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