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