45 use write_data,
only : write_fv3_sfc_data_netcdf
67 real,
parameter,
private ::
blim = 5.5
69 real,
parameter,
private ::
frz_h2o = 273.15
71 real,
parameter,
private ::
frz_ice = 271.21
73 real,
parameter,
private ::
grav = 9.81
75 real,
parameter,
private ::
hlice = 3.335e5
80 real(esmf_kind_r8),
pointer :: p(:,:)
85 real(esmf_kind_r8),
pointer :: p(:,:,:)
122 integer,
intent(in) :: localpet
221 call write_fv3_sfc_data_netcdf(localpet)
243 subroutine interp(localpet)
319 integer,
intent(in) :: localpet
321 integer :: l(1), u(1)
322 integer :: i, j, ij, rc, tile
323 integer :: clb_target(2), cub_target(2)
324 integer :: isrctermprocessing
325 integer :: num_fields
326 integer :: vgfrc_ind, mmvg_ind, lai_ind
327 integer,
allocatable :: search_nums(:)
328 integer(esmf_kind_i4),
pointer :: unmapped_ptr(:)
329 integer(esmf_kind_i4),
pointer :: mask_input_ptr(:,:)
330 integer(esmf_kind_i4),
pointer :: mask_target_ptr(:,:)
331 integer(esmf_kind_i8),
pointer :: landmask_target_ptr(:,:)
332 integer(esmf_kind_i8),
allocatable :: mask_target_one_tile(:,:)
333 integer(esmf_kind_i8),
allocatable :: water_target_one_tile(:,:)
334 integer(esmf_kind_i8),
allocatable :: land_target_one_tile(:,:)
335 integer(esmf_kind_i8),
pointer :: seamask_target_ptr(:,:)
337 real(esmf_kind_r8),
allocatable :: data_one_tile(:,:)
338 real(esmf_kind_r8),
allocatable :: data_one_tile2(:,:)
339 real(esmf_kind_r8),
allocatable :: data_one_tile_3d(:,:,:)
340 real(esmf_kind_r8),
allocatable :: latitude_one_tile(:,:)
341 real(esmf_kind_r8),
pointer :: seaice_fract_target_ptr(:,:)
342 real(esmf_kind_r8),
pointer :: srflag_target_ptr(:,:)
343 real(esmf_kind_r8),
pointer :: terrain_from_input_ptr(:,:)
344 real(esmf_kind_r8),
pointer :: veg_type_target_ptr(:,:)
345 real(esmf_kind_r8),
pointer :: soil_type_target_ptr(:,:)
346 real(esmf_kind_r8),
pointer :: landmask_input_ptr(:,:)
347 real(esmf_kind_r8),
pointer :: veg_type_input_ptr(:,:)
348 real(esmf_kind_r8),
allocatable :: veg_type_target_one_tile(:,:)
350 type(esmf_regridmethod_flag) :: method
351 type(esmf_routehandle) :: regrid_bl_no_mask
352 type(esmf_routehandle) :: regrid_all_land
353 type(esmf_routehandle) :: regrid_land
354 type(esmf_routehandle) :: regrid_landice
355 type(esmf_routehandle) :: regrid_nonland
356 type(esmf_routehandle) :: regrid_seaice
357 type(esmf_routehandle) :: regrid_water
359 type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input
360 type(esmf_fieldbundle) :: bundle_seaice_target, bundle_seaice_input
361 type(esmf_fieldbundle) :: bundle_water_target, bundle_water_input
362 type(esmf_fieldbundle) :: bundle_allland_target, bundle_allland_input
363 type(esmf_fieldbundle) :: bundle_landice_target, bundle_landice_input
364 type(esmf_fieldbundle) :: bundle_nolandice_target, bundle_nolandice_input
366 logical,
allocatable :: dozero(:)
372 method=esmf_regridmethod_bilinear
374 isrctermprocessing = 1
376 print*,
"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION." 379 polemethod=esmf_polemethod_allavg, &
380 srctermprocessing=isrctermprocessing, &
381 routehandle=regrid_bl_no_mask, &
382 regridmethod=method, rc=rc)
383 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
386 bundle_all_target = esmf_fieldbundlecreate(name=
"all points target", rc=rc)
387 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
389 bundle_all_input = esmf_fieldbundlecreate(name=
"all points input", rc=rc)
390 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
396 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
401 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
404 call esmf_fieldbundleget(bundle_all_target,fieldcount=num_fields,rc=rc)
405 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
408 allocate(dozero(num_fields))
411 call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero)
414 call esmf_fieldbundledestroy(bundle_all_target,rc=rc)
415 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
417 call esmf_fieldbundledestroy(bundle_all_input,rc=rc)
418 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
421 print*,
"- CALL FieldGet FOR SRFLAG." 423 farrayptr=srflag_target_ptr, rc=rc)
424 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
432 srflag_target_ptr = nint(srflag_target_ptr)
434 print*,
"- CALL FieldRegridRelease." 435 call esmf_fieldregridrelease(routehandle=regrid_bl_no_mask, rc=rc)
436 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
443 print*,
"- CALL GridAddItem FOR TARGET GRID." 445 itemflag=esmf_griditem_mask, &
446 staggerloc=esmf_staggerloc_center, rc=rc)
447 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
450 print*,
"- CALL GridGetItem FOR TARGET GRID." 452 itemflag=esmf_griditem_mask, &
453 farrayptr=mask_target_ptr, rc=rc)
454 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
457 print*,
"- CALL FieldGet FOR TARGET GRID SEAMASK." 459 computationallbound=clb_target, &
460 computationalubound=cub_target, &
461 farrayptr=seamask_target_ptr, rc=rc)
462 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
465 print*,
"- CALL FieldGet FOR TARGET GRID LANDMASK." 467 farrayptr=landmask_target_ptr, rc=rc)
468 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
471 print*,
"- CALL GridAddItem FOR INPUT GRID SEAMASK." 473 itemflag=esmf_griditem_mask, &
474 staggerloc=esmf_staggerloc_center, rc=rc)
475 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
478 print*,
"- CALL FieldGet FOR INPUT GRID LANDMASK." 480 farrayptr=landmask_input_ptr, rc=rc)
481 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
484 print*,
"- CALL GridGetItem FOR INPUT GRID LANDMASK." 486 itemflag=esmf_griditem_mask, &
487 farrayptr=mask_input_ptr, rc=rc)
488 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
491 if (localpet == 0)
then 496 allocate(data_one_tile(0,0))
497 allocate(data_one_tile_3d(0,0,0))
498 allocate(mask_target_one_tile(0,0))
506 method=esmf_regridmethod_nearest_stod
508 isrctermprocessing = 1
511 where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
514 where (landmask_target_ptr == 1) mask_target_ptr = 1
516 print*,
"- CALL FieldCreate FOR TERRAIN FROM INPUT GRID LAND." 518 typekind=esmf_typekind_r8, &
519 staggerloc=esmf_staggerloc_center, rc=rc)
520 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
523 print*,
"- CALL FieldRegridStore for land fields." 526 srcmaskvalues=(/0/), &
527 dstmaskvalues=(/0/), &
528 polemethod=esmf_polemethod_none, &
529 srctermprocessing=isrctermprocessing, &
530 unmappedaction=esmf_unmappedaction_ignore, &
531 normtype=esmf_normtype_fracarea, &
532 routehandle=regrid_all_land, &
533 regridmethod=method, &
534 unmappeddstlist=unmapped_ptr, rc=rc)
535 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
538 print*,
"- CALL Field_Regrid TERRAIN." 541 routehandle=regrid_all_land, &
542 termorderflag=esmf_termorder_srcseq, rc=rc)
543 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
546 print*,
"- CALL FieldGet FOR terrain from input grid at land." 548 farrayptr=terrain_from_input_ptr, rc=rc)
549 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
552 l = lbound(unmapped_ptr)
553 u = ubound(unmapped_ptr)
557 terrain_from_input_ptr(i,j) = -9999.9
559 nullify(terrain_from_input_ptr)
563 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
565 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
568 print*,
"- CALL FieldGather FOR TERRAIN FROM INPUT GRID: ", tile
570 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
573 if (localpet == 0)
then 575 land_target_one_tile = 0
576 where(mask_target_one_tile == 1) land_target_one_tile = 1
578 deallocate(land_target_one_tile)
581 print*,
"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID: ", tile
583 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
589 print*,
"- CALL FieldRegrid VEG TYPE." 592 routehandle=regrid_all_land, &
593 termorderflag=esmf_termorder_srcseq, rc=rc)
594 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
597 print*,
"- CALL FieldGet FOR TARGET grid veg type." 599 farrayptr=veg_type_target_ptr, rc=rc)
600 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
603 l = lbound(unmapped_ptr)
604 u = ubound(unmapped_ptr)
608 veg_type_target_ptr(i,j) = -9999.9
612 print*,
"- CALL FieldGather FOR TARGET GRID VEG TYPE TILE: ", tile
614 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
617 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
619 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
622 if (localpet == 0)
then 624 land_target_one_tile = 0
625 where(mask_target_one_tile == 1) land_target_one_tile = 1
627 deallocate(land_target_one_tile)
630 print*,
"- CALL FieldScatter FOR TARGET GRID VEG TYPE: ", tile
632 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
635 nullify(veg_type_target_ptr)
637 print*,
"- CALL FieldRegridRelease." 638 call esmf_fieldregridrelease(routehandle=regrid_all_land, rc=rc)
639 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
648 where (nint(landmask_input_ptr) == 1) mask_input_ptr = 0
650 mask_target_ptr = seamask_target_ptr
652 method=esmf_regridmethod_conserve
654 isrctermprocessing = 1
656 print*,
"- CALL FieldRegridStore for sea ice fraction." 659 srcmaskvalues=(/0/), &
660 dstmaskvalues=(/0/), &
661 polemethod=esmf_polemethod_none, &
662 srctermprocessing=isrctermprocessing, &
663 unmappedaction=esmf_unmappedaction_ignore, &
664 normtype=esmf_normtype_fracarea, &
665 routehandle=regrid_nonland, &
666 regridmethod=method, &
667 unmappeddstlist=unmapped_ptr, rc=rc)
668 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
671 print*,
"- CALL Field_Regrid for sea ice fraction." 674 routehandle=regrid_nonland, &
675 termorderflag=esmf_termorder_srcseq, rc=rc)
676 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
679 print*,
"- CALL FieldGet FOR TARGET grid sea ice fraction." 681 farrayptr=seaice_fract_target_ptr, rc=rc)
682 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
685 l = lbound(unmapped_ptr)
686 u = ubound(unmapped_ptr)
690 seaice_fract_target_ptr(i,j) = -9999.9
695 if (localpet == 0)
then 698 allocate(latitude_one_tile(0,0))
703 print*,
"- CALL FieldGather FOR TARGET GRID SEAICE FRACTION TILE: ", tile
705 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
708 print*,
"- CALL FieldGather FOR TARGET GRID MASK TILE: ", tile
709 call esmf_fieldgather(
seamask_target_grid, mask_target_one_tile, rootpet=0, tile=tile, rc=rc)
710 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
713 print*,
"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile
715 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
718 if (localpet == 0)
then 720 latitude=latitude_one_tile)
723 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
725 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
729 if (localpet == 0)
then 732 if (data_one_tile(i,j) > 1.0_esmf_kind_r8)
then 733 data_one_tile(i,j) = 1.0_esmf_kind_r8
735 if (data_one_tile(i,j) < 0.15_esmf_kind_r8) data_one_tile(i,j) = 0.0_esmf_kind_r8
736 if (data_one_tile(i,j) >= 0.15_esmf_kind_r8) mask_target_one_tile(i,j) = 2
741 print*,
"- CALL FieldScatter FOR TARGET GRID SEAICE FRACTION TILE: ", tile
743 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
746 print*,
"- CALL FieldScatter FOR TARGET LANDMASK TILE: ", tile
748 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
753 deallocate(latitude_one_tile)
755 print*,
"- CALL FieldRegridRelease." 756 call esmf_fieldregridrelease(routehandle=regrid_nonland, rc=rc)
757 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
766 where (nint(landmask_input_ptr) == 2) mask_input_ptr = 1
768 print*,
"- CALL FieldGet FOR TARGET land sea mask." 770 farrayptr=landmask_target_ptr, rc=rc)
771 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
775 do j = clb_target(2), cub_target(2)
776 do i = clb_target(1), cub_target(1)
777 if (landmask_target_ptr(i,j) == 2) mask_target_ptr(i,j) = 1
781 method=esmf_regridmethod_nearest_stod
782 isrctermprocessing = 1
784 print*,
"- CALL FieldRegridStore for 3d seaice fields." 787 srcmaskvalues=(/0/), &
788 dstmaskvalues=(/0/), &
789 polemethod=esmf_polemethod_none, &
790 srctermprocessing=isrctermprocessing, &
791 unmappedaction=esmf_unmappedaction_ignore, &
792 normtype=esmf_normtype_fracarea, &
793 routehandle=regrid_seaice, &
794 regridmethod=method, &
795 unmappeddstlist=unmapped_ptr, rc=rc)
796 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
799 bundle_seaice_target = esmf_fieldbundlecreate(name=
"sea ice target", rc=rc)
800 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
802 bundle_seaice_input = esmf_fieldbundlecreate(name=
"sea ice input", rc=rc)
803 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
808 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
813 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
815 call esmf_fieldbundleget(bundle_seaice_target,fieldcount=num_fields,rc=rc)
816 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
820 allocate(search_nums(num_fields))
821 allocate(dozero(num_fields))
823 search_nums = (/92,66,65,21,21/)
826 l = lbound(unmapped_ptr)
827 u = ubound(unmapped_ptr)
829 call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, &
830 unmapped_ptr=unmapped_ptr )
832 call esmf_fieldbundledestroy(bundle_seaice_input,rc=rc)
833 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
838 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
840 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
843 if (localpet == 0)
then 844 where(mask_target_one_tile == 1) mask_target_one_tile = 0
845 where(mask_target_one_tile == 2) mask_target_one_tile = 1
849 call search_many(num_fields,bundle_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, &
850 field_data_3d=data_one_tile_3d)
853 deallocate(search_nums)
854 call esmf_fieldbundledestroy(bundle_seaice_target,rc=rc)
855 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
858 print*,
"- CALL FieldRegridRelease." 859 call esmf_fieldregridrelease(routehandle=regrid_seaice, rc=rc)
860 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
868 where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1
871 where (landmask_target_ptr == 0) mask_target_ptr = 1
873 method=esmf_regridmethod_conserve
874 isrctermprocessing = 1
876 print*,
"- CALL FieldRegridStore for water fields." 879 srcmaskvalues=(/0/), &
880 dstmaskvalues=(/0/), &
881 polemethod=esmf_polemethod_none, &
882 srctermprocessing=isrctermprocessing, &
883 unmappedaction=esmf_unmappedaction_ignore, &
884 normtype=esmf_normtype_fracarea, &
885 routehandle=regrid_water, &
886 regridmethod=method, &
887 unmappeddstlist=unmapped_ptr, rc=rc)
888 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
891 bundle_water_target = esmf_fieldbundlecreate(name=
"water target", rc=rc)
892 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
894 bundle_water_input = esmf_fieldbundlecreate(name=
"water input", rc=rc)
895 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
898 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
901 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
911 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
919 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
921 call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
922 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
925 allocate(search_nums(num_fields))
926 allocate(dozero(num_fields))
928 search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/)
932 call esmf_fieldbundleget(bundle_water_target,fieldcount=num_fields,rc=rc)
933 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
936 allocate(search_nums(num_fields))
937 allocate(dozero(num_fields))
938 search_nums(:)=(/11,83/)
942 call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, &
943 unmapped_ptr=unmapped_ptr, resetifd=.true.)
945 call esmf_fieldbundledestroy(bundle_water_input,rc=rc)
946 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
950 if (localpet == 0)
then 953 allocate(latitude_one_tile(0,0))
958 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
960 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
963 print*,
"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile
965 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
968 if (localpet == 0)
then 970 water_target_one_tile = 0
971 where(mask_target_one_tile == 0) water_target_one_tile = 1
974 call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,&
975 tile,search_nums,localpet,latitude=latitude_one_tile)
977 if (localpet == 0)
deallocate(water_target_one_tile)
981 deallocate(latitude_one_tile,search_nums)
983 call esmf_fieldbundledestroy(bundle_water_target,rc=rc)
984 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
987 print*,
"- CALL FieldRegridRelease." 988 call esmf_fieldregridrelease(routehandle=regrid_water, rc=rc)
989 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
997 where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
1000 where (landmask_target_ptr == 1) mask_target_ptr = 1
1002 method=esmf_regridmethod_conserve
1003 isrctermprocessing = 1
1005 print*,
"- CALL FieldRegridStore for land fields." 1008 srcmaskvalues=(/0/), &
1009 dstmaskvalues=(/0/), &
1010 polemethod=esmf_polemethod_none, &
1011 srctermprocessing=isrctermprocessing, &
1012 unmappedaction=esmf_unmappedaction_ignore, &
1013 normtype=esmf_normtype_fracarea, &
1014 routehandle=regrid_all_land, &
1015 regridmethod=method, &
1016 unmappeddstlist=unmapped_ptr, rc=rc)
1017 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1020 bundle_allland_target = esmf_fieldbundlecreate(name=
"all land target", rc=rc)
1021 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1023 bundle_allland_input = esmf_fieldbundlecreate(name=
"all land input", rc=rc)
1024 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1028 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1032 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1034 call esmf_fieldbundleget(bundle_allland_target,fieldcount=num_fields,rc=rc)
1035 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1038 allocate(search_nums(num_fields))
1039 allocate(dozero(num_fields))
1041 search_nums = (/223,66,65/)
1042 dozero=(/.true.,.false.,.false./)
1044 call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, &
1045 unmapped_ptr=unmapped_ptr)
1047 call esmf_fieldbundledestroy(bundle_allland_input,rc=rc)
1048 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1054 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1056 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1059 if (localpet == 0)
then 1061 land_target_one_tile = 0
1062 where(mask_target_one_tile == 1) land_target_one_tile = 1
1065 call search_many(num_fields,bundle_allland_target,data_one_tile, land_target_one_tile,&
1066 tile,search_nums,localpet)
1068 if (localpet == 0)
deallocate(land_target_one_tile)
1071 deallocate(search_nums)
1072 call esmf_fieldbundledestroy(bundle_allland_target,rc=rc)
1073 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1076 print*,
"- CALL FieldRegridRelease." 1077 call esmf_fieldregridrelease(routehandle=regrid_all_land, rc=rc)
1078 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1085 print*,
"- CALL FieldGet FOR INPUT GRID VEG TYPE." 1087 farrayptr=veg_type_input_ptr, rc=rc)
1088 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1096 print*,
"- CALL FieldGet FOR TARGET GRID VEG TYPE." 1098 farrayptr=veg_type_target_ptr, rc=rc)
1099 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1105 method=esmf_regridmethod_nearest_stod
1106 isrctermprocessing = 1
1108 print*,
"- CALL FieldRegridStore for landice fields." 1111 srcmaskvalues=(/0/), &
1112 dstmaskvalues=(/0/), &
1113 polemethod=esmf_polemethod_none, &
1114 srctermprocessing=isrctermprocessing, &
1115 unmappedaction=esmf_unmappedaction_ignore, &
1116 normtype=esmf_normtype_fracarea, &
1117 routehandle=regrid_landice, &
1118 regridmethod=method, &
1119 unmappeddstlist=unmapped_ptr, rc=rc)
1120 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1123 bundle_landice_target = esmf_fieldbundlecreate(name=
"landice target", rc=rc)
1124 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1126 bundle_landice_input = esmf_fieldbundlecreate(name=
"landice input", rc=rc)
1127 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1131 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1135 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1140 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1143 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1147 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1149 call esmf_fieldbundleget(bundle_landice_target,fieldcount=num_fields,rc=rc)
1150 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1153 allocate(search_nums(num_fields))
1154 allocate(dozero(num_fields))
1157 search_nums = (/21,7,21/)
1160 search_nums = (/21,7,21,231/)
1161 dozero(:)=(/.false.,.false.,.false.,.true./)
1164 call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, &
1165 unmapped_ptr=unmapped_ptr )
1167 call esmf_fieldbundledestroy(bundle_landice_input,rc=rc)
1168 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1171 if (localpet == 0)
then 1176 allocate (veg_type_target_one_tile(0,0))
1177 allocate (land_target_one_tile(0,0))
1178 allocate (data_one_tile2(0,0))
1182 print*,
"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1183 call esmf_fieldgather(
veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1184 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1187 if (localpet == 0)
then 1188 land_target_one_tile = 0
1192 print*,
"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile
1194 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1197 call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,&
1198 tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d)
1201 deallocate (veg_type_target_one_tile)
1202 deallocate (land_target_one_tile)
1203 deallocate(search_nums)
1205 call esmf_fieldbundledestroy(bundle_landice_target,rc=rc)
1206 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1209 print*,
"- CALL FieldRegridRelease." 1210 call esmf_fieldregridrelease(routehandle=regrid_landice, rc=rc)
1211 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1219 where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1
1223 where (landmask_target_ptr == 1) mask_target_ptr = 1
1226 method=esmf_regridmethod_nearest_stod
1227 isrctermprocessing = 1
1229 print*,
"- CALL FieldRegridStore for 3d land (but no land ice) fields." 1232 srcmaskvalues=(/0/), &
1233 dstmaskvalues=(/0/), &
1234 polemethod=esmf_polemethod_none, &
1235 srctermprocessing=isrctermprocessing, &
1236 unmappedaction=esmf_unmappedaction_ignore, &
1237 normtype=esmf_normtype_fracarea, &
1238 routehandle=regrid_land, &
1239 regridmethod=method, &
1240 unmappeddstlist=unmapped_ptr, rc=rc)
1241 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1244 bundle_nolandice_target = esmf_fieldbundlecreate(name=
"land no landice target", rc=rc)
1245 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1248 bundle_nolandice_input = esmf_fieldbundlecreate(name=
"land no landice input", rc=rc)
1249 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1254 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1259 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1270 print*,
"- CALL Field_Regrid ." 1273 routehandle=regrid_land, &
1274 zeroregion=esmf_region_select, &
1275 termorderflag=esmf_termorder_srcseq, rc=rc)
1276 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1280 farrayptr=soil_type_target_ptr, rc=rc)
1281 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1284 l = lbound(unmapped_ptr)
1285 u = ubound(unmapped_ptr)
1289 soil_type_target_ptr(i,j) = -9999.9
1299 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1302 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1304 call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1305 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1307 vgfrc_ind = num_fields
1311 call esmf_fieldbundleadd(bundle_nolandice_target, (/
lai_target_grid/), rc=rc)
1312 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1314 call esmf_fieldbundleadd(bundle_nolandice_input, (/
lai_input_grid/), rc=rc)
1315 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1317 call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1318 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1320 lai_ind = num_fields
1325 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1328 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1332 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1335 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1338 call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1339 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1342 mmvg_ind = num_fields-1
1345 call esmf_fieldbundleget(bundle_nolandice_target,fieldcount=num_fields,rc=rc)
1346 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1349 allocate(search_nums(num_fields))
1350 allocate(dozero(num_fields))
1352 search_nums(1:5) = (/85,7,224,85,86/)
1353 dozero(1:5) = (/.false.,.false.,.true.,.true.,.false./)
1361 search_nums(vgfrc_ind) = 224
1362 dozero(vgfrc_ind) = .true.
1366 search_nums(lai_ind) = 229
1367 dozero(lai_ind) = .true.
1371 search_nums(mmvg_ind) = 227
1372 dozero(mmvg_ind) = .true.
1374 search_nums(mmvg_ind+1) = 228
1375 dozero(mmvg_ind+1) = .true.
1378 call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, &
1379 unmapped_ptr=unmapped_ptr)
1381 call esmf_fieldbundledestroy(bundle_nolandice_input,rc=rc)
1382 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1385 if (localpet == 0)
then 1388 allocate (veg_type_target_one_tile(0,0))
1393 print*,
"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile
1395 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1398 print*,
"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile
1399 call esmf_fieldgather(
veg_type_target_grid, veg_type_target_one_tile, rootpet=0, tile=tile, rc=rc)
1400 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1403 if (localpet == 0)
then 1407 print*,
"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile
1409 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1412 call search_many(num_fields,bundle_nolandice_target,data_one_tile, mask_target_one_tile,&
1413 tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d)
1415 print*,
"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile
1417 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1420 if (localpet == 0)
then 1422 data_one_tile = data_one_tile_3d(:,:,j)
1424 data_one_tile_3d(:,:,j) = data_one_tile
1428 print*,
"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile
1430 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1434 print*,
"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE, TILE: ", tile
1436 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1441 print*,
"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile
1443 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1446 if (localpet == 0)
then 1450 print*,
"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile
1452 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
1458 deallocate(search_nums)
1459 call esmf_fieldbundledestroy(bundle_nolandice_target,rc=rc)
1460 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1463 print*,
"- CALL FieldRegridRelease." 1464 call esmf_fieldregridrelease(routehandle=regrid_land, rc=rc)
1465 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1468 deallocate(veg_type_target_one_tile)
1470 deallocate(data_one_tile, data_one_tile2)
1471 deallocate(data_one_tile_3d)
1472 deallocate(mask_target_one_tile)
1496 integer :: clb(3), cub(3), rc
1497 integer :: i, j, n, soil_type
1499 integer(esmf_kind_i8),
pointer :: landmask_ptr(:,:)
1502 real(esmf_kind_r8),
pointer :: soilm_liq_ptr(:,:,:)
1503 real(esmf_kind_r8),
pointer :: soilm_tot_ptr(:,:,:)
1504 real(esmf_kind_r8),
pointer :: soil_temp_ptr(:,:,:)
1505 real(esmf_kind_r8),
pointer :: soil_type_ptr(:,:)
1506 real(esmf_kind_r8),
pointer :: veg_type_ptr(:,:)
1508 print*,
"- COMPUTE LIQUID PORTION OF TOTAL SOIL MOISTURE." 1510 print*,
"- CALL FieldGet FOR TOTAL SOIL MOISTURE." 1512 computationallbound=clb, &
1513 computationalubound=cub, &
1514 farrayptr=soilm_tot_ptr, rc=rc)
1515 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1518 print*,
"- CALL FieldGet FOR LIQUID SOIL MOISTURE." 1520 farrayptr=soilm_liq_ptr, rc=rc)
1521 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1524 print*,
"- CALL FieldGet FOR SOIL TEMPERATURE." 1526 farrayptr=soil_temp_ptr, rc=rc)
1527 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1530 print*,
"- CALL FieldGet FOR VEGETATION TYPE." 1532 farrayptr=veg_type_ptr, rc=rc)
1533 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1536 print*,
"- CALL FieldGet FOR SOIL TYPE." 1538 farrayptr=soil_type_ptr, rc=rc)
1539 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1542 print*,
"- CALL FieldGet FOR LANDMASK." 1544 farrayptr=landmask_ptr, rc=rc)
1545 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1548 do j = clb(2), cub(2)
1549 do i = clb(1), cub(1)
1557 soil_type = nint(soil_type_ptr(i,j))
1559 do n = clb(3), cub(3)
1561 if (soil_temp_ptr(i,j,n) < (
frz_h2o-0.0001))
then 1568 ((soil_temp_ptr(i,j,n)-
frz_h2o)/soil_temp_ptr(i,j,n)))** &
1571 if (fk .lt. 0.02) fk = 0.02
1573 soilm_liq_ptr(i,j,n) = min( fk, soilm_tot_ptr(i,j,n) )
1581 soilm_liq_ptr(i,j,n) = frh2o(soil_temp_ptr(i,j,n), &
1582 soilm_tot_ptr(i,j,n), soilm_liq_ptr(i,j,n), &
1588 soilm_liq_ptr(i,j,n) = soilm_tot_ptr(i,j,n)
1625 FUNCTION frh2o (TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)
1642 REAL(esmf_kind_r8) :: sh2o
1643 REAL(esmf_kind_r8) :: smc
1647 REAL(esmf_kind_r8) :: tkelv
1649 REAL,
PARAMETER :: ck = 8.0
1650 REAL,
PARAMETER :: error = 0.005
1668 IF (ck .NE. 0.0)
THEN 1683 IF (swl .GT. (smc-0.02)) swl = smc-0.02
1684 IF (swl .LT. 0.) swl = 0.
1690 DO WHILE ( (nlog .LT. 10) .AND. (kcount .EQ. 0) )
1693 df = log(( psis*
grav/
hlice ) * ( ( 1.+ck*swl )**2. ) * &
1694 ( smcmax/(smc-swl) )**bx) - log(-(tkelv-
frz_h2o)/tkelv)
1695 denom = 2. * ck / ( 1.+ck*swl ) + bx / ( smc - swl )
1696 swlk = swl - df/denom
1702 IF (swlk .GT. (smc-0.02)) swlk = smc - 0.02
1703 IF (swlk .LT. 0.) swlk = 0.
1709 dswl = abs(swlk-swl)
1717 IF ( dswl .LE. error )
THEN 1743 IF (kcount .EQ. 0)
THEN 1746 ((tkelv-
frz_h2o)/tkelv))**(-1/bx))*smcmax
1748 IF (fk .LT. 0.02) fk = 0.02
1750 frh2o = min(fk, smc)
1780 integer :: clb(3), cub(3), i, j, k, rc
1781 integer :: soilt_input, soilt_target
1782 integer(esmf_kind_i8),
pointer :: landmask_ptr(:,:)
1784 real(esmf_kind_r8),
pointer :: soilm_tot_ptr(:,:,:)
1785 real(esmf_kind_r8),
pointer :: soil_type_input_ptr(:,:)
1786 real(esmf_kind_r8),
pointer :: soil_type_target_ptr(:,:)
1787 real(esmf_kind_r8),
pointer :: veg_greenness_ptr(:,:)
1788 real(esmf_kind_r8),
pointer :: veg_type_ptr(:,:)
1789 real :: f1, fn, smcdir, smctra
1791 print*,
"- RESCALE SOIL MOISTURE FOR CHANGES IN SOIL TYPE." 1793 print*,
"- CALL FieldGet FOR TOTAL SOIL MOISTURE." 1795 computationallbound=clb, &
1796 computationalubound=cub, &
1797 farrayptr=soilm_tot_ptr, rc=rc)
1798 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1801 print*,
"- CALL FieldGet FOR LAND MASK." 1803 farrayptr=landmask_ptr, rc=rc)
1804 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1807 print*,
"- CALL FieldGet FOR VEGETATION TYPE." 1809 farrayptr=veg_type_ptr, rc=rc)
1810 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1813 print*,
"- CALL FieldGet FOR VEGETATION GREENNESS." 1815 farrayptr=veg_greenness_ptr, rc=rc)
1816 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1819 print*,
"- CALL FieldGet FOR TARGET GRID SOIL TYPE." 1821 farrayptr=soil_type_target_ptr, rc=rc)
1822 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1825 print*,
"- CALL FieldGet FOR SOIL TYPE FROM INPUT GRID." 1827 farrayptr=soil_type_input_ptr, rc=rc)
1828 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1831 do j = clb(2), cub(2)
1832 do i = clb(1), cub(1)
1840 soilt_target = nint(soil_type_target_ptr(i,j))
1841 soilt_input = nint(soil_type_input_ptr(i,j))
1849 if (soilt_target /= soilt_input)
then 1854 f1=(soilm_tot_ptr(i,j,1)-
drysmc_input(soilt_input)) / &
1864 if (soilm_tot_ptr(i,j,1) <
refsmc_input(soilt_input))
then 1865 f1=(soilm_tot_ptr(i,j,1) -
wltsmc_input(soilt_input)) / &
1870 f1=(soilm_tot_ptr(i,j,1) -
refsmc_input(soilt_input)) / &
1880 soilm_tot_ptr(i,j,1) = ((1.0 - veg_greenness_ptr(i,j)) * smcdir) + &
1881 (veg_greenness_ptr(i,j) * smctra)
1891 if (soilm_tot_ptr(i,j,k) <
refsmc_input(soilt_input))
then 1892 fn = (soilm_tot_ptr(i,j,k) -
wltsmc_input(soilt_input)) / &
1897 fn = (soilm_tot_ptr(i,j,k) -
refsmc_input(soilt_input)) / &
1910 soilm_tot_ptr(i,j,1)=min(soilm_tot_ptr(i,j,1),
maxsmc_target(soilt_target))
1911 soilm_tot_ptr(i,j,1)=max(
drysmc_target(soilt_target),soilm_tot_ptr(i,j,1))
1914 soilm_tot_ptr(i,j,k)=min(soilm_tot_ptr(i,j,k),
maxsmc_target(soilt_target))
1915 soilm_tot_ptr(i,j,k)=max(
wltsmc_target(soilt_target),soilm_tot_ptr(i,j,k))
1940 integer :: clb(3), cub(3), i, j, k, rc
1941 integer(esmf_kind_i8),
pointer :: landmask_ptr(:,:)
1943 real,
parameter :: lapse_rate = 6.5e-03
1944 real :: terrain_diff
1945 real(esmf_kind_r8),
pointer :: terrain_input_ptr(:,:)
1946 real(esmf_kind_r8),
pointer :: terrain_target_ptr(:,:)
1947 real(esmf_kind_r8),
pointer :: veg_type_target_ptr(:,:)
1948 real(esmf_kind_r8),
pointer :: soil_temp_target_ptr(:,:,:)
1950 print*,
"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." 1952 farrayptr=landmask_ptr, rc=rc)
1953 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1956 print*,
"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." 1958 farrayptr=veg_type_target_ptr, rc=rc)
1959 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1962 print*,
"- CALL FieldGet FOR TARGET GRID TERRAIN." 1964 farrayptr=terrain_target_ptr, rc=rc)
1965 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1968 print*,
"- CALL FieldGet FOR TERRAIN INTERP TO TARGET GRID." 1970 farrayptr=terrain_input_ptr, rc=rc)
1971 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1974 print*,
"- CALL FieldGet FOR SOIL TEMP TARGET GRID." 1976 computationallbound=clb, &
1977 computationalubound=cub, &
1978 farrayptr=soil_temp_target_ptr, rc=rc)
1979 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
1982 do j = clb(2), cub(2)
1983 do i = clb(1), cub(1)
1984 if (landmask_ptr(i,j) == 1)
then 1985 terrain_diff = abs(terrain_input_ptr(i,j) - terrain_target_ptr(i,j))
1986 if (terrain_diff > 100.0)
then 1987 do k = clb(3), cub(3)
1988 soil_temp_target_ptr(i,j,k) = soil_temp_target_ptr(i,j,k) + &
1989 ((terrain_input_ptr(i,j) - terrain_target_ptr(i,j)) * lapse_rate)
1991 soil_temp_target_ptr(i,j,k) = min(soil_temp_target_ptr(i,j,k), 273.16)
2012 integer,
intent(in) :: localpet
2013 character(len=1000) :: msg
2015 real(esmf_kind_r8) :: tmp(i_input,j_input), &
2016 data_one_tile(i_input,j_input,lsoil_input), &
2017 tmp3d(i_input,j_input,lsoil_target)
2018 if (lsoil_input == 9 .and. lsoil_target == 4)
then 2019 print*,
"CONVERTING FROM 9 INPUT SOIL LEVELS TO 4 TARGET SOIL LEVELS" 2021 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2026 typekind=esmf_typekind_r8, &
2027 staggerloc=esmf_staggerloc_center, &
2028 ungriddedlbound=(/1/), &
2029 ungriddedubound=(/lsoil_target/), rc=rc)
2032 tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2033 (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2034 (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2035 tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5)
2036 tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2037 (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2038 tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2039 (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2040 tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8)
2041 tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2042 (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2046 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2050 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2055 typekind=esmf_typekind_r8, &
2056 staggerloc=esmf_staggerloc_center, &
2057 ungriddedlbound=(/1/), &
2058 ungriddedubound=(/lsoil_target/), rc=rc)
2060 if(localpet==0)
then 2061 tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2062 (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2063 (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2064 tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5)
2065 tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2066 (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2067 tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2068 (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2069 tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8)
2070 tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2071 (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2075 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2079 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2084 typekind=esmf_typekind_r8, &
2085 staggerloc=esmf_staggerloc_center, &
2086 ungriddedlbound=(/1/), &
2087 ungriddedubound=(/lsoil_target/), rc=rc)
2088 if(localpet==0)
then 2089 tmp3d(:,:,1)= (data_one_tile(:,:,1) + data_one_tile(:,:,2))/2.0 * 0.1 + &
2090 (data_one_tile(:,:,2) + data_one_tile(:,:,3))/2.0 * 0.3 + &
2091 (data_one_tile(:,:,3) + data_one_tile(:,:,4))/2.0 * 0.6
2092 tmp = (data_one_tile(:,:,6) - data_one_tile(:,:,5)) / 30.0 * 10.0 + data_one_tile(:,:,5)
2093 tmp3d(:,:,2)= (data_one_tile(:,:,4) + data_one_tile(:,:,5)) / 2.0 * 0.75 + &
2094 (data_one_tile(:,:,5) + tmp) / 2.0 * 0.25
2095 tmp3d(:,:,3)= (tmp + data_one_tile(:,:,6)) /2.0 * (1.0/3.0) + &
2096 (data_one_tile(:,:,6) + data_one_tile(:,:,7)) / 2.0 * (2.0/3.0)
2097 tmp = (data_one_tile(:,:,9) - data_one_tile(:,:,9)) / 140.0 * 40.0 + data_one_tile(:,:,8)
2098 tmp3d(:,:,4)= (data_one_tile(:,:,7) + data_one_tile(:,:,8)) / 2.0 * 0.6 + &
2099 (data_one_tile(:,:,8) + tmp) / 2.0 * 0.4
2103 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2106 elseif (lsoil_input /= lsoil_target)
then 2109 write(msg,
'("NUMBER OF SOIL LEVELS IN INPUT (",I2,") and OUPUT & 2110 (",I2,") MUST EITHER BE EQUAL OR 9 AND 4, RESPECTIVELY")') &
2111 lsoil_input, lsoil_target
2130 integer :: clb(2), cub(2), i, j, rc
2131 integer(esmf_kind_i8),
pointer :: landmask_ptr(:,:)
2134 real(esmf_kind_r8),
pointer :: data_ptr(:,:)
2135 real(esmf_kind_r8),
pointer :: veg_type_ptr(:,:)
2137 data z0_igbp /1.089, 2.653, 0.854, 0.826, 0.800, 0.050, &
2138 0.030, 0.856, 0.856, 0.150, 0.040, 0.130, &
2139 1.000, 0.250, 0.011, 0.011, 0.001, 0.076, &
2142 print*,
"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." 2144 computationallbound=clb, &
2145 computationalubound=cub, &
2146 farrayptr=landmask_ptr, rc=rc)
2147 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2150 print*,
"- CALL FieldGet FOR TARGET GRID VEGETATION TYPE." 2152 farrayptr=veg_type_ptr, rc=rc)
2153 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2156 print*,
"- CALL FieldGet FOR TARGET GRID Z0." 2158 farrayptr=data_ptr, rc=rc)
2159 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2162 do j = clb(2), cub(2)
2163 do i = clb(1), cub(1)
2164 if (landmask_ptr(i,j) == 2)
then 2166 elseif (landmask_ptr(i,j) == 1)
then 2167 data_ptr(i,j) = z0_igbp(nint(veg_type_ptr(i,j))) * 100.0
2198 integer :: clb(2), cub(2), i, j, rc
2199 integer(esmf_kind_i8),
pointer :: landmask_ptr(:,:)
2201 real(esmf_kind_r8),
pointer :: data_ptr(:,:)
2202 real(esmf_kind_r8),
pointer :: data3d_ptr(:,:,:)
2203 real(esmf_kind_r8),
pointer :: soilmt_ptr(:,:,:)
2204 real(esmf_kind_r8),
pointer :: soilml_ptr(:,:,:)
2205 real(esmf_kind_r8),
pointer :: veg_greenness_ptr(:,:)
2206 real(esmf_kind_r8),
pointer :: veg_type_ptr(:,:)
2207 real(esmf_kind_r8),
pointer :: seaice_skint_ptr(:,:)
2208 real(esmf_kind_r8),
pointer :: skint_ptr(:,:)
2209 real(esmf_kind_r8),
pointer :: fice_ptr(:,:)
2210 real(esmf_kind_r8),
pointer :: hice_ptr(:,:)
2212 print*,
"- CALL FieldGet FOR TARGET GRID LAND-SEA MASK." 2214 computationallbound=clb, &
2215 computationalubound=cub, &
2216 farrayptr=landmask_ptr, rc=rc)
2217 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2220 print*,
"- SET NON-LAND FLAG FOR TARGET GRID SLOPE TYPE." 2222 farrayptr=data_ptr, rc=rc)
2223 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2226 do j = clb(2), cub(2)
2227 do i = clb(1), cub(1)
2228 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2232 print*,
"- SET NON-LAND FLAG FOR TARGET GRID SOIL TYPE." 2234 farrayptr=data_ptr, rc=rc)
2235 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2238 do j = clb(2), cub(2)
2239 do i = clb(1), cub(1)
2240 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2244 print*,
"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION TYPE." 2246 farrayptr=veg_type_ptr, rc=rc)
2247 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2250 do j = clb(2), cub(2)
2251 do i = clb(1), cub(1)
2252 if (landmask_ptr(i,j) /= 1) veg_type_ptr(i,j) = 0.0
2256 print*,
"- SET TARGET GRID ALVSF AT NON-LAND." 2258 farrayptr=data_ptr, rc=rc)
2259 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2262 do j = clb(2), cub(2)
2263 do i = clb(1), cub(1)
2264 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06
2268 print*,
"- SET TARGET GRID ALVWF AT NON-LAND." 2270 farrayptr=data_ptr, rc=rc)
2271 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2274 do j = clb(2), cub(2)
2275 do i = clb(1), cub(1)
2276 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06
2280 print*,
"- SET TARGET GRID ALNSF AT NON-LAND." 2282 farrayptr=data_ptr, rc=rc)
2283 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2286 do j = clb(2), cub(2)
2287 do i = clb(1), cub(1)
2288 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06
2292 print*,
"- SET TARGET GRID ALNWF AT NON-LAND." 2294 farrayptr=data_ptr, rc=rc)
2295 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2298 do j = clb(2), cub(2)
2299 do i = clb(1), cub(1)
2300 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.06
2304 print*,
"- SET NON-LAND FLAG FOR TARGET GRID FACSF." 2306 farrayptr=data_ptr, rc=rc)
2307 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2310 do j = clb(2), cub(2)
2311 do i = clb(1), cub(1)
2312 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2316 print*,
"- SET NON-LAND FLAG FOR TARGET GRID FACSF." 2318 farrayptr=data_ptr, rc=rc)
2319 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2322 do j = clb(2), cub(2)
2323 do i = clb(1), cub(1)
2324 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2328 print*,
"- SET NON-LAND FLAG FOR TARGET GRID MAXIMUM GREENNESS." 2330 farrayptr=data_ptr, rc=rc)
2331 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2334 do j = clb(2), cub(2)
2335 do i = clb(1), cub(1)
2336 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2340 print*,
"- SET NON-LAND FLAG FOR TARGET GRID MINIMUM GREENNESS." 2342 farrayptr=data_ptr, rc=rc)
2343 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2346 do j = clb(2), cub(2)
2347 do i = clb(1), cub(1)
2348 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2352 print*,
"- SET NON-LAND FLAG FOR TARGET GRID VEGETATION GREENNESS." 2354 farrayptr=veg_greenness_ptr, rc=rc)
2355 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2358 do j = clb(2), cub(2)
2359 do i = clb(1), cub(1)
2360 if (landmask_ptr(i,j) /= 1) veg_greenness_ptr(i,j) = 0.0
2364 print*,
"- SET NON-LAND FLAG FOR TARGET GRID MAX SNOW ALBEDO." 2366 farrayptr=data_ptr, rc=rc)
2367 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2370 do j = clb(2), cub(2)
2371 do i = clb(1), cub(1)
2372 if (landmask_ptr(i,j) /= 1) data_ptr(i,j) = 0.0
2376 print*,
"- ZERO OUT TARGET GRID CANOPY MOISTURE CONTENT WHERE NO PLANTS." 2378 farrayptr=data_ptr, rc=rc)
2379 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2382 do j = clb(2), cub(2)
2383 do i = clb(1), cub(1)
2384 if (veg_greenness_ptr(i,j) <= 0.01) data_ptr(i,j) = 0.0
2388 print*,
"- CALL FieldGet FOR TARGET GRID ICE SKIN TEMP." 2390 farrayptr=seaice_skint_ptr, rc=rc)
2391 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2394 print*,
"- SET TARGET GRID SKIN TEMP AT ICE POINTS." 2396 farrayptr=skint_ptr, rc=rc)
2397 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2400 print*,
"- CALL FieldGet FOR TARGET GRID SEA ICE FRACTION." 2402 farrayptr=fice_ptr, rc=rc)
2403 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2406 print*,
"- SET TARGET GRID SEA ICE DEPTH TO ZERO AT NON-ICE POINTS." 2408 farrayptr=hice_ptr, rc=rc)
2409 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2412 do j = clb(2), cub(2)
2413 do i = clb(1), cub(1)
2414 if (fice_ptr(i,j) > 0.0)
then 2415 skint_ptr(i,j) = (fice_ptr(i,j) * seaice_skint_ptr(i,j)) + &
2416 ( (1.0 - fice_ptr(i,j)) *
frz_ice )
2418 seaice_skint_ptr(i,j) = skint_ptr(i,j)
2424 print*,
"- SET TARGET GRID SUBSTRATE TEMP AT ICE." 2426 farrayptr=data_ptr, rc=rc)
2427 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2430 do j = clb(2), cub(2)
2431 do i = clb(1), cub(1)
2432 if (landmask_ptr(i,j) == 2)
then 2434 elseif (landmask_ptr(i,j) == 0)
then 2435 data_ptr(i,j) = skint_ptr(i,j)
2440 print*,
"- ZERO OUT TARGET GRID SNOW DEPTH AT OPEN WATER." 2442 farrayptr=data_ptr, rc=rc)
2443 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2446 do j = clb(2), cub(2)
2447 do i = clb(1), cub(1)
2448 if (landmask_ptr(i,j) == 0)
then 2454 print*,
"- ZERO OUT TARGET GRID SNOW LIQ AT OPEN WATER." 2456 farrayptr=data_ptr, rc=rc)
2457 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2460 do j = clb(2), cub(2)
2461 do i = clb(1), cub(1)
2462 if (landmask_ptr(i,j) == 0)
then 2468 print*,
"- SET NON-LAND FLAG VALUE FOR TARGET GRID TOTAL SOIL MOISTURE." 2470 farrayptr=soilmt_ptr, rc=rc)
2471 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2474 print*,
"- SET NON-LAND FLAG VALUE FOR TARGET GRID LIQUID SOIL MOISTURE." 2476 farrayptr=soilml_ptr, rc=rc)
2477 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2480 do j = clb(2), cub(2)
2481 do i = clb(1), cub(1)
2482 if (landmask_ptr(i,j) == 2 .or. landmask_ptr(i,j) == 0 .or. &
2484 soilmt_ptr(i,j,:) = 1.0
2485 soilml_ptr(i,j,:) = 1.0
2490 print*,
"- SET OPEN WATER FLAG FOR TARGET GRID SOIL TEMPERATURE." 2492 farrayptr=data3d_ptr, rc=rc)
2493 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2496 do j = clb(2), cub(2)
2497 do i = clb(1), cub(1)
2498 if (landmask_ptr(i,j) == 0)
then 2499 data3d_ptr(i,j,:) = skint_ptr(i,j)
2518 integer(esmf_kind_i8),
pointer :: mask_ptr(:,:)
2520 integer,
PARAMETER :: num_nst_fields_minus2 = 16
2521 integer,
PARAMETER :: xz_fill = 30.0
2522 integer,
PARAMETER :: nst_fill = 0.0
2524 real(esmf_kind_r8),
pointer :: data_ptr(:,:)
2525 real(esmf_kind_r8),
pointer :: skint_ptr(:,:)
2527 type(esmf_field) :: temp_field
2528 type(esmf_fieldbundle) :: nst_bundle
2530 print*,
"- CALL FieldGet FOR TARGET GRID LANDMASK." 2532 farrayptr=mask_ptr, rc=rc)
2533 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2536 nst_bundle = esmf_fieldbundlecreate(name=
"nst_bundle", rc=rc)
2537 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2545 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2548 print*,
"- CALL FieldGet FOR TREF." 2550 farrayptr=data_ptr, rc=rc)
2551 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2554 print*,
"- CALL FieldGet FOR SKIN T." 2556 farrayptr=skint_ptr, rc=rc)
2557 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2560 where(mask_ptr /= 0) data_ptr = skint_ptr
2564 print*,
"- CALL FieldGet FOR XZ." 2566 farrayptr=data_ptr, rc=rc)
2567 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2570 where(mask_ptr /= 0) data_ptr = xz_fill
2572 do i = 1,num_nst_fields_minus2
2574 call esmf_fieldbundleget(nst_bundle,i,temp_field,rc=rc)
2575 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2578 call esmf_fieldget(temp_field,farrayptr=data_ptr,rc=rc)
2579 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2582 where(mask_ptr /= 0) data_ptr = nst_fill
2586 call esmf_fieldbundledestroy(nst_bundle,rc=rc)
2587 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
2603 real(esmf_kind_r8),
pointer :: target_ptr(:,:), target_ptr_3d(:,:,:)
2604 real :: init_val = -999.9
2606 print*,
"- CALL FieldCreate FOR TARGET GRID T2M." 2608 typekind=esmf_typekind_r8, &
2609 name=
"t2m_target_grid", &
2610 staggerloc=esmf_staggerloc_center, rc=rc)
2611 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2614 print*,
"- INITIALIZE TARGET grid t2m." 2616 farrayptr=target_ptr, rc=rc)
2617 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2620 target_ptr = init_val
2622 print*,
"- CALL FieldCreate FOR TARGET GRID Q2M." 2624 typekind=esmf_typekind_r8, &
2625 name=
"q2m_target_grid", &
2626 staggerloc=esmf_staggerloc_center, rc=rc)
2627 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2630 print*,
"- INITIALIZE TARGET grid q2m." 2632 farrayptr=target_ptr, rc=rc)
2633 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2636 target_ptr = init_val
2638 print*,
"- CALL FieldCreate FOR TARGET GRID TPRCP." 2640 typekind=esmf_typekind_r8, &
2641 name=
"tprcp_target_grid", &
2642 staggerloc=esmf_staggerloc_center, rc=rc)
2643 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2646 print*,
"- INITIALIZE TARGET grid tprcp." 2648 farrayptr=target_ptr, rc=rc)
2649 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2652 target_ptr = init_val
2654 print*,
"- CALL FieldCreate FOR TARGET GRID F10M." 2656 typekind=esmf_typekind_r8, &
2657 name=
"f10m_target_grid", &
2658 staggerloc=esmf_staggerloc_center, rc=rc)
2659 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2662 print*,
"- INITIALIZE TARGET grid f10m." 2664 farrayptr=target_ptr, rc=rc)
2665 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2668 target_ptr = init_val
2670 print*,
"- CALL FieldCreate FOR TARGET GRID FFMM." 2672 typekind=esmf_typekind_r8, &
2673 name=
"ffmm_target_grid", &
2674 staggerloc=esmf_staggerloc_center, rc=rc)
2675 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2678 print*,
"- INITIALIZE TARGET grid ffmm." 2680 farrayptr=target_ptr, rc=rc)
2681 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2684 target_ptr = init_val
2686 print*,
"- CALL FieldCreate FOR TARGET GRID USTAR." 2688 typekind=esmf_typekind_r8, &
2689 name=
"ustar_target_grid", &
2690 staggerloc=esmf_staggerloc_center, rc=rc)
2691 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2694 print*,
"- INITIALIZE TARGET grid ustar." 2696 farrayptr=target_ptr, rc=rc)
2697 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2700 target_ptr = init_val
2702 print*,
"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV." 2704 typekind=esmf_typekind_r8, &
2705 name=
"snow_liq_equiv_target_grid", &
2706 staggerloc=esmf_staggerloc_center, rc=rc)
2707 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2710 print*,
"- INITIALIZE TARGET grid snow liq equiv." 2712 farrayptr=target_ptr, rc=rc)
2713 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2716 target_ptr = init_val
2718 print*,
"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH." 2720 typekind=esmf_typekind_r8, &
2721 name=
"snow_depth_target_grid", &
2722 staggerloc=esmf_staggerloc_center, rc=rc)
2723 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2726 print*,
"- INITIALIZE TARGET grid snow depth." 2728 farrayptr=target_ptr, rc=rc)
2729 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2732 target_ptr = init_val
2734 print*,
"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION." 2736 typekind=esmf_typekind_r8, &
2737 name=
"seaice_fract_target_grid", &
2738 staggerloc=esmf_staggerloc_center, rc=rc)
2739 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2742 print*,
"- INITIALIZE TARGET grid sea ice fraction." 2744 farrayptr=target_ptr, rc=rc)
2745 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2748 target_ptr = init_val
2750 print*,
"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH." 2752 typekind=esmf_typekind_r8, &
2753 name=
"seaice_depth_target_grid", &
2754 staggerloc=esmf_staggerloc_center, rc=rc)
2755 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2758 print*,
"- INITIALIZE TARGET sea ice depth." 2760 farrayptr=target_ptr, rc=rc)
2761 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2764 target_ptr = init_val
2766 print*,
"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP." 2768 typekind=esmf_typekind_r8, &
2769 name=
"seaice_skin_temp_target_grid", &
2770 staggerloc=esmf_staggerloc_center, rc=rc)
2771 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2774 print*,
"- INITIALIZE TARGET sea ice skin temp." 2776 farrayptr=target_ptr, rc=rc)
2777 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2780 target_ptr = init_val
2782 print*,
"- CALL FieldCreate FOR TARGET GRID SRFLAG." 2784 typekind=esmf_typekind_r8, &
2785 name=
"srflag_target_grid", &
2786 staggerloc=esmf_staggerloc_center, rc=rc)
2787 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2790 print*,
"- INITIALIZE TARGET srflag." 2792 farrayptr=target_ptr, rc=rc)
2793 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2796 target_ptr = init_val
2798 print*,
"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE." 2800 typekind=esmf_typekind_r8, &
2801 name=
"skin_temp_target_grid", &
2802 staggerloc=esmf_staggerloc_center, rc=rc)
2803 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2806 print*,
"- INITIALIZE TARGET grid skin temp." 2808 farrayptr=target_ptr, rc=rc)
2809 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2812 target_ptr = init_val
2814 print*,
"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT." 2816 typekind=esmf_typekind_r8, &
2817 name=
"canopy_mc_target_grid", &
2818 staggerloc=esmf_staggerloc_center, rc=rc)
2819 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2822 print*,
"- INITIALIZE TARGET grid canopy moisture." 2824 farrayptr=target_ptr, rc=rc)
2825 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2828 target_ptr = init_val
2830 print*,
"- CALL FieldCreate FOR TARGET GRID LEAF AREA INDEX." 2832 typekind=esmf_typekind_r8, &
2833 name=
"lai_target_grid",&
2834 staggerloc=esmf_staggerloc_center, rc=rc)
2835 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2838 print*,
"- INITIALIZE TARGET leaf area index." 2840 farrayptr=target_ptr, rc=rc)
2841 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2844 target_ptr = init_val
2846 print*,
"- CALL FieldCreate FOR TARGET GRID Z0." 2848 typekind=esmf_typekind_r8, &
2849 name=
"z0_target_grid", &
2850 staggerloc=esmf_staggerloc_center, rc=rc)
2851 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2854 print*,
"- INITIALIZE TARGET grid z0." 2856 farrayptr=target_ptr, rc=rc)
2857 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2860 target_ptr = init_val
2862 print*,
"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN." 2864 typekind=esmf_typekind_r8, &
2865 name=
"terrain_from_input_grid", &
2866 staggerloc=esmf_staggerloc_center, rc=rc)
2867 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2870 print*,
"- INITIALIZE TARGET grid interpolated terrain." 2872 farrayptr=target_ptr, rc=rc)
2873 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2876 target_ptr = init_val
2878 print*,
"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE." 2880 typekind=esmf_typekind_r8, &
2881 staggerloc=esmf_staggerloc_center, &
2882 name=
"soil_type_from_input_grid", rc=rc)
2883 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2886 print*,
"- INITIALIZE TARGET grid soil type" 2888 farrayptr=target_ptr, rc=rc)
2889 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2892 target_ptr = init_val
2894 print*,
"- CALL FieldCreate FOR TARGET GRID SOIL TEMPERATURE." 2896 typekind=esmf_typekind_r8, &
2897 staggerloc=esmf_staggerloc_center, &
2898 name=
"soil_temp_target_grid", &
2899 ungriddedlbound=(/1/), &
2901 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2904 print*,
"- INITIALIZE TARGET grid soil temp" 2906 farrayptr=target_ptr_3d, rc=rc)
2907 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2910 target_ptr_3d = init_val
2912 print*,
"- CALL FieldCreate FOR TARGET GRID TOTAL SOIL MOISTURE." 2914 typekind=esmf_typekind_r8, &
2915 staggerloc=esmf_staggerloc_center, &
2916 name=
"soilm_tot_target_grid", &
2917 ungriddedlbound=(/1/), &
2919 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2922 print*,
"- INITIALIZE TARGET grid soil moist" 2924 farrayptr=target_ptr_3d, rc=rc)
2925 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2928 target_ptr_3d = init_val
2930 print*,
"- CALL FieldCreate FOR TARGET GRID LIQUID SOIL MOISTURE." 2932 typekind=esmf_typekind_r8, &
2933 staggerloc=esmf_staggerloc_center, &
2934 name=
"soilm_liq_target_grid", &
2935 ungriddedlbound=(/1/), &
2937 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2940 print*,
"- INITIALIZE TARGET grid soil liq" 2942 farrayptr=target_ptr_3d, rc=rc)
2943 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2946 target_ptr_3d = init_val
2961 print*,
"- CALL FieldCreate FOR TARGET GRID C_D." 2963 typekind=esmf_typekind_r8, &
2965 staggerloc=esmf_staggerloc_center, rc=rc)
2966 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2969 print*,
"- CALL FieldCreate FOR TARGET GRID C_0." 2971 typekind=esmf_typekind_r8, &
2973 staggerloc=esmf_staggerloc_center, rc=rc)
2974 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2977 print*,
"- CALL FieldCreate FOR TARGET GRID D_CONV." 2979 typekind=esmf_typekind_r8, &
2981 staggerloc=esmf_staggerloc_center, rc=rc)
2982 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2985 print*,
"- CALL FieldCreate FOR TARGET GRID DT_COOL." 2987 typekind=esmf_typekind_r8, &
2989 staggerloc=esmf_staggerloc_center, rc=rc)
2990 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
2993 print*,
"- CALL FieldCreate FOR TARGET GRID IFD." 2995 typekind=esmf_typekind_r8, &
2997 staggerloc=esmf_staggerloc_center, rc=rc)
2998 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3001 print*,
"- CALL FieldCreate FOR TARGET GRID QRAIN." 3003 typekind=esmf_typekind_r8, &
3005 staggerloc=esmf_staggerloc_center, rc=rc)
3006 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3009 print*,
"- CALL FieldCreate FOR TARGET GRID TREF." 3011 typekind=esmf_typekind_r8, &
3013 staggerloc=esmf_staggerloc_center, rc=rc)
3014 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3017 print*,
"- CALL FieldCreate FOR TARGET GRID W_D." 3019 typekind=esmf_typekind_r8, &
3021 staggerloc=esmf_staggerloc_center, rc=rc)
3022 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3025 print*,
"- CALL FieldCreate FOR TARGET GRID W_0." 3027 typekind=esmf_typekind_r8, &
3029 staggerloc=esmf_staggerloc_center, rc=rc)
3030 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3033 print*,
"- CALL FieldCreate FOR TARGET GRID XS." 3035 typekind=esmf_typekind_r8, &
3037 staggerloc=esmf_staggerloc_center, rc=rc)
3038 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3041 print*,
"- CALL FieldCreate FOR TARGET GRID XT." 3043 typekind=esmf_typekind_r8, &
3045 staggerloc=esmf_staggerloc_center, rc=rc)
3046 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3049 print*,
"- CALL FieldCreate FOR TARGET GRID XU." 3051 typekind=esmf_typekind_r8, &
3053 staggerloc=esmf_staggerloc_center, rc=rc)
3054 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3057 print*,
"- CALL FieldCreate FOR TARGET GRID XV." 3059 typekind=esmf_typekind_r8, &
3061 staggerloc=esmf_staggerloc_center, rc=rc)
3062 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3065 print*,
"- CALL FieldCreate FOR TARGET GRID XZ." 3067 typekind=esmf_typekind_r8, &
3069 staggerloc=esmf_staggerloc_center, rc=rc)
3070 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3073 print*,
"- CALL FieldCreate FOR TARGET GRID XTTS." 3075 typekind=esmf_typekind_r8, &
3077 staggerloc=esmf_staggerloc_center, rc=rc)
3078 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3081 print*,
"- CALL FieldCreate FOR TARGET GRID XZTS." 3083 typekind=esmf_typekind_r8, &
3085 staggerloc=esmf_staggerloc_center, rc=rc)
3086 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3089 print*,
"- CALL FieldCreate FOR TARGET GRID Z_C." 3091 typekind=esmf_typekind_r8, &
3093 staggerloc=esmf_staggerloc_center, rc=rc)
3094 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3097 print*,
"- CALL FieldCreate FOR TARGET GRID ZM." 3099 typekind=esmf_typekind_r8, &
3101 staggerloc=esmf_staggerloc_center, rc=rc)
3102 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3115 subroutine ij_to_i_j(ij, itile, jtile, i, j)
3119 integer(esmf_kind_i4),
intent(in) :: ij
3120 integer ,
intent(in) :: itile, jtile
3122 integer ,
intent(out) :: i, j
3125 integer :: pt_loc_this_tile
3127 tile_num = ((ij-1) / (itile*jtile))
3128 pt_loc_this_tile = ij - (tile_num * itile * jtile)
3131 j = (pt_loc_this_tile - 1) / itile + 1
3132 i = mod(pt_loc_this_tile, itile)
3150 subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero, &
3151 unmapped_ptr,resetifd)
3159 integer,
intent(in) :: num_field
3160 type(esmf_routehandle),
intent(inout) :: route
3161 type(esmf_fieldbundle),
intent(in) :: bundle_pre, bundle_post
3162 logical,
intent(in) :: dozero(num_field)
3163 logical,
intent(in),
optional :: resetifd
3164 integer(esmf_kind_i4),
intent(inout),
optional :: unmapped_ptr(:)
3166 type(esmf_field) :: field_pre,field_post
3167 real(esmf_kind_r8),
pointer :: tmp_ptr(:,:)
3170 logical :: is2d(num_field)
3171 character(len=50) :: fname
3172 integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet, l(1), u(1)
3178 if(
present(unmapped_ptr))
then 3179 l = lbound(unmapped_ptr)
3180 u = ubound(unmapped_ptr)
3184 call esmf_fieldbundleget(bundle_pre,i,field_pre,rc=rc)
3185 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3188 call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3189 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3192 call esmf_fieldget(field_post,dimcount=ndims,name=fname,rc=rc)
3193 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3196 call esmf_vmgetglobal(vm, rc=rc)
3197 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3199 call esmf_vmget(vm, localpet=localpet, rc=rc)
3200 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3202 if(localpet==0) print*,
"in regrid_many fname = ", fname, ndims
3203 if (ndims == 2) is2d(i) = .true.
3204 if (ndims == 3) is2d(i) = .false.
3207 call esmf_fieldregrid(field_pre, &
3209 routehandle=route, &
3210 termorderflag=esmf_termorder_srcseq, rc=rc)
3211 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3214 call esmf_fieldregrid(field_pre, &
3216 routehandle=route, &
3217 zeroregion=esmf_region_select, &
3218 termorderflag=esmf_termorder_srcseq, rc=rc)
3219 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3224 if (
present(resetifd))
then 3227 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3229 tmp_ptr = float(nint(tmp_ptr))
3233 n2d = count(is2d(:))
3234 n3d = count(.not.is2d(:))
3235 if(localpet==0) print*, is2d(:)
3236 if (
present(unmapped_ptr))
then 3237 allocate(ptr_2d(n2d))
3238 if (n3d .ne. 0)
allocate(ptr_3d(n3d))
3242 call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3243 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3245 call esmf_fieldget(field_post, farrayptr=ptr_2d(ind_2d)%p, rc=rc)
3246 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3248 call esmf_fieldget(field_post,name=fname,rc=rc)
3249 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3251 if (localpet==0) print*,
"in doreplace loop, 2d field = ", trim(fname)
3254 call esmf_fieldbundleget(bundle_post,i,field_post,rc=rc)
3255 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3257 call esmf_fieldget(field_post,name=fname,rc=rc)
3258 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3260 if (localpet==0) print*,
"in doreplace loop, 3d field = ", trim(fname)
3261 call esmf_fieldget(field_post, farrayptr=ptr_3d(ind_3d)%p, rc=rc)
3262 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
3270 ptr_2d(k)%p(i,j) = -9999.9
3273 ptr_3d(k)%p(i,j,:) = -9999.9
3277 if(n3d .ne. 0)
deallocate(ptr_3d)
3296 subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, &
3297 search_nums,localpet,latitude,terrain_land,soilt_climo,&
3306 integer,
intent(in) :: num_field
3307 type(esmf_fieldbundle),
intent(inout) :: bundle_target
3311 real(esmf_kind_r8),
intent(inout),
optional :: terrain_land(
i_target,
j_target)
3312 real(esmf_kind_r8),
intent(inout),
optional :: soilt_climo(
i_target,
j_target)
3316 integer,
intent(in) :: tile,localpet
3317 integer,
intent(inout) :: search_nums(num_field)
3319 type(esmf_field) :: temp_field
3320 character(len=50) :: fname
3321 integer,
parameter :: sotyp_land_field_num = 224
3322 integer,
parameter :: sst_field_num = 11
3323 integer,
parameter :: terrain_field_num= 7
3324 integer :: j,k, rc, ndims
3327 call esmf_fieldbundleget(bundle_target,k,temp_field, rc=rc)
3328 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3330 call esmf_fieldget(temp_field, name=fname, dimcount=ndims,rc=rc)
3331 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3333 if (ndims .eq. 2)
then 3334 print*,
"processing 2d field ", trim(fname)
3335 print*,
"FieldGather" 3336 call esmf_fieldgather(temp_field,field_data_2d,rootpet=0,tile=tile, rc=rc)
3337 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3339 if (localpet == 0)
then 3340 if (
present(latitude) .and. search_nums(k).eq.sst_field_num)
then 3344 elseif (
present(terrain_land) .and. search_nums(k) .eq. terrain_field_num)
then 3348 elseif (search_nums(k) .eq. sotyp_land_field_num)
then 3350 if (fname .eq.
"soil_type_target_grid")
then 3355 elseif (
present(soilt_climo))
then 3366 field_data_2d = soilt_climo
3375 call esmf_fieldscatter(temp_field, field_data_2d, rootpet=0, tile=tile,rc=rc)
3376 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3380 print*,
"FieldGather" 3381 call esmf_fieldgather(temp_field,field_data_3d,rootpet=0,tile=tile,rc=rc)
3382 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3384 print*,
"processing 3d field ", trim(fname)
3385 if (localpet==0)
then 3387 field_data_2d = field_data_3d(:,:,j)
3389 field_data_3d(:,:,j) = field_data_2d
3392 call esmf_fieldscatter(temp_field, field_data_3d, rootpet=0, tile=tile,rc=rc)
3393 if(esmf_logfounderror(rctocheck=rc,msg=esmf_logerr_passthru,line=__line__,file=__file__))&
3412 print*,
"- DESTROY LOCAL TARGET GRID SURFACE FIELDS." type(esmf_field), public d_conv_target_grid
Thickness of free convection layer.
integer, public j_target
j dimension of each global tile, or of a nest, target grid.
type(esmf_field), public zm_target_grid
Oceanic mixed layer depth.
This module contains code to read the setup namelist file, handle the varmap file for GRIB2 data...
real, parameter, private hlice
latent heat of fusion
integer, public num_tiles_target_grid
Number of tiles, target grid.
integer, public lsoil_target
Number of soil layers, target grid.
subroutine roughness
Set roughness length at land and sea ice.
real, parameter, private frz_ice
melting pt sea ice
type(esmf_field), public canopy_mc_target_grid
Canopy moisture content.
type(esmf_field), public f10m_target_grid
log((z0+10)*1/z0) See sfc_diff.f for details.
type(esmf_field), public c_d_target_grid
Coefficient 2 to calculate d(tz)/d(ts).
type(esmf_field), public ifd_target_grid
Model mode index.
integer, public j_input
j-dimension of input grid (or of each global tile)
type(esmf_field), public w_d_target_grid
Coefficient 4 to calculate d(tz)/d(ts).
type(esmf_field), public xtts_target_grid
d(xt)/d(ts).
real, dimension(:), allocatable, public wltsmc_input
Plant wilting point soil moisture content input grid.
subroutine, public search_many(num_field, bundle_target, field_data_2d, mask, tile, search_nums, localpet, latitude, terrain_land, soilt_climo, field_data_3d)
Execute the search function for multple fields.
logical, public lai_from_climo
If false, interpolate leaf area index from the input data to the target grid instead of using data fr...
type(esmf_field), public srflag_target_grid
Snow/rain flag.
type(esmf_field), public xu_target_grid
u-current content in diurnal thermocline layer.
subroutine, public surface_driver(localpet)
Driver routine to process surface/nst data.
real, dimension(:), allocatable, public maxsmc_input
Maximum soil moisture content input grid.
real, dimension(:), allocatable, public satpsi_target
Saturated soil potential, target grid.
Module to hold ESMF fields associated with the target grid surface data.
type(esmf_field), public min_veg_greenness_target_grid
minimum annual greenness fraction
type(esmf_field), public tprcp_target_grid
Precipitation.
type(esmf_field), public max_veg_greenness_target_grid
maximum annual greenness fraction
type(esmf_field), public mxsno_albedo_target_grid
maximum snow albedo
Sets up the ESMF grid objects for the input data grid and target FV3 grid.
real, dimension(:), allocatable, public bb_target
Soil 'b' parameter, target grid.
type(esmf_field), public alvwf_target_grid
visible white sky albedo
type(esmf_field) terrain_from_input_grid_land
terrain height interpolated from input grid at all land points
subroutine cleanup_all_target_sfc_data
Free up memory once the target grid surface fields are no longer needed.
type(esmf_field), public latitude_target_grid
latitude of grid center, target grid
Replace undefined values with a valid value.
integer, public i_target
i dimension of each global tile, or of a nest, target grid.
logical, public sotyp_from_climo
If false, interpolate soil type from the input data to the target grid instead of using data from sta...
type(esmf_field), public xzts_target_grid
d(xz)/d(ts).
logical, public minmax_vgfrc_from_climo
If false, interpolate min/max vegetation fraction from the input data to the target grid instead of u...
type(esmf_field), public c_0_target_grid
Coefficient 1 to calculate d(tz)/d(ts).
subroutine, public create_surface_esmf_fields
Create ESMF fields for the target grid surface variables.
type(esmf_field), public soilm_liq_target_grid
3-d liquid soil moisture.
type(esmf_grid), public target_grid
target grid esmf grid object.
type(esmf_field), public alnsf_target_grid
near ir black sky albedo
type(esmf_field), public xz_target_grid
Diurnal thermocline layer thickness.
real, parameter, private grav
gravity
character(len=20), public external_model
The model that the input data is derived from.
type(esmf_field), public z_c_target_grid
Sub-layer cooling thickness.
subroutine, public search(field, mask, idim, jdim, tile, field_num, latitude, terrain_land, soilt_climo)
Replace undefined surface values.
type(esmf_field) soil_type_from_input_grid
soil type interpolated from input grid
type(esmf_field), public lai_target_grid
Leaf area index.
subroutine, public cleanup_static_fields
Free up memory for fields in this module.
subroutine calc_liq_soil_moisture
Compute liquid portion of the total soil moisture.
type(esmf_field), public landmask_target_grid
land mask target grid - '1' land; '0' non-land
type(esmf_field), public seaice_fract_target_grid
Sea ice fraction.
subroutine rescale_soil_moisture
Adjust soil moisture for changes in soil type between the input and target grids. ...
subroutine adjust_soilt_for_terrain
Adjust soil temperature for changes in terrain height between the input and target grids...
logical, public convert_nst
Convert nst data when true.
type(esmf_field), public snow_liq_equiv_target_grid
Liquid equivalent snow depth.
type(esmf_field), public qrain_target_grid
Sensible heat flux due to rainfall.
type(esmf_field), public soilm_tot_target_grid
3-d total soil moisture.
subroutine adjust_soil_levels(localpet)
Adjust soil levels of the input grid if there is a mismatch between input and target grids...
logical, public tg3_from_soil
If false, use lowest level soil temperature for the base soil temperature instead of using data from ...
integer, parameter veg_type_landice_target
Vegetation type category that defines permanent land ice points.
type(esmf_field), public seaice_depth_target_grid
Sea ice depth.
type(esmf_field), public ffmm_target_grid
log((z0+z1)*1/z0) See sfc_diff.f for details.
type(esmf_field), public seaice_skin_temp_target_grid
Sea ice skin temperature.
subroutine, public interp(localpet)
Horizontally interpolate surface fields from input to target FV3 grid using esmf routines.
type(esmf_field), public alvsf_target_grid
visible black sky albedo
real, dimension(:), allocatable, public drysmc_input
Air dry soil moisture content input grid.
real, dimension(:), allocatable, public wltsmc_target
Plant wilting point soil moisture content target grid.
type(esmf_field), public slope_type_target_grid
slope type
Reads static surface climatological data for the target FV3 grid (such as soil type and vegetation ty...
type(esmf_field), public xs_target_grid
Salinity content in diurnal thermocline layer.
logical, public vgfrc_from_climo
If false, interpolate vegetation fraction from the input data to the target grid instead of using dat...
subroutine, public calc_soil_params_driver(localpet)
Driver routine to compute soil parameters for each soil type.
subroutine, public create_nst_esmf_fields
Create ESMF fields for the target grid nst variables.
type(esmf_grid), public input_grid
input grid esmf grid object
type(esmf_field), public ustar_target_grid
Friction velocity.
subroutine error_handler(string, rc)
General error handler.
type(esmf_field), public tref_target_grid
Reference temperature.
type(esmf_field), public q2m_target_grid
2-m specific humidity.
subroutine, public regrid_many(bundle_pre, bundle_post, num_field, route, dozero, unmapped_ptr, resetifd)
Regrid multiple ESMF fields from input to target grid.
subroutine, public nst_land_fill
nst is not active at land or sea ice points.
character(len=25), public input_type
Input data type:
real, parameter, private frz_h2o
melting pt water
Process surface and nst fields.
type(esmf_field), public terrain_target_grid
terrain height target grid
real, dimension(:), allocatable, public refsmc_target
Reference soil moisture content target grid (onset of soil moisture stress).
type(esmf_field), public substrate_temp_target_grid
soil subtrate temperature
type(esmf_field), public veg_greenness_target_grid
vegetation greenness fraction
type(esmf_field), public skin_temp_target_grid
Skin temperature/sst.
type(esmf_field), public xv_target_grid
v-current content in diurnal thermocline layer.
type(esmf_field), public xt_target_grid
Heat content in diurnal thermocline layer.
type(esmf_field), public seamask_target_grid
sea mask target grid - '1' non-land; '0' land
type(esmf_field), public veg_type_target_grid
vegetation type
subroutine qc_check
Perform some quality control checks before output.
type(esmf_field), public z0_target_grid
Roughness length.
logical, public vgtyp_from_climo
If false, interpolate vegetation type from the input data to the target grid instead of using data fr...
type(esmf_field), public facwf_target_grid
fractional coverage for weak zenith angle dependent albedo
type(esmf_field) terrain_from_input_grid
terrain height interpolated from input grid
subroutine, public get_static_fields(localpet)
Driver routine to read/time interpolate static/climo fields on the fv3 target grid.
subroutine ij_to_i_j(ij, itile, jtile, i, j)
Convert 1d index to 2d indices.
type(esmf_field), public t2m_target_grid
2-m temperatrure.
subroutine, public cleanup_target_nst_data
Free up memory once the target grid nst fields are no longer needed.
type(esmf_field), public soil_temp_target_grid
3-d soil temperature.
real, dimension(:), allocatable, public refsmc_input
Reference soil moisture content input grid (onset of soil moisture stress).
subroutine, public cleanup_target_sfc_data
Free up memory once the target grid surface fields are no longer needed.
type(esmf_field), public alnwf_target_grid
near ir white sky albedo
real, dimension(:), allocatable, public maxsmc_target
Maximum soil moisture content target grid.
real, dimension(:), allocatable, public drysmc_target
Air dry soil moisture content target grid.
type(esmf_field), public dt_cool_target_grid
Sub-layer cooling amount.
integer, public i_input
i-dimension of input grid (or of each global tile)
type(esmf_field), public w_0_target_grid
Coefficient 3 to calculate d(tz)/d(ts).
type(esmf_field), public facsf_target_grid
fractional coverage for strong zenith angle dependent albedo
real, parameter, private blim
soil 'b' parameter limit
type(esmf_field), public snow_depth_target_grid
Physical snow depth.
type(esmf_field), public soil_type_target_grid
soil type