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