chgres_cube  1.9.0
•All Data Structures Namespaces Files Functions Variables Pages
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
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  endif
855 
856 
857  call search_many(num_fields,bundle_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, &
858  field_data_3d=data_one_tile_3d)
859  enddo
860 
861  deallocate(search_nums)
862  call esmf_fieldbundledestroy(bundle_seaice_target,rc=rc)
863  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
864  call error_handler("IN FieldBundleDestroy", rc)
865 
866  print*,"- CALL FieldRegridRelease."
867  call esmf_fieldregridrelease(routehandle=regrid_seaice, rc=rc)
868  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
869  call error_handler("IN FieldRegridRelease", rc)
870 
871 !---------------------------------------------------------------------------------------------
872 ! Now interpolate water fields.
873 !---------------------------------------------------------------------------------------------
874 
875  mask_input_ptr = 0
876  where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1
877 
878  mask_target_ptr = 0
879  where (landmask_target_ptr == 0) mask_target_ptr = 1
880 
881  method=esmf_regridmethod_conserve
882  isrctermprocessing = 1
883 
884  print*,"- CALL FieldRegridStore for water fields."
885  call esmf_fieldregridstore(skin_temp_input_grid, &
886  skin_temp_target_grid, &
887  srcmaskvalues=(/0/), &
888  dstmaskvalues=(/0/), &
889  polemethod=esmf_polemethod_none, &
890  srctermprocessing=isrctermprocessing, &
891  unmappedaction=esmf_unmappedaction_ignore, &
892  normtype=esmf_normtype_fracarea, &
893  routehandle=regrid_water, &
894  regridmethod=method, &
895  unmappeddstlist=unmapped_ptr, rc=rc)
896  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
897  call error_handler("IN FieldRegridStore", rc)
898 
899  bundle_water_target = esmf_fieldbundlecreate(name="water target", rc=rc)
900  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
901  call error_handler("IN FieldBundleCreate", rc)
902  bundle_water_input = esmf_fieldbundlecreate(name="water input", rc=rc)
903  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
904  call error_handler("IN FieldBundleCreate", rc)
905  call esmf_fieldbundleadd(bundle_water_target, (/skin_temp_target_grid, z0_target_grid/), rc=rc)
906  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
907  call error_handler("IN FieldBundleAdd", rc)
908  call esmf_fieldbundleadd(bundle_water_input, (/skin_temp_input_grid, z0_input_grid/), rc=rc)
909  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
910  call error_handler("IN FieldBundleAdd", rc)
911 
912  if (convert_nst) then
913 
914  call esmf_fieldbundleadd(bundle_water_target, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, &
915  dt_cool_target_grid,ifd_target_grid,qrain_target_grid,tref_target_grid, &
916  w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,xu_target_grid, &
917  xv_target_grid,xz_target_grid,xtts_target_grid,xzts_target_grid, &
918  z_c_target_grid,zm_target_grid/), rc=rc)
919  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
920  call error_handler("IN FieldBundleAdd", rc)
921 
922  call esmf_fieldbundleadd(bundle_water_input, (/c_d_input_grid,c_0_input_grid,d_conv_input_grid, &
923  dt_cool_input_grid,ifd_input_grid,qrain_input_grid,tref_input_grid, &
924  w_d_input_grid,w_0_input_grid,xs_input_grid,xt_input_grid,xu_input_grid, &
925  xv_input_grid,xz_input_grid,xtts_input_grid,xzts_input_grid, &
926  z_c_input_grid,zm_input_grid/), rc=rc)
927  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
928  call error_handler("IN FieldBundleAdd", rc)
929  call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
930  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
931  call error_handler("IN FieldBundleGet", rc)
932 
933  allocate(search_nums(num_fields))
934  allocate(dozero(num_fields))
935 
936  search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/)
937  dozero(:) = .true.
938 
939  else
940  call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
941  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
942  call error_handler("IN FieldBundleGet", rc)
943 
944  allocate(search_nums(num_fields))
945  allocate(dozero(num_fields))
946  search_nums(:)=(/11,83/)
947  dozero(:) = .true.
948  endif
949 
950  call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, &
951  unmapped_ptr=unmapped_ptr, resetifd=.true.)
952  deallocate(dozero)
953  call esmf_fieldbundledestroy(bundle_water_input,rc=rc)
954  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
955  call error_handler("IN FieldBundleDestroy", rc)
956 
957 
958  if (localpet == 0) then
959  allocate(latitude_one_tile(i_target,j_target))
960  else
961  allocate(latitude_one_tile(0,0))
962  endif
963 
964  do tile = 1, num_tiles_target_grid
965 
966  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
967  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
968  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
969  call error_handler("IN FieldGather", rc)
970 
971  print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile
972  call esmf_fieldgather(latitude_target_grid, latitude_one_tile, rootpet=0, tile=tile, rc=rc)
973  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
974  call error_handler("IN FieldGather", rc)
975 
976  if (localpet == 0) then
977  allocate(water_target_one_tile(i_target,j_target))
978  water_target_one_tile = 0
979  where(mask_target_one_tile == 0) water_target_one_tile = 1
980  endif
981 
982  call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,&
983  tile,search_nums,localpet,latitude=latitude_one_tile)
984 
985  if (localpet == 0) deallocate(water_target_one_tile)
986 
987  enddo
988 
989  deallocate(latitude_one_tile,search_nums)
990 
991  call esmf_fieldbundledestroy(bundle_water_target,rc=rc)
992  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
993  call error_handler("IN FieldBundleDestroy", rc)
994 
995  print*,"- CALL FieldRegridRelease."
996  call esmf_fieldregridrelease(routehandle=regrid_water, rc=rc)
997  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
998  call error_handler("IN FieldRegridRelease", rc)
999 
1000 !---------------------------------------------------------------------------------------------
1001 ! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice.
1002 !---------------------------------------------------------------------------------------------
1003 
1004  mask_input_ptr = 0
1005  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
1006 
1007  mask_target_ptr = 0
1008  where (landmask_target_ptr == 1) mask_target_ptr = 1
1009 
1010  method=esmf_regridmethod_conserve
1011  isrctermprocessing = 1
1012 
1013  print*,"- CALL FieldRegridStore for land fields."
1014  call esmf_fieldregridstore(snow_depth_input_grid, &
1015  snow_depth_target_grid, &
1016  srcmaskvalues=(/0/), &
1017  dstmaskvalues=(/0/), &
1018  polemethod=esmf_polemethod_none, &
1019  srctermprocessing=isrctermprocessing, &
1020  unmappedaction=esmf_unmappedaction_ignore, &
1021  normtype=esmf_normtype_fracarea, &
1022  routehandle=regrid_all_land, &
1023  regridmethod=method, &
1024  unmappeddstlist=unmapped_ptr, rc=rc)
1025  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1026  call error_handler("IN FieldRegridStore", rc)
1027 
1028  bundle_allland_target = esmf_fieldbundlecreate(name="all land target", rc=rc)
1029  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1030  call error_handler("IN FieldBundleCreate", rc)
1031  bundle_allland_input = esmf_fieldbundlecreate(name="all land input", rc=rc)
1032  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1033  call error_handler("IN FieldBundleCreate", rc)
1034  call esmf_fieldbundleadd(bundle_allland_target, (/canopy_mc_target_grid, snow_depth_target_grid, &
1035  snow_liq_equiv_target_grid/), rc=rc)
1036  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1037  call error_handler("IN FieldBundleAdd", rc)
1038  call esmf_fieldbundleadd(bundle_allland_input, (/canopy_mc_input_grid, snow_depth_input_grid, &
1039  snow_liq_equiv_input_grid/), rc=rc)
1040  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1041  call error_handler("IN FieldBundleAdd", rc)
1042  call esmf_fieldbundleget(bundle_allland_target,fieldcount=num_fields,rc=rc)
1043  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1044  call error_handler("IN FieldBundleGet", rc)
1045 
1046  allocate(search_nums(num_fields))
1047  allocate(dozero(num_fields))
1048 
1049  search_nums = (/223,66,65/)
1050  dozero=(/.true.,.false.,.false./)
1051 
1052  call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, &
1053  unmapped_ptr=unmapped_ptr)
1054  deallocate(dozero)
1055  call esmf_fieldbundledestroy(bundle_allland_input,rc=rc)
1056  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1057  call error_handler("IN FieldBundleDestroy", rc)
1058 
1059 
1060  do tile = 1, num_tiles_target_grid
1061 
1062  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1063  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
1064  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1065  call error_handler("IN FieldGather", rc)
1066 
1067  if (localpet == 0) then
1068  allocate(land_target_one_tile(i_target,j_target))
1069  land_target_one_tile = 0
1070  where(mask_target_one_tile == 1) land_target_one_tile = 1
1071  endif
1072 
1073  call search_many(num_fields,bundle_allland_target,data_one_tile, land_target_one_tile,&
1074  tile,search_nums,localpet)
1075 
1076  if (localpet == 0) deallocate(land_target_one_tile)
1077  enddo
1078 
1079  deallocate(search_nums)
1080  call esmf_fieldbundledestroy(bundle_allland_target,rc=rc)
1081  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1082  call error_handler("IN FieldBundleDestroy", rc)
1083 
1084  print*,"- CALL FieldRegridRelease."
1085  call esmf_fieldregridrelease(routehandle=regrid_all_land, rc=rc)
1086  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1087  call error_handler("IN FieldRegridRelease", rc)
1088 
1089 !---------------------------------------------------------------------------------------------
1090 ! Now interpolate landice points to landice points.
1091 !---------------------------------------------------------------------------------------------
1092 
1093  print*,"- CALL FieldGet FOR INPUT GRID VEG TYPE."
1094  call esmf_fieldget(veg_type_input_grid, &
1095  farrayptr=veg_type_input_ptr, rc=rc)
1096  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1097  call error_handler("IN FieldGet", rc)
1098 
1099  print*,'land ice check ',veg_type_landice_input
1100 
1101  mask_input_ptr = 0
1102  where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 1
1103 
1104  print*,"- CALL FieldGet FOR TARGET GRID VEG TYPE."
1105  call esmf_fieldget(veg_type_target_grid, &
1106  farrayptr=veg_type_target_ptr, rc=rc)
1107  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1108  call error_handler("IN FieldGet", rc)
1109 
1110  mask_target_ptr = 0
1111  where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 1
1112 
1113  method=esmf_regridmethod_nearest_stod
1114  isrctermprocessing = 1
1115 
1116  print*,"- CALL FieldRegridStore for landice fields."
1117  call esmf_fieldregridstore(soil_temp_input_grid, &
1118  soil_temp_target_grid, &
1119  srcmaskvalues=(/0/), &
1120  dstmaskvalues=(/0/), &
1121  polemethod=esmf_polemethod_none, &
1122  srctermprocessing=isrctermprocessing, &
1123  unmappedaction=esmf_unmappedaction_ignore, &
1124  normtype=esmf_normtype_fracarea, &
1125  routehandle=regrid_landice, &
1126  regridmethod=method, &
1127  unmappeddstlist=unmapped_ptr, rc=rc)
1128  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1129  call error_handler("IN FieldRegridStore", rc)
1130 
1131  bundle_landice_target = esmf_fieldbundlecreate(name="landice target", rc=rc)
1132  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1133  call error_handler("IN FieldBundleCreate", rc)
1134  bundle_landice_input = esmf_fieldbundlecreate(name="landice input", rc=rc)
1135  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1136  call error_handler("IN FieldBundleCreate", rc)
1137  call esmf_fieldbundleadd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid,&
1138  soil_temp_target_grid/), rc=rc)
1139  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1140  call error_handler("IN FieldBundleAdd", rc)
1141  call esmf_fieldbundleadd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid,&
1142  soil_temp_input_grid/), rc=rc)
1143  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1144  call error_handler("IN FieldBundleAdd", rc)
1145 
1146  if (.not. sotyp_from_climo) then
1147  call esmf_fieldbundleadd(bundle_landice_input, (/soil_type_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  call esmf_fieldbundleadd(bundle_landice_target,(/soil_type_target_grid/),rc=rc)
1151  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1152  call error_handler("IN FieldBundleAdd", rc)
1153  endif
1154 
1155  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1156  call error_handler("IN FieldBundleAdd", rc)
1157  call esmf_fieldbundleget(bundle_landice_target,fieldcount=num_fields,rc=rc)
1158  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1159  call error_handler("IN FieldBundleGet", rc)
1160 
1161  allocate(search_nums(num_fields))
1162  allocate(dozero(num_fields))
1163 
1164  if (sotyp_from_climo) then
1165  search_nums = (/21,7,21/)
1166  dozero(:)=.false.
1167  else
1168  search_nums = (/21,7,21,231/)
1169  dozero(:)=(/.false.,.false.,.false.,.true./)
1170  endif
1171 
1172  call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, &
1173  unmapped_ptr=unmapped_ptr )
1174  deallocate(dozero)
1175  call esmf_fieldbundledestroy(bundle_landice_input,rc=rc)
1176  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1177  call error_handler("IN FieldBundleDestroy", rc)
1178 
1179  if (localpet == 0) then
1180  allocate (veg_type_target_one_tile(i_target,j_target))
1181  allocate (land_target_one_tile(i_target,j_target))
1182  allocate (data_one_tile2(i_target,j_target))
1183  else
1184  allocate (veg_type_target_one_tile(0,0))
1185  allocate (land_target_one_tile(0,0))
1186  allocate (data_one_tile2(0,0))
1187  endif
1188 
1189  do tile = 1, num_tiles_target_grid
1190  print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1191  call esmf_fieldgather(veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1192  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1193  call error_handler("IN FieldGather", rc)
1194 
1195  if (localpet == 0) then
1196  land_target_one_tile = 0
1197  where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1
1198  endif
1199 
1200  print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile
1201  call esmf_fieldgather(terrain_from_input_grid_land, data_one_tile2, rootpet=0, tile=tile, rc=rc)
1202  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1203  call error_handler("IN FieldGather", rc)
1204 
1205  call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,&
1206  tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d)
1207  enddo
1208 
1209  deallocate (veg_type_target_one_tile)
1210  deallocate (land_target_one_tile)
1211  deallocate(search_nums)
1212 
1213  call esmf_fieldbundledestroy(bundle_landice_target,rc=rc)
1214  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1215  call error_handler("IN FieldBundleDestroy", rc)
1216 
1217  print*,"- CALL FieldRegridRelease."
1218  call esmf_fieldregridrelease(routehandle=regrid_landice, rc=rc)
1219  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1220  call error_handler("IN FieldRegridRelease", rc)
1221 
1222 !---------------------------------------------------------------------------------------------
1223 ! Now interpolate land (not including landice pts) to land (not including landice).
1224 !---------------------------------------------------------------------------------------------
1225 
1226  mask_input_ptr = 0
1227  where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
1228  where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0
1229 
1230  mask_target_ptr = 0
1231  where (landmask_target_ptr == 1) mask_target_ptr = 1
1232  where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0
1233 
1234  method=esmf_regridmethod_nearest_stod
1235  isrctermprocessing = 1
1236 
1237  print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields."
1238  call esmf_fieldregridstore(soilm_tot_input_grid, &
1239  soilm_tot_target_grid, &
1240  srcmaskvalues=(/0/), &
1241  dstmaskvalues=(/0/), &
1242  polemethod=esmf_polemethod_none, &
1243  srctermprocessing=isrctermprocessing, &
1244  unmappedaction=esmf_unmappedaction_ignore, &
1245  normtype=esmf_normtype_fracarea, &
1246  routehandle=regrid_land, &
1247  regridmethod=method, &
1248  unmappeddstlist=unmapped_ptr, rc=rc)
1249  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1250  call error_handler("IN FieldRegridStore", rc)
1251 
1252  bundle_nolandice_target = esmf_fieldbundlecreate(name="land no landice target", rc=rc)
1253  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1254  call error_handler("IN FieldBundleCreate", rc)
1255 
1256  bundle_nolandice_input = esmf_fieldbundlecreate(name="land no landice input", rc=rc)
1257  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1258  call error_handler("IN FieldBundleCreate", rc)
1259 
1260  call esmf_fieldbundleadd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid,&
1261  soil_type_from_input_grid,soilm_tot_target_grid,soil_temp_target_grid/), rc=rc)
1262  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1263  call error_handler("IN FieldBundleAdd", rc)
1264 
1265  call esmf_fieldbundleadd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid,&
1266  soil_type_input_grid,soilm_tot_input_grid,soil_temp_input_grid/), rc=rc)
1267  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1268  call error_handler("IN FieldBundleAdd", rc)
1269 
1270 
1271  if (.not. sotyp_from_climo) then
1272 ! call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc)
1273 ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) &
1274 ! call error_handler("IN FieldBundleAdd", rc)
1275 ! call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_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  print*,"- CALL Field_Regrid ."
1279  call esmf_fieldregrid(soil_type_input_grid, &
1280  soil_type_target_grid, &
1281  routehandle=regrid_land, &
1282  zeroregion=esmf_region_select, &
1283  termorderflag=esmf_termorder_srcseq, rc=rc)
1284  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1285  call error_handler("IN FieldRegrid", rc)
1286 
1287  call esmf_fieldget(soil_type_target_grid, &
1288  farrayptr=soil_type_target_ptr, rc=rc)
1289  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1290  call error_handler("IN FieldGet", rc)
1291 
1292  l = lbound(unmapped_ptr)
1293  u = ubound(unmapped_ptr)
1294 
1295  do ij = l(1), u(1)
1296  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
1297  soil_type_target_ptr(i,j) = -9999.9
1298  enddo
1299  ! call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc)
1300  ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) &
1301  ! call error_handler("IN FieldBundleGet", rc)
1302  ! sotyp_ind = 3
1303  endif
1304 
1305  if (.not. vgfrc_from_climo) then
1306  call esmf_fieldbundleadd(bundle_nolandice_target, (/veg_greenness_target_grid/), rc=rc)
1307  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1308  call error_handler("IN FieldBundleAdd", rc)
1309  call esmf_fieldbundleadd(bundle_nolandice_input, (/veg_greenness_input_grid/), rc=rc)
1310  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1311  call error_handler("IN FieldBundleAdd", rc)
1312  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1313  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1314  call error_handler("IN FieldBundleGet", rc)
1315  vgfrc_ind = num_fields
1316  endif
1317 
1318  if (.not. lai_from_climo) then
1319  call esmf_fieldbundleadd(bundle_nolandice_target, (/lai_target_grid/), rc=rc)
1320  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1321  call error_handler("IN FieldBundleAdd", rc)
1322  call esmf_fieldbundleadd(bundle_nolandice_input, (/lai_input_grid/), rc=rc)
1323  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1324  call error_handler("IN FieldBundleAdd", rc)
1325  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1326  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1327  call error_handler("IN FieldBundleGet", rc)
1328  lai_ind = num_fields
1329  endif
1330 
1331  if (.not. minmax_vgfrc_from_climo) then
1332  call esmf_fieldbundleadd(bundle_nolandice_target, (/max_veg_greenness_target_grid/), rc=rc)
1333  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1334  call error_handler("IN FieldBundleAdd", rc)
1335  call esmf_fieldbundleadd(bundle_nolandice_input, (/max_veg_greenness_input_grid/), rc=rc)
1336  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1337  call error_handler("IN FieldBundleAdd", rc)
1338 
1339  call esmf_fieldbundleadd(bundle_nolandice_target, (/min_veg_greenness_target_grid/), rc=rc)
1340  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1341  call error_handler("IN FieldBundleAdd", rc)
1342  call esmf_fieldbundleadd(bundle_nolandice_input, (/min_veg_greenness_input_grid/), rc=rc)
1343  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1344  call error_handler("IN FieldBundleAdd", rc)
1345 
1346  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1347  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1348  call error_handler("IN FieldBundleGet", rc)
1349 
1350  mmvg_ind = num_fields-1
1351  endif
1352 
1353  call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1354  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1355  call error_handler("IN FieldBundleGet", rc)
1356 
1357  allocate(search_nums(num_fields))
1358  allocate(dozero(num_fields))
1359 
1360  search_nums(1:5) = (/85,7,224,85,86/)
1361  dozero(1:5) = (/.false.,.false.,.true.,.true.,.false./)
1362 
1363  !if (.not.sotyp_from_climo) then
1364  ! search_nums(sotyp_ind) = 226
1365  ! dozero(sotyp_ind) = .False.
1366  !endif
1367 
1368  if (.not. vgfrc_from_climo) then
1369  search_nums(vgfrc_ind) = 224
1370  dozero(vgfrc_ind) = .true.
1371  endif
1372 
1373  if (.not. lai_from_climo) then
1374  search_nums(lai_ind) = 229
1375  dozero(lai_ind) = .true.
1376  endif
1377 
1378  if (.not. minmax_vgfrc_from_climo) then
1379  search_nums(mmvg_ind) = 227
1380  dozero(mmvg_ind) = .true.
1381 
1382  search_nums(mmvg_ind+1) = 228
1383  dozero(mmvg_ind+1) = .true.
1384  endif
1385 
1386  call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, &
1387  unmapped_ptr=unmapped_ptr)
1388  deallocate(dozero)
1389  call esmf_fieldbundledestroy(bundle_nolandice_input,rc=rc)
1390  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1391  call error_handler("IN FieldBundleDestroy", rc)
1392 
1393  if (localpet == 0) then
1394  allocate (veg_type_target_one_tile(i_target,j_target))
1395  else
1396  allocate (veg_type_target_one_tile(0,0))
1397  endif
1398 
1399  do tile = 1, num_tiles_target_grid
1400 
1401  print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1402  call esmf_fieldgather(landmask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
1403  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1404  call error_handler("IN FieldGather", rc)
1405 
1406  print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1407  call esmf_fieldgather(veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1408  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1409  call error_handler("IN FieldGather", rc)
1410 
1411  if (localpet == 0) then
1412  where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0
1413  endif
1414 
1415  print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile
1416  call esmf_fieldgather(soil_type_target_grid, data_one_tile2, 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  call search_many(num_fields,bundle_nolandice_target,data_one_tile, mask_target_one_tile,&
1421  tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d)
1422 
1423  print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile
1424  call esmf_fieldgather(soilm_tot_target_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
1425  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1426  call error_handler("IN FieldGather", rc)
1427 
1428  if (localpet == 0) then
1429  do j = 1, lsoil_target
1430  data_one_tile = data_one_tile_3d(:,:,j)
1431  call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 86)
1432  data_one_tile_3d(:,:,j) = data_one_tile
1433  enddo
1434  endif
1435 
1436  print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile
1437  call esmf_fieldgather(soil_temp_target_grid, data_one_tile_3d, rootpet=0, tile=tile, rc=rc)
1438  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1439  call error_handler("IN FieldGather", rc)
1440 
1441  if (tg3_from_soil) then
1442  print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE, TILE: ", tile
1443  call esmf_fieldscatter(substrate_temp_target_grid, data_one_tile_3d(:,:,lsoil_target), rootpet=0, tile=tile, rc=rc)
1444  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1445  call error_handler("IN FieldScatter", rc)
1446  endif
1447 
1448  if (.not. sotyp_from_climo) then
1449  print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile
1450  call esmf_fieldgather(soil_type_target_grid, data_one_tile,rootpet=0,tile=tile, rc=rc)
1451  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1452  call error_handler("IN FieldGather", rc)
1453 
1454  if (localpet == 0) then
1455  call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,226)
1456  endif
1457 
1458  print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile
1459  call esmf_fieldscatter(soil_type_target_grid,data_one_tile,rootpet=0,tile=tile,rc=rc)
1460  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1461  call error_handler("IN FieldScatter", rc)
1462  endif
1463 
1464  enddo
1465 
1466  deallocate(search_nums)
1467  call esmf_fieldbundledestroy(bundle_nolandice_target,rc=rc)
1468  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1469  call error_handler("IN FieldBundleDestroy", rc)
1470 
1471  print*,"- CALL FieldRegridRelease."
1472  call esmf_fieldregridrelease(routehandle=regrid_land, rc=rc)
1473  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1474  call error_handler("IN FieldRegridRelease", rc)
1475 
1476  deallocate(veg_type_target_one_tile)
1477 
1478  deallocate(data_one_tile, data_one_tile2)
1479  deallocate(data_one_tile_3d)
1480  deallocate(mask_target_one_tile)
1481 
1482  return
1483 
1484  end subroutine interp
1485 
1489  subroutine calc_liq_soil_moisture
1490 
1491  use esmf
1492 
1493  use model_grid, only : landmask_target_grid
1494 
1495  use program_setup, only : maxsmc_target, &
1496  bb_target, &
1497  satpsi_target
1498 
1499  use static_data, only : soil_type_target_grid, &
1500  veg_type_target_grid
1501 
1502  implicit none
1503 
1504  integer :: clb(3), cub(3), rc
1505  integer :: i, j, n, soil_type
1506 
1507  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1508 
1509  real :: bx, fk
1510  real(esmf_kind_r8), pointer :: soilm_liq_ptr(:,:,:)
1511  real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:)
1512  real(esmf_kind_r8), pointer :: soil_temp_ptr(:,:,:)
1513  real(esmf_kind_r8), pointer :: soil_type_ptr(:,:)
1514  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
1515 
1516  print*,"- COMPUTE LIQUID PORTION OF TOTAL SOIL MOISTURE."
1517 
1518  print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE."
1519  call esmf_fieldget(soilm_tot_target_grid, &
1520  computationallbound=clb, &
1521  computationalubound=cub, &
1522  farrayptr=soilm_tot_ptr, rc=rc)
1523  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1524  call error_handler("IN FieldGet", rc)
1525 
1526  print*,"- CALL FieldGet FOR LIQUID SOIL MOISTURE."
1527  call esmf_fieldget(soilm_liq_target_grid, &
1528  farrayptr=soilm_liq_ptr, rc=rc)
1529  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1530  call error_handler("IN FieldGet", rc)
1531 
1532  print*,"- CALL FieldGet FOR SOIL TEMPERATURE."
1533  call esmf_fieldget(soil_temp_target_grid, &
1534  farrayptr=soil_temp_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 VEGETATION TYPE."
1539  call esmf_fieldget(veg_type_target_grid, &
1540  farrayptr=veg_type_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 TYPE."
1545  call esmf_fieldget(soil_type_target_grid, &
1546  farrayptr=soil_type_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 LANDMASK."
1551  call esmf_fieldget(landmask_target_grid, &
1552  farrayptr=landmask_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  do j = clb(2), cub(2)
1557  do i = clb(1), cub(1)
1558 
1559 !---------------------------------------------------------------------------------------------
1560 ! Check land points that are not permanent land ice.
1561 !---------------------------------------------------------------------------------------------
1562 
1563  if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then
1564 
1565  soil_type = nint(soil_type_ptr(i,j))
1566 
1567  do n = clb(3), cub(3)
1568 
1569  if (soil_temp_ptr(i,j,n) < (frz_h2o-0.0001)) then
1570 
1571  bx = bb_target(soil_type)
1572 
1573  if (bx .gt. blim) bx = blim
1574 
1575  fk=(((hlice/(grav*(-satpsi_target(soil_type))))* &
1576  ((soil_temp_ptr(i,j,n)-frz_h2o)/soil_temp_ptr(i,j,n)))** &
1577  (-1/bx))*maxsmc_target(soil_type)
1578 
1579  if (fk .lt. 0.02) fk = 0.02
1580 
1581  soilm_liq_ptr(i,j,n) = min( fk, soilm_tot_ptr(i,j,n) )
1582 
1583 !-----------------------------------------------------------------------
1584 ! now use iterative solution for liquid soil water content using
1585 ! FUNCTION FRH2O with the initial guess for SH2O from above explicit
1586 ! first guess.
1587 !-----------------------------------------------------------------------
1588 
1589  soilm_liq_ptr(i,j,n) = frh2o(soil_temp_ptr(i,j,n), &
1590  soilm_tot_ptr(i,j,n), soilm_liq_ptr(i,j,n), &
1591  maxsmc_target(soil_type),bb_target(soil_type), &
1592  satpsi_target(soil_type))
1593 
1594  else ! temp above freezing. all moisture is liquid
1595 
1596  soilm_liq_ptr(i,j,n) = soilm_tot_ptr(i,j,n)
1597 
1598  end if ! is soil layer below freezing?
1599 
1600  enddo ! soil layer
1601 
1602  end if ! is this point land?
1603 
1604  enddo
1605  enddo
1606 
1607  end subroutine calc_liq_soil_moisture
1608 
1633  FUNCTION frh2o (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)
1634 
1635  use esmf
1636 
1637  IMPLICIT NONE
1638 
1639  INTEGER nlog
1640  INTEGER kcount
1641 
1642  REAL bexp
1643  REAL bx
1644  REAL denom
1645  REAL df
1646  REAL dswl
1647  REAL fk
1648  REAL frh2o
1649  REAL psis
1650  REAL(esmf_kind_r8) :: sh2o
1651  REAL(esmf_kind_r8) :: smc
1652  REAL smcmax
1653  REAL swl
1654  REAL swlk
1655  REAL(esmf_kind_r8) :: tkelv
1656 
1657  REAL, PARAMETER :: ck = 8.0
1658  REAL, PARAMETER :: error = 0.005
1659 
1660 ! ----------------------------------------------------------------------
1661 ! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM)
1662 ! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS
1663 ! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES.
1664 ! ----------------------------------------------------------------------
1665 
1666  bx = bexp
1667  IF (bexp .GT. blim) bx = blim
1668 
1669 ! ----------------------------------------------------------------------
1670 ! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.
1671 ! ----------------------------------------------------------------------
1672 
1673  nlog=0
1674  kcount=0
1675 
1676  IF (ck .NE. 0.0) THEN
1677 
1678 ! ----------------------------------------------------------------------
1679 ! OPTION 1: ITERATED SOLUTION FOR NONZERO CK
1680 ! IN KOREN ET AL, JGR, 1999, EQN 17
1681 ! ----------------------------------------------------------------------
1682 ! INITIAL GUESS FOR SWL (frozen content)
1683 ! ----------------------------------------------------------------------
1684 
1685  swl = smc-sh2o
1686 
1687 ! ----------------------------------------------------------------------
1688 ! KEEP WITHIN BOUNDS.
1689 ! ----------------------------------------------------------------------
1690 
1691  IF (swl .GT. (smc-0.02)) swl = smc-0.02
1692  IF (swl .LT. 0.) swl = 0.
1693 
1694 ! ----------------------------------------------------------------------
1695 ! START OF ITERATIONS
1696 ! ----------------------------------------------------------------------
1697 
1698  DO WHILE ( (nlog .LT. 10) .AND. (kcount .EQ. 0) )
1699 
1700  nlog = nlog+1
1701  df = log(( psis*grav/hlice ) * ( ( 1.+ck*swl )**2. ) * &
1702  ( smcmax/(smc-swl) )**bx) - log(-(tkelv-frz_h2o)/tkelv)
1703  denom = 2. * ck / ( 1.+ck*swl ) + bx / ( smc - swl )
1704  swlk = swl - df/denom
1705 
1706 ! ----------------------------------------------------------------------
1707 ! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.
1708 ! ----------------------------------------------------------------------
1709 
1710  IF (swlk .GT. (smc-0.02)) swlk = smc - 0.02
1711  IF (swlk .LT. 0.) swlk = 0.
1712 
1713 ! ----------------------------------------------------------------------
1714 ! MATHEMATICAL SOLUTION BOUNDS APPLIED.
1715 ! ----------------------------------------------------------------------
1716 
1717  dswl = abs(swlk-swl)
1718  swl = swlk
1719 
1720 ! ----------------------------------------------------------------------
1721 ! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)
1722 ! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.
1723 ! ----------------------------------------------------------------------
1724 
1725  IF ( dswl .LE. error ) THEN
1726  kcount = kcount+1
1727  ENDIF
1728 
1729  END DO
1730 
1731 ! ----------------------------------------------------------------------
1732 ! END OF ITERATIONS
1733 ! ----------------------------------------------------------------------
1734 ! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.
1735 ! ----------------------------------------------------------------------
1736 
1737  frh2o = smc - swl
1738 
1739 ! ----------------------------------------------------------------------
1740 ! END OPTION 1
1741 ! ----------------------------------------------------------------------
1742 
1743  ENDIF
1744 
1745 !-----------------------------------------------------------------------
1746 ! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0
1747 ! IN KOREN ET AL., JGR, 1999, EQN 17
1748 ! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION
1749 ! ----------------------------------------------------------------------
1750 
1751  IF (kcount .EQ. 0) THEN
1752 
1753  fk = (((hlice/(grav*(-psis)))* &
1754  ((tkelv-frz_h2o)/tkelv))**(-1/bx))*smcmax
1755 
1756  IF (fk .LT. 0.02) fk = 0.02
1757 
1758  frh2o = min(fk, smc)
1759 
1760  ENDIF
1761 
1762  RETURN
1763 
1764  END function frh2o
1765 
1771  subroutine rescale_soil_moisture
1772 
1773  use esmf
1774 
1775  use model_grid, only : landmask_target_grid
1776 
1777  use program_setup, only : drysmc_input, drysmc_target, &
1778  maxsmc_input, maxsmc_target, &
1779  refsmc_input, refsmc_target, &
1780  wltsmc_input, wltsmc_target
1781 
1782  use static_data, only : soil_type_target_grid, &
1783  veg_greenness_target_grid, &
1784  veg_type_target_grid
1785 
1786  implicit none
1787 
1788  integer :: clb(3), cub(3), i, j, k, rc
1789  integer :: soilt_input, soilt_target
1790  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1791 
1792  real(esmf_kind_r8), pointer :: soilm_tot_ptr(:,:,:)
1793  real(esmf_kind_r8), pointer :: soil_type_input_ptr(:,:)
1794  real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:)
1795  real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:)
1796  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
1797  real :: f1, fn, smcdir, smctra
1798 
1799  print*,"- RESCALE SOIL MOISTURE FOR CHANGES IN SOIL TYPE."
1800 
1801  print*,"- CALL FieldGet FOR TOTAL SOIL MOISTURE."
1802  call esmf_fieldget(soilm_tot_target_grid, &
1803  computationallbound=clb, &
1804  computationalubound=cub, &
1805  farrayptr=soilm_tot_ptr, rc=rc)
1806  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1807  call error_handler("IN FieldGet", rc)
1808 
1809  print*,"- CALL FieldGet FOR LAND MASK."
1810  call esmf_fieldget(landmask_target_grid, &
1811  farrayptr=landmask_ptr, rc=rc)
1812  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1813  call error_handler("IN FieldGet", rc)
1814 
1815  print*,"- CALL FieldGet FOR VEGETATION TYPE."
1816  call esmf_fieldget(veg_type_target_grid, &
1817  farrayptr=veg_type_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 VEGETATION GREENNESS."
1822  call esmf_fieldget(veg_greenness_target_grid, &
1823  farrayptr=veg_greenness_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 TARGET GRID SOIL TYPE."
1828  call esmf_fieldget(soil_type_target_grid, &
1829  farrayptr=soil_type_target_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 SOIL TYPE FROM INPUT GRID."
1834  call esmf_fieldget(soil_type_from_input_grid, &
1835  farrayptr=soil_type_input_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  do j = clb(2), cub(2)
1840  do i = clb(1), cub(1)
1841 
1842 !---------------------------------------------------------------------------------------------
1843 ! Check land points that are not permanent land ice.
1844 !---------------------------------------------------------------------------------------------
1845 
1846  if (landmask_ptr(i,j) == 1 .and. nint(veg_type_ptr(i,j)) /= veg_type_landice_target) then
1847 
1848  soilt_target = nint(soil_type_target_ptr(i,j))
1849  soilt_input = nint(soil_type_input_ptr(i,j))
1850 
1851 !---------------------------------------------------------------------------------------------
1852 ! Rescale soil moisture at points where the soil type between the input and output
1853 ! grids is different. Caution, this logic assumes the input and target grids use the same
1854 ! soil type dataset.
1855 !---------------------------------------------------------------------------------------------
1856 
1857  if (soilt_target /= soilt_input) then
1858 !---------------------------------------------------------------------------------------------
1859 ! Rescale top layer. First, determine direct evaporation part:
1860 !---------------------------------------------------------------------------------------------
1861 
1862  f1=(soilm_tot_ptr(i,j,1)-drysmc_input(soilt_input)) / &
1863  (maxsmc_input(soilt_input)-drysmc_input(soilt_input))
1864 
1865  smcdir=drysmc_target(soilt_target) + f1 * &
1866  (maxsmc_target(soilt_target) - drysmc_target(soilt_target))
1867 
1868 !---------------------------------------------------------------------------------------------
1869 ! Continue top layer rescale. Now determine transpiration part:
1870 !---------------------------------------------------------------------------------------------
1871 
1872  if (soilm_tot_ptr(i,j,1) < refsmc_input(soilt_input)) then
1873  f1=(soilm_tot_ptr(i,j,1) - wltsmc_input(soilt_input)) / &
1874  (refsmc_input(soilt_input) - wltsmc_input(soilt_input))
1875  smctra=wltsmc_target(soilt_target) + f1 * &
1876  (refsmc_target(soilt_target) - wltsmc_target(soilt_target))
1877  else
1878  f1=(soilm_tot_ptr(i,j,1) - refsmc_input(soilt_input)) / &
1879  (maxsmc_input(soilt_input) - refsmc_input(soilt_input))
1880  smctra=refsmc_target(soilt_target) + f1 * &
1881  (maxsmc_target(soilt_target) - refsmc_target(soilt_target))
1882  endif
1883 
1884 !---------------------------------------------------------------------------------------------
1885 ! Top layer is weighted by green vegetation fraction:
1886 !---------------------------------------------------------------------------------------------
1887 
1888  soilm_tot_ptr(i,j,1) = ((1.0 - veg_greenness_ptr(i,j)) * smcdir) + &
1889  (veg_greenness_ptr(i,j) * smctra)
1890 
1891 !---------------------------------------------------------------------------------------------
1892 ! Rescale bottom layers as follows:
1893 !
1894 ! - Rescale between wilting point and reference value when wilting < soil m < reference, or
1895 ! - Rescale between reference point and maximum value when reference < soil m < max.
1896 !---------------------------------------------------------------------------------------------
1897 
1898  do k = 2, cub(3)
1899  if (soilm_tot_ptr(i,j,k) < refsmc_input(soilt_input)) then
1900  fn = (soilm_tot_ptr(i,j,k) - wltsmc_input(soilt_input)) / &
1901  (refsmc_input(soilt_input) - wltsmc_input(soilt_input))
1902  soilm_tot_ptr(i,j,k) = wltsmc_target(soilt_target) + fn * &
1903  (refsmc_target(soilt_target) - wltsmc_target(soilt_target))
1904  else
1905  fn = (soilm_tot_ptr(i,j,k) - refsmc_input(soilt_input)) / &
1906  (maxsmc_input(soilt_input) - refsmc_input(soilt_input))
1907  soilm_tot_ptr(i,j,k) = refsmc_target(soilt_target) + fn * &
1908  (maxsmc_target(soilt_target) - refsmc_target(soilt_target))
1909  endif
1910  enddo
1911 
1912  endif ! is soil type different?
1913 
1914 !---------------------------------------------------------------------------------------------
1915 ! Range check all layers.
1916 !---------------------------------------------------------------------------------------------
1917 
1918  soilm_tot_ptr(i,j,1)=min(soilm_tot_ptr(i,j,1),maxsmc_target(soilt_target))
1919  soilm_tot_ptr(i,j,1)=max(drysmc_target(soilt_target),soilm_tot_ptr(i,j,1))
1920 
1921  do k = 2, cub(3)
1922  soilm_tot_ptr(i,j,k)=min(soilm_tot_ptr(i,j,k),maxsmc_target(soilt_target))
1923  soilm_tot_ptr(i,j,k)=max(wltsmc_target(soilt_target),soilm_tot_ptr(i,j,k))
1924  enddo
1925 
1926  endif ! is this a land point?
1927 
1928  enddo
1929  enddo
1930 
1931  return
1932 
1933  end subroutine rescale_soil_moisture
1934 
1939  subroutine adjust_soilt_for_terrain
1940 
1941  use model_grid, only : landmask_target_grid, &
1942  terrain_target_grid
1943 
1944  use static_data, only : veg_type_target_grid
1945 
1946  implicit none
1947 
1948  integer :: clb(3), cub(3), i, j, k, rc
1949  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
1950 
1951  real, parameter :: lapse_rate = 6.5e-03
1952  real :: terrain_diff
1953  real(esmf_kind_r8), pointer :: terrain_input_ptr(:,:)
1954  real(esmf_kind_r8), pointer :: terrain_target_ptr(:,:)
1955  real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:)
1956  real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:)
1957 
1958  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
1959  call esmf_fieldget(landmask_target_grid, &
1960  farrayptr=landmask_ptr, rc=rc)
1961  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1962  call error_handler("IN FieldGet", rc)
1963 
1964  print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE."
1965  call esmf_fieldget(veg_type_target_grid, &
1966  farrayptr=veg_type_target_ptr, rc=rc)
1967  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1968  call error_handler("IN FieldGet", rc)
1969 
1970  print*,"- CALL FieldGet FOR TARGET GRID TERRAIN."
1971  call esmf_fieldget(terrain_target_grid, &
1972  farrayptr=terrain_target_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 TERRAIN INTERP TO TARGET GRID."
1977  call esmf_fieldget(terrain_from_input_grid, &
1978  farrayptr=terrain_input_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 SOIL TEMP TARGET GRID."
1983  call esmf_fieldget(soil_temp_target_grid, &
1984  computationallbound=clb, &
1985  computationalubound=cub, &
1986  farrayptr=soil_temp_target_ptr, rc=rc)
1987  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1988  call error_handler("IN FieldGet", rc)
1989 
1990  do j = clb(2), cub(2)
1991  do i = clb(1), cub(1)
1992  if (landmask_ptr(i,j) == 1) then
1993  terrain_diff = abs(terrain_input_ptr(i,j) - terrain_target_ptr(i,j))
1994  if (terrain_diff > 100.0) then
1995  do k = clb(3), cub(3)
1996  soil_temp_target_ptr(i,j,k) = soil_temp_target_ptr(i,j,k) + &
1997  ((terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) * lapse_rate)
1998  if (nint(veg_type_target_ptr(i,j)) == veg_type_landice_target) then
1999  soil_temp_target_ptr(i,j,k) = min(soil_temp_target_ptr(i,j,k), 273.16)
2000  endif
2001  enddo
2002  endif
2003  endif
2004  enddo
2005  enddo
2006 
2007  end subroutine adjust_soilt_for_terrain
2008 
2015  subroutine adjust_soil_levels(localpet)
2016  use model_grid, only : lsoil_target, i_input, j_input, input_grid
2017  use sfc_input_data, only : lsoil_input, soil_temp_input_grid, &
2018  soilm_liq_input_grid, soilm_tot_input_grid
2019  implicit none
2020  integer, intent(in) :: localpet
2021  character(len=500) :: msg
2022  character(len=2) :: lsoil_input_ch, lsoil_target_ch
2023  integer :: rc
2024  real(esmf_kind_r8) :: tmp(i_input,j_input), &
2025  data_one_tile(i_input,j_input,lsoil_input), &
2026  tmp3d(i_input,j_input,lsoil_target)
2027  if (lsoil_input == 9 .and. lsoil_target == 4) then
2028  print*, "CONVERTING FROM 9 INPUT SOIL LEVELS TO 4 TARGET SOIL LEVELS"
2029  call esmf_fieldgather(soil_temp_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2030  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2031  call error_handler("IN FieldGather", rc)
2032 
2033  call esmf_fielddestroy(soil_temp_input_grid,rc=rc)
2034  soil_temp_input_grid = esmf_fieldcreate(input_grid, &
2035  typekind=esmf_typekind_r8, &
2036  staggerloc=esmf_staggerloc_center, &
2037  ungriddedlbound=(/1/), &
2038  ungriddedubound=(/lsoil_target/), rc=rc)
2039 
2040  if(localpet==0)then
2041  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2042  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2043  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2044  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2045  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2046  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2047  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2048  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2049  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2050  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2051  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2052  endif
2053 
2054  call esmf_fieldscatter(soil_temp_input_grid, tmp3d, rootpet=0, rc=rc)
2055  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2056  call error_handler("IN FieldScatter", rc)
2057 
2058  call esmf_fieldgather(soilm_tot_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2059  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2060  call error_handler("IN FieldGather", rc)
2061 
2062  call esmf_fielddestroy(soilm_tot_input_grid,rc=rc)
2063  soilm_tot_input_grid = esmf_fieldcreate(input_grid, &
2064  typekind=esmf_typekind_r8, &
2065  staggerloc=esmf_staggerloc_center, &
2066  ungriddedlbound=(/1/), &
2067  ungriddedubound=(/lsoil_target/), rc=rc)
2068 
2069  if(localpet==0) then
2070  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2071  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2072  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2073  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2074  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2075  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2076  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2077  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2078  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2079  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2080  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2081  endif
2082 
2083  call esmf_fieldscatter(soilm_tot_input_grid, tmp3d, rootpet=0, rc=rc)
2084  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2085  call error_handler("IN FieldScatter", rc)
2086 
2087  call esmf_fieldgather(soilm_liq_input_grid, data_one_tile, rootpet=0, tile=1, rc=rc)
2088  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2089  call error_handler("IN FieldGather", rc)
2090 
2091  call esmf_fielddestroy(soilm_liq_input_grid,rc=rc)
2092  soilm_liq_input_grid = esmf_fieldcreate(input_grid, &
2093  typekind=esmf_typekind_r8, &
2094  staggerloc=esmf_staggerloc_center, &
2095  ungriddedlbound=(/1/), &
2096  ungriddedubound=(/lsoil_target/), rc=rc)
2097  if(localpet==0) then
2098  tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2099  (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2100  (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2101  tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5) !Linear approx. of 40 cm obs
2102  tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2103  (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2104  tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2105  (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2106  tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8) !Linear approx of 200 cm obs
2107  tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2108  (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2109  endif
2110 
2111  call esmf_fieldscatter(soilm_liq_input_grid, tmp3d, rootpet=0, rc=rc)
2112  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2113  call error_handler("IN FieldScatter", rc)
2114 
2115  elseif (lsoil_input /= lsoil_target) then
2116  rc = -1
2117  write(lsoil_input_ch, '(i2)') lsoil_input
2118  write(lsoil_target_ch, '(i2)') lsoil_target
2119  msg="NUMBER OF SOIL LEVELS IN INPUT " // lsoil_input_ch // " AND OUTPUT " &
2120  // lsoil_target_ch // " MUST EITHER BE EQUAL OR 9 AND 4 RESPECTIVELY."
2121  call error_handler(msg, rc)
2122  endif
2123 
2124  end subroutine adjust_soil_levels
2125 
2131  subroutine roughness
2132 
2133  use model_grid, only : landmask_target_grid
2134  use static_data, only : veg_type_target_grid
2135 
2136  implicit none
2137 
2138  integer :: clb(2), cub(2), i, j, rc
2139  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
2140 
2141  real :: z0_igbp(20)
2142  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2143  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
2144 
2145  data z0_igbp /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, &
2146  0.030, 0.856, 0.856, 0.150, 0.040, 0.130, &
2147  1.000, 0.250, 0.011, 0.011, 0.001, 0.076, &
2148  0.050, 0.030/
2149 
2150  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
2151  call esmf_fieldget(landmask_target_grid, &
2152  computationallbound=clb, &
2153  computationalubound=cub, &
2154  farrayptr=landmask_ptr, rc=rc)
2155  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2156  call error_handler("IN FieldGet", rc)
2157 
2158  print*,"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE."
2159  call esmf_fieldget(veg_type_target_grid, &
2160  farrayptr=veg_type_ptr, rc=rc)
2161  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2162  call error_handler("IN FieldGet", rc)
2163 
2164  print*,"- CALL FieldGet FOR TARGET GRID Z0."
2165  call esmf_fieldget(z0_target_grid, &
2166  farrayptr=data_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  do j = clb(2), cub(2)
2171  do i = clb(1), cub(1)
2172  if (landmask_ptr(i,j) == 2) then
2173  data_ptr(i,j) = 1.0
2174  elseif (landmask_ptr(i,j) == 1) then
2175  data_ptr(i,j) = z0_igbp(nint(veg_type_ptr(i,j))) * 100.0
2176  endif
2177  enddo
2178  enddo
2179 
2180  end subroutine roughness
2181 
2185  subroutine qc_check
2186 
2187  use model_grid, only : landmask_target_grid
2188 
2189  use static_data, only : alvsf_target_grid, &
2190  alvwf_target_grid, &
2191  alnsf_target_grid, &
2192  alnwf_target_grid, &
2193  facsf_target_grid, &
2194  facwf_target_grid, &
2195  mxsno_albedo_target_grid, &
2196  max_veg_greenness_target_grid, &
2197  min_veg_greenness_target_grid, &
2198  slope_type_target_grid, &
2199  soil_type_target_grid, &
2200  substrate_temp_target_grid, &
2201  veg_greenness_target_grid, &
2202  veg_type_target_grid
2203 
2204  implicit none
2205 
2206  integer :: clb(2), cub(2), i, j, rc
2207  integer(esmf_kind_i8), pointer :: landmask_ptr(:,:)
2208 
2209  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2210  real(esmf_kind_r8), pointer :: data3d_ptr(:,:,:)
2211  real(esmf_kind_r8), pointer :: soilmt_ptr(:,:,:)
2212  real(esmf_kind_r8), pointer :: soilml_ptr(:,:,:)
2213  real(esmf_kind_r8), pointer :: veg_greenness_ptr(:,:)
2214  real(esmf_kind_r8), pointer :: veg_type_ptr(:,:)
2215  real(esmf_kind_r8), pointer :: seaice_skint_ptr(:,:)
2216  real(esmf_kind_r8), pointer :: skint_ptr(:,:)
2217  real(esmf_kind_r8), pointer :: fice_ptr(:,:)
2218  real(esmf_kind_r8), pointer :: hice_ptr(:,:)
2219 
2220  print*,"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK."
2221  call esmf_fieldget(landmask_target_grid, &
2222  computationallbound=clb, &
2223  computationalubound=cub, &
2224  farrayptr=landmask_ptr, rc=rc)
2225  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2226  call error_handler("IN FieldGet", rc)
2227 
2228  print*,"- SET NON-LAND FLAG FOR TARGET GRID SLOPE TYPE."
2229  call esmf_fieldget(slope_type_target_grid, &
2230  farrayptr=data_ptr, rc=rc)
2231  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2232  call error_handler("IN FieldGet", rc)
2233 
2234  do j = clb(2), cub(2)
2235  do i = clb(1), cub(1)
2236  if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2237  enddo
2238  enddo
2239 
2240  print*,"- SET NON-LAND FLAG FOR TARGET GRID SOIL TYPE."
2241  call esmf_fieldget(soil_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 VEGETATION TYPE."
2253  call esmf_fieldget(veg_type_target_grid, &
2254  farrayptr=veg_type_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) veg_type_ptr(i,j) = 0.0
2261  enddo
2262  enddo
2263 
2264  print*,"- SET TARGET GRID ALVSF AT NON-LAND."
2265  call esmf_fieldget(alvsf_target_grid, &
2266  farrayptr=data_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) data_ptr(i,j) = 0.06 ! gfs physics flag value
2273  enddo
2274  enddo
2275 
2276  print*,"- SET TARGET GRID ALVWF AT NON-LAND."
2277  call esmf_fieldget(alvwf_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 ALNSF AT NON-LAND."
2289  call esmf_fieldget(alnsf_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 ALNWF AT NON-LAND."
2301  call esmf_fieldget(alnwf_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 NON-LAND FLAG FOR TARGET GRID FACSF."
2313  call esmf_fieldget(facsf_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.0
2321  enddo
2322  enddo
2323 
2324  print*,"- SET NON-LAND FLAG FOR TARGET GRID FACSF."
2325  call esmf_fieldget(facwf_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 MAXIMUM GREENNESS."
2337  call esmf_fieldget(max_veg_greenness_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 MINIMUM GREENNESS."
2349  call esmf_fieldget(min_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 VEGETATION GREENNESS."
2361  call esmf_fieldget(veg_greenness_target_grid, &
2362  farrayptr=veg_greenness_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) veg_greenness_ptr(i,j) = 0.0
2369  enddo
2370  enddo
2371 
2372  print*,"- SET NON-LAND FLAG FOR TARGET GRID MAX SNOW ALBEDO."
2373  call esmf_fieldget(mxsno_albedo_target_grid, &
2374  farrayptr=data_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) data_ptr(i,j) = 0.0
2381  enddo
2382  enddo
2383 
2384  print*,"- ZERO OUT TARGET GRID CANOPY MOISTURE CONTENT WHERE NO PLANTS."
2385  call esmf_fieldget(canopy_mc_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 (veg_greenness_ptr(i,j) <= 0.01) data_ptr(i,j) = 0.0
2393  enddo
2394  enddo
2395 
2396  print*,"- CALL FieldGet FOR TARGET GRID ICE SKIN TEMP."
2397  call esmf_fieldget(seaice_skin_temp_target_grid, &
2398  farrayptr=seaice_skint_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  print*,"- SET TARGET GRID SKIN TEMP AT ICE POINTS."
2403  call esmf_fieldget(skin_temp_target_grid, &
2404  farrayptr=skint_ptr, rc=rc)
2405  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2406  call error_handler("IN FieldGet", rc)
2407 
2408  print*,"- CALL FieldGet FOR TARGET GRID SEA ICE FRACTION."
2409  call esmf_fieldget(seaice_fract_target_grid, &
2410  farrayptr=fice_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 SEA ICE DEPTH TO ZERO AT NON-ICE POINTS."
2415  call esmf_fieldget(seaice_depth_target_grid, &
2416  farrayptr=hice_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  do j = clb(2), cub(2)
2421  do i = clb(1), cub(1)
2422  if (fice_ptr(i,j) > 0.0) then
2423  skint_ptr(i,j) = (fice_ptr(i,j) * seaice_skint_ptr(i,j)) + &
2424  ( (1.0 - fice_ptr(i,j)) * frz_ice )
2425  else
2426  seaice_skint_ptr(i,j) = skint_ptr(i,j)
2427  hice_ptr(i,j) = 0.0
2428  endif
2429  enddo
2430  enddo
2431 
2432  print*,"- SET TARGET GRID SUBSTRATE TEMP AT ICE."
2433  call esmf_fieldget(substrate_temp_target_grid, &
2434  farrayptr=data_ptr, rc=rc)
2435  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2436  call error_handler("IN FieldGet", rc)
2437 
2438  do j = clb(2), cub(2)
2439  do i = clb(1), cub(1)
2440  if (landmask_ptr(i,j) == 2) then ! sea ice
2441  data_ptr(i,j) = frz_ice
2442  elseif (landmask_ptr(i,j) == 0) then ! open water flag value.
2443  data_ptr(i,j) = skint_ptr(i,j)
2444  endif
2445  enddo
2446  enddo
2447 
2448  print*,"- ZERO OUT TARGET GRID SNOW DEPTH AT OPEN WATER."
2449  call esmf_fieldget(snow_depth_target_grid, &
2450  farrayptr=data_ptr, rc=rc)
2451  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2452  call error_handler("IN FieldGet", rc)
2453 
2454  do j = clb(2), cub(2)
2455  do i = clb(1), cub(1)
2456  if (landmask_ptr(i,j) == 0) then ! open water
2457  data_ptr(i,j) = 0.0
2458  end if
2459  enddo
2460  enddo
2461 
2462  print*,"- ZERO OUT TARGET GRID SNOW LIQ AT OPEN WATER."
2463  call esmf_fieldget(snow_liq_equiv_target_grid, &
2464  farrayptr=data_ptr, rc=rc)
2465  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2466  call error_handler("IN FieldGet", rc)
2467 
2468  do j = clb(2), cub(2)
2469  do i = clb(1), cub(1)
2470  if (landmask_ptr(i,j) == 0) then ! open water
2471  data_ptr(i,j) = 0.0
2472  endif
2473  enddo
2474  enddo
2475 
2476  print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID TOTAL SOIL MOISTURE."
2477  call esmf_fieldget(soilm_tot_target_grid, &
2478  farrayptr=soilmt_ptr, rc=rc)
2479  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2480  call error_handler("IN FieldGet", rc)
2481 
2482  print*,"- SET NON-LAND FLAG VALUE FOR TARGET GRID LIQUID SOIL MOISTURE."
2483  call esmf_fieldget(soilm_liq_target_grid, &
2484  farrayptr=soilml_ptr, rc=rc)
2485  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2486  call error_handler("IN FieldGet", rc)
2487 
2488  do j = clb(2), cub(2)
2489  do i = clb(1), cub(1)
2490  if (landmask_ptr(i,j) == 2 .or. landmask_ptr(i,j) == 0 .or. &
2491  nint(veg_type_ptr(i,j)) == veg_type_landice_target) then
2492  soilmt_ptr(i,j,:) = 1.0
2493  soilml_ptr(i,j,:) = 1.0
2494  endif
2495  enddo
2496  enddo
2497 
2498  print*,"- SET OPEN WATER FLAG FOR TARGET GRID SOIL TEMPERATURE."
2499  call esmf_fieldget(soil_temp_target_grid, &
2500  farrayptr=data3d_ptr, rc=rc)
2501  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2502  call error_handler("IN FieldGet", rc)
2503 
2504  do j = clb(2), cub(2)
2505  do i = clb(1), cub(1)
2506  if (landmask_ptr(i,j) == 0) then
2507  data3d_ptr(i,j,:) = skint_ptr(i,j) ! open water flag value.
2508  endif
2509  enddo
2510  enddo
2511 
2512  return
2513 
2514  end subroutine qc_check
2515 
2520  subroutine nst_land_fill
2521 
2522  use model_grid, only : landmask_target_grid
2523 
2524  implicit none
2525 
2526  integer(esmf_kind_i8), pointer :: mask_ptr(:,:)
2527  integer :: rc,i
2528  integer, PARAMETER :: num_nst_fields_minus2 = 16
2529  integer, PARAMETER :: xz_fill = 30.0
2530  integer, PARAMETER :: nst_fill = 0.0
2531 
2532  real(esmf_kind_r8), pointer :: data_ptr(:,:)
2533  real(esmf_kind_r8), pointer :: skint_ptr(:,:)
2534 
2535  type(esmf_field) :: temp_field
2536  type(esmf_fieldbundle) :: nst_bundle
2537 
2538  print*,"- CALL FieldGet FOR TARGET GRID LANDMASK."
2539  call esmf_fieldget(landmask_target_grid, &
2540  farrayptr=mask_ptr, rc=rc)
2541  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2542  call error_handler("IN FieldGet", rc)
2543 
2544  nst_bundle = esmf_fieldbundlecreate(name="nst_bundle", rc=rc)
2545  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2546  call error_handler("IN FieldBundleCreate", rc)
2547 
2548  call esmf_fieldbundleadd(nst_bundle, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, &
2549  dt_cool_target_grid,ifd_target_grid,qrain_target_grid,&
2550  w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,&
2551  xu_target_grid,xv_target_grid,xtts_target_grid,xzts_target_grid, &
2552  z_c_target_grid, zm_target_grid/), rc=rc)
2553  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2554  call error_handler("IN FieldBundleAdd", rc)
2555 
2556  print*,"- CALL FieldGet FOR TREF."
2557  call esmf_fieldget(tref_target_grid, &
2558  farrayptr=data_ptr, rc=rc)
2559  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2560  call error_handler("IN FieldGet", rc)
2561 
2562  print*,"- CALL FieldGet FOR SKIN T."
2563  call esmf_fieldget(skin_temp_target_grid, &
2564  farrayptr=skint_ptr, rc=rc)
2565  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2566  call error_handler("IN FieldGet", rc)
2567 
2568  where(mask_ptr /= 0) data_ptr = skint_ptr
2569 
2570 ! xz
2571 
2572  print*,"- CALL FieldGet FOR XZ."
2573  call esmf_fieldget(xz_target_grid, &
2574  farrayptr=data_ptr, rc=rc)
2575  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2576  call error_handler("IN FieldGet", rc)
2577 
2578  where(mask_ptr /= 0) data_ptr = xz_fill
2579 
2580  do i = 1,num_nst_fields_minus2
2581 
2582  call esmf_fieldbundleget(nst_bundle,i,temp_field,rc=rc)
2583  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2584  call error_handler("IN FieldBundleGet", rc)
2585 
2586  call esmf_fieldget(temp_field,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 = nst_fill
2591 
2592  enddo
2593 
2594  call esmf_fieldbundledestroy(nst_bundle,rc=rc)
2595  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2596  call error_handler("IN FieldBundleDestroy", rc)
2597 
2598  end subroutine nst_land_fill
2599 
2603  subroutine create_surface_esmf_fields
2604 
2605  use model_grid, only : target_grid, lsoil_target
2606 
2607  implicit none
2608 
2609  integer :: rc
2610 
2611  real(esmf_kind_r8), pointer :: target_ptr(:,:), target_ptr_3d(:,:,:)
2612  real :: init_val = -999.9
2613 
2614  print*,"- CALL FieldCreate FOR TARGET GRID T2M."
2615  t2m_target_grid = esmf_fieldcreate(target_grid, &
2616  typekind=esmf_typekind_r8, &
2617  name="t2m_target_grid", &
2618  staggerloc=esmf_staggerloc_center, rc=rc)
2619  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2620  call error_handler("IN FieldCreate", rc)
2621 
2622  print*,"- INITIALIZE TARGET grid t2m."
2623  call esmf_fieldget(t2m_target_grid, &
2624  farrayptr=target_ptr, rc=rc)
2625  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2626  call error_handler("IN FieldGet", rc)
2627 
2628  target_ptr = init_val
2629 
2630  print*,"- CALL FieldCreate FOR TARGET GRID Q2M."
2631  q2m_target_grid = esmf_fieldcreate(target_grid, &
2632  typekind=esmf_typekind_r8, &
2633  name="q2m_target_grid", &
2634  staggerloc=esmf_staggerloc_center, rc=rc)
2635  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2636  call error_handler("IN FieldCreate", rc)
2637 
2638  print*,"- INITIALIZE TARGET grid q2m."
2639  call esmf_fieldget(q2m_target_grid, &
2640  farrayptr=target_ptr, rc=rc)
2641  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2642  call error_handler("IN FieldGet", rc)
2643 
2644  target_ptr = init_val
2645 
2646  print*,"- CALL FieldCreate FOR TARGET GRID TPRCP."
2647  tprcp_target_grid = esmf_fieldcreate(target_grid, &
2648  typekind=esmf_typekind_r8, &
2649  name="tprcp_target_grid", &
2650  staggerloc=esmf_staggerloc_center, rc=rc)
2651  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2652  call error_handler("IN FieldCreate", rc)
2653 
2654  print*,"- INITIALIZE TARGET grid tprcp."
2655  call esmf_fieldget(tprcp_target_grid, &
2656  farrayptr=target_ptr, rc=rc)
2657  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2658  call error_handler("IN FieldGet", rc)
2659 
2660  target_ptr = init_val
2661 
2662  print*,"- CALL FieldCreate FOR TARGET GRID F10M."
2663  f10m_target_grid = esmf_fieldcreate(target_grid, &
2664  typekind=esmf_typekind_r8, &
2665  name="f10m_target_grid", &
2666  staggerloc=esmf_staggerloc_center, rc=rc)
2667  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2668  call error_handler("IN FieldCreate", rc)
2669 
2670  print*,"- INITIALIZE TARGET grid f10m."
2671  call esmf_fieldget(f10m_target_grid, &
2672  farrayptr=target_ptr, rc=rc)
2673  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2674  call error_handler("IN FieldGet", rc)
2675 
2676  target_ptr = init_val
2677 
2678  print*,"- CALL FieldCreate FOR TARGET GRID FFMM."
2679  ffmm_target_grid = esmf_fieldcreate(target_grid, &
2680  typekind=esmf_typekind_r8, &
2681  name="ffmm_target_grid", &
2682  staggerloc=esmf_staggerloc_center, rc=rc)
2683  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2684  call error_handler("IN FieldCreate", rc)
2685 
2686  print*,"- INITIALIZE TARGET grid ffmm."
2687  call esmf_fieldget(ffmm_target_grid, &
2688  farrayptr=target_ptr, rc=rc)
2689  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2690  call error_handler("IN FieldGet", rc)
2691 
2692  target_ptr = init_val
2693 
2694  print*,"- CALL FieldCreate FOR TARGET GRID USTAR."
2695  ustar_target_grid = esmf_fieldcreate(target_grid, &
2696  typekind=esmf_typekind_r8, &
2697  name="ustar_target_grid", &
2698  staggerloc=esmf_staggerloc_center, rc=rc)
2699  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2700  call error_handler("IN FieldCreate", rc)
2701 
2702  print*,"- INITIALIZE TARGET grid ustar."
2703  call esmf_fieldget(ustar_target_grid, &
2704  farrayptr=target_ptr, rc=rc)
2705  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2706  call error_handler("IN FieldGet", rc)
2707 
2708  target_ptr = init_val
2709 
2710  print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV."
2711  snow_liq_equiv_target_grid = esmf_fieldcreate(target_grid, &
2712  typekind=esmf_typekind_r8, &
2713  name="snow_liq_equiv_target_grid", &
2714  staggerloc=esmf_staggerloc_center, rc=rc)
2715  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2716  call error_handler("IN FieldCreate", rc)
2717 
2718  print*,"- INITIALIZE TARGET grid snow liq equiv."
2719  call esmf_fieldget(snow_liq_equiv_target_grid, &
2720  farrayptr=target_ptr, rc=rc)
2721  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2722  call error_handler("IN FieldGet", rc)
2723 
2724  target_ptr = init_val
2725 
2726  print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH."
2727  snow_depth_target_grid = esmf_fieldcreate(target_grid, &
2728  typekind=esmf_typekind_r8, &
2729  name="snow_depth_target_grid", &
2730  staggerloc=esmf_staggerloc_center, rc=rc)
2731  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2732  call error_handler("IN FieldCreate", rc)
2733 
2734  print*,"- INITIALIZE TARGET grid snow depth."
2735  call esmf_fieldget(snow_depth_target_grid, &
2736  farrayptr=target_ptr, rc=rc)
2737  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2738  call error_handler("IN FieldGet", rc)
2739 
2740  target_ptr = init_val
2741 
2742  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION."
2743  seaice_fract_target_grid = esmf_fieldcreate(target_grid, &
2744  typekind=esmf_typekind_r8, &
2745  name="seaice_fract_target_grid", &
2746  staggerloc=esmf_staggerloc_center, rc=rc)
2747  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2748  call error_handler("IN FieldCreate", rc)
2749 
2750  print*,"- INITIALIZE TARGET grid sea ice fraction."
2751  call esmf_fieldget(seaice_fract_target_grid, &
2752  farrayptr=target_ptr, rc=rc)
2753  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2754  call error_handler("IN FieldGet", rc)
2755 
2756  target_ptr = init_val
2757 
2758  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH."
2759  seaice_depth_target_grid = esmf_fieldcreate(target_grid, &
2760  typekind=esmf_typekind_r8, &
2761  name="seaice_depth_target_grid", &
2762  staggerloc=esmf_staggerloc_center, rc=rc)
2763  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2764  call error_handler("IN FieldCreate", rc)
2765 
2766  print*,"- INITIALIZE TARGET sea ice depth."
2767  call esmf_fieldget(seaice_depth_target_grid, &
2768  farrayptr=target_ptr, rc=rc)
2769  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2770  call error_handler("IN FieldGet", rc)
2771 
2772  target_ptr = init_val
2773 
2774  print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP."
2775  seaice_skin_temp_target_grid = esmf_fieldcreate(target_grid, &
2776  typekind=esmf_typekind_r8, &
2777  name="seaice_skin_temp_target_grid", &
2778  staggerloc=esmf_staggerloc_center, rc=rc)
2779  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2780  call error_handler("IN FieldCreate", rc)
2781 
2782  print*,"- INITIALIZE TARGET sea ice skin temp."
2783  call esmf_fieldget(seaice_skin_temp_target_grid, &
2784  farrayptr=target_ptr, rc=rc)
2785  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2786  call error_handler("IN FieldGet", rc)
2787 
2788  target_ptr = init_val
2789 
2790  print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG."
2791  srflag_target_grid = esmf_fieldcreate(target_grid, &
2792  typekind=esmf_typekind_r8, &
2793  name="srflag_target_grid", &
2794  staggerloc=esmf_staggerloc_center, rc=rc)
2795  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2796  call error_handler("IN FieldCreate", rc)
2797 
2798  print*,"- INITIALIZE TARGET srflag."
2799  call esmf_fieldget(srflag_target_grid, &
2800  farrayptr=target_ptr, rc=rc)
2801  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2802  call error_handler("IN FieldGet", rc)
2803 
2804  target_ptr = init_val
2805 
2806  print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE."
2807  skin_temp_target_grid = esmf_fieldcreate(target_grid, &
2808  typekind=esmf_typekind_r8, &
2809  name="skin_temp_target_grid", &
2810  staggerloc=esmf_staggerloc_center, rc=rc)
2811  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2812  call error_handler("IN FieldCreate", rc)
2813 
2814  print*,"- INITIALIZE TARGET grid skin temp."
2815  call esmf_fieldget(skin_temp_target_grid, &
2816  farrayptr=target_ptr, rc=rc)
2817  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2818  call error_handler("IN FieldGet", rc)
2819 
2820  target_ptr = init_val
2821 
2822  print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT."
2823  canopy_mc_target_grid = esmf_fieldcreate(target_grid, &
2824  typekind=esmf_typekind_r8, &
2825  name="canopy_mc_target_grid", &
2826  staggerloc=esmf_staggerloc_center, rc=rc)
2827  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2828  call error_handler("IN FieldCreate", rc)
2829 
2830  print*,"- INITIALIZE TARGET grid canopy moisture."
2831  call esmf_fieldget(canopy_mc_target_grid, &
2832  farrayptr=target_ptr, rc=rc)
2833  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2834  call error_handler("IN FieldGet", rc)
2835 
2836  target_ptr = init_val
2837 
2838  print*,"- CALL FieldCreate FOR TARGET GRID LEAF AREA INDEX."
2839  lai_target_grid = esmf_fieldcreate(target_grid, &
2840  typekind=esmf_typekind_r8, &
2841  name="lai_target_grid",&
2842  staggerloc=esmf_staggerloc_center, rc=rc)
2843  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2844  call error_handler("IN FieldCreate", rc)
2845 
2846  print*,"- INITIALIZE TARGET leaf area index."
2847  call esmf_fieldget(lai_target_grid, &
2848  farrayptr=target_ptr, rc=rc)
2849  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2850  call error_handler("IN FieldGet", rc)
2851 
2852  target_ptr = init_val
2853 
2854  print*,"- CALL FieldCreate FOR TARGET GRID Z0."
2855  z0_target_grid = esmf_fieldcreate(target_grid, &
2856  typekind=esmf_typekind_r8, &
2857  name="z0_target_grid", &
2858  staggerloc=esmf_staggerloc_center, rc=rc)
2859  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2860  call error_handler("IN FieldCreate", rc)
2861 
2862  print*,"- INITIALIZE TARGET grid z0."
2863  call esmf_fieldget(z0_target_grid, &
2864  farrayptr=target_ptr, rc=rc)
2865  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2866  call error_handler("IN FieldGet", rc)
2867 
2868  target_ptr = init_val
2869 
2870  print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN."
2871  terrain_from_input_grid = esmf_fieldcreate(target_grid, &
2872  typekind=esmf_typekind_r8, &
2873  name="terrain_from_input_grid", &
2874  staggerloc=esmf_staggerloc_center, rc=rc)
2875  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2876  call error_handler("IN FieldCreate", rc)
2877 
2878  print*,"- INITIALIZE TARGET grid interpolated terrain."
2879  call esmf_fieldget(terrain_from_input_grid, &
2880  farrayptr=target_ptr, rc=rc)
2881  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2882  call error_handler("IN FieldGet", rc)
2883 
2884  target_ptr = init_val
2885 
2886  print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE."
2887  soil_type_from_input_grid = esmf_fieldcreate(target_grid, &
2888  typekind=esmf_typekind_r8, &
2889  staggerloc=esmf_staggerloc_center, &
2890  name="soil_type_from_input_grid", rc=rc)
2891  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2892  call error_handler("IN FieldCreate", rc)
2893 
2894  print*,"- INITIALIZE TARGET grid soil type"
2895  call esmf_fieldget(soil_type_from_input_grid, &
2896  farrayptr=target_ptr, rc=rc)
2897  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2898  call error_handler("IN FieldGet", rc)
2899 
2900  target_ptr = init_val
2901 
2902  print*,"- CALL FieldCreate FOR TARGET GRID SOIL TEMPERATURE."
2903  soil_temp_target_grid = esmf_fieldcreate(target_grid, &
2904  typekind=esmf_typekind_r8, &
2905  staggerloc=esmf_staggerloc_center, &
2906  name="soil_temp_target_grid", &
2907  ungriddedlbound=(/1/), &
2908  ungriddedubound=(/lsoil_target/), rc=rc)
2909  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2910  call error_handler("IN FieldCreate", rc)
2911 
2912  print*,"- INITIALIZE TARGET grid soil temp"
2913  call esmf_fieldget(soil_temp_target_grid, &
2914  farrayptr=target_ptr_3d, rc=rc)
2915  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2916  call error_handler("IN FieldGet", rc)
2917 
2918  target_ptr_3d = init_val
2919 
2920  print*,"- CALL FieldCreate FOR TARGET GRID TOTAL SOIL MOISTURE."
2921  soilm_tot_target_grid = esmf_fieldcreate(target_grid, &
2922  typekind=esmf_typekind_r8, &
2923  staggerloc=esmf_staggerloc_center, &
2924  name="soilm_tot_target_grid", &
2925  ungriddedlbound=(/1/), &
2926  ungriddedubound=(/lsoil_target/), rc=rc)
2927  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2928  call error_handler("IN FieldCreate", rc)
2929 
2930  print*,"- INITIALIZE TARGET grid soil moist"
2931  call esmf_fieldget(soilm_tot_target_grid, &
2932  farrayptr=target_ptr_3d, rc=rc)
2933  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2934  call error_handler("IN FieldGet", rc)
2935 
2936  target_ptr_3d = init_val
2937 
2938  print*,"- CALL FieldCreate FOR TARGET GRID LIQUID SOIL MOISTURE."
2939  soilm_liq_target_grid = esmf_fieldcreate(target_grid, &
2940  typekind=esmf_typekind_r8, &
2941  staggerloc=esmf_staggerloc_center, &
2942  name="soilm_liq_target_grid", &
2943  ungriddedlbound=(/1/), &
2944  ungriddedubound=(/lsoil_target/), rc=rc)
2945  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2946  call error_handler("IN FieldCreate", rc)
2947 
2948  print*,"- INITIALIZE TARGET grid soil liq"
2949  call esmf_fieldget(soilm_liq_target_grid, &
2950  farrayptr=target_ptr_3d, rc=rc)
2951  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2952  call error_handler("IN FieldGet", rc)
2953 
2954  target_ptr_3d = init_val
2955 
2956  end subroutine create_surface_esmf_fields
2957 
2961  subroutine create_nst_esmf_fields
2962 
2963  use model_grid, only : target_grid
2964 
2965  implicit none
2966 
2967  integer :: rc
2968 
2969  print*,"- CALL FieldCreate FOR TARGET GRID C_D."
2970  c_d_target_grid = esmf_fieldcreate(target_grid, &
2971  typekind=esmf_typekind_r8, &
2972  name='c_d', &
2973  staggerloc=esmf_staggerloc_center, rc=rc)
2974  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2975  call error_handler("IN FieldCreate", rc)
2976 
2977  print*,"- CALL FieldCreate FOR TARGET GRID C_0."
2978  c_0_target_grid = esmf_fieldcreate(target_grid, &
2979  typekind=esmf_typekind_r8, &
2980  name='c_0', &
2981  staggerloc=esmf_staggerloc_center, rc=rc)
2982  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2983  call error_handler("IN FieldCreate", rc)
2984 
2985  print*,"- CALL FieldCreate FOR TARGET GRID D_CONV."
2986  d_conv_target_grid = esmf_fieldcreate(target_grid, &
2987  typekind=esmf_typekind_r8, &
2988  name='d_conv',&
2989  staggerloc=esmf_staggerloc_center, rc=rc)
2990  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2991  call error_handler("IN FieldCreate", rc)
2992 
2993  print*,"- CALL FieldCreate FOR TARGET GRID DT_COOL."
2994  dt_cool_target_grid = esmf_fieldcreate(target_grid, &
2995  typekind=esmf_typekind_r8, &
2996  name='dt_cool',&
2997  staggerloc=esmf_staggerloc_center, rc=rc)
2998  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2999  call error_handler("IN FieldCreate", rc)
3000 
3001  print*,"- CALL FieldCreate FOR TARGET GRID IFD."
3002  ifd_target_grid = esmf_fieldcreate(target_grid, &
3003  typekind=esmf_typekind_r8, &
3004  name='ifd',&
3005  staggerloc=esmf_staggerloc_center, rc=rc)
3006  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3007  call error_handler("IN FieldCreate", rc)
3008 
3009  print*,"- CALL FieldCreate FOR TARGET GRID QRAIN."
3010  qrain_target_grid = esmf_fieldcreate(target_grid, &
3011  typekind=esmf_typekind_r8, &
3012  name='qrain',&
3013  staggerloc=esmf_staggerloc_center, rc=rc)
3014  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3015  call error_handler("IN FieldCreate", rc)
3016 
3017  print*,"- CALL FieldCreate FOR TARGET GRID TREF."
3018  tref_target_grid = esmf_fieldcreate(target_grid, &
3019  typekind=esmf_typekind_r8, &
3020  name='tref',&
3021  staggerloc=esmf_staggerloc_center, rc=rc)
3022  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3023  call error_handler("IN FieldCreate", rc)
3024 
3025  print*,"- CALL FieldCreate FOR TARGET GRID W_D."
3026  w_d_target_grid = esmf_fieldcreate(target_grid, &
3027  typekind=esmf_typekind_r8, &
3028  name='w_d',&
3029  staggerloc=esmf_staggerloc_center, rc=rc)
3030  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3031  call error_handler("IN FieldCreate", rc)
3032 
3033  print*,"- CALL FieldCreate FOR TARGET GRID W_0."
3034  w_0_target_grid = esmf_fieldcreate(target_grid, &
3035  typekind=esmf_typekind_r8, &
3036  name='w_0',&
3037  staggerloc=esmf_staggerloc_center, rc=rc)
3038  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3039  call error_handler("IN FieldCreate", rc)
3040 
3041  print*,"- CALL FieldCreate FOR TARGET GRID XS."
3042  xs_target_grid = esmf_fieldcreate(target_grid, &
3043  typekind=esmf_typekind_r8, &
3044  name='xs',&
3045  staggerloc=esmf_staggerloc_center, rc=rc)
3046  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3047  call error_handler("IN FieldCreate", rc)
3048 
3049  print*,"- CALL FieldCreate FOR TARGET GRID XT."
3050  xt_target_grid = esmf_fieldcreate(target_grid, &
3051  typekind=esmf_typekind_r8, &
3052  name='xt',&
3053  staggerloc=esmf_staggerloc_center, rc=rc)
3054  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3055  call error_handler("IN FieldCreate", rc)
3056 
3057  print*,"- CALL FieldCreate FOR TARGET GRID XU."
3058  xu_target_grid = esmf_fieldcreate(target_grid, &
3059  typekind=esmf_typekind_r8, &
3060  name='xu',&
3061  staggerloc=esmf_staggerloc_center, rc=rc)
3062  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3063  call error_handler("IN FieldCreate", rc)
3064 
3065  print*,"- CALL FieldCreate FOR TARGET GRID XV."
3066  xv_target_grid = esmf_fieldcreate(target_grid, &
3067  typekind=esmf_typekind_r8, &
3068  name='xv',&
3069  staggerloc=esmf_staggerloc_center, rc=rc)
3070  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3071  call error_handler("IN FieldCreate", rc)
3072 
3073  print*,"- CALL FieldCreate FOR TARGET GRID XZ."
3074  xz_target_grid = esmf_fieldcreate(target_grid, &
3075  typekind=esmf_typekind_r8, &
3076  name='xz',&
3077  staggerloc=esmf_staggerloc_center, rc=rc)
3078  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3079  call error_handler("IN FieldCreate", rc)
3080 
3081  print*,"- CALL FieldCreate FOR TARGET GRID XTTS."
3082  xtts_target_grid = esmf_fieldcreate(target_grid, &
3083  typekind=esmf_typekind_r8, &
3084  name='xtts',&
3085  staggerloc=esmf_staggerloc_center, rc=rc)
3086  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3087  call error_handler("IN FieldCreate", rc)
3088 
3089  print*,"- CALL FieldCreate FOR TARGET GRID XZTS."
3090  xzts_target_grid = esmf_fieldcreate(target_grid, &
3091  typekind=esmf_typekind_r8, &
3092  name='xzts',&
3093  staggerloc=esmf_staggerloc_center, rc=rc)
3094  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3095  call error_handler("IN FieldCreate", rc)
3096 
3097  print*,"- CALL FieldCreate FOR TARGET GRID Z_C."
3098  z_c_target_grid = esmf_fieldcreate(target_grid, &
3099  typekind=esmf_typekind_r8, &
3100  name='z_c',&
3101  staggerloc=esmf_staggerloc_center, rc=rc)
3102  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3103  call error_handler("IN FieldCreate", rc)
3104 
3105  print*,"- CALL FieldCreate FOR TARGET GRID ZM."
3106  zm_target_grid = esmf_fieldcreate(target_grid, &
3107  typekind=esmf_typekind_r8, &
3108  name='zm',&
3109  staggerloc=esmf_staggerloc_center, rc=rc)
3110  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3111  call error_handler("IN FieldCreate", rc)
3112 
3113  end subroutine create_nst_esmf_fields
3114 
3123  subroutine ij_to_i_j(ij, itile, jtile, i, j)
3124 
3125  implicit none
3126 
3127  integer(esmf_kind_i4), intent(in) :: ij
3128  integer , intent(in) :: itile, jtile
3129 
3130  integer , intent(out) :: i, j
3131 
3132  integer :: tile_num
3133  integer :: pt_loc_this_tile
3134 
3135  tile_num = ((ij-1) / (itile*jtile)) ! tile number minus 1
3136  pt_loc_this_tile = ij - (tile_num * itile * jtile)
3137  ! "ij" location of point within tile.
3138 
3139  j = (pt_loc_this_tile - 1) / itile + 1
3140  i = mod(pt_loc_this_tile, itile)
3141 
3142  if (i==0) i = itile
3143 
3144  return
3145 
3146  end subroutine ij_to_i_j
3147 
3158  subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero, &
3159  unmapped_ptr,resetifd)
3160 
3161  use esmf
3162  use program_setup, only : convert_nst
3163  use model_grid, only : i_target, j_target
3164 
3165  implicit none
3166 
3167  integer, intent(in) :: num_field
3168  type(esmf_routehandle), intent(inout) :: route
3169  type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post
3170  logical, intent(in) :: dozero(num_field)
3171  logical, intent(in), optional :: resetifd
3172  integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:)
3173 
3174  type(esmf_field) :: field_pre,field_post
3175  real(esmf_kind_r8), pointer :: tmp_ptr(:,:)
3176  type(realptr_2d),allocatable :: ptr_2d(:)
3177  type(realptr_3d),allocatable :: ptr_3d(:)
3178  logical :: is2d(num_field)
3179  character(len=50) :: fname
3180  integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet, l(1), u(1)
3181  type(esmf_vm) :: vm
3182 
3183  ind_2d = 0
3184  ind_3d = 0
3185 
3186  if(present(unmapped_ptr)) then
3187  l = lbound(unmapped_ptr)
3188  u = ubound(unmapped_ptr)
3189  endif
3190 
3191  do i = 1, num_field
3192  call esmf_fieldbundleget(bundle_pre,i,field_pre,rc=rc)
3193  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3194  call error_handler("IN FieldBundleGet", rc)
3195 
3196  call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3197  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3198  call error_handler("IN FieldBundleGet", rc)
3199 
3200  call esmf_fieldget(field_post,dimcount=ndims,name=fname,rc=rc)
3201  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3202  call error_handler("IN FieldGet", rc)
3203 
3204  call esmf_vmgetglobal(vm, rc=rc)
3205  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3206  call error_handler("IN VMGetGlobal", rc)
3207  call esmf_vmget(vm, localpet=localpet, rc=rc)
3208  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3209  call error_handler("IN VMGet", rc)
3210  if(localpet==0) print*, "in regrid_many fname = ", fname, ndims
3211  if (ndims == 2) is2d(i) = .true.
3212  if (ndims == 3) is2d(i) = .false.
3213 
3214  if (dozero(i)) then
3215  call esmf_fieldregrid(field_pre, &
3216  field_post, &
3217  routehandle=route, &
3218  termorderflag=esmf_termorder_srcseq, rc=rc)
3219  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3220  call error_handler("IN FieldRegrid", rc)
3221  else
3222  call esmf_fieldregrid(field_pre, &
3223  field_post, &
3224  routehandle=route, &
3225  zeroregion=esmf_region_select, &
3226  termorderflag=esmf_termorder_srcseq, rc=rc)
3227  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3228  call error_handler("IN FieldRegrid", rc)
3229  endif
3230  enddo
3231 
3232  if (present(resetifd)) then
3233  if( resetifd .and. convert_nst) then
3234  call esmf_fieldget(ifd_target_grid,farrayptr=tmp_ptr,rc=rc)
3235  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3236  call error_handler("IN FieldGet", rc)
3237  tmp_ptr = float(nint(tmp_ptr))
3238  endif
3239  endif
3240 
3241  n2d = count(is2d(:))
3242  n3d = count(.not.is2d(:))
3243  if(localpet==0) print*, is2d(:)
3244  if (present(unmapped_ptr)) then
3245  allocate(ptr_2d(n2d))
3246  if (n3d .ne. 0) allocate(ptr_3d(n3d))
3247  do i=1, num_field
3248  if (is2d(i)) then
3249  ind_2d = ind_2d + 1
3250  call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3251  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3252  call error_handler("IN FieldBundleGet", rc)
3253  call esmf_fieldget(field_post, farrayptr=ptr_2d(ind_2d)%p, rc=rc)
3254  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3255  call error_handler("IN FieldGet", rc)
3256  call esmf_fieldget(field_post,name=fname,rc=rc)
3257  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3258  call error_handler("IN FieldGet", rc)
3259  if (localpet==0) print*, "in doreplace loop, 2d field = ", trim(fname)
3260  else
3261  ind_3d = ind_3d + 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,name=fname,rc=rc)
3266  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3267  call error_handler("IN FieldGet", rc)
3268  if (localpet==0) print*, "in doreplace loop, 3d field = ", trim(fname)
3269  call esmf_fieldget(field_post, farrayptr=ptr_3d(ind_3d)%p, rc=rc)
3270  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3271  call error_handler("IN FieldGet", rc)
3272  endif
3273  end do
3274 
3275  do ij = l(1), u(1)
3276  call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j)
3277  do k = 1,n2d
3278  ptr_2d(k)%p(i,j) = -9999.9
3279  enddo
3280  do k = 1,n3d
3281  ptr_3d(k)%p(i,j,:) = -9999.9
3282  enddo
3283  enddo
3284  deallocate(ptr_2d)
3285  if(n3d .ne. 0) deallocate(ptr_3d)
3286  endif
3287  end subroutine regrid_many
3288 
3304  subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, &
3305  search_nums,localpet,latitude,terrain_land,soilt_climo,&
3306  field_data_3d)
3307 
3308  use model_grid, only : i_target,j_target, lsoil_target
3309  use program_setup, only : external_model, input_type
3310  use search_util
3311 
3312  implicit none
3313 
3314  integer, intent(in) :: num_field
3315  type(esmf_fieldbundle), intent(inout) :: bundle_target
3316  real(esmf_kind_r8), intent(inout) :: field_data_2d(i_target,j_target)
3317  real(esmf_kind_r8), intent(inout), optional :: field_data_3d(i_target,j_target,lsoil_target)
3318  real(esmf_kind_r8), intent(inout), optional :: latitude(i_target,j_target)
3319  real(esmf_kind_r8), intent(inout), optional :: terrain_land(i_target,j_target)
3320  real(esmf_kind_r8), intent(inout), optional :: soilt_climo(i_target,j_target)
3321  integer(esmf_kind_i8), intent(inout) :: mask(i_target,j_target)
3322 
3323 
3324  integer, intent(in) :: tile,localpet
3325  integer, intent(inout) :: search_nums(num_field)
3326 
3327  type(esmf_field) :: temp_field
3328  character(len=50) :: fname
3329  integer, parameter :: sotyp_land_field_num = 224
3330  integer, parameter :: sst_field_num = 11
3331  integer, parameter :: terrain_field_num= 7
3332  integer :: j,k, rc, ndims
3333 
3334  do k = 1,num_field
3335  call esmf_fieldbundleget(bundle_target,k,temp_field, rc=rc)
3336  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3337  call error_handler("IN FieldGet", rc)
3338  call esmf_fieldget(temp_field, name=fname, dimcount=ndims,rc=rc)
3339  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3340  call error_handler("IN FieldGet", rc)
3341  if (ndims .eq. 2) then
3342  print*, "processing 2d field ", trim(fname)
3343  print*, "FieldGather"
3344  call esmf_fieldgather(temp_field,field_data_2d,rootpet=0,tile=tile, rc=rc)
3345  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3346  call error_handler("IN FieldGather", rc)
3347  if (localpet == 0) then
3348  if (present(latitude) .and. search_nums(k).eq.sst_field_num) then
3349  ! Sea surface temperatures; pass latitude field to search
3350  print*, "search1"
3351  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude)
3352  elseif (present(terrain_land) .and. search_nums(k) .eq. terrain_field_num) then
3353  ! Terrain height; pass optional climo terrain array to search
3354  print*, "search2"
3355  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land)
3356  elseif (search_nums(k) .eq. sotyp_land_field_num) then
3357  ! Soil type over land
3358  if (fname .eq. "soil_type_target_grid") then
3359  ! Soil type over land when interpolating input data to target grid
3360  ! *with* the intention of retaining interpolated data in output
3361  print*, "search3"
3362  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo)
3363  elseif (present(soilt_climo)) then
3364  if (maxval(field_data_2d) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then
3365  ! Soil type over land when interpolating input data to target grid
3366  ! *without* the intention of retaining data in output file
3367  print*, "search4"
3368  call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k))
3369  else
3370  ! If no soil type field exists in input data (e.g., GFS grib2) then don't search
3371  ! but simply set data to the climo field. This may result in
3372  ! somewhat inaccurate soil moistures as no scaling will occur
3373  print*, "search5"
3374  field_data_2d = soilt_climo
3375  endif !check field value
3376  endif !sotype from target grid
3377  else
3378  ! Any field that doesn't require any of the special treatments or
3379  ! passing of additional variables as in those above
3380  call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k))
3381  endif !if present
3382  endif !localpet
3383  call esmf_fieldscatter(temp_field, field_data_2d, rootpet=0, tile=tile,rc=rc)
3384  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3385  call error_handler("IN FieldScatter", rc)
3386  else
3387  ! Process 3d fields soil temperature, moisture, and liquid
3388  print*, "FieldGather"
3389  call esmf_fieldgather(temp_field,field_data_3d,rootpet=0,tile=tile,rc=rc)
3390  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3391  call error_handler("IN FieldGather", rc)
3392  print*, "processing 3d field ", trim(fname)
3393  if (localpet==0) then
3394  do j = 1, lsoil_target
3395  field_data_2d = field_data_3d(:,:,j)
3396  call search(field_data_2d, mask, i_target, j_target, tile, 21)
3397  field_data_3d(:,:,j) = field_data_2d
3398  enddo
3399  endif
3400  call esmf_fieldscatter(temp_field, field_data_3d, rootpet=0, tile=tile,rc=rc)
3401  if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3402  call error_handler("IN FieldScatter", rc)
3403  endif !ndims
3404  end do !fields
3405 
3406  end subroutine search_many
3407 
3412  subroutine cleanup_all_target_sfc_data
3413 
3414  use surface_target_data, only : cleanup_target_sfc_data
3415 
3416  implicit none
3417 
3418  integer :: rc
3419 
3420  print*,"- DESTROY LOCAL TARGET GRID SURFACE FIELDS."
3421 
3422  call esmf_fielddestroy(terrain_from_input_grid, rc=rc)
3423  call esmf_fielddestroy(terrain_from_input_grid_land, rc=rc)
3424  call esmf_fielddestroy(soil_type_from_input_grid, rc=rc)
3425 
3426  call cleanup_target_sfc_data
3427 
3428  end subroutine cleanup_all_target_sfc_data
3429 
3430  end module surface
surface_target_data::d_conv_target_grid
type(esmf_field), public d_conv_target_grid
Thickness of free convection layer.
Definition: surface_target_data.F90:64
model_grid::j_target
integer, public j_target
j dimension of each global tile, or of a nest, target grid.
Definition: model_grid.F90:40
surface_target_data::zm_target_grid
type(esmf_field), public zm_target_grid
Oceanic mixed layer depth.
Definition: surface_target_data.F90:99
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::hlice
real, parameter, private hlice
latent heat of fusion
Definition: surface.F90:77
model_grid::num_tiles_target_grid
integer, public num_tiles_target_grid
Number of tiles, target grid.
Definition: model_grid.F90:49
model_grid::lsoil_target
integer, public lsoil_target
Number of soil layers, target grid.
Definition: model_grid.F90:25
surface::roughness
subroutine roughness
Set roughness length at land and sea ice.
Definition: surface.F90:2132
surface::frz_ice
real, parameter, private frz_ice
melting pt sea ice
Definition: surface.F90:73
surface_target_data::canopy_mc_target_grid
type(esmf_field), public canopy_mc_target_grid
Canopy moisture content.
Definition: surface_target_data.F90:18
surface_target_data::f10m_target_grid
type(esmf_field), public f10m_target_grid
log((z0+10)*1/z0) See sfc_diff.f for details.
Definition: surface_target_data.F90:20
surface_target_data::c_d_target_grid
type(esmf_field), public c_d_target_grid
Coefficient 2 to calculate d(tz)/d(ts).
Definition: surface_target_data.F90:60
surface_target_data::ifd_target_grid
type(esmf_field), public ifd_target_grid
Model mode index.
Definition: surface_target_data.F90:68
atm_input_data
Read atmospheric data on the input grid.
Definition: atm_input_data.F90:15
model_grid::j_input
integer, public j_input
j-dimension of input grid (or of each global tile)
Definition: model_grid.F90:30
surface_target_data::w_d_target_grid
type(esmf_field), public w_d_target_grid
Coefficient 4 to calculate d(tz)/d(ts).
Definition: surface_target_data.F90:75
surface_target_data::xtts_target_grid
type(esmf_field), public xtts_target_grid
d(xt)/d(ts).
Definition: surface_target_data.F90:93
program_setup::wltsmc_input
real, dimension(:), allocatable, public wltsmc_input
Plant wilting point soil moisture content input grid.
Definition: program_setup.F90:133
surface::search_many
subroutine, public search_many(num_field, bundle_target, field_data_2d, mask, tile, search_nums, localpet, latitude, terrain_land, soilt_climo, field_data_3d)
Execute the search function for multple fields.
Definition: surface.F90:3307
program_setup::lai_from_climo
logical, public lai_from_climo
If false, interpolate leaf area index from the input data to the target grid instead of using data fr...
Definition: program_setup.F90:119
surface::realptr_2d
Definition: surface.F90:81
surface_target_data::srflag_target_grid
type(esmf_field), public srflag_target_grid
Snow/rain flag.
Definition: surface_target_data.F90:36
surface_target_data::xu_target_grid
type(esmf_field), public xu_target_grid
u-current content in diurnal thermocline layer.
Definition: surface_target_data.F90:85
surface::surface_driver
subroutine, public surface_driver(localpet)
Driver routine to process surface/nst data.
Definition: surface.F90:108
program_setup::maxsmc_input
real, dimension(:), allocatable, public maxsmc_input
Maximum soil moisture content input grid.
Definition: program_setup.F90:129
program_setup::satpsi_target
real, dimension(:), allocatable, public satpsi_target
Saturated soil potential, target grid.
Definition: program_setup.F90:136
surface_target_data
Module to hold ESMF fields associated with the target grid surface data.
Definition: surface_target_data.F90:9
static_data::min_veg_greenness_target_grid
type(esmf_field), public min_veg_greenness_target_grid
minimum annual greenness fraction
Definition: static_data.F90:30
surface_target_data::tprcp_target_grid
type(esmf_field), public tprcp_target_grid
Precipitation.
Definition: surface_target_data.F90:50
static_data::max_veg_greenness_target_grid
type(esmf_field), public max_veg_greenness_target_grid
maximum annual greenness fraction
Definition: static_data.F90:29
static_data::mxsno_albedo_target_grid
type(esmf_field), public mxsno_albedo_target_grid
maximum snow albedo
Definition: static_data.F90:31
model_grid
Sets up the ESMF grid objects for the input data grid and target FV3 grid.
Definition: model_grid.F90:9
program_setup::bb_target
real, dimension(:), allocatable, public bb_target
Soil &#39;b&#39; parameter, target grid.
Definition: program_setup.F90:135
static_data::alvwf_target_grid
type(esmf_field), public alvwf_target_grid
visible white sky albedo
Definition: static_data.F90:24
surface::terrain_from_input_grid_land
type(esmf_field) terrain_from_input_grid_land
terrain height interpolated from input grid at all land points
Definition: surface.F90:65
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:3413
model_grid::latitude_target_grid
type(esmf_field), public latitude_target_grid
latitude of grid center, target grid
Definition: model_grid.F90:77
search_util
Replace undefined values with a valid value.
Definition: search_util.F90:15
model_grid::i_target
integer, public i_target
i dimension of each global tile, or of a nest, target grid.
Definition: model_grid.F90:37
program_setup::sotyp_from_climo
logical, public sotyp_from_climo
If false, interpolate soil type from the input data to the target grid instead of using data from sta...
Definition: program_setup.F90:105
surface_target_data::xzts_target_grid
type(esmf_field), public xzts_target_grid
d(xz)/d(ts).
Definition: surface_target_data.F90:95
program_setup::minmax_vgfrc_from_climo
logical, public minmax_vgfrc_from_climo
If false, interpolate min/max vegetation fraction from the input data to the target grid instead of u...
Definition: program_setup.F90:115
surface_target_data::c_0_target_grid
type(esmf_field), public c_0_target_grid
Coefficient 1 to calculate d(tz)/d(ts).
Definition: surface_target_data.F90:62
surface::create_surface_esmf_fields
subroutine, public create_surface_esmf_fields
Create ESMF fields for the target grid surface variables.
Definition: surface.F90:2604
surface_target_data::soilm_liq_target_grid
type(esmf_field), public soilm_liq_target_grid
3-d liquid soil moisture.
Definition: surface_target_data.F90:44
model_grid::target_grid
type(esmf_grid), public target_grid
target grid esmf grid object.
Definition: model_grid.F90:54
static_data::alnsf_target_grid
type(esmf_field), public alnsf_target_grid
near ir black sky albedo
Definition: static_data.F90:25
surface_target_data::xz_target_grid
type(esmf_field), public xz_target_grid
Diurnal thermocline layer thickness.
Definition: surface_target_data.F90:91
surface::grav
real, parameter, private grav
gravity
Definition: surface.F90:75
program_setup::external_model
character(len=20), public external_model
The model that the input data is derived from.
Definition: program_setup.F90:57
surface_target_data::z_c_target_grid
type(esmf_field), public z_c_target_grid
Sub-layer cooling thickness.
Definition: surface_target_data.F90:97
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:47
surface::soil_type_from_input_grid
type(esmf_field) soil_type_from_input_grid
soil type interpolated from input grid
Definition: surface.F90:59
surface_target_data::lai_target_grid
type(esmf_field), public lai_target_grid
Leaf area index.
Definition: surface_target_data.F90:56
static_data::cleanup_static_fields
subroutine, public cleanup_static_fields
Free up memory for fields in this module.
Definition: static_data.F90:510
surface::calc_liq_soil_moisture
subroutine calc_liq_soil_moisture
Compute liquid portion of the total soil moisture.
Definition: surface.F90:1490
model_grid::landmask_target_grid
type(esmf_field), public landmask_target_grid
land mask target grid - &#39;1&#39; land; &#39;0&#39; non-land
Definition: model_grid.F90:74
surface_target_data::seaice_fract_target_grid
type(esmf_field), public seaice_fract_target_grid
Sea ice fraction.
Definition: surface_target_data.F90:30
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:1772
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:1940
program_setup::convert_nst
logical, public convert_nst
Convert nst data when true.
Definition: program_setup.F90:95
surface_target_data::snow_liq_equiv_target_grid
type(esmf_field), public snow_liq_equiv_target_grid
Liquid equivalent snow depth.
Definition: surface_target_data.F90:38
surface_target_data::qrain_target_grid
type(esmf_field), public qrain_target_grid
Sensible heat flux due to rainfall.
Definition: surface_target_data.F90:71
surface_target_data::soilm_tot_target_grid
type(esmf_field), public soilm_tot_target_grid
3-d total soil moisture.
Definition: surface_target_data.F90:46
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:2016
program_setup::tg3_from_soil
logical, public tg3_from_soil
If false, use lowest level soil temperature for the base soil temperature instead of using data from ...
Definition: program_setup.F90:122
surface::veg_type_landice_target
integer, parameter veg_type_landice_target
Vegetation type category that defines permanent land ice points.
Definition: surface.F90:53
surface_target_data::seaice_depth_target_grid
type(esmf_field), public seaice_depth_target_grid
Sea ice depth.
Definition: surface_target_data.F90:28
surface_target_data::ffmm_target_grid
type(esmf_field), public ffmm_target_grid
log((z0+z1)*1/z0) See sfc_diff.f for details.
Definition: surface_target_data.F90:23
surface_target_data::seaice_skin_temp_target_grid
type(esmf_field), public seaice_skin_temp_target_grid
Sea ice skin temperature.
Definition: surface_target_data.F90:32
surface::interp
subroutine, public interp(localpet)
Horizontally interpolate surface fields from input to target FV3 grid using esmf routines.
Definition: surface.F90:249
atm_input_data::terrain_input_grid
type(esmf_field), public terrain_input_grid
terrain height
Definition: atm_input_data.F90:52
static_data::alvsf_target_grid
type(esmf_field), public alvsf_target_grid
visible black sky albedo
Definition: static_data.F90:23
program_setup::drysmc_input
real, dimension(:), allocatable, public drysmc_input
Air dry soil moisture content input grid.
Definition: program_setup.F90:127
surface::realptr_3d
Definition: surface.F90:86
program_setup::wltsmc_target
real, dimension(:), allocatable, public wltsmc_target
Plant wilting point soil moisture content target grid.
Definition: program_setup.F90:134
static_data::slope_type_target_grid
type(esmf_field), public slope_type_target_grid
slope type
Definition: static_data.F90:32
static_data
Reads static surface climatological data for the target FV3 grid (such as soil type and vegetation ty...
Definition: static_data.F90:13
surface_target_data::xs_target_grid
type(esmf_field), public xs_target_grid
Salinity content in diurnal thermocline layer.
Definition: surface_target_data.F90:79
program_setup::vgfrc_from_climo
logical, public vgfrc_from_climo
If false, interpolate vegetation fraction from the input data to the target grid instead of using dat...
Definition: program_setup.F90:110
program_setup::calc_soil_params_driver
subroutine, public calc_soil_params_driver(localpet)
Driver routine to compute soil parameters for each soil type.
Definition: program_setup.F90:515
surface::create_nst_esmf_fields
subroutine, public create_nst_esmf_fields
Create ESMF fields for the target grid nst variables.
Definition: surface.F90:2962
model_grid::input_grid
type(esmf_grid), public input_grid
input grid esmf grid object
Definition: model_grid.F90:52
surface_target_data::ustar_target_grid
type(esmf_field), public ustar_target_grid
Friction velocity.
Definition: surface_target_data.F90:52
surface_target_data::tref_target_grid
type(esmf_field), public tref_target_grid
Reference temperature.
Definition: surface_target_data.F90:73
surface_target_data::q2m_target_grid
type(esmf_field), public q2m_target_grid
2-m specific humidity.
Definition: surface_target_data.F90:26
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:3160
surface::nst_land_fill
subroutine, public nst_land_fill
nst is not active at land or sea ice points.
Definition: surface.F90:2521
program_setup::input_type
character(len=25), public input_type
Input data type:
Definition: program_setup.F90:43
surface::frz_h2o
real, parameter, private frz_h2o
melting pt water
Definition: surface.F90:71
surface
Process surface and nst fields.
Definition: surface.F90:21
model_grid::terrain_target_grid
type(esmf_field), public terrain_target_grid
terrain height target grid
Definition: model_grid.F90:96
program_setup::refsmc_target
real, dimension(:), allocatable, public refsmc_target
Reference soil moisture content target grid (onset of soil moisture stress).
Definition: program_setup.F90:132
static_data::substrate_temp_target_grid
type(esmf_field), public substrate_temp_target_grid
soil subtrate temperature
Definition: static_data.F90:34
static_data::veg_greenness_target_grid
type(esmf_field), public veg_greenness_target_grid
vegetation greenness fraction
Definition: static_data.F90:35
surface_target_data::skin_temp_target_grid
type(esmf_field), public skin_temp_target_grid
Skin temperature/sst.
Definition: surface_target_data.F90:34
surface_target_data::xv_target_grid
type(esmf_field), public xv_target_grid
v-current content in diurnal thermocline layer.
Definition: surface_target_data.F90:88
surface_target_data::xt_target_grid
type(esmf_field), public xt_target_grid
Heat content in diurnal thermocline layer.
Definition: surface_target_data.F90:82
model_grid::seamask_target_grid
type(esmf_field), public seamask_target_grid
sea mask target grid - &#39;1&#39; non-land; &#39;0&#39; land
Definition: model_grid.F90:93
static_data::veg_type_target_grid
type(esmf_field), public veg_type_target_grid
vegetation type
Definition: static_data.F90:36
surface::qc_check
subroutine qc_check
Perform some quality control checks before output.
Definition: surface.F90:2186
surface_target_data::z0_target_grid
type(esmf_field), public z0_target_grid
Roughness length.
Definition: surface_target_data.F90:54
program_setup::vgtyp_from_climo
logical, public vgtyp_from_climo
If false, interpolate vegetation type from the input data to the target grid instead of using data fr...
Definition: program_setup.F90:101
static_data::facwf_target_grid
type(esmf_field), public facwf_target_grid
fractional coverage for weak zenith angle dependent albedo
Definition: static_data.F90:28
surface::terrain_from_input_grid
type(esmf_field) terrain_from_input_grid
terrain height interpolated from input grid
Definition: surface.F90:62
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:50
surface::ij_to_i_j
subroutine ij_to_i_j(ij, itile, jtile, i, j)
Convert 1d index to 2d indices.
Definition: surface.F90:3124
surface_target_data::t2m_target_grid
type(esmf_field), public t2m_target_grid
2-m temperatrure.
Definition: surface_target_data.F90:48
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:145
surface_target_data::soil_temp_target_grid
type(esmf_field), public soil_temp_target_grid
3-d soil temperature.
Definition: surface_target_data.F90:42
program_setup::refsmc_input
real, dimension(:), allocatable, public refsmc_input
Reference soil moisture content input grid (onset of soil moisture stress).
Definition: program_setup.F90:131
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:112
static_data::alnwf_target_grid
type(esmf_field), public alnwf_target_grid
near ir white sky albedo
Definition: static_data.F90:26
program_setup::maxsmc_target
real, dimension(:), allocatable, public maxsmc_target
Maximum soil moisture content target grid.
Definition: program_setup.F90:130
program_setup::drysmc_target
real, dimension(:), allocatable, public drysmc_target
Air dry soil moisture content target grid.
Definition: program_setup.F90:128
surface_target_data::dt_cool_target_grid
type(esmf_field), public dt_cool_target_grid
Sub-layer cooling amount.
Definition: surface_target_data.F90:66
model_grid::i_input
integer, public i_input
i-dimension of input grid (or of each global tile)
Definition: model_grid.F90:27
surface_target_data::w_0_target_grid
type(esmf_field), public w_0_target_grid
Coefficient 3 to calculate d(tz)/d(ts).
Definition: surface_target_data.F90:77
static_data::facsf_target_grid
type(esmf_field), public facsf_target_grid
fractional coverage for strong zenith angle dependent albedo
Definition: static_data.F90:27
surface::blim
real, parameter, private blim
soil &#39;b&#39; parameter limit
Definition: surface.F90:69
surface_target_data::snow_depth_target_grid
type(esmf_field), public snow_depth_target_grid
Physical snow depth.
Definition: surface_target_data.F90:40
static_data::soil_type_target_grid
type(esmf_field), public soil_type_target_grid
soil type
Definition: static_data.F90:33