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