chgres_cube  1.7.0
 All Data Structures Files Functions Variables
surface.F90
Go to the documentation of this file.
1 
5 
21  module surface
22 
23  use esmf
24 
25  use surface_target_data, only : canopy_mc_target_grid, t2m_target_grid, &
26  q2m_target_grid, tprcp_target_grid, &
27  f10m_target_grid, seaice_fract_target_grid, &
28  ffmm_target_grid, ustar_target_grid, &
29  srflag_target_grid, soil_temp_target_grid, &
30  seaice_depth_target_grid, snow_liq_equiv_target_grid, &
31  seaice_skin_temp_target_grid, skin_temp_target_grid, &
32  snow_depth_target_grid, z0_target_grid, &
33  c_d_target_grid, c_0_target_grid, &
34  d_conv_target_grid, dt_cool_target_grid, &
35  ifd_target_grid, qrain_target_grid, &
36  tref_target_grid, w_d_target_grid, &
37  w_0_target_grid, xs_target_grid, &
38  xt_target_grid, xu_target_grid, &
39  xv_target_grid, xz_target_grid, &
40  xtts_target_grid, xzts_target_grid, &
41  z_c_target_grid, zm_target_grid, &
42  soilm_tot_target_grid, lai_target_grid, &
43  soilm_liq_target_grid
44 
45  use write_data, only : write_fv3_sfc_data_netcdf
46 
47  implicit none
48 
49  private
50 
51  integer, parameter :: veg_type_landice_target = 15
52 
56 
57  type(esmf_field) :: soil_type_from_input_grid
58 
60  type(esmf_field) :: terrain_from_input_grid
61 
63  type(esmf_field) :: terrain_from_input_grid_land
64 
66 
67  real, parameter, private :: blim = 5.5
68 
69  real, parameter, private :: frz_h2o = 273.15
70 
71  real, parameter, private :: frz_ice = 271.21
72 
73  real, parameter, private :: grav = 9.81
74 
75  real, parameter, private :: hlice = 3.335E5
76 
77 
78 
79  type realptr_2d
80  real(esmf_kind_r8), pointer :: p(:,:)
81 
82  end type realptr_2d
83 
84  type realptr_3d
85  real(esmf_kind_r8), pointer :: p(:,:,:)
86 
87  end type realptr_3d
88 
89 
90  public :: surface_driver
91  public :: create_nst_esmf_fields
92  public :: interp
93  public :: create_surface_esmf_fields
94  public :: nst_land_fill
95  public :: regrid_many
96  public :: search_many
97 
98  contains
99 
105  subroutine surface_driver(localpet)
106 
107  use input_data, only : cleanup_input_sfc_data, &
108  cleanup_input_nst_data, &
109  read_input_sfc_data, &
110  read_input_nst_data
111 
112  use program_setup, only : calc_soil_params_driver, &
113  convert_nst
114 
115  use static_data, only : get_static_fields, &
116  cleanup_static_fields
117 
118  use surface_target_data, only : cleanup_target_nst_data
119 
120  implicit none
121 
122  integer, intent(in) :: localpet
123 
124 !-----------------------------------------------------------------------
125 ! Compute soil-based parameters.
126 !-----------------------------------------------------------------------
127 
128  call calc_soil_params_driver(localpet)
129 
130 !-----------------------------------------------------------------------
131 ! Get static data (like vegetation type) on the target grid.
132 !-----------------------------------------------------------------------
133 
134  call get_static_fields(localpet)
135 
136 !-----------------------------------------------------------------------
137 ! Read surface data on input grid.
138 !-----------------------------------------------------------------------
139 
140  call read_input_sfc_data(localpet)
141 
142 !-----------------------------------------------------------------------
143 ! Read nst data on input grid.
144 !-----------------------------------------------------------------------
145 
146  if (convert_nst) call read_input_nst_data(localpet)
147 
148 !-----------------------------------------------------------------------
149 ! Create surface field objects for target grid.
150 !-----------------------------------------------------------------------
151 
152  call create_surface_esmf_fields
153 
154 !-----------------------------------------------------------------------
155 ! Create nst field objects for target grid.
156 !-----------------------------------------------------------------------
157 
158  if (convert_nst) call create_nst_esmf_fields
159 
160 !-----------------------------------------------------------------------
161 ! Adjust soil levels of input grid !! not implemented yet
162 !-----------------------------------------------------------------------
163 
164  call adjust_soil_levels(localpet)
165 
166 !-----------------------------------------------------------------------
167 ! Horizontally interpolate fields.
168 !-----------------------------------------------------------------------
169 
170  call interp(localpet)
171 
172 !---------------------------------------------------------------------------------------------
173 ! Adjust soil/landice column temperatures for any change in elevation between the
174 ! input and target grids.
175 !---------------------------------------------------------------------------------------------
176 
177  call adjust_soilt_for_terrain
178 
179 !---------------------------------------------------------------------------------------------
180 ! Rescale soil moisture for changes in soil type between the input and target grids.
181 !---------------------------------------------------------------------------------------------
182 
183  call rescale_soil_moisture
184 
185 !---------------------------------------------------------------------------------------------
186 ! Compute liquid portion of total soil moisture.
187 !---------------------------------------------------------------------------------------------
188 
189  call calc_liq_soil_moisture
190 
191 !---------------------------------------------------------------------------------------------
192 ! Set z0 at land and sea ice.
193 !---------------------------------------------------------------------------------------------
194 
195  call roughness
196 
197 !---------------------------------------------------------------------------------------------
198 ! Perform some final qc checks.
199 !---------------------------------------------------------------------------------------------
200 
201  call qc_check
202 
203 !---------------------------------------------------------------------------------------------
204 ! Set flag values at land for nst fields.
205 !---------------------------------------------------------------------------------------------
206 
207  if (convert_nst) call nst_land_fill
208 
209 !---------------------------------------------------------------------------------------------
210 ! Free up memory.
211 !---------------------------------------------------------------------------------------------
212 
213  call cleanup_input_sfc_data
214 
215  if (convert_nst) call cleanup_input_nst_data
216 
217 !---------------------------------------------------------------------------------------------
218 ! Write data to file.
219 !---------------------------------------------------------------------------------------------
220 
221  call write_fv3_sfc_data_netcdf(localpet)
222 
223 !---------------------------------------------------------------------------------------------
224 ! Free up memory.
225 !---------------------------------------------------------------------------------------------
226 
227  if (convert_nst) call cleanup_target_nst_data
228 
229  call cleanup_all_target_sfc_data
230 
231  call cleanup_static_fields
232 
233  return
234 
235  end subroutine surface_driver
236 
243  subroutine interp(localpet)
244 
245  use mpi
246  use esmf
247 
248  use input_data, only : canopy_mc_input_grid, &
249  f10m_input_grid, &
250  ffmm_input_grid, &
251  landsea_mask_input_grid, &
252  q2m_input_grid, &
253  seaice_depth_input_grid, &
254  seaice_fract_input_grid, &
255  seaice_skin_temp_input_grid, &
256  skin_temp_input_grid, &
257  snow_depth_input_grid, &
258  snow_liq_equiv_input_grid, &
259  soil_temp_input_grid, &
260  soil_type_input_grid, &
261  soilm_tot_input_grid, &
262  srflag_input_grid, &
263  t2m_input_grid, &
264  tprcp_input_grid, &
265  ustar_input_grid, &
266  veg_type_input_grid, &
267  z0_input_grid, &
268  c_d_input_grid, &
269  c_0_input_grid, &
270  d_conv_input_grid, &
271  dt_cool_input_grid, &
272  ifd_input_grid, &
273  qrain_input_grid, &
274  tref_input_grid, &
275  w_d_input_grid, &
276  w_0_input_grid, &
277  xs_input_grid, &
278  xt_input_grid, &
279  xu_input_grid, &
280  xv_input_grid, &
281  xz_input_grid, &
282  xtts_input_grid, &
283  xzts_input_grid, &
284  z_c_input_grid, &
285  zm_input_grid, terrain_input_grid, &
286  veg_type_landice_input, &
287  veg_greenness_input_grid, &
288  max_veg_greenness_input_grid, &
289  min_veg_greenness_input_grid, &
290  lai_input_grid
291 
292  use model_grid, only : input_grid, target_grid, &
293  i_target, j_target, &
294  lsoil_target, &
295  num_tiles_target_grid, &
296  landmask_target_grid, &
297  seamask_target_grid, &
298  latitude_target_grid
299 
300  use program_setup, only : convert_nst, &
301  vgtyp_from_climo, &
302  sotyp_from_climo, &
303  vgfrc_from_climo, &
304  minmax_vgfrc_from_climo, &
305  lai_from_climo, &
306  tg3_from_soil
307 
308  use static_data, only : veg_type_target_grid, &
309  soil_type_target_grid, &
310  veg_greenness_target_grid, &
311  substrate_temp_target_grid,&
312  min_veg_greenness_target_grid,&
313  max_veg_greenness_target_grid
314 
315  use search_util
316 
317  implicit none
318 
319  integer, intent(in) :: localpet
320 
321  integer :: l(1), u(1)
322  integer :: i, j, ij, rc, tile
323  integer :: clb_target(2), cub_target(2)
324  integer :: isrctermprocessing
325  integer :: num_fields
326  integer :: vgfrc_ind, mmvg_ind, lai_ind
327  integer, allocatable :: search_nums(:)
328  integer(esmf_kind_i4), pointer :: unmapped_ptr(:)
329  integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:)
330  integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:)
331  integer(esmf_kind_i8), pointer :: landmask_target_ptr(:,:)
332  integer(esmf_kind_i8), allocatable :: mask_target_one_tile(:,:)
333  integer(esmf_kind_i8), allocatable :: water_target_one_tile(:,:)
334  integer(esmf_kind_i8), allocatable :: land_target_one_tile(:,:)
335  integer(esmf_kind_i8), pointer :: seamask_target_ptr(:,:)
336 
337  real(esmf_kind_r8), allocatable :: data_one_tile(:,:)
338  real(esmf_kind_r8), allocatable :: data_one_tile2(:,:)
339  real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:)
340  real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:)
341  real(esmf_kind_r8), pointer :: seaice_fract_target_ptr(:,:)
342  real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:)
343  real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:)
344  real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:)
345  real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:)
346  real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:)
347  real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:)
348  real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:)
349 
350  type(esmf_regridmethod_flag) :: method
351  type(esmf_routehandle) :: regrid_bl_no_mask
352  type(esmf_routehandle) :: regrid_all_land
353  type(esmf_routehandle) :: regrid_land
354  type(esmf_routehandle) :: regrid_landice
355  type(esmf_routehandle) :: regrid_nonland
356  type(esmf_routehandle) :: regrid_seaice
357  type(esmf_routehandle) :: regrid_water
358 
359  type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input
360  type(esmf_fieldbundle) :: bundle_seaice_target, bundle_seaice_input
361  type(esmf_fieldbundle) :: bundle_water_target, bundle_water_input
362  type(esmf_fieldbundle) :: bundle_allland_target, bundle_allland_input
363  type(esmf_fieldbundle) :: bundle_landice_target, bundle_landice_input
364  type(esmf_fieldbundle) :: bundle_nolandice_target, bundle_nolandice_input
365 
366  logical, allocatable :: dozero(:)
367 
368 !-----------------------------------------------------------------------
369 ! Interpolate fieids that do not require 'masked' interpolation.
370 !-----------------------------------------------------------------------
371 
372  method=esmf_regridmethod_bilinear
373 
374  isrctermprocessing = 1
375 
376  print*,"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION."
377  call esmf_fieldregridstore(t2m_input_grid, &
378  t2m_target_grid, &
379  polemethod=esmf_polemethod_allavg, &
380  srctermprocessing=isrctermprocessing, &
381  routehandle=regrid_bl_no_mask, &
382  regridmethod=method, rc=rc)
383  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
384  call error_handler("IN FieldRegridStore", rc)
385 
386  bundle_all_target = esmf_fieldbundlecreate(name="all points target", rc=rc)
387  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
388  call error_handler("IN FieldBundleCreate", rc)
389  bundle_all_input = esmf_fieldbundlecreate(name="all points input", rc=rc)
390  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
391  call error_handler("IN FieldBundleCreate", rc)
392 
393  call esmf_fieldbundleadd(bundle_all_target, (/t2m_target_grid,q2m_target_grid,tprcp_target_grid, &
394  f10m_target_grid,ffmm_target_grid,ustar_target_grid,srflag_target_grid/), &
395  rc=rc)
396  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
397  call error_handler("IN FieldBundleAdd", rc)
398  call esmf_fieldbundleadd(bundle_all_input, (/t2m_input_grid,q2m_input_grid,tprcp_input_grid, &
399  f10m_input_grid,ffmm_input_grid,ustar_input_grid,srflag_input_grid/), &
400  rc=rc)
401  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
402  call error_handler("IN FieldBundleAdd", rc)
403 
404  call esmf_fieldbundleget(bundle_all_target,fieldcount=num_fields,rc=rc)
405  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
406  call error_handler("IN FieldBundleGet", rc)
407 
408  allocate(dozero(num_fields))
409  dozero(:) = .true.
410 
411  call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero)
412  deallocate(dozero)
413 
414  call esmf_fieldbundledestroy(bundle_all_target,rc=rc)
415  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
416  call error_handler("IN FieldBundleDestroy", rc)
417  call esmf_fieldbundledestroy(bundle_all_input,rc=rc)
418  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
419  call error_handler("IN FieldBundleDestroy", rc)
420 
421  print*,"- CALL FieldGet FOR SRFLAG."
422  call esmf_fieldget(srflag_target_grid, &
423  farrayptr=srflag_target_ptr, rc=rc)
424  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
425  call error_handler("IN FieldGet", rc)
426 
427 !-----------------------------------------------------------------------
428 ! This is a flag field. Using neighbor was expensive. So use
429 ! bilinear and 'nint'.
430 !-----------------------------------------------------------------------
431 
432  srflag_target_ptr = nint(srflag_target_ptr)
433 
434  print*,"- CALL FieldRegridRelease."
435  call esmf_fieldregridrelease(routehandle=regrid_bl_no_mask, rc=rc)
436  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
437  call error_handler("IN FieldRegridRelease", rc)
438 
439 !-----------------------------------------------------------------------
440 ! First, set the mask on the target and input grids.
441 !-----------------------------------------------------------------------
442 
443  print*,"- CALL GridAddItem FOR TARGET GRID."
444  call esmf_gridadditem(target_grid, &
445  itemflag=esmf_griditem_mask, &
446  staggerloc=esmf_staggerloc_center, rc=rc)
447  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
448  call error_handler("IN GridAddItem", rc)
449 
450  print*,"- CALL GridGetItem FOR TARGET GRID."
451  call esmf_gridgetitem(target_grid, &
452  itemflag=esmf_griditem_mask, &
453  farrayptr=mask_target_ptr, rc=rc)
454  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
455  call error_handler("IN GridGetItem", rc)
456 
457  print*,"- CALL FieldGet FOR TARGET GRID SEAMASK."
458  call esmf_fieldget(seamask_target_grid, &
459  computationallbound=clb_target, &
460  computationalubound=cub_target, &
461  farrayptr=seamask_target_ptr, rc=rc)
462  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
463  call error_handler("IN FieldGet", rc)
464 
465  print*,"- CALL FieldGet FOR TARGET GRID LANDMASK."
466  call esmf_fieldget(landmask_target_grid, &
467  farrayptr=landmask_target_ptr, rc=rc)
468  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
469  call error_handler("IN FieldGet", rc)
470 
471  print*,"- CALL GridAddItem FOR INPUT GRID SEAMASK."
472  call esmf_gridadditem(input_grid, &
473  itemflag=esmf_griditem_mask, &
474  staggerloc=esmf_staggerloc_center, rc=rc)
475  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
476  call error_handler("IN GridAddItem", rc)
477 
478  print*,"- CALL FieldGet FOR INPUT GRID LANDMASK."
479  call esmf_fieldget(landsea_mask_input_grid, &
480  farrayptr=landmask_input_ptr, rc=rc)
481  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
482  call error_handler("IN FieldGet", rc)
483 
484  print*,"- CALL GridGetItem FOR INPUT GRID LANDMASK."
485  call esmf_gridgetitem(input_grid, &
486  itemflag=esmf_griditem_mask, &
487  farrayptr=mask_input_ptr, rc=rc)
488  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
489  call error_handler("IN GridGetItem", rc)
490 
491  if (localpet == 0) then
492  allocate(data_one_tile(i_target,j_target))
493  allocate(data_one_tile_3d(i_target,j_target,lsoil_target))
494  allocate(mask_target_one_tile(i_target,j_target))
495  else
496  allocate(data_one_tile(0,0))
497  allocate(data_one_tile_3d(0,0,0))
498  allocate(mask_target_one_tile(0,0))
499  endif
500 
501  !-----------------------------------------------------------------------
502  ! Interpolate vegetation type to target grid if chosen in namelist and terrain
503  ! for use in replacing isolated bad terrain values
504  !-----------------------------------------------------------------------
505 
506  method=esmf_regridmethod_nearest_stod
507 
508  isrctermprocessing = 1
509 
510  mask_input_ptr = 0
511  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
512 
513  mask_target_ptr = 0
514  where (landmask_target_ptr == 1) mask_target_ptr = 1
515 
516  print*,"- CALL FieldCreate FOR TERRAIN FROM INPUT GRID LAND."
517  terrain_from_input_grid_land = esmf_fieldcreate(target_grid, &
518  typekind=esmf_typekind_r8, &
519  staggerloc=esmf_staggerloc_center, rc=rc)
520  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
521  call error_handler("IN FieldCreate", rc)
522 
523  print*,"- CALL FieldRegridStore for land fields."
524  call esmf_fieldregridstore(terrain_input_grid, &
525  terrain_from_input_grid_land, &
526  srcmaskvalues=(/0/), &
527  dstmaskvalues=(/0/), &
528  polemethod=esmf_polemethod_none, &
529  srctermprocessing=isrctermprocessing, &
530  unmappedaction=esmf_unmappedaction_ignore, &
531  normtype=esmf_normtype_fracarea, &
532  routehandle=regrid_all_land, &
533  regridmethod=method, &
534  unmappeddstlist=unmapped_ptr, rc=rc)
535  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
536  call error_handler("IN FieldRegridStore", rc)
537 
538  print*,"- CALL Field_Regrid TERRAIN."
539  call esmf_fieldregrid(terrain_input_grid, &
540  terrain_from_input_grid_land, &
541  routehandle=regrid_all_land, &
542  termorderflag=esmf_termorder_srcseq, rc=rc)
543  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
544  call error_handler("IN FieldRegrid", rc)
545 
546  print*,"- CALL FieldGet FOR terrain from input grid at land."
547  call esmf_fieldget(terrain_from_input_grid_land, &
548  farrayptr=terrain_from_input_ptr, rc=rc)
549  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
550  call error_handler("IN FieldGet", rc)
551 
552  l = lbound(unmapped_ptr)
553  u = ubound(unmapped_ptr)
554 
555  do ij = l(1), u(1)
556  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
557  terrain_from_input_ptr(i,j) = -9999.9
558  enddo
559  nullify(terrain_from_input_ptr)
560 
561  do tile = 1, num_tiles_target_grid
562 
563  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
564  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
565  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
566  call error_handler("IN FieldGather", rc)
567 
568  print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID: ", tile
569  call esmf_fieldgather(terrain_from_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
570  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
571  call error_handler("IN FieldGather", rc)
572 
573  if (localpet == 0) then
574  allocate(land_target_one_tile(i_target,j_target))
575  land_target_one_tile = 0
576  where(mask_target_one_tile == 1) land_target_one_tile = 1
577  call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 7)
578  deallocate(land_target_one_tile)
579  endif
580 
581  print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID: ", tile
582  call esmf_fieldscatter(terrain_from_input_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
583  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
584  call error_handler("IN FieldScatter", rc)
585  enddo
586 
587  if(.not. vgtyp_from_climo) then
588 
589  print*,"- CALL FieldRegrid VEG TYPE."
590  call esmf_fieldregrid(veg_type_input_grid, &
591  veg_type_target_grid, &
592  routehandle=regrid_all_land, &
593  termorderflag=esmf_termorder_srcseq, rc=rc)
594  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
595  call error_handler("IN FieldRegrid", rc)
596 
597  print*,"- CALL FieldGet FOR TARGET grid veg type."
598  call esmf_fieldget(veg_type_target_grid, &
599  farrayptr=veg_type_target_ptr, rc=rc)
600  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
601  call error_handler("IN FieldGet", rc)
602 
603  l = lbound(unmapped_ptr)
604  u = ubound(unmapped_ptr)
605 
606  do ij = l(1), u(1)
607  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
608  veg_type_target_ptr(i,j) = -9999.9
609  enddo
610 
611  do tile = 1, num_tiles_target_grid
612  print*,"- CALL FieldGather FOR TARGET GRID VEG TYPE TILE: ", tile
613  call esmf_fieldgather(veg_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
614  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
615  call error_handler("IN FieldGather", rc)
616 
617  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
618  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
619  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
620  call error_handler("IN FieldGather", rc)
621 
622  if (localpet == 0) then
623  allocate(land_target_one_tile(i_target,j_target))
624  land_target_one_tile = 0
625  where(mask_target_one_tile == 1) land_target_one_tile = 1
626  call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 225)
627  deallocate(land_target_one_tile)
628  endif
629 
630  print*,"- CALL FieldScatter FOR TARGET GRID VEG TYPE: ", tile
631  call esmf_fieldscatter(veg_type_target_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
632  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
633  call error_handler("IN FieldScatter", rc)
634  enddo
635  nullify(veg_type_target_ptr)
636  endif
637  print*,"- CALL FieldRegridRelease."
638  call esmf_fieldregridrelease(routehandle=regrid_all_land, rc=rc)
639  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
640  call error_handler("IN FieldRegridRelease", rc)
641 
642 !-----------------------------------------------------------------------
643 ! Next, determine the sea ice fraction on target grid.
644 ! Interpolate.
645 !-----------------------------------------------------------------------
646 
647  mask_input_ptr = 1
648  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 0
649 
650  mask_target_ptr = seamask_target_ptr
651 
652  method=esmf_regridmethod_conserve
653 
654  isrctermprocessing = 1
655 
656  print*,"- CALL FieldRegridStore for sea ice fraction."
657  call esmf_fieldregridstore(seaice_fract_input_grid, &
658  seaice_fract_target_grid, &
659  srcmaskvalues=(/0/), &
660  dstmaskvalues=(/0/), &
661  polemethod=esmf_polemethod_none, &
662  srctermprocessing=isrctermprocessing, &
663  unmappedaction=esmf_unmappedaction_ignore, &
664  normtype=esmf_normtype_fracarea, &
665  routehandle=regrid_nonland, &
666  regridmethod=method, &
667  unmappeddstlist=unmapped_ptr, rc=rc)
668  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
669  call error_handler("IN FieldRegridStore", rc)
670 
671  print*,"- CALL Field_Regrid for sea ice fraction."
672  call esmf_fieldregrid(seaice_fract_input_grid, &
673  seaice_fract_target_grid, &
674  routehandle=regrid_nonland, &
675  termorderflag=esmf_termorder_srcseq, rc=rc)
676  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
677  call error_handler("IN FieldRegrid", rc)
678 
679  print*,"- CALL FieldGet FOR TARGET grid sea ice fraction."
680  call esmf_fieldget(seaice_fract_target_grid, &
681  farrayptr=seaice_fract_target_ptr, rc=rc)
682  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
683  call error_handler("IN FieldGet", rc)
684 
685  l = lbound(unmapped_ptr)
686  u = ubound(unmapped_ptr)
687 
688  do ij = l(1), u(1)
689  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
690  seaice_fract_target_ptr(i,j) = -9999.9 ! flag value for missing point
691  ! which will be replaced in routine
692  ! "search".
693  enddo
694 
695  if (localpet == 0) then
696  allocate(latitude_one_tile(i_target,j_target))
697  else
698  allocate(latitude_one_tile(0,0))
699  endif
700 
701  do tile = 1, num_tiles_target_grid
702 
703  print*,"- CALL FieldGather FOR TARGET GRID SEAICE FRACTION TILE: ", tile
704  call esmf_fieldgather(seaice_fract_target_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
705  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
706  call error_handler("IN FieldGather", rc)
707 
708  print*,"- CALL FieldGather FOR TARGET GRID MASK TILE: ", tile
709  call esmf_fieldgather(seamask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
710  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
711  call error_handler("IN FieldGather", rc)
712 
713  print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile
714  call esmf_fieldgather(latitude_target_grid, latitude_one_tile, rootpet=0, tile=tile, rc=rc)
715  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
716  call error_handler("IN FieldGather", rc)
717 
718  if (localpet == 0) then
719  call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 91, &
720  latitude=latitude_one_tile)
721  endif
722 
723  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
724  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
725  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
726  call error_handler("IN FieldGather", rc)
727 
728 
729  if (localpet == 0) then
730  do j = 1, j_target
731  do i = 1, i_target
732  if (data_one_tile(i,j) > 1.0_esmf_kind_r8) then
733  data_one_tile(i,j) = 1.0_esmf_kind_r8
734  endif
735  if (data_one_tile(i,j) < 0.15_esmf_kind_r8) data_one_tile(i,j) = 0.0_esmf_kind_r8
736  if (data_one_tile(i,j) >= 0.15_esmf_kind_r8) mask_target_one_tile(i,j) = 2
737  enddo
738  enddo
739  endif
740 
741  print*,"- CALL FieldScatter FOR TARGET GRID SEAICE FRACTION TILE: ", tile
742  call esmf_fieldscatter(seaice_fract_target_grid, data_one_tile, rootpet=0, tile=tile, rc=rc)
743  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
744  call error_handler("IN FieldScatter", rc)
745 
746  print*,"- CALL FieldScatter FOR TARGET LANDMASK TILE: ", tile
747  call esmf_fieldscatter(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
748  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
749  call error_handler("IN FieldScatter", rc)
750 
751  enddo
752 
753  deallocate(latitude_one_tile)
754 
755  print*,"- CALL FieldRegridRelease."
756  call esmf_fieldregridrelease(routehandle=regrid_nonland, rc=rc)
757  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
758  call error_handler("IN FieldRegridRelease", rc)
759 
760 !---------------------------------------------------------------------------------------------
761 ! Now interpolate other sea ice related fields. Since we know what points are ice on
762 ! the target grid, reset the target grid mask.
763 !---------------------------------------------------------------------------------------------
764 
765  mask_input_ptr = 0
766  where (nint(landmask_input_ptr) == 2) mask_input_ptr = 1
767 
768  print*,"- CALL FieldGet FOR TARGET land sea mask."
769  call esmf_fieldget(landmask_target_grid, &
770  farrayptr=landmask_target_ptr, rc=rc)
771  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
772  call error_handler("IN FieldGet", rc)
773 
774  mask_target_ptr = 0
775  do j = clb_target(2), cub_target(2)
776  do i = clb_target(1), cub_target(1)
777  if (landmask_target_ptr(i,j) == 2) mask_target_ptr(i,j) = 1
778  enddo
779  enddo
780 
781  method=esmf_regridmethod_nearest_stod
782  isrctermprocessing = 1
783 
784  print*,"- CALL FieldRegridStore for 3d seaice fields."
785  call esmf_fieldregridstore(soil_temp_input_grid, &
786  soil_temp_target_grid, &
787  srcmaskvalues=(/0/), &
788  dstmaskvalues=(/0/), &
789  polemethod=esmf_polemethod_none, &
790  srctermprocessing=isrctermprocessing, &
791  unmappedaction=esmf_unmappedaction_ignore, &
792  normtype=esmf_normtype_fracarea, &
793  routehandle=regrid_seaice, &
794  regridmethod=method, &
795  unmappeddstlist=unmapped_ptr, rc=rc)
796  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
797  call error_handler("IN FieldRegridStore", rc)
798 
799  bundle_seaice_target = esmf_fieldbundlecreate(name="sea ice target", rc=rc)
800  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
801  call error_handler("IN FieldBundleCreate", rc)
802  bundle_seaice_input = esmf_fieldbundlecreate(name="sea ice input", rc=rc)
803  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
804  call error_handler("IN FieldBundleCreate", rc)
805  call esmf_fieldbundleadd(bundle_seaice_target, (/seaice_depth_target_grid, snow_depth_target_grid, &
806  snow_liq_equiv_target_grid, seaice_skin_temp_target_grid, &
807  soil_temp_target_grid/), rc=rc)
808  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
809  call error_handler("IN FieldBundleAdd", rc)
810  call esmf_fieldbundleadd(bundle_seaice_input, (/seaice_depth_input_grid, snow_depth_input_grid, &
811  snow_liq_equiv_input_grid, seaice_skin_temp_input_grid, &
812  soil_temp_input_grid/), rc=rc)
813  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
814  call error_handler("IN FieldBundleAdd", rc)
815  call esmf_fieldbundleget(bundle_seaice_target,fieldcount=num_fields,rc=rc)
816  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
817  call error_handler("IN FieldBundleGet", rc)
818 
819 
820  allocate(search_nums(num_fields))
821  allocate(dozero(num_fields))
822 
823  search_nums = (/92,66,65,21,21/)
824  dozero(:) = .true.
825 
826  l = lbound(unmapped_ptr)
827  u = ubound(unmapped_ptr)
828 
829  call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, &
830  unmapped_ptr=unmapped_ptr )
831  deallocate(dozero)
832  call esmf_fieldbundledestroy(bundle_seaice_input,rc=rc)
833  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
834  call error_handler("IN FieldBundleDestroy", rc)
835 
836  do tile = 1, num_tiles_target_grid
837 
838  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
839  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
840  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
841  call error_handler("IN FieldGather", rc)
842 
843  if (localpet == 0) then
844  where(mask_target_one_tile == 1) mask_target_one_tile = 0
845  where(mask_target_one_tile == 2) mask_target_one_tile = 1
846  endif
847 
848 
849  call search_many(num_fields,bundle_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, &
850  field_data_3d=data_one_tile_3d)
851  enddo
852 
853  deallocate(search_nums)
854  call esmf_fieldbundledestroy(bundle_seaice_target,rc=rc)
855  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
856  call error_handler("IN FieldBundleDestroy", rc)
857 
858  print*,"- CALL FieldRegridRelease."
859  call esmf_fieldregridrelease(routehandle=regrid_seaice, rc=rc)
860  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
861  call error_handler("IN FieldRegridRelease", rc)
862 
863 !---------------------------------------------------------------------------------------------
864 ! Now interpolate water fields.
865 !---------------------------------------------------------------------------------------------
866 
867  mask_input_ptr = 0
868  where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1
869 
870  mask_target_ptr = 0
871  where (landmask_target_ptr == 0) mask_target_ptr = 1
872 
873  method=esmf_regridmethod_conserve
874  isrctermprocessing = 1
875 
876  print*,"- CALL FieldRegridStore for water fields."
877  call esmf_fieldregridstore(skin_temp_input_grid, &
878  skin_temp_target_grid, &
879  srcmaskvalues=(/0/), &
880  dstmaskvalues=(/0/), &
881  polemethod=esmf_polemethod_none, &
882  srctermprocessing=isrctermprocessing, &
883  unmappedaction=esmf_unmappedaction_ignore, &
884  normtype=esmf_normtype_fracarea, &
885  routehandle=regrid_water, &
886  regridmethod=method, &
887  unmappeddstlist=unmapped_ptr, rc=rc)
888  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
889  call error_handler("IN FieldRegridStore", rc)
890 
891  bundle_water_target = esmf_fieldbundlecreate(name="water target", rc=rc)
892  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
893  call error_handler("IN FieldBundleCreate", rc)
894  bundle_water_input = esmf_fieldbundlecreate(name="water input", rc=rc)
895  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
896  call error_handler("IN FieldBundleCreate", rc)
897  call esmf_fieldbundleadd(bundle_water_target, (/skin_temp_target_grid, z0_target_grid/), rc=rc)
898  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
899  call error_handler("IN FieldBundleAdd", rc)
900  call esmf_fieldbundleadd(bundle_water_input, (/skin_temp_input_grid, z0_input_grid/), rc=rc)
901  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
902  call error_handler("IN FieldBundleAdd", rc)
903 
904  if (convert_nst) then
905 
906  call esmf_fieldbundleadd(bundle_water_target, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, &
907  dt_cool_target_grid,ifd_target_grid,qrain_target_grid,tref_target_grid, &
908  w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,xu_target_grid, &
909  xv_target_grid,xz_target_grid,xtts_target_grid,xzts_target_grid, &
910  z_c_target_grid,zm_target_grid/), rc=rc)
911  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
912  call error_handler("IN FieldBundleAdd", rc)
913 
914  call esmf_fieldbundleadd(bundle_water_input, (/c_d_input_grid,c_0_input_grid,d_conv_input_grid, &
915  dt_cool_input_grid,ifd_input_grid,qrain_input_grid,tref_input_grid, &
916  w_d_input_grid,w_0_input_grid,xs_input_grid,xt_input_grid,xu_input_grid, &
917  xv_input_grid,xz_input_grid,xtts_input_grid,xzts_input_grid, &
918  z_c_input_grid,zm_input_grid/), rc=rc)
919  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
920  call error_handler("IN FieldBundleAdd", rc)
921  call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
922  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
923  call error_handler("IN FieldBundleGet", rc)
924 
925  allocate(search_nums(num_fields))
926  allocate(dozero(num_fields))
927 
928  search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/)
929  dozero(:) = .true.
930 
931  else
932  call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
933  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
934  call error_handler("IN FieldBundleGet", rc)
935 
936  allocate(search_nums(num_fields))
937  allocate(dozero(num_fields))
938  search_nums(:)=(/11,83/)
939  dozero(:) = .true.
940  endif
941 
942  call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, &
943  unmapped_ptr=unmapped_ptr, resetifd=.true.)
944  deallocate(dozero)
945  call esmf_fieldbundledestroy(bundle_water_input,rc=rc)
946  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
947  call error_handler("IN FieldBundleDestroy", rc)
948 
949 
950  if (localpet == 0) then
951  allocate(latitude_one_tile(i_target,j_target))
952  else
953  allocate(latitude_one_tile(0,0))
954  endif
955 
956  do tile = 1, num_tiles_target_grid
957 
958  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
959  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
960  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
961  call error_handler("IN FieldGather", rc)
962 
963  print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile
964  call esmf_fieldgather(latitude_target_grid, latitude_one_tile, rootpet=0, tile=tile, rc=rc)
965  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
966  call error_handler("IN FieldGather", rc)
967 
968  if (localpet == 0) then
969  allocate(water_target_one_tile(i_target,j_target))
970  water_target_one_tile = 0
971  where(mask_target_one_tile == 0) water_target_one_tile = 1
972  endif
973 
974  call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,&
975  tile,search_nums,localpet,latitude=latitude_one_tile)
976 
977  if (localpet == 0) deallocate(water_target_one_tile)
978 
979  enddo
980 
981  deallocate(latitude_one_tile,search_nums)
982 
983  call esmf_fieldbundledestroy(bundle_water_target,rc=rc)
984  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
985  call error_handler("IN FieldBundleDestroy", rc)
986 
987  print*,"- CALL FieldRegridRelease."
988  call esmf_fieldregridrelease(routehandle=regrid_water, rc=rc)
989  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
990  call error_handler("IN FieldRegridRelease", rc)
991 
992 !---------------------------------------------------------------------------------------------
993 ! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice.
994 !---------------------------------------------------------------------------------------------
995 
996  mask_input_ptr = 0
997  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
998 
999  mask_target_ptr = 0
1000  where (landmask_target_ptr == 1) mask_target_ptr = 1
1001 
1002  method=esmf_regridmethod_conserve
1003  isrctermprocessing = 1
1004 
1005  print*,"- CALL FieldRegridStore for land fields."
1006  call esmf_fieldregridstore(snow_depth_input_grid, &
1007  snow_depth_target_grid, &
1008  srcmaskvalues=(/0/), &
1009  dstmaskvalues=(/0/), &
1010  polemethod=esmf_polemethod_none, &
1011  srctermprocessing=isrctermprocessing, &
1012  unmappedaction=esmf_unmappedaction_ignore, &
1013  normtype=esmf_normtype_fracarea, &
1014  routehandle=regrid_all_land, &
1015  regridmethod=method, &
1016  unmappeddstlist=unmapped_ptr, rc=rc)
1017  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1018  call error_handler("IN FieldRegridStore", rc)
1019 
1020  bundle_allland_target = esmf_fieldbundlecreate(name="all land target", rc=rc)
1021  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1022  call error_handler("IN FieldBundleCreate", rc)
1023  bundle_allland_input = esmf_fieldbundlecreate(name="all land input", rc=rc)
1024  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1025  call error_handler("IN FieldBundleCreate", rc)
1026  call esmf_fieldbundleadd(bundle_allland_target, (/canopy_mc_target_grid, snow_depth_target_grid, &
1027  snow_liq_equiv_target_grid/), rc=rc)
1028  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1029  call error_handler("IN FieldBundleAdd", rc)
1030  call esmf_fieldbundleadd(bundle_allland_input, (/canopy_mc_input_grid, snow_depth_input_grid, &
1031  snow_liq_equiv_input_grid/), rc=rc)
1032  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1033  call error_handler("IN FieldBundleAdd", rc)
1034  call esmf_fieldbundleget(bundle_allland_target,fieldcount=num_fields,rc=rc)
1035  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1036  call error_handler("IN FieldBundleGet", rc)
1037 
1038  allocate(search_nums(num_fields))
1039  allocate(dozero(num_fields))
1040 
1041  search_nums = (/223,66,65/)
1042  dozero=(/.true.,.false.,.false./)
1043 
1044  call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, &
1045  unmapped_ptr=unmapped_ptr)
1046  deallocate(dozero)
1047  call esmf_fieldbundledestroy(bundle_allland_input,rc=rc)
1048  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1049  call error_handler("IN FieldBundleDestroy", rc)
1050 
1051 
1052  do tile = 1, num_tiles_target_grid
1053 
1054  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1055  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
1056  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1057  call error_handler("IN FieldGather", rc)
1058 
1059  if (localpet == 0) then
1060  allocate(land_target_one_tile(i_target,j_target))
1061  land_target_one_tile = 0
1062  where(mask_target_one_tile == 1) land_target_one_tile = 1
1063  endif
1064 
1065  call search_many(num_fields,bundle_allland_target,data_one_tile, land_target_one_tile,&
1066  tile,search_nums,localpet)
1067 
1068  if (localpet == 0) deallocate(land_target_one_tile)
1069  enddo
1070 
1071  deallocate(search_nums)
1072  call esmf_fieldbundledestroy(bundle_allland_target,rc=rc)
1073  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1074  call error_handler("IN FieldBundleDestroy", rc)
1075 
1076  print*,"- CALL FieldRegridRelease."
1077  call esmf_fieldregridrelease(routehandle=regrid_all_land, rc=rc)
1078  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1079  call error_handler("IN FieldRegridRelease", rc)
1080 
1081 !---------------------------------------------------------------------------------------------
1082 ! Now interpolate landice points to landice points.
1083 !---------------------------------------------------------------------------------------------
1084 
1085  print*,"- CALL FieldGet FOR INPUT GRID VEG TYPE."
1086  call esmf_fieldget(veg_type_input_grid, &
1087  farrayptr=veg_type_input_ptr, rc=rc)
1088  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1089  call error_handler("IN FieldGet", rc)
1090 
1091  print*,'land ice check ',veg_type_landice_input
1092 
1093  mask_input_ptr = 0
1094  where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 1
1095 
1096  print*,"- CALL FieldGet FOR TARGET GRID VEG TYPE."
1097  call esmf_fieldget(veg_type_target_grid, &
1098  farrayptr=veg_type_target_ptr, rc=rc)
1099  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1100  call error_handler("IN FieldGet", rc)
1101 
1102  mask_target_ptr = 0
1103  where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 1
1104 
1105  method=esmf_regridmethod_nearest_stod
1106  isrctermprocessing = 1
1107 
1108  print*,"- CALL FieldRegridStore for landice fields."
1109  call esmf_fieldregridstore(soil_temp_input_grid, &
1110  soil_temp_target_grid, &
1111  srcmaskvalues=(/0/), &
1112  dstmaskvalues=(/0/), &
1113  polemethod=esmf_polemethod_none, &
1114  srctermprocessing=isrctermprocessing, &
1115  unmappedaction=esmf_unmappedaction_ignore, &
1116  normtype=esmf_normtype_fracarea, &
1117  routehandle=regrid_landice, &
1118  regridmethod=method, &
1119  unmappeddstlist=unmapped_ptr, rc=rc)
1120  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1121  call error_handler("IN FieldRegridStore", rc)
1122 
1123  bundle_landice_target = esmf_fieldbundlecreate(name="landice target", rc=rc)
1124  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1125  call error_handler("IN FieldBundleCreate", rc)
1126  bundle_landice_input = esmf_fieldbundlecreate(name="landice input", rc=rc)
1127  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1128  call error_handler("IN FieldBundleCreate", rc)
1129  call esmf_fieldbundleadd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid,&
1130  soil_temp_target_grid/), rc=rc)
1131  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1132  call error_handler("IN FieldBundleAdd", rc)
1133  call esmf_fieldbundleadd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid,&
1134  soil_temp_input_grid/), rc=rc)
1135  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1136  call error_handler("IN FieldBundleAdd", rc)
1137 
1138  if (.not. sotyp_from_climo) then
1139  call esmf_fieldbundleadd(bundle_landice_input, (/soil_type_input_grid/),rc=rc)
1140  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1141  call error_handler("IN FieldBundleAdd", rc)
1142  call esmf_fieldbundleadd(bundle_landice_target,(/soil_type_target_grid/),rc=rc)
1143  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1144  call error_handler("IN FieldBundleAdd", rc)
1145  endif
1146 
1147  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1148  call error_handler("IN FieldBundleAdd", rc)
1149  call esmf_fieldbundleget(bundle_landice_target,fieldcount=num_fields,rc=rc)
1150  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1151  call error_handler("IN FieldBundleGet", rc)
1152 
1153  allocate(search_nums(num_fields))
1154  allocate(dozero(num_fields))
1155 
1156  if (sotyp_from_climo) then
1157  search_nums = (/21,7,21/)
1158  dozero(:)=.false.
1159  else
1160  search_nums = (/21,7,21,231/)
1161  dozero(:)=(/.false.,.false.,.false.,.true./)
1162  endif
1163 
1164  call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, &
1165  unmapped_ptr=unmapped_ptr )
1166  deallocate(dozero)
1167  call esmf_fieldbundledestroy(bundle_landice_input,rc=rc)
1168  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1169  call error_handler("IN FieldBundleDestroy", rc)
1170 
1171  if (localpet == 0) then
1172  allocate (veg_type_target_one_tile(i_target,j_target))
1173  allocate (land_target_one_tile(i_target,j_target))
1174  allocate (data_one_tile2(i_target,j_target))
1175  else
1176  allocate (veg_type_target_one_tile(0,0))
1177  allocate (land_target_one_tile(0,0))
1178  allocate (data_one_tile2(0,0))
1179  endif
1180 
1181  do tile = 1, num_tiles_target_grid
1182  print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1183  call esmf_fieldgather(veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1184  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1185  call error_handler("IN FieldGather", rc)
1186 
1187  if (localpet == 0) then
1188  land_target_one_tile = 0
1189  where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1
1190  endif
1191 
1192  print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile
1193  call esmf_fieldgather(terrain_from_input_grid_land, data_one_tile2, rootpet=0, tile=tile, rc=rc)
1194  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1195  call error_handler("IN FieldGather", rc)
1196 
1197  call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,&
1198  tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d)
1199  enddo
1200 
1201  deallocate (veg_type_target_one_tile)
1202  deallocate (land_target_one_tile)
1203  deallocate(search_nums)
1204 
1205  call esmf_fieldbundledestroy(bundle_landice_target,rc=rc)
1206  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1207  call error_handler("IN FieldBundleDestroy", rc)
1208 
1209  print*,"- CALL FieldRegridRelease."
1210  call esmf_fieldregridrelease(routehandle=regrid_landice, rc=rc)
1211  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1212  call error_handler("IN FieldRegridRelease", rc)
1213 
1214 !---------------------------------------------------------------------------------------------
1215 ! Now interpolate land (not including landice pts) to land (not including landice).
1216 !---------------------------------------------------------------------------------------------
1217 
1218  mask_input_ptr = 0
1219  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
1220  where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0
1221 
1222  mask_target_ptr = 0
1223  where (landmask_target_ptr == 1) mask_target_ptr = 1
1224  where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0
1225 
1226  method=esmf_regridmethod_nearest_stod
1227  isrctermprocessing = 1
1228 
1229  print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields."
1230  call esmf_fieldregridstore(soilm_tot_input_grid, &
1231  soilm_tot_target_grid, &
1232  srcmaskvalues=(/0/), &
1233  dstmaskvalues=(/0/), &
1234  polemethod=esmf_polemethod_none, &
1235  srctermprocessing=isrctermprocessing, &
1236  unmappedaction=esmf_unmappedaction_ignore, &
1237  normtype=esmf_normtype_fracarea, &
1238  routehandle=regrid_land, &
1239  regridmethod=method, &
1240  unmappeddstlist=unmapped_ptr, rc=rc)
1241  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1242  call error_handler("IN FieldRegridStore", rc)
1243 
1244  bundle_nolandice_target = esmf_fieldbundlecreate(name="land no landice target", rc=rc)
1245  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1246  call error_handler("IN FieldBundleCreate", rc)
1247 
1248  bundle_nolandice_input = esmf_fieldbundlecreate(name="land no landice input", rc=rc)
1249  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1250  call error_handler("IN FieldBundleCreate", rc)
1251 
1252  call esmf_fieldbundleadd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid,&
1253  soil_type_from_input_grid,soilm_tot_target_grid,soil_temp_target_grid/), rc=rc)
1254  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1255  call error_handler("IN FieldBundleAdd", rc)
1256 
1257  call esmf_fieldbundleadd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid,&
1258  soil_type_input_grid,soilm_tot_input_grid,soil_temp_input_grid/), rc=rc)
1259  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1260  call error_handler("IN FieldBundleAdd", rc)
1261 
1262 
1263  if (.not. sotyp_from_climo) then
1264 ! call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc)
1265 ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) &
1266 ! call error_handler("IN FieldBundleAdd", rc)
1267 ! call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_input_grid/), rc=rc)
1268 ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) &
1269 ! call error_handler("IN FieldBundleAdd", rc)
1270  print*,"- CALL Field_Regrid ."
1271  call esmf_fieldregrid(soil_type_input_grid, &
1272  soil_type_target_grid, &
1273  routehandle=regrid_land, &
1274  zeroregion=esmf_region_select, &
1275  termorderflag=esmf_termorder_srcseq, rc=rc)
1276  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1277  call error_handler("IN FieldRegrid", rc)
1278 
1279  call esmf_fieldget(soil_type_target_grid, &
1280  farrayptr=soil_type_target_ptr, rc=rc)
1281  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1282  call error_handler("IN FieldGet", rc)
1283 
1284  l = lbound(unmapped_ptr)
1285  u = ubound(unmapped_ptr)
1286 
1287  do ij = l(1), u(1)
1288  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
1289  soil_type_target_ptr(i,j) = -9999.9
1290  enddo
1291  ! call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc)
1292  ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) &
1293  ! call error_handler("IN FieldBundleGet", rc)
1294  ! sotyp_ind = 3
1295  endif
1296 
1297  if (.not. vgfrc_from_climo) then
1298  call esmf_fieldbundleadd(bundle_nolandice_target, (/veg_greenness_target_grid/), rc=rc)
1299  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1300  call error_handler("IN FieldBundleAdd", rc)
1301  call esmf_fieldbundleadd(bundle_nolandice_input, (/veg_greenness_input_grid/), rc=rc)
1302  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1303  call error_handler("IN FieldBundleAdd", rc)
1304  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1305  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1306  call error_handler("IN FieldBundleGet", rc)
1307  vgfrc_ind = num_fields
1308  endif
1309 
1310  if (.not. lai_from_climo) then
1311  call esmf_fieldbundleadd(bundle_nolandice_target, (/lai_target_grid/), rc=rc)
1312  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1313  call error_handler("IN FieldBundleAdd", rc)
1314  call esmf_fieldbundleadd(bundle_nolandice_input, (/lai_input_grid/), rc=rc)
1315  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1316  call error_handler("IN FieldBundleAdd", rc)
1317  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1318  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1319  call error_handler("IN FieldBundleGet", rc)
1320  lai_ind = num_fields
1321  endif
1322 
1323  if (.not. minmax_vgfrc_from_climo) then
1324  call esmf_fieldbundleadd(bundle_nolandice_target, (/max_veg_greenness_target_grid/), rc=rc)
1325  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1326  call error_handler("IN FieldBundleAdd", rc)
1327  call esmf_fieldbundleadd(bundle_nolandice_input, (/max_veg_greenness_input_grid/), rc=rc)
1328  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1329  call error_handler("IN FieldBundleAdd", rc)
1330 
1331  call esmf_fieldbundleadd(bundle_nolandice_target, (/min_veg_greenness_target_grid/), rc=rc)
1332  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1333  call error_handler("IN FieldBundleAdd", rc)
1334  call esmf_fieldbundleadd(bundle_nolandice_input, (/min_veg_greenness_input_grid/), rc=rc)
1335  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1336  call error_handler("IN FieldBundleAdd", rc)
1337 
1338  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1339  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1340  call error_handler("IN FieldBundleGet", rc)
1341 
1342  mmvg_ind = num_fields-1
1343  endif
1344 
1345  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1346  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1347  call error_handler("IN FieldBundleGet", rc)
1348 
1349  allocate(search_nums(num_fields))
1350  allocate(dozero(num_fields))
1351 
1352  search_nums(1:5) = (/85,7,224,85,86/)
1353  dozero(1:5) = (/.false.,.false.,.true.,.true.,.false./)
1354 
1355  !if (.not.sotyp_from_climo) then
1356  ! search_nums(sotyp_ind) = 226
1357  ! dozero(sotyp_ind) = .False.
1358  !endif
1359 
1360  if (.not. vgfrc_from_climo) then
1361  search_nums(vgfrc_ind) = 224
1362  dozero(vgfrc_ind) = .true.
1363  endif
1364 
1365  if (.not. lai_from_climo) then
1366  search_nums(lai_ind) = 229
1367  dozero(lai_ind) = .true.
1368  endif
1369 
1370  if (.not. minmax_vgfrc_from_climo) then
1371  search_nums(mmvg_ind) = 227
1372  dozero(mmvg_ind) = .true.
1373 
1374  search_nums(mmvg_ind+1) = 228
1375  dozero(mmvg_ind+1) = .true.
1376  endif
1377 
1378  call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, &
1379  unmapped_ptr=unmapped_ptr)
1380  deallocate(dozero)
1381  call esmf_fieldbundledestroy(bundle_nolandice_input,rc=rc)
1382  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1383  call error_handler("IN FieldBundleDestroy", rc)
1384 
1385  if (localpet == 0) then
1386  allocate (veg_type_target_one_tile(i_target,j_target))
1387  else
1388  allocate (veg_type_target_one_tile(0,0))
1389  endif
1390 
1391  do tile = 1, num_tiles_target_grid
1392 
1393  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1394  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
1395  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1396  call error_handler("IN FieldGather", rc)
1397 
1398  print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1399  call esmf_fieldgather(veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1400  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1401  call error_handler("IN FieldGather", rc)
1402 
1403  if (localpet == 0) then
1404  where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0
1405  endif
1406 
1407  print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile
1408  call esmf_fieldgather(soil_type_target_grid, data_one_tile2, rootpet=0,tile=tile, rc=rc)
1409  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1410  call error_handler("IN FieldGather", rc)
1411 
1412  call search_many(num_fields,bundle_nolandice_target,data_one_tile, mask_target_one_tile,&
1413  tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d)
1414 
1415  print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile
1416  call esmf_fieldgather(soilm_tot_target_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
1417  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1418  call error_handler("IN FieldGather", rc)
1419 
1420  if (localpet == 0) then
1421  do j = 1, lsoil_target
1422  data_one_tile = data_one_tile_3d(:,:,j)
1423  call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 86)
1424  data_one_tile_3d(:,:,j) = data_one_tile
1425  enddo
1426  endif
1427 
1428  print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile
1429  call esmf_fieldgather(soil_temp_target_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
1430  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1431  call error_handler("IN FieldGather", rc)
1432 
1433  if (tg3_from_soil) then
1434  print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE, TILE: ", tile
1435  call esmf_fieldscatter(substrate_temp_target_grid, data_one_tile_3d(:,:,lsoil_target), rootpet=0, tile=tile, rc=rc)
1436  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1437  call error_handler("IN FieldScatter", rc)
1438  endif
1439 
1440  if (.not. sotyp_from_climo) then
1441  print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile
1442  call esmf_fieldgather(soil_type_target_grid, data_one_tile,rootpet=0,tile=tile, rc=rc)
1443  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1444  call error_handler("IN FieldGather", rc)
1445 
1446  if (localpet == 0) then
1447  call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,226)
1448  endif
1449 
1450  print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile
1451  call esmf_fieldscatter(soil_type_target_grid,data_one_tile,rootpet=0,tile=tile,rc=rc)
1452  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1453  call error_handler("IN FieldScatter", rc)
1454  endif
1455 
1456  enddo
1457 
1458  deallocate(search_nums)
1459  call esmf_fieldbundledestroy(bundle_nolandice_target,rc=rc)
1460  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1461  call error_handler("IN FieldBundleDestroy", rc)
1462 
1463  print*,"- CALL FieldRegridRelease."
1464  call esmf_fieldregridrelease(routehandle=regrid_land, rc=rc)
1465  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1466  call error_handler("IN FieldRegridRelease", rc)
1467 
1468  deallocate(veg_type_target_one_tile)
1469 
1470  deallocate(data_one_tile, data_one_tile2)
1471  deallocate(data_one_tile_3d)
1472  deallocate(mask_target_one_tile)
1473 
1474  return
1475 
1476  end subroutine interp
1477 
1481  subroutine calc_liq_soil_moisture
1482 
1483  use esmf
1484 
1485  use model_grid, only : landmask_target_grid
1486 
1487  use program_setup, only : maxsmc_target, &
1488  bb_target, &
1489  satpsi_target
1490 
1491  use static_data, only : soil_type_target_grid, &
1492  veg_type_target_grid
1493 
1494  implicit none
1495 
1496  integer :: clb(3), cub(3), rc
1497  integer :: i, j, n, soil_type
1498 
1499  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1500 
1501  real :: bx, fk
1502  real(esmf_kind_r8), pointer :: soilm_liq_ptr(:,:,:)
1503  real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:)
1504  real(esmf_kind_r8), pointer :: soil_temp_ptr(:,:,:)
1505  real(esmf_kind_r8), pointer :: soil_type_ptr(:,:)
1506  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
1507 
1508  print*,"- COMPUTE LIQUID PORTION OF TOTAL SOIL MOISTURE."
1509 
1510  print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE."
1511  call esmf_fieldget(soilm_tot_target_grid, &
1512  computationallbound=clb, &
1513  computationalubound=cub, &
1514  farrayptr=soilm_tot_ptr, rc=rc)
1515  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1516  call error_handler("IN FieldGet", rc)
1517 
1518  print*,"- CALL FieldGet FOR LIQUID SOIL MOISTURE."
1519  call esmf_fieldget(soilm_liq_target_grid, &
1520  farrayptr=soilm_liq_ptr, rc=rc)
1521  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1522  call error_handler("IN FieldGet", rc)
1523 
1524  print*,"- CALL FieldGet FOR SOIL TEMPERATURE."
1525  call esmf_fieldget(soil_temp_target_grid, &
1526  farrayptr=soil_temp_ptr, rc=rc)
1527  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1528  call error_handler("IN FieldGet", rc)
1529 
1530  print*,"- CALL FieldGet FOR VEGETATION TYPE."
1531  call esmf_fieldget(veg_type_target_grid, &
1532  farrayptr=veg_type_ptr, rc=rc)
1533  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1534  call error_handler("IN FieldGet", rc)
1535 
1536  print*,"- CALL FieldGet FOR SOIL TYPE."
1537  call esmf_fieldget(soil_type_target_grid, &
1538  farrayptr=soil_type_ptr, rc=rc)
1539  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1540  call error_handler("IN FieldGet", rc)
1541 
1542  print*,"- CALL FieldGet FOR LANDMASK."
1543  call esmf_fieldget(landmask_target_grid, &
1544  farrayptr=landmask_ptr, rc=rc)
1545  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1546  call error_handler("IN FieldGet", rc)
1547 
1548  do j = clb(2), cub(2)
1549  do i = clb(1), cub(1)
1550 
1551 !---------------------------------------------------------------------------------------------
1552 ! Check land points that are not permanent land ice.
1553 !---------------------------------------------------------------------------------------------
1554 
1555  if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then
1556 
1557  soil_type = nint(soil_type_ptr(i,j))
1558 
1559  do n = clb(3), cub(3)
1560 
1561  if (soil_temp_ptr(i,j,n) < (frz_h2o-0.0001)) then
1562 
1563  bx = bb_target(soil_type)
1564 
1565  if (bx .gt. blim) bx = blim
1566 
1567  fk=(((hlice/(grav*(-satpsi_target(soil_type))))* &
1568  ((soil_temp_ptr(i,j,n)-frz_h2o)/soil_temp_ptr(i,j,n)))** &
1569  (-1/bx))*maxsmc_target(soil_type)
1570 
1571  if (fk .lt. 0.02) fk = 0.02
1572 
1573  soilm_liq_ptr(i,j,n) = min( fk, soilm_tot_ptr(i,j,n) )
1574 
1575 !-----------------------------------------------------------------------
1576 ! now use iterative solution for liquid soil water content using
1577 ! FUNCTION FRH2O with the initial guess for SH2O from above explicit
1578 ! first guess.
1579 !-----------------------------------------------------------------------
1580 
1581  soilm_liq_ptr(i,j,n) = frh2o(soil_temp_ptr(i,j,n), &
1582  soilm_tot_ptr(i,j,n), soilm_liq_ptr(i,j,n), &
1583  maxsmc_target(soil_type),bb_target(soil_type), &
1584  satpsi_target(soil_type))
1585 
1586  else ! temp above freezing. all moisture is liquid
1587 
1588  soilm_liq_ptr(i,j,n) = soilm_tot_ptr(i,j,n)
1589 
1590  end if ! is soil layer below freezing?
1591 
1592  enddo ! soil layer
1593 
1594  end if ! is this point land?
1595 
1596  enddo
1597  enddo
1598 
1599  end subroutine calc_liq_soil_moisture
1600 
1625  FUNCTION frh2o (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)
1626 
1627  use esmf
1628 
1629  IMPLICIT NONE
1630 
1631  INTEGER nlog
1632  INTEGER kcount
1633 
1634  REAL bexp
1635  REAL bx
1636  REAL denom
1637  REAL df
1638  REAL dswl
1639  REAL fk
1640  REAL frh2o
1641  REAL psis
1642  REAL(esmf_kind_r8) :: sh2o
1643  REAL(esmf_kind_r8) :: smc
1644  REAL smcmax
1645  REAL swl
1646  REAL swlk
1647  REAL(esmf_kind_r8) :: tkelv
1648 
1649  REAL, PARAMETER :: ck = 8.0
1650  REAL, PARAMETER :: error = 0.005
1651 
1652 ! ----------------------------------------------------------------------
1653 ! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM)
1654 ! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS
1655 ! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES.
1656 ! ----------------------------------------------------------------------
1657 
1658  bx = bexp
1659  IF (bexp .GT. blim) bx = blim
1660 
1661 ! ----------------------------------------------------------------------
1662 ! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.
1663 ! ----------------------------------------------------------------------
1664 
1665  nlog=0
1666  kcount=0
1667 
1668  IF (ck .NE. 0.0) THEN
1669 
1670 ! ----------------------------------------------------------------------
1671 ! OPTION 1: ITERATED SOLUTION FOR NONZERO CK
1672 ! IN KOREN ET AL, JGR, 1999, EQN 17
1673 ! ----------------------------------------------------------------------
1674 ! INITIAL GUESS FOR SWL (frozen content)
1675 ! ----------------------------------------------------------------------
1676 
1677  swl = smc-sh2o
1678 
1679 ! ----------------------------------------------------------------------
1680 ! KEEP WITHIN BOUNDS.
1681 ! ----------------------------------------------------------------------
1682 
1683  IF (swl .GT. (smc-0.02)) swl = smc-0.02
1684  IF (swl .LT. 0.) swl = 0.
1685 
1686 ! ----------------------------------------------------------------------
1687 ! START OF ITERATIONS
1688 ! ----------------------------------------------------------------------
1689 
1690  DO WHILE ( (nlog .LT. 10) .AND. (kcount .EQ. 0) )
1691 
1692  nlog = nlog+1
1693  df = log(( psis*grav/hlice ) * ( ( 1.+ck*swl )**2. ) * &
1694  ( smcmax/(smc-swl) )**bx) - log(-(tkelv-frz_h2o)/tkelv)
1695  denom = 2. * ck / ( 1.+ck*swl ) + bx / ( smc - swl )
1696  swlk = swl - df/denom
1697 
1698 ! ----------------------------------------------------------------------
1699 ! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.
1700 ! ----------------------------------------------------------------------
1701 
1702  IF (swlk .GT. (smc-0.02)) swlk = smc - 0.02
1703  IF (swlk .LT. 0.) swlk = 0.
1704 
1705 ! ----------------------------------------------------------------------
1706 ! MATHEMATICAL SOLUTION BOUNDS APPLIED.
1707 ! ----------------------------------------------------------------------
1708 
1709  dswl = abs(swlk-swl)
1710  swl = swlk
1711 
1712 ! ----------------------------------------------------------------------
1713 ! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)
1714 ! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.
1715 ! ----------------------------------------------------------------------
1716 
1717  IF ( dswl .LE. error ) THEN
1718  kcount = kcount+1
1719  ENDIF
1720 
1721  END DO
1722 
1723 ! ----------------------------------------------------------------------
1724 ! END OF ITERATIONS
1725 ! ----------------------------------------------------------------------
1726 ! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.
1727 ! ----------------------------------------------------------------------
1728 
1729  frh2o = smc - swl
1730 
1731 ! ----------------------------------------------------------------------
1732 ! END OPTION 1
1733 ! ----------------------------------------------------------------------
1734 
1735  ENDIF
1736 
1737 !-----------------------------------------------------------------------
1738 ! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0
1739 ! IN KOREN ET AL., JGR, 1999, EQN 17
1740 ! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION
1741 ! ----------------------------------------------------------------------
1742 
1743  IF (kcount .EQ. 0) THEN
1744 
1745  fk = (((hlice/(grav*(-psis)))* &
1746  ((tkelv-frz_h2o)/tkelv))**(-1/bx))*smcmax
1747 
1748  IF (fk .LT. 0.02) fk = 0.02
1749 
1750  frh2o = min(fk, smc)
1751 
1752  ENDIF
1753 
1754  RETURN
1755 
1756  END function frh2o
1757 
1763  subroutine rescale_soil_moisture
1764 
1765  use esmf
1766 
1767  use model_grid, only : landmask_target_grid
1768 
1769  use program_setup, only : drysmc_input, drysmc_target, &
1770  maxsmc_input, maxsmc_target, &
1771  refsmc_input, refsmc_target, &
1772  wltsmc_input, wltsmc_target
1773 
1774  use static_data, only : soil_type_target_grid, &
1775  veg_greenness_target_grid, &
1776  veg_type_target_grid
1777 
1778  implicit none
1779 
1780  integer :: clb(3), cub(3), i, j, k, rc
1781  integer :: soilt_input, soilt_target
1782  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1783 
1784  real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:)
1785  real(esmf_kind_r8), pointer :: soil_type_input_ptr(:,:)
1786  real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:)
1787  real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:)
1788  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
1789  real :: f1, fn, smcdir, smctra
1790 
1791  print*,"- RESCALE SOIL MOISTURE FOR CHANGES IN SOIL TYPE."
1792 
1793  print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE."
1794  call esmf_fieldget(soilm_tot_target_grid, &
1795  computationallbound=clb, &
1796  computationalubound=cub, &
1797  farrayptr=soilm_tot_ptr, rc=rc)
1798  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1799  call error_handler("IN FieldGet", rc)
1800 
1801  print*,"- CALL FieldGet FOR LAND MASK."
1802  call esmf_fieldget(landmask_target_grid, &
1803  farrayptr=landmask_ptr, rc=rc)
1804  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1805  call error_handler("IN FieldGet", rc)
1806 
1807  print*,"- CALL FieldGet FOR VEGETATION TYPE."
1808  call esmf_fieldget(veg_type_target_grid, &
1809  farrayptr=veg_type_ptr, rc=rc)
1810  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1811  call error_handler("IN FieldGet", rc)
1812 
1813  print*,"- CALL FieldGet FOR VEGETATION GREENNESS."
1814  call esmf_fieldget(veg_greenness_target_grid, &
1815  farrayptr=veg_greenness_ptr, rc=rc)
1816  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1817  call error_handler("IN FieldGet", rc)
1818 
1819  print*,"- CALL FieldGet FOR TARGET GRID SOIL TYPE."
1820  call esmf_fieldget(soil_type_target_grid, &
1821  farrayptr=soil_type_target_ptr, rc=rc)
1822  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1823  call error_handler("IN FieldGet", rc)
1824 
1825  print*,"- CALL FieldGet FOR SOIL TYPE FROM INPUT GRID."
1826  call esmf_fieldget(soil_type_from_input_grid, &
1827  farrayptr=soil_type_input_ptr, rc=rc)
1828  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1829  call error_handler("IN FieldGet", rc)
1830 
1831  do j = clb(2), cub(2)
1832  do i = clb(1), cub(1)
1833 
1834 !---------------------------------------------------------------------------------------------
1835 ! Check land points that are not permanent land ice.
1836 !---------------------------------------------------------------------------------------------
1837 
1838  if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then
1839 
1840  soilt_target = nint(soil_type_target_ptr(i,j))
1841  soilt_input = nint(soil_type_input_ptr(i,j))
1842 
1843 !---------------------------------------------------------------------------------------------
1844 ! Rescale soil moisture at points where the soil type between the input and output
1845 ! grids is different. Caution, this logic assumes the input and target grids use the same
1846 ! soil type dataset.
1847 !---------------------------------------------------------------------------------------------
1848 
1849  if (soilt_target /= soilt_input) then
1850 !---------------------------------------------------------------------------------------------
1851 ! Rescale top layer. First, determine direct evaporation part:
1852 !---------------------------------------------------------------------------------------------
1853 
1854  f1=(soilm_tot_ptr(i,j,1)-drysmc_input(soilt_input)) / &
1855  (maxsmc_input(soilt_input)-drysmc_input(soilt_input))
1856 
1857  smcdir=drysmc_target(soilt_target) + f1 * &
1858  (maxsmc_target(soilt_target) - drysmc_target(soilt_target))
1859 
1860 !---------------------------------------------------------------------------------------------
1861 ! Continue top layer rescale. Now determine transpiration part:
1862 !---------------------------------------------------------------------------------------------
1863 
1864  if (soilm_tot_ptr(i,j,1) < refsmc_input(soilt_input)) then
1865  f1=(soilm_tot_ptr(i,j,1) - wltsmc_input(soilt_input)) / &
1866  (refsmc_input(soilt_input) - wltsmc_input(soilt_input))
1867  smctra=wltsmc_target(soilt_target) + f1 * &
1868  (refsmc_target(soilt_target) - wltsmc_target(soilt_target))
1869  else
1870  f1=(soilm_tot_ptr(i,j,1) - refsmc_input(soilt_input)) / &
1871  (maxsmc_input(soilt_input) - refsmc_input(soilt_input))
1872  smctra=refsmc_target(soilt_target) + f1 * &
1873  (maxsmc_target(soilt_target) - refsmc_target(soilt_target))
1874  endif
1875 
1876 !---------------------------------------------------------------------------------------------
1877 ! Top layer is weighted by green vegetation fraction:
1878 !---------------------------------------------------------------------------------------------
1879 
1880  soilm_tot_ptr(i,j,1) = ((1.0 - veg_greenness_ptr(i,j)) * smcdir) + &
1881  (veg_greenness_ptr(i,j) * smctra)
1882 
1883 !---------------------------------------------------------------------------------------------
1884 ! Rescale bottom layers as follows:
1885 !
1886 ! - Rescale between wilting point and reference value when wilting < soil m < reference, or
1887 ! - Rescale between reference point and maximum value when reference < soil m < max.
1888 !---------------------------------------------------------------------------------------------
1889 
1890  do k = 2, cub(3)
1891  if (soilm_tot_ptr(i,j,k) < refsmc_input(soilt_input)) then
1892  fn = (soilm_tot_ptr(i,j,k) - wltsmc_input(soilt_input)) / &
1893  (refsmc_input(soilt_input) - wltsmc_input(soilt_input))
1894  soilm_tot_ptr(i,j,k) = wltsmc_target(soilt_target) + fn * &
1895  (refsmc_target(soilt_target) - wltsmc_target(soilt_target))
1896  else
1897  fn = (soilm_tot_ptr(i,j,k) - refsmc_input(soilt_input)) / &
1898  (maxsmc_input(soilt_input) - refsmc_input(soilt_input))
1899  soilm_tot_ptr(i,j,k) = refsmc_target(soilt_target) + fn * &
1900  (maxsmc_target(soilt_target) - refsmc_target(soilt_target))
1901  endif
1902  enddo
1903 
1904  endif ! is soil type different?
1905 
1906 !---------------------------------------------------------------------------------------------
1907 ! Range check all layers.
1908 !---------------------------------------------------------------------------------------------
1909 
1910  soilm_tot_ptr(i,j,1)=min(soilm_tot_ptr(i,j,1),maxsmc_target(soilt_target))
1911  soilm_tot_ptr(i,j,1)=max(drysmc_target(soilt_target),soilm_tot_ptr(i,j,1))
1912 
1913  do k = 2, cub(3)
1914  soilm_tot_ptr(i,j,k)=min(soilm_tot_ptr(i,j,k),maxsmc_target(soilt_target))
1915  soilm_tot_ptr(i,j,k)=max(wltsmc_target(soilt_target),soilm_tot_ptr(i,j,k))
1916  enddo
1917 
1918  endif ! is this a land point?
1919 
1920  enddo
1921  enddo
1922 
1923  return
1924 
1925  end subroutine rescale_soil_moisture
1926 
1931  subroutine adjust_soilt_for_terrain
1932 
1933  use model_grid, only : landmask_target_grid, &
1934  terrain_target_grid
1935 
1936  use static_data, only : veg_type_target_grid
1937 
1938  implicit none
1939 
1940  integer :: clb(3), cub(3), i, j, k, rc
1941  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1942 
1943  real, parameter :: lapse_rate = 6.5e-03
1944  real :: terrain_diff
1945  real(esmf_kind_r8), pointer :: terrain_input_ptr(:,:)
1946  real(esmf_kind_r8), pointer :: terrain_target_ptr(:,:)
1947  real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:)
1948  real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:)
1949 
1950  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
1951  call esmf_fieldget(landmask_target_grid, &
1952  farrayptr=landmask_ptr, rc=rc)
1953  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1954  call error_handler("IN FieldGet", rc)
1955 
1956  print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE."
1957  call esmf_fieldget(veg_type_target_grid, &
1958  farrayptr=veg_type_target_ptr, rc=rc)
1959  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1960  call error_handler("IN FieldGet", rc)
1961 
1962  print*,"- CALL FieldGet FOR TARGET GRID TERRAIN."
1963  call esmf_fieldget(terrain_target_grid, &
1964  farrayptr=terrain_target_ptr, rc=rc)
1965  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1966  call error_handler("IN FieldGet", rc)
1967 
1968  print*,"- CALL FieldGet FOR TERRAIN INTERP TO TARGET GRID."
1969  call esmf_fieldget(terrain_from_input_grid, &
1970  farrayptr=terrain_input_ptr, rc=rc)
1971  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1972  call error_handler("IN FieldGet", rc)
1973 
1974  print*,"- CALL FieldGet FOR SOIL TEMP TARGET GRID."
1975  call esmf_fieldget(soil_temp_target_grid, &
1976  computationallbound=clb, &
1977  computationalubound=cub, &
1978  farrayptr=soil_temp_target_ptr, rc=rc)
1979  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1980  call error_handler("IN FieldGet", rc)
1981 
1982  do j = clb(2), cub(2)
1983  do i = clb(1), cub(1)
1984  if (landmask_ptr(i,j) == 1) then
1985  terrain_diff = abs(terrain_input_ptr(i,j) - terrain_target_ptr(i,j))
1986  if (terrain_diff > 100.0) then
1987  do k = clb(3), cub(3)
1988  soil_temp_target_ptr(i,j,k) = soil_temp_target_ptr(i,j,k) + &
1989  ((terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) * lapse_rate)
1990  if (nint(veg_type_target_ptr(i,j)) == veg_type_landice_target) then
1991  soil_temp_target_ptr(i,j,k) = min(soil_temp_target_ptr(i,j,k), 273.16)
1992  endif
1993  enddo
1994  endif
1995  endif
1996  enddo
1997  enddo
1998 
1999  end subroutine adjust_soilt_for_terrain
2000 
2007  subroutine adjust_soil_levels(localpet)
2008  use model_grid, only : lsoil_target, i_input, j_input, input_grid
2009  use input_data, only : lsoil_input, soil_temp_input_grid, &
2010  soilm_liq_input_grid, soilm_tot_input_grid
2011  implicit none
2012  integer, intent(in) :: localpet
2013  character(len=1000) :: msg
2014  integer :: rc
2015  real(esmf_kind_r8) :: tmp(i_input,j_input), &
2016  data_one_tile(i_input,j_input,lsoil_input), &
2017  tmp3d(i_input,j_input,lsoil_target)
2018  if (lsoil_input == 9 .and. lsoil_target == 4) then
2019  print*, "CONVERTING FROM 9 INPUT SOIL LEVELS TO 4 TARGET SOIL LEVELS"
2020  call esmf_fieldgather(soil_temp_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2021  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2022  call error_handler("IN FieldGather", rc)
2023 
2024  call esmf_fielddestroy(soil_temp_input_grid,rc=rc)
2025  soil_temp_input_grid = esmf_fieldcreate(input_grid, &
2026  typekind=esmf_typekind_r8, &
2027  staggerloc=esmf_staggerloc_center, &
2028  ungriddedlbound=(/1/), &
2029  ungriddedubound=(/lsoil_target/), rc=rc)
2030 
2031  if(localpet==0)then
2032  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2033  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2034  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2035  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2036  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2037  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2038  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2039  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2040  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2041  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2042  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2043  endif
2044 
2045  call esmf_fieldscatter(soil_temp_input_grid, tmp3d, rootpet=0, rc=rc)
2046  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2047  call error_handler("IN FieldScatter", rc)
2048 
2049  call esmf_fieldgather(soilm_tot_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2050  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2051  call error_handler("IN FieldGather", rc)
2052 
2053  call esmf_fielddestroy(soilm_tot_input_grid,rc=rc)
2054  soilm_tot_input_grid = esmf_fieldcreate(input_grid, &
2055  typekind=esmf_typekind_r8, &
2056  staggerloc=esmf_staggerloc_center, &
2057  ungriddedlbound=(/1/), &
2058  ungriddedubound=(/lsoil_target/), rc=rc)
2059 
2060  if(localpet==0) then
2061  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2062  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2063  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2064  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2065  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2066  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2067  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2068  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2069  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2070  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2071  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2072  endif
2073 
2074  call esmf_fieldscatter(soilm_tot_input_grid, tmp3d, rootpet=0, rc=rc)
2075  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2076  call error_handler("IN FieldScatter", rc)
2077 
2078  call esmf_fieldgather(soilm_liq_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2079  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2080  call error_handler("IN FieldGather", rc)
2081 
2082  call esmf_fielddestroy(soilm_liq_input_grid,rc=rc)
2083  soilm_liq_input_grid = esmf_fieldcreate(input_grid, &
2084  typekind=esmf_typekind_r8, &
2085  staggerloc=esmf_staggerloc_center, &
2086  ungriddedlbound=(/1/), &
2087  ungriddedubound=(/lsoil_target/), rc=rc)
2088  if(localpet==0) then
2089  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2090  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2091  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2092  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2093  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2094  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2095  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2096  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2097  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2098  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2099  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2100  endif
2101 
2102  call esmf_fieldscatter(soilm_liq_input_grid, tmp3d, rootpet=0, rc=rc)
2103  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2104  call error_handler("IN FieldScatter", rc)
2105 
2106  elseif (lsoil_input /= lsoil_target) then
2107  rc = -1
2108 
2109  write(msg,'("NUMBER OF SOIL LEVELS IN INPUT (",I2,") and OUPUT &
2110  (",I2,") MUST EITHER BE EQUAL OR 9 AND 4, RESPECTIVELY")') &
2111  lsoil_input, lsoil_target
2112 
2113  call error_handler(trim(msg), rc)
2114  endif
2115 
2116  end subroutine adjust_soil_levels
2117 
2123  subroutine roughness
2124 
2125  use model_grid, only : landmask_target_grid
2126  use static_data, only : veg_type_target_grid
2127 
2128  implicit none
2129 
2130  integer :: clb(2), cub(2), i, j, rc
2131  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
2132 
2133  real :: z0_igbp(20)
2134  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2135  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
2136 
2137  data z0_igbp /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, &
2138  0.030, 0.856, 0.856, 0.150, 0.040, 0.130, &
2139  1.000, 0.250, 0.011, 0.011, 0.001, 0.076, &
2140  0.050, 0.030/
2141 
2142  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
2143  call esmf_fieldget(landmask_target_grid, &
2144  computationallbound=clb, &
2145  computationalubound=cub, &
2146  farrayptr=landmask_ptr, rc=rc)
2147  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2148  call error_handler("IN FieldGet", rc)
2149 
2150  print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE."
2151  call esmf_fieldget(veg_type_target_grid, &
2152  farrayptr=veg_type_ptr, rc=rc)
2153  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2154  call error_handler("IN FieldGet", rc)
2155 
2156  print*,"- CALL FieldGet FOR TARGET GRID Z0."
2157  call esmf_fieldget(z0_target_grid, &
2158  farrayptr=data_ptr, rc=rc)
2159  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2160  call error_handler("IN FieldGet", rc)
2161 
2162  do j = clb(2), cub(2)
2163  do i = clb(1), cub(1)
2164  if (landmask_ptr(i,j) == 2) then
2165  data_ptr(i,j) = 1.0
2166  elseif (landmask_ptr(i,j) == 1) then
2167  data_ptr(i,j) = z0_igbp(nint(veg_type_ptr(i,j))) * 100.0
2168  endif
2169  enddo
2170  enddo
2171 
2172  end subroutine roughness
2173 
2177  subroutine qc_check
2178 
2179  use model_grid, only : landmask_target_grid
2180 
2181  use static_data, only : alvsf_target_grid, &
2182  alvwf_target_grid, &
2183  alnsf_target_grid, &
2184  alnwf_target_grid, &
2185  facsf_target_grid, &
2186  facwf_target_grid, &
2187  mxsno_albedo_target_grid, &
2188  max_veg_greenness_target_grid, &
2189  min_veg_greenness_target_grid, &
2190  slope_type_target_grid, &
2191  soil_type_target_grid, &
2192  substrate_temp_target_grid, &
2193  veg_greenness_target_grid, &
2194  veg_type_target_grid
2195 
2196  implicit none
2197 
2198  integer :: clb(2), cub(2), i, j, rc
2199  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
2200 
2201  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2202  real(esmf_kind_r8), pointer :: data3d_ptr(:,:,:)
2203  real(esmf_kind_r8), pointer :: soilmt_ptr(:,:,:)
2204  real(esmf_kind_r8), pointer :: soilml_ptr(:,:,:)
2205  real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:)
2206  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
2207  real(esmf_kind_r8), pointer :: seaice_skint_ptr(:,:)
2208  real(esmf_kind_r8), pointer :: skint_ptr(:,:)
2209  real(esmf_kind_r8), pointer :: fice_ptr(:,:)
2210  real(esmf_kind_r8), pointer :: hice_ptr(:,:)
2211 
2212  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
2213  call esmf_fieldget(landmask_target_grid, &
2214  computationallbound=clb, &
2215  computationalubound=cub, &
2216  farrayptr=landmask_ptr, rc=rc)
2217  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2218  call error_handler("IN FieldGet", rc)
2219 
2220  print*,"- SET NON-LAND FLAG FOR TARGET GRID SLOPE TYPE."
2221  call esmf_fieldget(slope_type_target_grid, &
2222  farrayptr=data_ptr, rc=rc)
2223  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2224  call error_handler("IN FieldGet", rc)
2225 
2226  do j = clb(2), cub(2)
2227  do i = clb(1), cub(1)
2228  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2229  enddo
2230  enddo
2231 
2232  print*,"- SET NON-LAND FLAG FOR TARGET GRID SOIL TYPE."
2233  call esmf_fieldget(soil_type_target_grid, &
2234  farrayptr=data_ptr, rc=rc)
2235  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2236  call error_handler("IN FieldGet", rc)
2237 
2238  do j = clb(2), cub(2)
2239  do i = clb(1), cub(1)
2240  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2241  enddo
2242  enddo
2243 
2244  print*,"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION TYPE."
2245  call esmf_fieldget(veg_type_target_grid, &
2246  farrayptr=veg_type_ptr, rc=rc)
2247  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2248  call error_handler("IN FieldGet", rc)
2249 
2250  do j = clb(2), cub(2)
2251  do i = clb(1), cub(1)
2252  if (landmask_ptr(i,j) /= 1) veg_type_ptr(i,j) = 0.0
2253  enddo
2254  enddo
2255 
2256  print*,"- SET TARGET GRID ALVSF AT NON-LAND."
2257  call esmf_fieldget(alvsf_target_grid, &
2258  farrayptr=data_ptr, rc=rc)
2259  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2260  call error_handler("IN FieldGet", rc)
2261 
2262  do j = clb(2), cub(2)
2263  do i = clb(1), cub(1)
2264  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value
2265  enddo
2266  enddo
2267 
2268  print*,"- SET TARGET GRID ALVWF AT NON-LAND."
2269  call esmf_fieldget(alvwf_target_grid, &
2270  farrayptr=data_ptr, rc=rc)
2271  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2272  call error_handler("IN FieldGet", rc)
2273 
2274  do j = clb(2), cub(2)
2275  do i = clb(1), cub(1)
2276  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value
2277  enddo
2278  enddo
2279 
2280  print*,"- SET TARGET GRID ALNSF AT NON-LAND."
2281  call esmf_fieldget(alnsf_target_grid, &
2282  farrayptr=data_ptr, rc=rc)
2283  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2284  call error_handler("IN FieldGet", rc)
2285 
2286  do j = clb(2), cub(2)
2287  do i = clb(1), cub(1)
2288  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value
2289  enddo
2290  enddo
2291 
2292  print*,"- SET TARGET GRID ALNWF AT NON-LAND."
2293  call esmf_fieldget(alnwf_target_grid, &
2294  farrayptr=data_ptr, rc=rc)
2295  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2296  call error_handler("IN FieldGet", rc)
2297 
2298  do j = clb(2), cub(2)
2299  do i = clb(1), cub(1)
2300  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06 ! gfs physics flag value
2301  enddo
2302  enddo
2303 
2304  print*,"- SET NON-LAND FLAG FOR TARGET GRID FACSF."
2305  call esmf_fieldget(facsf_target_grid, &
2306  farrayptr=data_ptr, rc=rc)
2307  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2308  call error_handler("IN FieldGet", rc)
2309 
2310  do j = clb(2), cub(2)
2311  do i = clb(1), cub(1)
2312  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2313  enddo
2314  enddo
2315 
2316  print*,"- SET NON-LAND FLAG FOR TARGET GRID FACSF."
2317  call esmf_fieldget(facwf_target_grid, &
2318  farrayptr=data_ptr, rc=rc)
2319  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2320  call error_handler("IN FieldGet", rc)
2321 
2322  do j = clb(2), cub(2)
2323  do i = clb(1), cub(1)
2324  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2325  enddo
2326  enddo
2327 
2328  print*,"- SET NON-LAND FLAG FOR TARGET GRID MAXIMUM GREENNESS."
2329  call esmf_fieldget(max_veg_greenness_target_grid, &
2330  farrayptr=data_ptr, rc=rc)
2331  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2332  call error_handler("IN FieldGet", rc)
2333 
2334  do j = clb(2), cub(2)
2335  do i = clb(1), cub(1)
2336  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2337  enddo
2338  enddo
2339 
2340  print*,"- SET NON-LAND FLAG FOR TARGET GRID MINIMUM GREENNESS."
2341  call esmf_fieldget(min_veg_greenness_target_grid, &
2342  farrayptr=data_ptr, rc=rc)
2343  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2344  call error_handler("IN FieldGet", rc)
2345 
2346  do j = clb(2), cub(2)
2347  do i = clb(1), cub(1)
2348  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2349  enddo
2350  enddo
2351 
2352  print*,"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION GREENNESS."
2353  call esmf_fieldget(veg_greenness_target_grid, &
2354  farrayptr=veg_greenness_ptr, rc=rc)
2355  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2356  call error_handler("IN FieldGet", rc)
2357 
2358  do j = clb(2), cub(2)
2359  do i = clb(1), cub(1)
2360  if (landmask_ptr(i,j) /= 1) veg_greenness_ptr(i,j) = 0.0
2361  enddo
2362  enddo
2363 
2364  print*,"- SET NON-LAND FLAG FOR TARGET GRID MAX SNOW ALBEDO."
2365  call esmf_fieldget(mxsno_albedo_target_grid, &
2366  farrayptr=data_ptr, rc=rc)
2367  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2368  call error_handler("IN FieldGet", rc)
2369 
2370  do j = clb(2), cub(2)
2371  do i = clb(1), cub(1)
2372  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2373  enddo
2374  enddo
2375 
2376  print*,"- ZERO OUT TARGET GRID CANOPY MOISTURE CONTENT WHERE NO PLANTS."
2377  call esmf_fieldget(canopy_mc_target_grid, &
2378  farrayptr=data_ptr, rc=rc)
2379  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2380  call error_handler("IN FieldGet", rc)
2381 
2382  do j = clb(2), cub(2)
2383  do i = clb(1), cub(1)
2384  if (veg_greenness_ptr(i,j) <= 0.01) data_ptr(i,j) = 0.0
2385  enddo
2386  enddo
2387 
2388  print*,"- CALL FieldGet FOR TARGET GRID ICE SKIN TEMP."
2389  call esmf_fieldget(seaice_skin_temp_target_grid, &
2390  farrayptr=seaice_skint_ptr, rc=rc)
2391  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2392  call error_handler("IN FieldGet", rc)
2393 
2394  print*,"- SET TARGET GRID SKIN TEMP AT ICE POINTS."
2395  call esmf_fieldget(skin_temp_target_grid, &
2396  farrayptr=skint_ptr, rc=rc)
2397  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2398  call error_handler("IN FieldGet", rc)
2399 
2400  print*,"- CALL FieldGet FOR TARGET GRID SEA ICE FRACTION."
2401  call esmf_fieldget(seaice_fract_target_grid, &
2402  farrayptr=fice_ptr, rc=rc)
2403  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2404  call error_handler("IN FieldGet", rc)
2405 
2406  print*,"- SET TARGET GRID SEA ICE DEPTH TO ZERO AT NON-ICE POINTS."
2407  call esmf_fieldget(seaice_depth_target_grid, &
2408  farrayptr=hice_ptr, rc=rc)
2409  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2410  call error_handler("IN FieldGet", rc)
2411 
2412  do j = clb(2), cub(2)
2413  do i = clb(1), cub(1)
2414  if (fice_ptr(i,j) > 0.0) then
2415  skint_ptr(i,j) = (fice_ptr(i,j) * seaice_skint_ptr(i,j)) + &
2416  ( (1.0 - fice_ptr(i,j)) * frz_ice )
2417  else
2418  seaice_skint_ptr(i,j) = skint_ptr(i,j)
2419  hice_ptr(i,j) = 0.0
2420  endif
2421  enddo
2422  enddo
2423 
2424  print*,"- SET TARGET GRID SUBSTRATE TEMP AT ICE."
2425  call esmf_fieldget(substrate_temp_target_grid, &
2426  farrayptr=data_ptr, rc=rc)
2427  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2428  call error_handler("IN FieldGet", rc)
2429 
2430  do j = clb(2), cub(2)
2431  do i = clb(1), cub(1)
2432  if (landmask_ptr(i,j) == 2) then ! sea ice
2433  data_ptr(i,j) = frz_ice
2434  elseif (landmask_ptr(i,j) == 0) then ! open water flag value.
2435  data_ptr(i,j) = skint_ptr(i,j)
2436  endif
2437  enddo
2438  enddo
2439 
2440  print*,"- ZERO OUT TARGET GRID SNOW DEPTH AT OPEN WATER."
2441  call esmf_fieldget(snow_depth_target_grid, &
2442  farrayptr=data_ptr, rc=rc)
2443  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2444  call error_handler("IN FieldGet", rc)
2445 
2446  do j = clb(2), cub(2)
2447  do i = clb(1), cub(1)
2448  if (landmask_ptr(i,j) == 0) then ! open water
2449  data_ptr(i,j) = 0.0
2450  end if
2451  enddo
2452  enddo
2453 
2454  print*,"- ZERO OUT TARGET GRID SNOW LIQ AT OPEN WATER."
2455  call esmf_fieldget(snow_liq_equiv_target_grid, &
2456  farrayptr=data_ptr, rc=rc)
2457  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2458  call error_handler("IN FieldGet", rc)
2459 
2460  do j = clb(2), cub(2)
2461  do i = clb(1), cub(1)
2462  if (landmask_ptr(i,j) == 0) then ! open water
2463  data_ptr(i,j) = 0.0
2464  endif
2465  enddo
2466  enddo
2467 
2468  print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID TOTAL SOIL MOISTURE."
2469  call esmf_fieldget(soilm_tot_target_grid, &
2470  farrayptr=soilmt_ptr, rc=rc)
2471  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2472  call error_handler("IN FieldGet", rc)
2473 
2474  print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID LIQUID SOIL MOISTURE."
2475  call esmf_fieldget(soilm_liq_target_grid, &
2476  farrayptr=soilml_ptr, rc=rc)
2477  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2478  call error_handler("IN FieldGet", rc)
2479 
2480  do j = clb(2), cub(2)
2481  do i = clb(1), cub(1)
2482  if (landmask_ptr(i,j) == 2 .or. landmask_ptr(i,j) == 0 .or. &
2483  nint(veg_type_ptr(i,j)) == veg_type_landice_target) then
2484  soilmt_ptr(i,j,:) = 1.0
2485  soilml_ptr(i,j,:) = 1.0
2486  endif
2487  enddo
2488  enddo
2489 
2490  print*,"- SET OPEN WATER FLAG FOR TARGET GRID SOIL TEMPERATURE."
2491  call esmf_fieldget(soil_temp_target_grid, &
2492  farrayptr=data3d_ptr, rc=rc)
2493  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2494  call error_handler("IN FieldGet", rc)
2495 
2496  do j = clb(2), cub(2)
2497  do i = clb(1), cub(1)
2498  if (landmask_ptr(i,j) == 0) then
2499  data3d_ptr(i,j,:) = skint_ptr(i,j) ! open water flag value.
2500  endif
2501  enddo
2502  enddo
2503 
2504  return
2505 
2506  end subroutine qc_check
2507 
2512  subroutine nst_land_fill
2513 
2514  use model_grid, only : landmask_target_grid
2515 
2516  implicit none
2517 
2518  integer(esmf_kind_i8), pointer :: mask_ptr(:,:)
2519  integer :: rc,i
2520  integer, PARAMETER :: num_nst_fields_minus2 = 16
2521  integer, PARAMETER :: xz_fill = 30.0
2522  integer, PARAMETER :: nst_fill = 0.0
2523 
2524  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2525  real(esmf_kind_r8), pointer :: skint_ptr(:,:)
2526 
2527  type(esmf_field) :: temp_field
2528  type(esmf_fieldbundle) :: nst_bundle
2529 
2530  print*,"- CALL FieldGet FOR TARGET GRID LANDMASK."
2531  call esmf_fieldget(landmask_target_grid, &
2532  farrayptr=mask_ptr, rc=rc)
2533  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2534  call error_handler("IN FieldGet", rc)
2535 
2536  nst_bundle = esmf_fieldbundlecreate(name="nst_bundle", rc=rc)
2537  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2538  call error_handler("IN FieldBundleCreate", rc)
2539 
2540  call esmf_fieldbundleadd(nst_bundle, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, &
2541  dt_cool_target_grid,ifd_target_grid,qrain_target_grid,&
2542  w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,&
2543  xu_target_grid,xv_target_grid,xtts_target_grid,xzts_target_grid, &
2544  z_c_target_grid, zm_target_grid/), rc=rc)
2545  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2546  call error_handler("IN FieldBundleAdd", rc)
2547 
2548  print*,"- CALL FieldGet FOR TREF."
2549  call esmf_fieldget(tref_target_grid, &
2550  farrayptr=data_ptr, rc=rc)
2551  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2552  call error_handler("IN FieldGet", rc)
2553 
2554  print*,"- CALL FieldGet FOR SKIN T."
2555  call esmf_fieldget(skin_temp_target_grid, &
2556  farrayptr=skint_ptr, rc=rc)
2557  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2558  call error_handler("IN FieldGet", rc)
2559 
2560  where(mask_ptr /= 0) data_ptr = skint_ptr
2561 
2562 ! xz
2563 
2564  print*,"- CALL FieldGet FOR XZ."
2565  call esmf_fieldget(xz_target_grid, &
2566  farrayptr=data_ptr, rc=rc)
2567  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2568  call error_handler("IN FieldGet", rc)
2569 
2570  where(mask_ptr /= 0) data_ptr = xz_fill
2571 
2572  do i = 1,num_nst_fields_minus2
2573 
2574  call esmf_fieldbundleget(nst_bundle,i,temp_field,rc=rc)
2575  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2576  call error_handler("IN FieldBundleGet", rc)
2577 
2578  call esmf_fieldget(temp_field,farrayptr=data_ptr,rc=rc)
2579  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2580  call error_handler("IN FieldGet", rc)
2581 
2582  where(mask_ptr /= 0) data_ptr = nst_fill
2583 
2584  enddo
2585 
2586  call esmf_fieldbundledestroy(nst_bundle,rc=rc)
2587  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2588  call error_handler("IN FieldBundleDestroy", rc)
2589 
2590  end subroutine nst_land_fill
2591 
2595  subroutine create_surface_esmf_fields
2596 
2597  use model_grid, only : target_grid, lsoil_target
2598 
2599  implicit none
2600 
2601  integer :: rc
2602 
2603  real(esmf_kind_r8), pointer :: target_ptr(:,:), target_ptr_3d(:,:,:)
2604  real :: init_val = -999.9
2605 
2606  print*,"- CALL FieldCreate FOR TARGET GRID T2M."
2607  t2m_target_grid = esmf_fieldcreate(target_grid, &
2608  typekind=esmf_typekind_r8, &
2609  name="t2m_target_grid", &
2610  staggerloc=esmf_staggerloc_center, rc=rc)
2611  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2612  call error_handler("IN FieldCreate", rc)
2613 
2614  print*,"- INITIALIZE TARGET grid t2m."
2615  call esmf_fieldget(t2m_target_grid, &
2616  farrayptr=target_ptr, rc=rc)
2617  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2618  call error_handler("IN FieldGet", rc)
2619 
2620  target_ptr = init_val
2621 
2622  print*,"- CALL FieldCreate FOR TARGET GRID Q2M."
2623  q2m_target_grid = esmf_fieldcreate(target_grid, &
2624  typekind=esmf_typekind_r8, &
2625  name="q2m_target_grid", &
2626  staggerloc=esmf_staggerloc_center, rc=rc)
2627  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2628  call error_handler("IN FieldCreate", rc)
2629 
2630  print*,"- INITIALIZE TARGET grid q2m."
2631  call esmf_fieldget(q2m_target_grid, &
2632  farrayptr=target_ptr, rc=rc)
2633  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2634  call error_handler("IN FieldGet", rc)
2635 
2636  target_ptr = init_val
2637 
2638  print*,"- CALL FieldCreate FOR TARGET GRID TPRCP."
2639  tprcp_target_grid = esmf_fieldcreate(target_grid, &
2640  typekind=esmf_typekind_r8, &
2641  name="tprcp_target_grid", &
2642  staggerloc=esmf_staggerloc_center, rc=rc)
2643  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2644  call error_handler("IN FieldCreate", rc)
2645 
2646  print*,"- INITIALIZE TARGET grid tprcp."
2647  call esmf_fieldget(tprcp_target_grid, &
2648  farrayptr=target_ptr, rc=rc)
2649  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2650  call error_handler("IN FieldGet", rc)
2651 
2652  target_ptr = init_val
2653 
2654  print*,"- CALL FieldCreate FOR TARGET GRID F10M."
2655  f10m_target_grid = esmf_fieldcreate(target_grid, &
2656  typekind=esmf_typekind_r8, &
2657  name="f10m_target_grid", &
2658  staggerloc=esmf_staggerloc_center, rc=rc)
2659  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2660  call error_handler("IN FieldCreate", rc)
2661 
2662  print*,"- INITIALIZE TARGET grid f10m."
2663  call esmf_fieldget(f10m_target_grid, &
2664  farrayptr=target_ptr, rc=rc)
2665  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2666  call error_handler("IN FieldGet", rc)
2667 
2668  target_ptr = init_val
2669 
2670  print*,"- CALL FieldCreate FOR TARGET GRID FFMM."
2671  ffmm_target_grid = esmf_fieldcreate(target_grid, &
2672  typekind=esmf_typekind_r8, &
2673  name="ffmm_target_grid", &
2674  staggerloc=esmf_staggerloc_center, rc=rc)
2675  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2676  call error_handler("IN FieldCreate", rc)
2677 
2678  print*,"- INITIALIZE TARGET grid ffmm."
2679  call esmf_fieldget(ffmm_target_grid, &
2680  farrayptr=target_ptr, rc=rc)
2681  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2682  call error_handler("IN FieldGet", rc)
2683 
2684  target_ptr = init_val
2685 
2686  print*,"- CALL FieldCreate FOR TARGET GRID USTAR."
2687  ustar_target_grid = esmf_fieldcreate(target_grid, &
2688  typekind=esmf_typekind_r8, &
2689  name="ustar_target_grid", &
2690  staggerloc=esmf_staggerloc_center, rc=rc)
2691  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2692  call error_handler("IN FieldCreate", rc)
2693 
2694  print*,"- INITIALIZE TARGET grid ustar."
2695  call esmf_fieldget(ustar_target_grid, &
2696  farrayptr=target_ptr, rc=rc)
2697  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2698  call error_handler("IN FieldGet", rc)
2699 
2700  target_ptr = init_val
2701 
2702  print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV."
2703  snow_liq_equiv_target_grid = esmf_fieldcreate(target_grid, &
2704  typekind=esmf_typekind_r8, &
2705  name="snow_liq_equiv_target_grid", &
2706  staggerloc=esmf_staggerloc_center, rc=rc)
2707  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2708  call error_handler("IN FieldCreate", rc)
2709 
2710  print*,"- INITIALIZE TARGET grid snow liq equiv."
2711  call esmf_fieldget(snow_liq_equiv_target_grid, &
2712  farrayptr=target_ptr, rc=rc)
2713  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2714  call error_handler("IN FieldGet", rc)
2715 
2716  target_ptr = init_val
2717 
2718  print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH."
2719  snow_depth_target_grid = esmf_fieldcreate(target_grid, &
2720  typekind=esmf_typekind_r8, &
2721  name="snow_depth_target_grid", &
2722  staggerloc=esmf_staggerloc_center, rc=rc)
2723  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2724  call error_handler("IN FieldCreate", rc)
2725 
2726  print*,"- INITIALIZE TARGET grid snow depth."
2727  call esmf_fieldget(snow_depth_target_grid, &
2728  farrayptr=target_ptr, rc=rc)
2729  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2730  call error_handler("IN FieldGet", rc)
2731 
2732  target_ptr = init_val
2733 
2734  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION."
2735  seaice_fract_target_grid = esmf_fieldcreate(target_grid, &
2736  typekind=esmf_typekind_r8, &
2737  name="seaice_fract_target_grid", &
2738  staggerloc=esmf_staggerloc_center, rc=rc)
2739  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2740  call error_handler("IN FieldCreate", rc)
2741 
2742  print*,"- INITIALIZE TARGET grid sea ice fraction."
2743  call esmf_fieldget(seaice_fract_target_grid, &
2744  farrayptr=target_ptr, rc=rc)
2745  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2746  call error_handler("IN FieldGet", rc)
2747 
2748  target_ptr = init_val
2749 
2750  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH."
2751  seaice_depth_target_grid = esmf_fieldcreate(target_grid, &
2752  typekind=esmf_typekind_r8, &
2753  name="seaice_depth_target_grid", &
2754  staggerloc=esmf_staggerloc_center, rc=rc)
2755  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2756  call error_handler("IN FieldCreate", rc)
2757 
2758  print*,"- INITIALIZE TARGET sea ice depth."
2759  call esmf_fieldget(seaice_depth_target_grid, &
2760  farrayptr=target_ptr, rc=rc)
2761  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2762  call error_handler("IN FieldGet", rc)
2763 
2764  target_ptr = init_val
2765 
2766  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP."
2767  seaice_skin_temp_target_grid = esmf_fieldcreate(target_grid, &
2768  typekind=esmf_typekind_r8, &
2769  name="seaice_skin_temp_target_grid", &
2770  staggerloc=esmf_staggerloc_center, rc=rc)
2771  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2772  call error_handler("IN FieldCreate", rc)
2773 
2774  print*,"- INITIALIZE TARGET sea ice skin temp."
2775  call esmf_fieldget(seaice_skin_temp_target_grid, &
2776  farrayptr=target_ptr, rc=rc)
2777  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2778  call error_handler("IN FieldGet", rc)
2779 
2780  target_ptr = init_val
2781 
2782  print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG."
2783  srflag_target_grid = esmf_fieldcreate(target_grid, &
2784  typekind=esmf_typekind_r8, &
2785  name="srflag_target_grid", &
2786  staggerloc=esmf_staggerloc_center, rc=rc)
2787  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2788  call error_handler("IN FieldCreate", rc)
2789 
2790  print*,"- INITIALIZE TARGET srflag."
2791  call esmf_fieldget(srflag_target_grid, &
2792  farrayptr=target_ptr, rc=rc)
2793  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2794  call error_handler("IN FieldGet", rc)
2795 
2796  target_ptr = init_val
2797 
2798  print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE."
2799  skin_temp_target_grid = esmf_fieldcreate(target_grid, &
2800  typekind=esmf_typekind_r8, &
2801  name="skin_temp_target_grid", &
2802  staggerloc=esmf_staggerloc_center, rc=rc)
2803  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2804  call error_handler("IN FieldCreate", rc)
2805 
2806  print*,"- INITIALIZE TARGET grid skin temp."
2807  call esmf_fieldget(skin_temp_target_grid, &
2808  farrayptr=target_ptr, rc=rc)
2809  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2810  call error_handler("IN FieldGet", rc)
2811 
2812  target_ptr = init_val
2813 
2814  print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT."
2815  canopy_mc_target_grid = esmf_fieldcreate(target_grid, &
2816  typekind=esmf_typekind_r8, &
2817  name="canopy_mc_target_grid", &
2818  staggerloc=esmf_staggerloc_center, rc=rc)
2819  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2820  call error_handler("IN FieldCreate", rc)
2821 
2822  print*,"- INITIALIZE TARGET grid canopy moisture."
2823  call esmf_fieldget(canopy_mc_target_grid, &
2824  farrayptr=target_ptr, rc=rc)
2825  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2826  call error_handler("IN FieldGet", rc)
2827 
2828  target_ptr = init_val
2829 
2830  print*,"- CALL FieldCreate FOR TARGET GRID LEAF AREA INDEX."
2831  lai_target_grid = esmf_fieldcreate(target_grid, &
2832  typekind=esmf_typekind_r8, &
2833  name="lai_target_grid",&
2834  staggerloc=esmf_staggerloc_center, rc=rc)
2835  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2836  call error_handler("IN FieldCreate", rc)
2837 
2838  print*,"- INITIALIZE TARGET leaf area index."
2839  call esmf_fieldget(lai_target_grid, &
2840  farrayptr=target_ptr, rc=rc)
2841  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2842  call error_handler("IN FieldGet", rc)
2843 
2844  target_ptr = init_val
2845 
2846  print*,"- CALL FieldCreate FOR TARGET GRID Z0."
2847  z0_target_grid = esmf_fieldcreate(target_grid, &
2848  typekind=esmf_typekind_r8, &
2849  name="z0_target_grid", &
2850  staggerloc=esmf_staggerloc_center, rc=rc)
2851  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2852  call error_handler("IN FieldCreate", rc)
2853 
2854  print*,"- INITIALIZE TARGET grid z0."
2855  call esmf_fieldget(z0_target_grid, &
2856  farrayptr=target_ptr, rc=rc)
2857  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2858  call error_handler("IN FieldGet", rc)
2859 
2860  target_ptr = init_val
2861 
2862  print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN."
2863  terrain_from_input_grid = esmf_fieldcreate(target_grid, &
2864  typekind=esmf_typekind_r8, &
2865  name="terrain_from_input_grid", &
2866  staggerloc=esmf_staggerloc_center, rc=rc)
2867  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2868  call error_handler("IN FieldCreate", rc)
2869 
2870  print*,"- INITIALIZE TARGET grid interpolated terrain."
2871  call esmf_fieldget(terrain_from_input_grid, &
2872  farrayptr=target_ptr, rc=rc)
2873  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2874  call error_handler("IN FieldGet", rc)
2875 
2876  target_ptr = init_val
2877 
2878  print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE."
2879  soil_type_from_input_grid = esmf_fieldcreate(target_grid, &
2880  typekind=esmf_typekind_r8, &
2881  staggerloc=esmf_staggerloc_center, &
2882  name="soil_type_from_input_grid", rc=rc)
2883  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2884  call error_handler("IN FieldCreate", rc)
2885 
2886  print*,"- INITIALIZE TARGET grid soil type"
2887  call esmf_fieldget(soil_type_from_input_grid, &
2888  farrayptr=target_ptr, rc=rc)
2889  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2890  call error_handler("IN FieldGet", rc)
2891 
2892  target_ptr = init_val
2893 
2894  print*,"- CALL FieldCreate FOR TARGET GRID SOIL TEMPERATURE."
2895  soil_temp_target_grid = esmf_fieldcreate(target_grid, &
2896  typekind=esmf_typekind_r8, &
2897  staggerloc=esmf_staggerloc_center, &
2898  name="soil_temp_target_grid", &
2899  ungriddedlbound=(/1/), &
2900  ungriddedubound=(/lsoil_target/), rc=rc)
2901  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2902  call error_handler("IN FieldCreate", rc)
2903 
2904  print*,"- INITIALIZE TARGET grid soil temp"
2905  call esmf_fieldget(soil_temp_target_grid, &
2906  farrayptr=target_ptr_3d, rc=rc)
2907  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2908  call error_handler("IN FieldGet", rc)
2909 
2910  target_ptr_3d = init_val
2911 
2912  print*,"- CALL FieldCreate FOR TARGET GRID TOTAL SOIL MOISTURE."
2913  soilm_tot_target_grid = esmf_fieldcreate(target_grid, &
2914  typekind=esmf_typekind_r8, &
2915  staggerloc=esmf_staggerloc_center, &
2916  name="soilm_tot_target_grid", &
2917  ungriddedlbound=(/1/), &
2918  ungriddedubound=(/lsoil_target/), rc=rc)
2919  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2920  call error_handler("IN FieldCreate", rc)
2921 
2922  print*,"- INITIALIZE TARGET grid soil moist"
2923  call esmf_fieldget(soilm_tot_target_grid, &
2924  farrayptr=target_ptr_3d, rc=rc)
2925  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2926  call error_handler("IN FieldGet", rc)
2927 
2928  target_ptr_3d = init_val
2929 
2930  print*,"- CALL FieldCreate FOR TARGET GRID LIQUID SOIL MOISTURE."
2931  soilm_liq_target_grid = esmf_fieldcreate(target_grid, &
2932  typekind=esmf_typekind_r8, &
2933  staggerloc=esmf_staggerloc_center, &
2934  name="soilm_liq_target_grid", &
2935  ungriddedlbound=(/1/), &
2936  ungriddedubound=(/lsoil_target/), rc=rc)
2937  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2938  call error_handler("IN FieldCreate", rc)
2939 
2940  print*,"- INITIALIZE TARGET grid soil liq"
2941  call esmf_fieldget(soilm_liq_target_grid, &
2942  farrayptr=target_ptr_3d, rc=rc)
2943  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2944  call error_handler("IN FieldGet", rc)
2945 
2946  target_ptr_3d = init_val
2947 
2948  end subroutine create_surface_esmf_fields
2949 
2953  subroutine create_nst_esmf_fields
2954 
2955  use model_grid, only : target_grid
2956 
2957  implicit none
2958 
2959  integer :: rc
2960 
2961  print*,"- CALL FieldCreate FOR TARGET GRID C_D."
2962  c_d_target_grid = esmf_fieldcreate(target_grid, &
2963  typekind=esmf_typekind_r8, &
2964  name='c_d', &
2965  staggerloc=esmf_staggerloc_center, rc=rc)
2966  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2967  call error_handler("IN FieldCreate", rc)
2968 
2969  print*,"- CALL FieldCreate FOR TARGET GRID C_0."
2970  c_0_target_grid = esmf_fieldcreate(target_grid, &
2971  typekind=esmf_typekind_r8, &
2972  name='c_0', &
2973  staggerloc=esmf_staggerloc_center, rc=rc)
2974  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2975  call error_handler("IN FieldCreate", rc)
2976 
2977  print*,"- CALL FieldCreate FOR TARGET GRID D_CONV."
2978  d_conv_target_grid = esmf_fieldcreate(target_grid, &
2979  typekind=esmf_typekind_r8, &
2980  name='d_conv',&
2981  staggerloc=esmf_staggerloc_center, rc=rc)
2982  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2983  call error_handler("IN FieldCreate", rc)
2984 
2985  print*,"- CALL FieldCreate FOR TARGET GRID DT_COOL."
2986  dt_cool_target_grid = esmf_fieldcreate(target_grid, &
2987  typekind=esmf_typekind_r8, &
2988  name='dt_cool',&
2989  staggerloc=esmf_staggerloc_center, rc=rc)
2990  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2991  call error_handler("IN FieldCreate", rc)
2992 
2993  print*,"- CALL FieldCreate FOR TARGET GRID IFD."
2994  ifd_target_grid = esmf_fieldcreate(target_grid, &
2995  typekind=esmf_typekind_r8, &
2996  name='ifd',&
2997  staggerloc=esmf_staggerloc_center, rc=rc)
2998  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2999  call error_handler("IN FieldCreate", rc)
3000 
3001  print*,"- CALL FieldCreate FOR TARGET GRID QRAIN."
3002  qrain_target_grid = esmf_fieldcreate(target_grid, &
3003  typekind=esmf_typekind_r8, &
3004  name='qrain',&
3005  staggerloc=esmf_staggerloc_center, rc=rc)
3006  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3007  call error_handler("IN FieldCreate", rc)
3008 
3009  print*,"- CALL FieldCreate FOR TARGET GRID TREF."
3010  tref_target_grid = esmf_fieldcreate(target_grid, &
3011  typekind=esmf_typekind_r8, &
3012  name='tref',&
3013  staggerloc=esmf_staggerloc_center, rc=rc)
3014  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3015  call error_handler("IN FieldCreate", rc)
3016 
3017  print*,"- CALL FieldCreate FOR TARGET GRID W_D."
3018  w_d_target_grid = esmf_fieldcreate(target_grid, &
3019  typekind=esmf_typekind_r8, &
3020  name='w_d',&
3021  staggerloc=esmf_staggerloc_center, rc=rc)
3022  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3023  call error_handler("IN FieldCreate", rc)
3024 
3025  print*,"- CALL FieldCreate FOR TARGET GRID W_0."
3026  w_0_target_grid = esmf_fieldcreate(target_grid, &
3027  typekind=esmf_typekind_r8, &
3028  name='w_0',&
3029  staggerloc=esmf_staggerloc_center, rc=rc)
3030  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3031  call error_handler("IN FieldCreate", rc)
3032 
3033  print*,"- CALL FieldCreate FOR TARGET GRID XS."
3034  xs_target_grid = esmf_fieldcreate(target_grid, &
3035  typekind=esmf_typekind_r8, &
3036  name='xs',&
3037  staggerloc=esmf_staggerloc_center, rc=rc)
3038  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3039  call error_handler("IN FieldCreate", rc)
3040 
3041  print*,"- CALL FieldCreate FOR TARGET GRID XT."
3042  xt_target_grid = esmf_fieldcreate(target_grid, &
3043  typekind=esmf_typekind_r8, &
3044  name='xt',&
3045  staggerloc=esmf_staggerloc_center, rc=rc)
3046  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3047  call error_handler("IN FieldCreate", rc)
3048 
3049  print*,"- CALL FieldCreate FOR TARGET GRID XU."
3050  xu_target_grid = esmf_fieldcreate(target_grid, &
3051  typekind=esmf_typekind_r8, &
3052  name='xu',&
3053  staggerloc=esmf_staggerloc_center, rc=rc)
3054  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3055  call error_handler("IN FieldCreate", rc)
3056 
3057  print*,"- CALL FieldCreate FOR TARGET GRID XV."
3058  xv_target_grid = esmf_fieldcreate(target_grid, &
3059  typekind=esmf_typekind_r8, &
3060  name='xv',&
3061  staggerloc=esmf_staggerloc_center, rc=rc)
3062  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3063  call error_handler("IN FieldCreate", rc)
3064 
3065  print*,"- CALL FieldCreate FOR TARGET GRID XZ."
3066  xz_target_grid = esmf_fieldcreate(target_grid, &
3067  typekind=esmf_typekind_r8, &
3068  name='xz',&
3069  staggerloc=esmf_staggerloc_center, rc=rc)
3070  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3071  call error_handler("IN FieldCreate", rc)
3072 
3073  print*,"- CALL FieldCreate FOR TARGET GRID XTTS."
3074  xtts_target_grid = esmf_fieldcreate(target_grid, &
3075  typekind=esmf_typekind_r8, &
3076  name='xtts',&
3077  staggerloc=esmf_staggerloc_center, rc=rc)
3078  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3079  call error_handler("IN FieldCreate", rc)
3080 
3081  print*,"- CALL FieldCreate FOR TARGET GRID XZTS."
3082  xzts_target_grid = esmf_fieldcreate(target_grid, &
3083  typekind=esmf_typekind_r8, &
3084  name='xzts',&
3085  staggerloc=esmf_staggerloc_center, rc=rc)
3086  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3087  call error_handler("IN FieldCreate", rc)
3088 
3089  print*,"- CALL FieldCreate FOR TARGET GRID Z_C."
3090  z_c_target_grid = esmf_fieldcreate(target_grid, &
3091  typekind=esmf_typekind_r8, &
3092  name='z_c',&
3093  staggerloc=esmf_staggerloc_center, rc=rc)
3094  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3095  call error_handler("IN FieldCreate", rc)
3096 
3097  print*,"- CALL FieldCreate FOR TARGET GRID ZM."
3098  zm_target_grid = esmf_fieldcreate(target_grid, &
3099  typekind=esmf_typekind_r8, &
3100  name='zm',&
3101  staggerloc=esmf_staggerloc_center, rc=rc)
3102  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3103  call error_handler("IN FieldCreate", rc)
3104 
3105  end subroutine create_nst_esmf_fields
3106 
3115  subroutine ij_to_i_j(ij, itile, jtile, i, j)
3116 
3117  implicit none
3118 
3119  integer(esmf_kind_i4), intent(in) :: ij
3120  integer , intent(in) :: itile, jtile
3121 
3122  integer , intent(out) :: i, j
3123 
3124  integer :: tile_num
3125  integer :: pt_loc_this_tile
3126 
3127  tile_num = ((ij-1) / (itile*jtile)) ! tile number minus 1
3128  pt_loc_this_tile = ij - (tile_num * itile * jtile)
3129  ! "ij" location of point within tile.
3130 
3131  j = (pt_loc_this_tile - 1) / itile + 1
3132  i = mod(pt_loc_this_tile, itile)
3133 
3134  if (i==0) i = itile
3135 
3136  return
3137 
3138  end subroutine ij_to_i_j
3139 
3150  subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero, &
3151  unmapped_ptr,resetifd)
3152 
3153  use esmf
3154  use program_setup, only : convert_nst
3155  use model_grid, only : i_target, j_target
3156 
3157  implicit none
3158 
3159  integer, intent(in) :: num_field
3160  type(esmf_routehandle), intent(inout) :: route
3161  type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post
3162  logical, intent(in) :: dozero(num_field)
3163  logical, intent(in), optional :: resetifd
3164  integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:)
3165 
3166  type(esmf_field) :: field_pre,field_post
3167  real(esmf_kind_r8), pointer :: tmp_ptr(:,:)
3168  type(realptr_2d),allocatable :: ptr_2d(:)
3169  type(realptr_3d),allocatable :: ptr_3d(:)
3170  logical :: is2d(num_field)
3171  character(len=50) :: fname
3172  integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet, l(1), u(1)
3173  type(esmf_vm) :: vm
3174 
3175  ind_2d = 0
3176  ind_3d = 0
3177 
3178  if(present(unmapped_ptr)) then
3179  l = lbound(unmapped_ptr)
3180  u = ubound(unmapped_ptr)
3181  endif
3182 
3183  do i = 1, num_field
3184  call esmf_fieldbundleget(bundle_pre,i,field_pre,rc=rc)
3185  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3186  call error_handler("IN FieldBundleGet", rc)
3187 
3188  call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3189  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3190  call error_handler("IN FieldBundleGet", rc)
3191 
3192  call esmf_fieldget(field_post,dimcount=ndims,name=fname,rc=rc)
3193  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3194  call error_handler("IN FieldGet", rc)
3195 
3196  call esmf_vmgetglobal(vm, rc=rc)
3197  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3198  call error_handler("IN VMGetGlobal", rc)
3199  call esmf_vmget(vm, localpet=localpet, rc=rc)
3200  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3201  call error_handler("IN VMGet", rc)
3202  if(localpet==0) print*, "in regrid_many fname = ", fname, ndims
3203  if (ndims == 2) is2d(i) = .true.
3204  if (ndims == 3) is2d(i) = .false.
3205 
3206  if (dozero(i)) then
3207  call esmf_fieldregrid(field_pre, &
3208  field_post, &
3209  routehandle=route, &
3210  termorderflag=esmf_termorder_srcseq, rc=rc)
3211  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3212  call error_handler("IN FieldRegrid", rc)
3213  else
3214  call esmf_fieldregrid(field_pre, &
3215  field_post, &
3216  routehandle=route, &
3217  zeroregion=esmf_region_select, &
3218  termorderflag=esmf_termorder_srcseq, rc=rc)
3219  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3220  call error_handler("IN FieldRegrid", rc)
3221  endif
3222  enddo
3223 
3224  if (present(resetifd)) then
3225  if( resetifd .and. convert_nst) then
3226  call esmf_fieldget(ifd_target_grid,farrayptr=tmp_ptr,rc=rc)
3227  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3228  call error_handler("IN FieldGet", rc)
3229  tmp_ptr = float(nint(tmp_ptr))
3230  endif
3231  endif
3232 
3233  n2d = count(is2d(:))
3234  n3d = count(.not.is2d(:))
3235  if(localpet==0) print*, is2d(:)
3236  if (present(unmapped_ptr)) then
3237  allocate(ptr_2d(n2d))
3238  if (n3d .ne. 0) allocate(ptr_3d(n3d))
3239  do i=1, num_field
3240  if (is2d(i)) then
3241  ind_2d = ind_2d + 1
3242  call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3243  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3244  call error_handler("IN FieldBundleGet", rc)
3245  call esmf_fieldget(field_post, farrayptr=ptr_2d(ind_2d)%p, rc=rc)
3246  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3247  call error_handler("IN FieldGet", rc)
3248  call esmf_fieldget(field_post,name=fname,rc=rc)
3249  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3250  call error_handler("IN FieldGet", rc)
3251  if (localpet==0) print*, "in doreplace loop, 2d field = ", trim(fname)
3252  else
3253  ind_3d = ind_3d + 1
3254  call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3255  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3256  call error_handler("IN FieldBundleGet", rc)
3257  call esmf_fieldget(field_post,name=fname,rc=rc)
3258  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3259  call error_handler("IN FieldGet", rc)
3260  if (localpet==0) print*, "in doreplace loop, 3d field = ", trim(fname)
3261  call esmf_fieldget(field_post, farrayptr=ptr_3d(ind_3d)%p, rc=rc)
3262  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3263  call error_handler("IN FieldGet", rc)
3264  endif
3265  end do
3266 
3267  do ij = l(1), u(1)
3268  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
3269  do k = 1,n2d
3270  ptr_2d(k)%p(i,j) = -9999.9
3271  enddo
3272  do k = 1,n3d
3273  ptr_3d(k)%p(i,j,:) = -9999.9
3274  enddo
3275  enddo
3276  deallocate(ptr_2d)
3277  if(n3d .ne. 0) deallocate(ptr_3d)
3278  endif
3279  end subroutine regrid_many
3280 
3296  subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, &
3297  search_nums,localpet,latitude,terrain_land,soilt_climo,&
3298  field_data_3d)
3299 
3300  use model_grid, only : i_target,j_target, lsoil_target
3301  use program_setup, only : external_model, input_type
3302  use search_util
3303 
3304  implicit none
3305 
3306  integer, intent(in) :: num_field
3307  type(esmf_fieldbundle), intent(inout) :: bundle_target
3308  real(esmf_kind_r8), intent(inout) :: field_data_2d(i_target,j_target)
3309  real(esmf_kind_r8), intent(inout), optional :: field_data_3d(i_target,j_target,lsoil_target)
3310  real(esmf_kind_r8), intent(inout), optional :: latitude(i_target,j_target)
3311  real(esmf_kind_r8), intent(inout), optional :: terrain_land(i_target,j_target)
3312  real(esmf_kind_r8), intent(inout), optional :: soilt_climo(i_target,j_target)
3313  integer(esmf_kind_i8), intent(inout) :: mask(i_target,j_target)
3314 
3315 
3316  integer, intent(in) :: tile,localpet
3317  integer, intent(inout) :: search_nums(num_field)
3318 
3319  type(esmf_field) :: temp_field
3320  character(len=50) :: fname
3321  integer, parameter :: sotyp_land_field_num = 224
3322  integer, parameter :: sst_field_num = 11
3323  integer, parameter :: terrain_field_num= 7
3324  integer :: j,k, rc, ndims
3325 
3326  do k = 1,num_field
3327  call esmf_fieldbundleget(bundle_target,k,temp_field, rc=rc)
3328  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3329  call error_handler("IN FieldGet", rc)
3330  call esmf_fieldget(temp_field, name=fname, dimcount=ndims,rc=rc)
3331  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3332  call error_handler("IN FieldGet", rc)
3333  if (ndims .eq. 2) then
3334  print*, "processing 2d field ", trim(fname)
3335  print*, "FieldGather"
3336  call esmf_fieldgather(temp_field,field_data_2d,rootpet=0,tile=tile, rc=rc)
3337  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3338  call error_handler("IN FieldGather", rc)
3339  if (localpet == 0) then
3340  if (present(latitude) .and. search_nums(k).eq.sst_field_num) then
3341  ! Sea surface temperatures; pass latitude field to search
3342  print*, "search1"
3343  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude)
3344  elseif (present(terrain_land) .and. search_nums(k) .eq. terrain_field_num) then
3345  ! Terrain height; pass optional climo terrain array to search
3346  print*, "search2"
3347  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land)
3348  elseif (search_nums(k) .eq. sotyp_land_field_num) then
3349  ! Soil type over land
3350  if (fname .eq. "soil_type_target_grid") then
3351  ! Soil type over land when interpolating input data to target grid
3352  ! *with* the intention of retaining interpolated data in output
3353  print*, "search3"
3354  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo)
3355  elseif (present(soilt_climo)) then
3356  if (maxval(field_data_2d) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then
3357  ! Soil type over land when interpolating input data to target grid
3358  ! *without* the intention of retaining data in output file
3359  print*, "search4"
3360  call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k))
3361  else
3362  ! If no soil type field exists in input data (e.g., GFS grib2) then don't search
3363  ! but simply set data to the climo field. This may result in
3364  ! somewhat inaccurate soil moistures as no scaling will occur
3365  print*, "search5"
3366  field_data_2d = soilt_climo
3367  endif !check field value
3368  endif !sotype from target grid
3369  else
3370  ! Any field that doesn't require any of the special treatments or
3371  ! passing of additional variables as in those above
3372  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k))
3373  endif !if present
3374  endif !localpet
3375  call esmf_fieldscatter(temp_field, field_data_2d, rootpet=0, tile=tile,rc=rc)
3376  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3377  call error_handler("IN FieldScatter", rc)
3378  else
3379  ! Process 3d fields soil temperature, moisture, and liquid
3380  print*, "FieldGather"
3381  call esmf_fieldgather(temp_field,field_data_3d,rootpet=0,tile=tile,rc=rc)
3382  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3383  call error_handler("IN FieldGather", rc)
3384  print*, "processing 3d field ", trim(fname)
3385  if (localpet==0) then
3386  do j = 1, lsoil_target
3387  field_data_2d = field_data_3d(:,:,j)
3388  call search(field_data_2d, mask, i_target, j_target, tile, 21)
3389  field_data_3d(:,:,j) = field_data_2d
3390  enddo
3391  endif
3392  call esmf_fieldscatter(temp_field, field_data_3d, rootpet=0, tile=tile,rc=rc)
3393  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3394  call error_handler("IN FieldScatter", rc)
3395  endif !ndims
3396  end do !fields
3397 
3398  end subroutine search_many
3399 
3404  subroutine cleanup_all_target_sfc_data
3405 
3406  use surface_target_data, only : cleanup_target_sfc_data
3407 
3408  implicit none
3409 
3410  integer :: rc
3411 
3412  print*,"- DESTROY LOCAL TARGET GRID SURFACE FIELDS."
3413 
3414  call esmf_fielddestroy(terrain_from_input_grid, rc=rc)
3415  call esmf_fielddestroy(terrain_from_input_grid_land, rc=rc)
3416  call esmf_fielddestroy(soil_type_from_input_grid, rc=rc)
3417 
3418  call cleanup_target_sfc_data
3419 
3420  end subroutine cleanup_all_target_sfc_data
3421 
3422  end module surface
input_data::cleanup_input_sfc_data
subroutine, public cleanup_input_sfc_data
Free up memory associated with sfc data.
Definition: input_data.F90:7345
program_setup::calc_soil_params_driver
subroutine, public calc_soil_params_driver(localpet)
Driver routine to compute soil parameters for each soil type.
Definition: program_setup.F90:515
surface::qc_check
subroutine qc_check
Perform some quality control checks before output.
Definition: surface.F90:2177
write_data::write_fv3_sfc_data_netcdf
subroutine, public write_fv3_sfc_data_netcdf(localpet)
Writes surface and nst data into a &#39;coldstart&#39; file (netcdf).
Definition: write_data.F90:1806
write_data
Definition: write_data.F90:1
static_data::get_static_fields
subroutine, public get_static_fields(localpet)
Driver routine to read/time interpolate static/climo fields on the fv3 target grid.
Definition: static_data.F90:47
surface::realptr_2d
Definition: surface.F90:79
surface::interp
subroutine, public interp(localpet)
Horizontally interpolate surface fields from input to target FV3 grid using esmf routines.
Definition: surface.F90:243
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
surface::cleanup_all_target_sfc_data
subroutine cleanup_all_target_sfc_data
Free up memory once the target grid surface fields are no longer needed.
Definition: surface.F90:3404
surface
Process surface and nst fields.
Definition: surface.F90:21
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
surface_target_data::cleanup_target_sfc_data
subroutine, public cleanup_target_sfc_data
Free up memory once the target grid surface fields are no longer needed.
Definition: surface_target_data.F90:111
model_grid
Sets up the ESMF grid objects for the input data grid and target FV3 grid.
Definition: model_grid.F90:9
surface_target_data::cleanup_target_nst_data
subroutine, public cleanup_target_nst_data
Free up memory once the target grid nst fields are no longer needed.
Definition: surface_target_data.F90:144
input_data
Read atmospheric, surface and nst data on the input grid.
Definition: input_data.F90:14
static_data::cleanup_static_fields
subroutine, public cleanup_static_fields
Free up memory for fields in this module.
Definition: static_data.F90:507
search_util
Replace undefined values with a valid value.
Definition: search_util.F90:15
surface::realptr_3d
Definition: surface.F90:84
surface::regrid_many
subroutine, public regrid_many(bundle_pre, bundle_post, num_field, route, dozero, unmapped_ptr, resetifd)
Regrid multiple ESMF fields from input to target grid.
Definition: surface.F90:3150
surface_target_data
Module to hold ESMF fields associated with the target grid surface data.
Definition: surface_target_data.F90:9
surface::rescale_soil_moisture
subroutine rescale_soil_moisture
Adjust soil moisture for changes in soil type between the input and target grids. ...
Definition: surface.F90:1763
surface::adjust_soil_levels
subroutine adjust_soil_levels(localpet)
Adjust soil levels of the input grid if there is a mismatch between input and target grids...
Definition: surface.F90:2007
error_handler
subroutine error_handler(string, rc)
General error handler.
Definition: utils.F90:9
surface::create_nst_esmf_fields
subroutine, public create_nst_esmf_fields
Create ESMF fields for the target grid nst variables.
Definition: surface.F90:2953
program_setup
This module contains code to read the setup namelist file, handle the varmap file for GRIB2 data...
Definition: program_setup.F90:9
surface::frh2o
real function frh2o(TKELV, SMC, SH2O, SMCMAX, BEXP, PSIS)
Calculate supercooled soil moisture.
Definition: surface.F90:1625
surface::ij_to_i_j
subroutine ij_to_i_j(ij, itile, jtile, i, j)
Convert 1d index to 2d indices.
Definition: surface.F90:3115
input_data::cleanup_input_nst_data
subroutine, public cleanup_input_nst_data
Free up memory associated with nst data.
Definition: input_data.F90:7312
surface::adjust_soilt_for_terrain
subroutine adjust_soilt_for_terrain
Adjust soil temperature for changes in terrain height between the input and target grids...
Definition: surface.F90:1931
surface::roughness
subroutine roughness
Set roughness length at land and sea ice.
Definition: surface.F90:2123
surface::search_many
subroutine, public search_many(num_field, bundle_target, field_data_2d, mask, tile, search_nums, localpet, latitude, terrain_land, soilt_climo, field_data_3d)
Execute the search function for multple fields.
Definition: surface.F90:3296
static_data
Reads static surface climatological data for the target FV3 grid (such as soil type and vegetation ty...
Definition: static_data.F90:13
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
surface::calc_liq_soil_moisture
subroutine calc_liq_soil_moisture
Compute liquid portion of the total soil moisture.
Definition: surface.F90:1481
surface::create_surface_esmf_fields
subroutine, public create_surface_esmf_fields
Create ESMF fields for the target grid surface variables.
Definition: surface.F90:2595
surface::nst_land_fill
subroutine, public nst_land_fill
nst is not active at land or sea ice points.
Definition: surface.F90:2512
surface::surface_driver
subroutine, public surface_driver(localpet)
Driver routine to process surface/nst data.
Definition: surface.F90:105