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