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