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