chgres_cube  1.8.0
•All Data Structures Namespaces Files Functions Variables Pages
input_data.F90
Go to the documentation of this file.
1 
4 
14  module input_data
15 
16  use esmf
17  use netcdf
18  use nemsio_module
19 
20  use program_setup, only : data_dir_input_grid, &
21  nst_files_input_grid, &
22  sfc_files_input_grid, &
23  atm_files_input_grid, &
24  grib2_file_input_grid, &
25  atm_core_files_input_grid, &
26  atm_tracer_files_input_grid, &
27  convert_nst, &
28  orog_dir_input_grid, &
29  orog_files_input_grid, &
30  tracers_input, num_tracers_input, &
31  input_type, tracers, &
32  get_var_cond, read_from_input, &
33  geogrid_file_input_grid, &
34  external_model, &
35  vgfrc_from_climo, &
36  minmax_vgfrc_from_climo, &
37  lai_from_climo
38 
39  use model_grid, only : input_grid, &
40  i_input, j_input, &
41  ip1_input, jp1_input, &
42  num_tiles_input_grid, &
43  latitude_input_grid, &
44  longitude_input_grid
45 
46  implicit none
47 
48  private
49 
50 ! Fields associated with the atmospheric model.
51 
52  type(esmf_field), public :: dzdt_input_grid
53  type(esmf_field) :: dpres_input_grid
54  type(esmf_field), public :: pres_input_grid
55  type(esmf_field), public :: ps_input_grid
56  type(esmf_field), public :: terrain_input_grid
57  type(esmf_field), public :: temp_input_grid
58 
59  type(esmf_field), public :: u_input_grid
60  type(esmf_field), public :: v_input_grid
61  type(esmf_field), public :: wind_input_grid
62  type(esmf_field), allocatable, public :: tracers_input_grid(:)
63 
64  integer, public :: lev_input
65  integer, public :: levp1_input
66 
67 ! Fields associated with the land-surface model.
68 
69  integer, public :: veg_type_landice_input = 15
72  integer, parameter :: icet_default = 265.0
74  type(esmf_field), public :: canopy_mc_input_grid
75  type(esmf_field), public :: f10m_input_grid
76  type(esmf_field), public :: ffmm_input_grid
78  type(esmf_field), public :: landsea_mask_input_grid
80  type(esmf_field), public :: q2m_input_grid
81  type(esmf_field), public :: seaice_depth_input_grid
82  type(esmf_field), public :: seaice_fract_input_grid
83  type(esmf_field), public :: seaice_skin_temp_input_grid
84  type(esmf_field), public :: skin_temp_input_grid
85  type(esmf_field), public :: snow_depth_input_grid
86  type(esmf_field), public :: snow_liq_equiv_input_grid
87  type(esmf_field), public :: soil_temp_input_grid
88  type(esmf_field), public :: soil_type_input_grid
89  type(esmf_field), public :: soilm_liq_input_grid
90  type(esmf_field), public :: soilm_tot_input_grid
91  type(esmf_field), public :: srflag_input_grid
92  type(esmf_field), public :: t2m_input_grid
93  type(esmf_field), public :: tprcp_input_grid
94  type(esmf_field), public :: ustar_input_grid
95  type(esmf_field), public :: veg_type_input_grid
96  type(esmf_field), public :: z0_input_grid
97  type(esmf_field), public :: veg_greenness_input_grid
98  type(esmf_field), public :: lai_input_grid
99  type(esmf_field), public :: max_veg_greenness_input_grid
100  type(esmf_field), public :: min_veg_greenness_input_grid
101 
102  integer, public :: lsoil_input=4
104 
105  character(len=50), private, allocatable :: slevs(:)
106 
107 ! Fields associated with the nst model.
108 
109  type(esmf_field), public :: c_d_input_grid
110  type(esmf_field), public :: c_0_input_grid
111  type(esmf_field), public :: d_conv_input_grid
112  type(esmf_field), public :: dt_cool_input_grid
113  type(esmf_field), public :: ifd_input_grid
115  type(esmf_field), public :: qrain_input_grid
116  type(esmf_field), public :: tref_input_grid
117  type(esmf_field), public :: w_d_input_grid
118  type(esmf_field), public :: w_0_input_grid
119  type(esmf_field), public :: xs_input_grid
120  type(esmf_field), public :: xt_input_grid
121  type(esmf_field), public :: xu_input_grid
122  type(esmf_field), public :: xv_input_grid
123  type(esmf_field), public :: xz_input_grid
124  type(esmf_field), public :: xtts_input_grid
125  type(esmf_field), public :: xzts_input_grid
126  type(esmf_field), public :: z_c_input_grid
127  type(esmf_field), public :: zm_input_grid
128 
129  public :: read_input_atm_data
130  public :: cleanup_input_atm_data
131  public :: read_input_sfc_data
132  public :: cleanup_input_sfc_data
133  public :: read_input_nst_data
134  public :: cleanup_input_nst_data
135  public :: check_soilt
136  public :: check_cnwat
137  public :: quicksort
138  public :: convert_winds
139  public :: init_sfc_esmf_fields
140  public :: dint2p
141 
142  contains
143 
148  subroutine read_input_atm_data(localpet)
149 
150  implicit none
151 
152  integer, intent(in) :: localpet
153 
154 !-------------------------------------------------------------------------------
155 ! Read the tiled 'warm' restart files.
156 !-------------------------------------------------------------------------------
157 
158  if (trim(input_type) == "restart") then
159 
160  call read_input_atm_restart_file(localpet)
161 
162 !-------------------------------------------------------------------------------
163 ! Read the gaussian history files in netcdf format.
164 !-------------------------------------------------------------------------------
165 
166  elseif (trim(input_type) == "gaussian_netcdf") then
167 
168  call read_input_atm_gaussian_netcdf_file(localpet)
169 
170 !-------------------------------------------------------------------------------
171 ! Read the tiled history files in netcdf format.
172 !-------------------------------------------------------------------------------
173 
174  elseif (trim(input_type) == "history") then
175 
176  call read_input_atm_tiled_history_file(localpet)
177 
178 !-------------------------------------------------------------------------------
179 ! Read the gaussian history files in nemsio format.
180 !-------------------------------------------------------------------------------
181 
182  elseif (trim(input_type) == "gaussian_nemsio") then ! fv3gfs gaussian nemsio
183 
184  call read_input_atm_gaussian_nemsio_file(localpet)
185 
186 !-------------------------------------------------------------------------------
187 ! Read the spectral gfs gaussian history files in nemsio format.
188 !-------------------------------------------------------------------------------
189 
190  elseif (trim(input_type) == "gfs_gaussian_nemsio") then ! spectral gfs gaussian
191  ! nemsio.
192  call read_input_atm_gfs_gaussian_nemsio_file(localpet)
193 
194 !-------------------------------------------------------------------------------
195 ! Read the spectral gfs gaussian history files in sigio format.
196 !-------------------------------------------------------------------------------
197 
198  elseif (trim(input_type) == "gfs_sigio") then ! spectral gfs sigio format.
199 
200  call read_input_atm_gfs_sigio_file(localpet)
201 
202 !-------------------------------------------------------------------------------
203 ! Read fv3gfs data in grib2 format.
204 !-------------------------------------------------------------------------------
205 
206  elseif (trim(input_type) == "grib2") then
207 
208  call read_input_atm_grib2_file(localpet)
209 
210  endif
211 
212  end subroutine read_input_atm_data
213 
218  subroutine read_input_nst_data(localpet)
219 
220  implicit none
221 
222  integer, intent(in) :: localpet
223 
224  integer :: rc
225 
226  print*,"- READ INPUT GRID NST DATA."
227 
228  print*,"- CALL FieldCreate FOR INPUT GRID C_D."
229  c_d_input_grid = esmf_fieldcreate(input_grid, &
230  typekind=esmf_typekind_r8, &
231  staggerloc=esmf_staggerloc_center, rc=rc)
232  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
233  call error_handler("IN FieldCreate", rc)
234 
235  print*,"- CALL FieldCreate FOR INPUT GRID C_0."
236  c_0_input_grid = esmf_fieldcreate(input_grid, &
237  typekind=esmf_typekind_r8, &
238  staggerloc=esmf_staggerloc_center, rc=rc)
239  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
240  call error_handler("IN FieldCreate", rc)
241 
242  print*,"- CALL FieldCreate FOR INPUT GRID D_CONV."
243  d_conv_input_grid = esmf_fieldcreate(input_grid, &
244  typekind=esmf_typekind_r8, &
245  staggerloc=esmf_staggerloc_center, rc=rc)
246  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
247  call error_handler("IN FieldCreate", rc)
248 
249  print*,"- CALL FieldCreate FOR INPUT GRID DT_COOL."
250  dt_cool_input_grid = esmf_fieldcreate(input_grid, &
251  typekind=esmf_typekind_r8, &
252  staggerloc=esmf_staggerloc_center, rc=rc)
253  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
254  call error_handler("IN FieldCreate", rc)
255 
256  print*,"- CALL FieldCreate FOR INPUT GRID IFD."
257  ifd_input_grid = esmf_fieldcreate(input_grid, &
258  typekind=esmf_typekind_r8, &
259  staggerloc=esmf_staggerloc_center, rc=rc)
260  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
261  call error_handler("IN FieldCreate", rc)
262 
263  print*,"- CALL FieldCreate FOR INPUT GRID QRAIN."
264  qrain_input_grid = esmf_fieldcreate(input_grid, &
265  typekind=esmf_typekind_r8, &
266  staggerloc=esmf_staggerloc_center, rc=rc)
267  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
268  call error_handler("IN FieldCreate", rc)
269 
270  print*,"- CALL FieldCreate FOR INPUT GRID TREF."
271  tref_input_grid = esmf_fieldcreate(input_grid, &
272  typekind=esmf_typekind_r8, &
273  staggerloc=esmf_staggerloc_center, rc=rc)
274  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
275  call error_handler("IN FieldCreate", rc)
276 
277  print*,"- CALL FieldCreate FOR INPUT GRID W_D."
278  w_d_input_grid = esmf_fieldcreate(input_grid, &
279  typekind=esmf_typekind_r8, &
280  staggerloc=esmf_staggerloc_center, rc=rc)
281  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
282  call error_handler("IN FieldCreate", rc)
283 
284  print*,"- CALL FieldCreate FOR INPUT GRID W_0."
285  w_0_input_grid = esmf_fieldcreate(input_grid, &
286  typekind=esmf_typekind_r8, &
287  staggerloc=esmf_staggerloc_center, rc=rc)
288  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
289  call error_handler("IN FieldCreate", rc)
290 
291  print*,"- CALL FieldCreate FOR INPUT GRID XS."
292  xs_input_grid = esmf_fieldcreate(input_grid, &
293  typekind=esmf_typekind_r8, &
294  staggerloc=esmf_staggerloc_center, rc=rc)
295  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
296  call error_handler("IN FieldCreate", rc)
297 
298  print*,"- CALL FieldCreate FOR INPUT GRID XT."
299  xt_input_grid = esmf_fieldcreate(input_grid, &
300  typekind=esmf_typekind_r8, &
301  staggerloc=esmf_staggerloc_center, rc=rc)
302  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
303  call error_handler("IN FieldCreate", rc)
304 
305  print*,"- CALL FieldCreate FOR INPUT GRID XU."
306  xu_input_grid = esmf_fieldcreate(input_grid, &
307  typekind=esmf_typekind_r8, &
308  staggerloc=esmf_staggerloc_center, rc=rc)
309  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
310  call error_handler("IN FieldCreate", rc)
311 
312  print*,"- CALL FieldCreate FOR INPUT GRID XV."
313  xv_input_grid = esmf_fieldcreate(input_grid, &
314  typekind=esmf_typekind_r8, &
315  staggerloc=esmf_staggerloc_center, rc=rc)
316  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
317  call error_handler("IN FieldCreate", rc)
318 
319  print*,"- CALL FieldCreate FOR INPUT GRID XZ."
320  xz_input_grid = esmf_fieldcreate(input_grid, &
321  typekind=esmf_typekind_r8, &
322  staggerloc=esmf_staggerloc_center, rc=rc)
323  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
324  call error_handler("IN FieldCreate", rc)
325 
326  print*,"- CALL FieldCreate FOR INPUT GRID XTTS."
327  xtts_input_grid = esmf_fieldcreate(input_grid, &
328  typekind=esmf_typekind_r8, &
329  staggerloc=esmf_staggerloc_center, rc=rc)
330  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
331  call error_handler("IN FieldCreate", rc)
332 
333  print*,"- CALL FieldCreate FOR INPUT GRID XZTS."
334  xzts_input_grid = esmf_fieldcreate(input_grid, &
335  typekind=esmf_typekind_r8, &
336  staggerloc=esmf_staggerloc_center, rc=rc)
337  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
338  call error_handler("IN FieldCreate", rc)
339 
340  print*,"- CALL FieldCreate FOR INPUT GRID Z_C."
341  z_c_input_grid = esmf_fieldcreate(input_grid, &
342  typekind=esmf_typekind_r8, &
343  staggerloc=esmf_staggerloc_center, rc=rc)
344  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
345  call error_handler("IN FieldCreate", rc)
346 
347  print*,"- CALL FieldCreate FOR INPUT GRID ZM."
348  zm_input_grid = esmf_fieldcreate(input_grid, &
349  typekind=esmf_typekind_r8, &
350  staggerloc=esmf_staggerloc_center, rc=rc)
351  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
352  call error_handler("IN FieldCreate", rc)
353 
354 !--------------------------------------------------------------------------
355 ! Read input grid nst data from a fv3 gaussian nemsio history file or
356 ! spectral GFS nemsio file.
357 !--------------------------------------------------------------------------
358 
359  if (trim(input_type) == "gaussian_nemsio" .or. trim(input_type) == "gfs_gaussian_nemsio") then
360 
361  call read_input_nst_nemsio_file(localpet)
362 
363 !---------------------------------------------------------------------------
364 ! Read nst data from these netcdf formatted fv3 files: tiled history,
365 ! tiled warm restart, and gaussian history.
366 !---------------------------------------------------------------------------
367 
368  else
369 
370  call read_input_nst_netcdf_file(localpet)
371 
372  endif
373 
374  end subroutine read_input_nst_data
375 
380  subroutine read_input_sfc_data(localpet)
381 
382  implicit none
383 
384  integer, intent(in) :: localpet
385 
386  call init_sfc_esmf_fields()
387 
388 !-------------------------------------------------------------------------------
389 ! Read the tiled 'warm' restart files.
390 !-------------------------------------------------------------------------------
391 
392  if (trim(input_type) == "restart") then
393 
394  call read_input_sfc_restart_file(localpet)
395 
396 !-------------------------------------------------------------------------------
397 ! Read the tiled or gaussian history files in netcdf format.
398 !-------------------------------------------------------------------------------
399 
400  elseif (trim(input_type) == "history" .or. trim(input_type) == &
401  "gaussian_netcdf") then
402 
403  call read_input_sfc_netcdf_file(localpet)
404 
405 !-------------------------------------------------------------------------------
406 ! Read the gaussian history files in nemsio format.
407 !-------------------------------------------------------------------------------
408 
409  elseif (trim(input_type) == "gaussian_nemsio") then
410 
411  call read_input_sfc_gaussian_nemsio_file(localpet)
412 
413 !-------------------------------------------------------------------------------
414 ! Read the spectral gfs gaussian history files in nemsio format.
415 !-------------------------------------------------------------------------------
416 
417  elseif (trim(input_type) == "gfs_gaussian_nemsio") then
418 
419  call read_input_sfc_gfs_gaussian_nemsio_file(localpet)
420 
421 !-------------------------------------------------------------------------------
422 ! Read the spectral gfs gaussian history files in sfcio format.
423 !-------------------------------------------------------------------------------
424 
425  elseif (trim(input_type) == "gfs_sigio") then
426 
427  call read_input_sfc_gfs_sfcio_file(localpet)
428 
429 !-------------------------------------------------------------------------------
430 ! Read fv3gfs surface data in grib2 format.
431 !-------------------------------------------------------------------------------
432 
433  elseif (trim(input_type) == "grib2") then
434 
435  call read_input_sfc_grib2_file(localpet)
436 
437  endif
438 
439  end subroutine read_input_sfc_data
440 
444  subroutine init_atm_esmf_fields
445 
446  implicit none
447 
448  integer :: i, rc
449 
450  print*,"- INITIALIZE ATMOSPHERIC ESMF FIELDS."
451 
452  print*,"- CALL FieldCreate FOR INPUT GRID 3-D WIND."
453  wind_input_grid = esmf_fieldcreate(input_grid, &
454  typekind=esmf_typekind_r8, &
455  staggerloc=esmf_staggerloc_center, &
456  ungriddedlbound=(/1,1/), &
457  ungriddedubound=(/lev_input,3/), rc=rc)
458  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
459  call error_handler("IN FieldCreate", rc)
460 
461  print*,"- CALL FieldCreate FOR INPUT GRID SURFACE PRESSURE."
462  ps_input_grid = esmf_fieldcreate(input_grid, &
463  typekind=esmf_typekind_r8, &
464  staggerloc=esmf_staggerloc_center, rc=rc)
465  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
466  call error_handler("IN FieldCreate", rc)
467 
468  print*,"- CALL FieldCreate FOR INPUT GRID TERRAIN."
469  terrain_input_grid = esmf_fieldcreate(input_grid, &
470  typekind=esmf_typekind_r8, &
471  staggerloc=esmf_staggerloc_center, rc=rc)
472  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
473  call error_handler("IN FieldCreate", rc)
474 
475  print*,"- CALL FieldCreate FOR INPUT GRID TEMPERATURE."
476  temp_input_grid = esmf_fieldcreate(input_grid, &
477  typekind=esmf_typekind_r8, &
478  staggerloc=esmf_staggerloc_center, &
479  ungriddedlbound=(/1/), &
480  ungriddedubound=(/lev_input/), rc=rc)
481  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
482  call error_handler("IN FieldCreate", rc)
483 
484  allocate(tracers_input_grid(num_tracers_input))
485 
486  do i = 1, num_tracers_input
487  print*,"- CALL FieldCreate FOR INPUT GRID TRACER ", trim(tracers_input(i))
488  tracers_input_grid(i) = esmf_fieldcreate(input_grid, &
489  typekind=esmf_typekind_r8, &
490  staggerloc=esmf_staggerloc_center, &
491  ungriddedlbound=(/1/), &
492  ungriddedubound=(/lev_input/), rc=rc)
493  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
494  call error_handler("IN FieldCreate", rc)
495  enddo
496 
497  print*,"- CALL FieldCreate FOR INPUT GRID DZDT."
498  dzdt_input_grid = esmf_fieldcreate(input_grid, &
499  typekind=esmf_typekind_r8, &
500  staggerloc=esmf_staggerloc_center, &
501  ungriddedlbound=(/1/), &
502  ungriddedubound=(/lev_input/), rc=rc)
503  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
504  call error_handler("IN FieldCreate", rc)
505 
506  print*,"- CALL FieldCreate FOR INPUT GRID U."
507  u_input_grid = esmf_fieldcreate(input_grid, &
508  typekind=esmf_typekind_r8, &
509  staggerloc=esmf_staggerloc_center, &
510  ungriddedlbound=(/1/), &
511  ungriddedubound=(/lev_input/), rc=rc)
512  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
513  call error_handler("IN FieldCreate", rc)
514 
515  print*,"- CALL FieldCreate FOR INPUT GRID V."
516  v_input_grid = esmf_fieldcreate(input_grid, &
517  typekind=esmf_typekind_r8, &
518  staggerloc=esmf_staggerloc_center, &
519  ungriddedlbound=(/1/), &
520  ungriddedubound=(/lev_input/), rc=rc)
521  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
522  call error_handler("IN FieldCreate", rc)
523 
524  print*,"- CALL FieldCreate FOR INPUT GRID PRESSURE."
525  pres_input_grid = esmf_fieldcreate(input_grid, &
526  typekind=esmf_typekind_r8, &
527  staggerloc=esmf_staggerloc_center, &
528  ungriddedlbound=(/1/), &
529  ungriddedubound=(/lev_input/), rc=rc)
530  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
531  call error_handler("IN FieldCreate", rc)
532 
533  end subroutine init_atm_esmf_fields
534 
538  subroutine init_sfc_esmf_fields
539 
540  implicit none
541 
542  integer :: rc
543 
544  print*,"- CALL FieldCreate FOR INPUT GRID LANDSEA MASK."
545  landsea_mask_input_grid = esmf_fieldcreate(input_grid, &
546  typekind=esmf_typekind_r8, &
547  staggerloc=esmf_staggerloc_center, rc=rc)
548  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
549  call error_handler("IN FieldCreate", rc)
550 
551  print*,"- CALL FieldCreate FOR INPUT GRID Z0."
552  z0_input_grid = esmf_fieldcreate(input_grid, &
553  typekind=esmf_typekind_r8, &
554  staggerloc=esmf_staggerloc_center, rc=rc)
555  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
556  call error_handler("IN FieldCreate", rc)
557 
558  print*,"- CALL FieldCreate FOR INPUT GRID VEGETATION TYPE."
559  veg_type_input_grid = esmf_fieldcreate(input_grid, &
560  typekind=esmf_typekind_r8, &
561  staggerloc=esmf_staggerloc_center, rc=rc)
562  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
563  call error_handler("IN FieldCreate", rc)
564 
565  print*,"- CALL FieldCreate FOR INPUT GRID CANOPY MOISTURE CONTENT."
566  canopy_mc_input_grid = esmf_fieldcreate(input_grid, &
567  typekind=esmf_typekind_r8, &
568  staggerloc=esmf_staggerloc_center, rc=rc)
569  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
570  call error_handler("IN FieldCreate", rc)
571 
572  print*,"- CALL FieldCreate FOR INPUT GRID SEAICE FRACTION."
573  seaice_fract_input_grid = esmf_fieldcreate(input_grid, &
574  typekind=esmf_typekind_r8, &
575  staggerloc=esmf_staggerloc_center, rc=rc)
576  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
577  call error_handler("IN FieldCreate", rc)
578 
579  print*,"- CALL FieldCreate FOR INPUT GRID SEAICE DEPTH."
580  seaice_depth_input_grid = esmf_fieldcreate(input_grid, &
581  typekind=esmf_typekind_r8, &
582  staggerloc=esmf_staggerloc_center, rc=rc)
583  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
584  call error_handler("IN FieldCreate", rc)
585 
586  print*,"- CALL FieldCreate FOR INPUT GRID SEAICE SKIN TEMPERATURE."
587  seaice_skin_temp_input_grid = esmf_fieldcreate(input_grid, &
588  typekind=esmf_typekind_r8, &
589  staggerloc=esmf_staggerloc_center, rc=rc)
590  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
591  call error_handler("IN FieldCreate", rc)
592 
593  print*,"- CALL FieldCreate FOR INPUT GRID SNOW DEPTH."
594  snow_depth_input_grid = esmf_fieldcreate(input_grid, &
595  typekind=esmf_typekind_r8, &
596  staggerloc=esmf_staggerloc_center, rc=rc)
597  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
598  call error_handler("IN FieldCreate", rc)
599 
600  print*,"- CALL FieldCreate FOR INPUT GRID SNOW LIQUID EQUIVALENT."
601  snow_liq_equiv_input_grid = esmf_fieldcreate(input_grid, &
602  typekind=esmf_typekind_r8, &
603  staggerloc=esmf_staggerloc_center, rc=rc)
604  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
605  call error_handler("IN FieldCreate", rc)
606 
607  print*,"- CALL FieldCreate FOR INPUT GRID T2M."
608  t2m_input_grid = esmf_fieldcreate(input_grid, &
609  typekind=esmf_typekind_r8, &
610  staggerloc=esmf_staggerloc_center, rc=rc)
611  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
612  call error_handler("IN FieldCreate", rc)
613 
614  print*,"- CALL FieldCreate FOR INPUT GRID Q2M."
615  q2m_input_grid = esmf_fieldcreate(input_grid, &
616  typekind=esmf_typekind_r8, &
617  staggerloc=esmf_staggerloc_center, rc=rc)
618  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
619  call error_handler("IN FieldCreate", rc)
620 
621  print*,"- CALL FieldCreate FOR INPUT GRID TPRCP."
622  tprcp_input_grid = esmf_fieldcreate(input_grid, &
623  typekind=esmf_typekind_r8, &
624  staggerloc=esmf_staggerloc_center, rc=rc)
625  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
626  call error_handler("IN FieldCreate", rc)
627 
628  print*,"- CALL FieldCreate FOR INPUT GRID F10M."
629  f10m_input_grid = esmf_fieldcreate(input_grid, &
630  typekind=esmf_typekind_r8, &
631  staggerloc=esmf_staggerloc_center, rc=rc)
632  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
633  call error_handler("IN FieldCreate", rc)
634 
635  print*,"- CALL FieldCreate FOR INPUT GRID USTAR."
636  ustar_input_grid = esmf_fieldcreate(input_grid, &
637  typekind=esmf_typekind_r8, &
638  staggerloc=esmf_staggerloc_center, rc=rc)
639  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
640  call error_handler("IN FieldCreate", rc)
641 
642  print*,"- CALL FieldCreate FOR INPUT GRID FFMM."
643  ffmm_input_grid = esmf_fieldcreate(input_grid, &
644  typekind=esmf_typekind_r8, &
645  staggerloc=esmf_staggerloc_center, rc=rc)
646  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
647  call error_handler("IN FieldCreate", rc)
648 
649  print*,"- CALL FieldCreate FOR INPUT GRID SRFLAG."
650  srflag_input_grid = esmf_fieldcreate(input_grid, &
651  typekind=esmf_typekind_r8, &
652  staggerloc=esmf_staggerloc_center, rc=rc)
653  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
654  call error_handler("IN FieldCreate", rc)
655 
656  print*,"- CALL FieldCreate FOR INPUT SKIN TEMPERATURE."
657  skin_temp_input_grid = esmf_fieldcreate(input_grid, &
658  typekind=esmf_typekind_r8, &
659  staggerloc=esmf_staggerloc_center, rc=rc)
660  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
661  call error_handler("IN FieldCreate", rc)
662 
663  print*,"- CALL FieldCreate FOR INPUT SOIL TYPE."
664  soil_type_input_grid = esmf_fieldcreate(input_grid, &
665  typekind=esmf_typekind_r8, &
666  staggerloc=esmf_staggerloc_center, rc=rc)
667  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
668  call error_handler("IN FieldCreate", rc)
669 
670  print*,"- CALL FieldCreate FOR INPUT TERRAIN."
671  terrain_input_grid = esmf_fieldcreate(input_grid, &
672  typekind=esmf_typekind_r8, &
673  staggerloc=esmf_staggerloc_center, rc=rc)
674  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
675  call error_handler("IN FieldCreate", rc)
676 
677  print*,"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE."
678  soil_temp_input_grid = esmf_fieldcreate(input_grid, &
679  typekind=esmf_typekind_r8, &
680  staggerloc=esmf_staggerloc_center, &
681  ungriddedlbound=(/1/), &
682  ungriddedubound=(/lsoil_input/), rc=rc)
683  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
684  call error_handler("IN FieldCreate", rc)
685 
686  print*,"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE."
687  soilm_tot_input_grid = esmf_fieldcreate(input_grid, &
688  typekind=esmf_typekind_r8, &
689  staggerloc=esmf_staggerloc_center, &
690  ungriddedlbound=(/1/), &
691  ungriddedubound=(/lsoil_input/), rc=rc)
692  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
693  call error_handler("IN FieldCreate", rc)
694 
695  print*,"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE."
696  soilm_liq_input_grid = esmf_fieldcreate(input_grid, &
697  typekind=esmf_typekind_r8, &
698  staggerloc=esmf_staggerloc_center, &
699  ungriddedlbound=(/1/), &
700  ungriddedubound=(/lsoil_input/), rc=rc)
701  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
702  call error_handler("IN FieldCreate", rc)
703 
704 
705 
706  if (.not. vgfrc_from_climo) then
707  print*,"- CALL FieldCreate FOR INPUT VEGETATION GREENNESS."
708  veg_greenness_input_grid = esmf_fieldcreate(input_grid, &
709  typekind=esmf_typekind_r8, &
710  staggerloc=esmf_staggerloc_center, rc=rc)
711  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
712  call error_handler("IN FieldCreate", rc)
713  endif
714 
715  if (.not. minmax_vgfrc_from_climo) then
716  print*,"- CALL FieldCreate FOR INPUT MIN VEGETATION GREENNESS."
717  min_veg_greenness_input_grid = esmf_fieldcreate(input_grid, &
718  typekind=esmf_typekind_r8, &
719  staggerloc=esmf_staggerloc_center, rc=rc)
720  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
721  call error_handler("IN FieldCreate", rc)
722 
723  print*,"- CALL FieldCreate FOR INPUT MAX VEGETATION GREENNESS."
724  max_veg_greenness_input_grid = esmf_fieldcreate(input_grid, &
725  typekind=esmf_typekind_r8, &
726  staggerloc=esmf_staggerloc_center, rc=rc)
727  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
728  call error_handler("IN FieldCreate", rc)
729  endif
730 
731  if (.not. lai_from_climo) then
732  print*,"- CALL FieldCreate FOR INPUT LEAF AREA INDEX."
733  lai_input_grid = esmf_fieldcreate(input_grid, &
734  typekind=esmf_typekind_r8, &
735  staggerloc=esmf_staggerloc_center, rc=rc)
736  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
737  call error_handler("IN FieldCreate", rc)
738  endif
739  end subroutine init_sfc_esmf_fields
740 
746  subroutine read_input_atm_gfs_sigio_file(localpet)
747 
748  use sigio_module
749 
750  implicit none
751 
752  integer, intent(in) :: localpet
753 
754  character(len=300) :: the_file
755 
756  integer(sigio_intkind) :: iret
757  integer :: rc, i, j, k
758  integer :: clb(3), cub(3)
759 
760  real(esmf_kind_r8) :: ak, bk
761  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
762  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
763  real(esmf_kind_r8), allocatable :: dummy3d2(:,:,:)
764  real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:)
765  real(esmf_kind_r8), allocatable :: pi(:,:,:)
766 
767  type(sigio_head) :: sighead
768  type(sigio_dbta) :: sigdata
769 
770  the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1))
771 
772  print*,"- ATMOSPHERIC DATA IN SIGIO FORMAT."
773  print*,"- OPEN AND READ: ", trim(the_file)
774 
775  call sigio_sropen(21, trim(the_file), iret)
776  if (iret /= 0) then
777  rc = iret
778  call error_handler("OPENING SPECTRAL GFS SIGIO FILE.", rc)
779  endif
780  call sigio_srhead(21, sighead, iret)
781  if (iret /= 0) then
782  rc = iret
783  call error_handler("READING SPECTRAL GFS SIGIO FILE.", rc)
784  endif
785 
786  lev_input = sighead%levs
787  levp1_input = lev_input + 1
788 
789  if (num_tracers_input /= sighead%ntrac) then
790  call error_handler("WRONG NUMBER OF TRACERS EXPECTED.", 99)
791  endif
792 
793  if (sighead%idvt == 0 .or. sighead%idvt == 21) then
794  if (trim(tracers_input(1)) /= 'spfh' .or. &
795  trim(tracers_input(2)) /= 'o3mr' .or. &
796  trim(tracers_input(3)) /= 'clwmr') then
797  call error_handler("TRACERS SELECTED DO NOT MATCH FILE CONTENTS.", 99)
798  endif
799  else
800  print*,'- UNRECOGNIZED IDVT: ', sighead%idvt
801  call error_handler("UNRECOGNIZED IDVT", 99)
802  endif
803 
804 !---------------------------------------------------------------------------
805 ! Initialize esmf atmospheric fields.
806 !---------------------------------------------------------------------------
807 
808  call init_atm_esmf_fields
809 
810  if (localpet == 0) then
811  allocate(dummy2d(i_input,j_input))
812  allocate(dummy3d(i_input,j_input,lev_input))
813  allocate(dummy3d2(i_input,j_input,lev_input))
814  else
815  allocate(dummy2d(0,0))
816  allocate(dummy3d(0,0,0))
817  allocate(dummy3d2(0,0,0))
818  endif
819 
820  if (localpet == 0) then
821  call sigio_aldbta(sighead, sigdata, iret)
822  if (iret /= 0) then
823  rc = iret
824  call error_handler("ALLOCATING SIGDATA.", rc)
825  endif
826  call sigio_srdbta(21, sighead, sigdata, iret)
827  if (iret /= 0) then
828  rc = iret
829  call error_handler("READING SIGDATA.", rc)
830  endif
831  call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%ps, dummy2d, 1)
832  dummy2d = exp(dummy2d) * 1000.0
833  print*,'surface pres ',maxval(dummy2d),minval(dummy2d)
834  endif
835 
836  print*,"- CALL FieldScatter FOR SURFACE PRESSURE."
837  call esmf_fieldscatter(ps_input_grid, dummy2d, rootpet=0, rc=rc)
838  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
839  call error_handler("IN FieldScatter", rc)
840 
841  if (localpet == 0) then
842  call sptez(0,sighead%jcap,4,i_input, j_input, sigdata%hs, dummy2d, 1)
843  print*,'terrain ',maxval(dummy2d),minval(dummy2d)
844  endif
845 
846  print*,"- CALL FieldScatter FOR TERRAIN."
847  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
848  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
849  call error_handler("IN FieldScatter", rc)
850 
851  do k = 1, num_tracers_input
852 
853  if (localpet == 0) then
854  call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%q(:,:,k), dummy3d, 1)
855  print*,trim(tracers_input(k)),maxval(dummy3d),minval(dummy3d)
856  endif
857 
858  print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(k))
859  call esmf_fieldscatter(tracers_input_grid(k), dummy3d, rootpet=0, rc=rc)
860  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
861  call error_handler("IN FieldScatter", rc)
862 
863  enddo
864 
865  if (localpet == 0) then
866  call sptezm(0,sighead%jcap,4,i_input, j_input, lev_input, sigdata%t, dummy3d, 1)
867  print*,'temp ',maxval(dummy3d),minval(dummy3d)
868  endif
869 
870  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
871  call esmf_fieldscatter(temp_input_grid, dummy3d, rootpet=0, rc=rc)
872  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
873  call error_handler("IN FieldScatter", rc)
874 
875 !---------------------------------------------------------------------------
876 ! The spectral gfs files have omega, not vertical velocity. Set to
877 ! zero for now. Convert from omega to vv in the future?
878 !---------------------------------------------------------------------------
879 
880  if (localpet == 0) then
881  print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO."
882  dummy3d = 0.0
883  endif
884 
885  print*,"- CALL FieldScatter FOR INPUT DZDT."
886  call esmf_fieldscatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc)
887  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
888  call error_handler("IN FieldScatter", rc)
889 
890  if (localpet == 0) then
891  call sptezmv(0, sighead%jcap, 4, i_input, j_input, lev_input, sigdata%d, sigdata%z, dummy3d, dummy3d2, 1)
892  print*,'u ',maxval(dummy3d),minval(dummy3d)
893  print*,'v ',maxval(dummy3d2),minval(dummy3d2)
894  endif
895 
896  print*,"- CALL FieldScatter FOR INPUT U-WIND."
897  call esmf_fieldscatter(u_input_grid, dummy3d, rootpet=0, rc=rc)
898  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
899  call error_handler("IN FieldScatter", rc)
900 
901  print*,"- CALL FieldScatter FOR INPUT V-WIND."
902  call esmf_fieldscatter(v_input_grid, dummy3d2, rootpet=0, rc=rc)
903  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
904  call error_handler("IN FieldScatter", rc)
905 
906  deallocate(dummy2d, dummy3d, dummy3d2)
907 
908  if (localpet == 0) call sigio_axdbta(sigdata, iret)
909 
910  call sigio_sclose(21, iret)
911 
912 !---------------------------------------------------------------------------
913 ! Convert from 2-d to 3-d component winds.
914 !---------------------------------------------------------------------------
915 
916  call convert_winds
917 
918 !---------------------------------------------------------------------------
919 ! Compute 3-d pressure from 'ak' and 'bk'.
920 !---------------------------------------------------------------------------
921 
922  print*,"- COMPUTE 3-D PRESSURE."
923 
924  print*,"- CALL FieldGet FOR 3-D PRES."
925  nullify(pptr)
926  call esmf_fieldget(pres_input_grid, &
927  computationallbound=clb, &
928  computationalubound=cub, &
929  farrayptr=pptr, rc=rc)
930  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
931  call error_handler("IN FieldGet", rc)
932 
933  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
934  nullify(psptr)
935  call esmf_fieldget(ps_input_grid, &
936  farrayptr=psptr, rc=rc)
937  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
938  call error_handler("IN FieldGet", rc)
939 
940 !---------------------------------------------------------------------------
941 ! First, compute interface pressure.
942 !---------------------------------------------------------------------------
943 
944  allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input),stat=rc)
945 
946  do k=1,levp1_input
947  ak = sighead%vcoord(k,1)
948  bk = sighead%vcoord(k,2)
949  do i= clb(1), cub(1)
950  do j= clb(2), cub(2)
951  pi(i,j,k) = ak + bk*psptr(i,j)
952  enddo
953  enddo
954  enddo
955 
956  if (localpet == 0) then
957  print*,'pres int ',psptr(clb(1),clb(2)),pi(clb(1),clb(2),:)
958  endif
959 
960 !---------------------------------------------------------------------------
961 ! Now comput mid-layer pressure from interface pressure.
962 !---------------------------------------------------------------------------
963 
964  do k=1,lev_input
965  do i= clb(1), cub(1)
966  do j= clb(2), cub(2)
967  pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0_esmf_kind_r8
968  enddo
969  enddo
970  enddo
971 
972  deallocate(pi)
973 
974  if (localpet == 0) then
975  print*,'pres ',psptr(clb(1),clb(2)),pptr(clb(1),clb(2),:)
976  endif
977 
978  end subroutine read_input_atm_gfs_sigio_file
979 
985  subroutine read_input_atm_gfs_gaussian_nemsio_file(localpet)
986 
987  implicit none
988 
989  integer, intent(in) :: localpet
990 
991  character(len=300) :: the_file
992  character(len=20) :: vlevtyp, vname
993 
994  integer(nemsio_intkind) :: vlev, iret
995  integer :: i, j, k, n, rc
996  integer :: clb(3), cub(3)
997 
998  real(nemsio_realkind), allocatable :: vcoord(:,:,:)
999  real(nemsio_realkind), allocatable :: dummy(:)
1000  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
1001  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
1002  real(esmf_kind_r8) :: ak, bk
1003  real(esmf_kind_r8), allocatable :: pi(:,:,:)
1004  real(esmf_kind_r8), pointer :: pptr(:,:,:), psptr(:,:)
1005 
1006  type(nemsio_gfile) :: gfile
1007 
1008  the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1))
1009 
1010  print*,"- READ ATMOS DATA FROM SPECTRAL GFS NEMSIO FILE: ", trim(the_file)
1011 
1012  print*,"- OPEN FILE."
1013  call nemsio_open(gfile, the_file, "read", iret=iret)
1014  if (iret /= 0) call error_handler("OPENING SPECTRAL GFS NEMSIO ATM FILE.", iret)
1015 
1016  print*,"- READ NUMBER OF VERTICAL LEVELS."
1017  call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input)
1018  if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret)
1019 
1020  levp1_input = lev_input + 1
1021 
1022  allocate(vcoord(levp1_input,3,2))
1023 
1024  print*,"- READ VERTICAL COORDINATE INFO."
1025  call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord)
1026  if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret)
1027 
1028 !---------------------------------------------------------------------------
1029 ! Initialize esmf atmospheric fields.
1030 !---------------------------------------------------------------------------
1031 
1032  call init_atm_esmf_fields
1033 
1034  if (localpet == 0) then
1035  allocate(dummy(i_input*j_input))
1036  allocate(dummy2d(i_input,j_input))
1037  allocate(dummy3d(i_input,j_input,lev_input))
1038  else
1039  allocate(dummy(0))
1040  allocate(dummy2d(0,0))
1041  allocate(dummy3d(0,0,0))
1042  endif
1043 
1044 !-----------------------------------------------------------------------
1045 ! 3-d fields in gaussian files increment from bottom to model top.
1046 ! That is what is expected by this program, so no need to flip indices.
1047 !-----------------------------------------------------------------------
1048 
1049  if (localpet == 0) then
1050  print*,"- READ TEMPERATURE."
1051  vname = "tmp"
1052  vlevtyp = "mid layer"
1053  do vlev = 1, lev_input
1054  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1055  if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret)
1056  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1057 ! print*,'temp check after read ',vlev, dummy3d(1,1,vlev)
1058  enddo
1059  endif
1060 
1061  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
1062  call esmf_fieldscatter(temp_input_grid, dummy3d, rootpet=0, rc=rc)
1063  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1064  call error_handler("IN FieldScatter", rc)
1065 
1066  do n = 1, num_tracers_input
1067 
1068  if (localpet == 0) then
1069  print*,"- READ ", trim(tracers_input(n))
1070  vname = trim(tracers_input(n))
1071  vlevtyp = "mid layer"
1072  do vlev = 1, lev_input
1073  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1074  if (iret /= 0) call error_handler("READING TRACER RECORD.", iret)
1075 ! print*,'tracer ',vlev, maxval(dummy),minval(dummy)
1076  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1077  enddo
1078  endif
1079 
1080  print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n))
1081  call esmf_fieldscatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc)
1082  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1083  call error_handler("IN FieldScatter", rc)
1084 
1085  enddo
1086 
1087  if (localpet == 0) then
1088  print*,"- READ U-WINDS."
1089  vname = "ugrd"
1090  vlevtyp = "mid layer"
1091  do vlev = 1, lev_input
1092  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1093  if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret)
1094 ! print*,'ugrd ',vlev, maxval(dummy),minval(dummy)
1095  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1096  enddo
1097  endif
1098 
1099  print*,"- CALL FieldScatter FOR INPUT U-WIND."
1100  call esmf_fieldscatter(u_input_grid, dummy3d, rootpet=0, rc=rc)
1101  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1102  call error_handler("IN FieldScatter", rc)
1103 
1104  if (localpet == 0) then
1105  print*,"- READ V-WINDS."
1106  vname = "vgrd"
1107  vlevtyp = "mid layer"
1108  do vlev = 1, lev_input
1109  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1110  if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret)
1111 ! print*,'vgrd ',vlev, maxval(dummy),minval(dummy)
1112  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1113  enddo
1114  endif
1115 
1116  print*,"- CALL FieldScatter FOR INPUT V-WIND."
1117  call esmf_fieldscatter(v_input_grid, dummy3d, rootpet=0, rc=rc)
1118  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1119  call error_handler("IN FieldScatter", rc)
1120 
1121 !---------------------------------------------------------------------------
1122 ! The spectral gfs nemsio files do not have a vertical velocity or
1123 ! omega record. So set to zero for now.
1124 !---------------------------------------------------------------------------
1125 
1126  if (localpet == 0) then
1127  print*,"- NO VERTICAL VELOCITY RECORD. SET TO ZERO."
1128  dummy3d = 0.0
1129  endif
1130 
1131  print*,"- CALL FieldScatter FOR INPUT DZDT."
1132  call esmf_fieldscatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc)
1133  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1134  call error_handler("IN FieldScatter", rc)
1135 
1136  if (localpet == 0) then
1137  print*,"- READ HGT."
1138  vname = "hgt"
1139  vlevtyp = "sfc"
1140  vlev = 1
1141  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1142  if (iret /= 0) call error_handler("READING HGT RECORD.", iret)
1143 ! print*,'hgt ',vlev, maxval(dummy),minval(dummy)
1144  dummy2d = reshape(dummy, (/i_input,j_input/))
1145  endif
1146 
1147  print*,"- CALL FieldScatter FOR TERRAIN."
1148  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
1149  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1150  call error_handler("IN FieldScatter", rc)
1151 
1152  if (localpet == 0) then
1153  print*,"- READ PRES."
1154  vname = "pres"
1155  vlevtyp = "sfc"
1156  vlev = 1
1157  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1158  if (iret /= 0) call error_handler("READING PRES RECORD.", iret)
1159 ! print*,'pres ',vlev, maxval(dummy),minval(dummy)
1160  dummy2d = reshape(dummy, (/i_input,j_input/))
1161  endif
1162 
1163  print*,"- CALL FieldScatter FOR SURFACE PRESSURE."
1164  call esmf_fieldscatter(ps_input_grid, dummy2d, rootpet=0, rc=rc)
1165  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1166  call error_handler("IN FieldScatter", rc)
1167 
1168  call nemsio_close(gfile)
1169 
1170  deallocate(dummy, dummy2d, dummy3d)
1171 
1172 !---------------------------------------------------------------------------
1173 ! Convert from 2-d to 3-d component winds.
1174 !---------------------------------------------------------------------------
1175 
1176  call convert_winds
1177 
1178 !---------------------------------------------------------------------------
1179 ! Compute 3-d pressure from 'ak' and 'bk'.
1180 !---------------------------------------------------------------------------
1181 
1182  print*,"- COMPUTE 3-D PRESSURE."
1183 
1184  print*,"- CALL FieldGet FOR 3-D PRES."
1185  nullify(pptr)
1186  call esmf_fieldget(pres_input_grid, &
1187  computationallbound=clb, &
1188  computationalubound=cub, &
1189  farrayptr=pptr, rc=rc)
1190  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1191  call error_handler("IN FieldGet", rc)
1192 
1193  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
1194  nullify(psptr)
1195  call esmf_fieldget(ps_input_grid, &
1196  farrayptr=psptr, rc=rc)
1197  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1198  call error_handler("IN FieldGet", rc)
1199 
1200 !---------------------------------------------------------------------------
1201 ! First, compute interface pressure.
1202 !---------------------------------------------------------------------------
1203 
1204  allocate(pi(clb(1):cub(1),clb(2):cub(2),1:levp1_input))
1205 
1206  do k=1,levp1_input
1207  ak = vcoord(k,1,1)
1208  bk = vcoord(k,2,1)
1209  do i= clb(1), cub(1)
1210  do j= clb(2), cub(2)
1211  pi(i,j,k) = ak + bk*psptr(i,j)
1212  enddo
1213  enddo
1214  enddo
1215 
1216  deallocate(vcoord)
1217 
1218 !---------------------------------------------------------------------------
1219 ! Now comput mid-layer pressure from interface pressure.
1220 !---------------------------------------------------------------------------
1221 
1222  do k=1,lev_input
1223  do i= clb(1), cub(1)
1224  do j= clb(2), cub(2)
1225  pptr(i,j,k) = (pi(i,j,k)+pi(i,j,k+1))/2.0
1226  enddo
1227  enddo
1228  enddo
1229 
1230  deallocate(pi)
1231 
1232  end subroutine read_input_atm_gfs_gaussian_nemsio_file
1233 
1238  subroutine read_input_atm_gaussian_nemsio_file(localpet)
1239 
1240  implicit none
1241 
1242  integer, intent(in) :: localpet
1243 
1244  character(len=300) :: the_file
1245  character(len=20) :: vlevtyp, vname
1246 
1247  integer :: i, j, k, n
1248  integer :: rc, clb(3), cub(3)
1249  integer(nemsio_intkind) :: vlev, iret
1250 
1251  real(nemsio_realkind), allocatable :: vcoord(:,:,:)
1252  real(nemsio_realkind), allocatable :: dummy(:)
1253  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
1254  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
1255  real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:)
1256  real(esmf_kind_r8), pointer :: dpresptr(:,:,:)
1257  real(esmf_kind_r8), allocatable :: pres_interface(:)
1258 
1259  type(nemsio_gfile) :: gfile
1260 
1261  the_file = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1))
1262 
1263  print*,"- READ ATMOS DATA FROM GAUSSIAN NEMSIO FILE: ", trim(the_file)
1264 
1265  print*,"- OPEN FILE."
1266  call nemsio_open(gfile, the_file, "read", iret=iret)
1267  if (iret /= 0) call error_handler("OPENING GAUSSIAN NEMSIO ATM FILE.", iret)
1268 
1269  print*,"- READ NUMBER OF VERTICAL LEVELS."
1270  call nemsio_getfilehead(gfile, iret=iret, dimz=lev_input)
1271  if (iret /= 0) call error_handler("READING NUMBER OF VERTICAL LEVLES.", iret)
1272 
1273  levp1_input = lev_input + 1
1274 
1275  allocate(vcoord(levp1_input,3,2))
1276 
1277  print*,"- READ VERTICAL COORDINATE INFO."
1278  call nemsio_getfilehead(gfile, iret=iret, vcoord=vcoord)
1279  if (iret /= 0) call error_handler("READING VERTICAL COORDINATE INFO.", iret)
1280 
1281 !---------------------------------------------------------------------------
1282 ! Initialize esmf atmospheric fields.
1283 !---------------------------------------------------------------------------
1284 
1285  call init_atm_esmf_fields
1286 
1287  print*,"- CALL FieldCreate FOR INPUT DPRES."
1288  dpres_input_grid = esmf_fieldcreate(input_grid, &
1289  typekind=esmf_typekind_r8, &
1290  staggerloc=esmf_staggerloc_center, &
1291  ungriddedlbound=(/1/), &
1292  ungriddedubound=(/lev_input/), rc=rc)
1293  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1294  call error_handler("IN FieldCreate", rc)
1295 
1296  if (localpet == 0) then
1297  allocate(dummy(i_input*j_input))
1298  allocate(dummy2d(i_input,j_input))
1299  allocate(dummy3d(i_input,j_input,lev_input))
1300  else
1301  allocate(dummy(0))
1302  allocate(dummy2d(0,0))
1303  allocate(dummy3d(0,0,0))
1304  endif
1305 
1306 !-----------------------------------------------------------------------
1307 ! 3-d fields in gaussian files increment from bottom to model top.
1308 ! That is what is expected by this program, so no need to flip indices.
1309 !-----------------------------------------------------------------------
1310 
1311  if (localpet == 0) then
1312  print*,"- READ TEMPERATURE."
1313  vname = "tmp"
1314  vlevtyp = "mid layer"
1315  do vlev = 1, lev_input
1316  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1317  if (iret /= 0) call error_handler("READING TEMPERATURE RECORD.", iret)
1318  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1319  print*,'temp check after read ',vlev, dummy3d(1,1,vlev)
1320  enddo
1321  endif
1322 
1323  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
1324  call esmf_fieldscatter(temp_input_grid, dummy3d, rootpet=0, rc=rc)
1325  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1326  call error_handler("IN FieldScatter", rc)
1327 
1328  do n = 1, num_tracers_input
1329 
1330  if (localpet == 0) then
1331  print*,"- READ ", trim(tracers_input(n))
1332  vname = trim(tracers_input(n))
1333  vlevtyp = "mid layer"
1334  do vlev = 1, lev_input
1335  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1336  if (iret /= 0) call error_handler("READING TRACER RECORD.", iret)
1337  print*,'tracer ',vlev, maxval(dummy),minval(dummy)
1338  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1339  enddo
1340  endif
1341 
1342  print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(n))
1343  call esmf_fieldscatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc)
1344  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1345  call error_handler("IN FieldScatter", rc)
1346 
1347  enddo
1348 
1349  if (localpet == 0) then
1350  print*,"- READ U-WINDS."
1351  vname = "ugrd"
1352  vlevtyp = "mid layer"
1353  do vlev = 1, lev_input
1354  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1355  if (iret /= 0) call error_handler("READING U-WIND RECORD.", iret)
1356  print*,'ugrd ',vlev, maxval(dummy),minval(dummy)
1357  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1358  enddo
1359  endif
1360 
1361  print*,"- CALL FieldScatter FOR INPUT U-WIND."
1362  call esmf_fieldscatter(u_input_grid, dummy3d, rootpet=0, rc=rc)
1363  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1364  call error_handler("IN FieldScatter", rc)
1365 
1366  if (localpet == 0) then
1367  print*,"- READ V-WINDS."
1368  vname = "vgrd"
1369  vlevtyp = "mid layer"
1370  do vlev = 1, lev_input
1371  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1372  if (iret /= 0) call error_handler("READING V-WIND RECORD.", iret)
1373  print*,'vgrd ',vlev, maxval(dummy),minval(dummy)
1374  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1375  enddo
1376  endif
1377 
1378  print*,"- CALL FieldScatter FOR INPUT V-WIND."
1379  call esmf_fieldscatter(v_input_grid, dummy3d, rootpet=0, rc=rc)
1380  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1381  call error_handler("IN FieldScatter", rc)
1382 
1383  if (localpet == 0) then
1384  print*,"- READ DPRES."
1385  vname = "dpres"
1386  vlevtyp = "mid layer"
1387  do vlev = 1, lev_input
1388  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1389  if (iret /= 0) call error_handler("READING DPRES RECORD.", iret)
1390  print*,'dpres ',vlev, maxval(dummy),minval(dummy)
1391  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1392  enddo
1393  endif
1394 
1395  print*,"- CALL FieldScatter FOR INPUT DPRES."
1396  call esmf_fieldscatter(dpres_input_grid, dummy3d, rootpet=0, rc=rc)
1397  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1398  call error_handler("IN FieldScatter", rc)
1399 
1400  if (localpet == 0) then
1401  print*,"- READ DZDT."
1402  vname = "dzdt"
1403  vlevtyp = "mid layer"
1404  do vlev = 1, lev_input
1405  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1406  if (iret /= 0) call error_handler("READING DZDT RECORD.", iret)
1407  print*,'dzdt ',vlev, maxval(dummy),minval(dummy)
1408  dummy3d(:,:,vlev) = reshape(dummy, (/i_input,j_input/))
1409  enddo
1410  endif
1411 
1412  print*,"- CALL FieldScatter FOR INPUT DZDT."
1413  call esmf_fieldscatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc)
1414  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1415  call error_handler("IN FieldScatter", rc)
1416 
1417  if (localpet == 0) then
1418  print*,"- READ HGT."
1419  vname = "hgt"
1420  vlevtyp = "sfc"
1421  vlev = 1
1422  call nemsio_readrecv(gfile, vname, vlevtyp, vlev, dummy, 0, iret)
1423  if (iret /= 0) call error_handler("READING HGT RECORD.", iret)
1424  print*,'hgt ',vlev, maxval(dummy),minval(dummy)
1425  dummy2d = reshape(dummy, (/i_input,j_input/))
1426  endif
1427 
1428  print*,"- CALL FieldScatter FOR TERRAIN."
1429  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
1430  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1431  call error_handler("IN FieldScatter", rc)
1432 
1433  call nemsio_close(gfile)
1434 
1435  deallocate(dummy, dummy2d, dummy3d)
1436 
1437 !---------------------------------------------------------------------------
1438 ! Convert from 2-d to 3-d component winds.
1439 !---------------------------------------------------------------------------
1440 
1441  call convert_winds
1442 
1443 !---------------------------------------------------------------------------
1444 ! Compute 3-d pressure. Mid-layer and surface pressure are computed
1445 ! from delta p. The surface pressure in the file is not used. After
1446 ! the model's write component interpolates from the cubed-sphere grid
1447 ! to the gaussian grid, the surface pressure is no longer consistent
1448 ! with the delta p (per Jun Wang).
1449 !---------------------------------------------------------------------------
1450 
1451  print*,"- COMPUTE 3-D PRESSURE."
1452 
1453  print*,"- CALL FieldGet FOR DELTA PRESSURE."
1454  nullify(dpresptr)
1455  call esmf_fieldget(dpres_input_grid, &
1456  computationallbound=clb, &
1457  computationalubound=cub, &
1458  farrayptr=dpresptr, rc=rc)
1459  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1460  call error_handler("IN FieldGet", rc)
1461 
1462  print*,"- CALL FieldGet FOR 3-D PRESSURE."
1463  nullify(presptr)
1464  call esmf_fieldget(pres_input_grid, &
1465  farrayptr=presptr, rc=rc)
1466  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1467  call error_handler("IN FieldGet", rc)
1468 
1469  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
1470  nullify(psptr)
1471  call esmf_fieldget(ps_input_grid, &
1472  farrayptr=psptr, rc=rc)
1473  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1474  call error_handler("IN FieldGet", rc)
1475 
1476  allocate(pres_interface(levp1_input))
1477 
1478  if (localpet == 0) then
1479  do k = clb(3), cub(3)
1480  print*,'dpres is ',cub(1),cub(2),k, dpresptr(cub(1),cub(2),k)
1481  enddo
1482  endif
1483 
1484  do i = clb(1), cub(1)
1485  do j = clb(2), cub(2)
1486  pres_interface(levp1_input) = vcoord(levp1_input,1,1)
1487  do k = lev_input, 1, -1
1488  pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
1489  enddo
1490  psptr(i,j) = pres_interface(1)
1491  do k = 1, lev_input
1492  presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
1493  enddo
1494  enddo
1495  enddo
1496 
1497  deallocate(vcoord)
1498 
1499  if (localpet == 0) then
1500  print*,'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2))
1501  print*,'pres is ',clb(1),clb(2),presptr(clb(1),clb(2),:)
1502  endif
1503 
1504  print*,'pres check 1',localpet,maxval(presptr(:,:,1)),minval(presptr(:,:,1))
1505  print*,'pres check lev',localpet,maxval(presptr(:,:,lev_input)),minval(presptr(:,:,lev_input))
1506 
1507  deallocate(pres_interface)
1508 
1509  call esmf_fielddestroy(dpres_input_grid, rc=rc)
1510 
1511  end subroutine read_input_atm_gaussian_nemsio_file
1512 
1521  subroutine read_input_atm_restart_file(localpet)
1522 
1523  implicit none
1524 
1525  integer, intent(in) :: localpet
1526 
1527  character(len=500) :: tilefile
1528 
1529  integer :: i, j, k
1530  integer :: clb(3), cub(3)
1531  integer :: rc, tile, ncid, id_var
1532  integer :: error, id_dim
1533 
1534  real(esmf_kind_r8), allocatable :: ak(:)
1535  real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:)
1536  real(esmf_kind_r8), pointer :: dpresptr(:,:,:)
1537  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
1538  real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:)
1539  real(esmf_kind_r8), allocatable :: pres_interface(:)
1540 
1541 !---------------------------------------------------------------------------
1542 ! Get number of vertical levels and model top pressure.
1543 !---------------------------------------------------------------------------
1544 
1545  tilefile = trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(7))
1546  print*,"- READ ATM VERTICAL LEVELS FROM: ", trim(tilefile)
1547  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1548  call netcdf_err(error, 'opening: '//trim(tilefile) )
1549 
1550  error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim)
1551  call netcdf_err(error, 'reading xaxis_1 id' )
1552  error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input)
1553  call netcdf_err(error, 'reading xaxis_1 value' )
1554 
1555  lev_input = levp1_input - 1
1556 
1557  allocate(ak(levp1_input))
1558 
1559  error=nf90_inq_varid(ncid, 'ak', id_var)
1560  call netcdf_err(error, 'reading field id' )
1561  error=nf90_get_var(ncid, id_var, ak)
1562  call netcdf_err(error, 'reading ak' )
1563 
1564  error = nf90_close(ncid)
1565 
1566 !---------------------------------------------------------------------------
1567 ! Initialize esmf atmospheric fields.
1568 !---------------------------------------------------------------------------
1569 
1570  call init_atm_esmf_fields
1571 
1572  print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE."
1573  dpres_input_grid = esmf_fieldcreate(input_grid, &
1574  typekind=esmf_typekind_r8, &
1575  staggerloc=esmf_staggerloc_center, &
1576  ungriddedlbound=(/1/), &
1577  ungriddedubound=(/lev_input/), rc=rc)
1578  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1579  call error_handler("IN FieldCreate", rc)
1580 
1581  if (localpet < num_tiles_input_grid) then
1582  allocate(data_one_tile_3d(i_input,j_input,lev_input))
1583  allocate(data_one_tile(i_input,j_input))
1584  else
1585  allocate(data_one_tile_3d(0,0,0))
1586  allocate(data_one_tile(0,0))
1587  endif
1588 
1589  if (localpet < num_tiles_input_grid) then
1590  tile = localpet+1
1591  tilefile= trim(data_dir_input_grid) // "/" // trim(atm_core_files_input_grid(tile))
1592  print*,"- READ ATMOSPHERIC CORE FILE: ", trim(tilefile)
1593  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1594  call netcdf_err(error, 'opening: '//trim(tilefile) )
1595  endif
1596 
1597  if (localpet < num_tiles_input_grid) then
1598  error=nf90_inq_varid(ncid, 'phis', id_var)
1599  call netcdf_err(error, 'reading field id' )
1600  error=nf90_get_var(ncid, id_var, data_one_tile)
1601  call netcdf_err(error, 'reading field' )
1602  data_one_tile = data_one_tile / 9.806_8 ! geopotential height
1603  endif
1604 
1605  do tile = 1, num_tiles_input_grid
1606  print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN for tile ",tile
1607  call esmf_fieldscatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
1608  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1609  call error_handler("IN FieldScatter", rc)
1610  enddo
1611 
1612  if (localpet < num_tiles_input_grid) then
1613 ! error=nf90_inq_varid(ncid, 'W', id_var)
1614 ! call netcdf_err(error, 'reading field id' )
1615 ! error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1616 ! call netcdf_err(error, 'reading field' )
1617 ! data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1618 
1619 ! Using 'w' from restart files has caused problems. Set to zero.
1620  data_one_tile_3d = 0.0_8
1621  endif
1622 
1623  do tile = 1, num_tiles_input_grid
1624  print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY for tile ",tile
1625  call esmf_fieldscatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1626  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1627  call error_handler("IN FieldScatter", rc)
1628  enddo
1629 
1630  if (localpet < num_tiles_input_grid) then
1631  error=nf90_inq_varid(ncid, 'T', id_var)
1632  call netcdf_err(error, 'reading field id' )
1633  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1634  call netcdf_err(error, 'reading field' )
1635  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1636  endif
1637 
1638  do tile = 1, num_tiles_input_grid
1639  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
1640  call esmf_fieldscatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1641  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1642  call error_handler("IN FieldScatter", rc)
1643  enddo
1644 
1645  if (localpet < num_tiles_input_grid) then
1646  error=nf90_inq_varid(ncid, 'delp', id_var)
1647  call netcdf_err(error, 'reading field id' )
1648  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1649  call netcdf_err(error, 'reading field' )
1650  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1651  endif
1652 
1653  do tile = 1, num_tiles_input_grid
1654  print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE."
1655  call esmf_fieldscatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1656  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1657  call error_handler("IN FieldScatter", rc)
1658  enddo
1659 
1660  if (localpet < num_tiles_input_grid) then
1661  error=nf90_inq_varid(ncid, 'ua', id_var)
1662  call netcdf_err(error, 'reading field id' )
1663  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1664  call netcdf_err(error, 'reading field' )
1665  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1666  endif
1667 
1668  do tile = 1, num_tiles_input_grid
1669  print*,"- CALL FieldScatter FOR INPUT GRID U."
1670  call esmf_fieldscatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1671  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1672  call error_handler("IN FieldScatter", rc)
1673  enddo
1674 
1675  if (localpet < num_tiles_input_grid) then
1676  error=nf90_inq_varid(ncid, 'va', id_var)
1677  call netcdf_err(error, 'reading field id' )
1678  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1679  call netcdf_err(error, 'reading field' )
1680  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1681  endif
1682 
1683  do tile = 1, num_tiles_input_grid
1684  print*,"- CALL FieldScatter FOR INPUT GRID V."
1685  call esmf_fieldscatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1686  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1687  call error_handler("IN FieldScatter", rc)
1688  enddo
1689 
1690  if (localpet < num_tiles_input_grid) error = nf90_close(ncid)
1691 
1692  if (localpet < num_tiles_input_grid) then
1693  tile = localpet+1
1694  tilefile= trim(data_dir_input_grid) // "/" // trim(atm_tracer_files_input_grid(tile))
1695  print*,"- READ ATMOSPHERIC TRACER FILE: ", trim(tilefile)
1696  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1697  call netcdf_err(error, 'opening: '//trim(tilefile) )
1698  endif
1699 
1700  do i = 1, num_tracers_input
1701 
1702  if (localpet < num_tiles_input_grid) then
1703  error=nf90_inq_varid(ncid, tracers_input(i), id_var)
1704  call netcdf_err(error, 'reading field id' )
1705  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
1706  call netcdf_err(error, 'reading field' )
1707  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
1708  endif
1709 
1710  do tile = 1, num_tiles_input_grid
1711  print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input(i))
1712  call esmf_fieldscatter(tracers_input_grid(i), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
1713  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1714  call error_handler("IN FieldScatter", rc)
1715  enddo
1716 
1717  enddo
1718 
1719  if (localpet < num_tiles_input_grid) error=nf90_close(ncid)
1720 
1721 !---------------------------------------------------------------------------
1722 ! Convert from 2-d to 3-d cartesian winds.
1723 !---------------------------------------------------------------------------
1724 
1725  call convert_winds
1726 
1727 !---------------------------------------------------------------------------
1728 ! Compute pressures
1729 !---------------------------------------------------------------------------
1730 
1731  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
1732  call esmf_fieldget(ps_input_grid, &
1733  farrayptr=psptr, rc=rc)
1734  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1735  call error_handler("IN FieldGet", rc)
1736 
1737  print*,"- CALL FieldGet FOR PRESSURE."
1738  call esmf_fieldget(pres_input_grid, &
1739  computationallbound=clb, &
1740  computationalubound=cub, &
1741  farrayptr=presptr, rc=rc)
1742  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1743  call error_handler("IN FieldGet", rc)
1744 
1745  print*,"- CALL FieldGet FOR DELTA PRESSURE."
1746  call esmf_fieldget(dpres_input_grid, &
1747  farrayptr=dpresptr, rc=rc)
1748  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1749  call error_handler("IN FieldGet", rc)
1750 
1751  allocate(pres_interface(levp1_input))
1752 
1753  do i = clb(1), cub(1)
1754  do j = clb(2), cub(2)
1755  pres_interface(levp1_input) = ak(1) ! model top in Pa
1756  do k = (levp1_input-1), 1, -1
1757  pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
1758  enddo
1759  do k = 1, lev_input
1760  presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
1761  enddo
1762  psptr(i,j) = pres_interface(1)
1763  enddo
1764  enddo
1765 
1766  deallocate(ak)
1767  deallocate(pres_interface)
1768 
1769  call esmf_fielddestroy(dpres_input_grid, rc=rc)
1770 
1771  deallocate(data_one_tile_3d, data_one_tile)
1772 
1773  end subroutine read_input_atm_restart_file
1774 
1780  subroutine read_input_atm_gaussian_netcdf_file(localpet)
1781 
1782  use mpi
1783 
1784  implicit none
1785 
1786  integer, intent(in) :: localpet
1787 
1788  character(len=500) :: tilefile
1789 
1790  integer :: start(3), count(3), iscnt
1791  integer :: error, ncid, num_tracers_file
1792  integer :: id_dim, idim_input, jdim_input
1793  integer :: id_var, rc, nprocs, max_procs
1794  integer :: kdim, remainder, myrank, i, j, k, n
1795  integer :: clb(3), cub(3)
1796  integer, allocatable :: kcount(:), startk(:), displ(:)
1797  integer, allocatable :: ircnt(:)
1798 
1799  real(esmf_kind_r8), allocatable :: phalf(:)
1800  real(esmf_kind_r8), allocatable :: pres_interface(:)
1801  real(kind=4), allocatable :: dummy3d(:,:,:)
1802  real(kind=4), allocatable :: dummy3dall(:,:,:)
1803  real(esmf_kind_r8), allocatable :: dummy3dflip(:,:,:)
1804  real(esmf_kind_r8), allocatable :: dummy(:,:)
1805  real(esmf_kind_r8), pointer :: presptr(:,:,:), dpresptr(:,:,:)
1806  real(esmf_kind_r8), pointer :: psptr(:,:)
1807 
1808  print*,"- READ INPUT ATMOS DATA FROM GAUSSIAN NETCDF FILE."
1809 
1810  tilefile = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1))
1811  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
1812  call netcdf_err(error, 'opening: '//trim(tilefile) )
1813 
1814  error=nf90_inq_dimid(ncid, 'grid_xt', id_dim)
1815  call netcdf_err(error, 'reading grid_xt id' )
1816  error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
1817  call netcdf_err(error, 'reading grid_xt value' )
1818 
1819  error=nf90_inq_dimid(ncid, 'grid_yt', id_dim)
1820  call netcdf_err(error, 'reading grid_yt id' )
1821  error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
1822  call netcdf_err(error, 'reading grid_yt value' )
1823 
1824  if (idim_input /= i_input .or. jdim_input /= j_input) then
1825  call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2)
1826  endif
1827 
1828  error=nf90_inq_dimid(ncid, 'pfull', id_dim)
1829  call netcdf_err(error, 'reading pfull id' )
1830  error=nf90_inquire_dimension(ncid,id_dim,len=lev_input)
1831  call netcdf_err(error, 'reading pfull value' )
1832 
1833  error=nf90_inq_dimid(ncid, 'phalf', id_dim)
1834  call netcdf_err(error, 'reading phalf id' )
1835  error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input)
1836  call netcdf_err(error, 'reading phalf value' )
1837  allocate(phalf(levp1_input))
1838  error=nf90_inq_varid(ncid, 'phalf', id_var)
1839  call netcdf_err(error, 'getting phalf varid' )
1840  error=nf90_get_var(ncid, id_var, phalf)
1841  call netcdf_err(error, 'reading phalf varid' )
1842 
1843  error=nf90_get_att(ncid, nf90_global, 'ncnsto', num_tracers_file)
1844  call netcdf_err(error, 'reading ntracer value' )
1845 
1846  call mpi_comm_size(mpi_comm_world, nprocs, error)
1847  print*,'- Running with ', nprocs, ' processors'
1848 
1849  call mpi_comm_rank(mpi_comm_world, myrank, error)
1850  print*,'- myrank/localpet is ',myrank,localpet
1851 
1852  max_procs = nprocs
1853  if (nprocs > lev_input) then
1854  max_procs = lev_input
1855  endif
1856 
1857  kdim = lev_input / max_procs
1858  remainder = lev_input - (max_procs*kdim)
1859 
1860  allocate(kcount(0:nprocs-1))
1861  kcount=0
1862  allocate(startk(0:nprocs-1))
1863  startk=0
1864  allocate(displ(0:nprocs-1))
1865  displ=0
1866  allocate(ircnt(0:nprocs-1))
1867  ircnt=0
1868 
1869  do k = 0, max_procs-2
1870  kcount(k) = kdim
1871  enddo
1872  kcount(max_procs-1) = kdim + remainder
1873 
1874  startk(0) = 1
1875  do k = 1, max_procs-1
1876  startk(k) = startk(k-1) + kcount(k-1)
1877  enddo
1878 
1879  ircnt(:) = idim_input * jdim_input * kcount(:)
1880 
1881  displ(0) = 0
1882  do k = 1, max_procs-1
1883  displ(k) = displ(k-1) + ircnt(k-1)
1884  enddo
1885 
1886  iscnt=idim_input*jdim_input*kcount(myrank)
1887 
1888 ! Account for case if number of tasks exceeds the number of vert levels.
1889 
1890  if (myrank <= max_procs-1) then
1891  allocate(dummy3d(idim_input,jdim_input,kcount(myrank)))
1892  else
1893  allocate(dummy3d(0,0,0))
1894  endif
1895 
1896  if (myrank == 0) then
1897  allocate(dummy3dall(idim_input,jdim_input,lev_input))
1898  dummy3dall = 0.0
1899  allocate(dummy3dflip(idim_input,jdim_input,lev_input))
1900  dummy3dflip = 0.0
1901  allocate(dummy(idim_input,jdim_input))
1902  dummy = 0.0
1903  else
1904  allocate(dummy3dall(0,0,0))
1905  allocate(dummy3dflip(0,0,0))
1906  allocate(dummy(0,0))
1907  endif
1908 
1909 !---------------------------------------------------------------------------
1910 ! Initialize esmf atmospheric fields.
1911 !---------------------------------------------------------------------------
1912 
1913  call init_atm_esmf_fields
1914 
1915  print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE."
1916  dpres_input_grid = esmf_fieldcreate(input_grid, &
1917  typekind=esmf_typekind_r8, &
1918  staggerloc=esmf_staggerloc_center, &
1919  ungriddedlbound=(/1/), &
1920  ungriddedubound=(/lev_input/), rc=rc)
1921  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1922  call error_handler("IN FieldCreate", rc)
1923 
1924 ! Temperature
1925 
1926  if (myrank <= max_procs-1) then
1927  start = (/1,1,startk(myrank)/)
1928  count = (/idim_input,jdim_input,kcount(myrank)/)
1929  error=nf90_inq_varid(ncid, 'tmp', id_var)
1930  call netcdf_err(error, 'reading tmp field id' )
1931  error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1932  call netcdf_err(error, 'reading tmp field' )
1933  endif
1934 
1935  call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1936  dummy3dall, ircnt, displ, mpi_real, &
1937  0, mpi_comm_world, error)
1938  if (error /= 0) call error_handler("IN mpi_gatherv of temperature", error)
1939 
1940  if (myrank == 0) then
1941  dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1)
1942  endif
1943 
1944  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE "
1945  call esmf_fieldscatter(temp_input_grid, dummy3dflip, rootpet=0, rc=rc)
1946  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1947  call error_handler("IN FieldScatter", rc)
1948 
1949 ! dpres
1950 
1951  if (myrank <= max_procs-1) then
1952  error=nf90_inq_varid(ncid, 'dpres', id_var)
1953  call netcdf_err(error, 'reading dpres field id' )
1954  error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1955  call netcdf_err(error, 'reading dpres field' )
1956  endif
1957 
1958  call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1959  dummy3dall, ircnt, displ, mpi_real, &
1960  0, mpi_comm_world, error)
1961  if (error /= 0) call error_handler("IN mpi_gatherv of dpres", error)
1962 
1963  if (myrank == 0) then
1964  dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1)
1965  endif
1966 
1967  print*,"- CALL FieldScatter FOR INPUT GRID DPRES "
1968  call esmf_fieldscatter(dpres_input_grid, dummy3dflip, rootpet=0, rc=rc)
1969  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1970  call error_handler("IN FieldScatter", rc)
1971 
1972 ! ugrd
1973 
1974  if (myrank <= max_procs-1) then
1975  error=nf90_inq_varid(ncid, 'ugrd', id_var)
1976  call netcdf_err(error, 'reading ugrd field id' )
1977  error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
1978  call netcdf_err(error, 'reading ugrd field' )
1979  endif
1980 
1981  call mpi_gatherv(dummy3d, iscnt, mpi_real, &
1982  dummy3dall, ircnt, displ, mpi_real, &
1983  0, mpi_comm_world, error)
1984  if (error /= 0) call error_handler("IN mpi_gatherv of ugrd", error)
1985 
1986  if (myrank == 0) then
1987  dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1)
1988  endif
1989 
1990  print*,"- CALL FieldScatter FOR INPUT GRID UGRD "
1991  call esmf_fieldscatter(u_input_grid, dummy3dflip, rootpet=0, rc=rc)
1992  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1993  call error_handler("IN FieldScatter", rc)
1994 
1995 ! vgrd
1996 
1997  if (myrank <= max_procs-1) then
1998  error=nf90_inq_varid(ncid, 'vgrd', id_var)
1999  call netcdf_err(error, 'reading vgrd field id' )
2000  error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
2001  call netcdf_err(error, 'reading vgrd field' )
2002  endif
2003 
2004  call mpi_gatherv(dummy3d, iscnt, mpi_real, &
2005  dummy3dall, ircnt, displ, mpi_real, &
2006  0, mpi_comm_world, error)
2007  if (error /= 0) call error_handler("IN mpi_gatherv of vgrd", error)
2008 
2009  if (myrank == 0) then
2010  dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1)
2011  endif
2012 
2013  print*,"- CALL FieldScatter FOR INPUT GRID VGRD "
2014  call esmf_fieldscatter(v_input_grid, dummy3dflip, rootpet=0, rc=rc)
2015  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2016  call error_handler("IN FieldScatter", rc)
2017 
2018 ! tracers
2019 
2020  do n = 1, num_tracers_input
2021 
2022  if (myrank <= max_procs-1) then
2023  error=nf90_inq_varid(ncid, tracers_input(n), id_var)
2024  call netcdf_err(error, 'reading tracer field id' )
2025  error=nf90_get_var(ncid, id_var, dummy3d, start=start, count=count)
2026  call netcdf_err(error, 'reading tracer field' )
2027  endif
2028 
2029  call mpi_gatherv(dummy3d, iscnt, mpi_real, &
2030  dummy3dall, ircnt, displ, mpi_real, &
2031  0, mpi_comm_world, error)
2032  if (error /= 0) call error_handler("IN mpi_gatherv of tracer", error)
2033 
2034  if (myrank == 0) then
2035  dummy3dflip(:,:,1:lev_input) = dummy3dall(:,:,lev_input:1:-1)
2036  where(dummy3dflip < 0.0) dummy3dflip = 0.0
2037  endif
2038 
2039  print*,"- CALL FieldScatter FOR INPUT GRID ", tracers_input(n)
2040  call esmf_fieldscatter(tracers_input_grid(n), dummy3dflip, rootpet=0, rc=rc)
2041  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2042  call error_handler("IN FieldScatter", rc)
2043 
2044  enddo
2045 
2046 ! dzdt set to zero for now.
2047 
2048  if (myrank == 0) then
2049  dummy3dflip = 0.0
2050  endif
2051 
2052  print*,"- CALL FieldScatter FOR INPUT GRID DZDT"
2053  call esmf_fieldscatter(dzdt_input_grid, dummy3dflip, rootpet=0, rc=rc)
2054  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2055  call error_handler("IN FieldScatter", rc)
2056 
2057  deallocate(dummy3dflip, dummy3dall, dummy3d)
2058 
2059 ! terrain
2060 
2061  if (myrank==0) then
2062  print*,"- READ TERRAIN."
2063  error=nf90_inq_varid(ncid, 'hgtsfc', id_var)
2064  call netcdf_err(error, 'reading hgtsfc field id' )
2065  error=nf90_get_var(ncid, id_var, dummy)
2066  call netcdf_err(error, 'reading hgtsfc field' )
2067  endif
2068 
2069  print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN."
2070  call esmf_fieldscatter(terrain_input_grid, dummy, rootpet=0, rc=rc)
2071  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2072  call error_handler("IN FieldScatter", rc)
2073 
2074 ! surface pressure
2075 
2076  if (myrank==0) then
2077  print*,"- READ SURFACE P."
2078  error=nf90_inq_varid(ncid, 'pressfc', id_var)
2079  call netcdf_err(error, 'reading pressfc field id' )
2080  error=nf90_get_var(ncid, id_var, dummy)
2081  call netcdf_err(error, 'reading pressfc field' )
2082  endif
2083 
2084  print*,"- CALL FieldScatter FOR INPUT GRID SURFACE P."
2085  call esmf_fieldscatter(ps_input_grid, dummy, rootpet=0, rc=rc)
2086  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2087  call error_handler("IN FieldScatter", rc)
2088 
2089  deallocate(kcount, startk, displ, ircnt, dummy)
2090 
2091 !---------------------------------------------------------------------------
2092 ! Convert from 2-d to 3-d cartesian winds.
2093 !---------------------------------------------------------------------------
2094 
2095  call convert_winds
2096 
2097 !---------------------------------------------------------------------------
2098 ! Compute pressure.
2099 !---------------------------------------------------------------------------
2100 
2101  print*,"- CALL FieldGet FOR PRESSURE."
2102  call esmf_fieldget(pres_input_grid, &
2103  computationallbound=clb, &
2104  computationalubound=cub, &
2105  farrayptr=presptr, rc=rc)
2106  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2107  call error_handler("IN FieldGet", rc)
2108 
2109  print*,"- CALL FieldGet FOR DELTA PRESSURE."
2110  call esmf_fieldget(dpres_input_grid, &
2111  farrayptr=dpresptr, rc=rc)
2112  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2113  call error_handler("IN FieldGet", rc)
2114 
2115  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
2116  call esmf_fieldget(ps_input_grid, &
2117  farrayptr=psptr, rc=rc)
2118  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2119  call error_handler("IN FieldGet", rc)
2120 
2121  allocate(pres_interface(levp1_input))
2122 
2123 !---------------------------------------------------------------------------
2124 ! Compute 3-d pressure.
2125 !---------------------------------------------------------------------------
2126 
2127 !---------------------------------------------------------------------------
2128 ! When ingesting gaussian netcdf files, the mid-layer
2129 ! surface pressure are computed top down from delta-p
2130 ! The surface pressure in the file is not used. According
2131 ! to Jun Wang, after the model's write component interpolates from the
2132 ! cubed-sphere grid to the gaussian grid, the surface pressure is
2133 ! no longer consistent with the delta p.
2134 !---------------------------------------------------------------------------
2135 
2136  do i = clb(1), cub(1)
2137  do j = clb(2), cub(2)
2138  pres_interface(levp1_input) = phalf(1) * 100.0_8
2139  do k = lev_input, 1, -1
2140  pres_interface(k) = pres_interface(k+1) + dpresptr(i,j,k)
2141  enddo
2142  psptr(i,j) = pres_interface(1)
2143  do k = 1, lev_input
2144  presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
2145  enddo
2146  enddo
2147  enddo
2148 
2149  deallocate(pres_interface, phalf)
2150 
2151  call esmf_fielddestroy(dpres_input_grid, rc=rc)
2152 
2153  end subroutine read_input_atm_gaussian_netcdf_file
2154 
2164  subroutine read_input_atm_tiled_history_file(localpet)
2165 
2166  use mpi
2167 
2168  implicit none
2169 
2170  integer, intent(in) :: localpet
2171 
2172  character(len=500) :: tilefile
2173 
2174  integer :: error, ncid, rc, tile
2175  integer :: id_dim, idim_input, jdim_input
2176  integer :: id_var, i, j, k, n
2177  integer :: clb(3), cub(3), num_tracers_file
2178 
2179  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
2180  real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:)
2181  real(esmf_kind_r8), pointer :: presptr(:,:,:), dpresptr(:,:,:)
2182  real(esmf_kind_r8), pointer :: psptr(:,:)
2183  real(esmf_kind_r8), allocatable :: pres_interface(:), phalf(:)
2184 
2185  print*,"- READ INPUT ATMOS DATA FROM TILED HISTORY FILES."
2186 
2187  tilefile = trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(1))
2188  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
2189  call netcdf_err(error, 'opening: '//trim(tilefile) )
2190 
2191  error=nf90_inq_dimid(ncid, 'grid_xt', id_dim)
2192  call netcdf_err(error, 'reading grid_xt id' )
2193  error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
2194  call netcdf_err(error, 'reading grid_xt value' )
2195 
2196  error=nf90_inq_dimid(ncid, 'grid_yt', id_dim)
2197  call netcdf_err(error, 'reading grid_yt id' )
2198  error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
2199  call netcdf_err(error, 'reading grid_yt value' )
2200 
2201  if (idim_input /= i_input .or. jdim_input /= j_input) then
2202  call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 2)
2203  endif
2204 
2205  error=nf90_inq_dimid(ncid, 'pfull', id_dim)
2206  call netcdf_err(error, 'reading pfull id' )
2207  error=nf90_inquire_dimension(ncid,id_dim,len=lev_input)
2208  call netcdf_err(error, 'reading pfull value' )
2209 
2210  error=nf90_inq_dimid(ncid, 'phalf', id_dim)
2211  call netcdf_err(error, 'reading phalf id' )
2212  error=nf90_inquire_dimension(ncid,id_dim,len=levp1_input)
2213  call netcdf_err(error, 'reading phalf value' )
2214  allocate(phalf(levp1_input))
2215  error=nf90_inq_varid(ncid, 'phalf', id_var)
2216  call netcdf_err(error, 'getting phalf varid' )
2217  error=nf90_get_var(ncid, id_var, phalf)
2218  call netcdf_err(error, 'reading phalf varid' )
2219 
2220  error=nf90_get_att(ncid, nf90_global, 'ncnsto', num_tracers_file)
2221  call netcdf_err(error, 'reading ntracer value' )
2222 
2223  error = nf90_close(ncid)
2224 
2225  print*,'- FILE HAS ', num_tracers_file, ' TRACERS.'
2226  print*,'- WILL PROCESS ', num_tracers_input, ' TRACERS.'
2227 
2228 !---------------------------------------------------------------------------
2229 ! Initialize esmf atmospheric fields.
2230 !---------------------------------------------------------------------------
2231 
2232  call init_atm_esmf_fields
2233 
2234  print*,"- CALL FieldCreate FOR INPUT GRID DELTA PRESSURE."
2235  dpres_input_grid = esmf_fieldcreate(input_grid, &
2236  typekind=esmf_typekind_r8, &
2237  staggerloc=esmf_staggerloc_center, &
2238  ungriddedlbound=(/1/), &
2239  ungriddedubound=(/lev_input/), rc=rc)
2240  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2241  call error_handler("IN FieldCreate", rc)
2242 
2243  if (localpet < num_tiles_input_grid) then
2244  allocate(data_one_tile(i_input,j_input))
2245  allocate(data_one_tile_3d(i_input,j_input,lev_input))
2246  else
2247  allocate(data_one_tile(0,0))
2248  allocate(data_one_tile_3d(0,0,0))
2249  endif
2250 
2251  if (localpet < num_tiles_input_grid) then
2252  tile = localpet+1
2253  tilefile= trim(data_dir_input_grid) // "/" // trim(atm_files_input_grid(tile))
2254  print*,"- READ ATMOSPHERIC DATA FROM: ", trim(tilefile)
2255  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
2256  call netcdf_err(error, 'opening: '//trim(tilefile) )
2257  endif
2258 
2259  if (localpet < num_tiles_input_grid) then
2260 ! print*,"- READ VERTICAL VELOCITY."
2261 ! error=nf90_inq_varid(ncid, 'dzdt', id_var)
2262 ! call netcdf_err(error, 'reading field id' )
2263 ! error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2264 ! call netcdf_err(error, 'reading field' )
2265 ! data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2266 
2267 ! Using w from the tiled history files has caused problems.
2268 ! Set to zero.
2269  data_one_tile_3d = 0.0_8
2270  endif
2271 
2272  do tile = 1, num_tiles_input_grid
2273  print*,"- CALL FieldScatter FOR INPUT GRID VERTICAL VELOCITY."
2274  call esmf_fieldscatter(dzdt_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2275  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2276  call error_handler("IN FieldScatter", rc)
2277  enddo
2278 
2279  do n = 1, num_tracers_input
2280 
2281  if (localpet < num_tiles_input_grid) then
2282  print*,"- READ ", trim(tracers_input(n))
2283  error=nf90_inq_varid(ncid, tracers_input(n), id_var)
2284  call netcdf_err(error, 'reading field id' )
2285  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2286  call netcdf_err(error, 'reading field' )
2287  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2288  endif
2289 
2290  do tile = 1, num_tiles_input_grid
2291  print*,"- CALL FieldScatter FOR INPUT GRID TRACER ", trim(tracers_input(n))
2292  call esmf_fieldscatter(tracers_input_grid(n), data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2293  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2294  call error_handler("IN FieldScatter", rc)
2295  enddo
2296 
2297  enddo
2298 
2299  if (localpet < num_tiles_input_grid) then
2300  print*,"- READ TEMPERATURE."
2301  error=nf90_inq_varid(ncid, 'tmp', id_var)
2302  call netcdf_err(error, 'reading field id' )
2303  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2304  call netcdf_err(error, 'reading field' )
2305  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2306  endif
2307 
2308  do tile = 1, num_tiles_input_grid
2309  print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
2310  call esmf_fieldscatter(temp_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2311  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2312  call error_handler("IN FieldScatter", rc)
2313  enddo
2314 
2315  if (localpet < num_tiles_input_grid) then
2316  print*,"- READ U-WIND."
2317  error=nf90_inq_varid(ncid, 'ugrd', id_var)
2318  call netcdf_err(error, 'reading field id' )
2319  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2320  call netcdf_err(error, 'reading field' )
2321  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2322  endif
2323 
2324  do tile = 1, num_tiles_input_grid
2325  print*,"- CALL FieldScatter FOR INPUT GRID U."
2326  call esmf_fieldscatter(u_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2327  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2328  call error_handler("IN FieldScatter", rc)
2329  enddo
2330 
2331  if (localpet < num_tiles_input_grid) then
2332  print*,"- READ V-WIND."
2333  error=nf90_inq_varid(ncid, 'vgrd', id_var)
2334  call netcdf_err(error, 'reading field id' )
2335  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2336  call netcdf_err(error, 'reading field' )
2337  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2338  endif
2339 
2340  do tile = 1, num_tiles_input_grid
2341  print*,"- CALL FieldScatter FOR INPUT GRID V."
2342  call esmf_fieldscatter(v_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2343  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2344  call error_handler("IN FieldScatter", rc)
2345  enddo
2346 
2347  if (localpet < num_tiles_input_grid) then
2348  print*,"- READ SURFACE PRESSURE."
2349  error=nf90_inq_varid(ncid, 'pressfc', id_var)
2350  call netcdf_err(error, 'reading field id' )
2351  error=nf90_get_var(ncid, id_var, data_one_tile)
2352  call netcdf_err(error, 'reading field' )
2353  endif
2354 
2355  do tile = 1, num_tiles_input_grid
2356  print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE."
2357  call esmf_fieldscatter(ps_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
2358  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2359  call error_handler("IN FieldScatter", rc)
2360  enddo
2361 
2362  if (localpet < num_tiles_input_grid) then
2363  print*,"- READ TERRAIN."
2364  error=nf90_inq_varid(ncid, 'hgtsfc', id_var)
2365  call netcdf_err(error, 'reading field id' )
2366  error=nf90_get_var(ncid, id_var, data_one_tile)
2367  call netcdf_err(error, 'reading field' )
2368  endif
2369 
2370  do tile = 1, num_tiles_input_grid
2371  print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN."
2372  call esmf_fieldscatter(terrain_input_grid, data_one_tile, rootpet=tile-1, tile=tile, rc=rc)
2373  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2374  call error_handler("IN FieldScatter", rc)
2375  enddo
2376 
2377  if (localpet < num_tiles_input_grid) then
2378  print*,"- READ DELTA PRESSURE."
2379  error=nf90_inq_varid(ncid, 'dpres', id_var)
2380  call netcdf_err(error, 'reading field id' )
2381  error=nf90_get_var(ncid, id_var, data_one_tile_3d)
2382  call netcdf_err(error, 'reading field' )
2383  data_one_tile_3d(:,:,1:lev_input) = data_one_tile_3d(:,:,lev_input:1:-1)
2384  endif
2385 
2386  do tile = 1, num_tiles_input_grid
2387  print*,"- CALL FieldScatter FOR INPUT DELTA PRESSURE."
2388  call esmf_fieldscatter(dpres_input_grid, data_one_tile_3d, rootpet=tile-1, tile=tile, rc=rc)
2389  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2390  call error_handler("IN FieldScatter", rc)
2391  enddo
2392 
2393  if (localpet < num_tiles_input_grid) error = nf90_close(ncid)
2394 
2395  deallocate(data_one_tile_3d, data_one_tile)
2396 
2397 !---------------------------------------------------------------------------
2398 ! Convert from 2-d to 3-d cartesian winds.
2399 !---------------------------------------------------------------------------
2400 
2401  call convert_winds
2402 
2403 !---------------------------------------------------------------------------
2404 ! Compute pressure.
2405 !---------------------------------------------------------------------------
2406 
2407  print*,"- CALL FieldGet FOR PRESSURE."
2408  call esmf_fieldget(pres_input_grid, &
2409  computationallbound=clb, &
2410  computationalubound=cub, &
2411  farrayptr=presptr, rc=rc)
2412  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2413  call error_handler("IN FieldGet", rc)
2414 
2415  print*,"- CALL FieldGet FOR DELTA PRESSURE."
2416  call esmf_fieldget(dpres_input_grid, &
2417  farrayptr=dpresptr, rc=rc)
2418  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2419  call error_handler("IN FieldGet", rc)
2420 
2421  print*,"- CALL FieldGet FOR SURFACE PRESSURE."
2422  call esmf_fieldget(ps_input_grid, &
2423  farrayptr=psptr, rc=rc)
2424  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2425  call error_handler("IN FieldGet", rc)
2426 
2427  allocate(pres_interface(levp1_input))
2428 
2429 !---------------------------------------------------------------------------
2430 ! Compute 3-d pressure.
2431 !---------------------------------------------------------------------------
2432 
2433  do i = clb(1), cub(1)
2434  do j = clb(2), cub(2)
2435  pres_interface(1) = psptr(i,j)
2436  do k = 2, levp1_input
2437  pres_interface(k) = pres_interface(k-1) - dpresptr(i,j,k-1)
2438  enddo
2439  do k = 1, lev_input
2440  presptr(i,j,k) = (pres_interface(k) + pres_interface(k+1)) / 2.0_8
2441  enddo
2442  enddo
2443  enddo
2444 
2445  deallocate(pres_interface, phalf)
2446 
2447  call esmf_fielddestroy(dpres_input_grid, rc=rc)
2448 
2449  end subroutine read_input_atm_tiled_history_file
2450 
2455  subroutine read_input_atm_grib2_file(localpet)
2456 
2457  use mpi
2458  use grib_mod
2459 
2460  use grib2_util, only : rh2spfh, rh2spfh_gfs, convert_omega
2461 
2462  implicit none
2463 
2464  integer, intent(in) :: localpet
2465 
2466  integer, parameter :: ntrac_max=14
2467  integer, parameter :: max_levs=1000
2468 
2469  character(len=300) :: the_file
2470  character(len=20) :: vname, &
2471  trac_names_vmap(ntrac_max), &
2472  tmpstr, &
2473  method, tracers_input_vmap(num_tracers_input), &
2474  tracers_default(ntrac_max)
2475 
2476  integer :: i, j, k, n
2477  integer :: ii,jj
2478  integer :: rc, clb(3), cub(3)
2479  integer :: vlev, iret,varnum, o3n, pdt_num
2480  integer :: intrp_ier, done_print
2481  integer :: trac_names_oct10(ntrac_max)
2482  integer :: tracers_input_oct10(num_tracers_input)
2483  integer :: trac_names_oct11(ntrac_max)
2484  integer :: tracers_input_oct11(num_tracers_input)
2485  integer :: lugb, lugi, jdisc, jpdt(200), jgdt(200), iscale
2486  integer :: jids(200), jpdtn, jgdtn, octet_23, octet_29
2487  integer :: count_spfh, count_rh, count_icmr, count_scliwc
2488  integer :: count_cice, count_rwmr, count_scllwc, count
2489 
2490  logical :: conv_omega=.false., &
2491  hasspfh=.true., &
2492  isnative=.false., &
2493  use_rh=.false. , unpack, &
2494  all_empty, is_missing
2495 
2496  real(esmf_kind_r8), allocatable :: dum2d_1(:,:)
2497 
2498 
2499  real(esmf_kind_r8) :: rlevs_hold(max_levs)
2500  real(esmf_kind_r8), allocatable :: rlevs(:)
2501  real(esmf_kind_r4), allocatable :: dummy2d(:,:)
2502  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:), dummy2d_8(:,:),&
2503  u_tmp_3d(:,:,:), v_tmp_3d(:,:,:)
2504  real(esmf_kind_r8), pointer :: presptr(:,:,:), psptr(:,:),tptr(:,:,:), &
2505  qptr(:,:,:), wptr(:,:,:), &
2506  uptr(:,:,:), vptr(:,:,:)
2507  real(esmf_kind_r4) :: value
2508  real(esmf_kind_r8), parameter :: p0 = 100000.0
2509  real(esmf_kind_r8), allocatable :: dummy3d_col_in(:),dummy3d_col_out(:)
2510  real(esmf_kind_r8), parameter :: intrp_missing = -999.0
2511  real(esmf_kind_r4), parameter :: lev_no_tr_fill = 20000.0
2512  real(esmf_kind_r4), parameter :: lev_no_o3_fill = 40000.0
2513 
2514  type(gribfield) :: gfld
2515 
2516  tracers(:) = "NULL"
2517 
2518  trac_names_oct10 = (/1, 1, 14, 1, 1, 1, 1, 6, 6, 1, 6, 13, 13, 2 /)
2519  trac_names_oct11 = (/0, 22, 192, 23, 24, 25, 32, 1, 29, 100, 28, 193, 192, 2 /)
2520 
2521  trac_names_vmap = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", &
2522  "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", &
2523  "rain_nc ", "water_nc", "liq_aero", "ice_aero", &
2524  "sgs_tke "/)
2525 
2526  tracers_default = (/"sphum ", "liq_wat ", "o3mr ", "ice_wat ", &
2527  "rainwat ", "snowwat ", "graupel ", "cld_amt ", "ice_nc ", &
2528  "rain_nc ", "water_nc", "liq_aero", "ice_aero", &
2529  "sgs_tke "/)
2530 
2531  the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid)
2532 
2533  print*,"- READ ATMOS DATA FROM GRIB2 FILE: ", trim(the_file)
2534 
2535  if (localpet == 0) then
2536 
2537  lugb=14
2538  lugi=0
2539  call baopenr(lugb,the_file,iret)
2540  if (iret /= 0) call error_handler("ERROR OPENING GRIB2 FILE.", iret)
2541 
2542  jdisc = 0 ! Search for discipline - meteorological products
2543  j = 0 ! Search at beginning of file.
2544  jpdt = -9999 ! Array of values in product definition template, set to wildcard
2545  jids = -9999 ! Array of values in identification section, set to wildcard
2546  jgdt = -9999 ! Array of values in grid definition template, set to wildcard
2547  jgdtn = -1 ! Search for any grid definition number.
2548  jpdtn = -1 ! Search for any product definition template number.
2549  unpack =.false.
2550 
2551  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2552  unpack, k, gfld, iret)
2553 
2554 !----------------------------------------------------------------------
2555 ! Read first record and check if this is NCEP GEFS data.
2556 ! This will determine what product definition template number to
2557 ! search for (Section 4/Octets 8-9).
2558 !
2559 ! Section 1/Octets 6-7 is '7' (NCEP)
2560 ! Section 1/Octets 8-9 is '2' (NCEP Ensemble products).
2561 !----------------------------------------------------------------------
2562 
2563  if (iret == 0) then
2564  if (gfld%idsect(1) == 7 .and. gfld%idsect(2) == 2) then
2565  print*,'- THIS IS NCEP GEFS DATA.'
2566  pdt_num = 1 ! Search for product definition template number 1.
2567  ! Individual ensember forecast.
2568  else
2569  pdt_num = 0 ! Search for product definition template number 0.
2570  ! Analysis or forecast.
2571  endif
2572  else
2573  call error_handler("READING GRIB2 FILE", iret)
2574  endif
2575 
2576 !----------------------------------------------------------------------
2577 ! First, check for the vertical coordinate. If temperture at the 10 hybrid
2578 ! level is found, hybrid coordinates are assumed. Otherwise, data is on
2579 ! isobaric levels.
2580 !----------------------------------------------------------------------
2581 
2582  j = 0
2583  jpdtn = pdt_num ! Search for the specific product definition template number.
2584  jpdt(1) = 0 ! Sect4/oct 10 - Parameter category - temperature field
2585  jpdt(2) = 0 ! Sect4/oct 11 - Parameter number - temperature
2586  jpdt(10) = 105 ! Sect4/oct 23 - Type of level - hybrid
2587  jpdt(12) = 10 ! Sect4/octs 25/28 - Value of hybrid level
2588  unpack=.false.
2589 
2590  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2591  unpack, k, gfld, iret)
2592 
2593  if (iret == 0) then
2594  print*,'- DATA IS ON HYBRID LEVELS.'
2595  octet_23 = 105 ! Section 4/Oct 23 - type of first fixed surface.
2596  octet_29 = 255 ! Section 4/Oct 29 - type of second fixed surface (N/A).
2597  isnative=.true.
2598  else
2599  print*,'- DATA IS ON ISOBARIC LEVELS.'
2600  octet_23 = 100 ! Section 4/Oct 23 - type of first fixed surface.
2601  octet_29 = 255 ! Section 4/Oct 29 - type of second fixed surface (N/A).
2602  isnative=.false.
2603  endif
2604 
2605 ! Now count the number of vertical levels by searching for u-wind.
2606 ! Store the value of each level.
2607 
2608  rlevs_hold = -999.9
2609  lev_input = 0
2610  iret = 0
2611  j = 0
2612  jpdtn = -1
2613  jpdt = -9999
2614 
2615  do
2616  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2617  unpack, k, gfld, iret)
2618 
2619  if (iret /= 0) exit
2620 
2621  if (gfld%discipline == 0) then ! Discipline - meteorological products
2622  if (gfld%ipdtnum == pdt_num) then ! Product definition template number.
2623  if (gfld%ipdtmpl(1) == 2 .and. gfld%ipdtmpl(2) == 2) then ! u-wind
2624  ! Sect4/octs 10 and 11.
2625  if (gfld%ipdtmpl(10) == octet_23 .and. gfld%ipdtmpl(13) == octet_29) then
2626  ! Sect4 octs 23 and 29.
2627  ! Hybrid or isobaric.
2628  lev_input = lev_input + 1
2629  iscale = 10 ** gfld%ipdtmpl(11)
2630  rlevs_hold(lev_input) = float(gfld%ipdtmpl(12))/float(iscale)
2631  endif
2632  endif
2633  endif
2634  endif
2635 
2636  j = k
2637  enddo
2638 
2639  endif ! read file on task 0.
2640 
2641  call mpi_barrier(mpi_comm_world, iret)
2642  call mpi_bcast(isnative,1,mpi_logical,0,mpi_comm_world,iret)
2643  call mpi_bcast(lev_input,1,mpi_integer,0,mpi_comm_world,iret)
2644  call mpi_bcast(pdt_num,1,mpi_integer,0,mpi_comm_world,iret)
2645  call mpi_bcast(rlevs_hold, max_levs, mpi_integer,0,mpi_comm_world,iret)
2646 
2647  allocate(slevs(lev_input))
2648  allocate(rlevs(lev_input))
2649  allocate(dummy3d_col_in(lev_input))
2650  allocate(dummy3d_col_out(lev_input))
2651 
2652  levp1_input = lev_input + 1
2653 
2654 ! Jili Dong add sort to re-order isobaric levels.
2655 
2656  do i = 1, lev_input
2657  rlevs(i) = rlevs_hold(i)
2658  enddo
2659 
2660  call quicksort(rlevs,1,lev_input)
2661 
2662  do i = 1, lev_input
2663  if (isnative) then
2664  write(slevs(i), '(i6)') nint(rlevs(i))
2665  slevs(i) = trim(slevs(i)) // " hybrid"
2666  else
2667  write(slevs(i), '(f11.2)') rlevs(i)
2668  slevs(i) = trim(slevs(i)) // " Pa"
2669  endif
2670  enddo
2671 
2672  if(localpet == 0) then
2673  do i = 1,lev_input
2674  print*, "- LEVEL AFTER SORT = ",trim(slevs(i))
2675  enddo
2676  endif
2677 
2678 ! Check to see if specfic humidity exists at all the same levels as ugrd.
2679 
2680  if (localpet == 0) then
2681 
2682  jpdtn = pdt_num ! Product definition template number.
2683  jpdt = -9999
2684  jpdt(1) = 1 ! Sect4/oct 10 - Parameter category - moisture
2685  jpdt(2) = 0 ! Sect4/oct 11 - Parameter number - specific humidity
2686  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level.
2687  unpack=.false.
2688 
2689  count_spfh=0
2690 
2691  do vlev = 1, lev_input
2692  j = 0
2693  jpdt(12) = nint(rlevs(vlev))
2694 
2695  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2696  unpack, k, gfld, iret)
2697 
2698  if (iret == 0) then
2699  count_spfh = count_spfh + 1
2700  endif
2701  enddo
2702 
2703  jpdt(1) = 1 ! Sec4/oct 10 - Parameter category - moisture
2704  jpdt(2) = 1 ! Sec4/oct 11 - Parameter number - rel humidity
2705  count_rh=0
2706 
2707  do vlev = 1, lev_input
2708  j = 0
2709  jpdt(12) = nint(rlevs(vlev))
2710 
2711  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2712  unpack, k, gfld, iret)
2713 
2714  if (iret == 0) then
2715  count_rh = count_rh + 1
2716  endif
2717  enddo
2718 
2719  if (count_spfh /= lev_input) then
2720  use_rh = .true.
2721  endif
2722 
2723  if (count_spfh == 0 .or. use_rh) then
2724  if (count_rh == 0) then
2725  call error_handler("READING ATMOSPHERIC WATER VAPOR VARIABLE.", 2)
2726  endif
2727  hasspfh = .false. ! Will read rh and convert to specific humidity.
2728  trac_names_oct10(1) = 1
2729  trac_names_oct11(1) = 1
2730  print*,"- FILE CONTAINS RH."
2731  else
2732  print*,"- FILE CONTAINS SPFH."
2733  endif
2734 
2735  endif
2736 
2737  call mpi_barrier(mpi_comm_world, rc)
2738  call mpi_bcast(hasspfh,1,mpi_logical,0,mpi_comm_world,rc)
2739 
2740 ! Search for and count the number of tracers in the file.
2741 
2742  if (localpet == 0) then
2743 
2744  jpdtn = pdt_num ! Product definition template number.
2745  jpdt = -9999
2746  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level.
2747  unpack=.false.
2748 
2749  count_icmr=0
2750  count_scliwc=0
2751  count_cice=0
2752  count_rwmr=0
2753  count_scllwc=0
2754 
2755  do vlev = 1, lev_input
2756 
2757  j = 0
2758  jpdt(1) = 1 ! Sect4/oct 10 - Parameter category - moisture
2759  jpdt(2) = 23 ! Sect4/oct 11 - Parameter number - ice water mixing ratio
2760  jpdt(12) = nint(rlevs(vlev))
2761 
2762  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2763  unpack, k, gfld, iret)
2764 
2765  if (iret == 0) then
2766  count_icmr = count_icmr + 1
2767  endif
2768 
2769  j = 0
2770  jpdt(1) = 1 ! Sect4/oct 10 - Parameter category - moisture
2771  jpdt(2) = 84 ! Sect4/oct 11 - Parameter number - cloud ice water content.
2772  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2773  unpack, k, gfld, iret)
2774 
2775  if (iret == 0) then
2776  count_scliwc = count_scliwc + 1
2777  endif
2778 
2779  j = 0
2780  jpdt(1) = 6 ! Sect4/oct 10 - Parameter category - clouds
2781  jpdt(2) = 0 ! Sect4/oct 11 - Parameter number - cloud ice
2782  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2783  unpack, k, gfld, iret)
2784 
2785  if (iret == 0) then
2786  count_cice = count_cice + 1
2787  endif
2788 
2789  j = 0
2790  jpdt(1) = 1 ! Sect4/oct 10 - Parameter category - moisture
2791  jpdt(2) = 24 ! Sect4/oct 11 - Parameter number - rain mixing ratio
2792  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2793  unpack, k, gfld, iret)
2794 
2795  if (iret == 0) then
2796  count_rwmr = count_rwmr + 1
2797  endif
2798 
2799  j = 0
2800  jpdt(1) = 1 ! Sect4/oct 10 - Parameter category - moisture
2801  jpdt(2) = 83 ! Sect4/oct 11 - Parameter number - specific cloud liquid
2802  ! water content.
2803  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2804  unpack, k, gfld, iret)
2805 
2806  if (iret == 0) then
2807  count_scllwc = count_scllwc + 1
2808  endif
2809 
2810  enddo
2811 
2812  if (count_icmr == 0) then
2813  if (count_scliwc == 0) then
2814  if (count_cice == 0) then
2815  print*,'- FILE DOES NOT CONTAIN CICE.'
2816  else
2817  trac_names_oct10(4) = 6 ! Sect4/oct 10 - Parameter category - clouds
2818  trac_names_oct11(4) = 0 ! Sect4/oct 11 - Parameter number - cloud ice
2819  print*,"- FILE CONTAINS CICE."
2820  endif
2821  else
2822  trac_names_oct10(4) = 1 ! Sect4/oct 10 - Parameter category - moisture
2823  trac_names_oct11(4) = 84 ! Sect4/oct 11 - Parameter number - cloud ice water content.
2824  print*,"- FILE CONTAINS SCLIWC."
2825  endif
2826  else
2827  print*,"- FILE CONTAINS ICMR."
2828  endif ! count of icmr
2829 
2830  if (count_rwmr == 0) then
2831  if (count_scllwc == 0) then
2832  print*,"- FILE DOES NOT CONTAIN SCLLWC."
2833  else
2834  trac_names_oct10(4) = 1 ! Sect4/oct 10 - Parameter category - moisture
2835  trac_names_oct11(4) = 83 ! Sect4/oct 11 - Parameter number - specific cloud liquid
2836  ! water content.
2837  print*,"- FILE CONTAINS SCLLWC."
2838  endif
2839  else
2840  print*,"- FILE CONTAINS CLWMR."
2841  endif
2842 
2843  endif ! count of tracers/localpet = 0
2844 
2845  call mpi_barrier(mpi_comm_world, rc)
2846  call mpi_bcast(trac_names_oct10,ntrac_max,mpi_integer,0,mpi_comm_world,rc)
2847  call mpi_bcast(trac_names_oct11,ntrac_max,mpi_integer,0,mpi_comm_world,rc)
2848 
2849  print*,"- COUNT NUMBER OF TRACERS TO BE READ IN BASED ON PHYSICS SUITE TABLE"
2850  do n = 1, num_tracers_input
2851 
2852  vname = tracers_input(n)
2853 
2854  i = maxloc(merge(1.,0.,trac_names_vmap == vname),dim=1)
2855 
2856  tracers_input_vmap(n)=trac_names_vmap(i)
2857  tracers(n)=tracers_default(i)
2858  if(trim(tracers(n)) .eq. "o3mr") o3n = n
2859 
2860  tracers_input_oct10(n) = trac_names_oct10(i)
2861  tracers_input_oct11(n) = trac_names_oct11(i)
2862 
2863  enddo
2864 
2865 !---------------------------------------------------------------------------
2866 ! Initialize esmf atmospheric fields.
2867 !---------------------------------------------------------------------------
2868 
2869  call init_atm_esmf_fields
2870 
2871  if (localpet == 0) then
2872  allocate(dummy2d(i_input,j_input))
2873  allocate(dummy2d_8(i_input,j_input))
2874  allocate(dummy3d(i_input,j_input,lev_input))
2875  allocate(dum2d_1(i_input,j_input))
2876  else
2877  allocate(dummy2d(0,0))
2878  allocate(dummy2d_8(0,0))
2879  allocate(dummy3d(0,0,0))
2880  allocate(dum2d_1(0,0))
2881  endif
2882 
2883 !----------------------------------------------------------------------------------
2884 ! This program expects field levels from bottom to top. Fields in non-native
2885 ! files read in from top to bottom. We will flip indices later. Fields on
2886 ! native vertical coordinates read from bottom to top so those need no adjustments.
2887 !----------------------------------------------------------------------------------
2888 
2889  if (localpet == 0) then
2890 
2891  print*,"- READ TEMPERATURE."
2892 
2893  jdisc = 0 ! search for discipline - meteorological products
2894  j = 0 ! search at beginning of file.
2895  jpdt = -9999 ! array of values in product definition template, set to wildcard
2896  jids = -9999 ! array of values in identification section, set to wildcard
2897  jgdt = -9999 ! array of values in grid definition template, set to wildcard
2898  jgdtn = -1 ! search for any grid definition number.
2899  jpdtn = pdt_num ! Search for specific product definition template number.
2900  jpdt(1) = 0 ! Sect 4/oct 10 - parameter category - temperature
2901  jpdt(2) = 0 ! Sect 4/oct 11 - parameter number - temperature
2902  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level.
2903 
2904  unpack=.true.
2905 
2906  do vlev = 1, lev_input
2907 
2908  jpdt(12) = nint(rlevs(vlev))
2909 
2910  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2911  unpack, k, gfld, iret)
2912  if (iret /= 0) then
2913  call error_handler("READING IN TEMPERATURE AT LEVEL "//trim(slevs(vlev)),iret)
2914  endif
2915 
2916  dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) )
2917 
2918  dummy3d(:,:,vlev) = dum2d_1
2919 
2920  enddo
2921 
2922  endif ! Read of temperature
2923 
2924  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TEMPERATURE."
2925  call esmf_fieldscatter(temp_input_grid, dummy3d, rootpet=0, rc=rc)
2926  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2927  call error_handler("IN FieldScatter", rc)
2928 
2929 ! Read tracers
2930 
2931  do n = 1, num_tracers_input
2932 
2933  if (localpet == 0) print*,"- READ ", trim(tracers_input_vmap(n))
2934 
2935  vname = tracers_input_vmap(n)
2936  call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, &
2937  this_field_var_name=tmpstr,loc=varnum)
2938 
2939  if (n==1 .and. .not. hasspfh) then
2940  print*,"- CALL FieldGather TEMPERATURE."
2941  call esmf_fieldgather(temp_input_grid,dummy3d,rootpet=0, tile=1, rc=rc)
2942  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2943  call error_handler("IN FieldGet", rc)
2944  endif
2945 
2946  if (localpet == 0) then
2947 
2948  jdisc = 0 ! search for discipline - meteorological products
2949  jpdt = -9999 ! array of values in product definition template, set to wildcard
2950  jids = -9999 ! array of values in identification section, set to wildcard
2951  jgdt = -9999 ! array of values in grid definition template, set to wildcard
2952  jgdtn = -1 ! search for any grid definition number.
2953  jpdtn = pdt_num ! Search for the product definition template number.
2954  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level.
2955  unpack = .false.
2956 
2957  count = 0
2958 
2959  do vlev = 1, lev_input
2960 
2961  j = 0
2962  jpdt(1) = tracers_input_oct10(n)
2963  jpdt(2) = tracers_input_oct11(n)
2964  jpdt(12) = nint(rlevs(vlev))
2965 
2966  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2967  unpack, k, gfld, iret)
2968 
2969  if (iret == 0) then
2970  count = count + 1
2971  endif
2972 
2973  enddo
2974  iret=count
2975 
2976  ! Check to see if file has any data for this tracer
2977  if (iret == 0) then
2978  all_empty = .true.
2979  else
2980  all_empty = .false.
2981  endif
2982 
2983  is_missing = .false.
2984 
2985  do vlev = 1, lev_input
2986 
2987  unpack=.true.
2988  j = 0
2989  jpdt(1) = tracers_input_oct10(n)
2990  jpdt(2) = tracers_input_oct11(n)
2991  jpdt(12) = nint(rlevs(vlev) )
2992 
2993  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
2994  unpack, k, gfld, iret)
2995 
2996  if (iret == 0) then ! found data
2997  dummy2d = reshape(gfld%fld, (/i_input,j_input/) )
2998  else ! did not find data.
2999  if (trim(method) .eq. 'intrp' .and. .not.all_empty) then
3000  dummy2d = intrp_missing
3001  is_missing = .true.
3002  else
3003  ! Abort if input data has some data for current tracer, but has
3004  ! missing data below 200 mb/ above 400mb
3005  if (.not.all_empty .and. n == o3n) then
3006  if (rlevs(vlev) .lt. lev_no_o3_fill) &
3007  call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev))//&
3008  ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR", 1)
3009  elseif (.not.all_empty .and. n .ne. o3n) then
3010  if (rlevs(vlev) .gt. lev_no_tr_fill) &
3011  call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev))//&
3012  ". SET MISSING VARIABLE CONDITION TO 'INTRP' TO AVOID THIS ERROR.", 1)
3013  endif
3014  ! If entire array is empty and method is set to intrp, switch method to fill
3015  if (trim(method) .eq. 'intrp' .and. all_empty) method='set_to_fill'
3016 
3017  call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var=dummy2d)
3018  if (iret==1) then ! missing_var_method == skip or no entry
3019  if ( (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 0) .or. & ! spec humidity
3020  (tracers_input_oct10(n) == 1 .and. tracers_input_oct11(n) == 1) .or. & ! rel humidity
3021  (tracers_input_oct10(n) == 14 .and. tracers_input_oct11(n) == 192) ) then ! ozone
3022  call error_handler("READING IN "//trim(tracers(n))//" AT LEVEL "//trim(slevs(vlev))&
3023  //". SET A FILL VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
3024  endif
3025  endif
3026  endif ! method intrp
3027  endif !iret<=0
3028 
3029  if (n==1 .and. .not. hasspfh) then
3030  if (trim(external_model) .eq. 'GFS') then
3031  print *,'- CALL CALRH GFS'
3032  call rh2spfh_gfs(dummy2d,rlevs(vlev),dummy3d(:,:,vlev))
3033  else
3034  print *,'- CALL CALRH non-GFS'
3035  call rh2spfh(dummy2d,rlevs(vlev),dummy3d(:,:,vlev))
3036  end if
3037  endif
3038 
3039  dummy3d(:,:,vlev) = real(dummy2d,esmf_kind_r8)
3040 
3041  enddo !vlev
3042 
3043 ! Jili Dong interpolation for missing levels
3044  if (is_missing .and. trim(method) .eq. 'intrp') then
3045  print *,'- INTERPOLATE TRACER '//trim(tracers(n))
3046  done_print = 0
3047  do jj = 1, j_input
3048  do ii = 1, i_input
3049  dummy3d_col_in=dummy3d(ii,jj,:)
3050  call dint2p(rlevs,dummy3d_col_in,lev_input,rlevs,dummy3d_col_out, &
3051  lev_input, 2, intrp_missing, intrp_ier)
3052  if (intrp_ier .gt. 0) call error_handler("Interpolation failed.",intrp_ier)
3053  dummy3d(ii,jj,:)=dummy3d_col_out
3054  enddo
3055  enddo
3056  do vlev=1,lev_input
3057  dummy2d = dummy3d(:,:,n)
3058  if (any(dummy2d .eq. intrp_missing)) then
3059  ! If we're outside the appropriate region, don't fill but error instead
3060  if (n == o3n .and. rlevs(vlev) .lt. lev_no_o3_fill) then
3061  call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev)),1)
3062  elseif (n .ne. o3n .and. rlevs(vlev) .gt. lev_no_tr_fill) then
3063  call error_handler("TRACER "//trim(tracers(n))//" HAS MISSING DATA AT "//trim(slevs(vlev)),1)
3064  else ! we're okay to fill missing data with provided fill value
3065  if (done_print .eq. 0) then
3066  print*, "Pressure out of range of existing data. Defaulting to fill value."
3067  done_print = 1
3068  end if !done print
3069  where(dummy2d .eq. intrp_missing) dummy2d = value
3070  dummy3d(:,:,vlev) = dummy2d
3071  end if !n & lev
3072  endif ! intrp_missing
3073  ! zero out negative tracers from interpolation/extrapolation
3074  where(dummy3d(:,:,vlev) .lt. 0.0) dummy3d(:,:,vlev) = 0.0
3075 ! print*,'tracer af intrp',vlev, maxval(dummy3d(:,:,vlev)),minval(dummy3d(:,:,vlev))
3076  end do !nlevs do
3077  end if !if intrp
3078  endif !localpet == 0
3079 
3080  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT ", trim(tracers_input_vmap(n))
3081  call esmf_fieldscatter(tracers_input_grid(n), dummy3d, rootpet=0, rc=rc)
3082  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3083  call error_handler("IN FieldScatter", rc)
3084 
3085  enddo
3086 
3087  deallocate(dummy3d_col_in, dummy3d_col_out)
3088 
3089  call read_winds(u_tmp_3d,v_tmp_3d,localpet,octet_23,rlevs,lugb,pdt_num)
3090 
3091  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT U-WIND."
3092  call esmf_fieldscatter(u_input_grid, u_tmp_3d, rootpet=0, rc=rc)
3093  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3094  call error_handler("IN FieldScatter", rc)
3095 
3096  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT V-WIND."
3097  call esmf_fieldscatter(v_input_grid, v_tmp_3d, rootpet=0, rc=rc)
3098  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3099  call error_handler("IN FieldScatter", rc)
3100 
3101  if (localpet == 0) then
3102 
3103  print*,"- READ SURFACE PRESSURE."
3104  jdisc = 0 ! search for discipline - meteorological products
3105  j = 0 ! search at beginning of file.
3106  jpdt = -9999 ! array of values in product definition template, set to wildcard
3107  jids = -9999 ! array of values in identification section, set to wildcard
3108  jgdt = -9999 ! array of values in grid definition template, set to wildcard
3109  jgdtn = -1 ! search for any grid definition number.
3110  jpdtn = pdt_num ! Search for the product definition template number.
3111  jpdt(1) = 3 ! Sect4/oct 10 - param category - mass
3112  jpdt(2) = 0 ! Sect4/oct 11 - param number - pressure
3113  jpdt(10) = 1 ! Sect4/oct 23 - type of level - ground surface
3114  unpack=.true.
3115 
3116  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3117  unpack, k, gfld, iret)
3118  if (iret /= 0) call error_handler("READING SURFACE PRESSURE RECORD.", iret)
3119 
3120  dummy2d_8 = reshape(gfld%fld, (/i_input,j_input/) )
3121 
3122  endif ! Read surface pressure
3123 
3124  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID SURFACE PRESSURE."
3125  call esmf_fieldscatter(ps_input_grid, dummy2d_8, rootpet=0, rc=rc)
3126  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3127  call error_handler("IN FieldScatter", rc)
3128 
3129 ! Read dzdt.
3130 
3131  if (localpet == 0) then
3132 
3133  print*,"- READ DZDT."
3134  vname = "dzdt"
3135  call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, &
3136  loc=varnum)
3137 
3138  jdisc = 0 ! search for discipline - meteorological products
3139  j = 0 ! search at beginning of file.
3140  jpdt = -9999 ! array of values in product definition template, set to wildcard
3141  jids = -9999 ! array of values in identification section, set to wildcard
3142  jgdt = -9999 ! array of values in grid definition template, set to wildcard
3143  jgdtn = -1 ! search for any grid definition number.
3144  jpdtn = pdt_num ! Search for the product definition template number.
3145  jpdt(1) = 2 ! Sect4/oct 10 - param category - momentum
3146  jpdt(2) = 9 ! Sect4/oct 11 - param number - dzdt
3147  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level
3148 
3149  unpack=.true.
3150 
3151  do vlev = 1, lev_input
3152 
3153  jpdt(12) = nint(rlevs(vlev))
3154 
3155  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3156  unpack, k, gfld, iret)
3157 
3158  if (iret /= 0) then ! dzdt not found, look for omega.
3159  print*,"DZDT not available at level ", trim(slevs(vlev)), " so checking for VVEL"
3160  jpdt(2) = 8 ! Sect4/oct 11 - parameter number - omega
3161  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3162  unpack, k, gfld, iret)
3163  if (iret /= 0) then
3164  call handle_grib_error(vname, slevs(vlev),method,value,varnum,iret,var8=dum2d_1)
3165  if (iret==1) then ! missing_var_method == skip
3166  cycle
3167  endif
3168  else
3169  conv_omega = .true.
3170  dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) )
3171  endif
3172  else ! found dzdt
3173  dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) )
3174  endif
3175 
3176  dummy3d(:,:,vlev) = dum2d_1
3177 
3178  enddo
3179 
3180  endif ! Read of dzdt
3181 
3182  call mpi_bcast(conv_omega,1,mpi_logical,0,mpi_comm_world,rc)
3183 
3184  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT DZDT."
3185  call esmf_fieldscatter(dzdt_input_grid, dummy3d, rootpet=0, rc=rc)
3186  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3187  call error_handler("IN FieldScatter", rc)
3188 
3189 ! Read terrain
3190 
3191  if (localpet == 0) then
3192 
3193  print*,"- READ TERRAIN."
3194  jdisc = 0 ! search for discipline - meteorological products
3195  j = 0 ! search at beginning of file.
3196  jpdt = -9999 ! array of values in product definition template, set to wildcard
3197  jids = -9999 ! array of values in identification section, set to wildcard
3198  jgdt = -9999 ! array of values in grid definition template, set to wildcard
3199  jgdtn = -1 ! search for any grid definition number.
3200  jpdtn = pdt_num ! Search for the product definition template number.
3201  jpdt(1) = 3 ! Sect4/oct 10 - param category - mass
3202  jpdt(2) = 5 ! Sect4/oct 11 - param number - geopotential height
3203  jpdt(10) = 1 ! Sect4/oct 23 - type of level - ground surface
3204  unpack=.true.
3205 
3206  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3207  unpack, k, gfld, iret)
3208  if (iret /= 0) call error_handler("READING TERRAIN HEIGHT RECORD.", iret)
3209 
3210  dummy2d_8 = reshape(gfld%fld, (/i_input,j_input/) )
3211 
3212  endif ! read of terrain.
3213 
3214  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID TERRAIN."
3215  call esmf_fieldscatter(terrain_input_grid, dummy2d_8, rootpet=0, rc=rc)
3216  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3217  call error_handler("IN FieldScatter", rc)
3218 
3219  deallocate(dummy2d, dummy2d_8)
3220 
3221 if (.not. isnative) then
3222 
3223  !---------------------------------------------------------------------------
3224  ! Flip 'z' indices to all 3-d variables. Data is read in from model
3225  ! top to surface. This program expects surface to model top.
3226  !---------------------------------------------------------------------------
3227 
3228  if (localpet == 0) print*,"- CALL FieldGet FOR SURFACE PRESSURE."
3229  nullify(psptr)
3230  call esmf_fieldget(ps_input_grid, &
3231  farrayptr=psptr, rc=rc)
3232  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3233  call error_handler("IN FieldGet", rc)
3234 
3235  nullify(presptr)
3236  if (localpet == 0) print*,"- CALL FieldGet FOR 3-D PRESSURE."
3237  call esmf_fieldget(pres_input_grid, &
3238  computationallbound=clb, &
3239  computationalubound=cub, &
3240  farrayptr=presptr, rc=rc)
3241  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3242  call error_handler("IN FieldGet", rc)
3243 
3244  nullify(tptr)
3245  if (localpet == 0) print*,"- CALL FieldGet TEMPERATURE."
3246  call esmf_fieldget(temp_input_grid, &
3247  farrayptr=tptr, rc=rc)
3248  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3249  call error_handler("IN FieldGet", rc)
3250 
3251  nullify(uptr)
3252  if (localpet == 0) print*,"- CALL FieldGet FOR U"
3253  call esmf_fieldget(u_input_grid, &
3254  farrayptr=uptr, rc=rc)
3255  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3256  call error_handler("IN FieldGet", rc)
3257 
3258  nullify(vptr)
3259  if (localpet == 0) print*,"- CALL FieldGet FOR V"
3260  call esmf_fieldget(v_input_grid, &
3261  farrayptr=vptr, rc=rc)
3262  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3263  call error_handler("IN FieldGet", rc)
3264 
3265  nullify(wptr)
3266  if (localpet == 0) print*,"- CALL FieldGet FOR W"
3267  call esmf_fieldget(dzdt_input_grid, &
3268  farrayptr=wptr, rc=rc)
3269  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3270  call error_handler("IN FieldGet", rc)
3271 
3272  if (localpet == 0) print*,"- CALL FieldGet FOR TRACERS."
3273  do n=1,num_tracers_input
3274  nullify(qptr)
3275  call esmf_fieldget(tracers_input_grid(n), &
3276  farrayptr=qptr, rc=rc)
3277  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3278  call error_handler("IN FieldGet", rc)
3279  do i = clb(1),cub(1)
3280  do j = clb(2),cub(2)
3281  qptr(i,j,:) = qptr(i,j,lev_input:1:-1)
3282  end do
3283  end do
3284  end do
3285 
3286  do i = clb(1),cub(1)
3287  do j = clb(2),cub(2)
3288  presptr(i,j,:) = rlevs(lev_input:1:-1)
3289  tptr(i,j,:) = tptr(i,j,lev_input:1:-1)
3290  uptr(i,j,:) = uptr(i,j,lev_input:1:-1)
3291  vptr(i,j,:) = vptr(i,j,lev_input:1:-1)
3292  wptr(i,j,:) = wptr(i,j,lev_input:1:-1)
3293  end do
3294  end do
3295 
3296  if (localpet == 0) then
3297  print*,'psfc is ',clb(1),clb(2),psptr(clb(1),clb(2))
3298  print*,'pres is ',cub(1),cub(2),presptr(cub(1),cub(2),:)
3299 
3300  print*,'pres check 1',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2),1)), &
3301  minval(presptr(clb(1):cub(1),clb(2):cub(2),1))
3302  print*,'pres check lev',localpet,maxval(presptr(clb(1):cub(1),clb(2):cub(2), &
3303  lev_input)),minval(presptr(clb(1):cub(1),clb(2):cub(2),lev_input))
3304  endif
3305 
3306 else ! is native coordinate (hybrid).
3307 
3308 ! For native files, read in pressure field directly from file but don't flip levels
3309 
3310  if (localpet == 0) then
3311 
3312  print*,"- READ PRESSURE."
3313 
3314  jdisc = 0 ! search for discipline - meteorological products
3315  j = 0 ! search at beginning of file.
3316  jpdt = -9999 ! array of values in product definition template, set to wildcard
3317  jids = -9999 ! array of values in identification section, set to wildcard
3318  jgdt = -9999 ! array of values in grid definition template, set to wildcard
3319  jgdtn = -1 ! search for any grid definition number.
3320  jpdtn = pdt_num ! Search for the product definition template number.
3321  jpdt(1) = 3 ! Sect4/oct 10 - parameter category - mass
3322  jpdt(2) = 0 ! Sect4/oct 11 - parameter number - pressure
3323  jpdt(10) = octet_23 ! Sect4/oct 23 - type of level.
3324  unpack=.true.
3325 
3326  do vlev = 1, lev_input
3327 
3328  jpdt(12) = nint(rlevs(vlev))
3329  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
3330  unpack, k, gfld, iret)
3331  if (iret /= 0) then
3332  call error_handler("READING IN PRESSURE AT LEVEL "//trim(slevs(vlev)),iret)
3333  endif
3334 
3335  dum2d_1 = reshape(gfld%fld, (/i_input,j_input/) )
3336 
3337  dummy3d(:,:,vlev) = dum2d_1
3338 
3339  enddo
3340 
3341  endif ! localpet == 0
3342 
3343  if (localpet == 0) print*,"- CALL FieldScatter FOR INPUT GRID PRESSURE."
3344  call esmf_fieldscatter(pres_input_grid, dummy3d, rootpet=0, rc=rc)
3345  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3346  call error_handler("IN FieldScatter", rc)
3347 
3348  endif
3349 
3350  deallocate(dummy3d, dum2d_1)
3351 
3352 !---------------------------------------------------------------------------
3353 ! Convert from 2-d to 3-d component winds.
3354 !---------------------------------------------------------------------------
3355 
3356  call convert_winds
3357 
3358 !---------------------------------------------------------------------------
3359 ! Convert dpdt to dzdt if needed
3360 !---------------------------------------------------------------------------
3361 
3362  if (conv_omega) then
3363 
3364  if (localpet == 0) print*,"- CONVERT FROM OMEGA TO DZDT."
3365 
3366  nullify(tptr)
3367  if (localpet == 0) print*,"- CALL FieldGet TEMPERATURE."
3368  call esmf_fieldget(temp_input_grid, &
3369  farrayptr=tptr, rc=rc)
3370  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3371  call error_handler("IN FieldGet", rc)
3372 
3373  nullify(qptr)
3374  if (localpet == 0) print*,"- CALL FieldGet SPECIFIC HUMIDITY."
3375  call esmf_fieldget(tracers_input_grid(1), &
3376  computationallbound=clb, &
3377  computationalubound=cub, &
3378  farrayptr=qptr, rc=rc)
3379  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3380  call error_handler("IN FieldGet", rc)
3381 
3382  nullify(wptr)
3383  if (localpet == 0) print*,"- CALL FieldGet DZDT."
3384  call esmf_fieldget(dzdt_input_grid, &
3385  computationallbound=clb, &
3386  computationalubound=cub, &
3387  farrayptr=wptr, rc=rc)
3388  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3389  call error_handler("IN FieldGet", rc)
3390 
3391  nullify(presptr)
3392  call esmf_fieldget(pres_input_grid, &
3393  farrayptr=presptr, rc=rc)
3394  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3395  call error_handler("IN FieldGet", rc)
3396 
3397  call convert_omega(wptr,presptr,tptr,qptr,clb,cub)
3398 
3399  endif
3400 
3401  if (localpet == 0) call baclose(lugb, rc)
3402 
3403  end subroutine read_input_atm_grib2_file
3404 
3412  subroutine read_input_sfc_gfs_sfcio_file(localpet)
3413 
3414  use sfcio_module
3415 
3416  implicit none
3417 
3418  integer, intent(in) :: localpet
3419 
3420  character(len=300) :: the_file
3421 
3422  integer(sfcio_intkind) :: iret
3423  integer :: rc
3424 
3425  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
3426  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
3427 
3428  type(sfcio_head) :: sfchead
3429  type(sfcio_dbta) :: sfcdata
3430 
3431  the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
3432 
3433  print*,"- READ SURFACE DATA IN SFCIO FORMAT."
3434  print*,"- OPEN AND READ: ",trim(the_file)
3435  call sfcio_sropen(23, trim(the_file), iret)
3436  if (iret /= 0) then
3437  rc=iret
3438  call error_handler("OPENING FILE", rc)
3439  endif
3440 
3441  call sfcio_srhead(23, sfchead, iret)
3442  if (iret /= 0) then
3443  rc=iret
3444  call error_handler("READING HEADER", rc)
3445  endif
3446 
3447  if (localpet == 0) then
3448  call sfcio_aldbta(sfchead, sfcdata, iret)
3449  if (iret /= 0) then
3450  rc=iret
3451  call error_handler("ALLOCATING DATA.", rc)
3452  endif
3453  call sfcio_srdbta(23, sfchead, sfcdata, iret)
3454  if (iret /= 0) then
3455  rc=iret
3456  call error_handler("READING DATA.", rc)
3457  endif
3458  allocate(dummy2d(i_input,j_input))
3459  allocate(dummy3d(i_input,j_input,lsoil_input))
3460  else
3461  allocate(dummy2d(0,0))
3462  allocate(dummy3d(0,0,0))
3463  endif
3464 
3465  if (localpet == 0) dummy2d = sfcdata%slmsk
3466 
3467  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
3468  call esmf_fieldscatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc)
3469  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3470  call error_handler("IN FieldScatter", rc)
3471 
3472  if (localpet == 0) dummy2d = sfcdata%zorl
3473 
3474  print*,"- CALL FieldScatter FOR INPUT Z0."
3475  call esmf_fieldscatter(z0_input_grid, dummy2d, rootpet=0, rc=rc)
3476  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3477  call error_handler("IN FieldScatter", rc)
3478 
3479  if (localpet == 0) dummy2d = nint(sfcdata%vtype)
3480 
3481  print*,"- CALL FieldScatter FOR INPUT VEG TYPE."
3482  call esmf_fieldscatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc)
3483  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3484  call error_handler("IN FieldScatter", rc)
3485 
3486 ! Prior to July, 2017, gfs used zobler soil types. '13' indicates permanent land ice.
3487  veg_type_landice_input = 13
3488 
3489  if (localpet == 0) dummy2d = sfcdata%canopy
3490 
3491  print*,"- CALL FieldScatter FOR INPUT CANOPY MC."
3492  call esmf_fieldscatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc)
3493  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3494  call error_handler("IN FieldScatter", rc)
3495 
3496  if (localpet == 0) dummy2d = sfcdata%fice
3497 
3498  print*,"- CALL FieldScatter FOR INPUT ICE FRACTION."
3499  call esmf_fieldscatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc)
3500  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3501  call error_handler("IN FieldScatter", rc)
3502 
3503  if (localpet == 0) dummy2d = sfcdata%hice
3504 
3505  print*,"- CALL FieldScatter FOR INPUT ICE DEPTH."
3506  call esmf_fieldscatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc)
3507  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3508  call error_handler("IN FieldScatter", rc)
3509 
3510  if (localpet == 0) dummy2d = sfcdata%tisfc
3511 
3512  print*,"- CALL FieldScatter FOR INPUT ICE SKIN TEMP."
3513  call esmf_fieldscatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
3514  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3515  call error_handler("IN FieldScatter", rc)
3516 
3517  if (localpet == 0) dummy2d = sfcdata%snwdph ! mm (expected by program)
3518 
3519  print*,"- CALL FieldScatter FOR INPUT SNOW DEPTH."
3520  call esmf_fieldscatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc)
3521  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3522  call error_handler("IN FieldScatter", rc)
3523 
3524  if (localpet == 0) dummy2d = sfcdata%sheleg
3525 
3526  print*,"- CALL FieldScatter FOR INPUT SNOW LIQUID EQUIV."
3527  call esmf_fieldscatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc)
3528  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3529  call error_handler("IN FieldScatter", rc)
3530 
3531  if (localpet == 0) dummy2d = sfcdata%t2m
3532 
3533  print*,"- CALL FieldScatter FOR INPUT T2M."
3534  call esmf_fieldscatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc)
3535  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3536  call error_handler("IN FieldScatter", rc)
3537 
3538  if (localpet == 0) dummy2d = sfcdata%q2m
3539 
3540  print*,"- CALL FieldScatter FOR INPUT Q2M."
3541  call esmf_fieldscatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc)
3542  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3543  call error_handler("IN FieldScatter", rc)
3544 
3545  if (localpet == 0) dummy2d = sfcdata%tprcp
3546 
3547  print*,"- CALL FieldScatter FOR INPUT TPRCP."
3548  call esmf_fieldscatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc)
3549  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3550  call error_handler("IN FieldScatter", rc)
3551 
3552  if (localpet == 0) dummy2d = sfcdata%f10m
3553 
3554  print*,"- CALL FieldScatter FOR INPUT F10M."
3555  call esmf_fieldscatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc)
3556  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3557  call error_handler("IN FieldScatter", rc)
3558 
3559  if (localpet == 0) dummy2d = sfcdata%uustar
3560 
3561  print*,"- CALL FieldScatter FOR INPUT USTAR."
3562  call esmf_fieldscatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc)
3563  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3564  call error_handler("IN FieldScatter", rc)
3565 
3566  if (localpet == 0) dummy2d = sfcdata%ffmm
3567 
3568  print*,"- CALL FieldScatter FOR INPUT FFMM."
3569  call esmf_fieldscatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc)
3570  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3571  call error_handler("IN FieldScatter", rc)
3572 
3573  if (localpet == 0) dummy2d = sfcdata%srflag
3574 
3575  print*,"- CALL FieldScatter FOR INPUT SRFLAG."
3576  call esmf_fieldscatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc)
3577  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3578  call error_handler("IN FieldScatter", rc)
3579 
3580  if (localpet == 0) dummy2d = sfcdata%tsea
3581 
3582  print*,"- CALL FieldScatter FOR INPUT SKIN TEMP."
3583  call esmf_fieldscatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
3584  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3585  call error_handler("IN FieldScatter", rc)
3586 
3587  if (localpet == 0) dummy2d = nint(sfcdata%stype)
3588 
3589  print*,"- CALL FieldScatter FOR INPUT SOIL TYPE."
3590  call esmf_fieldscatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc)
3591  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3592  call error_handler("IN FieldScatter", rc)
3593 
3594  if (localpet == 0) dummy2d = sfcdata%orog
3595 
3596  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
3597  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
3598  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3599  call error_handler("IN FieldScatter", rc)
3600 
3601  if (localpet == 0) dummy3d = sfcdata%slc
3602 
3603  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
3604  call esmf_fieldscatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc)
3605  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3606  call error_handler("IN FieldScatter", rc)
3607 
3608  if (localpet == 0) dummy3d = sfcdata%smc
3609 
3610  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
3611  call esmf_fieldscatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc)
3612  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3613  call error_handler("IN FieldScatter", rc)
3614 
3615  if (localpet == 0) dummy3d = sfcdata%stc
3616 
3617  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
3618  call esmf_fieldscatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc)
3619  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3620  call error_handler("IN FieldScatter", rc)
3621 
3622  deallocate(dummy2d, dummy3d)
3623  call sfcio_axdbta(sfcdata, iret)
3624 
3625  call sfcio_sclose(23, iret)
3626 
3627  end subroutine read_input_sfc_gfs_sfcio_file
3628 
3636  subroutine read_input_sfc_gfs_gaussian_nemsio_file(localpet)
3637 
3638  implicit none
3639 
3640  integer, intent(in) :: localpet
3641 
3642  character(len=300) :: the_file
3643 
3644  integer :: rc
3645 
3646  real(nemsio_realkind), allocatable :: dummy(:)
3647  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
3648  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
3649 
3650  type(nemsio_gfile) :: gfile
3651 
3652  the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
3653 
3654  if (localpet == 0) then
3655  allocate(dummy3d(i_input,j_input,lsoil_input))
3656  allocate(dummy2d(i_input,j_input))
3657  allocate(dummy(i_input*j_input))
3658  print*,"- OPEN FILE ", trim(the_file)
3659  call nemsio_open(gfile, the_file, "read", iret=rc)
3660  if (rc /= 0) call error_handler("OPENING FILE.", rc)
3661  else
3662  allocate(dummy3d(0,0,0))
3663  allocate(dummy2d(0,0))
3664  allocate(dummy(0))
3665  endif
3666 
3667  if (localpet == 0) then
3668  print*,"- READ TERRAIN."
3669  call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc)
3670  if (rc /= 0) call error_handler("READING TERRAIN.", rc)
3671  dummy2d = reshape(dummy, (/i_input,j_input/))
3672  print*,'orog ',maxval(dummy2d),minval(dummy2d)
3673  endif
3674 
3675  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
3676  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
3677  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3678  call error_handler("IN FieldScatter", rc)
3679 
3680  if (localpet == 0) then
3681  print*,"- READ LANDSEA MASK."
3682  call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc)
3683  if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc)
3684  dummy2d = reshape(dummy, (/i_input,j_input/))
3685  print*,'landmask ',maxval(dummy2d),minval(dummy2d)
3686  endif
3687 
3688  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
3689  call esmf_fieldscatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc)
3690  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3691  call error_handler("IN FieldScatter", rc)
3692 
3693  if (localpet == 0) then
3694  print*,"- READ SEAICE FRACTION."
3695  call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc)
3696  if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc)
3697  dummy2d = reshape(dummy, (/i_input,j_input/))
3698  print*,'icec ',maxval(dummy2d),minval(dummy2d)
3699  endif
3700 
3701  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION."
3702  call esmf_fieldscatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc)
3703  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3704  call error_handler("IN FieldScatter", rc)
3705 
3706  if (localpet == 0) then
3707  print*,"- READ SEAICE DEPTH."
3708  call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc)
3709  if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc)
3710  dummy2d = reshape(dummy, (/i_input,j_input/))
3711  print*,'icetk ',maxval(dummy2d),minval(dummy2d)
3712  endif
3713 
3714  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH."
3715  call esmf_fieldscatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc)
3716  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3717  call error_handler("IN FieldScatter", rc)
3718 
3719  if (localpet == 0) then
3720  print*,"- READ SEAICE SKIN TEMPERATURE."
3721  call nemsio_readrecv(gfile, "tisfc", "sfc", 1, dummy, 0, iret=rc)
3722  if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc)
3723  dummy2d = reshape(dummy, (/i_input,j_input/))
3724  print*,'ti ',maxval(dummy2d),minval(dummy2d)
3725  endif
3726 
3727  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE."
3728  call esmf_fieldscatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
3729  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3730  call error_handler("IN FieldScatter", rc)
3731 
3732  if (localpet == 0) then
3733  print*,"- READ SNOW LIQUID EQUIVALENT."
3734  call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc)
3735  if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc)
3736  dummy2d = reshape(dummy, (/i_input,j_input/))
3737  print*,'weasd ',maxval(dummy2d),minval(dummy2d)
3738  endif
3739 
3740  print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT."
3741  call esmf_fieldscatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc)
3742  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3743  call error_handler("IN FieldScatter", rc)
3744 
3745  if (localpet == 0) then
3746  print*,"- READ SNOW DEPTH."
3747  call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc)
3748  if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc)
3749  dummy2d = reshape(dummy, (/i_input,j_input/))
3750  print*,'snod ',maxval(dummy2d),minval(dummy2d)
3751  endif
3752 
3753  print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH."
3754  call esmf_fieldscatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc)
3755  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3756  call error_handler("IN FieldScatter", rc)
3757 
3758  if (localpet == 0) then
3759  print*,"- READ VEG TYPE."
3760  call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc)
3761  if (rc /= 0) call error_handler("READING VEG TYPE", rc)
3762  dummy2d = reshape(dummy, (/i_input,j_input/))
3763  print*,'vtype ',maxval(dummy2d),minval(dummy2d)
3764  endif
3765 
3766  print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE."
3767  call esmf_fieldscatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc)
3768  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3769  call error_handler("IN FieldScatter", rc)
3770 
3771  if (localpet == 0) then
3772  print*,"- READ SOIL TYPE."
3773  call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc)
3774  if (rc /= 0) call error_handler("READING SOIL TYPE.", rc)
3775  dummy2d = reshape(dummy, (/i_input,j_input/))
3776  print*,'sotype ',maxval(dummy2d),minval(dummy2d)
3777  endif
3778 
3779  print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE."
3780  call esmf_fieldscatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc)
3781  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3782  call error_handler("IN FieldScatter", rc)
3783 
3784  if (localpet == 0) then
3785  print*,"- READ T2M."
3786  call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc)
3787  if (rc /= 0) call error_handler("READING T2M.", rc)
3788  dummy2d = reshape(dummy, (/i_input,j_input/))
3789  print*,'t2m ',maxval(dummy2d),minval(dummy2d)
3790  endif
3791 
3792  print*,"- CALL FieldScatter FOR INPUT GRID T2M."
3793  call esmf_fieldscatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc)
3794  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3795  call error_handler("IN FieldScatter", rc)
3796 
3797  if (localpet == 0) then
3798  print*,"- READ Q2M."
3799  call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc)
3800  if (rc /= 0) call error_handler("READING Q2M.", rc)
3801  dummy2d = reshape(dummy, (/i_input,j_input/))
3802  print*,'q2m ',maxval(dummy2d),minval(dummy2d)
3803  endif
3804 
3805  print*,"- CALL FieldScatter FOR INPUT GRID Q2M."
3806  call esmf_fieldscatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc)
3807  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3808  call error_handler("IN FieldScatter", rc)
3809 
3810  if (localpet == 0) then
3811  print*,"- READ TPRCP."
3812  call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc)
3813  if (rc /= 0) call error_handler("READING TPRCP.", rc)
3814  dummy2d = reshape(dummy, (/i_input,j_input/))
3815  print*,'tprcp ',maxval(dummy2d),minval(dummy2d)
3816  endif
3817 
3818  print*,"- CALL FieldScatter FOR INPUT GRID TPRCP."
3819  call esmf_fieldscatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc)
3820  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3821  call error_handler("IN FieldScatter", rc)
3822 
3823  if (localpet == 0) then
3824  print*,"- READ FFMM."
3825  call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc)
3826  if (rc /= 0) call error_handler("READING FFMM.", rc)
3827  dummy2d = reshape(dummy, (/i_input,j_input/))
3828  print*,'ffmm ',maxval(dummy2d),minval(dummy2d)
3829  endif
3830 
3831  print*,"- CALL FieldScatter FOR INPUT GRID FFMM"
3832  call esmf_fieldscatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc)
3833  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3834  call error_handler("IN FieldScatter", rc)
3835 
3836  if (localpet == 0) then
3837  print*,"- READ USTAR."
3838  call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc)
3839  if (rc /= 0) call error_handler("READING USTAR.", rc)
3840  dummy2d = reshape(dummy, (/i_input,j_input/))
3841  print*,'fricv ',maxval(dummy2d),minval(dummy2d)
3842  endif
3843 
3844  print*,"- CALL FieldScatter FOR INPUT GRID USTAR"
3845  call esmf_fieldscatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc)
3846  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3847  call error_handler("IN FieldScatter", rc)
3848 
3849  if (localpet == 0) dummy2d = 0.0
3850  print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG"
3851  call esmf_fieldscatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc)
3852  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3853  call error_handler("IN FieldScatter", rc)
3854 
3855  if (localpet == 0) then
3856  print*,"- READ SKIN TEMPERATURE."
3857  call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc)
3858  if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc)
3859  dummy2d = reshape(dummy, (/i_input,j_input/))
3860  print*,'tmp ',maxval(dummy2d),minval(dummy2d)
3861  endif
3862 
3863  print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE"
3864  call esmf_fieldscatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
3865  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3866  call error_handler("IN FieldScatter", rc)
3867 
3868  if (localpet == 0) then
3869  print*,"- READ F10M."
3870  call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc)
3871  if (rc /= 0) call error_handler("READING F10M.", rc)
3872  dummy2d = reshape(dummy, (/i_input,j_input/))
3873  print*,'f10m ',maxval(dummy2d),minval(dummy2d)
3874  endif
3875 
3876  print*,"- CALL FieldScatter FOR INPUT GRID F10M."
3877  call esmf_fieldscatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc)
3878  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3879  call error_handler("IN FieldScatter", rc)
3880 
3881  if (localpet == 0) then
3882  print*,"- READ CANOPY MOISTURE CONTENT."
3883  call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc)
3884  if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc)
3885  dummy2d = reshape(dummy, (/i_input,j_input/))
3886  print*,'cnwat ',maxval(dummy2d),minval(dummy2d)
3887  endif
3888 
3889  print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT."
3890  call esmf_fieldscatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc)
3891  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3892  call error_handler("IN FieldScatter", rc)
3893 
3894  if (localpet == 0) then
3895  print*,"- READ Z0."
3896  call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc)
3897  if (rc /= 0) call error_handler("READING Z0.", rc)
3898  dummy2d = reshape(dummy, (/i_input,j_input/))
3899  print*,'sfcr ',maxval(dummy2d),minval(dummy2d)
3900  endif
3901 
3902  print*,"- CALL FieldScatter FOR INPUT GRID Z0."
3903  call esmf_fieldscatter(z0_input_grid, dummy2d, rootpet=0, rc=rc)
3904  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3905  call error_handler("IN FieldScatter", rc)
3906 
3907  deallocate(dummy2d)
3908 
3909  if (localpet == 0) then
3910  print*,"- READ LIQUID SOIL MOISTURE."
3911  call nemsio_readrecv(gfile, "slc", "soil layer", 1, dummy, 0, iret=rc)
3912  if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc)
3913  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
3914  call nemsio_readrecv(gfile, "slc", "soil layer", 2, dummy, 0, iret=rc)
3915  if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc)
3916  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
3917  call nemsio_readrecv(gfile, "slc", "soil layer", 3, dummy, 0, iret=rc)
3918  if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc)
3919  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
3920  call nemsio_readrecv(gfile, "slc", "soil layer", 4, dummy, 0, iret=rc)
3921  if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc)
3922  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
3923  print*,'slc ',maxval(dummy3d),minval(dummy3d)
3924  endif
3925 
3926  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
3927  call esmf_fieldscatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc)
3928  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3929  call error_handler("IN FieldScatter", rc)
3930 
3931  if (localpet == 0) then
3932  print*,"- READ TOTAL SOIL MOISTURE."
3933  call nemsio_readrecv(gfile, "smc", "soil layer", 1, dummy, 0, iret=rc)
3934  if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc)
3935  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
3936  call nemsio_readrecv(gfile, "smc", "soil layer", 2, dummy, 0, iret=rc)
3937  if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc)
3938  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
3939  call nemsio_readrecv(gfile, "smc", "soil layer", 3, dummy, 0, iret=rc)
3940  if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc)
3941  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
3942  call nemsio_readrecv(gfile, "smc", "soil layer", 4, dummy, 0, iret=rc)
3943  if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc)
3944  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
3945  print*,'smc ',maxval(dummy3d),minval(dummy3d)
3946  endif
3947 
3948  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
3949  call esmf_fieldscatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc)
3950  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3951  call error_handler("IN FieldScatter", rc)
3952 
3953  if (localpet == 0) then
3954  print*,"- READ SOIL TEMPERATURE."
3955  call nemsio_readrecv(gfile, "stc", "soil layer", 1, dummy, 0, iret=rc)
3956  if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc)
3957  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
3958  call nemsio_readrecv(gfile, "stc", "soil layer", 2, dummy, 0, iret=rc)
3959  if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc)
3960  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
3961  call nemsio_readrecv(gfile, "stc", "soil layer", 3, dummy, 0, iret=rc)
3962  if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc)
3963  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
3964  call nemsio_readrecv(gfile, "stc", "soil layer", 4, dummy, 0, iret=rc)
3965  if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc)
3966  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
3967  print*,'stc ',maxval(dummy3d),minval(dummy3d)
3968  endif
3969 
3970  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
3971  call esmf_fieldscatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc)
3972  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3973  call error_handler("IN FieldScatter", rc)
3974 
3975  deallocate(dummy3d, dummy)
3976 
3977  if (localpet == 0) call nemsio_close(gfile)
3978 
3979  end subroutine read_input_sfc_gfs_gaussian_nemsio_file
3980 
3985  subroutine read_input_sfc_gaussian_nemsio_file(localpet)
3986 
3987  implicit none
3988 
3989  integer, intent(in) :: localpet
3990 
3991  character(len=250) :: the_file
3992 
3993  integer :: rc
3994 
3995  real(nemsio_realkind), allocatable :: dummy(:)
3996  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
3997  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:)
3998 
3999  type(nemsio_gfile) :: gfile
4000 
4001  the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
4002 
4003  if (localpet == 0) then
4004  allocate(dummy3d(i_input,j_input,lsoil_input))
4005  allocate(dummy2d(i_input,j_input))
4006  allocate(dummy(i_input*j_input))
4007  print*,"- OPEN FILE ", trim(the_file)
4008  call nemsio_open(gfile, the_file, "read", iret=rc)
4009  if (rc /= 0) call error_handler("OPENING FILE.", rc)
4010  else
4011  allocate(dummy3d(0,0,0))
4012  allocate(dummy2d(0,0))
4013  allocate(dummy(0))
4014  endif
4015 
4016  if (localpet == 0) then
4017  print*,"- READ TERRAIN."
4018  call nemsio_readrecv(gfile, "orog", "sfc", 1, dummy, 0, iret=rc)
4019  if (rc /= 0) call error_handler("READING TERRAIN.", rc)
4020  dummy2d = reshape(dummy, (/i_input,j_input/))
4021  print*,'orog ',maxval(dummy2d),minval(dummy2d)
4022  endif
4023 
4024  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
4025  call esmf_fieldscatter(terrain_input_grid, dummy2d, rootpet=0, rc=rc)
4026  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4027  call error_handler("IN FieldScatter", rc)
4028 
4029  if (localpet == 0) then
4030  print*,"- READ LANDSEA MASK."
4031  call nemsio_readrecv(gfile, "land", "sfc", 1, dummy, 0, iret=rc)
4032  if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc)
4033  dummy2d = reshape(dummy, (/i_input,j_input/))
4034  print*,'landmask ',maxval(dummy2d),minval(dummy2d)
4035  endif
4036 
4037  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
4038  call esmf_fieldscatter(landsea_mask_input_grid, dummy2d, rootpet=0, rc=rc)
4039  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4040  call error_handler("IN FieldScatter", rc)
4041 
4042  if (localpet == 0) then
4043  print*,"- READ SEAICE FRACTION."
4044  call nemsio_readrecv(gfile, "icec", "sfc", 1, dummy, 0, iret=rc)
4045  if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc)
4046  dummy2d = reshape(dummy, (/i_input,j_input/))
4047  print*,'icec ',maxval(dummy2d),minval(dummy2d)
4048  endif
4049 
4050  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION."
4051  call esmf_fieldscatter(seaice_fract_input_grid, dummy2d, rootpet=0, rc=rc)
4052  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4053  call error_handler("IN FieldScatter", rc)
4054 
4055  if (localpet == 0) then
4056  print*,"- READ SEAICE DEPTH."
4057  call nemsio_readrecv(gfile, "icetk", "sfc", 1, dummy, 0, iret=rc)
4058  if (rc /= 0) call error_handler("READING SEAICE DEPTH.", rc)
4059  dummy2d = reshape(dummy, (/i_input,j_input/))
4060  print*,'icetk ',maxval(dummy2d),minval(dummy2d)
4061  endif
4062 
4063  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH."
4064  call esmf_fieldscatter(seaice_depth_input_grid, dummy2d, rootpet=0, rc=rc)
4065  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4066  call error_handler("IN FieldScatter", rc)
4067 
4068  if (localpet == 0) then
4069  print*,"- READ SEAICE SKIN TEMPERATURE."
4070  call nemsio_readrecv(gfile, "ti", "sfc", 1, dummy, 0, iret=rc)
4071  if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc)
4072  dummy2d = reshape(dummy, (/i_input,j_input/))
4073  print*,'ti ',maxval(dummy2d),minval(dummy2d)
4074  endif
4075 
4076  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE."
4077  call esmf_fieldscatter(seaice_skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
4078  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4079  call error_handler("IN FieldScatter", rc)
4080 
4081  if (localpet == 0) then
4082  print*,"- READ SNOW LIQUID EQUIVALENT."
4083  call nemsio_readrecv(gfile, "weasd", "sfc", 1, dummy, 0, iret=rc)
4084  if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc)
4085  dummy2d = reshape(dummy, (/i_input,j_input/))
4086  print*,'weasd ',maxval(dummy2d),minval(dummy2d)
4087  endif
4088 
4089  print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT."
4090  call esmf_fieldscatter(snow_liq_equiv_input_grid, dummy2d, rootpet=0, rc=rc)
4091  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4092  call error_handler("IN FieldScatter", rc)
4093 
4094  if (localpet == 0) then
4095  print*,"- READ SNOW DEPTH."
4096  call nemsio_readrecv(gfile, "snod", "sfc", 1, dummy, 0, iret=rc)
4097  if (rc /= 0) call error_handler("READING SNOW DEPTH.", rc)
4098  dummy2d = reshape(dummy, (/i_input,j_input/)) * 1000.0_8
4099  print*,'snod ',maxval(dummy2d),minval(dummy2d)
4100  endif
4101 
4102  print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH."
4103  call esmf_fieldscatter(snow_depth_input_grid, dummy2d, rootpet=0, rc=rc)
4104  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4105  call error_handler("IN FieldScatter", rc)
4106 
4107  if (localpet == 0) then
4108  print*,"- READ VEG TYPE."
4109  call nemsio_readrecv(gfile, "vtype", "sfc", 1, dummy, 0, iret=rc)
4110  if (rc /= 0) call error_handler("READING VEG TYPE", rc)
4111  dummy2d = reshape(dummy, (/i_input,j_input/))
4112  print*,'vtype ',maxval(dummy2d),minval(dummy2d)
4113  endif
4114 
4115  print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE."
4116  call esmf_fieldscatter(veg_type_input_grid, dummy2d, rootpet=0, rc=rc)
4117  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4118  call error_handler("IN FieldScatter", rc)
4119 
4120  if (localpet == 0) then
4121  print*,"- READ SOIL TYPE."
4122  call nemsio_readrecv(gfile, "sotyp", "sfc", 1, dummy, 0, iret=rc)
4123  if (rc /= 0) call error_handler("READING SOIL TYPE.", rc)
4124  dummy2d = reshape(dummy, (/i_input,j_input/))
4125  print*,'sotype ',maxval(dummy2d),minval(dummy2d)
4126  endif
4127 
4128  print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE."
4129  call esmf_fieldscatter(soil_type_input_grid, dummy2d, rootpet=0, rc=rc)
4130  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4131  call error_handler("IN FieldScatter", rc)
4132 
4133  if (localpet == 0) then
4134  print*,"- READ T2M."
4135  call nemsio_readrecv(gfile, "tmp", "2 m above gnd", 1, dummy, 0, iret=rc)
4136  if (rc /= 0) call error_handler("READING T2M.", rc)
4137  dummy2d = reshape(dummy, (/i_input,j_input/))
4138  print*,'t2m ',maxval(dummy2d),minval(dummy2d)
4139  endif
4140 
4141  print*,"- CALL FieldScatter FOR INPUT GRID T2M."
4142  call esmf_fieldscatter(t2m_input_grid, dummy2d, rootpet=0, rc=rc)
4143  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4144  call error_handler("IN FieldScatter", rc)
4145 
4146  if (localpet == 0) then
4147  print*,"- READ Q2M."
4148  call nemsio_readrecv(gfile, "spfh", "2 m above gnd", 1, dummy, 0, iret=rc)
4149  if (rc /= 0) call error_handler("READING Q2M.", rc)
4150  dummy2d = reshape(dummy, (/i_input,j_input/))
4151  print*,'q2m ',maxval(dummy2d),minval(dummy2d)
4152  endif
4153 
4154  print*,"- CALL FieldScatter FOR INPUT GRID Q2M."
4155  call esmf_fieldscatter(q2m_input_grid, dummy2d, rootpet=0, rc=rc)
4156  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4157  call error_handler("IN FieldScatter", rc)
4158 
4159  if (localpet == 0) then
4160  print*,"- READ TPRCP."
4161  call nemsio_readrecv(gfile, "tprcp", "sfc", 1, dummy, 0, iret=rc)
4162  if (rc /= 0) call error_handler("READING TPRCP.", rc)
4163  dummy2d = reshape(dummy, (/i_input,j_input/))
4164  print*,'tprcp ',maxval(dummy2d),minval(dummy2d)
4165  endif
4166 
4167  print*,"- CALL FieldScatter FOR INPUT GRID TPRCP."
4168  call esmf_fieldscatter(tprcp_input_grid, dummy2d, rootpet=0, rc=rc)
4169  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4170  call error_handler("IN FieldScatter", rc)
4171 
4172  if (localpet == 0) then
4173  print*,"- READ FFMM."
4174  call nemsio_readrecv(gfile, "ffmm", "sfc", 1, dummy, 0, iret=rc)
4175  if (rc /= 0) call error_handler("READING FFMM.", rc)
4176  dummy2d = reshape(dummy, (/i_input,j_input/))
4177  print*,'ffmm ',maxval(dummy2d),minval(dummy2d)
4178  endif
4179 
4180  print*,"- CALL FieldScatter FOR INPUT GRID FFMM"
4181  call esmf_fieldscatter(ffmm_input_grid, dummy2d, rootpet=0, rc=rc)
4182  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4183  call error_handler("IN FieldScatter", rc)
4184 
4185  if (localpet == 0) then
4186  print*,"- READ USTAR."
4187  call nemsio_readrecv(gfile, "fricv", "sfc", 1, dummy, 0, iret=rc)
4188  if (rc /= 0) call error_handler("READING USTAR.", rc)
4189  dummy2d = reshape(dummy, (/i_input,j_input/))
4190  print*,'fricv ',maxval(dummy2d),minval(dummy2d)
4191  endif
4192 
4193  print*,"- CALL FieldScatter FOR INPUT GRID USTAR"
4194  call esmf_fieldscatter(ustar_input_grid, dummy2d, rootpet=0, rc=rc)
4195  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4196  call error_handler("IN FieldScatter", rc)
4197 
4198  if (localpet == 0) dummy2d = 0.0
4199  print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG"
4200  call esmf_fieldscatter(srflag_input_grid, dummy2d, rootpet=0, rc=rc)
4201  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4202  call error_handler("IN FieldScatter", rc)
4203 
4204  if (localpet == 0) then
4205  print*,"- READ SKIN TEMPERATURE."
4206  call nemsio_readrecv(gfile, "tmp", "sfc", 1, dummy, 0, iret=rc)
4207  if (rc /= 0) call error_handler("READING SKIN TEMPERATURE.", rc)
4208  dummy2d = reshape(dummy, (/i_input,j_input/))
4209  print*,'tmp ',maxval(dummy2d),minval(dummy2d)
4210  endif
4211 
4212  print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE"
4213  call esmf_fieldscatter(skin_temp_input_grid, dummy2d, rootpet=0, rc=rc)
4214  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4215  call error_handler("IN FieldScatter", rc)
4216 
4217  if (localpet == 0) then
4218  print*,"- READ F10M."
4219  call nemsio_readrecv(gfile, "f10m", "10 m above gnd", 1, dummy, 0, iret=rc)
4220  if (rc /= 0) call error_handler("READING F10M.", rc)
4221  dummy2d = reshape(dummy, (/i_input,j_input/))
4222  print*,'f10m ',maxval(dummy2d),minval(dummy2d)
4223  endif
4224 
4225  print*,"- CALL FieldScatter FOR INPUT GRID F10M."
4226  call esmf_fieldscatter(f10m_input_grid, dummy2d, rootpet=0, rc=rc)
4227  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4228  call error_handler("IN FieldScatter", rc)
4229 
4230  if (localpet == 0) then
4231  print*,"- READ CANOPY MOISTURE CONTENT."
4232  call nemsio_readrecv(gfile, "cnwat", "sfc", 1, dummy, 0, iret=rc)
4233  if (rc /= 0) call error_handler("READING CANOPY MOISTURE CONTENT.", rc)
4234  dummy2d = reshape(dummy, (/i_input,j_input/))
4235  print*,'cnwat ',maxval(dummy2d),minval(dummy2d)
4236  endif
4237 
4238  print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT."
4239  call esmf_fieldscatter(canopy_mc_input_grid, dummy2d, rootpet=0, rc=rc)
4240  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4241  call error_handler("IN FieldScatter", rc)
4242 
4243  if (localpet == 0) then
4244  print*,"- READ Z0."
4245  call nemsio_readrecv(gfile, "sfcr", "sfc", 1, dummy, 0, iret=rc)
4246  if (rc /= 0) call error_handler("READING Z0.", rc)
4247  dummy2d = reshape(dummy, (/i_input,j_input/)) * 100.0_8 ! convert to cm
4248  print*,'sfcr ',maxval(dummy2d),minval(dummy2d)
4249  endif
4250 
4251  print*,"- CALL FieldScatter FOR INPUT GRID Z0."
4252  call esmf_fieldscatter(z0_input_grid, dummy2d, rootpet=0, rc=rc)
4253  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4254  call error_handler("IN FieldScatter", rc)
4255 
4256  deallocate(dummy2d)
4257 
4258  if (localpet == 0) then
4259  print*,"- READ LIQUID SOIL MOISTURE."
4260  call nemsio_readrecv(gfile, "soill", "0-10 cm down", 1, dummy, 0, iret=rc)
4261  if (rc /= 0) call error_handler("READING LAYER 1 LIQUID SOIL MOIST.", rc)
4262  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
4263  call nemsio_readrecv(gfile, "soill", "10-40 cm down", 1, dummy, 0, iret=rc)
4264  if (rc /= 0) call error_handler("READING LAYER 2 LIQUID SOIL MOIST.", rc)
4265  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
4266  call nemsio_readrecv(gfile, "soill", "40-100 cm down", 1, dummy, 0, iret=rc)
4267  if (rc /= 0) call error_handler("READING LAYER 3 LIQUID SOIL MOIST.", rc)
4268  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
4269  call nemsio_readrecv(gfile, "soill", "100-200 cm down", 1, dummy, 0, iret=rc)
4270  if (rc /= 0) call error_handler("READING LAYER 4 LIQUID SOIL MOIST.", rc)
4271  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
4272  print*,'soill ',maxval(dummy3d),minval(dummy3d)
4273  endif
4274 
4275  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
4276  call esmf_fieldscatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc)
4277  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4278  call error_handler("IN FieldScatter", rc)
4279 
4280  if (localpet == 0) then
4281  print*,"- READ TOTAL SOIL MOISTURE."
4282  call nemsio_readrecv(gfile, "soilw", "0-10 cm down", 1, dummy, 0, iret=rc)
4283  if (rc /= 0) call error_handler("READING LAYER 1 TOTAL SOIL MOIST.", rc)
4284  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
4285  call nemsio_readrecv(gfile, "soilw", "10-40 cm down", 1, dummy, 0, iret=rc)
4286  if (rc /= 0) call error_handler("READING LAYER 2 TOTAL SOIL MOIST.", rc)
4287  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
4288  call nemsio_readrecv(gfile, "soilw", "40-100 cm down", 1, dummy, 0, iret=rc)
4289  if (rc /= 0) call error_handler("READING LAYER 3 TOTAL SOIL MOIST.", rc)
4290  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
4291  call nemsio_readrecv(gfile, "soilw", "100-200 cm down", 1, dummy, 0, iret=rc)
4292  if (rc /= 0) call error_handler("READING LAYER 4 TOTAL SOIL MOIST.", rc)
4293  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
4294  print*,'soilm ',maxval(dummy3d),minval(dummy3d)
4295  endif
4296 
4297  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
4298  call esmf_fieldscatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc)
4299  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4300  call error_handler("IN FieldScatter", rc)
4301 
4302  if (localpet == 0) then
4303  print*,"- READ SOIL TEMPERATURE."
4304  call nemsio_readrecv(gfile, "tmp", "0-10 cm down", 1, dummy, 0, iret=rc)
4305  if (rc /= 0) call error_handler("READING LAYER 1 SOIL TEMP.", rc)
4306  dummy3d(:,:,1) = reshape(dummy, (/i_input,j_input/))
4307  call nemsio_readrecv(gfile, "tmp", "10-40 cm down", 1, dummy, 0, iret=rc)
4308  if (rc /= 0) call error_handler("READING LAYER 2 SOIL TEMP.", rc)
4309  dummy3d(:,:,2) = reshape(dummy, (/i_input,j_input/))
4310  call nemsio_readrecv(gfile, "tmp", "40-100 cm down", 1, dummy, 0, iret=rc)
4311  if (rc /= 0) call error_handler("READING LAYER 3 SOIL TEMP.", rc)
4312  dummy3d(:,:,3) = reshape(dummy, (/i_input,j_input/))
4313  call nemsio_readrecv(gfile, "tmp", "100-200 cm down", 1, dummy, 0, iret=rc)
4314  if (rc /= 0) call error_handler("READING LAYER 4 SOIL TEMP.", rc)
4315  dummy3d(:,:,4) = reshape(dummy, (/i_input,j_input/))
4316  print*,'soilt ',maxval(dummy3d),minval(dummy3d)
4317  endif
4318 
4319  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
4320  call esmf_fieldscatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc)
4321  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4322  call error_handler("IN FieldScatter", rc)
4323 
4324  deallocate(dummy3d, dummy)
4325 
4326  if (localpet == 0) call nemsio_close(gfile)
4327 
4328  end subroutine read_input_sfc_gaussian_nemsio_file
4329 
4334  subroutine read_input_sfc_restart_file(localpet)
4335 
4336  implicit none
4337 
4338  integer, intent(in) :: localpet
4339 
4340  character(len=500) :: tilefile
4341 
4342  integer :: error, rc
4343  integer :: id_dim, idim_input, jdim_input
4344  integer :: ncid, tile, id_var
4345 
4346  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
4347  real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:)
4348 
4349 !---------------------------------------------------------------------------
4350 ! Get i/j dimensions and number of soil layers from first surface file.
4351 ! Do dimensions match those from the orography file?
4352 !---------------------------------------------------------------------------
4353 
4354  tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
4355  print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile)
4356  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
4357  call netcdf_err(error, 'opening: '//trim(tilefile) )
4358 
4359  error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim)
4360  call netcdf_err(error, 'reading xaxis_1 id' )
4361  error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
4362  call netcdf_err(error, 'reading xaxis_1 value' )
4363 
4364  error=nf90_inq_dimid(ncid, 'yaxis_1', id_dim)
4365  call netcdf_err(error, 'reading yaxis_1 id' )
4366  error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
4367  call netcdf_err(error, 'reading yaxis_1 value' )
4368 
4369  if (idim_input /= i_input .or. jdim_input /= j_input) then
4370  call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 1)
4371  endif
4372 
4373  error = nf90_close(ncid)
4374 
4375  if (localpet == 0) then
4376  allocate(data_one_tile(idim_input,jdim_input))
4377  allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input))
4378  else
4379  allocate(data_one_tile(0,0))
4380  allocate(data_one_tile_3d(0,0,0))
4381  endif
4382 
4383  terrain_loop: do tile = 1, num_tiles_input_grid
4384 
4385  if (localpet == 0) then
4386  tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile))
4387  print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile)
4388  error=nf90_open(tilefile,nf90_nowrite,ncid)
4389  call netcdf_err(error, 'OPENING OROGRAPHY FILE' )
4390  error=nf90_inq_varid(ncid, 'orog_raw', id_var)
4391  call netcdf_err(error, 'READING OROG RECORD ID' )
4392  error=nf90_get_var(ncid, id_var, data_one_tile)
4393  call netcdf_err(error, 'READING OROG RECORD' )
4394  print*,'terrain check ',tile, maxval(data_one_tile)
4395  error=nf90_close(ncid)
4396  endif
4397 
4398  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
4399  call esmf_fieldscatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4400  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4401  call error_handler("IN FieldScatter", rc)
4402 
4403  enddo terrain_loop
4404 
4405  tile_loop : do tile = 1, num_tiles_input_grid
4406 
4407 ! liquid soil moisture
4408 
4409  if (localpet == 0) then
4410  call read_fv3_grid_data_netcdf('slc', tile, idim_input, jdim_input, &
4411  lsoil_input, sfcdata_3d=data_one_tile_3d)
4412  endif
4413 
4414  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
4415  call esmf_fieldscatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4416  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4417  call error_handler("IN FieldScatter", rc)
4418 
4419  if (localpet == 0) then
4420  call read_fv3_grid_data_netcdf('smc', tile, idim_input, jdim_input, &
4421  lsoil_input, sfcdata_3d=data_one_tile_3d)
4422  endif
4423 
4424  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
4425  call esmf_fieldscatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4426  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4427  call error_handler("IN FieldScatter", rc)
4428 
4429  if (localpet == 0) then
4430  call read_fv3_grid_data_netcdf('stc', tile, idim_input, jdim_input, &
4431  lsoil_input, sfcdata_3d=data_one_tile_3d)
4432  endif
4433 
4434  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
4435  call esmf_fieldscatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4436  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4437  call error_handler("IN FieldScatter", rc)
4438 
4439 ! land mask
4440 
4441  if (localpet == 0) then
4442  call read_fv3_grid_data_netcdf('slmsk', tile, idim_input, jdim_input, &
4443  lsoil_input, sfcdata=data_one_tile)
4444  endif
4445 
4446  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
4447  call esmf_fieldscatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4448  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4449  call error_handler("IN FieldScatter", rc)
4450 
4451 ! sea ice fraction
4452 
4453  if (localpet == 0) then
4454  call read_fv3_grid_data_netcdf('fice', tile, idim_input, jdim_input, &
4455  lsoil_input, sfcdata=data_one_tile)
4456  endif
4457 
4458  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION."
4459  call esmf_fieldscatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4460  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4461  call error_handler("IN FieldScatter", rc)
4462 
4463 ! sea ice depth
4464 
4465  if (localpet == 0) then
4466  call read_fv3_grid_data_netcdf('hice', tile, idim_input, jdim_input, &
4467  lsoil_input, sfcdata=data_one_tile)
4468  endif
4469 
4470  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH."
4471  call esmf_fieldscatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4472  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4473  call error_handler("IN FieldScatter", rc)
4474 
4475 ! sea ice skin temperature
4476 
4477  if (localpet == 0) then
4478  call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, &
4479  lsoil_input, sfcdata=data_one_tile)
4480  endif
4481 
4482  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE."
4483  call esmf_fieldscatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4484  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4485  call error_handler("IN FieldScatter", rc)
4486 
4487 ! liquid equivalent snow depth
4488 
4489  if (localpet == 0) then
4490  call read_fv3_grid_data_netcdf('sheleg', tile, idim_input, jdim_input, &
4491  lsoil_input, sfcdata=data_one_tile)
4492  endif
4493 
4494  print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT."
4495  call esmf_fieldscatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4496  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4497  call error_handler("IN FieldScatter", rc)
4498 
4499 ! physical snow depth
4500 
4501  if (localpet == 0) then
4502  call read_fv3_grid_data_netcdf('snwdph', tile, idim_input, jdim_input, &
4503  lsoil_input, sfcdata=data_one_tile)
4504  data_one_tile = data_one_tile
4505  endif
4506 
4507  print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH."
4508  call esmf_fieldscatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4509  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4510  call error_handler("IN FieldScatter", rc)
4511 
4512 ! Vegetation type
4513 
4514  if (localpet == 0) then
4515  call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, &
4516  lsoil_input, sfcdata=data_one_tile)
4517  endif
4518 
4519  print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE."
4520  call esmf_fieldscatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4521  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4522  call error_handler("IN FieldScatter", rc)
4523 
4524 ! Soil type
4525 
4526  if (localpet == 0) then
4527  call read_fv3_grid_data_netcdf('stype', tile, idim_input, jdim_input, &
4528  lsoil_input, sfcdata=data_one_tile)
4529  endif
4530 
4531  print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE."
4532  call esmf_fieldscatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4533  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4534  call error_handler("IN FieldScatter", rc)
4535 
4536 ! Two-meter temperature
4537 
4538  if (localpet == 0) then
4539  call read_fv3_grid_data_netcdf('t2m', tile, idim_input, jdim_input, &
4540  lsoil_input, sfcdata=data_one_tile)
4541  endif
4542 
4543  print*,"- CALL FieldScatter FOR INPUT GRID T2M."
4544  call esmf_fieldscatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4545  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4546  call error_handler("IN FieldScatter", rc)
4547 
4548 ! Two-meter q
4549 
4550  if (localpet == 0) then
4551  call read_fv3_grid_data_netcdf('q2m', tile, idim_input, jdim_input, &
4552  lsoil_input, sfcdata=data_one_tile)
4553  endif
4554 
4555  print*,"- CALL FieldScatter FOR INPUT GRID Q2M."
4556  call esmf_fieldscatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4557  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4558  call error_handler("IN FieldScatter", rc)
4559 
4560  if (localpet == 0) then
4561  call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, &
4562  lsoil_input, sfcdata=data_one_tile)
4563  endif
4564 
4565  print*,"- CALL FieldScatter FOR INPUT GRID TPRCP."
4566  call esmf_fieldscatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4567  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4568  call error_handler("IN FieldScatter", rc)
4569 
4570  if (localpet == 0) then
4571  call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, &
4572  lsoil_input, sfcdata=data_one_tile)
4573  endif
4574 
4575  print*,"- CALL FieldScatter FOR INPUT GRID F10M"
4576  call esmf_fieldscatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4577  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4578  call error_handler("IN FieldScatter", rc)
4579 
4580  if (localpet == 0) then
4581  call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, &
4582  lsoil_input, sfcdata=data_one_tile)
4583  endif
4584 
4585  print*,"- CALL FieldScatter FOR INPUT GRID FFMM"
4586  call esmf_fieldscatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4587  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4588  call error_handler("IN FieldScatter", rc)
4589 
4590  if (localpet == 0) then
4591  call read_fv3_grid_data_netcdf('uustar', tile, idim_input, jdim_input, &
4592  lsoil_input, sfcdata=data_one_tile)
4593  endif
4594 
4595  print*,"- CALL FieldScatter FOR INPUT GRID USTAR"
4596  call esmf_fieldscatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4597  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4598  call error_handler("IN FieldScatter", rc)
4599 
4600  if (localpet == 0) then
4601  call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, &
4602  lsoil_input, sfcdata=data_one_tile)
4603  endif
4604 
4605  print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG"
4606  call esmf_fieldscatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4607  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4608  call error_handler("IN FieldScatter", rc)
4609 
4610  if (localpet == 0) then
4611  call read_fv3_grid_data_netcdf('tsea', tile, idim_input, jdim_input, &
4612  lsoil_input, sfcdata=data_one_tile)
4613  endif
4614 
4615  print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE"
4616  call esmf_fieldscatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4617  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4618  call error_handler("IN FieldScatter", rc)
4619 
4620  if (localpet == 0) then
4621  call read_fv3_grid_data_netcdf('canopy', tile, idim_input, jdim_input, &
4622  lsoil_input, sfcdata=data_one_tile)
4623  endif
4624 
4625  print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT."
4626  call esmf_fieldscatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4627  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4628  call error_handler("IN FieldScatter", rc)
4629 
4630  if (localpet == 0) then
4631  call read_fv3_grid_data_netcdf('zorl', tile, idim_input, jdim_input, &
4632  lsoil_input, sfcdata=data_one_tile)
4633  endif
4634 
4635  print*,"- CALL FieldScatter FOR INPUT GRID Z0."
4636  call esmf_fieldscatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4637  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4638  call error_handler("IN FieldScatter", rc)
4639 
4640  enddo tile_loop
4641 
4642  deallocate(data_one_tile, data_one_tile_3d)
4643 
4644  end subroutine read_input_sfc_restart_file
4645 
4651  subroutine read_input_sfc_netcdf_file(localpet)
4652 
4653  implicit none
4654 
4655  integer, intent(in) :: localpet
4656 
4657  character(len=500) :: tilefile
4658 
4659  integer :: error, id_var
4660  integer :: id_dim, idim_input, jdim_input
4661  integer :: ncid, rc, tile
4662 
4663  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
4664  real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:)
4665 
4666 !---------------------------------------------------------------------------
4667 ! Get i/j dimensions and number of soil layers from first surface file.
4668 ! Do dimensions match those from the orography file?
4669 !---------------------------------------------------------------------------
4670 
4671  tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
4672  print*,"- READ GRID DIMENSIONS FROM: ", trim(tilefile)
4673  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
4674  call netcdf_err(error, 'opening: '//trim(tilefile) )
4675 
4676  error=nf90_inq_dimid(ncid, 'grid_xt', id_dim)
4677  call netcdf_err(error, 'reading grid_xt id' )
4678  error=nf90_inquire_dimension(ncid,id_dim,len=idim_input)
4679  call netcdf_err(error, 'reading grid_xt value' )
4680 
4681  error=nf90_inq_dimid(ncid, 'grid_yt', id_dim)
4682  call netcdf_err(error, 'reading grid_yt id' )
4683  error=nf90_inquire_dimension(ncid,id_dim,len=jdim_input)
4684  call netcdf_err(error, 'reading grid_yt value' )
4685 
4686  if (idim_input /= i_input .or. jdim_input /= j_input) then
4687  call error_handler("DIMENSION MISMATCH BETWEEN SFC AND OROG FILES.", 3)
4688  endif
4689 
4690  error = nf90_close(ncid)
4691 
4692  if (localpet == 0) then
4693  allocate(data_one_tile(idim_input,jdim_input))
4694  allocate(data_one_tile_3d(idim_input,jdim_input,lsoil_input))
4695  else
4696  allocate(data_one_tile(0,0))
4697  allocate(data_one_tile_3d(0,0,0))
4698  endif
4699 
4700  terrain_loop: do tile = 1, num_tiles_input_grid
4701 
4702  if (trim(input_type) == "gaussian_netcdf") then
4703  if (localpet == 0) then
4704  call read_fv3_grid_data_netcdf('orog', tile, idim_input, jdim_input, &
4705  lsoil_input, sfcdata=data_one_tile)
4706  endif
4707 
4708  else
4709 
4710  if (localpet == 0) then
4711  tilefile = trim(orog_dir_input_grid) // trim(orog_files_input_grid(tile))
4712  print*,'- OPEN OROGRAPHY FILE: ', trim(tilefile)
4713  error=nf90_open(tilefile,nf90_nowrite,ncid)
4714  call netcdf_err(error, 'OPENING OROGRAPHY FILE.' )
4715  error=nf90_inq_varid(ncid, 'orog_raw', id_var)
4716  call netcdf_err(error, 'READING OROGRAPHY RECORD ID.' )
4717  error=nf90_get_var(ncid, id_var, data_one_tile)
4718  call netcdf_err(error, 'READING OROGRAPHY RECORD.' )
4719  print*,'terrain check history ',tile, maxval(data_one_tile)
4720  error=nf90_close(ncid)
4721  endif
4722 
4723  endif
4724 
4725  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
4726  call esmf_fieldscatter(terrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4727  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4728  call error_handler("IN FieldScatter", rc)
4729 
4730  enddo terrain_loop
4731 
4732  tile_loop : do tile = 1, num_tiles_input_grid
4733 
4734 ! liquid soil moisture
4735 
4736  if (localpet == 0) then
4737  call read_fv3_grid_data_netcdf('soill1', tile, idim_input, jdim_input, &
4738  lsoil_input, sfcdata=data_one_tile)
4739  data_one_tile_3d(:,:,1) = data_one_tile
4740  call read_fv3_grid_data_netcdf('soill2', tile, idim_input, jdim_input, &
4741  lsoil_input, sfcdata=data_one_tile)
4742  data_one_tile_3d(:,:,2) = data_one_tile
4743  call read_fv3_grid_data_netcdf('soill3', tile, idim_input, jdim_input, &
4744  lsoil_input, sfcdata=data_one_tile)
4745  data_one_tile_3d(:,:,3) = data_one_tile
4746  call read_fv3_grid_data_netcdf('soill4', tile, idim_input, jdim_input, &
4747  lsoil_input, sfcdata=data_one_tile)
4748  data_one_tile_3d(:,:,4) = data_one_tile
4749  endif
4750 
4751  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
4752  call esmf_fieldscatter(soilm_liq_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4753  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4754  call error_handler("IN FieldScatter", rc)
4755 
4756 ! total soil moisture
4757 
4758  if (localpet == 0) then
4759  call read_fv3_grid_data_netcdf('soilw1', tile, idim_input, jdim_input, &
4760  lsoil_input, sfcdata=data_one_tile)
4761  data_one_tile_3d(:,:,1) = data_one_tile
4762  call read_fv3_grid_data_netcdf('soilw2', tile, idim_input, jdim_input, &
4763  lsoil_input, sfcdata=data_one_tile)
4764  data_one_tile_3d(:,:,2) = data_one_tile
4765  call read_fv3_grid_data_netcdf('soilw3', tile, idim_input, jdim_input, &
4766  lsoil_input, sfcdata=data_one_tile)
4767  data_one_tile_3d(:,:,3) = data_one_tile
4768  call read_fv3_grid_data_netcdf('soilw4', tile, idim_input, jdim_input, &
4769  lsoil_input, sfcdata=data_one_tile)
4770  data_one_tile_3d(:,:,4) = data_one_tile
4771  endif
4772 
4773  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
4774  call esmf_fieldscatter(soilm_tot_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4775  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4776  call error_handler("IN FieldScatter", rc)
4777 
4778 ! soil tempeature (ice temp at land ice points)
4779 
4780  if (localpet == 0) then
4781  call read_fv3_grid_data_netcdf('soilt1', tile, idim_input, jdim_input, &
4782  lsoil_input, sfcdata=data_one_tile)
4783  data_one_tile_3d(:,:,1) = data_one_tile
4784  call read_fv3_grid_data_netcdf('soilt2', tile, idim_input, jdim_input, &
4785  lsoil_input, sfcdata=data_one_tile)
4786  data_one_tile_3d(:,:,2) = data_one_tile
4787  call read_fv3_grid_data_netcdf('soilt3', tile, idim_input, jdim_input, &
4788  lsoil_input, sfcdata=data_one_tile)
4789  data_one_tile_3d(:,:,3) = data_one_tile
4790  call read_fv3_grid_data_netcdf('soilt4', tile, idim_input, jdim_input, &
4791  lsoil_input, sfcdata=data_one_tile)
4792  data_one_tile_3d(:,:,4) = data_one_tile
4793  endif
4794 
4795  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
4796  call esmf_fieldscatter(soil_temp_input_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
4797  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4798  call error_handler("IN FieldScatter", rc)
4799 
4800 ! land mask
4801 
4802  if (localpet == 0) then
4803  call read_fv3_grid_data_netcdf('land', tile, idim_input, jdim_input, &
4804  lsoil_input, sfcdata=data_one_tile)
4805  endif
4806 
4807  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
4808  call esmf_fieldscatter(landsea_mask_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4809  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4810  call error_handler("IN FieldScatter", rc)
4811 
4812 ! sea ice fraction
4813 
4814  if (localpet == 0) then
4815  call read_fv3_grid_data_netcdf('icec', tile, idim_input, jdim_input, &
4816  lsoil_input, sfcdata=data_one_tile)
4817  endif
4818 
4819  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION."
4820  call esmf_fieldscatter(seaice_fract_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4821  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4822  call error_handler("IN FieldScatter", rc)
4823 
4824 ! sea ice depth
4825 
4826  if (localpet == 0) then
4827  call read_fv3_grid_data_netcdf('icetk', tile, idim_input, jdim_input, &
4828  lsoil_input, sfcdata=data_one_tile)
4829  endif
4830 
4831  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH."
4832  call esmf_fieldscatter(seaice_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4833  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4834  call error_handler("IN FieldScatter", rc)
4835 
4836 ! sea ice skin temperature
4837 
4838  if (localpet == 0) then
4839  call read_fv3_grid_data_netcdf('tisfc', tile, idim_input, jdim_input, &
4840  lsoil_input, sfcdata=data_one_tile)
4841  endif
4842 
4843  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE."
4844  call esmf_fieldscatter(seaice_skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4845  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4846  call error_handler("IN FieldScatter", rc)
4847 
4848 ! liquid equivalent snow depth
4849 
4850  if (localpet == 0) then
4851  call read_fv3_grid_data_netcdf('weasd', tile, idim_input, jdim_input, &
4852  lsoil_input, sfcdata=data_one_tile)
4853  endif
4854 
4855  print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT."
4856  call esmf_fieldscatter(snow_liq_equiv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4857  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4858  call error_handler("IN FieldScatter", rc)
4859 
4860 ! physical snow depth
4861 
4862  if (localpet == 0) then
4863  call read_fv3_grid_data_netcdf('snod', tile, idim_input, jdim_input, &
4864  lsoil_input, sfcdata=data_one_tile)
4865  data_one_tile = data_one_tile * 1000.0 ! convert from meters to mm.
4866  endif
4867 
4868  print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH."
4869  call esmf_fieldscatter(snow_depth_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4870  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4871  call error_handler("IN FieldScatter", rc)
4872 
4873 ! Vegetation type
4874 
4875  if (localpet == 0) then
4876  call read_fv3_grid_data_netcdf('vtype', tile, idim_input, jdim_input, &
4877  lsoil_input, sfcdata=data_one_tile)
4878  endif
4879 
4880  print*,"- CALL FieldScatter FOR INPUT GRID VEG TYPE."
4881  call esmf_fieldscatter(veg_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4882  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4883  call error_handler("IN FieldScatter", rc)
4884 
4885 ! Soil type
4886 
4887  if (localpet == 0) then
4888  call read_fv3_grid_data_netcdf('sotyp', tile, idim_input, jdim_input, &
4889  lsoil_input, sfcdata=data_one_tile)
4890  endif
4891 
4892  print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE."
4893  call esmf_fieldscatter(soil_type_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4894  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4895  call error_handler("IN FieldScatter", rc)
4896 
4897 ! Two-meter temperature
4898 
4899  if (localpet == 0) then
4900  call read_fv3_grid_data_netcdf('tmp2m', tile, idim_input, jdim_input, &
4901  lsoil_input, sfcdata=data_one_tile)
4902  endif
4903 
4904  print*,"- CALL FieldScatter FOR INPUT GRID T2M."
4905  call esmf_fieldscatter(t2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4906  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4907  call error_handler("IN FieldScatter", rc)
4908 
4909 ! Two-meter q
4910 
4911  if (localpet == 0) then
4912  call read_fv3_grid_data_netcdf('spfh2m', tile, idim_input, jdim_input, &
4913  lsoil_input, sfcdata=data_one_tile)
4914  endif
4915 
4916  print*,"- CALL FieldScatter FOR INPUT GRID Q2M."
4917  call esmf_fieldscatter(q2m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4918  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4919  call error_handler("IN FieldScatter", rc)
4920 
4921  if (localpet == 0) then
4922  call read_fv3_grid_data_netcdf('tprcp', tile, idim_input, jdim_input, &
4923  lsoil_input, sfcdata=data_one_tile)
4924  endif
4925 
4926  print*,"- CALL FieldScatter FOR INPUT GRID TPRCP."
4927  call esmf_fieldscatter(tprcp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4928  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4929  call error_handler("IN FieldScatter", rc)
4930 
4931  if (localpet == 0) then
4932  call read_fv3_grid_data_netcdf('f10m', tile, idim_input, jdim_input, &
4933  lsoil_input, sfcdata=data_one_tile)
4934  endif
4935 
4936  print*,"- CALL FieldScatter FOR INPUT GRID F10M"
4937  call esmf_fieldscatter(f10m_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4938  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4939  call error_handler("IN FieldScatter", rc)
4940 
4941  if (localpet == 0) then
4942  call read_fv3_grid_data_netcdf('ffmm', tile, idim_input, jdim_input, &
4943  lsoil_input, sfcdata=data_one_tile)
4944  endif
4945 
4946  print*,"- CALL FieldScatter FOR INPUT GRID FFMM"
4947  call esmf_fieldscatter(ffmm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4948  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4949  call error_handler("IN FieldScatter", rc)
4950 
4951  if (localpet == 0) then
4952  call read_fv3_grid_data_netcdf('fricv', tile, idim_input, jdim_input, &
4953  lsoil_input, sfcdata=data_one_tile)
4954  endif
4955 
4956  print*,"- CALL FieldScatter FOR INPUT GRID USTAR"
4957  call esmf_fieldscatter(ustar_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4958  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4959  call error_handler("IN FieldScatter", rc)
4960 
4961  if (localpet == 0) then
4962 ! call read_fv3_grid_data_netcdf('srflag', tile, idim_input, jdim_input, &
4963 ! lsoil_input, sfcdata=data_one_tile)
4964  data_one_tile = 0.0
4965  endif
4966 
4967  print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG"
4968  call esmf_fieldscatter(srflag_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4969  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4970  call error_handler("IN FieldScatter", rc)
4971 
4972  if (localpet == 0) then
4973  call read_fv3_grid_data_netcdf('tmpsfc', tile, idim_input, jdim_input, &
4974  lsoil_input, sfcdata=data_one_tile)
4975  endif
4976 
4977  print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE"
4978  call esmf_fieldscatter(skin_temp_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4979  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4980  call error_handler("IN FieldScatter", rc)
4981 
4982  if (localpet == 0) then
4983  call read_fv3_grid_data_netcdf('cnwat', tile, idim_input, jdim_input, &
4984  lsoil_input, sfcdata=data_one_tile)
4985  endif
4986 
4987  print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT."
4988  call esmf_fieldscatter(canopy_mc_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4989  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
4990  call error_handler("IN FieldScatter", rc)
4991 
4992  if (localpet == 0) then
4993  call read_fv3_grid_data_netcdf('sfcr', tile, idim_input, jdim_input, &
4994  lsoil_input, sfcdata=data_one_tile)
4995  endif
4996 
4997  print*,"- CALL FieldScatter FOR INPUT GRID Z0."
4998  call esmf_fieldscatter(z0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
4999  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5000  call error_handler("IN FieldScatter", rc)
5001 
5002  enddo tile_loop
5003 
5004  deallocate(data_one_tile, data_one_tile_3d)
5005 
5006  end subroutine read_input_sfc_netcdf_file
5007 
5012  subroutine read_input_sfc_grib2_file(localpet)
5013 
5014  use mpi
5015  use grib_mod
5016  use program_setup, only : vgtyp_from_climo, sotyp_from_climo
5017  use model_grid, only : input_grid_type
5018  use search_util
5019 
5020  implicit none
5021 
5022  integer, intent(in) :: localpet
5023 
5024  character(len=250) :: the_file
5025  character(len=250) :: geo_file
5026  character(len=20) :: vname, vname_file, slev
5027  character(len=50) :: method
5028  character(len=20) :: to_upper
5029 
5030  integer :: rc, varnum, iret, i, j,k
5031  integer :: ncid2d, varid, varsize
5032  integer :: lugb, lugi
5033  integer :: jdisc, jgdtn, jpdtn, pdt_num
5034  integer :: jids(200), jgdt(200), jpdt(200)
5035 
5036  logical :: rap_latlon, unpack
5037 
5038  real(esmf_kind_r4) :: value
5039  real(esmf_kind_r4), allocatable :: dummy2d(:,:)
5040  real(esmf_kind_r8), allocatable :: icec_save(:,:)
5041  real(esmf_kind_r4), allocatable :: dummy1d(:)
5042  real(esmf_kind_r8), allocatable :: dummy2d_8(:,:),dummy2d_82(:,:),tsk_save(:,:)
5043  real(esmf_kind_r8), allocatable :: dummy3d(:,:,:), dummy3d_stype(:,:,:)
5044  integer(esmf_kind_i4), allocatable :: slmsk_save(:,:)
5045  integer(esmf_kind_i8), allocatable :: dummy2d_i(:,:)
5046 
5047  type(gribfield) :: gfld
5048 
5049  rap_latlon = trim(to_upper(external_model))=="RAP" .and. trim(input_grid_type) == "rotated_latlon"
5050 
5051  the_file = trim(data_dir_input_grid) // "/" // trim(grib2_file_input_grid)
5052  geo_file = trim(geogrid_file_input_grid)
5053 
5054  print*,"- READ SFC DATA FROM GRIB2 FILE: ", trim(the_file)
5055 
5056 ! Determine the number of soil layers in file.
5057 
5058  if (localpet == 0) then
5059 
5060  lugb=12
5061  call baopenr(lugb,the_file,rc)
5062  if (rc /= 0) call error_handler("ERROR OPENING GRIB2 FILE.", rc)
5063 
5064  j = 0 ! search at beginning of file
5065  lugi = 0 ! no grib index file
5066  jdisc = -1 ! search for any discipline
5067  jpdtn = -1 ! search for any product definition template number
5068  jgdtn = -1 ! search for any grid definition template number
5069  jids = -9999 ! array of values in identification section, set to wildcard
5070  jgdt = -9999 ! array of values in grid definition template, set to wildcard
5071  jpdt = -9999 ! array of values in product definition template, set to wildcard
5072  unpack = .false. ! unpack data
5073 
5074  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5075  unpack, k, gfld, rc)
5076 
5077  if (rc == 0) then
5078  if (gfld%idsect(1) == 7 .and. gfld%idsect(2) == 2) then
5079  print*,'- THIS IS NCEP GEFS DATA.'
5080  pdt_num = 1
5081  else
5082  pdt_num = 0
5083  endif
5084  else
5085  if (rc /= 0) call error_handler("ERROR READING GRIB2 FILE.", rc)
5086  endif
5087 
5088  j = 0
5089  lsoil_input = 0
5090 
5091  do
5092 
5093  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5094  unpack, k, gfld, rc)
5095 
5096  if (rc /= 0) exit
5097 
5098  if (gfld%discipline == 2) then ! discipline - land products
5099  if (gfld%ipdtnum == pdt_num) then ! prod template number - analysis or forecast at single level.
5100  if (gfld%ipdtmpl(1) == 0 .and. gfld%ipdtmpl(2) == 2) then ! soil temp
5101  ! Sect4/octs 10 and 11
5102  if (gfld%ipdtmpl(10) == 106 .and. gfld%ipdtmpl(13) == 106) then ! Sect4/octs 23/29.
5103  ! Layer below ground.
5104  lsoil_input = lsoil_input + 1
5105  endif
5106  endif
5107  endif
5108  endif
5109 
5110  j = k
5111 
5112  enddo
5113 
5114  print*, "- FILE HAS ", lsoil_input, " SOIL LEVELS."
5115  if (lsoil_input == 0) call error_handler("COUNTING SOIL LEVELS.", rc)
5116 
5117  endif ! localpet == 0
5118 
5119  call mpi_barrier(mpi_comm_world, rc)
5120  call mpi_bcast(lsoil_input,1,mpi_integer,0,mpi_comm_world,rc)
5121 
5122  ! We need to recreate the soil fields if we have something other than 4 levels
5123 
5124  if (lsoil_input /= 4) then
5125 
5126  call esmf_fielddestroy(soil_temp_input_grid, rc=rc)
5127  call esmf_fielddestroy(soilm_tot_input_grid, rc=rc)
5128  call esmf_fielddestroy(soilm_liq_input_grid, rc=rc)
5129 
5130  print*,"- CALL FieldCreate FOR INPUT SOIL TEMPERATURE."
5131  soil_temp_input_grid = esmf_fieldcreate(input_grid, &
5132  typekind=esmf_typekind_r8, &
5133  staggerloc=esmf_staggerloc_center, &
5134  ungriddedlbound=(/1/), &
5135  ungriddedubound=(/lsoil_input/), rc=rc)
5136  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5137  call error_handler("IN FieldCreate", rc)
5138 
5139  print*,"- CALL FieldCreate FOR INPUT TOTAL SOIL MOISTURE."
5140  soilm_tot_input_grid = esmf_fieldcreate(input_grid, &
5141  typekind=esmf_typekind_r8, &
5142  staggerloc=esmf_staggerloc_center, &
5143  ungriddedlbound=(/1/), &
5144  ungriddedubound=(/lsoil_input/), rc=rc)
5145  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5146  call error_handler("IN FieldCreate", rc)
5147 
5148  print*,"- CALL FieldCreate FOR INPUT LIQUID SOIL MOISTURE."
5149  soilm_liq_input_grid = esmf_fieldcreate(input_grid, &
5150  typekind=esmf_typekind_r8, &
5151  staggerloc=esmf_staggerloc_center, &
5152  ungriddedlbound=(/1/), &
5153  ungriddedubound=(/lsoil_input/), rc=rc)
5154  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5155  call error_handler("IN FieldCreate", rc)
5156 
5157  endif
5158 
5159  if (localpet == 0) then
5160  allocate(dummy2d(i_input,j_input))
5161  allocate(slmsk_save(i_input,j_input))
5162  allocate(tsk_save(i_input,j_input))
5163  allocate(icec_save(i_input,j_input))
5164  allocate(dummy2d_8(i_input,j_input))
5165  allocate(dummy2d_82(i_input,j_input))
5166  allocate(dummy3d(i_input,j_input,lsoil_input))
5167  else
5168  allocate(dummy3d(0,0,0))
5169  allocate(dummy2d_8(0,0))
5170  allocate(dummy2d_82(0,0))
5171  allocate(dummy2d(0,0))
5172  allocate(slmsk_save(0,0))
5173  endif
5174 
5175  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5176  ! These variables are always in grib files, or are required, so no need to check for them
5177  ! in the varmap table. If they can't be found in the input file, then stop the program.
5178  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5179 
5180  if (localpet == 0) then
5181 
5182  print*,"- READ TERRAIN."
5183 
5184  j = 0
5185  jdisc = 0 ! Search for discipline 0 - meteorological products
5186  jpdt = -9999 ! array of values in product definition template, set to wildcard.
5187  jpdtn = pdt_num ! search for product definition template number 0 - anl or fcst.
5188  jpdt(1) = 3 ! Sec4/oct 10 - param cat - mass field
5189  jpdt(2) = 5 ! Sec4/oct 11 - param number - geopotential height
5190  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5191  unpack=.true.
5192  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5193  unpack, k, gfld, rc)
5194  if (rc /= 0) call error_handler("READING TERRAIN.", rc)
5195 
5196  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5197 ! print*,'orog ', maxval(dummy2d_8),minval(dummy2d_8)
5198 
5199  endif
5200 
5201  print*,"- CALL FieldScatter FOR INPUT TERRAIN."
5202  call esmf_fieldscatter(terrain_input_grid, dummy2d_8, rootpet=0, rc=rc)
5203  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5204  call error_handler("IN FieldScatter", rc)
5205 
5206  if (localpet == 0) then
5207 
5208  print*,"- READ SEAICE FRACTION."
5209 
5210  jdisc = 10 ! Search for discipline - ocean products
5211  j = 0 ! Search at beginning of file.
5212  jpdtn = pdt_num ! Search for product def template number 0 - anl or fcst.
5213  jpdt = -9999 ! Array of values in Sec 4 product definition template;
5214  ! Initialize to wildcard.
5215  jpdt(1) = 2 ! Sec4/oct 10 - parameter category - ice
5216  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - ice cover
5217  unpack=.true.
5218  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5219  unpack, k, gfld, rc)
5220  if (rc /= 0) call error_handler("READING SEAICE FRACTION.", rc)
5221 
5222  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5223 ! print*,'icec ', maxval(dummy2d_8),minval(dummy2d_8)
5224 
5225  icec_save = dummy2d_8
5226 
5227  endif
5228 
5229  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE FRACTION."
5230  call esmf_fieldscatter(seaice_fract_input_grid, dummy2d_8 ,rootpet=0, rc=rc)
5231  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5232  call error_handler("IN FieldScatter", rc)
5233 
5234 !----------------------------------------------------------------------------------
5235 ! GFS v14 and v15.2 grib data has two land masks. LANDN is created by
5236 ! nearest neighbor interpolation. LAND is created by bilinear interpolation.
5237 ! LANDN matches the bitmap. So use it first. For other GFS versions or other models,
5238 ! use LAND. Mask in grib file is '1' (land), '0' (not land). Add sea/lake ice category
5239 ! '2' based on ice concentration.
5240 !----------------------------------------------------------------------------------
5241 
5242  if (localpet == 0) then
5243 
5244  print*,"- READ LANDSEA MASK."
5245 
5246  jdisc = 2 ! Search for discipline - land products
5247  j = 0 ! Search at beginning of file.
5248  jpdtn = pdt_num ! Search for product definition template number 0 - anl or fcst.
5249  jpdt = -9999 ! Initialize array of values in product definition template - Sec 4.
5250  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5251  jpdt(2) = 218 ! Sec4/oct 11 - parameter number - land nearest neighbor
5252  unpack=.true.
5253  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5254  unpack, k, gfld, rc)
5255 
5256  if (rc == 0) then
5257 
5258  print*,'landnn ', maxval(gfld%fld),minval(gfld%fld)
5259 
5260  else
5261 
5262  jdisc = 2 ! Search for discipline - land products
5263  j = 0 ! Search at beginning of file.
5264  jpdtn = pdt_num ! Search for product def template number 0 - anl or fcst.
5265  jpdt = -9999 ! Initialize array of values in product definition template - Sec 4.
5266  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5267  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - land cover (fraction)
5268  unpack=.true.
5269  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5270  unpack, k, gfld, rc)
5271  if (rc /= 0) call error_handler("READING LANDSEA MASK.", rc)
5272 
5273 ! print*,'land ', maxval(gfld%fld),minval(gfld%fld)
5274 
5275  endif
5276 
5277  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5278 
5279  do j = 1, j_input
5280  do i = 1, i_input
5281  if(dummy2d_8(i,j) < 0.5_esmf_kind_r8) dummy2d_8(i,j)=0.0
5282  if(icec_save(i,j) > 0.15_esmf_kind_r8) then
5283  dummy2d_8(i,j) = 2.0_esmf_kind_r8
5284  endif
5285  enddo
5286  enddo
5287 
5288  slmsk_save = nint(dummy2d_8)
5289 
5290  deallocate(icec_save)
5291 
5292  endif ! read land mask
5293 
5294  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
5295  call esmf_fieldscatter(landsea_mask_input_grid, dummy2d_8 ,rootpet=0, rc=rc)
5296  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5297  call error_handler("IN FieldScatter", rc)
5298 
5299  if (localpet == 0) then
5300 
5301  print*,"- READ SEAICE SKIN TEMPERATURE."
5302 
5303  jdisc = 0 ! Search for discipline - meteorological products
5304  j = 0 ! Search at beginning of file.
5305  jpdtn = pdt_num ! Search for product definition template number 0 - anl or fcst.
5306  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5307  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature
5308  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature
5309  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5310  unpack=.true.
5311  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5312  unpack, k, gfld, rc)
5313  if (rc /= 0) call error_handler("READING SEAICE SKIN TEMP.", rc)
5314 
5315 ! print*,'ti ',maxval(gfld%fld),minval(gfld%fld)
5316 
5317  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5318 
5319  endif
5320 
5321  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE SKIN TEMPERATURE."
5322  call esmf_fieldscatter(seaice_skin_temp_input_grid, dummy2d_8 ,rootpet=0, rc=rc)
5323  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5324  call error_handler("IN FieldScatter", rc)
5325 
5326 !----------------------------------------------------------------------------------
5327 ! Read snow fields. Zero out at non-land points and undefined points (points
5328 ! removed using the bitmap). Program expects depth and liquid equivalent
5329 ! in mm.
5330 !----------------------------------------------------------------------------------
5331 
5332  if (localpet == 0) then
5333 
5334  print*,"- READ SNOW LIQUID EQUIVALENT."
5335 
5336  jdisc = 0 ! Search for discipline - meteorological products
5337  j = 0 ! Search at beginning of file.
5338  jpdtn = pdt_num ! Search for the product definition template number.
5339  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5340  jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture
5341  jpdt(2) = 13 ! Sec4/oct 11 - parameter number - liquid equiv snow depth
5342  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5343  unpack=.true.
5344 
5345  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5346  unpack, k, gfld, rc)
5347  if (rc /= 0) call error_handler("READING SNOW LIQUID EQUIVALENT.", rc)
5348 
5349 ! print*,'weasd ', maxval(gfld%fld),minval(gfld%fld)
5350 
5351  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5352 
5353  do j = 1, j_input
5354  do i = 1, i_input
5355  if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0
5356  enddo
5357  enddo
5358 
5359  endif
5360 
5361  print*,"- CALL FieldScatter FOR INPUT GRID SNOW LIQUID EQUIVALENT."
5362  call esmf_fieldscatter(snow_liq_equiv_input_grid, dummy2d_8 ,rootpet=0, rc=rc)
5363  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5364  call error_handler("IN FieldScatter", rc)
5365 
5366  if (localpet == 0) then
5367 
5368  print*,"- READ SNOW DEPTH."
5369 
5370  jdisc = 0 ! Search for discipline - meteorological products
5371  j = 0 ! Search at beginning of file.
5372  jpdtn = pdt_num ! Search for the product definition template number.
5373  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5374  jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture
5375  jpdt(2) = 11 ! Sec4/oct 11 - parameter number - snow depth
5376  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5377  unpack=.true.
5378 
5379  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5380  unpack, k, gfld, rc)
5381 
5382  if (rc /= 0) then
5383  call error_handler("READING SNOW DEPTH.", rc)
5384  else
5385  gfld%fld = gfld%fld * 1000.0
5386 ! print*,'snod ', maxval(gfld%fld),minval(gfld%fld)
5387  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5388  endif
5389 
5390  do j = 1, j_input
5391  do i = 1, i_input
5392  if(slmsk_save(i,j) == 0) dummy2d_8(i,j) = 0.0
5393  enddo
5394  enddo
5395 
5396  endif
5397 
5398  print*,"- CALL FieldScatter FOR INPUT GRID SNOW DEPTH."
5399  call esmf_fieldscatter(snow_depth_input_grid,dummy2d_8,rootpet=0, rc=rc)
5400  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5401  call error_handler("IN FieldScatter", rc)
5402 
5403  if (localpet == 0) then
5404 
5405  print*,"- READ T2M."
5406 
5407  jdisc = 0 ! Search for discipline - meteorological products
5408  j = 0 ! Search at beginning of file.
5409  jpdtn = pdt_num ! Search for the product definition template number.
5410  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5411  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature
5412  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature
5413  jpdt(10) = 103 ! Sec4/oct 23 - type of level - height above ground surface
5414  jpdt(12) = 2 ! Sec4/octs 25-28 - 2 meters above ground.
5415  unpack=.true.
5416 
5417  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5418  unpack, k, gfld, rc)
5419 
5420  if (rc /= 0) call error_handler("READING T2M.", rc)
5421 ! print*,'t2m ', maxval(gfld%fld),minval(gfld%fld)
5422 
5423  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5424 
5425  endif
5426 
5427  print*,"- CALL FieldScatter FOR INPUT GRID T2M."
5428  call esmf_fieldscatter(t2m_input_grid, dummy2d_8, rootpet=0,rc=rc)
5429  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5430  call error_handler("IN FieldScatter", rc)
5431 
5432  if (localpet == 0) then
5433 
5434  print*,"- READ Q2M."
5435 
5436  jdisc = 0 ! Search for discipline - meteorological products
5437  j = 0 ! Search at beginning of file.
5438  jpdtn = pdt_num ! Search for the product definition template number.
5439  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5440  jpdt(1) = 1 ! Sec4/oct 10 - parameter category - moisture
5441  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - specific humidity
5442  jpdt(10) = 103 ! Sec4/oct 23 - type of level - height above ground surface
5443  jpdt(12) = 2 ! Sec4/octs 25-28 - 2 meters above ground.
5444  unpack=.true.
5445 
5446  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5447  unpack, k, gfld, rc)
5448  if (rc /=0) call error_handler("READING Q2M.", rc)
5449 
5450 ! print*,'q2m ',maxval(gfld%fld),minval(gfld%fld)
5451 
5452  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5453 
5454  endif
5455 
5456  print*,"- CALL FieldScatter FOR INPUT GRID Q2M."
5457  call esmf_fieldscatter(q2m_input_grid,dummy2d_8, rootpet=0,rc=rc)
5458  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5459  call error_handler("IN FieldScatter", rc)
5460 
5461  if (localpet == 0) then
5462 
5463  print*,"- READ SKIN TEMPERATURE."
5464 
5465  jdisc = 0 ! Search for discipline - meteorological products
5466  j = 0 ! Search at beginning of file.
5467  jpdtn = pdt_num ! Search for the product definition template number.
5468  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5469  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - temperature
5470  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - temperature
5471  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5472  unpack=.true.
5473 
5474  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5475  unpack, k, gfld, rc)
5476 
5477  if (rc /= 0 ) call error_handler("READING SKIN TEMPERATURE.", rc)
5478 ! print*,'skint ', maxval(gfld%fld),minval(gfld%fld)
5479 
5480  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5481 
5482  tsk_save(:,:) = dummy2d_8
5483 
5484  do j = 1, j_input
5485  do i = 1, i_input
5486  if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) < 271.2) then
5487 ! print*,'too cool SST ',i,j,dummy2d_8(i,j)
5488  dummy2d_8(i,j) = 271.2
5489  endif
5490  if(slmsk_save(i,j) == 0 .and. dummy2d_8(i,j) > 310.) then
5491 ! print*,'too hot SST ',i,j,dummy2d_8(i,j)
5492  dummy2d_8(i,j) = 310.0
5493  endif
5494  enddo
5495  enddo
5496 
5497  endif
5498 
5499  print*,"- CALL FieldScatter FOR INPUT GRID SKIN TEMPERATURE"
5500  call esmf_fieldscatter(skin_temp_input_grid,dummy2d_8,rootpet=0, rc=rc)
5501  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5502  call error_handler("IN FieldScatter", rc)
5503 
5504 ! srflag not in files. Set to zero.
5505 
5506  if (localpet == 0) dummy2d_8 = 0.0
5507 
5508  print*,"- CALL FieldScatter FOR INPUT GRID SRFLAG"
5509  call esmf_fieldscatter(srflag_input_grid,dummy2d_8, rootpet=0,rc=rc)
5510  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5511  call error_handler("IN FieldScatter", rc)
5512 
5513  if (localpet == 0) then
5514 
5515  print*,"- READ SOIL TYPE."
5516 
5517  jdisc = 2 ! Search for discipline - land products
5518  j = 0 ! Search at beginning of file
5519  jpdtn = pdt_num ! Search for the product definition template number.
5520  jpdt = -9999 ! Initialize array of values in product definition template - Sec4
5521  jpdt(1) = 3 ! Sec4/oct 10 - parameter category - soil products
5522  jpdt(2) = 0 ! Sec4/oct 11 - parameter number - soil type
5523  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5524  unpack=.true.
5525 
5526  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5527  unpack, k, gfld, rc)
5528 
5529  if (rc == 0 ) then
5530 ! print*,'soil type ', maxval(gfld%fld),minval(gfld%fld)
5531  dummy2d = reshape(gfld%fld , (/i_input,j_input/))
5532 
5533  endif
5534 
5535  if (rc /= 0 .and. (trim(to_upper(external_model))=="HRRR" .or. rap_latlon) .and. geo_file .ne. "NULL") then
5536  ! Some HRRR and RAP files don't have dominant soil type in the output, but the geogrid files
5537  ! do, so this gives users the option to provide the geogrid file and use input soil
5538  ! type
5539  print*, "OPEN GEOGRID FILE ", trim(geo_file)
5540  rc = nf90_open(geo_file,nf90_nowrite,ncid2d)
5541  call netcdf_err(rc,"READING GEOGRID FILE")
5542 
5543  print*, "INQURE ABOUT DIM IDS"
5544  rc = nf90_inq_dimid(ncid2d,"west_east",varid)
5545  call netcdf_err(rc,"READING west_east DIMENSION FROM GEOGRID FILE")
5546 
5547  rc = nf90_inquire_dimension(ncid2d,varid,len=varsize)
5548  call netcdf_err(rc,"READING west_east DIMENSION SIZE")
5549  if (varsize .ne. i_input) call error_handler ("GEOGRID FILE GRID SIZE DIFFERS FROM INPUT DATA.", -1)
5550 
5551  print*, "INQUIRE ABOUT SOIL TYPE FROM GEOGRID FILE"
5552  rc = nf90_inq_varid(ncid2d,"SCT_DOM",varid)
5553  call netcdf_err(rc,"FINDING SCT_DOM IN GEOGRID FILE")
5554 
5555  print*, "READ SOIL TYPE FROM GEOGRID FILE "
5556  rc = nf90_get_var(ncid2d,varid,dummy2d)
5557  call netcdf_err(rc,"READING SCT_DOM FROM FILE")
5558 
5559  print*, "INQUIRE ABOUT SOIL TYPE FRACTIONS FROM GEOGRID FILE"
5560  rc = nf90_inq_varid(ncid2d,"SOILCTOP",varid)
5561  call netcdf_err(rc,"FINDING SOILCTOP IN GEOGRID FILE")
5562 
5563  allocate(dummy3d_stype(i_input,j_input,16))
5564  print*, "READ SOIL TYPE FRACTIONS FROM GEOGRID FILE "
5565  rc = nf90_get_var(ncid2d,varid,dummy3d_stype)
5566  call netcdf_err(rc,"READING SCT_DOM FROM FILE")
5567 
5568  print*, "CLOSE GEOGRID FILE "
5569  iret = nf90_close(ncid2d)
5570 
5571  ! There's an issue with the geogrid file containing soil type water at land points.
5572  ! This correction replaces the soil type at these points with the soil type with
5573  ! the next highest fractional coverage.
5574  allocate(dummy1d(16))
5575  do j = 1, j_input
5576  do i = 1, i_input
5577  if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) then
5578  dummy1d(:) = dummy3d_stype(i,j,:)
5579  dummy1d(14) = 0.0_esmf_kind_r4
5580  dummy2d(i,j) = real(MAXLOC(dummy1d, 1),esmf_kind_r4)
5581  endif
5582  enddo
5583  enddo
5584  deallocate(dummy1d)
5585  deallocate(dummy3d_stype)
5586  endif ! failed
5587 
5588  if ((rc /= 0 .and. trim(to_upper(external_model)) /= "HRRR" .and. .not. rap_latlon) &
5589  .or. (rc /= 0 .and. (trim(to_upper(external_model)) == "HRRR" .or. rap_latlon))) then
5590  if (.not. sotyp_from_climo) then
5591  call error_handler("COULD NOT FIND SOIL TYPE IN FILE. PLEASE SET SOTYP_FROM_CLIMO=.TRUE. . EXITING", rc)
5592  else
5593  vname = "sotyp"
5594  slev = "surface"
5595  call get_var_cond(vname,this_miss_var_method=method, this_miss_var_value=value, &
5596  loc=varnum)
5597  call handle_grib_error(vname, slev ,method,value,varnum,rc, var= dummy2d)
5598  if (rc == 1) then ! missing_var_method == skip or no entry in varmap table
5599  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. WILL NOT "//&
5600  "SCALE SOIL MOISTURE FOR DIFFERENCES IN SOIL TYPE. "
5601  dummy2d(:,:) = -99999.0_esmf_kind_r4
5602  endif
5603  endif
5604  endif
5605 
5606  ! In the event that the soil type on the input grid still contains mismatches between
5607  ! soil type and landmask, this correction is a last-ditch effort to replace these points
5608  ! with soil type from a nearby land point.
5609 
5610  if (.not. sotyp_from_climo) then
5611  do j = 1, j_input
5612  do i = 1, i_input
5613  if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9
5614  enddo
5615  enddo
5616 
5617  allocate(dummy2d_i(i_input,j_input))
5618  dummy2d_8 = real(dummy2d,esmf_kind_r8)
5619  dummy2d_i(:,:) = 0
5620  where(slmsk_save == 1) dummy2d_i = 1
5621 
5622  call search(dummy2d_8,dummy2d_i,i_input,j_input,1,230)
5623  deallocate(dummy2d_i)
5624  else
5625  dummy2d_8=real(dummy2d,esmf_kind_r8)
5626  endif
5627 
5628  print*,'sotype ',maxval(dummy2d_8),minval(dummy2d_8)
5629 
5630  endif ! read of soil type
5631 
5632  print*,"- CALL FieldScatter FOR INPUT GRID SOIL TYPE."
5633  call esmf_fieldscatter(soil_type_input_grid,dummy2d_8, rootpet=0, rc=rc)
5634  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5635  call error_handler("IN FieldScatter", rc)
5636 
5637  deallocate(dummy2d)
5638 
5639  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5640  ! Begin variables whose presence in grib2 files varies, but no climatological
5641  ! data is available, so we have to account for values in the varmap table
5642  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5643 
5644  if (.not. vgfrc_from_climo) then
5645 
5646  if (localpet == 0) then
5647 
5648  print*,"- READ VEG FRACTION."
5649 
5650  jdisc = 2 ! Search for discipline - land products
5651  j = 0 ! Search at beginning of file.
5652  jpdtn = pdt_num ! Search for the product definition template number.
5653  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5654  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5655  jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation
5656  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5657  unpack=.true.
5658 
5659  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5660  unpack, k, gfld, rc)
5661 
5662  if (rc /= 0 )then
5663  call error_handler("COULD NOT FIND VEGETATION FRACTION IN FILE. &
5664  PLEASE SET VGFRC_FROM_CLIMO=.TRUE. EXITING", rc)
5665  else
5666  if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5667 ! print*,'vfrac ', maxval(gfld%fld),minval(gfld%fld)
5668  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5669 
5670  endif
5671 
5672  endif ! localpet 0
5673 
5674  print*,"- CALL FieldScatter FOR INPUT GRID VEG GREENNESS."
5675  call esmf_fieldscatter(veg_greenness_input_grid,dummy2d_8, rootpet=0, rc=rc)
5676  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
5677  call error_handler("IN FieldScatter", rc)
5678 
5679  endif
5680 
5681  if (.not. minmax_vgfrc_from_climo) then
5682 
5683  if (localpet == 0) then
5684 
5685  print*,"- READ MIN VEG FRACTION."
5686 
5687  jdisc = 2 ! Search for discipline - land products
5688  j = 1105 ! grib2 file does not distinguish between the various veg
5689  ! fractions. Need to search using record number.
5690  jpdtn = pdt_num ! Search for the product definition template number.
5691  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5692  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5693  jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation
5694  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5695  unpack=.true.
5696 
5697  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5698  unpack, k, gfld, rc)
5699 
5700  if (rc /= 0) then
5701  j = 1101 ! Have to search by record number.
5702  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5703  unpack, k, gfld, rc)
5704  if (rc /= 0) then
5705  j = 1151 ! Have to search by record number.
5706  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5707  unpack, k, gfld, rc)
5708  if (rc/=0) call error_handler("COULD NOT FIND MIN VEGETATION FRACTION IN FILE. &
5709  PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
5710  endif
5711  endif
5712 
5713  if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5714  print*,'vfrac min ', maxval(gfld%fld),minval(gfld%fld)
5715  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5716 
5717  endif ! localpet == 0
5718 
5719  print*,"- CALL FieldScatter FOR INPUT GRID MIN VEG GREENNESS."
5720  call esmf_fieldscatter(min_veg_greenness_input_grid,dummy2d_8, rootpet=0, rc=rc)
5721  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5722  call error_handler("IN FieldScatter", rc)
5723 
5724  if (localpet == 0) then
5725 
5726  print*,"- READ MAX VEG FRACTION."
5727 
5728  jdisc = 2 ! Search for discipline - land products
5729  j = 1106 ! Have to search by record number.
5730  jpdtn = pdt_num ! Search for the product definition template number.
5731  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5732  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5733  jpdt(2) = 4 ! Sec4/oct 11 - parameter number - vegetation
5734  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5735  unpack=.true.
5736 
5737  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5738  unpack, k, gfld, rc)
5739  if (rc /= 0) then
5740  j = 1102 ! Have to search by record number.
5741  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5742  unpack, k, gfld, rc)
5743  if (rc /= 0) then
5744  j = 1152 ! Have to search by record number.
5745  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5746  unpack, k, gfld, rc)
5747  if (rc <= 0) call error_handler("COULD NOT FIND MAX VEGETATION FRACTION IN FILE. &
5748  PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
5749  endif
5750  endif
5751 
5752  if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
5753 ! print*,'vfrac max ', maxval(gfld%fld),minval(gfld%fld)
5754  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5755 
5756  endif !localpet==0
5757 
5758  print*,"- CALL FieldScatter FOR INPUT GRID MAX VEG GREENNESS."
5759  call esmf_fieldscatter(max_veg_greenness_input_grid,dummy2d_8,rootpet=0, rc=rc)
5760  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5761  call error_handler("IN FieldScatter", rc)
5762 
5763  endif !minmax_vgfrc_from_climo
5764 
5765  if (.not. lai_from_climo) then
5766 
5767  if (localpet == 0) then
5768 
5769  print*,"- READ LAI."
5770 
5771  jdisc = 0 ! Search for discipline - meteorological products
5772  j = 0 ! Search at beginning of file.
5773  jpdtn = pdt_num ! Search for the product definition template number.
5774  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5775  jpdt(1) = 7 ! Sec4/oct 10 - parameter category - thermo stability indices
5776  jpdt(2) = 198 ! Sec4/oct 11 - parameter number - leaf area index
5777  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5778  unpack=.true.
5779 
5780  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5781  unpack, k, gfld, rc)
5782 
5783  if (rc /= 0) call error_handler("COULD NOT FIND LAI IN FILE. &
5784  PLEASE SET LAI_FROM_CLIMO=.TRUE. . EXITING",rc)
5785 
5786 ! print*,'lai ', maxval(gfld%fld),minval(gfld%fld)
5787  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5788 
5789  endif !localpet==0
5790 
5791  print*,"- CALL FieldScatter FOR INPUT GRID LAI."
5792  call esmf_fieldscatter(lai_input_grid,dummy2d_8,rootpet=0, rc=rc)
5793  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5794  call error_handler("IN FieldScatter", rc)
5795 
5796  endif ! lai
5797 
5798  if (localpet == 0) then
5799 
5800  print*,"- READ SEAICE DEPTH."
5801  vname="hice"
5802  slev=":surface:"
5803  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5804  loc=varnum)
5805 
5806  jdisc = 10 ! Search for discipline - ocean products
5807  j = 0 ! Search at beginning of file.
5808  jpdtn = pdt_num ! Search for the product definition template number.
5809  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5810  jpdt(1) = 2 ! Sec4/oct 10 - parameter category - ice
5811  jpdt(2) = 1 ! Sec4/oct 11 - parameter number - thickness
5812  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5813  unpack=.true.
5814 
5815  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5816  unpack, k, gfld, rc)
5817 
5818  if (rc /= 0 ) then
5819  call handle_grib_error(vname, slev ,method,value,varnum,rc,var8=dummy2d_8)
5820  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5821  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//&
5822  " REPLACED WITH CLIMO. SET A FILL "// &
5823  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
5824  dummy2d_8(:,:) = 0.0
5825  endif
5826  else
5827 ! print*,'hice ', maxval(gfld%fld),minval(gfld%fld)
5828  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5829  endif
5830 
5831  endif
5832 
5833  print*,"- CALL FieldScatter FOR INPUT GRID SEAICE DEPTH."
5834  call esmf_fieldscatter(seaice_depth_input_grid,dummy2d_8, rootpet=0, rc=rc)
5835  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5836  call error_handler("IN FieldScatter", rc)
5837 
5838  if (localpet == 0) then
5839 
5840  print*,"- READ TPRCP."
5841  vname="tprcp"
5842  slev=":surface:"
5843  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5844  loc=varnum)
5845 
5846 ! No test data contained this field. So could not test with g2 library.
5847  rc = 1
5848  if (rc /= 0) then
5849  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8)
5850  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5851  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5852  " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5853  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
5854  dummy2d_8 = 0.0
5855  endif
5856  endif
5857  print*,'tprcp ',maxval(dummy2d_8),minval(dummy2d_8)
5858 
5859  endif ! tprcp
5860 
5861  print*,"- CALL FieldScatter FOR INPUT GRID TPRCP."
5862  call esmf_fieldscatter(tprcp_input_grid,dummy2d_8, rootpet=0, rc=rc)
5863  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5864  call error_handler("IN FieldScatter", rc)
5865 
5866  if (localpet == 0) then
5867 
5868  print*,"- READ FFMM."
5869  vname="ffmm"
5870  slev=":surface:"
5871  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5872  loc=varnum)
5873 
5874 ! No sample data contained this field, so could not test g2lib.
5875  rc = 1
5876  if (rc /= 0) then
5877  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8)
5878  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5879  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5880  " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5881  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
5882  dummy2d_8(:,:) = 0.0
5883  endif
5884  endif
5885  print*,'ffmm ',maxval(dummy2d_8),minval(dummy2d_8)
5886 
5887  endif ! ffmm
5888 
5889  print*,"- CALL FieldScatter FOR INPUT GRID FFMM"
5890  call esmf_fieldscatter(ffmm_input_grid,dummy2d_8, rootpet=0, rc=rc)
5891  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5892  call error_handler("IN FieldScatter", rc)
5893 
5894  if (localpet == 0) then
5895 
5896  print*,"- READ USTAR."
5897  vname="fricv"
5898  slev=":surface:"
5899  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5900  loc=varnum)
5901 
5902  jdisc = 0 ! Search for discipline - meteorological products
5903  j = 0 ! Search at beginning of file.
5904  jpdtn = pdt_num ! Search for the product definition template number.
5905  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5906  jpdt(1) = 2 ! Sec4/oct 10 - parameter category - momentum
5907  jpdt(2) = 30 ! Sec4/oct 11 - parameter number - friction velocity
5908  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5909  unpack=.true.
5910 
5911  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5912  unpack, k, gfld, rc)
5913  if (rc /= 0) then
5914  jpdt(2) = 197 ! oct 11 - param number - friction vel.
5915  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5916  unpack, k, gfld, rc)
5917  endif
5918 
5919  if (rc == 0) then
5920 ! print*,'fricv ', maxval(gfld%fld),minval(gfld%fld)
5921  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5922  else
5923  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8)
5924  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5925  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL "//&
5926  "REPLACED WITH CLIMO. SET A FILL "// &
5927  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
5928  dummy2d_8(:,:) = 0.0
5929  endif
5930  endif
5931 
5932  endif ! ustar
5933 
5934  print*,"- CALL FieldScatter FOR INPUT GRID USTAR"
5935  call esmf_fieldscatter(ustar_input_grid,dummy2d_8, rootpet=0, rc=rc)
5936  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5937  call error_handler("IN FieldScatter", rc)
5938 
5939  if (localpet == 0) then
5940 
5941  print*,"- READ F10M."
5942  vname="f10m"
5943  slev=":10 m above ground:"
5944  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5945  loc=varnum)
5946 
5947  rc = -1 ! None of the test cases have this record. Can't test with g2lib.
5948  if (rc /= 0) then
5949  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8)
5950  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5951  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL NOT"//&
5952  " BE WRITTEN TO THE INPUT FILE. SET A FILL "// &
5953  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
5954  dummy2d_8(:,:) = 0.0
5955  endif
5956  endif
5957  print*,'f10m ',maxval(dummy2d_8),minval(dummy2d_8)
5958 
5959  endif
5960 
5961  print*,"- CALL FieldScatter FOR INPUT GRID F10M."
5962  call esmf_fieldscatter(f10m_input_grid,dummy2d_8, rootpet=0, rc=rc)
5963  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
5964  call error_handler("IN FieldScatter", rc)
5965 
5966  if (localpet == 0) then
5967 
5968  print*,"- READ CANOPY MOISTURE CONTENT."
5969  vname="cnwat"
5970  slev=":surface:"
5971  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
5972  loc=varnum)
5973 
5974  jdisc = 2 ! Search for discipline - land products
5975  j = 0 ! Search from beginning of file
5976  jpdtn = pdt_num ! Search for the product definition template number.
5977  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
5978  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
5979  jpdt(2) = 13 ! Sec4/oct 11 - parameter number - canopy water
5980  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
5981  unpack=.true.
5982 
5983  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5984  unpack, k, gfld, rc)
5985 
5986  if (rc /= 0 ) then
5987  jpdt(2) = 196 ! Sec4/oct 11 - param number - canopy water
5988  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
5989  unpack, k, gfld, rc)
5990  endif
5991 
5992  if (rc == 0 ) then
5993  print*,'cnwat ', maxval(gfld%fld),minval(gfld%fld)
5994  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
5995  call check_cnwat(dummy2d_8)
5996  else
5997  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8=dummy2d_8)
5998  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
5999  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL"//&
6000  " REPLACED WITH CLIMO. SET A FILL "// &
6001  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
6002  dummy2d_8 = 0.0
6003  endif
6004  endif
6005 
6006  endif
6007 
6008  print*,"- CALL FieldScatter FOR INPUT GRID CANOPY MOISTURE CONTENT."
6009  call esmf_fieldscatter(canopy_mc_input_grid,dummy2d_8, rootpet=0, rc=rc)
6010  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6011  call error_handler("IN FieldScatter", rc)
6012 
6013  if (localpet == 0) then
6014 
6015  print*,"- READ Z0."
6016  vname="sfcr"
6017  slev=":surface:"
6018  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
6019  loc=varnum)
6020 
6021  jdisc = 2 ! Search for discipline - land products
6022  j = 0 ! Search from beginning of file.
6023  jpdtn = pdt_num ! Search for the product definition template number.
6024  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
6025  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
6026  jpdt(2) = 1 ! Sec4/oct 11 - parameter number - surface roughness
6027  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
6028  unpack=.true.
6029 
6030  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6031  unpack, k, gfld, rc)
6032 
6033  if (rc /= 0 ) then
6034  call handle_grib_error(vname, slev ,method,value,varnum,rc, var8= dummy2d_8)
6035  if (rc==1) then ! missing_var_method == skip or no entry in varmap table
6036  print*, "WARNING: "//trim(vname)//" NOT AVAILABLE IN FILE. THIS FIELD WILL BE"//&
6037  " REPLACED WITH CLIMO. SET A FILL "// &
6038  "VALUE IN THE VARMAP TABLE IF THIS IS NOT DESIRABLE."
6039  dummy2d_8(:,:) = 0.0
6040  endif
6041  else
6042  gfld%fld = gfld%fld * 10.0 ! Grib files have z0 (m), but fv3 expects z0(cm)
6043 ! print*,'sfcr ', maxval(gfld%fld),minval(gfld%fld)
6044  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
6045  endif
6046 
6047  endif
6048 
6049  print*,"- CALL FieldScatter FOR INPUT GRID Z0."
6050  call esmf_fieldscatter(z0_input_grid,dummy2d_8, rootpet=0, rc=rc)
6051  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6052  call error_handler("IN FieldScatter", rc)
6053 
6054  if (localpet == 0) then
6055  print*,"- READ LIQUID SOIL MOISTURE."
6056  vname = "soill"
6057  vname_file = ":SOILL:"
6058  call read_grib_soil(vname,vname_file,lugb, pdt_num,dummy3d) !!! NEED TO HANDLE
6059  !!! SOIL LEVELS
6060  endif
6061 
6062  print*,"- CALL FieldScatter FOR INPUT LIQUID SOIL MOISTURE."
6063  call esmf_fieldscatter(soilm_liq_input_grid, dummy3d, rootpet=0, rc=rc)
6064  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6065  call error_handler("IN FieldScatter", rc)
6066 
6067  if (localpet == 0) then
6068  print*,"- READ TOTAL SOIL MOISTURE."
6069  vname = "soilw"
6070  vname_file = "var2_2_1_" ! the var number instead
6071  call read_grib_soil(vname,vname_file,lugb, pdt_num,dummy3d)
6072  endif
6073 
6074  print*,"- CALL FieldScatter FOR INPUT TOTAL SOIL MOISTURE."
6075  call esmf_fieldscatter(soilm_tot_input_grid, dummy3d, rootpet=0, rc=rc)
6076  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6077  call error_handler("IN FieldScatter", rc)
6078 
6079 !----------------------------------------------------------------------------------------
6080 ! Vegetation type is not available in some files. However, it is needed to identify
6081 ! permanent land ice points. At land ice, the total soil moisture is a flag value of
6082 ! '1'. Use this flag as a temporary solution.
6083 !----------------------------------------------------------------------------------------
6084 
6085  print*, "- CALL FieldGather for INPUT SOIL TYPE."
6086  call esmf_fieldgather(soil_type_input_grid, dummy2d_82, rootpet=0, tile=1, rc=rc)
6087  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6088  call error_handler("IN FieldGather", rc)
6089 
6090  if (localpet == 0) then
6091 
6092  print*,"- READ VEG TYPE."
6093 
6094  jdisc = 2 ! Search for discipline - land products
6095  j = 0 ! Search from beginning of file.
6096  jpdtn = pdt_num ! Search for the product definition template number.
6097  jpdt = -9999 ! Initialize array of values in product definition template Sec4.
6098  jpdt(1) = 0 ! Sec4/oct 10 - parameter category - veg/biomass
6099  jpdt(2) = 198 ! Sec4/oct 11 - parameter number - vegetation type
6100  jpdt(10) = 1 ! Sec4/oct 23 - type of level - ground surface
6101  unpack=.true.
6102 
6103  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6104  unpack, k, gfld, rc)
6105 
6106  if (rc /= 0 ) then
6107  if (.not. vgtyp_from_climo) then
6108  call error_handler("COULD NOT FIND VEGETATION TYPE IN FILE. PLEASE SET VGTYP_FROM_CLIMO=.TRUE. . EXITING", rc)
6109  else ! Set input veg type at land ice from soil moisture flag (1.0).
6110  do j = 1, j_input
6111  do i = 1, i_input
6112  dummy2d_8(i,j) = 0.0
6113  if(slmsk_save(i,j) == 1 .and. dummy3d(i,j,1) > 0.99) & ! land ice indicated by
6114  ! soil moisture flag of '1'.
6115  dummy2d_8(i,j) = real(veg_type_landice_input,esmf_kind_r8)
6116  enddo
6117  enddo
6118  endif
6119  else ! found vtype in file.
6120  dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
6121  endif
6122 
6123  if (trim(external_model) .ne. "GFS") then
6124  do j = 1, j_input
6125  do i = 1,i_input
6126  if (dummy2d_8(i,j) == 15.0_esmf_kind_r8 .and. slmsk_save(i,j) == 1) then
6127  if (dummy3d(i,j,1) < 0.6) then
6128  dummy2d_8(i,j) = real(veg_type_landice_input,esmf_kind_r8)
6129  elseif (dummy3d(i,j,1) > 0.99) then
6130  slmsk_save(i,j) = 0
6131  dummy2d_8(i,j) = 0.0_esmf_kind_r8
6132  dummy2d_82(i,j) = 0.0_esmf_kind_r8
6133  endif
6134  elseif (dummy2d_8(i,j) == 17.0_esmf_kind_r8 .and. slmsk_save(i,j)==0) then
6135  dummy2d_8(i,j) = 0.0_esmf_kind_r8
6136  endif
6137  enddo
6138  enddo
6139  endif
6140 
6141 ! print*,'vgtyp ',maxval(dummy2d_8),minval(dummy2d_8)
6142 
6143  endif ! read veg type
6144 
6145  print*,"- CALL FieldScatter FOR INPUT VEG TYPE."
6146  call esmf_fieldscatter(veg_type_input_grid, dummy2d_8, rootpet=0, rc=rc)
6147  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6148  call error_handler("IN FieldScatter", rc)
6149 
6150  print*,"- CALL FieldScatter FOR INPUT SOIL TYPE."
6151  call esmf_fieldscatter(soil_type_input_grid, dummy2d_82, rootpet=0, rc=rc)
6152  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6153  call error_handler("IN FieldScatter", rc)
6154 
6155  deallocate(dummy2d_82)
6156 
6157  print*,"- CALL FieldScatter FOR INPUT LANDSEA MASK."
6158  call esmf_fieldscatter(landsea_mask_input_grid,real(slmsk_save,esmf_kind_r8),rootpet=0, rc=rc)
6159  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6160  call error_handler("IN FieldScatter", rc)
6161 
6162 !---------------------------------------------------------------------------------
6163 ! At open water (slmsk==0), the soil temperature array is not used and set
6164 ! to the filler value of SST. At lake/sea ice points (slmsk=2), the soil
6165 ! temperature array holds ice column temperature. This field is not available
6166 ! in the grib data, so set to a default value.
6167 !---------------------------------------------------------------------------------
6168 
6169  if (localpet == 0) then
6170  print*,"- READ SOIL TEMPERATURE."
6171  vname = "soilt"
6172  vname_file = ":TSOIL:"
6173  call read_grib_soil(vname,vname_file,lugb,pdt_num,dummy3d)
6174  call check_soilt(dummy3d,slmsk_save,tsk_save)
6175  deallocate(tsk_save)
6176  endif
6177 
6178  deallocate(slmsk_save)
6179 
6180  print*,"- CALL FieldScatter FOR INPUT SOIL TEMPERATURE."
6181  call esmf_fieldscatter(soil_temp_input_grid, dummy3d, rootpet=0, rc=rc)
6182  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
6183  call error_handler("IN FieldScatter", rc)
6184 
6185  deallocate(dummy3d)
6186  deallocate(dummy2d_8)
6187 
6188  if (localpet == 0) call baclose(lugb, rc)
6189 
6190  end subroutine read_input_sfc_grib2_file
6191 
6197  subroutine read_input_nst_netcdf_file(localpet)
6198 
6199  implicit none
6200 
6201  integer, intent(in) :: localpet
6202 
6203  character(len=10) :: field
6204 
6205  integer :: rc, tile
6206 
6207  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
6208 
6209  if (localpet == 0) then
6210  allocate(data_one_tile(i_input,j_input))
6211  else
6212  allocate(data_one_tile(0,0))
6213  endif
6214 
6215  tile_loop : do tile = 1, num_tiles_input_grid
6216 
6217 ! c_d
6218 
6219  if (localpet == 0) then
6220  if (trim(input_type) == "restart") then
6221  field='c_d'
6222  else
6223  field='cd'
6224  endif
6225  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6226  lsoil_input, sfcdata=data_one_tile)
6227  endif
6228 
6229  print*,"- CALL FieldScatter FOR INPUT C_D"
6230  call esmf_fieldscatter(c_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6231  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6232  call error_handler("IN FieldScatter", rc)
6233 
6234 ! c_0
6235 
6236  if (localpet == 0) then
6237  if (trim(input_type) == "restart") then
6238  field='c_0'
6239  else
6240  field='c0'
6241  endif
6242  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6243  lsoil_input, sfcdata=data_one_tile)
6244  endif
6245 
6246  print*,"- CALL FieldScatter FOR INPUT C_0"
6247  call esmf_fieldscatter(c_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6248  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6249  call error_handler("IN FieldScatter", rc)
6250 
6251 ! d_conv
6252 
6253  if (localpet == 0) then
6254  if (trim(input_type) == "restart") then
6255  field='d_conv'
6256  else
6257  field='dconv'
6258  endif
6259  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6260  lsoil_input, sfcdata=data_one_tile)
6261  endif
6262 
6263  print*,"- CALL FieldScatter FOR INPUT D_CONV."
6264  call esmf_fieldscatter(d_conv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6265  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6266  call error_handler("IN FieldScatter", rc)
6267 
6268 ! dt_cool
6269 
6270  if (localpet == 0) then
6271  if (trim(input_type) == "restart") then
6272  field='dt_cool'
6273  else
6274  field='dtcool'
6275  endif
6276  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6277  lsoil_input, sfcdata=data_one_tile)
6278  endif
6279 
6280  print*,"- CALL FieldScatter FOR INPUT DT_COOL."
6281  call esmf_fieldscatter(dt_cool_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6282  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6283  call error_handler("IN FieldScatter", rc)
6284 
6285 ! ifd - xu li said initialize to '1'.
6286 
6287  if (localpet == 0) then
6288  data_one_tile = 1.0
6289  endif
6290 
6291  print*,"- CALL FieldScatter FOR INPUT IFD."
6292  call esmf_fieldscatter(ifd_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6293  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6294  call error_handler("IN FieldScatter", rc)
6295 
6296 ! qrain
6297 
6298  if (localpet == 0) then
6299  call read_fv3_grid_data_netcdf('qrain', tile, i_input, j_input, &
6300  lsoil_input, sfcdata=data_one_tile)
6301  endif
6302 
6303  print*,"- CALL FieldScatter FOR INPUT QRAIN."
6304  call esmf_fieldscatter(qrain_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6305  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6306  call error_handler("IN FieldScatter", rc)
6307 
6308 ! tref
6309 
6310  if (localpet == 0) then
6311  call read_fv3_grid_data_netcdf('tref', tile, i_input, j_input, &
6312  lsoil_input, sfcdata=data_one_tile)
6313  endif
6314 
6315  print*,"- CALL FieldScatter FOR INPUT TREF"
6316  call esmf_fieldscatter(tref_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6317  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6318  call error_handler("IN FieldScatter", rc)
6319 
6320 ! w_d
6321 
6322  if (localpet == 0) then
6323  if (trim(input_type) == "restart") then
6324  field='w_d'
6325  else
6326  field='wd'
6327  endif
6328  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6329  lsoil_input, sfcdata=data_one_tile)
6330  endif
6331 
6332  print*,"- CALL FieldScatter FOR INPUT W_D"
6333  call esmf_fieldscatter(w_d_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6334  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6335  call error_handler("IN FieldScatter", rc)
6336 
6337 ! w_0
6338 
6339  if (localpet == 0) then
6340  if (trim(input_type) == "restart") then
6341  field='w_0'
6342  else
6343  field='w0'
6344  endif
6345  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6346  lsoil_input, sfcdata=data_one_tile)
6347  endif
6348 
6349  print*,"- CALL FieldScatter FOR INPUT W_0"
6350  call esmf_fieldscatter(w_0_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6351  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6352  call error_handler("IN FieldScatter", rc)
6353 
6354 ! xs
6355 
6356  if (localpet == 0) then
6357  call read_fv3_grid_data_netcdf('xs', tile, i_input, j_input, &
6358  lsoil_input, sfcdata=data_one_tile)
6359  endif
6360 
6361  print*,"- CALL FieldScatter FOR INPUT XS"
6362  call esmf_fieldscatter(xs_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6363  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6364  call error_handler("IN FieldScatter", rc)
6365 
6366 ! xt
6367 
6368  if (localpet == 0) then
6369  call read_fv3_grid_data_netcdf('xt', tile, i_input, j_input, &
6370  lsoil_input, sfcdata=data_one_tile)
6371  endif
6372 
6373  print*,"- CALL FieldScatter FOR INPUT XT"
6374  call esmf_fieldscatter(xt_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6375  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6376  call error_handler("IN FieldScatter", rc)
6377 
6378 ! xu
6379 
6380  if (localpet == 0) then
6381  call read_fv3_grid_data_netcdf('xu', tile, i_input, j_input, &
6382  lsoil_input, sfcdata=data_one_tile)
6383  endif
6384 
6385  print*,"- CALL FieldScatter FOR INPUT XU"
6386  call esmf_fieldscatter(xu_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6387  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6388  call error_handler("IN FieldScatter", rc)
6389 
6390 ! xv
6391 
6392  if (localpet == 0) then
6393  call read_fv3_grid_data_netcdf('xv', tile, i_input, j_input, &
6394  lsoil_input, sfcdata=data_one_tile)
6395  endif
6396 
6397  print*,"- CALL FieldScatter FOR INPUT XV"
6398  call esmf_fieldscatter(xv_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6399  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6400  call error_handler("IN FieldScatter", rc)
6401 
6402 ! xz
6403 
6404  if (localpet == 0) then
6405  call read_fv3_grid_data_netcdf('xz', tile, i_input, j_input, &
6406  lsoil_input, sfcdata=data_one_tile)
6407  endif
6408 
6409  print*,"- CALL FieldScatter FOR INPUT XZ"
6410  call esmf_fieldscatter(xz_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6411  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6412  call error_handler("IN FieldScatter", rc)
6413 
6414 ! xtts
6415 
6416  if (localpet == 0) then
6417  call read_fv3_grid_data_netcdf('xtts', tile, i_input, j_input, &
6418  lsoil_input, sfcdata=data_one_tile)
6419  endif
6420 
6421  print*,"- CALL FieldScatter FOR INPUT XTTS"
6422  call esmf_fieldscatter(xtts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6423  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6424  call error_handler("IN FieldScatter", rc)
6425 
6426 ! xzts
6427 
6428  if (localpet == 0) then
6429  call read_fv3_grid_data_netcdf('xzts', tile, i_input, j_input, &
6430  lsoil_input, sfcdata=data_one_tile)
6431  endif
6432 
6433  print*,"- CALL FieldScatter FOR INPUT XZTS"
6434  call esmf_fieldscatter(xzts_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6435  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6436  call error_handler("IN FieldScatter", rc)
6437 
6438 ! z_c
6439 
6440  if (localpet == 0) then
6441  if (trim(input_type) == "restart") then
6442  field='z_c'
6443  else
6444  field='zc'
6445  endif
6446  call read_fv3_grid_data_netcdf(trim(field), tile, i_input, j_input, &
6447  lsoil_input, sfcdata=data_one_tile)
6448  endif
6449 
6450  print*,"- CALL FieldScatter FOR INPUT Z_C"
6451  call esmf_fieldscatter(z_c_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6452  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6453  call error_handler("IN FieldScatter", rc)
6454 
6455 ! zm - Not used yet. Xu li said set to '0'.
6456 
6457  if (localpet == 0) then
6458  data_one_tile = 0.0
6459  endif
6460 
6461  print*,"- CALL FieldScatter FOR INPUT ZM"
6462  call esmf_fieldscatter(zm_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
6463  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6464  call error_handler("IN FieldScatter", rc)
6465 
6466  enddo tile_loop
6467 
6468  deallocate(data_one_tile)
6469 
6470  end subroutine read_input_nst_netcdf_file
6471 
6481  subroutine read_input_nst_nemsio_file(localpet)
6482 
6483  implicit none
6484 
6485  integer, intent(in) :: localpet
6486 
6487  character(len=300) :: the_file
6488 
6489  integer :: rc
6490 
6491  real(nemsio_realkind), allocatable :: dummy(:)
6492  real(esmf_kind_r8), allocatable :: dummy2d(:,:)
6493 
6494  type(nemsio_gfile) :: gfile
6495 
6496  if (trim(input_type) == "gfs_gaussian_nemsio") then ! spectral gfs nemsio in
6497  ! separate file.
6498  the_file = trim(data_dir_input_grid) // "/" // trim(nst_files_input_grid)
6499  else
6500  the_file = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(1))
6501  endif
6502 
6503  print*,"- READ NST DATA FROM: ", trim(the_file)
6504 
6505  if (localpet == 0) then
6506  allocate(dummy(i_input*j_input))
6507  allocate(dummy2d(i_input,j_input))
6508  call nemsio_open(gfile, the_file, "read", iret=rc)
6509  else
6510  allocate(dummy(0))
6511  allocate(dummy2d(0,0))
6512  endif
6513 
6514  if (localpet == 0) then
6515  print*,"- READ TREF"
6516  call nemsio_readrecv(gfile, "tref", "sfc", 1, dummy, 0, iret=rc)
6517  if (rc /= 0) call error_handler("READING TREF.", rc)
6518  dummy2d = reshape(dummy, (/i_input,j_input/))
6519  print*,'tref ',maxval(dummy2d),minval(dummy2d)
6520  endif
6521 
6522  print*,"- CALL FieldScatter FOR INPUT TREF."
6523  call esmf_fieldscatter(tref_input_grid, dummy2d, rootpet=0, rc=rc)
6524  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6525  call error_handler("IN FieldScatter", rc)
6526 
6527  if (localpet == 0) then
6528  print*,"- READ CD"
6529  call nemsio_readrecv(gfile, "cd", "sfc", 1, dummy, 0, iret=rc)
6530  if (rc /= 0) call error_handler("READING CD.", rc)
6531  dummy2d = reshape(dummy, (/i_input,j_input/))
6532  print*,'cd ',maxval(dummy2d),minval(dummy2d)
6533  endif
6534 
6535  print*,"- CALL FieldScatter FOR INPUT C_D."
6536  call esmf_fieldscatter(c_d_input_grid, dummy2d, rootpet=0, rc=rc)
6537  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6538  call error_handler("IN FieldScatter", rc)
6539 
6540  if (localpet == 0) then
6541  print*,"- READ C0"
6542  call nemsio_readrecv(gfile, "c0", "sfc", 1, dummy, 0, iret=rc)
6543  if (rc /= 0) call error_handler("READING C0.", rc)
6544  dummy2d = reshape(dummy, (/i_input,j_input/))
6545  print*,'c0 ',maxval(dummy2d),minval(dummy2d)
6546  endif
6547 
6548  print*,"- CALL FieldScatter FOR INPUT C_0."
6549  call esmf_fieldscatter(c_0_input_grid, dummy2d, rootpet=0, rc=rc)
6550  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6551  call error_handler("IN FieldScatter", rc)
6552 
6553  if (localpet == 0) then
6554  print*,"- READ DCONV"
6555  call nemsio_readrecv(gfile, "dconv", "sfc", 1, dummy, 0, iret=rc)
6556  if (rc /= 0) call error_handler("READING DCONV.", rc)
6557  dummy2d = reshape(dummy, (/i_input,j_input/))
6558  print*,'dconv ',maxval(dummy2d),minval(dummy2d)
6559  endif
6560 
6561  print*,"- CALL FieldScatter FOR INPUT D_CONV."
6562  call esmf_fieldscatter(d_conv_input_grid, dummy2d, rootpet=0, rc=rc)
6563  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6564  call error_handler("IN FieldScatter", rc)
6565 
6566  if (localpet == 0) then
6567  print*,"- READ DTCOOL"
6568  call nemsio_readrecv(gfile, "dtcool", "sfc", 1, dummy, 0, iret=rc)
6569  if (rc /= 0) call error_handler("READING DTCOOL.", rc)
6570  dummy2d = reshape(dummy, (/i_input,j_input/))
6571  print*,'dtcool ',maxval(dummy2d),minval(dummy2d)
6572  endif
6573 
6574  print*,"- CALL FieldScatter FOR INPUT DT_COOL."
6575  call esmf_fieldscatter(dt_cool_input_grid, dummy2d, rootpet=0, rc=rc)
6576  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6577  call error_handler("IN FieldScatter", rc)
6578 
6579  if (localpet == 0) then
6580  dummy2d = 1.0 ! IFD not in file. Set to '1' per Xu Li.
6581  endif
6582 
6583  print*,"- CALL FieldScatter FOR INPUT IFD."
6584  call esmf_fieldscatter(ifd_input_grid, dummy2d, rootpet=0, rc=rc)
6585  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6586  call error_handler("IN FieldScatter", rc)
6587 
6588  if (localpet == 0) then
6589  print*,"- READ QRAIN"
6590  call nemsio_readrecv(gfile, "qrain", "sfc", 1, dummy, 0, iret=rc)
6591  if (rc /= 0) call error_handler("READING QRAIN.", rc)
6592  dummy2d = reshape(dummy, (/i_input,j_input/))
6593  print*,'qrain ',maxval(dummy2d),minval(dummy2d)
6594  endif
6595 
6596  print*,"- CALL FieldScatter FOR INPUT QRAIN."
6597  call esmf_fieldscatter(qrain_input_grid, dummy2d, rootpet=0, rc=rc)
6598  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6599  call error_handler("IN FieldScatter", rc)
6600 
6601  if (localpet == 0) then
6602  print*,"- READ WD"
6603  call nemsio_readrecv(gfile, "wd", "sfc", 1, dummy, 0, iret=rc)
6604  if (rc /= 0) call error_handler("READING WD.", rc)
6605  dummy2d = reshape(dummy, (/i_input,j_input/))
6606  print*,'wd ',maxval(dummy2d),minval(dummy2d)
6607  endif
6608 
6609  print*,"- CALL FieldScatter FOR INPUT WD."
6610  call esmf_fieldscatter(w_d_input_grid, dummy2d, rootpet=0, rc=rc)
6611  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6612  call error_handler("IN FieldScatter", rc)
6613 
6614  if (localpet == 0) then
6615  print*,"- READ W0"
6616  call nemsio_readrecv(gfile, "w0", "sfc", 1, dummy, 0, iret=rc)
6617  if (rc /= 0) call error_handler("READING W0.", rc)
6618  dummy2d = reshape(dummy, (/i_input,j_input/))
6619  print*,'w0 ',maxval(dummy2d),minval(dummy2d)
6620  endif
6621 
6622  print*,"- CALL FieldScatter FOR INPUT W0."
6623  call esmf_fieldscatter(w_0_input_grid, dummy2d, rootpet=0, rc=rc)
6624  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6625  call error_handler("IN FieldScatter", rc)
6626 
6627  if (localpet == 0) then
6628  print*,"- READ XS"
6629  call nemsio_readrecv(gfile, "xs", "sfc", 1, dummy, 0, iret=rc)
6630  if (rc /= 0) call error_handler("READING XS.", rc)
6631  dummy2d = reshape(dummy, (/i_input,j_input/))
6632  print*,'xs ',maxval(dummy2d),minval(dummy2d)
6633  endif
6634 
6635  print*,"- CALL FieldScatter FOR INPUT XS."
6636  call esmf_fieldscatter(xs_input_grid, dummy2d, rootpet=0, rc=rc)
6637  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6638  call error_handler("IN FieldScatter", rc)
6639 
6640  if (localpet == 0) then
6641  print*,"- READ XT"
6642  call nemsio_readrecv(gfile, "xt", "sfc", 1, dummy, 0, iret=rc)
6643  if (rc /= 0) call error_handler("READING XT.", rc)
6644  dummy2d = reshape(dummy, (/i_input,j_input/))
6645  print*,'xt ',maxval(dummy2d),minval(dummy2d)
6646  endif
6647 
6648  print*,"- CALL FieldScatter FOR INPUT XT."
6649  call esmf_fieldscatter(xt_input_grid, dummy2d, rootpet=0, rc=rc)
6650  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6651  call error_handler("IN FieldScatter", rc)
6652 
6653  if (localpet == 0) then
6654  print*,"- READ XU"
6655  call nemsio_readrecv(gfile, "xu", "sfc", 1, dummy, 0, iret=rc)
6656  if (rc /= 0) call error_handler("READING XU.", rc)
6657  dummy2d = reshape(dummy, (/i_input,j_input/))
6658  print*,'xu ',maxval(dummy2d),minval(dummy2d)
6659  endif
6660 
6661  print*,"- CALL FieldScatter FOR INPUT XU."
6662  call esmf_fieldscatter(xu_input_grid, dummy2d, rootpet=0, rc=rc)
6663  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6664  call error_handler("IN FieldScatter", rc)
6665 
6666  if (localpet == 0) then
6667  print*,"- READ XV"
6668  call nemsio_readrecv(gfile, "xv", "sfc", 1, dummy, 0, iret=rc)
6669  if (rc /= 0) call error_handler("READING XV.", rc)
6670  dummy2d = reshape(dummy, (/i_input,j_input/))
6671  print*,'xv ',maxval(dummy2d),minval(dummy2d)
6672  endif
6673 
6674  print*,"- CALL FieldScatter FOR INPUT XV."
6675  call esmf_fieldscatter(xv_input_grid, dummy2d, rootpet=0, rc=rc)
6676  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6677  call error_handler("IN FieldScatter", rc)
6678 
6679  if (localpet == 0) then
6680  print*,"- READ XZ"
6681  call nemsio_readrecv(gfile, "xz", "sfc", 1, dummy, 0, iret=rc)
6682  if (rc /= 0) call error_handler("READING XZ.", rc)
6683  dummy2d = reshape(dummy, (/i_input,j_input/))
6684  print*,'xz ',maxval(dummy2d),minval(dummy2d)
6685  endif
6686 
6687  print*,"- CALL FieldScatter FOR INPUT XZ."
6688  call esmf_fieldscatter(xz_input_grid, dummy2d, rootpet=0, rc=rc)
6689  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6690  call error_handler("IN FieldScatter", rc)
6691 
6692  if (localpet == 0) then
6693  print*,"- READ XTTS"
6694  call nemsio_readrecv(gfile, "xtts", "sfc", 1, dummy, 0, iret=rc)
6695  if (rc /= 0) call error_handler("READING XTTS.", rc)
6696  dummy2d = reshape(dummy, (/i_input,j_input/))
6697  print*,'xtts ',maxval(dummy2d),minval(dummy2d)
6698  endif
6699 
6700  print*,"- CALL FieldScatter FOR INPUT XTTS."
6701  call esmf_fieldscatter(xtts_input_grid, dummy2d, rootpet=0, rc=rc)
6702  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6703  call error_handler("IN FieldScatter", rc)
6704 
6705  if (localpet == 0) then
6706  print*,"- READ XZTS"
6707  call nemsio_readrecv(gfile, "xzts", "sfc", 1, dummy, 0, iret=rc)
6708  if (rc /= 0) call error_handler("READING XZTS.", rc)
6709  dummy2d = reshape(dummy, (/i_input,j_input/))
6710  print*,'xzts ',maxval(dummy2d),minval(dummy2d)
6711  endif
6712 
6713  print*,"- CALL FieldScatter FOR INPUT XZTS."
6714  call esmf_fieldscatter(xzts_input_grid, dummy2d, rootpet=0, rc=rc)
6715  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6716  call error_handler("IN FieldScatter", rc)
6717 
6718  if (localpet == 0) then
6719  print*,"- READ ZC"
6720  call nemsio_readrecv(gfile, "zc", "sfc", 1, dummy, 0, iret=rc)
6721  if (rc /= 0) call error_handler("READING ZC.", rc)
6722  dummy2d = reshape(dummy, (/i_input,j_input/))
6723  print*,'zc ',maxval(dummy2d),minval(dummy2d)
6724  endif
6725 
6726  print*,"- CALL FieldScatter FOR INPUT Z_C."
6727  call esmf_fieldscatter(z_c_input_grid, dummy2d, rootpet=0, rc=rc)
6728  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6729  call error_handler("IN FieldScatter", rc)
6730 
6731  if (localpet == 0) then
6732  dummy2d = 0.0 ! zm not used yet. Set to zero per Xu Li.
6733  endif
6734 
6735  print*,"- CALL FieldScatter FOR INPUT ZM."
6736  call esmf_fieldscatter(zm_input_grid, dummy2d, rootpet=0, rc=rc)
6737  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6738  call error_handler("IN FieldScatter", rc)
6739 
6740  deallocate(dummy, dummy2d)
6741 
6742  if (localpet == 0) call nemsio_close(gfile)
6743 
6744  end subroutine read_input_nst_nemsio_file
6745 
6756  SUBROUTINE read_fv3_grid_data_netcdf(FIELD,TILE_NUM,IMO,JMO,LMO, &
6757  SFCDATA, SFCDATA_3D)
6758 
6759  IMPLICIT NONE
6760 
6761  CHARACTER(LEN=*),INTENT(IN) :: FIELD
6762 
6763  INTEGER, INTENT(IN) :: IMO, JMO, LMO, TILE_NUM
6764 
6765  REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA(IMO,JMO)
6766  REAL(ESMF_KIND_R8), INTENT(OUT), OPTIONAL :: SFCDATA_3D(IMO,JMO,LMO)
6767 
6768  CHARACTER(LEN=256) :: TILEFILE
6769 
6770  INTEGER :: ERROR, NCID, ID_VAR
6771 
6772  tilefile = trim(data_dir_input_grid) // "/" // trim(sfc_files_input_grid(tile_num))
6773 
6774  print*,'WILL READ ',trim(field), ' FROM: ', trim(tilefile)
6775 
6776  error=nf90_open(trim(tilefile),nf90_nowrite,ncid)
6777  CALL netcdf_err(error, 'OPENING: '//trim(tilefile) )
6778 
6779  error=nf90_inq_varid(ncid, field, id_var)
6780  CALL netcdf_err(error, 'READING FIELD ID' )
6781 
6782  IF (PRESENT(sfcdata_3d)) THEN
6783  error=nf90_get_var(ncid, id_var, sfcdata_3d)
6784  CALL netcdf_err(error, 'READING FIELD' )
6785  ELSE
6786  error=nf90_get_var(ncid, id_var, sfcdata)
6787  CALL netcdf_err(error, 'READING FIELD' )
6788  ENDIF
6789 
6790  error = nf90_close(ncid)
6791 
6792  END SUBROUTINE read_fv3_grid_data_netcdf
6793 
6805  subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
6806 
6807  use grib_mod
6808  use program_setup, only : get_var_cond
6809 
6810  implicit none
6811 
6812  integer, intent(in) :: localpet, lugb
6813  integer, intent(in) :: pdt_num, octet_23
6814 
6815  real(esmf_kind_r8), intent(inout), allocatable :: u(:,:,:),v(:,:,:)
6816  real(esmf_kind_r8), intent(in), dimension(lev_input) :: rlevs
6817 
6818  real(esmf_kind_r4), dimension(i_input,j_input) :: alpha
6819  real(esmf_kind_r8), dimension(i_input,j_input) :: lon, lat
6820  real(esmf_kind_r4), allocatable :: u_tmp(:,:),v_tmp(:,:)
6821  real(esmf_kind_r8), allocatable :: dum2d(:,:)
6822  real(esmf_kind_r4), dimension(i_input,j_input) :: ws,wd
6823  real(esmf_kind_r4) :: value_u, value_v,lov,latin1,latin2
6824  real(esmf_kind_r8) :: d2r
6825 
6826  integer :: varnum_u, varnum_v, vlev, &
6827  error, iret
6828  integer :: j, k, lugi, jgdtn, jpdtn
6829  integer :: jdisc, jids(200), jgdt(200), jpdt(200)
6830 
6831  character(len=20) :: vname
6832  character(len=50) :: method_u, method_v
6833 
6834  logical :: unpack
6835 
6836  type(gribfield) :: gfld
6837 
6838  d2r=acos(-1.0_esmf_kind_r8) / 180.0_esmf_kind_r8
6839  if (localpet==0) then
6840  allocate(u(i_input,j_input,lev_input))
6841  allocate(v(i_input,j_input,lev_input))
6842  else
6843  allocate(u(0,0,0))
6844  allocate(v(0,0,0))
6845  endif
6846 
6847  vname = "u"
6848  call get_var_cond(vname,this_miss_var_method=method_u, this_miss_var_value=value_u, &
6849  loc=varnum_u)
6850  vname = "v"
6851  call get_var_cond(vname,this_miss_var_method=method_v, this_miss_var_value=value_v, &
6852  loc=varnum_v)
6853 
6854  print*,"- CALL FieldGather FOR INPUT GRID LONGITUDE"
6855  call esmf_fieldgather(longitude_input_grid, lon, rootpet=0, tile=1, rc=error)
6856  if(esmf_logfounderror(rctocheck=error,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6857  call error_handler("IN FieldGather", error)
6858 
6859  print*,"- CALL FieldGather FOR INPUT GRID LATITUDE"
6860  call esmf_fieldgather(latitude_input_grid, lat, rootpet=0, tile=1, rc=error)
6861  if(esmf_logfounderror(rctocheck=error,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
6862  call error_handler("IN FieldGather", error)
6863 
6864  if (localpet==0) then
6865 
6866  lugi = 0 ! index file unit number
6867  jdisc = 0 ! search for discipline - meteorological products
6868  j = 0 ! search at beginning of file.
6869  jpdt = -9999 ! array of values in product definition template, set to wildcard
6870  jids = -9999 ! array of values in identification section, set to wildcard
6871  jgdt = -9999 ! array of values in grid definition template, set to wildcard
6872  jgdtn = -1 ! search for any grid definition number.
6873  jpdtn = pdt_num ! Search for the product definition template number.
6874  unpack=.false.
6875 
6876  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6877  unpack, k, gfld, iret)
6878 
6879  if (iret /= 0) call error_handler("ERROR READING GRIB2 FILE.", iret)
6880 
6881  if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid
6882 
6883  latin1 = float(gfld%igdtmpl(15))/1.0e6
6884  lov = float(gfld%igdtmpl(16))/1.0e6
6885 
6886  print*, "- CALL CALCALPHA_ROTLATLON with center lat,lon = ",latin1,lov
6887  call calcalpha_rotlatlon(lat,lon,latin1,lov,alpha)
6888 
6889  elseif (gfld%igdtnum == 30) then ! grid definition template number - lambert conformal grid.
6890 
6891  lov = float(gfld%igdtmpl(14))/1.0e6
6892  latin1 = float(gfld%igdtmpl(19))/1.0e6
6893  latin2 = float(gfld%igdtmpl(20))/1.0e6
6894 
6895  print*, "- CALL GRIDROT for LC grid with lov,latin1/2 = ",lov,latin1,latin2
6896  call gridrot(lov,latin1,latin2,lon,alpha)
6897 
6898  endif
6899 
6900  jpdt(10) = octet_23 ! Sec4/oct 23 - type of level.
6901 
6902  unpack=.true.
6903 
6904  allocate(dum2d(i_input,j_input))
6905  allocate(u_tmp(i_input,j_input))
6906  allocate(v_tmp(i_input,j_input))
6907 
6908  do vlev = 1, lev_input
6909 
6910  vname = ":UGRD:"
6911 
6912  jpdt(1) = 2 ! Sec4/oct 10 - parameter category - momentum
6913  jpdt(2) = 2 ! Sec4/oct 11 - parameter number - u-wind
6914  jpdt(12) = nint(rlevs(vlev)) ! Sect4/octs 25-28 - scaled value of fixed surface.
6915 
6916  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6917  unpack, k, gfld, iret)
6918 
6919  if (iret /= 0) then
6920  call handle_grib_error(vname, slevs(vlev),method_u,value_u,varnum_u,iret,var=u_tmp)
6921  if (iret==1) then ! missing_var_method == skip
6922  call error_handler("READING IN U AT LEVEL "//trim(slevs(vlev))//". SET A FILL "// &
6923  "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
6924  endif
6925  else
6926  dum2d = reshape(gfld%fld, (/i_input,j_input/) )
6927  u_tmp(:,:) = dum2d
6928  endif
6929 
6930  vname = ":VGRD:"
6931 
6932  jpdt(2) = 3 ! Sec4/oct 11 - parameter number - v-wind
6933 
6934  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
6935  unpack, k, gfld, iret)
6936 
6937  if (iret /= 0) then
6938  call handle_grib_error(vname, slevs(vlev),method_v,value_v,varnum_v,iret,var=v_tmp)
6939  if (iret==1) then ! missing_var_method == skip
6940  call error_handler("READING IN V AT LEVEL "//trim(slevs(vlev))//". SET A FILL "// &
6941  "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",iret)
6942  endif
6943  else
6944  dum2d = reshape(gfld%fld, (/i_input,j_input/) )
6945  v_tmp(:,:) = dum2d
6946  endif
6947 
6948  deallocate(dum2d)
6949 
6950  if (gfld%igdtnum == 0) then ! grid definition template number - lat/lon grid
6951  if (external_model == 'UKMET') then
6952  u(:,:,vlev) = u_tmp
6953  v(:,:,vlev) = (v_tmp(:,2:jp1_input) + v_tmp(:,1:j_input))/2
6954  else
6955  u(:,:,vlev) = u_tmp
6956  v(:,:,vlev) = v_tmp
6957  endif
6958  else if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid
6959  ws = sqrt(u_tmp**2 + v_tmp**2)
6960  wd = atan2(-u_tmp,-v_tmp) / d2r ! calculate grid-relative wind direction
6961  wd = wd + alpha + 180.0 ! Rotate from grid- to earth-relative direction
6962  wd = 270.0 - wd ! Convert from meteorological (true N) to mathematical direction
6963  u(:,:,vlev) = -ws*cos(wd*d2r)
6964  v(:,:,vlev) = -ws*sin(wd*d2r)
6965  else
6966  u(:,:,vlev) = real(u_tmp * cos(alpha) + v_tmp * sin(alpha),esmf_kind_r8)
6967  v(:,:,vlev) = real(v_tmp * cos(alpha) - u_tmp * sin(alpha),esmf_kind_r8)
6968  endif
6969 
6970  print*, 'max, min U ', minval(u(:,:,vlev)), maxval(u(:,:,vlev))
6971  print*, 'max, min V ', minval(v(:,:,vlev)), maxval(v(:,:,vlev))
6972  enddo
6973  endif
6974 
6975 end subroutine read_winds
6976 
6980  subroutine convert_winds
6981 
6982  implicit none
6983 
6984  integer :: clb(4), cub(4)
6985  integer :: i, j, k, rc
6986 
6987  real(esmf_kind_r8) :: latrad, lonrad
6988  real(esmf_kind_r8), pointer :: windptr(:,:,:,:)
6989  real(esmf_kind_r8), pointer :: uptr(:,:,:)
6990  real(esmf_kind_r8), pointer :: vptr(:,:,:)
6991  real(esmf_kind_r8), pointer :: latptr(:,:)
6992  real(esmf_kind_r8), pointer :: lonptr(:,:)
6993 
6994  print*,"- CALL FieldGet FOR 3-D WIND."
6995  call esmf_fieldget(wind_input_grid, &
6996  computationallbound=clb, &
6997  computationalubound=cub, &
6998  farrayptr=windptr, rc=rc)
6999  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7000  call error_handler("IN FieldGet", rc)
7001 
7002  print*,"- CALL FieldGet FOR U."
7003  call esmf_fieldget(u_input_grid, &
7004  farrayptr=uptr, rc=rc)
7005  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7006  call error_handler("IN FieldGet", rc)
7007 
7008  print*,"- CALL FieldGet FOR V."
7009  call esmf_fieldget(v_input_grid, &
7010  farrayptr=vptr, rc=rc)
7011  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7012  call error_handler("IN FieldGet", rc)
7013 
7014  print*,"- CALL FieldGet FOR LATITUDE."
7015  call esmf_fieldget(latitude_input_grid, &
7016  farrayptr=latptr, rc=rc)
7017  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7018  call error_handler("IN FieldGet", rc)
7019 
7020  print*,"- CALL FieldGet FOR LONGITUDE."
7021  call esmf_fieldget(longitude_input_grid, &
7022  farrayptr=lonptr, rc=rc)
7023  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
7024  call error_handler("IN FieldGet", rc)
7025 
7026  do i = clb(1), cub(1)
7027  do j = clb(2), cub(2)
7028  latrad = latptr(i,j) * acos(-1.) / 180.0
7029  lonrad = lonptr(i,j) * acos(-1.) / 180.0
7030  do k = clb(3), cub(3)
7031  windptr(i,j,k,1) = uptr(i,j,k) * cos(lonrad) - vptr(i,j,k) * sin(latrad) * sin(lonrad)
7032  windptr(i,j,k,2) = uptr(i,j,k) * sin(lonrad) + vptr(i,j,k) * sin(latrad) * cos(lonrad)
7033  windptr(i,j,k,3) = vptr(i,j,k) * cos(latrad)
7034  enddo
7035  enddo
7036  enddo
7037 
7038  call esmf_fielddestroy(u_input_grid, rc=rc)
7039  call esmf_fielddestroy(v_input_grid, rc=rc)
7040 
7041  end subroutine convert_winds
7042 
7056 subroutine gridrot(lov,latin1,latin2,lon,rot)
7057 
7058  use model_grid, only : i_input,j_input
7059  implicit none
7060 
7061 
7062  real(esmf_kind_r4), intent(in) :: lov,latin1,latin2
7063  real(esmf_kind_r4), intent(inout) :: rot(i_input,j_input)
7064  real(esmf_kind_r8), intent(in) :: lon(i_input,j_input)
7065 
7066  real(esmf_kind_r4) :: trot(i_input,j_input), tlon(i_input,j_input)
7067  real(esmf_kind_r4) :: dtor = 3.14159265359/180.0_esmf_kind_r4
7068  real(esmf_kind_r4) :: an
7069  !trot_tmp = real(lon,esmf_kind_r4)-lov
7070  !trot = trot_tmp
7071  !where(trot_tmp > 180.0) trot = trot-360.0_esmf_kind_r4
7072  !where(trot_tmp < -180.0) trot = trot-360.0_esmf_kind_r4
7073 
7074  if ( (latin1 - latin2) .lt. 0.000001 ) then
7075  an = sin(latin1*dtor)
7076  else
7077  an = log( cos(latin1*dtor) / cos(latin2*dtor) ) / &
7078  log( tan(dtor*(90.0-latin1)/2.) / tan(dtor*(90.0-latin2)/2.))
7079  end if
7080 
7081  tlon = mod(lon - lov + 180. + 3600., 360.) - 180.
7082  trot = an * tlon
7083 
7084  rot = trot * dtor
7085 
7086 end subroutine gridrot
7087 
7097 subroutine calcalpha_rotlatlon(latgrid,longrid,cenlat,cenlon,alpha)
7098 
7099  use model_grid, only : i_input,j_input
7100  implicit none
7101 
7102  real(esmf_kind_r8), intent(in) :: latgrid(i_input,j_input), &
7103  longrid(i_input,j_input)
7104  real(esmf_kind_r4), intent(in) :: cenlat, cenlon
7105  real(esmf_kind_r4), intent(out) :: alpha(i_input,j_input)
7106 
7107  ! Variables local to subroutine
7108  real(esmf_kind_r8) :: D2R,lon0_r,lat0_r,sphi0,cphi0
7109  real(esmf_kind_r8), DIMENSION(i_input,j_input) :: tlat,tlon,tph,sinalpha
7110 
7111  d2r = acos(-1.0_esmf_kind_r8) / 180.0_esmf_kind_r8
7112  if (cenlon .lt. 0) then
7113  lon0_r = (cenlon + 360.0)*d2r
7114  else
7115  lon0_r = cenlon*d2r
7116  end if
7117  lat0_r=cenlat*d2r
7118  sphi0=sin(lat0_r)
7119  cphi0=cos(lat0_r)
7120 
7121  ! deal with input lat/lon
7122  tlat = latgrid * d2r
7123  tlon = longrid * d2r
7124 
7125  ! Calculate alpha (rotation angle)
7126  tlon = -tlon + lon0_r
7127  tph = asin(cphi0*sin(tlat) - sphi0*cos(tlat)*cos(tlon))
7128  sinalpha = sphi0 * sin(tlon) / cos(tph)
7129  alpha = -asin(sinalpha)/d2r
7130  ! returns alpha in degrees
7131 end subroutine calcalpha_rotlatlon
7132 
7146 subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d)
7147 
7148  use, intrinsic :: ieee_arithmetic
7149 
7150  implicit none
7151 
7152  real(esmf_kind_r4), intent(in) :: value
7153  real(esmf_kind_r4), intent(inout), optional :: var(:,:)
7154  real(esmf_kind_r8), intent(inout), optional :: var8(:,:)
7155  real(esmf_kind_r8), intent(inout), optional :: var3d(:,:,:)
7156 
7157  character(len=20), intent(in) :: vname, lev, method
7158 
7159  integer, intent(in) :: varnum
7160  integer, intent(inout) :: iret
7161 
7162  iret = 0
7163  if (varnum == 9999) then
7164  print*, "WARNING: ", trim(vname), " NOT FOUND AT LEVEL ", lev, " IN EXTERNAL FILE ", &
7165  "AND NO ENTRY EXISTS IN VARMAP TABLE. VARIABLE WILL NOT BE USED."
7166  iret = 1
7167 
7168  return
7169  endif
7170 
7171  if (trim(method) == "skip" ) then
7172  print*, "WARNING: SKIPPING ", trim(vname), " IN FILE"
7173  read_from_input(varnum) = .false.
7174  iret = 1
7175  elseif (trim(method) == "set_to_fill") then
7176  print*, "WARNING: ,", trim(vname), " NOT AVAILABLE AT LEVEL ", trim(lev), &
7177  ". SETTING EQUAL TO FILL VALUE OF ", value
7178  if(present(var)) var(:,:) = value
7179  if(present(var8)) var8(:,:) = value
7180  if(present(var3d)) var3d(:,:,:) = value
7181  elseif (trim(method) == "set_to_NaN") then
7182  print*, "WARNING: ,", trim(vname), " NOT AVAILABLE AT LEVEL ", trim(lev), &
7183  ". SETTING EQUAL TO NaNs"
7184  if(present(var)) var(:,:) = ieee_value(var,ieee_quiet_nan)
7185  if(present(var8)) var8(:,:) = ieee_value(var8,ieee_quiet_nan)
7186  if(present(var3d)) var3d(:,:,:) = ieee_value(var3d,ieee_quiet_nan)
7187  elseif (trim(method) == "stop") then
7188  call error_handler("READING "//trim(vname)// " at level "//lev//". TO MAKE THIS NON- &
7189  FATAL, CHANGE STOP TO SKIP FOR THIS VARIABLE IN YOUR VARMAP &
7190  FILE.", iret)
7191  elseif (trim(method) == "intrp") then
7192  print*, "WARNING: ,"//trim(vname)//" NOT AVAILABLE AT LEVEL "//trim(lev)// &
7193  ". WILL INTERPOLATE INTERSPERSED MISSING LEVELS AND/OR FILL MISSING"//&
7194  " LEVELS AT EDGES."
7195  else
7196  call error_handler("ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // &
7197  " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// &
7198  " , intrp, skip, or stop.", 1)
7199  endif
7200 
7201 end subroutine handle_grib_error
7202 
7211  subroutine read_grib_soil(vname, vname_file, lugb, pdt_num, dummy3d)
7212 
7213  use grib_mod
7214 
7215  implicit none
7216 
7217  character(len=20), intent(in) :: vname,vname_file
7218 
7219  integer, intent(in) :: lugb, pdt_num
7220 
7221  real(esmf_kind_r8), intent(inout) :: dummy3d(:,:,:)
7222 
7223  character(len=50) :: slevs(lsoil_input)
7224  character(len=50) :: method
7225 
7226  integer :: varnum, i, j, k, rc, rc2
7227  integer :: jdisc, jgdtn, jpdtn, lugi
7228  integer :: jids(200), jgdt(200), jpdt(200)
7229  integer :: iscale1, iscale2
7230 
7231  logical :: unpack
7232 
7233  real(esmf_kind_r4), allocatable :: dummy2d(:,:)
7234  real(esmf_kind_r4) :: value
7235 
7236  type(gribfield) :: gfld
7237 
7238  allocate(dummy2d(i_input,j_input))
7239 
7240  if(lsoil_input == 4) then
7241  slevs = (/character(24)::':0-0.1 m below ground:', ':0.1-0.4 m below ground:', &
7242  ':0.4-1 m below ground:', ':1-2 m below ground:'/)
7243  elseif(lsoil_input == 9) then
7244  slevs = (/character(26)::':0-0 m below ground',':0.01-0.01 m below ground:',':0.04-0.04 m below ground:', &
7245  ':0.1-0.1 m below ground:',':0.3-0.3 m below ground:',':0.6-0.6 m below ground:', &
7246  ':1-1 m below ground:',':1.6-1.6 m below ground:',':3-3 m below ground:'/)
7247  else
7248  rc = -1
7249  call error_handler("reading soil levels. File must have 4 or 9 soil levels.", rc)
7250  endif
7251 
7252  call get_var_cond(vname,this_miss_var_method=method,this_miss_var_value=value, &
7253  loc=varnum)
7254 
7255  lugi = 0 ! unit number for index file
7256  jdisc = 2 ! search for discipline - land products
7257  j = 0 ! search at beginning of file.
7258  jpdt = -9999 ! array of values in product definition template 4.n
7259  jids = -9999 ! array of values in identification section, set to wildcard
7260  jgdt = -9999 ! array of values in grid definition template 3.m
7261  jgdtn = -1 ! search for any grid definition number.
7262  jpdtn = pdt_num ! Search for the product definition template number.
7263  jpdt(1) = 0 ! Section 4/Octet 10 - parameter category - veg/biomass
7264  if (trim(vname) == 'soilt') jpdt(2) = 2 ! Section 4/Octet 11 - parameter number - soil temp
7265  if (trim(vname) == 'soilw') jpdt(2) = 192 ! Section 4/Octet 11 - parameter number - total soilm
7266  if (trim(vname) == 'soill') then
7267  jpdt(1) = 3 ! Section 4/Octet 10 - soil products
7268  jpdt(2) = 192 ! Section 4/Octet 11 - parameter number - liquid soilm
7269  endif
7270  jpdt(10) = 106 ! Section 4/Octet 23 - depth below ground
7271  jpdt(13) = 106 ! Section 4/Octet 29 - depth below ground
7272  unpack=.true.
7273 
7274  do i = 1,lsoil_input
7275 
7276  call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
7277  unpack, k, gfld, rc2)
7278 
7279  if (rc2 /= 0) then ! record not found.
7280  call handle_grib_error(vname_file, slevs(i),method,value,varnum,rc,var=dummy2d)
7281  if (rc==1 .and. trim(vname) /= "soill") then
7282  ! missing_var_method == skip or no entry in varmap table
7283  call error_handler("READING IN "//trim(vname)//". SET A FILL "// &
7284  "VALUE IN THE VARMAP TABLE IF THIS ERROR IS NOT DESIRABLE.",rc)
7285  elseif (rc==1) then
7286  dummy3d(:,:,:) = 0.0_esmf_kind_r8
7287  return
7288  endif
7289  endif
7290 
7291  if (rc2 == 0) then ! record found.
7292  iscale1 = 10 ** gfld%ipdtmpl(11)
7293  iscale2 = 10 ** gfld%ipdtmpl(14)
7294 ! print*,'getgb2 top of soil layer in m ', float(gfld%ipdtmpl(12))/float(iscale1)
7295 ! print*,'getgb2 bot of soil layer in m ', float(gfld%ipdtmpl(15))/float(iscale2)
7296  dummy2d = reshape(gfld%fld, (/i_input,j_input/) )
7297  endif
7298 
7299  j = k
7300 
7301  dummy3d(:,:,i) = real(dummy2d,esmf_kind_r8)
7302 
7303  enddo
7304 
7305  deallocate(dummy2d)
7306 
7307  end subroutine read_grib_soil
7308 
7312  subroutine cleanup_input_atm_data
7313 
7314  implicit none
7315 
7316  integer :: rc, n
7317 
7318  print*,'- DESTROY ATMOSPHERIC INPUT DATA.'
7319 
7320  call esmf_fielddestroy(terrain_input_grid, rc=rc)
7321  call esmf_fielddestroy(pres_input_grid, rc=rc)
7322  call esmf_fielddestroy(dzdt_input_grid, rc=rc)
7323  call esmf_fielddestroy(temp_input_grid, rc=rc)
7324  call esmf_fielddestroy(wind_input_grid, rc=rc)
7325  call esmf_fielddestroy(ps_input_grid, rc=rc)
7326 
7327  do n = 1, num_tracers_input
7328  call esmf_fielddestroy(tracers_input_grid(n), rc=rc)
7329  enddo
7330  deallocate(tracers_input_grid)
7331 
7332  end subroutine cleanup_input_atm_data
7333 
7337  subroutine cleanup_input_nst_data
7338 
7339  implicit none
7340 
7341  integer :: rc
7342 
7343  print*,'- DESTROY NST INPUT DATA.'
7344 
7345  call esmf_fielddestroy(landsea_mask_input_grid, rc=rc)
7346  call esmf_fielddestroy(c_d_input_grid, rc=rc)
7347  call esmf_fielddestroy(c_0_input_grid, rc=rc)
7348  call esmf_fielddestroy(d_conv_input_grid, rc=rc)
7349  call esmf_fielddestroy(dt_cool_input_grid, rc=rc)
7350  call esmf_fielddestroy(ifd_input_grid, rc=rc)
7351  call esmf_fielddestroy(qrain_input_grid, rc=rc)
7352  call esmf_fielddestroy(tref_input_grid, rc=rc)
7353  call esmf_fielddestroy(w_d_input_grid, rc=rc)
7354  call esmf_fielddestroy(w_0_input_grid, rc=rc)
7355  call esmf_fielddestroy(xs_input_grid, rc=rc)
7356  call esmf_fielddestroy(xt_input_grid, rc=rc)
7357  call esmf_fielddestroy(xu_input_grid, rc=rc)
7358  call esmf_fielddestroy(xv_input_grid, rc=rc)
7359  call esmf_fielddestroy(xz_input_grid, rc=rc)
7360  call esmf_fielddestroy(xtts_input_grid, rc=rc)
7361  call esmf_fielddestroy(xzts_input_grid, rc=rc)
7362  call esmf_fielddestroy(z_c_input_grid, rc=rc)
7363  call esmf_fielddestroy(zm_input_grid, rc=rc)
7364 
7365  end subroutine cleanup_input_nst_data
7366 
7370  subroutine cleanup_input_sfc_data
7371 
7372  implicit none
7373 
7374  integer :: rc
7375 
7376  print*,"- CALL FieldDestroy FOR INPUT GRID FIELDS."
7377 
7378  call esmf_fielddestroy(canopy_mc_input_grid, rc=rc)
7379  call esmf_fielddestroy(f10m_input_grid, rc=rc)
7380  call esmf_fielddestroy(ffmm_input_grid, rc=rc)
7381  if (.not. convert_nst) then
7382  call esmf_fielddestroy(landsea_mask_input_grid, rc=rc)
7383  endif
7384  call esmf_fielddestroy(q2m_input_grid, rc=rc)
7385  call esmf_fielddestroy(seaice_depth_input_grid, rc=rc)
7386  call esmf_fielddestroy(seaice_fract_input_grid, rc=rc)
7387  call esmf_fielddestroy(seaice_skin_temp_input_grid, rc=rc)
7388  call esmf_fielddestroy(skin_temp_input_grid, rc=rc)
7389  call esmf_fielddestroy(snow_depth_input_grid, rc=rc)
7390  call esmf_fielddestroy(snow_liq_equiv_input_grid, rc=rc)
7391  call esmf_fielddestroy(soil_temp_input_grid, rc=rc)
7392  call esmf_fielddestroy(soil_type_input_grid, rc=rc)
7393  call esmf_fielddestroy(soilm_liq_input_grid, rc=rc)
7394  call esmf_fielddestroy(soilm_tot_input_grid, rc=rc)
7395  call esmf_fielddestroy(srflag_input_grid, rc=rc)
7396  call esmf_fielddestroy(t2m_input_grid, rc=rc)
7397  call esmf_fielddestroy(tprcp_input_grid, rc=rc)
7398  call esmf_fielddestroy(ustar_input_grid, rc=rc)
7399  call esmf_fielddestroy(veg_type_input_grid, rc=rc)
7400  call esmf_fielddestroy(z0_input_grid, rc=rc)
7401  call esmf_fielddestroy(terrain_input_grid, rc=rc)
7402  if (.not. vgfrc_from_climo) then
7403  call esmf_fielddestroy(veg_greenness_input_grid, rc=rc)
7404  endif
7405  if (.not. minmax_vgfrc_from_climo) then
7406  call esmf_fielddestroy(min_veg_greenness_input_grid, rc=rc)
7407  call esmf_fielddestroy(max_veg_greenness_input_grid, rc=rc)
7408  endif
7409  if (.not. lai_from_climo) then
7410  call esmf_fielddestroy(lai_input_grid, rc=rc)
7411  endif
7412 
7413  end subroutine cleanup_input_sfc_data
7414 
7421 recursive subroutine quicksort(a, first, last)
7422  implicit none
7423  real*8 a(*), x, t
7424  integer first, last
7425  integer i, j
7426 
7427  x = a( (first+last) / 2 )
7428  i = first
7429  j = last
7430  do
7431  do while (a(i) < x)
7432  i=i+1
7433  end do
7434  do while (x < a(j))
7435  j=j-1
7436  end do
7437  if (i >= j) exit
7438  t = a(i); a(i) = a(j); a(j) = t
7439  i=i+1
7440  j=j-1
7441  end do
7442  if (first < i-1) call quicksort(a, first, i-1)
7443  if (j+1 < last) call quicksort(a, j+1, last)
7444 end subroutine quicksort
7445 
7459 
7460 subroutine check_soilt(soilt, landmask, skint)
7461  implicit none
7462  real(esmf_kind_r8), intent(inout) :: soilt(i_input,j_input,lsoil_input)
7463  real(esmf_kind_r8), intent(in) :: skint(i_input,j_input)
7464  integer(esmf_kind_i4), intent(in) :: landmask(i_input,j_input)
7465 
7466  integer :: i, j, k
7467 
7468  do k=1,lsoil_input
7469  do j = 1, j_input
7470  do i = 1, i_input
7471  if (landmask(i,j) == 0_esmf_kind_i4 ) then
7472  soilt(i,j,k) = skint(i,j)
7473  else if (landmask(i,j) == 1_esmf_kind_i4 .and. soilt(i,j,k) > 350.0_esmf_kind_r8) then
7474  soilt(i,j,k) = skint(i,j)
7475  else if (landmask(i,j) == 2_esmf_kind_i4 ) then
7476  soilt(i,j,k) = icet_default
7477  endif
7478  enddo
7479  enddo
7480  enddo
7481 end subroutine check_soilt
7482 
7489 
7490 subroutine check_cnwat(cnwat)
7491  implicit none
7492  real(esmf_kind_r8), intent(inout) :: cnwat(i_input,j_input)
7493 
7494  real(esmf_kind_r8) :: max_cnwat = 0.5
7495 
7496  integer :: i, j
7497 
7498  do i = 1,i_input
7499  do j = 1,j_input
7500  if (cnwat(i,j) .gt. max_cnwat) cnwat(i,j) = 0.0_esmf_kind_r8
7501  enddo
7502  enddo
7503 end subroutine check_cnwat
7504 
7505 
7506 
7507 
7526 
7527 SUBROUTINE dint2p(PPIN,XXIN,NPIN,PPOUT,XXOUT,NPOUT &
7528  ,LINLOG,XMSG,IER)
7529  IMPLICIT NONE
7530 
7531 ! NCL code for pressure level interpolation
7532 !
7533 ! This code was designed for one simple task. It has since
7534 ! been mangled and abused for assorted reasons. For example,
7535 ! early gfortran compilers had some issues with automatic arrays.
7536 ! Hence, the C-Wrapper was used to create 'work' arrays which
7537 ! were then passed to this code. The original focused (non-NCL)
7538 ! task was to handle PPIN & PPOUT that had the same 'monotonicity.'
7539 ! Extra code was added to handle the more general case.
7540 ! Blah-Blah: Punch line: it is embarrassingly convoluted!!!
7541 !
7542 ! ! input types
7543  INTEGER npin,npout,linlog,ier
7544  real*8 ppin(npin),xxin(npin),ppout(npout),xmsg
7545  ! output
7546  real*8 xxout(npout)
7547  ! work
7548  real*8 pin(npin),xin(npin),p(npin),x(npin)
7549  real*8 pout(npout),xout(npout)
7550 
7551 ! local
7552  INTEGER j1,np,nl,nin,nlmax,nplvl,nlsave,np1,no1,n1,n2,loglin, &
7553  nlstrt
7554  real*8 slope,pa,pb,pc
7555 
7556  loglin = abs(linlog)
7557 
7558 ! error check: enough points: pressures consistency?
7559 
7560  ier = 0
7561  IF (npout.GT.0) THEN
7562  DO np = 1,npout
7563  xxout(np) = xmsg
7564  END DO
7565  END IF
7566 ! Jili Dong input levels have to be the same as output levels:
7567 ! we only interpolate for levels with missing variables
7568 ! IF (.not. all(PPIN .eq. PPOUT)) IER = IER+1
7569 
7570  IF (npin.LT.2 .OR. npout.LT.1) ier = ier + 1
7571 
7572  IF (ier.NE.0) THEN
7573 ! PRINT *,'INT2P: error exit: ier=',IER
7574  RETURN
7575  END IF
7576 
7577 ! should *input arrays* be reordered? want p(1) > p(2) > p(3) etc
7578 ! so that it will match order for which code was originally designed
7579 ! copy to 'work' arrays
7580 
7581  np1 = 0
7582  no1 = 0
7583  IF (ppin(1).LT.ppin(2)) THEN
7584  np1 = npin + 1
7585  END IF
7586  IF (ppout(1).LT.ppout(2)) THEN
7587  no1 = npout + 1
7588  END IF
7589 
7590  DO np = 1,npin
7591  pin(np) = ppin(abs(np1-np))
7592  xin(np) = xxin(abs(np1-np))
7593  END DO
7594 
7595  DO np = 1,npout
7596  pout(np) = ppout(abs(no1-np))
7597  END DO
7598 
7599 ! eliminate XIN levels with missing data.
7600 ! . This can happen with observational data.
7601 
7602  nl = 0
7603  DO np = 1,npin
7604  IF (xin(np).NE.xmsg .AND. pin(np).NE.xmsg) THEN
7605  nl = nl + 1
7606  p(nl) = pin(np)
7607  x(nl) = xin(np)
7608  END IF
7609  END DO
7610  nlmax = nl
7611 
7612  ! all missing data
7613  IF (nlmax.LT.2) THEN
7614  ier = ier + 1000
7615  print *,'INT2P: ier=',ier
7616  RETURN
7617  END IF
7618 
7619 ! ===============> pressure in decreasing order <================
7620 ! perform the interpolation [pin(1)>pin(2)>...>pin(npin)]
7621 ! ( p ,x)
7622 ! ------------------------- p(nl+1), x(nl+1) example (200,5)
7623 ! .
7624 ! ------------------------- pout(np), xout(np) (250,?)
7625 ! .
7626 ! ------------------------- p(nl) , x(nl) (300,10)
7627 
7628 
7629 ! exact p-level matches
7630  nlstrt = 1
7631  nlsave = 1
7632  DO np = 1,npout
7633  xout(np) = xmsg
7634  DO nl = nlstrt,nlmax
7635  IF (pout(np).EQ.p(nl)) THEN
7636  xout(np) = x(nl)
7637  nlsave = nl + 1
7638  GO TO 10
7639  END IF
7640  END DO
7641  10 nlstrt = nlsave
7642  END DO
7643 
7644  IF (loglin.EQ.1) THEN
7645  DO np = 1,npout
7646  DO nl = 1,nlmax - 1
7647  IF (pout(np).LT.p(nl) .AND. pout(np).GT.p(nl+1)) THEN
7648  slope = (x(nl)-x(nl+1))/ (p(nl)-p(nl+1))
7649  xout(np) = x(nl+1) + slope* (pout(np)-p(nl+1))
7650  END IF
7651  END DO
7652  END DO
7653  ELSE
7654  DO np = 1,npout
7655  DO nl = 1,nlmax - 1
7656  IF (pout(np).LT.p(nl) .AND. pout(np).GT.p(nl+1)) THEN
7657  pa = log(p(nl))
7658  pb = log(pout(np))
7659 ! special case: In case someome inadvertently enter p=0.
7660  if (p(nl+1).gt.0.d0) then
7661  pc = log(p(nl+1))
7662  else
7663  pc = log(1.d-4)
7664  end if
7665 
7666  slope = (x(nl)-x(nl+1))/ (pa-pc)
7667  xout(np) = x(nl+1) + slope* (pb-pc)
7668  END IF
7669  END DO
7670  END DO
7671  END IF
7672 
7673 ! extrapolate?
7674 ! . use the 'last' valid slope for extrapolating
7675 
7676  IF (linlog.LT.0) THEN
7677  DO np = 1,npout
7678  DO nl = 1,nlmax
7679  IF (pout(np).GT.p(1)) THEN
7680  IF (loglin.EQ.1) THEN
7681  slope = (x(2)-x(1))/ (p(2)-p(1))
7682  xout(np) = x(1) + slope* (pout(np)-p(1))
7683  ELSE
7684  pa = log(p(2))
7685  pb = log(pout(np))
7686  pc = log(p(1))
7687  slope = (x(2)-x(1))/ (pa-pc)
7688  xout(np) = x(1) + slope* (pb-pc)
7689  END IF
7690  ELSE IF (pout(np).LT.p(nlmax)) THEN
7691  n1 = nlmax
7692  n2 = nlmax - 1
7693  IF (loglin.EQ.1) THEN
7694  slope = (x(n1)-x(n2))/ (p(n1)-p(n2))
7695  xout(np) = x(n1) + slope* (pout(np)-p(n1))
7696  ELSE
7697  pa = log(p(n1))
7698  pb = log(pout(np))
7699  pc = log(p(n2))
7700  slope = (x(n1)-x(n2))/ (pa-pc)
7701  !XOUT(NP) = X(N1) + SLOPE* (PB-PC) !bug fixed below
7702  xout(np) = x(n1) + slope* (pb-pa)
7703  END IF
7704  END IF
7705  END DO
7706  END DO
7707  END IF
7708 
7709 ! place results in the return array;
7710 ! . possibly .... reverse to original order
7711 
7712  if (no1.GT.0) THEN
7713  DO np = 1,npout
7714  n1 = abs(no1-np)
7715  ppout(np) = pout(n1)
7716  xxout(np) = xout(n1)
7717  END DO
7718  ELSE
7719  DO np = 1,npout
7720  ppout(np) = pout(np)
7721  xxout(np) = xout(np)
7722  END DO
7723  END IF
7724 
7725 
7726  RETURN
7727  END SUBROUTINE dint2p
7728 
7729 
7730  end module input_data
grib2_util
Utilities for use when reading grib2 data.
Definition: grib2_util.F90:12
input_data::read_input_nst_nemsio_file
subroutine read_input_nst_nemsio_file(localpet)
Read input grid nst data from fv3 gaussian nemsio history file or spectral GFS nemsio file...
Definition: input_data.F90:6482
input_data::seaice_fract_input_grid
type(esmf_field), public seaice_fract_input_grid
sea ice fraction
Definition: input_data.F90:82
input_data::read_input_atm_restart_file
subroutine read_input_atm_restart_file(localpet)
Read input grid fv3 atmospheric data &#39;warm&#39; restart files.
Definition: input_data.F90:1522
program_setup
This module contains code to read the setup namelist file, handle the varmap file for GRIB2 data...
Definition: program_setup.F90:9
program_setup::atm_tracer_files_input_grid
character(len=500), dimension(6), public atm_tracer_files_input_grid
File names of input atmospheric restart tracer files.
Definition: program_setup.F90:21
program_setup::num_tracers_input
integer, public num_tracers_input
Number of atmospheric tracers in input file.
Definition: program_setup.F90:58
input_data::icet_default
integer, parameter icet_default
Default value of soil and skin temperature (K) over ice.
Definition: input_data.F90:72
input_data::lev_input
integer, public lev_input
number of atmospheric layers
Definition: input_data.F90:64
program_setup::nst_files_input_grid
character(len=500), public nst_files_input_grid
File name of input nst data.
Definition: program_setup.F90:26
model_grid::ip1_input
integer, public ip1_input
i_input plus 1
Definition: model_grid.F90:32
input_data::xz_input_grid
type(esmf_field), public xz_input_grid
Diurnal thermocline layer thickness.
Definition: input_data.F90:123
input_data::seaice_skin_temp_input_grid
type(esmf_field), public seaice_skin_temp_input_grid
sea ice skin temp
Definition: input_data.F90:83
model_grid::j_input
integer, public j_input
j-dimension of input grid (or of each global tile)
Definition: model_grid.F90:29
input_data::veg_greenness_input_grid
type(esmf_field), public veg_greenness_input_grid
vegetation fraction
Definition: input_data.F90:97
input_data::read_input_sfc_grib2_file
subroutine read_input_sfc_grib2_file(localpet)
Read input grid surface data from a grib2 file.
Definition: input_data.F90:5013
input_data::read_input_nst_netcdf_file
subroutine read_input_nst_netcdf_file(localpet)
Read nst data from these netcdf formatted fv3 files: tiled history, tiled warm restart, and gaussian history.
Definition: input_data.F90:6198
program_setup::lai_from_climo
logical, public lai_from_climo
If false, interpolate leaf area index from the input data to the target grid instead of using data fr...
Definition: program_setup.F90:116
input_data::read_input_sfc_gfs_gaussian_nemsio_file
subroutine read_input_sfc_gfs_gaussian_nemsio_file(localpet)
Read input grid surface data from a spectral gfs gaussian nemsio file.
Definition: input_data.F90:3637
input_data::tref_input_grid
type(esmf_field), public tref_input_grid
Reference temperature.
Definition: input_data.F90:116
input_data::w_0_input_grid
type(esmf_field), public w_0_input_grid
Coefficient 3 to calculate d(tz)/d(ts)
Definition: input_data.F90:118
input_data::z_c_input_grid
type(esmf_field), public z_c_input_grid
Sub-layer cooling thickness.
Definition: input_data.F90:126
input_data::veg_type_landice_input
integer, public veg_type_landice_input
NOAH land ice option defined at this veg type.
Definition: input_data.F90:69
input_data::z0_input_grid
type(esmf_field), public z0_input_grid
roughness length
Definition: input_data.F90:96
input_data::dpres_input_grid
type(esmf_field) dpres_input_grid
pressure thickness
Definition: input_data.F90:53
input_data::read_input_sfc_restart_file
subroutine read_input_sfc_restart_file(localpet)
Read input grid surface data from fv3 tiled warm &#39;restart&#39; files.
Definition: input_data.F90:4335
input_data::xv_input_grid
type(esmf_field), public xv_input_grid
v-current content in diurnal thermocline layer
Definition: input_data.F90:122
input_data::calcalpha_rotlatlon
subroutine calcalpha_rotlatlon(latgrid, longrid, cenlat, cenlon, alpha)
Calculate rotation angle for rotated latlon grids.
Definition: input_data.F90:7098
input_data::levp1_input
integer, public levp1_input
number of atmos layer interfaces
Definition: input_data.F90:65
program_setup::tracers
character(len=20), dimension(max_tracers), public tracers
Name of each atmos tracer to be processed.
Definition: program_setup.F90:63
input_data::read_input_atm_gfs_gaussian_nemsio_file
subroutine read_input_atm_gfs_gaussian_nemsio_file(localpet)
Read input atmospheric data from spectral gfs (global gaussian in nemsio format.
Definition: input_data.F90:986
input_data::lai_input_grid
type(esmf_field), public lai_input_grid
leaf area index
Definition: input_data.F90:98
input_data::ps_input_grid
type(esmf_field), public ps_input_grid
surface pressure
Definition: input_data.F90:55
input_data::cleanup_input_atm_data
subroutine, public cleanup_input_atm_data
Free up memory associated with atm data.
Definition: input_data.F90:7313
model_grid::jp1_input
integer, public jp1_input
j_input plus 1
Definition: model_grid.F90:34
input_data::ifd_input_grid
type(esmf_field), public ifd_input_grid
Model mode index.
Definition: input_data.F90:113
input_data::read_input_atm_data
subroutine, public read_input_atm_data(localpet)
Read input grid atmospheric data driver.
Definition: input_data.F90:149
input_data::convert_winds
subroutine, public convert_winds
Convert winds from 2-d to 3-d components.
Definition: input_data.F90:6981
model_grid
Sets up the ESMF grid objects for the input data grid and target FV3 grid.
Definition: model_grid.F90:9
program_setup::tracers_input
character(len=20), dimension(max_tracers), public tracers_input
Name of each atmos tracer record in the input file.
Definition: program_setup.F90:69
input_data::read_input_atm_gaussian_nemsio_file
subroutine read_input_atm_gaussian_nemsio_file(localpet)
Read input grid atmospheric fv3 gaussian nemsio files.
Definition: input_data.F90:1239
model_grid::latitude_input_grid
type(esmf_field), public latitude_input_grid
latitude of grid center, input grid
Definition: model_grid.F90:56
input_data::slevs
character(len=50), dimension(:), allocatable, private slevs
The atmospheric levels in the GRIB2 input file.
Definition: input_data.F90:105
input_data::zm_input_grid
type(esmf_field), public zm_input_grid
Oceanic mixed layer depth.
Definition: input_data.F90:127
input_data::ffmm_input_grid
type(esmf_field), public ffmm_input_grid
log((z0+z1)*1/z0) See sfc_diff.f for details.
Definition: input_data.F90:76
search_util
Replace undefined values with a valid value.
Definition: search_util.F90:15
program_setup::get_var_cond
subroutine, public get_var_cond(var_name, this_miss_var_method, this_miss_var_value, this_field_var_name, loc)
Search the variable mapping table to find conditions for handling missing variables.
Definition: program_setup.F90:445
input_data::xtts_input_grid
type(esmf_field), public xtts_input_grid
d(xt)/d(ts)
Definition: input_data.F90:124
program_setup::sotyp_from_climo
logical, public sotyp_from_climo
If false, interpolate soil type from the input data to the target grid instead of using data from sta...
Definition: program_setup.F90:102
input_data::cleanup_input_nst_data
subroutine, public cleanup_input_nst_data
Free up memory associated with nst data.
Definition: input_data.F90:7338
input_data::qrain_input_grid
type(esmf_field), public qrain_input_grid
Sensible heat flux due to rainfall.
Definition: input_data.F90:115
model_grid::num_tiles_input_grid
integer, public num_tiles_input_grid
Number of tiles, input grid.
Definition: model_grid.F90:46
program_setup::minmax_vgfrc_from_climo
logical, public minmax_vgfrc_from_climo
If false, interpolate min/max vegetation fraction from the input data to the target grid instead of u...
Definition: program_setup.F90:112
input_data::read_input_atm_grib2_file
subroutine read_input_atm_grib2_file(localpet)
Read input grid atmospheric fv3gfs grib2 files.
Definition: input_data.F90:2456
grib2_util::rh2spfh_gfs
subroutine, public rh2spfh_gfs(rh_sphum, p, t)
Convert relative humidity to specific humidity (GFS formula) Calculation of saturation water vapor pr...
Definition: grib2_util.F90:81
input_data::init_atm_esmf_fields
subroutine init_atm_esmf_fields
Create atmospheric esmf fields.
Definition: input_data.F90:445
input_data::cleanup_input_sfc_data
subroutine, public cleanup_input_sfc_data
Free up memory associated with sfc data.
Definition: input_data.F90:7371
input_data::terrain_input_grid
type(esmf_field), public terrain_input_grid
terrain height
Definition: input_data.F90:56
program_setup::orog_files_input_grid
character(len=500), dimension(6), public orog_files_input_grid
Input grid orography files.
Definition: program_setup.F90:32
input_data::lsoil_input
integer, public lsoil_input
number of soil layers, no longer hardwired to allow for 7 layers of soil for the RUC LSM ...
Definition: input_data.F90:102
input_data::srflag_input_grid
type(esmf_field), public srflag_input_grid
snow/rain flag
Definition: input_data.F90:91
input_data::read_input_atm_tiled_history_file
subroutine read_input_atm_tiled_history_file(localpet)
Read input grid fv3 atmospheric tiled history files in netcdf format.
Definition: input_data.F90:2165
input_data::check_soilt
subroutine, public check_soilt(soilt, landmask, skint)
Check for and replace certain values in soil temperature.
Definition: input_data.F90:7461
input_data::w_d_input_grid
type(esmf_field), public w_d_input_grid
Coefficient 4 to calculate d(tz)/d(ts)
Definition: input_data.F90:117
input_data::t2m_input_grid
type(esmf_field), public t2m_input_grid
2-m temperature
Definition: input_data.F90:92
input_data::read_input_sfc_gaussian_nemsio_file
subroutine read_input_sfc_gaussian_nemsio_file(localpet)
Read input grid surface data from an fv3 gaussian nemsio file.
Definition: input_data.F90:3986
input_data::max_veg_greenness_input_grid
type(esmf_field), public max_veg_greenness_input_grid
shdmax
Definition: input_data.F90:99
program_setup::external_model
character(len=20), public external_model
The model that the input data is derived from.
Definition: program_setup.F90:54
search_util::search
subroutine, public search(field, mask, idim, jdim, tile, field_num, latitude, terrain_land, soilt_climo)
Replace undefined surface values.
Definition: search_util.F90:47
program_setup::orog_dir_input_grid
character(len=500), public orog_dir_input_grid
Directory containing the input grid orography files.
Definition: program_setup.F90:31
input_data::read_input_sfc_gfs_sfcio_file
subroutine read_input_sfc_gfs_sfcio_file(localpet)
Read input grid surface data from a spectral gfs gaussian sfcio file.
Definition: input_data.F90:3413
input_data::snow_liq_equiv_input_grid
type(esmf_field), public snow_liq_equiv_input_grid
snow liq equiv depth
Definition: input_data.F90:86
program_setup::convert_nst
logical, public convert_nst
Convert nst data when true.
Definition: program_setup.F90:92
program_setup::atm_files_input_grid
character(len=500), dimension(6), public atm_files_input_grid
File names of input atmospheric data.
Definition: program_setup.F90:16
input_data::u_input_grid
type(esmf_field), public u_input_grid
u/v wind at grid
Definition: input_data.F90:59
input_data::soilm_liq_input_grid
type(esmf_field), public soilm_liq_input_grid
3-d liquid soil moisture
Definition: input_data.F90:89
input_data::temp_input_grid
type(esmf_field), public temp_input_grid
temperature
Definition: input_data.F90:57
input_data::soil_type_input_grid
type(esmf_field), public soil_type_input_grid
soil type
Definition: input_data.F90:88
input_data::read_input_sfc_data
subroutine, public read_input_sfc_data(localpet)
Driver to read input grid surface data.
Definition: input_data.F90:381
input_data::read_input_atm_gfs_sigio_file
subroutine read_input_atm_gfs_sigio_file(localpet)
Read input atmospheric data from spectral gfs (old sigio format).
Definition: input_data.F90:747
input_data::pres_input_grid
type(esmf_field), public pres_input_grid
3-d pressure
Definition: input_data.F90:54
input_data::xu_input_grid
type(esmf_field), public xu_input_grid
u-current content in diurnal thermocline layer
Definition: input_data.F90:121
input_data::gridrot
subroutine gridrot(lov, latin1, latin2, lon, rot)
Compute grid rotation angle for non-latlon grids.
Definition: input_data.F90:7057
input_data::read_grib_soil
subroutine read_grib_soil(vname, vname_file, lugb, pdt_num, dummy3d)
Read soil temperature and soil moisture fields from a GRIB2 file.
Definition: input_data.F90:7212
input_data::dt_cool_input_grid
type(esmf_field), public dt_cool_input_grid
Sub-layer cooling amount.
Definition: input_data.F90:112
netcdf_err
subroutine netcdf_err(err, string)
Error handler for netcdf.
Definition: utils.F90:32
input_data::read_input_nst_data
subroutine, public read_input_nst_data(localpet)
Driver to read input grid nst data.
Definition: input_data.F90:219
input_data::c_d_input_grid
type(esmf_field), public c_d_input_grid
Coefficient 2 to calculate d(tz)/d(ts)
Definition: input_data.F90:109
input_data::read_input_sfc_netcdf_file
subroutine read_input_sfc_netcdf_file(localpet)
Read input grid surface data from tiled &#39;history&#39; files (netcdf) or gaussian netcdf files...
Definition: input_data.F90:4652
input_data::f10m_input_grid
type(esmf_field), public f10m_input_grid
log((z0+10)*1/z0)
Definition: input_data.F90:75
input_data::xs_input_grid
type(esmf_field), public xs_input_grid
Salinity content in diurnal thermocline layer.
Definition: input_data.F90:119
input_data::xzts_input_grid
type(esmf_field), public xzts_input_grid
d(xz)/d(ts)
Definition: input_data.F90:125
program_setup::geogrid_file_input_grid
character(len=500), public geogrid_file_input_grid
Name of "geogrid" file, which contains static surface fields on the input grid.
Definition: program_setup.F90:28
input_data::min_veg_greenness_input_grid
type(esmf_field), public min_veg_greenness_input_grid
shdmin
Definition: input_data.F90:100
input_data::dzdt_input_grid
type(esmf_field), public dzdt_input_grid
vert velocity
Definition: input_data.F90:52
input_data::q2m_input_grid
type(esmf_field), public q2m_input_grid
2-m spec hum
Definition: input_data.F90:80
program_setup::vgfrc_from_climo
logical, public vgfrc_from_climo
If false, interpolate vegetation fraction from the input data to the target grid instead of using dat...
Definition: program_setup.F90:107
input_data::read_winds
subroutine read_winds(u, v, localpet, octet_23, rlevs, lugb, pdt_num)
Read winds from a grib2 file.
Definition: input_data.F90:6806
model_grid::input_grid
type(esmf_grid), public input_grid
input grid esmf grid object
Definition: model_grid.F90:51
program_setup::data_dir_input_grid
character(len=500), public data_dir_input_grid
Directory containing input atm or sfc files.
Definition: program_setup.F90:22
error_handler
subroutine error_handler(string, rc)
General error handler.
Definition: utils.F90:10
grib2_util::convert_omega
subroutine, public convert_omega(omega, p, t, q, clb, cub)
Convert omega to vertical velocity.
Definition: grib2_util.F90:218
input_data::init_sfc_esmf_fields
subroutine, public init_sfc_esmf_fields
Create surface input grid esmf fields.
Definition: input_data.F90:539
input_data::d_conv_input_grid
type(esmf_field), public d_conv_input_grid
Thickness of free convection layer.
Definition: input_data.F90:111
input_data::handle_grib_error
subroutine handle_grib_error(vname, lev, method, value, varnum, iret, var, var8, var3d)
Handle GRIB2 read error based on the user selected method in the varmap file.
Definition: input_data.F90:7147
model_grid::input_grid_type
character(len=50), public input_grid_type
map projection of input grid
Definition: model_grid.F90:20
program_setup::input_type
character(len=25), public input_type
Input data type:
Definition: program_setup.F90:40
program_setup::atm_core_files_input_grid
character(len=500), dimension(7), public atm_core_files_input_grid
File names of input atmospheric restart core files.
Definition: program_setup.F90:20
input_data::soil_temp_input_grid
type(esmf_field), public soil_temp_input_grid
3-d soil temp
Definition: input_data.F90:87
input_data::wind_input_grid
type(esmf_field), public wind_input_grid
3-component wind
Definition: input_data.F90:61
input_data::check_cnwat
subroutine, public check_cnwat(cnwat)
When using GEFS data, some points on the target grid have unreasonable canpy moisture content...
Definition: input_data.F90:7491
input_data::v_input_grid
type(esmf_field), public v_input_grid
box center
Definition: input_data.F90:60
input_data::veg_type_input_grid
type(esmf_field), public veg_type_input_grid
vegetation type
Definition: input_data.F90:95
input_data::soilm_tot_input_grid
type(esmf_field), public soilm_tot_input_grid
3-d total soil moisture
Definition: input_data.F90:90
model_grid::longitude_input_grid
type(esmf_field), public longitude_input_grid
longitude of grid center, input grid
Definition: model_grid.F90:58
input_data::landsea_mask_input_grid
type(esmf_field), public landsea_mask_input_grid
land sea mask; 0-water, 1-land, 2-ice
Definition: input_data.F90:78
input_data::canopy_mc_input_grid
type(esmf_field), public canopy_mc_input_grid
canopy moist content
Definition: input_data.F90:74
input_data::xt_input_grid
type(esmf_field), public xt_input_grid
Heat content in diurnal thermocline layer.
Definition: input_data.F90:120
program_setup::grib2_file_input_grid
character(len=500), public grib2_file_input_grid
REQUIRED.
Definition: program_setup.F90:27
input_data::skin_temp_input_grid
type(esmf_field), public skin_temp_input_grid
skin temp/sst
Definition: input_data.F90:84
input_data::snow_depth_input_grid
type(esmf_field), public snow_depth_input_grid
snow dpeth
Definition: input_data.F90:85
input_data
Read atmospheric, surface and nst data on the input grid.
Definition: input_data.F90:14
program_setup::vgtyp_from_climo
logical, public vgtyp_from_climo
If false, interpolate vegetation type from the input data to the target grid instead of using data fr...
Definition: program_setup.F90:98
program_setup::read_from_input
logical, dimension(:), allocatable, public read_from_input
When false, variable was not read from GRIB2 input file.
Definition: program_setup.F90:60
input_data::ustar_input_grid
type(esmf_field), public ustar_input_grid
fric velocity
Definition: input_data.F90:94
input_data::c_0_input_grid
type(esmf_field), public c_0_input_grid
Coefficient 1 to calculate d(tz)/d(ts)
Definition: input_data.F90:110
input_data::read_input_atm_gaussian_netcdf_file
subroutine read_input_atm_gaussian_netcdf_file(localpet)
Read fv3 netcdf gaussian history file.
Definition: input_data.F90:1781
input_data::tracers_input_grid
type(esmf_field), dimension(:), allocatable, public tracers_input_grid
tracers
Definition: input_data.F90:62
program_setup::sfc_files_input_grid
character(len=500), dimension(6), public sfc_files_input_grid
File names containing input surface data.
Definition: program_setup.F90:35
input_data::tprcp_input_grid
type(esmf_field), public tprcp_input_grid
precip
Definition: input_data.F90:93
model_grid::i_input
integer, public i_input
i-dimension of input grid (or of each global tile)
Definition: model_grid.F90:26
grib2_util::rh2spfh
subroutine, public rh2spfh(rh_sphum, p, t)
Convert relative humidity to specific humidity.
Definition: grib2_util.F90:38
input_data::seaice_depth_input_grid
type(esmf_field), public seaice_depth_input_grid
sea ice depth
Definition: input_data.F90:81
input_data::quicksort
recursive subroutine, public quicksort(a, first, last)
Sort an array of values.
Definition: input_data.F90:7422