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