From 631816e337835cad8ae6ae7286f9a19d59c1ae50 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Thu, 29 Apr 2021 16:47:35 -0500 Subject: [PATCH 01/18] First test for the regrid_many capability. --- sorc/chgres_cube.fd/surface.F90 | 172 ++++++++++++++++++++------------ 1 file changed, 110 insertions(+), 62 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index f373bebd4..74bc71e90 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -137,6 +137,10 @@ module surface !< gravity real, parameter, private :: hlice = 3.335E5 !< latent heat of fusion + + type fieldptr + type(esmf_field), pointer :: f + end type fieldptr public :: surface_driver @@ -389,6 +393,7 @@ subroutine interp(localpet) integer :: i, j, ij, rc, tile integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing + integer :: num_fields integer(esmf_kind_i4), pointer :: unmapped_ptr(:) integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) @@ -450,6 +455,8 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_nonland type(esmf_routehandle) :: regrid_seaice type(esmf_routehandle) :: regrid_water + + type(fieldptr), allocatable :: fields_to_regrid, target_fields !----------------------------------------------------------------------- ! Interpolate fieids that do not require 'masked' interpolation. @@ -919,69 +926,80 @@ subroutine interp(localpet) termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for sea ice depth." - call ESMF_FieldRegrid(seaice_depth_input_grid, & - seaice_depth_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid sea ice depth." - call ESMF_FieldGet(seaice_depth_target_grid, & - farrayPtr=seaice_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for snow depth." - call ESMF_FieldRegrid(snow_depth_input_grid, & - snow_depth_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid snow depth." - call ESMF_FieldGet(snow_depth_target_grid, & - farrayPtr=snow_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for snow liq equiv." - call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & - snow_liq_equiv_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." - call ESMF_FieldGet(snow_liq_equiv_target_grid, & - farrayPtr=snow_liq_equiv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for sea ice skin temp." - call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & - seaice_skin_temp_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." - call ESMF_FieldGet(seaice_skin_temp_target_grid, & - farrayPtr=seaice_skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + +!!!! Commenting out and replacing with a regrid_many subroutine +! print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." +! call ESMF_FieldGet(soil_temp_target_grid, & +! farrayPtr=soil_temp_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc)! +! +! print*,"- CALL Field_Regrid for sea ice depth." +! call ESMF_FieldRegrid(seaice_depth_input_grid, & +! seaice_depth_target_grid, & +! routehandle=regrid_seaice, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET grid sea ice depth." +! call ESMF_FieldGet(seaice_depth_target_grid, & +! farrayPtr=seaice_depth_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL Field_Regrid for snow depth." +! call ESMF_FieldRegrid(snow_depth_input_grid, & +! snow_depth_target_grid, & +! routehandle=regrid_seaice, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET grid snow depth." +! call ESMF_FieldGet(snow_depth_target_grid, & +! farrayPtr=snow_depth_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL Field_Regrid for snow liq equiv." +! call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & +! snow_liq_equiv_target_grid, & +! routehandle=regrid_seaice, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." +! call ESMF_FieldGet(snow_liq_equiv_target_grid, & +! farrayPtr=snow_liq_equiv_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL Field_Regrid for sea ice skin temp." +! call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & +! seaice_skin_temp_target_grid, & +! routehandle=regrid_seaice, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." +! call ESMF_FieldGet(seaice_skin_temp_target_grid, & +! farrayPtr=seaice_skin_temp_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) + num_fields_regrid = 4 + allocate(fields_to_regrid(4)) + allocate(target_fields(4)) + fields_to_regrid(:)%p => (/seaice_depth_input_grid,snow_depth_input_grid, & + snow_liq_equiv_input_grid,skin_temp_input_grid/) + target_fields(:)%p => (/seaice_depth_target_grid,snow_depth_target_grid, & + snow_liq_equiv_target_grid,skin_temp_target_grid/) + call regrid_many(fields_to_regrid,target_fields,num_fields_regrid,regrd_seaice) + deallocate(fields_to_regrid,target_fields) + l = lbound(unmapped_ptr) u = ubound(unmapped_ptr) @@ -4779,6 +4797,36 @@ subroutine ij_to_i_j(ij, itile, jtile, i, j) return end subroutine ij_to_i_j + + subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) + + implicit none + + use esmf + + integer, intent(in) :: num_field + type(esmf_routehandle), intent(in) :: route + type(field_ptr), intent(in) :: fields_pre(num_field), fields_post(num_field) + real(esmf_kind_r8), pointer, intent(inout) :: post_ptrs(num_field) + + integer :: i, rc + + do i = 1, num_field + + call ESMF_FieldRegrid(fields_pre(i), & + fields_post(i)%f, & + routehandle=route, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + + call ESMF_FieldGet(fields_post(i)%f, & + farrayPtr=post_ptrs(i), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc)! + end do + + end subroutine regrid_many !> Free up memory once the target grid surface fields are !! no longer needed. From bab678c321bf1afc566fa3b7746de892b236c3fb Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Mon, 3 May 2021 22:51:06 +0000 Subject: [PATCH 02/18] Added search_many routine. Extended use to regridding over water. Code compiles and runs to completion w/ reasonable results. --- sorc/chgres_cube.fd/input_data.F90 | 86 +- sorc/chgres_cube.fd/surface.F90 | 1737 +++++++++++++++------------- 2 files changed, 991 insertions(+), 832 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 83c0bcaaa..4850dde3c 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -73,33 +73,33 @@ module input_data !< Default is igbp. integer, parameter :: ICET_DEFAULT = 265.0 !< Default value of soil and skin !< temperature (K) over ice. - type(esmf_field), public :: canopy_mc_input_grid !< canopy moist content - type(esmf_field), public :: f10m_input_grid !< log((z0+10)*1/z0) - type(esmf_field), public :: ffmm_input_grid !< log((z0+z1)*1/z0) + type(esmf_field), public,target :: canopy_mc_input_grid !< canopy moist content + type(esmf_field), public,target :: f10m_input_grid !< log((z0+10)*1/z0) + type(esmf_field), public,target :: ffmm_input_grid !< log((z0+z1)*1/z0) !! See sfc_diff.f for details. - type(esmf_field), public :: landsea_mask_input_grid !< land sea mask; + type(esmf_field), public,target :: landsea_mask_input_grid !< land sea mask; !! 0-water, 1-land, 2-ice - type(esmf_field), public :: q2m_input_grid !< 2-m spec hum - type(esmf_field), public :: seaice_depth_input_grid !< sea ice depth - type(esmf_field), public :: seaice_fract_input_grid !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_input_grid !< sea ice skin temp - type(esmf_field), public :: skin_temp_input_grid !< skin temp/sst - type(esmf_field), public :: snow_depth_input_grid !< snow dpeth - type(esmf_field), public :: snow_liq_equiv_input_grid !< snow liq equiv depth - type(esmf_field), public :: soil_temp_input_grid !< 3-d soil temp - type(esmf_field), public :: soil_type_input_grid !< soil type - type(esmf_field), public :: soilm_liq_input_grid !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_input_grid !< 3-d total soil moisture - type(esmf_field), public :: srflag_input_grid !< snow/rain flag - type(esmf_field), public :: t2m_input_grid !< 2-m temperature - type(esmf_field), public :: tprcp_input_grid !< precip - type(esmf_field), public :: ustar_input_grid !< fric velocity - type(esmf_field), public :: veg_type_input_grid !< vegetation type - type(esmf_field), public :: z0_input_grid !< roughness length - type(esmf_field), public :: veg_greenness_input_grid !< vegetation fraction - type(esmf_field), public :: lai_input_grid !< leaf area index - type(esmf_field), public :: max_veg_greenness_input_grid !< shdmax - type(esmf_field), public :: min_veg_greenness_input_grid !< shdmin + type(esmf_field), public,target :: q2m_input_grid !< 2-m spec hum + type(esmf_field), public,target :: seaice_depth_input_grid !< sea ice depth + type(esmf_field), public,target :: seaice_fract_input_grid !< sea ice fraction + type(esmf_field), public,target :: seaice_skin_temp_input_grid !< sea ice skin temp + type(esmf_field), public,target :: skin_temp_input_grid !< skin temp/sst + type(esmf_field), public,target :: snow_depth_input_grid !< snow dpeth + type(esmf_field), public,target :: snow_liq_equiv_input_grid !< snow liq equiv depth + type(esmf_field), public,target :: soil_temp_input_grid !< 3-d soil temp + type(esmf_field), public,target :: soil_type_input_grid !< soil type + type(esmf_field), public,target :: soilm_liq_input_grid !< 3-d liquid soil moisture + type(esmf_field), public,target :: soilm_tot_input_grid !< 3-d total soil moisture + type(esmf_field), public,target :: srflag_input_grid !< snow/rain flag + type(esmf_field), public,target :: t2m_input_grid !< 2-m temperature + type(esmf_field), public,target :: tprcp_input_grid !< precip + type(esmf_field), public,target :: ustar_input_grid !< fric velocity + type(esmf_field), public,target :: veg_type_input_grid !< vegetation type + type(esmf_field), public,target :: z0_input_grid !< roughness length + type(esmf_field), public,target :: veg_greenness_input_grid !< vegetation fraction + type(esmf_field), public,target :: lai_input_grid !< leaf area index + type(esmf_field), public,target :: max_veg_greenness_input_grid !< shdmax + type(esmf_field), public,target :: min_veg_greenness_input_grid !< shdmin integer, public :: lsoil_input=4 !< number of soil layers, no longer hardwired to allow !! for 7 layers of soil for the RUC LSM @@ -108,25 +108,25 @@ module input_data ! Fields associated with the nst model. - type(esmf_field), public :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_input_grid !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_input_grid !< Sub-layer cooling amount - type(esmf_field), public :: ifd_input_grid !< Model mode index. 0-diurnal model not + type(esmf_field), public,target :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) + type(esmf_field), public,target :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) + type(esmf_field), public,target :: d_conv_input_grid !< Thickness of free convection layer + type(esmf_field), public,target :: dt_cool_input_grid !< Sub-layer cooling amount + type(esmf_field), public,target :: ifd_input_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public :: qrain_input_grid !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_input_grid !< Reference temperature - type(esmf_field), public :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_input_grid !< Salinity content in diurnal thermocline layer - type(esmf_field), public :: xt_input_grid !< Heat content in diurnal thermocline layer - type(esmf_field), public :: xu_input_grid !< u-current content in diurnal thermocline layer - type(esmf_field), public :: xv_input_grid !< v-current content in diurnal thermocline layer - type(esmf_field), public :: xz_input_grid !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_input_grid !< d(xt)/d(ts) - type(esmf_field), public :: xzts_input_grid !< d(xz)/d(ts) - type(esmf_field), public :: z_c_input_grid !< Sub-layer cooling thickness - type(esmf_field), public :: zm_input_grid !< Oceanic mixed layer depth + type(esmf_field), public,target :: qrain_input_grid !< Sensible heat flux due to rainfall + type(esmf_field), public,target :: tref_input_grid !< Reference temperature + type(esmf_field), public,target :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) + type(esmf_field), public,target :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) + type(esmf_field), public,target :: xs_input_grid !< Salinity content in diurnal thermocline layer + type(esmf_field), public,target :: xt_input_grid !< Heat content in diurnal thermocline layer + type(esmf_field), public,target :: xu_input_grid !< u-current content in diurnal thermocline layer + type(esmf_field), public,target :: xv_input_grid !< v-current content in diurnal thermocline layer + type(esmf_field), public,target :: xz_input_grid !< Diurnal thermocline layer thickness + type(esmf_field), public,target :: xtts_input_grid !< d(xt)/d(ts) + type(esmf_field), public,target :: xzts_input_grid !< d(xz)/d(ts) + type(esmf_field), public,target :: z_c_input_grid !< Sub-layer cooling thickness + type(esmf_field), public,target :: zm_input_grid !< Oceanic mixed layer depth public :: read_input_atm_data public :: cleanup_input_atm_data diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 74bc71e90..ad6010130 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -33,88 +33,88 @@ module surface !< are applied at these points. ! surface fields (not including nst) - type(esmf_field), public :: canopy_mc_target_grid + type(esmf_field), public, target :: canopy_mc_target_grid !< canopy moisture content - type(esmf_field), public :: f10m_target_grid + type(esmf_field), public, target :: f10m_target_grid !< log((z0+10)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public :: ffmm_target_grid + type(esmf_field), public, target :: ffmm_target_grid !< log((z0+z1)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public :: q2m_target_grid + type(esmf_field), public, target :: q2m_target_grid !< 2-m specific humidity - type(esmf_field), public :: seaice_depth_target_grid + type(esmf_field), public, target :: seaice_depth_target_grid !< sea ice depth - type(esmf_field), public :: seaice_fract_target_grid + type(esmf_field), public, target :: seaice_fract_target_grid !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_target_grid + type(esmf_field), public, target :: seaice_skin_temp_target_grid !< sea ice skin temperature - type(esmf_field), public :: skin_temp_target_grid + type(esmf_field), public, target :: skin_temp_target_grid !< skin temperature/sst - type(esmf_field), public :: srflag_target_grid + type(esmf_field), public, target :: srflag_target_grid !< snow/rain flag - type(esmf_field), public :: snow_liq_equiv_target_grid + type(esmf_field), public, target :: snow_liq_equiv_target_grid !< liquid equiv snow depth - type(esmf_field), public :: snow_depth_target_grid + type(esmf_field), public, target :: snow_depth_target_grid !< physical snow depth - type(esmf_field), public :: soil_temp_target_grid + type(esmf_field), public, target :: soil_temp_target_grid !< 3-d soil temperature - type(esmf_field), public :: soilm_liq_target_grid + type(esmf_field), public, target :: soilm_liq_target_grid !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_target_grid + type(esmf_field), public, target :: soilm_tot_target_grid !< 3-d total soil moisture - type(esmf_field), public :: t2m_target_grid + type(esmf_field), public, target :: t2m_target_grid !< 2-m temperatrure - type(esmf_field), public :: tprcp_target_grid + type(esmf_field), public, target :: tprcp_target_grid !< precip - type(esmf_field), public :: ustar_target_grid + type(esmf_field), public, target :: ustar_target_grid !< friction velocity - type(esmf_field), public :: z0_target_grid + type(esmf_field), public, target :: z0_target_grid !< roughness length - type(esmf_field), public :: lai_target_grid + type(esmf_field), public, target :: lai_target_grid !< leaf area index ! nst fields - type(esmf_field), public :: c_d_target_grid + type(esmf_field), public, target :: c_d_target_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_target_grid + type(esmf_field), public, target :: c_0_target_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_target_grid + type(esmf_field), public, target :: d_conv_target_grid !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_target_grid + type(esmf_field), public, target :: dt_cool_target_grid !< Sub-layer cooling amount - type(esmf_field), public :: ifd_target_grid + type(esmf_field), public, target :: ifd_target_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public :: qrain_target_grid + type(esmf_field), public, target :: qrain_target_grid !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_target_grid + type(esmf_field), public, target :: tref_target_grid !< reference temperature - type(esmf_field), public :: w_d_target_grid + type(esmf_field), public, target :: w_d_target_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_target_grid + type(esmf_field), public, target :: w_0_target_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_target_grid + type(esmf_field), public, target :: xs_target_grid !< Salinity content in diurnal !< thermocline layer - type(esmf_field), public :: xt_target_grid + type(esmf_field), public, target :: xt_target_grid !< Heat content in diurnal thermocline !< layer - type(esmf_field), public :: xu_target_grid + type(esmf_field), public, target :: xu_target_grid !< u-current content in diurnal !< thermocline layer - type(esmf_field), public :: xv_target_grid + type(esmf_field), public, target :: xv_target_grid !< v-current content in diurnal !< thermocline layer - type(esmf_field), public :: xz_target_grid + type(esmf_field), public, target :: xz_target_grid !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_target_grid + type(esmf_field), public, target :: xtts_target_grid !< d(xt)/d(ts) - type(esmf_field), public :: xzts_target_grid + type(esmf_field), public, target :: xzts_target_grid !< d(xz)/d(ts) - type(esmf_field), public :: z_c_target_grid + type(esmf_field), public, target :: z_c_target_grid !< Sub-layer cooling thickness - type(esmf_field), public :: zm_target_grid + type(esmf_field), public, target :: zm_target_grid !< Oceanic mixed layer depth type(esmf_field) :: soil_type_from_input_grid @@ -142,6 +142,10 @@ module surface type(esmf_field), pointer :: f end type fieldptr + type realptr + real(esmf_kind_r8), pointer :: p(:,:) + end type realptr + public :: surface_driver contains @@ -390,10 +394,11 @@ subroutine interp(localpet) integer, intent(in) :: localpet integer :: l(1), u(1) - integer :: i, j, ij, rc, tile + integer :: i, j, ij, rc, tile,k integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing integer :: num_fields + integer, allocatable :: search_nums(:) integer(esmf_kind_i4), pointer :: unmapped_ptr(:) integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) @@ -456,7 +461,8 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_seaice type(esmf_routehandle) :: regrid_water - type(fieldptr), allocatable :: fields_to_regrid, target_fields + type(fieldptr), allocatable :: fields_to_regrid(:), target_fields(:) + type(realptr), allocatable :: target_ptrs(:) !----------------------------------------------------------------------- ! Interpolate fieids that do not require 'masked' interpolation. @@ -927,12 +933,12 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegrid", rc) -!!!! Commenting out and replacing with a regrid_many subroutine -! print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." -! call ESMF_FieldGet(soil_temp_target_grid, & -! farrayPtr=soil_temp_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc)! +! Commenting out and replacing with a regrid_many subroutine + print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." + call ESMF_FieldGet(soil_temp_target_grid, & + farrayPtr=soil_temp_target_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc)! ! ! print*,"- CALL Field_Regrid for sea ice depth." ! call ESMF_FieldRegrid(seaice_depth_input_grid, & @@ -990,34 +996,51 @@ subroutine interp(localpet) ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & ! call error_handler("IN FieldGet", rc) - num_fields_regrid = 4 - allocate(fields_to_regrid(4)) - allocate(target_fields(4)) - fields_to_regrid(:)%p => (/seaice_depth_input_grid,snow_depth_input_grid, & - snow_liq_equiv_input_grid,skin_temp_input_grid/) - target_fields(:)%p => (/seaice_depth_target_grid,snow_depth_target_grid, & - snow_liq_equiv_target_grid,skin_temp_target_grid/) - call regrid_many(fields_to_regrid,target_fields,num_fields_regrid,regrd_seaice) - deallocate(fields_to_regrid,target_fields) + num_fields = 4 + allocate(fields_to_regrid(num_fields)) + allocate(target_fields(num_fields)) + allocate(target_ptrs(num_fields)) + allocate(search_nums(num_fields)) + + target_fields(1)%f=>seaice_depth_target_grid + target_fields(2)%f=>snow_depth_target_grid + target_fields(3)%f=>snow_liq_equiv_target_grid + target_fields(4)%f=>seaice_skin_temp_target_grid + fields_to_regrid(1)%f=>seaice_depth_input_grid + fields_to_regrid(2)%f=>snow_depth_input_grid + fields_to_regrid(3)%f=>snow_liq_equiv_input_grid + fields_to_regrid(4)%f=>seaice_skin_temp_input_grid + target_ptrs(1)%p=>seaice_depth_target_ptr + target_ptrs(2)%p=>snow_depth_target_ptr + target_ptrs(3)%p=>snow_liq_equiv_target_ptr + target_ptrs(4)%p=>seaice_skin_temp_target_ptr + search_nums = (/92,66,65,21/) + + call regrid_many(fields_to_regrid,target_fields,target_ptrs,num_fields, regrid_seaice) + deallocate(fields_to_regrid) l = lbound(unmapped_ptr) u = ubound(unmapped_ptr) do ij = l(1), u(1) call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - seaice_depth_target_ptr(i,j) = -9999.9 - snow_depth_target_ptr(i,j) = -9999.9 - snow_liq_equiv_target_ptr(i,j) = -9999.9 - seaice_skin_temp_target_ptr(i,j) = -9999.9 - soil_temp_target_ptr(i,j,:) = -9999.9 + !seaice_depth_target_ptr(i,j) = -9999.9 + !snow_depth_target_ptr(i,j) = -9999.9 + !snow_liq_equiv_target_ptr(i,j) = -9999.9 + !seaice_skin_temp_target_ptr(i,j) = -9999.9 + !soil_temp_target_ptr(i,j,:) = -9999.9 + do k = 1,num_fields + target_ptrs(i)%p(i,j) = -9999.9 + end do enddo + deallocate(target_ptrs) do tile = 1, num_tiles_target_grid - print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile - call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) + !print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile + !call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + !if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + ! call error_handler("IN FieldGather", rc) print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) @@ -1030,56 +1053,58 @@ subroutine interp(localpet) where(mask_target_one_tile == 1) mask_target_one_tile = 0 where(mask_target_one_tile == 2) mask_target_one_tile = 1 - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile - call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) + ! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) endif - print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile - call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile - call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile - call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile - call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - + !print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile + !call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + !if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + ! call error_handler("IN FieldScatter", rc) + + call search_many(num_fields,target_fields,data_one_tile, mask_target_one_tile,i_target,j_target,tile,search_nums,localpet) + deallocate(target_fields) +! print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile +! call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile +! call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +! print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile +! call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile +! call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +! print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile +! call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile +! call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! print*,"- CALL FieldGather FOR TARGET GRID SEAICE COLUMN TEMP: ", tile call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1109,695 +1134,789 @@ subroutine interp(localpet) ! Now interpolate water fields. !--------------------------------------------------------------------------------------------- - mask_input_ptr = 0 - where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1 - - mask_target_ptr = 0 - where (landmask_target_ptr == 0) mask_target_ptr = 1 - - method=ESMF_REGRIDMETHOD_CONSERVE - isrctermprocessing = 1 - - print*,"- CALL FieldRegridStore for water fields." - call ESMF_FieldRegridStore(skin_temp_input_grid, & - skin_temp_target_grid, & - srcmaskvalues=(/0/), & - dstmaskvalues=(/0/), & - polemethod=ESMF_POLEMETHOD_NONE, & - srctermprocessing=isrctermprocessing, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - normtype=ESMF_NORMTYPE_FRACAREA, & - routehandle=regrid_water, & - regridmethod=method, & - unmappedDstList=unmapped_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegridStore", rc) - - print*,"- CALL Field_Regrid for skin temperature over water." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL Field_Regrid for z0 over water." - call ESMF_FieldRegrid(z0_input_grid, & - z0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET z0." - call ESMF_FieldGet(z0_target_grid, & - farrayPtr=z0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - skin_temp_target_ptr(i,j) = -9999.9 - z0_target_ptr(i,j) = -9999.9 - enddo - - if (convert_nst) then - - print*,"- CALL Field_Regrid for c_d over water." - call ESMF_FieldRegrid(c_d_input_grid, & - c_d_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for c_0 over water." - call ESMF_FieldRegrid(c_0_input_grid, & - c_0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for d_conv over water." - call ESMF_FieldRegrid(d_conv_input_grid, & - d_conv_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for dt_cool over water." - call ESMF_FieldRegrid(dt_cool_input_grid, & - dt_cool_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for ifd over water." - call ESMF_FieldRegrid(ifd_input_grid, & - ifd_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for qrain over water." - call ESMF_FieldRegrid(qrain_input_grid, & - qrain_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for tref over water." - call ESMF_FieldRegrid(tref_input_grid, & - tref_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for w_d over water." - call ESMF_FieldRegrid(w_d_input_grid, & - w_d_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for w_0 over water." - call ESMF_FieldRegrid(w_0_input_grid, & - w_0_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xs over water." - call ESMF_FieldRegrid(xs_input_grid, & - xs_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xt over water." - call ESMF_FieldRegrid(xt_input_grid, & - xt_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xu over water." - call ESMF_FieldRegrid(xu_input_grid, & - xu_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xv over water." - call ESMF_FieldRegrid(xv_input_grid, & - xv_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xz over water." - call ESMF_FieldRegrid(xz_input_grid, & - xz_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xtts over water." - call ESMF_FieldRegrid(xtts_input_grid, & - xtts_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for xzts over water." - call ESMF_FieldRegrid(xzts_input_grid, & - xzts_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for z_c over water." - call ESMF_FieldRegrid(z_c_input_grid, & - z_c_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for zm over water." - call ESMF_FieldRegrid(zm_input_grid, & - zm_target_grid, & - routehandle=regrid_water, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - -! Tag unmapped points - - print*,"- CALL FieldGet FOR TARGET c_d." - call ESMF_FieldGet(c_d_target_grid, & - farrayPtr=c_d_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET c_0." - call ESMF_FieldGet(c_0_target_grid, & - farrayPtr=c_0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET d_conv." - call ESMF_FieldGet(d_conv_target_grid, & - farrayPtr=d_conv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET dt_cool." - call ESMF_FieldGet(dt_cool_target_grid, & - farrayPtr=dt_cool_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET ifd." - call ESMF_FieldGet(ifd_target_grid, & - farrayPtr=ifd_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - ifd_target_ptr = float(nint(ifd_target_ptr)) - - print*,"- CALL FieldGet FOR TARGET qrain." - call ESMF_FieldGet(qrain_target_grid, & - farrayPtr=qrain_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET tref." - call ESMF_FieldGet(tref_target_grid, & - farrayPtr=tref_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET w_d." - call ESMF_FieldGet(w_d_target_grid, & - farrayPtr=w_d_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET w_0." - call ESMF_FieldGet(w_0_target_grid, & - farrayPtr=w_0_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xs." - call ESMF_FieldGet(xs_target_grid, & - farrayPtr=xs_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xt." - call ESMF_FieldGet(xt_target_grid, & - farrayPtr=xt_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xu." - call ESMF_FieldGet(xu_target_grid, & - farrayPtr=xu_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xv." - call ESMF_FieldGet(xv_target_grid, & - farrayPtr=xv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xz." - call ESMF_FieldGet(xz_target_grid, & - farrayPtr=xz_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xtts." - call ESMF_FieldGet(xtts_target_grid, & - farrayPtr=xtts_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET xzts." - call ESMF_FieldGet(xzts_target_grid, & - farrayPtr=xzts_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET z_c." - call ESMF_FieldGet(z_c_target_grid, & - farrayPtr=z_c_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET zm." - call ESMF_FieldGet(zm_target_grid, & - farrayPtr=zm_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - c_d_target_ptr(i,j) = -9999.9 - c_0_target_ptr(i,j) = -9999.9 - d_conv_target_ptr(i,j) = -9999.9 - dt_cool_target_ptr(i,j) = -9999.9 - ifd_target_ptr(i,j) = -9999.9 - qrain_target_ptr(i,j) = -9999.9 - tref_target_ptr(i,j) = -9999.9 - w_d_target_ptr(i,j) = -9999.9 - w_0_target_ptr(i,j) = -9999.9 - xs_target_ptr(i,j) = -9999.9 - xt_target_ptr(i,j) = -9999.9 - xu_target_ptr(i,j) = -9999.9 - xv_target_ptr(i,j) = -9999.9 - xz_target_ptr(i,j) = -9999.9 - xtts_target_ptr(i,j) = -9999.9 - xzts_target_ptr(i,j) = -9999.9 - z_c_target_ptr(i,j) = -9999.9 - zm_target_ptr(i,j) = -9999.9 - enddo - - endif - - if (localpet == 0) then - allocate(latitude_one_tile(i_target,j_target)) - else - allocate(latitude_one_tile(0,0)) - endif - - do tile = 1, num_tiles_target_grid - -! skin temp - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile - call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile - call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - allocate(water_target_one_tile(i_target,j_target)) - water_target_one_tile = 0 - where(mask_target_one_tile == 0) water_target_one_tile = 1 - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & - latitude=latitude_one_tile) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! z0 - - print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile - call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile - call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - if (convert_nst) then - -! c_d - - print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile - call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile - call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! c_0 - - print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile - call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile - call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! d_conv - - print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile - call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile - call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! dt_cool - - print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile - call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile - call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! ifd - - print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile - call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile - call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! qrain - - print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile - call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile - call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! tref - - print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile - call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & - latitude=latitude_one_tile) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile - call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! w_d - - print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile - call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile - call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! w_0 - - print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile - call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile - call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xs - - print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile - call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile - call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xt - - print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile - call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile - call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xu - - print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile - call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile - call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xv - - print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile - call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile - call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - -! xz - - print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile - call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) - endif + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 0) mask_input_ptr = 1 - print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile - call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + mask_target_ptr = 0 + where (landmask_target_ptr == 0) mask_target_ptr = 1 -! xtts + method=ESMF_REGRIDMETHOD_CONSERVE + isrctermprocessing = 1 - print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile - call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) + print*,"- CALL FieldRegridStore for water fields." + call ESMF_FieldRegridStore(skin_temp_input_grid, & + skin_temp_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_water, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif + if (convert_nst) then + num_fields = 20 + else + num_fields = 4 + endif - print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile - call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + allocate(fields_to_regrid(num_fields)) + allocate(target_fields(num_fields)) + allocate(target_ptrs(num_fields)) + allocate(search_nums(num_fields)) -! xzts - print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile - call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) + target_fields(1)%f=>skin_temp_target_grid + target_fields(2)%f=>z0_target_grid + fields_to_regrid(1)%f=>skin_temp_target_grid + fields_to_regrid(2)%f=>z0_input_grid + target_ptrs(1)%p=>skin_temp_target_ptr + target_ptrs(2)%p=>z0_target_ptr + if (convert_nst) then - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif + target_fields(3)%f=>c_d_target_grid + target_fields(4)%f=>c_0_target_grid + target_fields(5)%f=>d_conv_target_grid + target_fields(6)%f=>dt_cool_target_grid + target_fields(7)%f=>ifd_target_grid + target_fields(8)%f=>qrain_target_grid + target_fields(9)%f=>tref_target_grid + target_fields(10)%f=>w_d_target_grid + target_fields(11)%f=>w_0_target_grid + target_fields(12)%f=>xs_target_grid + target_fields(13)%f=>xt_target_grid + target_fields(14)%f=>xu_target_grid + target_fields(15)%f=>xv_target_grid + target_fields(16)%f=>xz_target_grid + target_fields(17)%f=>xtts_target_grid + target_fields(18)%f=>xzts_target_grid + target_fields(19)%f=>z_c_target_grid + target_fields(20)%f=>zm_target_grid + + fields_to_regrid(3)%f=>c_d_input_grid + fields_to_regrid(4)%f=>c_0_input_grid + fields_to_regrid(5)%f=>d_conv_input_grid + fields_to_regrid(6)%f=>dt_cool_input_grid + fields_to_regrid(7)%f=>ifd_input_grid + fields_to_regrid(8)%f=>qrain_input_grid + fields_to_regrid(9)%f=>tref_input_grid + fields_to_regrid(10)%f=>w_d_input_grid + fields_to_regrid(11)%f=>w_0_input_grid + fields_to_regrid(12)%f=>xs_input_grid + fields_to_regrid(13)%f=>xt_input_grid + fields_to_regrid(14)%f=>xu_input_grid + fields_to_regrid(15)%f=>xv_input_grid + fields_to_regrid(16)%f=>xz_input_grid + fields_to_regrid(17)%f=>xtts_input_grid + fields_to_regrid(18)%f=>xzts_input_grid + fields_to_regrid(19)%f=>z_c_input_grid + fields_to_regrid(20)%f=>zm_input_grid + + target_ptrs(3)%p=>c_d_target_ptr + target_ptrs(4)%p=>c_0_target_ptr + target_ptrs(5)%p=>d_conv_target_ptr + target_ptrs(6)%p=>dt_cool_target_ptr + target_ptrs(7)%p=>ifd_target_ptr + target_ptrs(8)%p=>qrain_target_ptr + target_ptrs(9)%p=>tref_target_ptr + target_ptrs(10)%p=>w_d_target_ptr + target_ptrs(11)%p=>w_0_target_ptr + target_ptrs(12)%p=>xs_target_ptr + target_ptrs(13)%p=>xt_target_ptr + target_ptrs(14)%p=>xu_target_ptr + target_ptrs(15)%p=>xv_target_ptr + target_ptrs(16)%p=>xz_target_ptr + target_ptrs(17)%p=>xtts_target_ptr + target_ptrs(18)%p=>xzts_target_ptr + target_ptrs(19)%p=>z_c_target_ptr + target_ptrs(20)%p=>zm_target_ptr + search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/) + else + search_nums(:)=(/11,83/) + endif - print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile - call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call regrid_many(fields_to_regrid,target_fields,target_ptrs,num_fields,regrid_water) + deallocate(fields_to_regrid) -! z_c +! print*,"- CALL Field_Regrid for skin temperature over water." +! call ESMF_FieldRegrid(skin_temp_input_grid, & +! skin_temp_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET skin temperature." +! call ESMF_FieldGet(skin_temp_target_grid, & +! farrayPtr=skin_temp_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL Field_Regrid for z0 over water." +! call ESMF_FieldRegrid(z0_input_grid, & +! z0_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL FieldGet FOR TARGET z0." +! call ESMF_FieldGet(z0_target_grid, & +! farrayPtr=z0_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! l = lbound(unmapped_ptr) +! u = ubound(unmapped_ptr) +! +! do ij = l(1), u(1) +! call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) +! skin_temp_target_ptr(i,j) = -9999.9 +! z0_target_ptr(i,j) = -9999.9 +! enddo +! +! if (convert_nst) then +! +! print*,"- CALL Field_Regrid for c_d over water." +! call ESMF_FieldRegrid(c_d_input_grid, & +! c_d_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for c_0 over water." +! call ESMF_FieldRegrid(c_0_input_grid, & +! c_0_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for d_conv over water." +! call ESMF_FieldRegrid(d_conv_input_grid, & +! d_conv_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for dt_cool over water." +! call ESMF_FieldRegrid(dt_cool_input_grid, & +! dt_cool_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for ifd over water." +! call ESMF_FieldRegrid(ifd_input_grid, & +! ifd_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for qrain over water." +! call ESMF_FieldRegrid(qrain_input_grid, & +! qrain_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for tref over water." +! call ESMF_FieldRegrid(tref_input_grid, & +! tref_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for w_d over water." +! call ESMF_FieldRegrid(w_d_input_grid, & +! w_d_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for w_0 over water." +! call ESMF_FieldRegrid(w_0_input_grid, & +! w_0_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xs over water." +! call ESMF_FieldRegrid(xs_input_grid, & +! xs_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xt over water." +! call ESMF_FieldRegrid(xt_input_grid, & +! xt_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xu over water." +! call ESMF_FieldRegrid(xu_input_grid, & +! xu_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xv over water." +! call ESMF_FieldRegrid(xv_input_grid, & +! xv_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xz over water." +! call ESMF_FieldRegrid(xz_input_grid, & +! xz_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xtts over water." +! call ESMF_FieldRegrid(xtts_input_grid, & +! xtts_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for xzts over water." +! call ESMF_FieldRegrid(xzts_input_grid, & +! xzts_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for z_c over water." +! call ESMF_FieldRegrid(z_c_input_grid, & +! z_c_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +! print*,"- CALL Field_Regrid for zm over water." +! call ESMF_FieldRegrid(zm_input_grid, & +! zm_target_grid, & +! routehandle=regrid_water, & +! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldRegrid", rc) +! +!! Tag unmapped points +! +! print*,"- CALL FieldGet FOR TARGET c_d." +! call ESMF_FieldGet(c_d_target_grid, & +! farrayPtr=c_d_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET c_0." +! call ESMF_FieldGet(c_0_target_grid, & +! farrayPtr=c_0_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET d_conv." +! call ESMF_FieldGet(d_conv_target_grid, & +! farrayPtr=d_conv_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET dt_cool." +! call ESMF_FieldGet(dt_cool_target_grid, & +! farrayPtr=dt_cool_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET ifd." +! call ESMF_FieldGet(ifd_target_grid, & +! farrayPtr=ifd_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! ifd_target_ptr = float(nint(ifd_target_ptr)) +! +! print*,"- CALL FieldGet FOR TARGET qrain." +! call ESMF_FieldGet(qrain_target_grid, & +! farrayPtr=qrain_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET tref." +! call ESMF_FieldGet(tref_target_grid, & +! farrayPtr=tref_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET w_d." +! call ESMF_FieldGet(w_d_target_grid, & +! farrayPtr=w_d_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET w_0." +! call ESMF_FieldGet(w_0_target_grid, & +! farrayPtr=w_0_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xs." +! call ESMF_FieldGet(xs_target_grid, & +! farrayPtr=xs_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xt." +! call ESMF_FieldGet(xt_target_grid, & +! farrayPtr=xt_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xu." +! call ESMF_FieldGet(xu_target_grid, & +! farrayPtr=xu_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xv." +! call ESMF_FieldGet(xv_target_grid, & +! farrayPtr=xv_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xz." +! call ESMF_FieldGet(xz_target_grid, & +! farrayPtr=xz_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xtts." +! call ESMF_FieldGet(xtts_target_grid, & +! farrayPtr=xtts_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET xzts." +! call ESMF_FieldGet(xzts_target_grid, & +! farrayPtr=xzts_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET z_c." +! call ESMF_FieldGet(z_c_target_grid, & +! farrayPtr=z_c_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) +! +! print*,"- CALL FieldGet FOR TARGET zm." +! call ESMF_FieldGet(zm_target_grid, & +! farrayPtr=zm_target_ptr, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGet", rc) + if (convert_nst) ifd_target_ptr = float(nint(ifd_target_ptr)) - print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile - call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + +! c_d_target_ptr(i,j) = -9999.9 +! c_0_target_ptr(i,j) = -9999.9 +! d_conv_target_ptr(i,j) = -9999.9 +! dt_cool_target_ptr(i,j) = -9999.9 +! ifd_target_ptr(i,j) = -9999.9 +! qrain_target_ptr(i,j) = -9999.9 +! tref_target_ptr(i,j) = -9999.9 +! w_d_target_ptr(i,j) = -9999.9 +! w_0_target_ptr(i,j) = -9999.9 +! xs_target_ptr(i,j) = -9999.9 +! xt_target_ptr(i,j) = -9999.9 +! xu_target_ptr(i,j) = -9999.9 +! xv_target_ptr(i,j) = -9999.9 +! xz_target_ptr(i,j) = -9999.9 +! xtts_target_ptr(i,j) = -9999.9 +! xzts_target_ptr(i,j) = -9999.9 +! z_c_target_ptr(i,j) = -9999.9 +! zm_target_ptr(i,j) = -9999.9 + do k = 1, num_fields + target_ptrs(k)%p(i,j) = -9999.9 + end do + enddo + deallocate(target_ptrs) + !endif - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif - print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile - call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + do tile = 1, num_tiles_target_grid -! zm +! skin temp - print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile - call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) +! print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile +! call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) - if (localpet == 0) then - call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) - endif + print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile + call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) - print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile - call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + print*,"- CALL FieldGather FOR TARGET LATITUDE TILE: ", tile + call ESMF_FieldGather(latitude_target_grid, latitude_one_tile, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) + if (localpet == 0) then + allocate(water_target_one_tile(i_target,j_target)) + water_target_one_tile = 0 + where(mask_target_one_tile == 0) water_target_one_tile = 1 endif + ! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & + ! latitude=latitude_one_tile) + !endif + + call search_many(num_fields,target_fields,data_one_tile, water_target_one_tile,& + i_target,j_target,tile,search_nums,localpet,latitude=latitude_one_tile) + deallocate(target_fields) + +! print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile +! call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! z0 +! +! print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile +! call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile +! call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +! if (convert_nst) then +! +!! c_d +! +! print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile +! call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile +! call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! c_0 +! +! print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile +! call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile +! call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! d_conv +! +! print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile +! call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile +! call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! dt_cool +! +! print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile +! call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile +! call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! ifd +! +! print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile +! call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile +! call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! qrain +! +! print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile +! call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile +! call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! tref +! +! print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile +! call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & +! latitude=latitude_one_tile) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile +! call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! w_d +! +! print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile +! call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile +! call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! w_0 +! +! print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile +! call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile +! call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xs +! +! print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile +! call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile +! call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xt +! +! print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile +! call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile +! call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xu +! +! print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile +! call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile +! call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xv +! +! print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile +! call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile +! call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xz +! +! print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile +! call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile +! call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xtts +! +! print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile +! call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile +! call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! xzts +! +! print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile +! call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile +! call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! z_c +! +! print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile +! call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile +! call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +!! zm +! +! print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile +! call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldGather", rc) +! +! if (localpet == 0) then +! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) +! endif +! +! print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile +! call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldScatter", rc) +! +! endif if (localpet == 0) deallocate(water_target_one_tile) @@ -4800,20 +4919,20 @@ end subroutine ij_to_i_j subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) + use esmf + implicit none - use esmf - - integer, intent(in) :: num_field - type(esmf_routehandle), intent(in) :: route - type(field_ptr), intent(in) :: fields_pre(num_field), fields_post(num_field) - real(esmf_kind_r8), pointer, intent(inout) :: post_ptrs(num_field) + integer, intent(in) :: num_field + type(esmf_routehandle), intent(inout) :: route + type(fieldptr), intent(in) :: fields_pre(num_field), fields_post(num_field) + type(realptr), intent(inout) :: post_ptrs(num_field) integer :: i, rc do i = 1, num_field - call ESMF_FieldRegrid(fields_pre(i), & + call ESMF_FieldRegrid(fields_pre(i)%f, & fields_post(i)%f, & routehandle=route, & termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) @@ -4821,13 +4940,53 @@ subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) call error_handler("IN FieldRegrid", rc) call ESMF_FieldGet(fields_post(i)%f, & - farrayPtr=post_ptrs(i), rc=rc) + farrayPtr=post_ptrs(i)%p, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGet", rc)! end do end subroutine regrid_many + subroutine search_many(num_field,target_fields,field_data,mask,i_search,j_search,tile,search_nums,localpet,latitude) + + use model_grid, only : i_target,j_target + use search_util + + implicit none + + integer, intent(in) :: num_field + type(fieldptr), intent(inout) :: target_fields(num_field) + real(esmf_kind_r8), intent(inout) :: field_data(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: latitude(i_target,j_target) + integer(esmf_kind_i8), intent(inout) :: mask(i_target,j_target) + + integer, intent(in) :: i_search,j_search,tile,localpet + integer, intent(inout) :: search_nums(num_field) + + integer :: k, rc + + do k = 1,num_field + print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldGather(target_fields(k)%f, field_data, rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + if (present(latitude)) then + call search(field_data, mask, i_search, j_search, tile,search_nums(k),latitude=latitude) + else + call search(field_data, mask, i_search, j_search, tile,search_nums(k)) + endif + endif + + print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile + call ESMF_FieldScatter(target_fields(k)%f, field_data, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + end do + + end subroutine search_many + !> Free up memory once the target grid surface fields are !! no longer needed. !! From 063a56b1fc10929d24131866542056edeedc7536 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Wed, 5 May 2021 21:10:17 +0000 Subject: [PATCH 03/18] Updated documentation for regrid_many and search_many --- sorc/chgres_cube.fd/surface.F90 | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index ad6010130..39bfba491 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -4916,7 +4916,15 @@ subroutine ij_to_i_j(ij, itile, jtile, i, j) return end subroutine ij_to_i_j - + +!> Regrid multiple ESMF fields from input to target grid +!! +!! @param[in] fields_pre Length num_field array of ptrs to input ESMF fields +!! @param[in] fields_post Length num_field array of ptrs to target ESMF fields +!! @param[inout] post_ptrs Length num_field array of ptrs to ESMF target field pointers +!! @param[in] num_field Number of fields to process +!! @param[inout] route Route handle to saved ESMF regridding instructions +!! @author Larissa Reames, OU CIMMS/NOAA/NSSL subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) use esmf @@ -4947,6 +4955,20 @@ subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) end subroutine regrid_many +!> Execute the search function for multple fields +!! +!! @param[in] num_field Number of fields to process. +!! @param[inout] target_fields Length num_field array of ptrs to target ESMF fields. +!! @param[inout] field_data A real array of size i_target,j_target to temporarily hold data for searching +!! @param[inout] mask An integer array of size i_target,j_target that holds masked (0) and unmasked (1) +!! values indicating where to execute search (only at unmasked points). +!! @param[in] i_search First (east-west) index of unmapped points to replace. +!! @param[in] j_search Second (north-south) index of unmapped points to replace. +!! @param[in] tile Current cubed sphere tile. +!! @param[inout] search_nums Array length num_field holding search field numbers corresponding to each field provided for searching. +!! @param[in] localpet ESMF local persistent execution thread. +!! @param[in][optional] latitude A real array size i_target,j_target of latitude on the target grid +!! @author Larissa Reames, OU CIMMS/NOAA/NSSL subroutine search_many(num_field,target_fields,field_data,mask,i_search,j_search,tile,search_nums,localpet,latitude) use model_grid, only : i_target,j_target From 8ccb3f0b1b4dd75d9ea66ccbdd667d8571688de5 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Fri, 7 May 2021 15:31:17 -0500 Subject: [PATCH 04/18] Extended use of regrid_many and search_many to all masked regridding sections and used ESMF_FieldBundles instead of arrays of pointers. --- sorc/chgres_cube.fd/input_data.F90 | 86 +- sorc/chgres_cube.fd/static_data.F90 | 3 +- sorc/chgres_cube.fd/surface.F90 | 2087 +++++++-------------------- 3 files changed, 596 insertions(+), 1580 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 45d69dda2..8d2406ff2 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -71,33 +71,33 @@ module input_data !< Default is igbp. integer, parameter :: ICET_DEFAULT = 265.0 !< Default value of soil and skin !< temperature (K) over ice. - type(esmf_field), public,target :: canopy_mc_input_grid !< canopy moist content - type(esmf_field), public,target :: f10m_input_grid !< log((z0+10)*1/z0) - type(esmf_field), public,target :: ffmm_input_grid !< log((z0+z1)*1/z0) + type(esmf_field), public :: canopy_mc_input_grid !< canopy moist content + type(esmf_field), public :: f10m_input_grid !< log((z0+10)*1/z0) + type(esmf_field), public :: ffmm_input_grid !< log((z0+z1)*1/z0) !! See sfc_diff.f for details. - type(esmf_field), public,target :: landsea_mask_input_grid !< land sea mask; + type(esmf_field), public :: landsea_mask_input_grid !< land sea mask; !! 0-water, 1-land, 2-ice - type(esmf_field), public,target :: q2m_input_grid !< 2-m spec hum - type(esmf_field), public,target :: seaice_depth_input_grid !< sea ice depth - type(esmf_field), public,target :: seaice_fract_input_grid !< sea ice fraction - type(esmf_field), public,target :: seaice_skin_temp_input_grid !< sea ice skin temp - type(esmf_field), public,target :: skin_temp_input_grid !< skin temp/sst - type(esmf_field), public,target :: snow_depth_input_grid !< snow dpeth - type(esmf_field), public,target :: snow_liq_equiv_input_grid !< snow liq equiv depth - type(esmf_field), public,target :: soil_temp_input_grid !< 3-d soil temp - type(esmf_field), public,target :: soil_type_input_grid !< soil type - type(esmf_field), public,target :: soilm_liq_input_grid !< 3-d liquid soil moisture - type(esmf_field), public,target :: soilm_tot_input_grid !< 3-d total soil moisture - type(esmf_field), public,target :: srflag_input_grid !< snow/rain flag - type(esmf_field), public,target :: t2m_input_grid !< 2-m temperature - type(esmf_field), public,target :: tprcp_input_grid !< precip - type(esmf_field), public,target :: ustar_input_grid !< fric velocity - type(esmf_field), public,target :: veg_type_input_grid !< vegetation type - type(esmf_field), public,target :: z0_input_grid !< roughness length - type(esmf_field), public,target :: veg_greenness_input_grid !< vegetation fraction - type(esmf_field), public,target :: lai_input_grid !< leaf area index - type(esmf_field), public,target :: max_veg_greenness_input_grid !< shdmax - type(esmf_field), public,target :: min_veg_greenness_input_grid !< shdmin + type(esmf_field), public :: q2m_input_grid !< 2-m spec hum + type(esmf_field), public :: seaice_depth_input_grid !< sea ice depth + type(esmf_field), public :: seaice_fract_input_grid !< sea ice fraction + type(esmf_field), public :: seaice_skin_temp_input_grid !< sea ice skin temp + type(esmf_field), public :: skin_temp_input_grid !< skin temp/sst + type(esmf_field), public :: snow_depth_input_grid !< snow dpeth + type(esmf_field), public :: snow_liq_equiv_input_grid !< snow liq equiv depth + type(esmf_field), public :: soil_temp_input_grid !< 3-d soil temp + type(esmf_field), public :: soil_type_input_grid !< soil type + type(esmf_field), public :: soilm_liq_input_grid !< 3-d liquid soil moisture + type(esmf_field), public :: soilm_tot_input_grid !< 3-d total soil moisture + type(esmf_field), public :: srflag_input_grid !< snow/rain flag + type(esmf_field), public :: t2m_input_grid !< 2-m temperature + type(esmf_field), public :: tprcp_input_grid !< precip + type(esmf_field), public :: ustar_input_grid !< fric velocity + type(esmf_field), public :: veg_type_input_grid !< vegetation type + type(esmf_field), public :: z0_input_grid !< roughness length + type(esmf_field), public :: veg_greenness_input_grid !< vegetation fraction + type(esmf_field), public :: lai_input_grid !< leaf area index + type(esmf_field), public :: max_veg_greenness_input_grid !< shdmax + type(esmf_field), public :: min_veg_greenness_input_grid !< shdmin integer, public :: lsoil_input=4 !< number of soil layers, no longer hardwired to allow !! for 7 layers of soil for the RUC LSM @@ -106,25 +106,25 @@ module input_data ! Fields associated with the nst model. - type(esmf_field), public,target :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public,target :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public,target :: d_conv_input_grid !< Thickness of free convection layer - type(esmf_field), public,target :: dt_cool_input_grid !< Sub-layer cooling amount - type(esmf_field), public,target :: ifd_input_grid !< Model mode index. 0-diurnal model not + type(esmf_field), public :: c_d_input_grid !< Coefficient 2 to calculate d(tz)/d(ts) + type(esmf_field), public :: c_0_input_grid !< Coefficient 1 to calculate d(tz)/d(ts) + type(esmf_field), public :: d_conv_input_grid !< Thickness of free convection layer + type(esmf_field), public :: dt_cool_input_grid !< Sub-layer cooling amount + type(esmf_field), public :: ifd_input_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public,target :: qrain_input_grid !< Sensible heat flux due to rainfall - type(esmf_field), public,target :: tref_input_grid !< Reference temperature - type(esmf_field), public,target :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public,target :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public,target :: xs_input_grid !< Salinity content in diurnal thermocline layer - type(esmf_field), public,target :: xt_input_grid !< Heat content in diurnal thermocline layer - type(esmf_field), public,target :: xu_input_grid !< u-current content in diurnal thermocline layer - type(esmf_field), public,target :: xv_input_grid !< v-current content in diurnal thermocline layer - type(esmf_field), public,target :: xz_input_grid !< Diurnal thermocline layer thickness - type(esmf_field), public,target :: xtts_input_grid !< d(xt)/d(ts) - type(esmf_field), public,target :: xzts_input_grid !< d(xz)/d(ts) - type(esmf_field), public,target :: z_c_input_grid !< Sub-layer cooling thickness - type(esmf_field), public,target :: zm_input_grid !< Oceanic mixed layer depth + type(esmf_field), public :: qrain_input_grid !< Sensible heat flux due to rainfall + type(esmf_field), public :: tref_input_grid !< Reference temperature + type(esmf_field), public :: w_d_input_grid !< Coefficient 4 to calculate d(tz)/d(ts) + type(esmf_field), public :: w_0_input_grid !< Coefficient 3 to calculate d(tz)/d(ts) + type(esmf_field), public :: xs_input_grid !< Salinity content in diurnal thermocline layer + type(esmf_field), public :: xt_input_grid !< Heat content in diurnal thermocline layer + type(esmf_field), public :: xu_input_grid !< u-current content in diurnal thermocline layer + type(esmf_field), public :: xv_input_grid !< v-current content in diurnal thermocline layer + type(esmf_field), public :: xz_input_grid !< Diurnal thermocline layer thickness + type(esmf_field), public :: xtts_input_grid !< d(xt)/d(ts) + type(esmf_field), public :: xzts_input_grid !< d(xz)/d(ts) + type(esmf_field), public :: z_c_input_grid !< Sub-layer cooling thickness + type(esmf_field), public :: zm_input_grid !< Oceanic mixed layer depth public :: read_input_atm_data public :: cleanup_input_atm_data diff --git a/sorc/chgres_cube.fd/static_data.F90 b/sorc/chgres_cube.fd/static_data.F90 index ebd02482b..6e8c38557 100644 --- a/sorc/chgres_cube.fd/static_data.F90 +++ b/sorc/chgres_cube.fd/static_data.F90 @@ -114,7 +114,8 @@ subroutine get_static_fields(localpet) print*,"- CALL FieldCreate FOR TARGET GRID SOIL TYPE." soil_type_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=error) + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soil_type_target_grid", rc=error) if(ESMF_logFoundError(rcToCheck=error,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", error) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 39bfba491..0bf254bcc 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -33,88 +33,88 @@ module surface !< are applied at these points. ! surface fields (not including nst) - type(esmf_field), public, target :: canopy_mc_target_grid + type(esmf_field), public :: canopy_mc_target_grid !< canopy moisture content - type(esmf_field), public, target :: f10m_target_grid + type(esmf_field), public :: f10m_target_grid !< log((z0+10)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public, target :: ffmm_target_grid + type(esmf_field), public :: ffmm_target_grid !< log((z0+z1)*1/z0) !< See sfc_diff.f for details - type(esmf_field), public, target :: q2m_target_grid + type(esmf_field), public :: q2m_target_grid !< 2-m specific humidity - type(esmf_field), public, target :: seaice_depth_target_grid + type(esmf_field), public :: seaice_depth_target_grid !< sea ice depth - type(esmf_field), public, target :: seaice_fract_target_grid + type(esmf_field), public :: seaice_fract_target_grid !< sea ice fraction - type(esmf_field), public, target :: seaice_skin_temp_target_grid + type(esmf_field), public :: seaice_skin_temp_target_grid !< sea ice skin temperature - type(esmf_field), public, target :: skin_temp_target_grid + type(esmf_field), public :: skin_temp_target_grid !< skin temperature/sst - type(esmf_field), public, target :: srflag_target_grid + type(esmf_field), public :: srflag_target_grid !< snow/rain flag - type(esmf_field), public, target :: snow_liq_equiv_target_grid + type(esmf_field), public :: snow_liq_equiv_target_grid !< liquid equiv snow depth - type(esmf_field), public, target :: snow_depth_target_grid + type(esmf_field), public :: snow_depth_target_grid !< physical snow depth - type(esmf_field), public, target :: soil_temp_target_grid + type(esmf_field), public :: soil_temp_target_grid !< 3-d soil temperature - type(esmf_field), public, target :: soilm_liq_target_grid + type(esmf_field), public :: soilm_liq_target_grid !< 3-d liquid soil moisture - type(esmf_field), public, target :: soilm_tot_target_grid + type(esmf_field), public :: soilm_tot_target_grid !< 3-d total soil moisture - type(esmf_field), public, target :: t2m_target_grid + type(esmf_field), public :: t2m_target_grid !< 2-m temperatrure - type(esmf_field), public, target :: tprcp_target_grid + type(esmf_field), public :: tprcp_target_grid !< precip - type(esmf_field), public, target :: ustar_target_grid + type(esmf_field), public :: ustar_target_grid !< friction velocity - type(esmf_field), public, target :: z0_target_grid + type(esmf_field), public :: z0_target_grid !< roughness length - type(esmf_field), public, target :: lai_target_grid + type(esmf_field), public :: lai_target_grid !< leaf area index ! nst fields - type(esmf_field), public, target :: c_d_target_grid + type(esmf_field), public :: c_d_target_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public, target :: c_0_target_grid + type(esmf_field), public :: c_0_target_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public, target :: d_conv_target_grid + type(esmf_field), public :: d_conv_target_grid !< Thickness of free convection layer - type(esmf_field), public, target :: dt_cool_target_grid + type(esmf_field), public :: dt_cool_target_grid !< Sub-layer cooling amount - type(esmf_field), public, target :: ifd_target_grid + type(esmf_field), public :: ifd_target_grid !< Model mode index. 0-diurnal model not !< started; 1-diurnal model started. - type(esmf_field), public, target :: qrain_target_grid + type(esmf_field), public :: qrain_target_grid !< Sensible heat flux due to rainfall - type(esmf_field), public, target :: tref_target_grid + type(esmf_field), public :: tref_target_grid !< reference temperature - type(esmf_field), public, target :: w_d_target_grid + type(esmf_field), public :: w_d_target_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public, target :: w_0_target_grid + type(esmf_field), public :: w_0_target_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public, target :: xs_target_grid + type(esmf_field), public :: xs_target_grid !< Salinity content in diurnal !< thermocline layer - type(esmf_field), public, target :: xt_target_grid + type(esmf_field), public :: xt_target_grid !< Heat content in diurnal thermocline !< layer - type(esmf_field), public, target :: xu_target_grid + type(esmf_field), public :: xu_target_grid !< u-current content in diurnal !< thermocline layer - type(esmf_field), public, target :: xv_target_grid + type(esmf_field), public :: xv_target_grid !< v-current content in diurnal !< thermocline layer - type(esmf_field), public, target :: xz_target_grid + type(esmf_field), public :: xz_target_grid !< Diurnal thermocline layer thickness - type(esmf_field), public, target :: xtts_target_grid + type(esmf_field), public :: xtts_target_grid !< d(xt)/d(ts) - type(esmf_field), public, target :: xzts_target_grid + type(esmf_field), public :: xzts_target_grid !< d(xz)/d(ts) - type(esmf_field), public, target :: z_c_target_grid + type(esmf_field), public :: z_c_target_grid !< Sub-layer cooling thickness - type(esmf_field), public, target :: zm_target_grid + type(esmf_field), public :: zm_target_grid !< Oceanic mixed layer depth type(esmf_field) :: soil_type_from_input_grid @@ -138,13 +138,14 @@ module surface real, parameter, private :: hlice = 3.335E5 !< latent heat of fusion - type fieldptr - type(esmf_field), pointer :: f - end type fieldptr - type realptr + type realptr_2d real(esmf_kind_r8), pointer :: p(:,:) end type realptr + + type realptr_3d + real(esmf_kind_r8), pointer :: p(:,:,:) + end type realptr public :: surface_driver @@ -398,6 +399,7 @@ subroutine interp(localpet) integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing integer :: num_fields + integer :: sotyp_ind, vgfrc_ind, mmvg_ind, lai_ind integer, allocatable :: search_nums(:) integer(esmf_kind_i4), pointer :: unmapped_ptr(:) integer(esmf_kind_i4), pointer :: mask_input_ptr(:,:) @@ -461,8 +463,14 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_seaice type(esmf_routehandle) :: regrid_water - type(fieldptr), allocatable :: fields_to_regrid(:), target_fields(:) - type(realptr), allocatable :: target_ptrs(:) + type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input + type(esmf_fieldbundle) :: bundle_seaice, bundle_seaice_input + type(esmf_fieldbundle) :: bundle_water_target, bundle_water_input + type(esmf_fieldbundle) :: bundle_allland_target, bundle_allland_input + type(esmf_fieldbundle) :: bundle_landice_target, bundle_landice_input + type(esmf_fieldbundle) :: bundle_nolandice_target, bundle_nolandice_input + + logical, allocatable :: dozero(:) !----------------------------------------------------------------------- ! Interpolate fieids that do not require 'masked' interpolation. @@ -482,62 +490,40 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid T2M." - call ESMF_FieldRegrid(t2m_input_grid, & - t2m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid Q2M." - call ESMF_FieldRegrid(q2m_input_grid, & - q2m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid TPRCP." - call ESMF_FieldRegrid(tprcp_input_grid, & - tprcp_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid F10M." - call ESMF_FieldRegrid(f10m_input_grid, & - f10m_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid FFMM." - call ESMF_FieldRegrid(ffmm_input_grid, & - ffmm_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid USTAR." - call ESMF_FieldRegrid(ustar_input_grid, & - ustar_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid SRFLAG." - call ESMF_FieldRegrid(srflag_input_grid, & - srflag_target_grid, & - routehandle=regrid_bl_no_mask, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + bundle_all_target = ESMF_FieldBundleCreate(name="all points target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_all_input = ESMF_FieldBundleCreate(name="all points input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_all_target, (/t2_target_grid,q2_target_grid,tprcp_target_grid, & + f10m_target_grid,ffmm_target_grid,ustar_target_grid,srflag_target_grid/), & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_all_input, (/t2_input_grid,q2_input_grid,tprcp_input_grid, & + f10m_input_grid,ffmm_input_grid,ustar_input_grid,srflag_input_grid/), & + rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_all_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(dozero(num_fields)) + dozero = (/.True., .True., .True., .True., .True., .True., .True./) + call regrid_many(fields_to_regrid,target_fields,num_fields,regrid_bl_no_mask,dozero) + + call FieldBundleDestroy(bundle_all_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + call FieldBundleDestroy(bundle_all_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldGet FOR SRFLAG." call ESMF_FieldGet(srflag_target_grid, & farrayPtr=srflag_target_ptr, rc=rc) @@ -925,203 +911,62 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for soil temperature over seaice." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_seaice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + bundle_seaice_target = ESMF_FieldBundleCreate(name="sea ice target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_seaice_input = ESMF_FieldBundleCreate(name="sea ice input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_seaice_target, (/seaice_depth_target_grid, snow_depth_target_grid, & + snow_liq_equiv_target_grid, seaice_skin_temp_target_grid, & + soil_temp_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_seaice_input, (/seaice_depth_input_grid, snow_depth_input_grid, & + snow_liq_equiv_input_grid, seaice_skin_temp_input_grid, & + soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_seaice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) -! Commenting out and replacing with a regrid_many subroutine - print*,"- CALL FieldGet FOR TARGET grid soil temperature over seaice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc)! -! -! print*,"- CALL Field_Regrid for sea ice depth." -! call ESMF_FieldRegrid(seaice_depth_input_grid, & -! seaice_depth_target_grid, & -! routehandle=regrid_seaice, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET grid sea ice depth." -! call ESMF_FieldGet(seaice_depth_target_grid, & -! farrayPtr=seaice_depth_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL Field_Regrid for snow depth." -! call ESMF_FieldRegrid(snow_depth_input_grid, & -! snow_depth_target_grid, & -! routehandle=regrid_seaice, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET grid snow depth." -! call ESMF_FieldGet(snow_depth_target_grid, & -! farrayPtr=snow_depth_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL Field_Regrid for snow liq equiv." -! call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & -! snow_liq_equiv_target_grid, & -! routehandle=regrid_seaice, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET grid snow liq equiv." -! call ESMF_FieldGet(snow_liq_equiv_target_grid, & -! farrayPtr=snow_liq_equiv_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL Field_Regrid for sea ice skin temp." -! call ESMF_FieldRegrid(seaice_skin_temp_input_grid, & -! seaice_skin_temp_target_grid, & -! routehandle=regrid_seaice, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET grid sea ice skin temp." -! call ESMF_FieldGet(seaice_skin_temp_target_grid, & -! farrayPtr=seaice_skin_temp_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) - num_fields = 4 - allocate(fields_to_regrid(num_fields)) - allocate(target_fields(num_fields)) - allocate(target_ptrs(num_fields)) allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) - target_fields(1)%f=>seaice_depth_target_grid - target_fields(2)%f=>snow_depth_target_grid - target_fields(3)%f=>snow_liq_equiv_target_grid - target_fields(4)%f=>seaice_skin_temp_target_grid - fields_to_regrid(1)%f=>seaice_depth_input_grid - fields_to_regrid(2)%f=>snow_depth_input_grid - fields_to_regrid(3)%f=>snow_liq_equiv_input_grid - fields_to_regrid(4)%f=>seaice_skin_temp_input_grid - target_ptrs(1)%p=>seaice_depth_target_ptr - target_ptrs(2)%p=>snow_depth_target_ptr - target_ptrs(3)%p=>snow_liq_equiv_target_ptr - target_ptrs(4)%p=>seaice_skin_temp_target_ptr - search_nums = (/92,66,65,21/) - - call regrid_many(fields_to_regrid,target_fields,target_ptrs,num_fields, regrid_seaice) - deallocate(fields_to_regrid) + search_nums = (/92,66,65,21,21/) + dozero(:) = .True. l = lbound(unmapped_ptr) u = ubound(unmapped_ptr) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - !seaice_depth_target_ptr(i,j) = -9999.9 - !snow_depth_target_ptr(i,j) = -9999.9 - !snow_liq_equiv_target_ptr(i,j) = -9999.9 - !seaice_skin_temp_target_ptr(i,j) = -9999.9 - !soil_temp_target_ptr(i,j,:) = -9999.9 - do k = 1,num_fields - target_ptrs(i)%p(i,j) = -9999.9 - end do - enddo - deallocate(target_ptrs) + + call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & + n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) + + call FieldBundleDestroy(bundle_seaice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) do tile = 1, num_tiles_target_grid - !print*,"- CALL FieldGather FOR TARGET GRID SEAICE DEPTH TILE: ", tile - !call ESMF_FieldGather(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - !if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - ! call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - if (localpet == 0) then - ! I don't think is needed anymore with the more recent fixes to fill values in input_data - !if (count(landmask_target_ptr == 2) == 0) data_one_tile(:,:) =0.0_esmf_kind_r8 - + if (localpet == 0) then where(mask_target_one_tile == 1) mask_target_one_tile = 0 where(mask_target_one_tile == 2) mask_target_one_tile = 1 - ! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 92) endif - !print*,"- CALL FieldScatter FOR TARGET GRID SEAICE DEPTH TILE: ", tile - !call ESMF_FieldScatter(seaice_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - !if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - ! call error_handler("IN FieldScatter", rc) - - call search_many(num_fields,target_fields,data_one_tile, mask_target_one_tile,i_target,j_target,tile,search_nums,localpet) - deallocate(target_fields) -! print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile -! call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 66) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile -! call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -! print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile -! call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 65) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQ EQUIV TILE: ", tile -! call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -! print*,"- CALL FieldGather FOR TARGET GRID SEAICE SKIN TEMP: ", tile -! call ESMF_FieldGather(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID SEAICE SKIN TEMP: ", tile -! call ESMF_FieldScatter(seaice_skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! - print*,"- CALL FieldGather FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 21) - data_one_tile_3d(:,:,j) = data_one_tile - enddo - endif - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + call search_many(num_fields,bundle_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, & + field_data_3d=data_one_tile_3d) + + call FieldBundleDestroy(target_fields,rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call error_handler("IN FieldBundleDestroy", rc) enddo @@ -1158,413 +1003,66 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - if (convert_nst) then - num_fields = 20 - else - num_fields = 4 - endif + bundle_water_target = ESMF_FieldBundleCreate(name="water target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_water_input = ESMF_FieldBundleCreate(name="water input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_water_target, (/skin_temp_target_grid, z0_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_seaice_input, (/skin_temp_input_grid, z0_input_grid,/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) - allocate(fields_to_regrid(num_fields)) - allocate(target_fields(num_fields)) - allocate(target_ptrs(num_fields)) allocate(search_nums(num_fields)) - - target_fields(1)%f=>skin_temp_target_grid - target_fields(2)%f=>z0_target_grid - fields_to_regrid(1)%f=>skin_temp_target_grid - fields_to_regrid(2)%f=>z0_input_grid - target_ptrs(1)%p=>skin_temp_target_ptr - target_ptrs(2)%p=>z0_target_ptr if (convert_nst) then - target_fields(3)%f=>c_d_target_grid - target_fields(4)%f=>c_0_target_grid - target_fields(5)%f=>d_conv_target_grid - target_fields(6)%f=>dt_cool_target_grid - target_fields(7)%f=>ifd_target_grid - target_fields(8)%f=>qrain_target_grid - target_fields(9)%f=>tref_target_grid - target_fields(10)%f=>w_d_target_grid - target_fields(11)%f=>w_0_target_grid - target_fields(12)%f=>xs_target_grid - target_fields(13)%f=>xt_target_grid - target_fields(14)%f=>xu_target_grid - target_fields(15)%f=>xv_target_grid - target_fields(16)%f=>xz_target_grid - target_fields(17)%f=>xtts_target_grid - target_fields(18)%f=>xzts_target_grid - target_fields(19)%f=>z_c_target_grid - target_fields(20)%f=>zm_target_grid - - fields_to_regrid(3)%f=>c_d_input_grid - fields_to_regrid(4)%f=>c_0_input_grid - fields_to_regrid(5)%f=>d_conv_input_grid - fields_to_regrid(6)%f=>dt_cool_input_grid - fields_to_regrid(7)%f=>ifd_input_grid - fields_to_regrid(8)%f=>qrain_input_grid - fields_to_regrid(9)%f=>tref_input_grid - fields_to_regrid(10)%f=>w_d_input_grid - fields_to_regrid(11)%f=>w_0_input_grid - fields_to_regrid(12)%f=>xs_input_grid - fields_to_regrid(13)%f=>xt_input_grid - fields_to_regrid(14)%f=>xu_input_grid - fields_to_regrid(15)%f=>xv_input_grid - fields_to_regrid(16)%f=>xz_input_grid - fields_to_regrid(17)%f=>xtts_input_grid - fields_to_regrid(18)%f=>xzts_input_grid - fields_to_regrid(19)%f=>z_c_input_grid - fields_to_regrid(20)%f=>zm_input_grid - - target_ptrs(3)%p=>c_d_target_ptr - target_ptrs(4)%p=>c_0_target_ptr - target_ptrs(5)%p=>d_conv_target_ptr - target_ptrs(6)%p=>dt_cool_target_ptr - target_ptrs(7)%p=>ifd_target_ptr - target_ptrs(8)%p=>qrain_target_ptr - target_ptrs(9)%p=>tref_target_ptr - target_ptrs(10)%p=>w_d_target_ptr - target_ptrs(11)%p=>w_0_target_ptr - target_ptrs(12)%p=>xs_target_ptr - target_ptrs(13)%p=>xt_target_ptr - target_ptrs(14)%p=>xu_target_ptr - target_ptrs(15)%p=>xv_target_ptr - target_ptrs(16)%p=>xz_target_ptr - target_ptrs(17)%p=>xtts_target_ptr - target_ptrs(18)%p=>xzts_target_ptr - target_ptrs(19)%p=>z_c_target_ptr - target_ptrs(20)%p=>zm_target_ptr + call ESMF_FieldBundleAdd(bundle_water_target, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, & + dt_cool_target_grid,ifd_target_grid,qrain_target_grid,tref_target_grid, & + w_d_target_grid,w_0_target_grid,xs_target_grid,xt_target_grid,xu_target_grid, & + xv_target_grid,xz_target_grid,xtts_target_grid,xzts_target_grid, & + z_c_target_grid,zm_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_water_input, (/c_d_input_grid,c_0_input_grid,d_conv_input_grid, & + dt_cool_input_grid,ifd_input_grid,qrain_input_grid,tref_input_grid, & + w_d_input_grid,w_0_input_grid,xs_input_grid,xt_input_grid,xu_input_grid, & + xv_input_grid,xz_input_grid,xtts_input_grid,xzts_input_grid, & + z_c_input_grid,zm_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_water_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + search_nums(:)=(/11,83,0,0,0,0,1,0,11,0,0,0,0,0,0,30,0,0,0,0/) + dozero(:) = .True. + else + call ESMF_FieldBundleGet(bundle_water_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) search_nums(:)=(/11,83/) + dozero(:) = .True. endif + + call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & + n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1),resetifd=.True.) + + call FieldBundleDestroy(bundle_seaice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) - call regrid_many(fields_to_regrid,target_fields,target_ptrs,num_fields,regrid_water) - deallocate(fields_to_regrid) - -! print*,"- CALL Field_Regrid for skin temperature over water." -! call ESMF_FieldRegrid(skin_temp_input_grid, & -! skin_temp_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET skin temperature." -! call ESMF_FieldGet(skin_temp_target_grid, & -! farrayPtr=skin_temp_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL Field_Regrid for z0 over water." -! call ESMF_FieldRegrid(z0_input_grid, & -! z0_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL FieldGet FOR TARGET z0." -! call ESMF_FieldGet(z0_target_grid, & -! farrayPtr=z0_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! l = lbound(unmapped_ptr) -! u = ubound(unmapped_ptr) -! -! do ij = l(1), u(1) -! call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) -! skin_temp_target_ptr(i,j) = -9999.9 -! z0_target_ptr(i,j) = -9999.9 -! enddo -! -! if (convert_nst) then -! -! print*,"- CALL Field_Regrid for c_d over water." -! call ESMF_FieldRegrid(c_d_input_grid, & -! c_d_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for c_0 over water." -! call ESMF_FieldRegrid(c_0_input_grid, & -! c_0_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for d_conv over water." -! call ESMF_FieldRegrid(d_conv_input_grid, & -! d_conv_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for dt_cool over water." -! call ESMF_FieldRegrid(dt_cool_input_grid, & -! dt_cool_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for ifd over water." -! call ESMF_FieldRegrid(ifd_input_grid, & -! ifd_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for qrain over water." -! call ESMF_FieldRegrid(qrain_input_grid, & -! qrain_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for tref over water." -! call ESMF_FieldRegrid(tref_input_grid, & -! tref_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for w_d over water." -! call ESMF_FieldRegrid(w_d_input_grid, & -! w_d_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for w_0 over water." -! call ESMF_FieldRegrid(w_0_input_grid, & -! w_0_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xs over water." -! call ESMF_FieldRegrid(xs_input_grid, & -! xs_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xt over water." -! call ESMF_FieldRegrid(xt_input_grid, & -! xt_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xu over water." -! call ESMF_FieldRegrid(xu_input_grid, & -! xu_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xv over water." -! call ESMF_FieldRegrid(xv_input_grid, & -! xv_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xz over water." -! call ESMF_FieldRegrid(xz_input_grid, & -! xz_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xtts over water." -! call ESMF_FieldRegrid(xtts_input_grid, & -! xtts_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for xzts over water." -! call ESMF_FieldRegrid(xzts_input_grid, & -! xzts_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for z_c over water." -! call ESMF_FieldRegrid(z_c_input_grid, & -! z_c_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -! print*,"- CALL Field_Regrid for zm over water." -! call ESMF_FieldRegrid(zm_input_grid, & -! zm_target_grid, & -! routehandle=regrid_water, & -! termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldRegrid", rc) -! -!! Tag unmapped points -! -! print*,"- CALL FieldGet FOR TARGET c_d." -! call ESMF_FieldGet(c_d_target_grid, & -! farrayPtr=c_d_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET c_0." -! call ESMF_FieldGet(c_0_target_grid, & -! farrayPtr=c_0_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET d_conv." -! call ESMF_FieldGet(d_conv_target_grid, & -! farrayPtr=d_conv_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET dt_cool." -! call ESMF_FieldGet(dt_cool_target_grid, & -! farrayPtr=dt_cool_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET ifd." -! call ESMF_FieldGet(ifd_target_grid, & -! farrayPtr=ifd_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! ifd_target_ptr = float(nint(ifd_target_ptr)) -! -! print*,"- CALL FieldGet FOR TARGET qrain." -! call ESMF_FieldGet(qrain_target_grid, & -! farrayPtr=qrain_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET tref." -! call ESMF_FieldGet(tref_target_grid, & -! farrayPtr=tref_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET w_d." -! call ESMF_FieldGet(w_d_target_grid, & -! farrayPtr=w_d_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET w_0." -! call ESMF_FieldGet(w_0_target_grid, & -! farrayPtr=w_0_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xs." -! call ESMF_FieldGet(xs_target_grid, & -! farrayPtr=xs_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xt." -! call ESMF_FieldGet(xt_target_grid, & -! farrayPtr=xt_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xu." -! call ESMF_FieldGet(xu_target_grid, & -! farrayPtr=xu_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xv." -! call ESMF_FieldGet(xv_target_grid, & -! farrayPtr=xv_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xz." -! call ESMF_FieldGet(xz_target_grid, & -! farrayPtr=xz_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xtts." -! call ESMF_FieldGet(xtts_target_grid, & -! farrayPtr=xtts_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET xzts." -! call ESMF_FieldGet(xzts_target_grid, & -! farrayPtr=xzts_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET z_c." -! call ESMF_FieldGet(z_c_target_grid, & -! farrayPtr=z_c_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) -! -! print*,"- CALL FieldGet FOR TARGET zm." -! call ESMF_FieldGet(zm_target_grid, & -! farrayPtr=zm_target_ptr, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGet", rc) - if (convert_nst) ifd_target_ptr = float(nint(ifd_target_ptr)) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - -! c_d_target_ptr(i,j) = -9999.9 -! c_0_target_ptr(i,j) = -9999.9 -! d_conv_target_ptr(i,j) = -9999.9 -! dt_cool_target_ptr(i,j) = -9999.9 -! ifd_target_ptr(i,j) = -9999.9 -! qrain_target_ptr(i,j) = -9999.9 -! tref_target_ptr(i,j) = -9999.9 -! w_d_target_ptr(i,j) = -9999.9 -! w_0_target_ptr(i,j) = -9999.9 -! xs_target_ptr(i,j) = -9999.9 -! xt_target_ptr(i,j) = -9999.9 -! xu_target_ptr(i,j) = -9999.9 -! xv_target_ptr(i,j) = -9999.9 -! xz_target_ptr(i,j) = -9999.9 -! xtts_target_ptr(i,j) = -9999.9 -! xzts_target_ptr(i,j) = -9999.9 -! z_c_target_ptr(i,j) = -9999.9 -! zm_target_ptr(i,j) = -9999.9 - do k = 1, num_fields - target_ptrs(k)%p(i,j) = -9999.9 - end do - enddo - deallocate(target_ptrs) - !endif if (localpet == 0) then allocate(latitude_one_tile(i_target,j_target)) @@ -1574,13 +1072,6 @@ subroutine interp(localpet) do tile = 1, num_tiles_target_grid -! skin temp - -! print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE TILE: ", tile -! call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1596,333 +1087,19 @@ subroutine interp(localpet) water_target_one_tile = 0 where(mask_target_one_tile == 0) water_target_one_tile = 1 endif - ! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & - ! latitude=latitude_one_tile) - !endif call search_many(num_fields,target_fields,data_one_tile, water_target_one_tile,& - i_target,j_target,tile,search_nums,localpet,latitude=latitude_one_tile) - deallocate(target_fields) - -! print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP: ", tile -! call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! z0 -! -! print*,"- CALL FieldGather FOR TARGET GRID Z0 TILE: ", tile -! call ESMF_FieldGather(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 83) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID Z0: ", tile -! call ESMF_FieldScatter(z0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -! if (convert_nst) then -! -!! c_d -! -! print*,"- CALL FieldGather FOR TARGET GRID C_D TILE: ", tile -! call ESMF_FieldGather(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID C_D: ", tile -! call ESMF_FieldScatter(c_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! c_0 -! -! print*,"- CALL FieldGather FOR TARGET GRID C_0 TILE: ", tile -! call ESMF_FieldGather(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID C_0: ", tile -! call ESMF_FieldScatter(c_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! d_conv -! -! print*,"- CALL FieldGather FOR TARGET GRID D_CONV TILE: ", tile -! call ESMF_FieldGather(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID D_CONV: ", tile -! call ESMF_FieldScatter(d_conv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! dt_cool -! -! print*,"- CALL FieldGather FOR TARGET GRID DT_COOL TILE: ", tile -! call ESMF_FieldGather(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID DT_COOL: ", tile -! call ESMF_FieldScatter(dt_cool_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! ifd -! -! print*,"- CALL FieldGather FOR TARGET GRID IFD TILE: ", tile -! call ESMF_FieldGather(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 1) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID IFD: ", tile -! call ESMF_FieldScatter(ifd_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! qrain -! -! print*,"- CALL FieldGather FOR TARGET GRID QRAIN TILE: ", tile -! call ESMF_FieldGather(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID QRAIN: ", tile -! call ESMF_FieldScatter(qrain_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! tref -! -! print*,"- CALL FieldGather FOR TARGET GRID TREF TILE: ", tile -! call ESMF_FieldGather(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 11, & -! latitude=latitude_one_tile) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID TREF: ", tile -! call ESMF_FieldScatter(tref_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! w_d -! -! print*,"- CALL FieldGather FOR TARGET GRID W_D TILE: ", tile -! call ESMF_FieldGather(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID W_D: ", tile -! call ESMF_FieldScatter(w_d_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! w_0 -! -! print*,"- CALL FieldGather FOR TARGET GRID W_0 TILE: ", tile -! call ESMF_FieldGather(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID W_0: ", tile -! call ESMF_FieldScatter(w_0_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xs -! -! print*,"- CALL FieldGather FOR TARGET GRID XS TILE: ", tile -! call ESMF_FieldGather(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XS: ", tile -! call ESMF_FieldScatter(xs_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xt -! -! print*,"- CALL FieldGather FOR TARGET GRID XT TILE: ", tile -! call ESMF_FieldGather(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XT: ", tile -! call ESMF_FieldScatter(xt_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xu -! -! print*,"- CALL FieldGather FOR TARGET GRID XU TILE: ", tile -! call ESMF_FieldGather(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XU: ", tile -! call ESMF_FieldScatter(xu_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xv -! -! print*,"- CALL FieldGather FOR TARGET GRID XV TILE: ", tile -! call ESMF_FieldGather(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XV: ", tile -! call ESMF_FieldScatter(xv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xz -! -! print*,"- CALL FieldGather FOR TARGET GRID XZ TILE: ", tile -! call ESMF_FieldGather(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 30) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XZ: ", tile -! call ESMF_FieldScatter(xz_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xtts -! -! print*,"- CALL FieldGather FOR TARGET GRID XTTS TILE: ", tile -! call ESMF_FieldGather(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XTTS: ", tile -! call ESMF_FieldScatter(xtts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! xzts -! -! print*,"- CALL FieldGather FOR TARGET GRID XZTS TILE: ", tile -! call ESMF_FieldGather(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID XZTS: ", tile -! call ESMF_FieldScatter(xzts_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! z_c -! -! print*,"- CALL FieldGather FOR TARGET GRID Z_C TILE: ", tile -! call ESMF_FieldGather(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID Z_C: ", tile -! call ESMF_FieldScatter(z_c_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -!! zm -! -! print*,"- CALL FieldGather FOR TARGET GRID ZM TILE: ", tile -! call ESMF_FieldGather(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldGather", rc) -! -! if (localpet == 0) then -! call search(data_one_tile, water_target_one_tile, i_target, j_target, tile, 0) -! endif -! -! print*,"- CALL FieldScatter FOR TARGET GRID ZM: ", tile -! call ESMF_FieldScatter(zm_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) -! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & -! call error_handler("IN FieldScatter", rc) -! -! endif + tile,search_nums,localpet,latitude=latitude_one_tile) if (localpet == 0) deallocate(water_target_one_tile) enddo deallocate(latitude_one_tile) + + call FieldBundleDestroy(bundle_water_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) @@ -1957,69 +1134,40 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for snow depth over land." - call ESMF_FieldRegrid(snow_depth_input_grid, & - snow_depth_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, & ! flag needed so snow over sea - ! ice is not zeroed out. - rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for snow liq equiv over land." - call ESMF_FieldRegrid(snow_liq_equiv_input_grid, & - snow_liq_equiv_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for canopy mc." - call ESMF_FieldRegrid(canopy_mc_input_grid, & - canopy_mc_target_grid, & - routehandle=regrid_all_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET snow depth." - call ESMF_FieldGet(snow_depth_target_grid, & - farrayPtr=snow_depth_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET snow liq equiv." - call ESMF_FieldGet(snow_liq_equiv_target_grid, & - farrayPtr=snow_liq_equiv_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + bundle_alland_target = ESMF_FieldBundleCreate(name="all land target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_allland_input = ESMF_FieldBundleCreate(name="all land input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_allland_target, (/canopy_mc_target_grid, snow_depth_target_grid, & + snow_liq_equiv_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_allland_input, (/canopy_mc_input_grid, snow_depth_input_grid, & + snow_liq_equiv_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_allland_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + - print*,"- CALL FieldGet FOR TARGET canopy moisture." - call ESMF_FieldGet(canopy_mc_target_grid, & - farrayPtr=canopy_mc_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) + search_nums = (/223,66,65/) + dozero=(/.True,.False.,.False./) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - snow_depth_target_ptr(i,j) = -9999.9 - snow_liq_equiv_target_ptr(i,j) = -9999.9 - canopy_mc_target_ptr(i,j) = -9999.9 - enddo + call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & + n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) + call FieldBundleDestroy(bundle_allland_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + do tile = 1, num_tiles_target_grid - print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldGather(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TARGET LANDMASK TILE: ", tile call ESMF_FieldGather(landmask_target_grid, mask_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -2029,45 +1177,18 @@ subroutine interp(localpet) allocate(land_target_one_tile(i_target,j_target)) land_target_one_tile = 0 where(mask_target_one_tile == 1) land_target_one_tile = 1 - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 66) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH: ", tile - call ESMF_FieldScatter(snow_depth_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SNOW LIQUID EQUIV: ", tile - call ESMF_FieldGather(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 65) endif + + call search_many(num_fields,bundle_allland_target,data_one_tile, land_target_one_tile,& + tile,search_nums,localpet) - print*,"- CALL FieldScatter FOR TARGET GRID SNOW LIQUID EQUIV: ", tile - call ESMF_FieldScatter(snow_liq_equiv_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID CANOPY MC: ", tile - call ESMF_FieldGather(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 223) - deallocate(land_target_one_tile) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID CANOPY MC: ", tile - call ESMF_FieldScatter(canopy_mc_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - + if (localpet == 0) deallocate(land_target_one_tile) enddo - + + call FieldBundleDestroy(bundle_allland_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_all_land, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -2115,135 +1236,74 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for soil temperature over landice." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for skin temperature over landice." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for terrain over landice." - call ESMF_FieldRegrid(terrain_input_grid, & - terrain_from_input_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL FieldGet FOR TARGET grid column temperature over landice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR terrain from input grid." - call ESMF_FieldGet(terrain_from_input_grid, & - farrayPtr=terrain_from_input_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) - - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - soil_temp_target_ptr(i,j,:) = -9999.9 - skin_temp_target_ptr(i,j) = -9999.9 - terrain_from_input_ptr(i,j) = -9999.9 - enddo - - if (localpet == 0) then - allocate (veg_type_target_one_tile(i_target,j_target)) - allocate (land_target_one_tile(i_target,j_target)) - allocate (data_one_tile2(i_target,j_target)) - else - allocate (veg_type_target_one_tile(0,0)) - allocate (land_target_one_tile(0,0)) - allocate (data_one_tile2(0,0)) - endif - - do tile = 1, num_tiles_target_grid - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMP TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + bundle_landice_target = ESMF_FieldBundleCreate(name="landice target", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile - call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) + call error_handler("IN FieldBundleCreate", rc) + bundle_landice_input = ESMF_FieldBundleCreate(name="landice input", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - land_target_one_tile = 0 - where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1 - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMP, TILE: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + call error_handler("IN FieldBundleCreate", rc) + call ESMF_FieldBundleAdd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid, + soil_temp_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid + soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_landice_target,fieldCount=num_fields,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call error_handler("IN FieldBundleGet", rc) - print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid_land, data_one_tile2, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) - if (localpet == 0) then - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 7, terrain_land=data_one_tile2) - endif + search_nums = (/21,7/) + dozero(:) = .False. - print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) + call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & + n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) + + call FieldBundleDestroy(bundle_landice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call error_handler("IN FieldBundleDestroy", rc) + + if (localpet == 0) then + allocate (veg_type_target_one_tile(i_target,j_target)) + allocate (land_target_one_tile(i_target,j_target)) + allocate (data_one_tile2(i_target,j_target)) + else + allocate (veg_type_target_one_tile(0,0)) + allocate (land_target_one_tile(0,0)) + allocate (data_one_tile2(0,0)) + endif - print*,"- CALL FieldGather FOR TARGET GRID LANDICE COLUMN TEMP: ", tile - call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) + do tile = 1, num_tiles_target_grid + print*,"- CALL FieldGather FOR TARGET VEG TYPE TILE: ", tile + call ESMF_FieldGather(veg_type_target_grid, veg_type_target_one_tile, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, land_target_one_tile, i_target, j_target, tile, 21) - data_one_tile_3d(:,:,j) = data_one_tile - enddo + land_target_one_tile = 0 + where(nint(veg_type_target_one_tile) == veg_type_landice_target) land_target_one_tile = 1 endif + + print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID LAND, TILE: ", tile + call ESMF_FieldGather(terrain_from_input_grid_land, data_one_tile2, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGather", rc) - print*,"- CALL FieldScatter FOR TARGET GRID SEAICE COLUMN TEMP: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) + call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,& + tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d)) enddo deallocate (veg_type_target_one_tile) deallocate (land_target_one_tile) + + call FieldBundleDestroy(bundle_landice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_landice, rc=rc) @@ -2280,162 +1340,141 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - print*,"- CALL Field_Regrid for total soil moisture over land." - call ESMF_FieldRegrid(soilm_tot_input_grid, & - soilm_tot_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for soil temperature over land." - call ESMF_FieldRegrid(soil_temp_input_grid, & - soil_temp_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for skin temperature over land." - call ESMF_FieldRegrid(skin_temp_input_grid, & - skin_temp_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for terrain over land." - call ESMF_FieldRegrid(terrain_input_grid, & - terrain_from_input_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - zeroregion=ESMF_REGION_SELECT, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for soil type over land." - call ESMF_FieldRegrid(soil_type_input_grid, & - soil_type_from_input_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - if (.not. vgfrc_from_climo) then - print*,"- CALL Field_Regrid for veg greenness over land." - call ESMF_FieldRegrid(veg_greenness_input_grid, & - veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + bundle_nolandice_target = ESMF_FieldBundleCreate(name="land no landice target", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - endif - - if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL Field_Regrid for max veg greenness over land." - call ESMF_FieldRegrid(max_veg_greenness_input_grid, & - max_veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - - print*,"- CALL Field_Regrid for min veg greenness over land." - call ESMF_FieldRegrid(min_veg_greenness_input_grid, & - min_veg_greenness_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - endif - - if (.not. lai_from_climo) then - print*,"- CALL Field_Regrid for leaf area index over land." - call ESMF_FieldRegrid(lai_input_grid, & - lai_target_grid, & - routehandle=regrid_land, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldRegrid", rc) - + call error_handler("IN FieldBundleCreate", rc) + + bundle_nolandice_input = ESMF_FieldBundleCreate(name="land no landice input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid, + soil_type_from_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid + soil_type_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + + if (.not. sotyp_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, soil_type_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, soil_type_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + sotyp_ind = num_fields endif + + if (.not. vgfrc_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, veg_greenness_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, veg_greenness_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + vgfrc_ind = num_fields + endif + + if (.not. lai_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, lai_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, lai_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + lai_ind = num_fields + endif + + if (.not. minmax_vgfrc_from_climo) then + call ESMF_FieldBundleAdd(bundle_nolandice_target, max_veg_greenness_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, max_veg_greenness_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_target, min_veg_greenness_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, min_veg_greenness_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + mmcv_ind = num_fields-1 + endif + + call ESMF_FieldBundleAdd(bundle_nolandice_target, soilm_tot_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, soilm_tot_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleAdd(bundle_nolandice_target, soil_temp_target_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, soil_temp_input_grid, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) - print*,"- CALL FieldGet FOR TARGET grid total soil moisture over land." - call ESMF_FieldGet(soilm_tot_target_grid, & - farrayPtr=soilm_tot_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET grid soil temp over ice." - call ESMF_FieldGet(soil_temp_target_grid, & - farrayPtr=soil_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET skin temperature." - call ESMF_FieldGet(skin_temp_target_grid, & - farrayPtr=skin_temp_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR terrain from input grid." - call ESMF_FieldGet(terrain_from_input_grid, & - farrayPtr=terrain_from_input_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + + call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) - print*,"- CALL FieldGet FOR soil type from input grid." - call ESMF_FieldGet(soil_type_from_input_grid, & - farrayPtr=soil_type_from_input_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + search_nums(1:3) = (/85,7,224/) + dozero(1:3) = (/.False.,.False.,.True./) + dozero(num_fields-1:num_fields) = (/.True.,.False./) + + if (.not.sotyp_from_climo) then + search_nums(sotyp_ind) = 226 + dozero(sotyp_ind) = .False. + endif + if (.not. vgfrc_from_climo) then - print*,"- CALL FieldGet FOR TARGET veg greenness." - call ESMF_FieldGet(veg_greenness_target_grid, & - farrayPtr=veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + search_nums(vgfrc_ind) = 224 + dozero(vgfrc_ind) = .True. + endif + + if (.not. lai_from_climo) then + search_nums(lai_ind) = 229 + dozero(lai_ind) = .True. endif if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL FieldGet FOR TARGET max veg greenness." - call ESMF_FieldGet(max_veg_greenness_target_grid, & - farrayPtr=max_veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - - print*,"- CALL FieldGet FOR TARGET min veg greenness." - call ESMF_FieldGet(min_veg_greenness_target_grid, & - farrayPtr=min_veg_greenness_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - endif - - if (.not. lai_from_climo) then - print*,"- CALL FieldGet FOR TARGET lai." - call ESMF_FieldGet(lai_target_grid, & - farrayPtr=lai_target_ptr, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGet", rc) - endif + search_nums(mmvg_ind) = 227 + dozero(mmvg_ind) = .True. + + search_nums(mmvg_ind+1) = 228 + dozero(mmvg_land+1) = .True. + endif - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) - do ij = l(1), u(1) - call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) - soilm_tot_target_ptr(i,j,:) = -9999.9 - soil_temp_target_ptr(i,j,:) = -9999.9 - skin_temp_target_ptr(i,j) = -9999.9 - terrain_from_input_ptr(i,j) = -9999.9 - soil_type_from_input_ptr(i,j) = -9999.9 - veg_greenness_target_ptr(i,j) = -9999.9 - max_veg_greenness_target_ptr(i,j) = -9999.9 - min_veg_greenness_target_ptr(i,j) = -9999.9 - lai_target_ptr(i,j) = -9999.9 - enddo + call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, & + n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) + call FieldBundleDestroy(bundle_nolandice_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) if (localpet == 0) then allocate (veg_type_target_one_tile(i_target,j_target)) @@ -2455,142 +1494,17 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - print*,"- CALL FieldGather FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - if (localpet == 0) then where(nint(veg_type_target_one_tile) == veg_type_landice_target) mask_target_one_tile = 0 - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 7) - endif - - print*,"- CALL FieldScatter FOR TERRAIN FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(terrain_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile - call ESMF_FieldGather(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) endif - - print*,"- CALL FieldScatter FOR TARGET GRID SKIN TEMPERATURE, TILE: ", tile - call ESMF_FieldScatter(skin_temp_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile - call ESMF_FieldGather(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - + print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile call ESMF_FieldGather(soil_type_target_grid, data_one_tile2, rootPet=0,tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGather", rc) - -!--------------------------------------------------------------------------------------- -! Some grib2 data does not have soil type. Set soil type interpolated from input -! grid to the target (model) grid soil type. This turns off the soil moisture -! rescaling. -!--------------------------------------------------------------------------------------- - - if (.not. sotyp_from_climo) then - if (localpet==0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 224,soilt_climo=data_one_tile2) - endif - else - if (localpet == 0 .and. maxval(data_one_tile) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then - ! If soil type from the input grid has any non-zero points then soil type must exist for - ! use - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 224) - elseif (localpet == 0) then - data_one_tile = data_one_tile2 - endif - endif - - if (.not. sotyp_from_climo) then - print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - endif - - print*,"- CALL FieldScatter FOR SOIL TYPE FROM INPUT GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_from_input_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - - if (.not. vgfrc_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 226) - endif - - print*,"- CALL FieldScatter FOR VEG GREENNESS TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(veg_greenness_target_grid, data_one_tile, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - endif - - if (.not. minmax_vgfrc_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID MAX VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(max_veg_greenness_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile, 227) - endif - - print*,"- CALL FieldScatter FOR MAX VEG GREENNESS TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(max_veg_greenness_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - print*,"- CALL FieldGather FOR TARGET GRID MIN VEG GREENNESS, TILE: ", tile - call ESMF_FieldGather(min_veg_greenness_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,228) - endif - - - print*,"- CALL FieldScatter FOR MIN VEG GREENNESS TARGET GRID, TILE: ",tile - call ESMF_FieldScatter(min_veg_greenness_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - - endif - - if (.not. lai_from_climo) then - print*,"- CALL FieldGather FOR TARGET GRID LEAF AREA INDEX, TILE: ", tile - call ESMF_FieldGather(lai_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0 .and. maxval(data_one_tile) > 0.0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile, 229) - endif - - print*,"- CALL FieldScatter FOR LEAF AREA INDEX TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(lai_target_grid, data_one_tile, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - endif + call search_many(num_fields,bundle_nolandice_target,data_one_tile, land_target_one_tile,& + tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d)) print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) @@ -2605,28 +1519,10 @@ subroutine interp(localpet) enddo endif - print*,"- CALL FieldScatter FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile - call ESMF_FieldScatter(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - print*,"- CALL FieldGather FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile call ESMF_FieldGather(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - do j = 1, lsoil_target - data_one_tile = data_one_tile_3d(:,:,j) - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, 85) - data_one_tile_3d(:,:,j) = data_one_tile - enddo - endif - - print*,"- CALL FieldScatter FOR TARGET GRID SOIL TEMPERATURE, TILE: ", tile - call ESMF_FieldScatter(soil_temp_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) if (tg3_from_soil) then print*,"- CALL FieldScatter FOR TARGET GRID SUBSTRATE TEMPERATURE, TILE: ", tile @@ -2636,6 +1532,10 @@ subroutine interp(localpet) endif enddo + + call FieldBundleDestroy(bundle_nolandice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_land, rc=rc) @@ -4680,7 +3580,8 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID SOIL TYPE." soil_type_from_input_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soil_type_from_input_grid", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -4919,92 +3820,206 @@ end subroutine ij_to_i_j !> Regrid multiple ESMF fields from input to target grid !! -!! @param[in] fields_pre Length num_field array of ptrs to input ESMF fields -!! @param[in] fields_post Length num_field array of ptrs to target ESMF fields +!! @param[in] bundle_pre ESMF fieldBundle on input grid +!! @param[in] bundle_post ESMF fieldBundle on target grid !! @param[inout] post_ptrs Length num_field array of ptrs to ESMF target field pointers -!! @param[in] num_field Number of fields to process +!! @param[in] num_field Number of fields in target field pointer !! @param[inout] route Route handle to saved ESMF regridding instructions + !! @author Larissa Reames, OU CIMMS/NOAA/NSSL - subroutine regrid_many(fields_pre,fields_post,post_ptrs, num_field,route) + subroutine regrid_many(fields_pre,fields_post, num_field,route,dozero,doreplace, & + n_unmap, unmapped_ptr, u, l,resetifd) use esmf + + use program_setup, only : convert_nst implicit none - integer, intent(in) :: num_field - type(esmf_routehandle), intent(inout) :: route - type(fieldptr), intent(in) :: fields_pre(num_field), fields_post(num_field) - type(realptr), intent(inout) :: post_ptrs(num_field) + integer, intent(in) :: num_field + type(esmf_routehandle), intent(inout) :: route + type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post + logical, intent(in) :: dozero(num_field), doreplace + logical, intent(in), optional :: resetifd + integer, intent(in), optional :: n_unmap, u, l + type(realptr), intent(inout),optional :: unmapped_ptr(n_unmap) - integer :: i, rc + + type(esmf_field) :: field_pre,field_post + real(esmf_kind_r8), pointer :: tmp_ptr(:,:) + real(realptr2d), pointer, allocatable :: 2d_ptr(:) + real(realptr3d), pointer, allocatable :: 3d_ptr(:) + logical :: is2d(num_field) + character(len=50) :: fname + integer :: i, j, k, ij, 2d_cur, 3d_cur, rc, ndims + + 2d_cur = 0 + 3d_cur = 0 do i = 1, num_field - - call ESMF_FieldRegrid(fields_pre(i)%f, & - fields_post(i)%f, & - routehandle=route, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + call ESMF_FieldBundleGet(bundle_pre,i,field_pre,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) - - call ESMF_FieldGet(fields_post(i)%f, & - farrayPtr=post_ptrs(i)%p, rc=rc) + call error_handler("IN FieldBundleGet", rc) + + call ESMF_FieldBundleGet(bundle_post,i,field_post,dimCount=ndims,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc)! - end do + call error_handler("IN FieldBundleGet", rc) + + if (ndims == 2) is2d(i) = .True. + if (ndims == 3) is2d(i) = .False. + + if (dozero(i)) then + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + else + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + zeroregion=ESMF_REGION_SELECT + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) + endif + enddo + + if (resetifd .and. convert_nst) then + call ESMF_FieldGet(ifd_target_grid,farrayPtr=tmp_ptr,rc=rc) + ff(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + tmp_ptr = float(nint(tmp_ptr)) + endif + + n2d = count(is2d == .True.) + n3d = count(is3d == .False.) + + if (doreplace) then + allocate(2d_ptr(n2d)) + if (n3d .ne. 0) allocate(3d_ptr(n3d)) + do i=1, field + if (is2d(i)) then + 2d_cur = 2d_cur + 1 + call ESMF_FieldGet(field_post, & + farrayPtr=2d_ptr(2d_cur)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + else + 3d_cur = 3d_cur + 1 + call ESMF_FieldGet(field_post, & + farrayPtr=3d_ptr(3d_cur)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + endif + end do + + do ij = l, u + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + do k = 1,n2d + 2d_ptr(i)%p(i,j) = -9999.9 + enddo + do k = 1,n3d + 3d_ptr(i)%p(i,j,:) = -9999.1 + enddo + enddo + endif end subroutine regrid_many !> Execute the search function for multple fields !! !! @param[in] num_field Number of fields to process. -!! @param[inout] target_fields Length num_field array of ptrs to target ESMF fields. +!! @param[inout] bundle_target ESMF FieldBundle holding target fields to search !! @param[inout] field_data A real array of size i_target,j_target to temporarily hold data for searching !! @param[inout] mask An integer array of size i_target,j_target that holds masked (0) and unmasked (1) !! values indicating where to execute search (only at unmasked points). -!! @param[in] i_search First (east-west) index of unmapped points to replace. -!! @param[in] j_search Second (north-south) index of unmapped points to replace. !! @param[in] tile Current cubed sphere tile. !! @param[inout] search_nums Array length num_field holding search field numbers corresponding to each field provided for searching. !! @param[in] localpet ESMF local persistent execution thread. -!! @param[in][optional] latitude A real array size i_target,j_target of latitude on the target grid +!! @param[in] (optional) latitude A real array size i_target,j_target of latitude on the target grid +!! @param[in] (optional) terrain_land A real array size i_target,j_target of terrain height (m) on the target grid +!! @param[in] (optional) soilt_climo A real array size i_target,j_target of climatological soil type on the target grid !! @author Larissa Reames, OU CIMMS/NOAA/NSSL - subroutine search_many(num_field,target_fields,field_data,mask,i_search,j_search,tile,search_nums,localpet,latitude) + subroutine search_many(num_field,bundle_target,field_data,mask, tile, & + search_nums,localpet,latitude,terrain_land,soilt_climo) use model_grid, only : i_target,j_target + use program_setup, only : external_model, input_type, sotyp_from_climo use search_util implicit none integer, intent(in) :: num_field - type(fieldptr), intent(inout) :: target_fields(num_field) - real(esmf_kind_r8), intent(inout) :: field_data(i_target,j_target) + type(esmf_fieldbundle), intent(inout) :: bundle_target + real(esmf_kind_r8), intent(inout) :: field_data_2d(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: field_data_3d(i_target,j_target,lsoil_target) real(esmf_kind_r8), intent(inout), optional :: latitude(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: terrain_land(i_target,j_target) + real(esmf_kind_r8), intent(inout), optional :: soilt_climo(i_target,j_target) integer(esmf_kind_i8), intent(inout) :: mask(i_target,j_target) - integer, intent(in) :: i_search,j_search,tile,localpet + + integer, intent(in) :: tile,localpet integer, intent(inout) :: search_nums(num_field) - - integer :: k, rc + + type(esmf_field) :: temp_field + integer, parameter :: SOTYP_LAND_FIELD_NUM = 224 + integer :: k, rc, ndims do k = 1,num_field - print*,"- CALL FieldGather FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldGather(target_fields(k)%f, field_data, rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) + call ESMF_FieldBundleGet(bundle_target,i,temp_field, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + call ESMF_FieldGet(temp_field, name=fname, dimcount=ndims,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) if (localpet == 0) then - if (present(latitude)) then - call search(field_data, mask, i_search, j_search, tile,search_nums(k),latitude=latitude) + + if (ndims .eq. 2) then + call ESMF_FieldGather(temp_field,field_data_2d,rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + + if (present(latitude)) then + call search(field_data, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) + elseif (present(terrain_land)) then + call search(field_data, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) + elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then + if (fname .eq. "soil_type_target_grid") then + call search(field_data, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo) + elseif (present(soilt_climo) .and. search_nums(k) .eq. SOILT_TARGET_FIELD_NUM) then + if (maxval(field_data) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then + ! If soil type from the input grid has any non-zero points then soil type must exist for use + call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, search_nums(k)) + elseif ! Otherwise, just set the data on the "target" grid to the soil climatology + field_data = soilt_climo + endif !check field value + else + call search(field_data, mask, i_target, j_target, tile,search_nums(k)) + endif !sotype from target grid + endif !if present else - call search(field_data, mask, i_search, j_search, tile,search_nums(k)) - endif - endif + do j = 1, lsoil_target + field_data_2d = field_data_3d(:,:,j) + call search(field_data_2d, mask, i_target, j_target, tile, 21) + field_data_3d(:,:,j) = field_data_3d + enddo + endif !ndims + endif !localpet == 0 - print*,"- CALL FieldScatter FOR TARGET GRID SNOW DEPTH TILE: ", tile - call ESMF_FieldScatter(target_fields(k)%f, field_data, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) + if (ndims .eq. 2) then + call ESMF_FieldScatter(target_fields(k)%f, field_data_2d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + else + call ESMF_FieldScatter(target_fields(k)%f, field_data_3d, rootPet=0, tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + endif end do end subroutine search_many From caf50752c4ada359d1e06e70cd59f63c6a69a961 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Mon, 10 May 2021 16:12:43 +0000 Subject: [PATCH 05/18] Update to fix all compile and run-time bugs. Compiles and completes execution, and all but one tests pass. Still investigating this. --- sorc/chgres_cube.fd/surface.F90 | 420 ++++++++++++++++---------------- 1 file changed, 214 insertions(+), 206 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 0bf254bcc..f98d1af91 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -141,11 +141,11 @@ module surface type realptr_2d real(esmf_kind_r8), pointer :: p(:,:) - end type realptr + end type realptr_2d type realptr_3d real(esmf_kind_r8), pointer :: p(:,:,:) - end type realptr + end type realptr_3d public :: surface_driver @@ -377,9 +377,7 @@ subroutine interp(localpet) vgfrc_from_climo, & minmax_vgfrc_from_climo, & lai_from_climo, & - tg3_from_soil, & - external_model, & - input_type + tg3_from_soil use static_data, only : veg_type_target_grid, & soil_type_target_grid, & @@ -395,7 +393,7 @@ subroutine interp(localpet) integer, intent(in) :: localpet integer :: l(1), u(1) - integer :: i, j, ij, rc, tile,k + integer :: i, j, ij, rc, tile integer :: clb_target(2), cub_target(2) integer :: isrctermprocessing integer :: num_fields @@ -414,45 +412,13 @@ subroutine interp(localpet) real(esmf_kind_r8), allocatable :: data_one_tile2(:,:) real(esmf_kind_r8), allocatable :: data_one_tile_3d(:,:,:) real(esmf_kind_r8), allocatable :: latitude_one_tile(:,:) - real(esmf_kind_r8), pointer :: canopy_mc_target_ptr(:,:) - real(esmf_kind_r8), pointer :: c_d_target_ptr(:,:) - real(esmf_kind_r8), pointer :: c_0_target_ptr(:,:) - real(esmf_kind_r8), pointer :: d_conv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: dt_cool_target_ptr(:,:) - real(esmf_kind_r8), pointer :: ifd_target_ptr(:,:) - real(esmf_kind_r8), pointer :: qrain_target_ptr(:,:) - real(esmf_kind_r8), pointer :: tref_target_ptr(:,:) - real(esmf_kind_r8), pointer :: w_d_target_ptr(:,:) - real(esmf_kind_r8), pointer :: w_0_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xs_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xt_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xu_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xz_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xtts_target_ptr(:,:) - real(esmf_kind_r8), pointer :: xzts_target_ptr(:,:) - real(esmf_kind_r8), pointer :: z_c_target_ptr(:,:) - real(esmf_kind_r8), pointer :: zm_target_ptr(:,:) - real(esmf_kind_r8), pointer :: seaice_depth_target_ptr(:,:) real(esmf_kind_r8), pointer :: seaice_fract_target_ptr(:,:) - real(esmf_kind_r8), pointer :: seaice_skin_temp_target_ptr(:,:) - real(esmf_kind_r8), pointer :: skin_temp_target_ptr(:,:) - real(esmf_kind_r8), pointer :: snow_depth_target_ptr(:,:) - real(esmf_kind_r8), pointer :: snow_liq_equiv_target_ptr(:,:) - real(esmf_kind_r8), pointer :: soil_temp_target_ptr(:,:,:) - real(esmf_kind_r8), pointer :: soil_type_from_input_ptr(:,:) - real(esmf_kind_r8), pointer :: soilm_tot_target_ptr(:,:,:) real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:) real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) - real(esmf_kind_r8), pointer :: z0_target_ptr(:,:) real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:) real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:) - real(esmf_kind_r8), pointer :: veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: min_veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: max_veg_greenness_target_ptr(:,:) - real(esmf_kind_r8), pointer :: lai_target_ptr(:,:) type(esmf_regridmethod_flag) :: method type(esmf_routehandle) :: regrid_bl_no_mask @@ -464,7 +430,7 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_water type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input - type(esmf_fieldbundle) :: bundle_seaice, bundle_seaice_input + type(esmf_fieldbundle) :: bundle_seaice_target, bundle_seaice_input type(esmf_fieldbundle) :: bundle_water_target, bundle_water_input type(esmf_fieldbundle) :: bundle_allland_target, bundle_allland_input type(esmf_fieldbundle) :: bundle_landice_target, bundle_landice_input @@ -497,12 +463,12 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleCreate", rc) - call ESMF_FieldBundleAdd(bundle_all_target, (/t2_target_grid,q2_target_grid,tprcp_target_grid, & + call ESMF_FieldBundleAdd(bundle_all_target, (/t2m_target_grid,q2m_target_grid,tprcp_target_grid, & f10m_target_grid,ffmm_target_grid,ustar_target_grid,srflag_target_grid/), & rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_all_input, (/t2_input_grid,q2_input_grid,tprcp_input_grid, & + call ESMF_FieldBundleAdd(bundle_all_input, (/t2m_input_grid,q2m_input_grid,tprcp_input_grid, & f10m_input_grid,ffmm_input_grid,ustar_input_grid,srflag_input_grid/), & rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -515,12 +481,12 @@ subroutine interp(localpet) allocate(dozero(num_fields)) dozero = (/.True., .True., .True., .True., .True., .True., .True./) - call regrid_many(fields_to_regrid,target_fields,num_fields,regrid_bl_no_mask,dozero) - - call FieldBundleDestroy(bundle_all_target,rc=rc) + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.,0) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) - call FieldBundleDestroy(bundle_all_input,rc=rc) + call ESMF_FieldBundleDestroy(bundle_all_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -942,9 +908,9 @@ subroutine interp(localpet) u = ubound(unmapped_ptr) call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & - n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) - - call FieldBundleDestroy(bundle_seaice_input,rc=rc) + .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1) ) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_seaice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -961,15 +927,15 @@ subroutine interp(localpet) endif - call search_many(num_fields,bundle_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, & + call search_many(num_fields,bundle_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, & field_data_3d=data_one_tile_3d) - - call FieldBundleDestroy(target_fields,rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleDestroy", rc) - enddo + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_seaice_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_seaice, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1012,11 +978,10 @@ subroutine interp(localpet) call ESMF_FieldBundleAdd(bundle_water_target, (/skin_temp_target_grid, z0_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_seaice_input, (/skin_temp_input_grid, z0_input_grid,/), rc=rc) + call ESMF_FieldBundleAdd(bundle_water_input, (/skin_temp_input_grid, z0_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - allocate(search_nums(num_fields)) if (convert_nst) then @@ -1055,11 +1020,12 @@ subroutine interp(localpet) search_nums(:)=(/11,83/) dozero(:) = .True. endif - + + if(localpet==0) print*, "num unmapped = ", u(1)-l(1) call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & - n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1),resetifd=.True.) - - call FieldBundleDestroy(bundle_seaice_input,rc=rc) + .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1),resetifd=.True.) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_water_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1088,16 +1054,16 @@ subroutine interp(localpet) where(mask_target_one_tile == 0) water_target_one_tile = 1 endif - call search_many(num_fields,target_fields,data_one_tile, water_target_one_tile,& + call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,& tile,search_nums,localpet,latitude=latitude_one_tile) if (localpet == 0) deallocate(water_target_one_tile) enddo - deallocate(latitude_one_tile) + deallocate(latitude_one_tile,search_nums) - call FieldBundleDestroy(bundle_water_input,rc=rc) + call ESMF_FieldBundleDestroy(bundle_water_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1134,7 +1100,7 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldRegridStore", rc) - bundle_alland_target = ESMF_FieldBundleCreate(name="all land target", rc=rc) + bundle_allland_target = ESMF_FieldBundleCreate(name="all land target", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleCreate", rc) bundle_allland_input = ESMF_FieldBundleCreate(name="all land input", rc=rc) @@ -1157,11 +1123,12 @@ subroutine interp(localpet) allocate(dozero(num_fields)) search_nums = (/223,66,65/) - dozero=(/.True,.False.,.False./) + dozero=(/.True.,.False.,.False./) call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & - n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) - call FieldBundleDestroy(bundle_allland_input,rc=rc) + .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1)) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_allland_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1184,8 +1151,9 @@ subroutine interp(localpet) if (localpet == 0) deallocate(land_target_one_tile) enddo - - call FieldBundleDestroy(bundle_allland_target,rc=rc) + + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_allland_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1242,11 +1210,11 @@ subroutine interp(localpet) bundle_landice_input = ESMF_FieldBundleCreate(name="landice input", rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleCreate", rc) - call ESMF_FieldBundleAdd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid, + call ESMF_FieldBundleAdd(bundle_landice_target, (/skin_temp_target_grid, terrain_from_input_grid,& soil_temp_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid + call ESMF_FieldBundleAdd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid,& soil_temp_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) @@ -1261,9 +1229,9 @@ subroutine interp(localpet) dozero(:) = .False. call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & - n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) - - call FieldBundleDestroy(bundle_landice_input,rc=rc) + .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1) ) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_landice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1294,14 +1262,15 @@ subroutine interp(localpet) call error_handler("IN FieldGather", rc) call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,& - tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d)) + tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d) enddo deallocate (veg_type_target_one_tile) deallocate (land_target_one_tile) + deallocate(search_nums) - call FieldBundleDestroy(bundle_landice_target,rc=rc) + call ESMF_FieldBundleDestroy(bundle_landice_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1348,22 +1317,22 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleCreate", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid, - soil_type_from_grid/), rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/skin_temp_target_grid, terrain_from_input_grid,& + soil_type_from_input_grid,soilm_tot_target_grid,soil_temp_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid - soil_type_input_grid/), rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/skin_temp_input_grid, terrain_input_grid,& + soil_type_input_grid,soilm_tot_input_grid,soil_temp_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) if (.not. sotyp_from_climo) then - call ESMF_FieldBundleAdd(bundle_nolandice_target, soil_type_target_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, soil_type_input_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) @@ -1373,10 +1342,10 @@ subroutine interp(localpet) endif if (.not. vgfrc_from_climo) then - call ESMF_FieldBundleAdd(bundle_nolandice_target, veg_greenness_target_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/veg_greenness_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, veg_greenness_input_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/veg_greenness_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) @@ -1386,10 +1355,10 @@ subroutine interp(localpet) endif if (.not. lai_from_climo) then - call ESMF_FieldBundleAdd(bundle_nolandice_target, lai_target_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/lai_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, lai_input_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/lai_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) @@ -1399,17 +1368,17 @@ subroutine interp(localpet) endif if (.not. minmax_vgfrc_from_climo) then - call ESMF_FieldBundleAdd(bundle_nolandice_target, max_veg_greenness_target_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/max_veg_greenness_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, max_veg_greenness_input_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/max_veg_greenness_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_target, min_veg_greenness_target_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_target, (/min_veg_greenness_target_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, min_veg_greenness_input_grid, rc=rc) + call ESMF_FieldBundleAdd(bundle_nolandice_input, (/min_veg_greenness_input_grid/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) @@ -1417,24 +1386,9 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleGet", rc) - mmcv_ind = num_fields-1 + mmvg_ind = num_fields-1 endif - call ESMF_FieldBundleAdd(bundle_nolandice_target, soilm_tot_target_grid, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, soilm_tot_input_grid, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - - call ESMF_FieldBundleAdd(bundle_nolandice_target, soil_temp_target_grid, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, soil_temp_input_grid, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - - call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleGet", rc) @@ -1443,9 +1397,8 @@ subroutine interp(localpet) allocate(dozero(num_fields)) - search_nums(1:3) = (/85,7,224/) - dozero(1:3) = (/.False.,.False.,.True./) - dozero(num_fields-1:num_fields) = (/.True.,.False./) + search_nums(1:5) = (/85,7,224,85,86/) + dozero(1:5) = (/.False.,.False.,.True.,.True.,.False./) if (.not.sotyp_from_climo) then search_nums(sotyp_ind) = 226 @@ -1467,12 +1420,13 @@ subroutine interp(localpet) dozero(mmvg_ind) = .True. search_nums(mmvg_ind+1) = 228 - dozero(mmvg_land+1) = .True. + dozero(mmvg_ind+1) = .True. endif call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, & - n_unmap=u(1)-l(1), unmapped_ptr=unmapped_ptr, u(1), l(1) ) - call FieldBundleDestroy(bundle_nolandice_input,rc=rc) + .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1)) + deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_nolandice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -1503,8 +1457,8 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGather", rc) - call search_many(num_fields,bundle_nolandice_target,data_one_tile, land_target_one_tile,& - tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d)) + call search_many(num_fields,bundle_nolandice_target,data_one_tile, mask_target_one_tile,& + tile,search_nums,localpet,soilt_climo=data_one_tile2, field_data_3d=data_one_tile_3d) print*,"- CALL FieldGather FOR TARGET GRID TOTAL SOIL MOISTURE, TILE: ", tile call ESMF_FieldGather(soilm_tot_target_grid, data_one_tile_3d, rootPet=0, tile=tile, rc=rc) @@ -1532,8 +1486,9 @@ subroutine interp(localpet) endif enddo - - call FieldBundleDestroy(bundle_nolandice_target,rc=rc) + + deallocate(search_nums) + call ESMF_FieldBundleDestroy(bundle_nolandice_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -3325,6 +3280,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID T2M." t2m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="t2m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3340,6 +3296,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID Q2M." q2m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="q2m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3355,6 +3312,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID TPRCP." tprcp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="tprcp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3370,6 +3328,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID F10M." f10m_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="f10m_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3385,6 +3344,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID FFMM." ffmm_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="ffmm_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3400,6 +3360,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID USTAR." ustar_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="ustar_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3415,6 +3376,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SNOW LIQ EQUIV." snow_liq_equiv_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="snow_liq_equiv_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3430,6 +3392,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SNOW DEPTH." snow_depth_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="snow_depth_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3445,6 +3408,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE FRACTION." seaice_fract_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_fract_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3460,6 +3424,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE DEPTH." seaice_depth_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_depth_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3475,6 +3440,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SEA ICE SKIN TEMP." seaice_skin_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="seaice_skin_temp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3490,6 +3456,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SRFLAG." srflag_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="srflag_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3505,6 +3472,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID SKIN TEMPERATURE." skin_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="skin_temp_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3520,6 +3488,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID CANOPY MOISTURE CONTENT." canopy_mc_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="canopy_mc_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3535,6 +3504,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID LEAF AREA INDEX." lai_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="lai_target_grid",& staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3550,6 +3520,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR TARGET GRID Z0." z0_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="z0_target_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3565,6 +3536,7 @@ subroutine create_surface_esmf_fields print*,"- CALL FieldCreate FOR INTERPOLATED TARGET GRID TERRAIN." terrain_from_input_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & + name="terrain_from_input_grid", & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldCreate", rc) @@ -3597,6 +3569,7 @@ subroutine create_surface_esmf_fields soil_temp_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soil_temp_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3614,6 +3587,7 @@ subroutine create_surface_esmf_fields soilm_tot_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soilm_tot_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3631,6 +3605,7 @@ subroutine create_surface_esmf_fields soilm_liq_target_grid = ESMF_FieldCreate(target_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & + name="soilm_liq_target_grid", & ungriddedLBound=(/1/), & ungriddedUBound=(/lsoil_target/), rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3827,105 +3802,129 @@ end subroutine ij_to_i_j !! @param[inout] route Route handle to saved ESMF regridding instructions !! @author Larissa Reames, OU CIMMS/NOAA/NSSL - subroutine regrid_many(fields_pre,fields_post, num_field,route,dozero,doreplace, & + subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, & n_unmap, unmapped_ptr, u, l,resetifd) - use esmf - + use esmf use program_setup, only : convert_nst + use model_grid, only : i_target, j_target implicit none - integer, intent(in) :: num_field + integer, intent(in) :: num_field,n_unmap type(esmf_routehandle), intent(inout) :: route type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post logical, intent(in) :: dozero(num_field), doreplace - logical, intent(in), optional :: resetifd - integer, intent(in), optional :: n_unmap, u, l - type(realptr), intent(inout),optional :: unmapped_ptr(n_unmap) - + logical, intent(in), optional :: resetifd + integer, intent(in), optional :: u, l + integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(n_unmap) type(esmf_field) :: field_pre,field_post real(esmf_kind_r8), pointer :: tmp_ptr(:,:) - real(realptr2d), pointer, allocatable :: 2d_ptr(:) - real(realptr3d), pointer, allocatable :: 3d_ptr(:) + type(realptr_2d),allocatable :: ptr_2d(:) + type(realptr_3d),allocatable :: ptr_3d(:) logical :: is2d(num_field) character(len=50) :: fname - integer :: i, j, k, ij, 2d_cur, 3d_cur, rc, ndims + integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet + type(esmf_vm) :: vm - 2d_cur = 0 - 3d_cur = 0 + ind_2d = 0 + ind_3d = 0 do i = 1, num_field call ESMF_FieldBundleGet(bundle_pre,i,field_pre,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleGet", rc) - - call ESMF_FieldBundleGet(bundle_post,i,field_post,dimCount=ndims,rc=rc) + call error_handler("IN FieldBundleGet", rc) + + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleGet", rc) - + call error_handler("IN FieldBundleGet", rc) + + call ESMF_FieldGet(field_post,dimCount=ndims,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + + call ESMF_VMGetGlobal(vm, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN VMGetGlobal", rc) + call ESMF_VMGet(vm, localPet=localpet, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN VMGet", rc) + if(localpet==0) print*, "in regrid_many fname = ", fname, ndims if (ndims == 2) is2d(i) = .True. if (ndims == 3) is2d(i) = .False. if (dozero(i)) then - call ESMF_FieldRegrid(field_pre, & - field_post, & - routehandle=route, & - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) else - call ESMF_FieldRegrid(field_pre, & - field_post, & - routehandle=route, & - zeroregion=ESMF_REGION_SELECT - termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegrid", rc) + call ESMF_FieldRegrid(field_pre, & + field_post, & + routehandle=route, & + zeroregion=ESMF_REGION_SELECT, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegrid", rc) endif enddo - if (resetifd .and. convert_nst) then + if (present(resetifd) .and. resetifd .and. convert_nst) then call ESMF_FieldGet(ifd_target_grid,farrayPtr=tmp_ptr,rc=rc) - ff(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) tmp_ptr = float(nint(tmp_ptr)) endif - n2d = count(is2d == .True.) - n3d = count(is3d == .False.) - + n2d = count(is2d(:) == .True.) + n3d = count(is2d(:) == .False.) + if(localpet==0) print*, is2d(:) if (doreplace) then - allocate(2d_ptr(n2d)) - if (n3d .ne. 0) allocate(3d_ptr(n3d)) - do i=1, field + allocate(ptr_2d(n2d)) + if (n3d .ne. 0) allocate(ptr_3d(n3d)) + do i=1, num_field if (is2d(i)) then - 2d_cur = 2d_cur + 1 - call ESMF_FieldGet(field_post, & - farrayPtr=2d_ptr(2d_cur)%p, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - else - 3d_cur = 3d_cur + 1 - call ESMF_FieldGet(field_post, & - farrayPtr=3d_ptr(3d_cur)%p, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - endif + ind_2d = ind_2d + 1 + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(field_post, farrayPtr=ptr_2d(ind_2d)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + call ESMF_FieldGet(field_post,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + if (localpet==0) print*, "in doreplace loop, 2d field = ", trim(fname) + else + ind_3d = ind_3d + 1 + call ESMF_FieldBundleGet(bundle_post,i,field_post,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(field_post,name=fname,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + if (localpet==0) print*, "in doreplace loop, 3d field = ", trim(fname) + call ESMF_FieldGet(field_post, farrayPtr=ptr_3d(ind_3d)%p, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + endif end do do ij = l, u call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) do k = 1,n2d - 2d_ptr(i)%p(i,j) = -9999.9 + ptr_2d(k)%p(i,j) = -9999.9 enddo do k = 1,n3d - 3d_ptr(i)%p(i,j,:) = -9999.1 + ptr_3d(k)%p(i,j,:) = -9999.9 enddo enddo + deallocate(ptr_2d) + if(n3d .ne. 0) deallocate(ptr_3d) endif - end subroutine regrid_many !> Execute the search function for multple fields @@ -3942,11 +3941,12 @@ end subroutine regrid_many !! @param[in] (optional) terrain_land A real array size i_target,j_target of terrain height (m) on the target grid !! @param[in] (optional) soilt_climo A real array size i_target,j_target of climatological soil type on the target grid !! @author Larissa Reames, OU CIMMS/NOAA/NSSL - subroutine search_many(num_field,bundle_target,field_data,mask, tile, & - search_nums,localpet,latitude,terrain_land,soilt_climo) + subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & + search_nums,localpet,latitude,terrain_land,soilt_climo,& + field_data_3d) - use model_grid, only : i_target,j_target - use program_setup, only : external_model, input_type, sotyp_from_climo + use model_grid, only : i_target,j_target, lsoil_target + use program_setup, only : external_model, input_type use search_util implicit none @@ -3965,62 +3965,70 @@ subroutine search_many(num_field,bundle_target,field_data,mask, tile, & integer, intent(inout) :: search_nums(num_field) type(esmf_field) :: temp_field + character(len=50) :: fname integer, parameter :: SOTYP_LAND_FIELD_NUM = 224 - integer :: k, rc, ndims + integer :: j,k, rc, ndims do k = 1,num_field - call ESMF_FieldBundleGet(bundle_target,i,temp_field, rc=rc) + call ESMF_FieldBundleGet(bundle_target,k,temp_field, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGet", rc) call ESMF_FieldGet(temp_field, name=fname, dimcount=ndims,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGet", rc) - - if (localpet == 0) then - - if (ndims .eq. 2) then + if (ndims .eq. 2) then + print*, "processing 2d field ", trim(fname) + print*, "FieldGather" call ESMF_FieldGather(temp_field,field_data_2d,rootPet=0,tile=tile, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGather", rc) - - + if (localpet == 0) then if (present(latitude)) then - call search(field_data, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) + print*, "search1" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) elseif (present(terrain_land)) then - call search(field_data, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) + print*, "search2" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then if (fname .eq. "soil_type_target_grid") then - call search(field_data, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo) - elseif (present(soilt_climo) .and. search_nums(k) .eq. SOILT_TARGET_FIELD_NUM) then - if (maxval(field_data) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then + print*, "search3" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo) + elseif (present(soilt_climo)) then + if (maxval(field_data_2d) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then + print*, "search4" ! If soil type from the input grid has any non-zero points then soil type must exist for use - call search(data_one_tile, mask_target_one_tile, i_target, j_target, tile, search_nums(k)) - elseif ! Otherwise, just set the data on the "target" grid to the soil climatology - field_data = soilt_climo + call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k)) + else ! Otherwise, just set the data on the "target" grid to the soil climatology + print*, "search5" + field_data_2d = soilt_climo endif !check field value else - call search(field_data, mask, i_target, j_target, tile,search_nums(k)) + print*, "search6" + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k)) endif !sotype from target grid endif !if present - else + endif !localpet + call ESMF_FieldScatter(temp_field, field_data_2d, rootPet=0, tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + else + print*, "FieldGather" + call ESMF_FieldGather(temp_field,field_data_3d,rootPet=0,tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + print*, "processing 3d field ", trim(fname) + if (localpet==0) then do j = 1, lsoil_target field_data_2d = field_data_3d(:,:,j) call search(field_data_2d, mask, i_target, j_target, tile, 21) - field_data_3d(:,:,j) = field_data_3d + field_data_3d(:,:,j) = field_data_2d enddo - endif !ndims - endif !localpet == 0 - - if (ndims .eq. 2) then - call ESMF_FieldScatter(target_fields(k)%f, field_data_2d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - else - call ESMF_FieldScatter(target_fields(k)%f, field_data_3d, rootPet=0, tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + endif + call ESMF_FieldScatter(temp_field, field_data_3d, rootPet=0, tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) - endif - end do + endif !ndims + end do !fields end subroutine search_many From 8470fbdc16a95bbe38e0255886098746dc19ea76 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Mon, 10 May 2021 19:17:22 +0000 Subject: [PATCH 06/18] All changes utilizing FieldBundle now compile and run without errors and all develop branch system tests pass. --- sorc/chgres_cube.fd/surface.F90 | 60 ++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index f98d1af91..c4dfd7bb8 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -479,10 +479,11 @@ subroutine interp(localpet) call error_handler("IN FieldBundleGet", rc) allocate(dozero(num_fields)) - dozero = (/.True., .True., .True., .True., .True., .True., .True./) + dozero(:) = .True. - call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.,0) + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.) deallocate(dozero) + call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) @@ -908,7 +909,7 @@ subroutine interp(localpet) u = ubound(unmapped_ptr) call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & - .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1) ) + .True.,unmapped_ptr=unmapped_ptr ) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_seaice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -982,7 +983,6 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) - if (convert_nst) then call ESMF_FieldBundleAdd(bundle_water_target, (/c_d_target_grid,c_0_target_grid,d_conv_target_grid, & @@ -1021,9 +1021,8 @@ subroutine interp(localpet) dozero(:) = .True. endif - if(localpet==0) print*, "num unmapped = ", u(1)-l(1) call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & - .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1),resetifd=.True.) + .True., unmapped_ptr=unmapped_ptr, resetifd=.True.) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_water_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1118,15 +1117,14 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleGet", rc) - allocate(search_nums(num_fields)) allocate(dozero(num_fields)) search_nums = (/223,66,65/) dozero=(/.True.,.False.,.False./) - + call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & - .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1)) + .True., unmapped_ptr=unmapped_ptr) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_allland_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1229,7 +1227,7 @@ subroutine interp(localpet) dozero(:) = .False. call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & - .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1) ) + .True., unmapped_ptr=unmapped_ptr ) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_landice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1424,7 +1422,7 @@ subroutine interp(localpet) endif call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, & - .True.,u(1)-l(1), unmapped_ptr=unmapped_ptr, u=u(1), l=l(1)) + .True., unmapped_ptr=unmapped_ptr) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_nolandice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3797,13 +3795,15 @@ end subroutine ij_to_i_j !! !! @param[in] bundle_pre ESMF fieldBundle on input grid !! @param[in] bundle_post ESMF fieldBundle on target grid -!! @param[inout] post_ptrs Length num_field array of ptrs to ESMF target field pointers !! @param[in] num_field Number of fields in target field pointer !! @param[inout] route Route handle to saved ESMF regridding instructions - +!! @param[in] dozero Logical length num_field for whether field should be zeroed out before regridding +!! @param[in] doreplace Logical indicating wehther to set unmapped locations to missing value for searching and replacing later +!! @param[inout] unmapped_ptr (optional) Pointer to unmapped points from FieldRegrid +!! @param[in] resetifd (optional) Logical for whether to reset ifd (only for water where nst data is used) !! @author Larissa Reames, OU CIMMS/NOAA/NSSL subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, & - n_unmap, unmapped_ptr, u, l,resetifd) + unmapped_ptr,resetifd) use esmf use program_setup, only : convert_nst @@ -3811,13 +3811,12 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, implicit none - integer, intent(in) :: num_field,n_unmap + integer, intent(in) :: num_field type(esmf_routehandle), intent(inout) :: route type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post logical, intent(in) :: dozero(num_field), doreplace logical, intent(in), optional :: resetifd - integer, intent(in), optional :: u, l - integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(n_unmap) + integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:) type(esmf_field) :: field_pre,field_post real(esmf_kind_r8), pointer :: tmp_ptr(:,:) @@ -3825,11 +3824,16 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, type(realptr_3d),allocatable :: ptr_3d(:) logical :: is2d(num_field) character(len=50) :: fname - integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet + integer :: i, j, k, ij, ind_2d, ind_3d, rc, ndims,n2d, n3d,localpet, l(1), u(1) type(esmf_vm) :: vm ind_2d = 0 ind_3d = 0 + + if(present(unmapped_ptr)) then + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + endif do i = 1, num_field call ESMF_FieldBundleGet(bundle_pre,i,field_pre,rc=rc) @@ -3913,7 +3917,7 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, endif end do - do ij = l, u + do ij = l(1), u(1) call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) do k = 1,n2d ptr_2d(k)%p(i,j) = -9999.9 @@ -3931,15 +3935,16 @@ end subroutine regrid_many !! !! @param[in] num_field Number of fields to process. !! @param[inout] bundle_target ESMF FieldBundle holding target fields to search -!! @param[inout] field_data A real array of size i_target,j_target to temporarily hold data for searching +!! @param[inout] field_data_2d A real array of size i_target,j_target to temporarily hold data for searching !! @param[inout] mask An integer array of size i_target,j_target that holds masked (0) and unmasked (1) !! values indicating where to execute search (only at unmasked points). !! @param[in] tile Current cubed sphere tile. -!! @param[inout] search_nums Array length num_field holding search field numbers corresponding to each field provided for searching. -!! @param[in] localpet ESMF local persistent execution thread. -!! @param[in] (optional) latitude A real array size i_target,j_target of latitude on the target grid -!! @param[in] (optional) terrain_land A real array size i_target,j_target of terrain height (m) on the target grid -!! @param[in] (optional) soilt_climo A real array size i_target,j_target of climatological soil type on the target grid +!! @param[inout] search_nums Array length num_field holding search field numbers corresponding to each field provided for searching. +!! @param[in] localpet ESMF local persistent execution thread. +!! @param[in] latitude (optional) A real array size i_target,j_target of latitude on the target grid +!! @param[in] terrain_land (optional) A real array size i_target,j_target of terrain height (m) on the target grid +!! @param[in] soilt_climo (optional) A real array size i_target,j_target of climatological soil type on the target grid +!! @param[in] field_data_3d (optional) An empty real array of size i_target,j_target,lsoil_target to temporarily hold soil data for searching !! @author Larissa Reames, OU CIMMS/NOAA/NSSL subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & search_nums,localpet,latitude,terrain_land,soilt_climo,& @@ -4002,10 +4007,9 @@ subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & print*, "search5" field_data_2d = soilt_climo endif !check field value - else - print*, "search6" - call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k)) endif !sotype from target grid + else + call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k)) endif !if present endif !localpet call ESMF_FieldScatter(temp_field, field_data_2d, rootPet=0, tile=tile,rc=rc) From 83a4569031e17ed9d189bf16ff93be794375414e Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Thu, 12 Aug 2021 16:26:04 +0000 Subject: [PATCH 07/18] Big fix for logical indexing. --- sorc/chgres_cube.fd/surface.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 03142f2fc..ecd591ec1 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -3249,8 +3249,8 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, tmp_ptr = float(nint(tmp_ptr)) endif - n2d = count(is2d(:) == .True.) - n3d = count(is2d(:) == .False.) + n2d = count(is2d(:)) + n3d = count(.not.is2d(:)) if(localpet==0) print*, is2d(:) if (doreplace) then allocate(ptr_2d(n2d)) From b5cbc64eab435fb4d9f3a3f2fdaacd81af2dabac Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Thu, 12 Aug 2021 16:51:16 +0000 Subject: [PATCH 08/18] Update doxygen comments for array of pointers. --- sorc/chgres_cube.fd/surface.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index ecd591ec1..e63555a26 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -141,11 +141,14 @@ module surface type realptr_2d real(esmf_kind_r8), pointer :: p(:,:) + !< array of 2d pointers end type realptr_2d - + !< pointer to hold array of 2d pointers type realptr_3d real(esmf_kind_r8), pointer :: p(:,:,:) + !< array of 3d pointers end type realptr_3d + !< pointer to hold array of 3d pointers public :: surface_driver public :: create_nst_esmf_fields From 5d46d729b05eb173400b9d4763d8266bea4e1613 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Fri, 13 Aug 2021 09:57:02 -0500 Subject: [PATCH 09/18] First commit of regrid_many unit tests --- tests/chgres_cube/CMakeLists.txt | 10 +- .../chgres_cube/ftst_surface_regrid_many.F90 | 347 ++++++++++++++++++ 2 files changed, 355 insertions(+), 2 deletions(-) create mode 100644 tests/chgres_cube/ftst_surface_regrid_many.F90 diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index 86db92811..e1a268ac4 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -158,7 +158,13 @@ add_executable(ftst_surface_nst_landfill ftst_surface_nst_landfill.F90) target_link_libraries(ftst_surface_nst_landfill chgres_cube_lib) # Cause test to be run with MPI. -add_mpi_test(chgres_cube-ftst_surface_nst_landfill - EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_nst_landfill +add_mpi_test(chgres_cube-ftst_surface_regrid_many + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many + NUMPROCS 1 + TIMEOUT 60) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_surface_regrid_many + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many NUMPROCS 1 TIMEOUT 60) diff --git a/tests/chgres_cube/ftst_surface_regrid_many.F90 b/tests/chgres_cube/ftst_surface_regrid_many.F90 new file mode 100644 index 000000000..083d4e1ea --- /dev/null +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -0,0 +1,347 @@ + program surface_interp + +! Unit test for surface routine interp that regrids surface +! variables from input to target grid. +! +! Author: Larissa Reames, OU CIMMS/NOAA NSSL + + use esmf + + + use model_grid, only : i_input, j_input, & + input_grid, & + latitude_input_grid, & + longitude_input_grid, & + i_target, j_target, & + target_grid, num_tiles_target_grid, & + latitude_target_grid, & + longitude_target_grid, & + + use static_data, only: soil_type_target_grid, & + veg_type_target_grid, & + + use surface, only : regrid_many + + + implicit none + + integer, parameter :: IPTS_INPUT=4 + integer, parameter :: JPTS_INPUT=3 + integer, parameter :: IPTS_TARGET=8 + integer, parameter :: JPTS_TARGET=5 + + real, parameter :: EPSILON=0.0001 + real(esmf_kind_r8) :: deltalon + + integer :: clb(4), cub(4) + integer :: ierr, localpet, npets, rc + integer :: i, j, k, num_fields + + real(esmf_kind_r8), allocatable :: latitude(:,:), longitude(:,:) + real(esmf_kind_r8), allocatable :: q2m_input(:,:), & + t2m_input(:,:) + real(esmf_kind_r8), allocatable :: q2m_correct(:,:), & + q2m_target(:,:), & + t2m_target(:,:), & + t2m_correct(:,:), & + real(esmf_kind_r8), pointer :: lon_ptr(:,:), & + lat_ptr(:,:) + type(esmf_vm) :: vm + type(esmf_polekind_flag) :: polekindflag(2) + type(esmf_fieldbundle) :: bundle_all_target, bundle_all_input + type(esmf_regridmethod_flag) :: method + type(esmf_routehandle) :: regrid_bl_no_mask + logical, allocatable :: dozero(:) + + print*,"Starting test of surface regrid_many." + + call mpi_init(ierr) + + call ESMF_Initialize(rc=ierr) + + call ESMF_VMGetGlobal(vm, rc=ierr) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + + sotyp_from_climo = .False. + vgtyp_from_climo = .False. + + !--------------------------------------------------------------------! + !----------------- Setup Input Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_input = IPTS_INPUT + j_input = JPTS_INPUT + + polekindflag(1:2) = ESMF_POLEKIND_MONOPOLE + + input_grid = ESMF_GridCreateNoPeriDim(maxIndex=(/i_input,j_input/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_input,j_input)) + allocate(longitude(i_input,j_input)) + + ! This is a random regional grid. I tried a global grid here but it had an unstable + ! solution. + + deltalon = 2.0_esmf_kind_r8 + do i = 1, i_input + longitude(i,:) = 90+real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do j = 1, j_input + latitude(:,j) = 35.0-real((j-1),kind=esmf_kind_r8) * deltalon + end do + + call ESMF_GridAddCoord(input_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + print*,"- CALL GridGetCoord FOR INPUT GRID Y-COORD." + call ESMF_GridGetCoord(input_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) - 360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_latitude", & + rc=rc) + + longitude_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + + call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + nullify(lat_corner_ptr, lon_corner_ptr) + + !Initializes input ESMF fields + t2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_t2m", & + rc=rc) + q2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name=" + input_grid_q2m", & + rc=rc) + !Allocate and fill in the fields on the input grid that we need to create soil type + allocate(t2m_input(i_input,j_input)) + allocate(q2m_input(i_input,j_input)) + + t2m_input = reshape((/290.,292.,294.,296., 291.,293.,295.,297., 292.,294.,296.,298./),(/i_input,j_input/)) + q2m_input = reshape((/6.E-4,7.E-4,8.E-4,9.E-4, 7.E-4,8.E-4,9.E-4,10.E-4, 8.E-4,9.E-4,10.E-4,11.E-4/),(/i_input,j_input/)) + + call ESMF_FieldScatter(t2m_input_grid,t2m_input,rootpet=0,rc=rc) + call ESMF_FieldScatter(q2m_input_grid,q2m_input,rootpet=0,rc=rc) + + deallocate(t2m_input,q2m_input) + + !--------------------------------------------------------------------! + !---------------- Setup Target Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_target = IPTS_TARGET + j_target = JPTS_TARGET + + num_tiles_target_grid = 1 + target_grid = ESMF_GridCreate1PeriDim(maxIndex=(/i_target,j_target/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_target,j_target)) + allocate(longitude(i_target,j_target)) + + ! Regional grid that fits within the input regional grid but with smaller grid cells + deltalon = 0.5 + do i = 1, i_target + longitude(i,:) = 91.1_esmf_kind_r8 + real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do i = 1, j_target + latitude(:,i) = 34.1_esmf_kind_r8 - real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + call ESMF_GridAddCoord(target_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) -360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", & + rc=rc) + + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + + call ESMF_FieldScatter(longitude_target_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_target_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + + ! Create masks on the target grid and the correct (expected) soil type on the target grid + ! to check against what returns from interp + + allocate(t2m_correct(i_target,j_target)) + allocate(q2m_correct(i_target,j_target)) + allocate(t2m_target(i_target,j_target)) + allocate(q2m_target(i_target,j_target)) + + + t2m_correct = reshape((/0., 0., 15.,15.,5., 5., 5., 5., & + 0., 0., 5., 5., 6., 6., 6., 6., & + 0., 0., 5., 5., 6., 6., 6., 6., & + 0., 0., 5., 5., 6., 6., 0., 0., & + 0., 0., 5., 5., 6., 6., 0., 0. /),(/i_target,j_target/)) + q2m_correct = reshape((/0., 0.,16.,16., 4., 4., 4., 4., & + 0., 0., 3., 3., 5., 5., 5., 5., & + 0., 0., 3., 3., 5., 5., 5., 5., & + 0., 0., 3., 3., 5., 5., 0., 0., & + 0., 0., 3., 3., 5., 5., 0., 0. /),(/i_target,j_target/)) + + + method=ESMF_REGRIDMETHOD_BILINEAR + + isrctermprocessing = 1 + + print*,"- CALL FieldRegridStore FOR NON-MASKED BILINEAR INTERPOLATION." + call ESMF_FieldRegridStore(t2m_input_grid, & + t2m_target_grid, & + polemethod=ESMF_POLEMETHOD_ALLAVG, & + srctermprocessing=isrctermprocessing, & + routehandle=regrid_bl_no_mask, & + regridmethod=method, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridStore", rc) + + bundle_all_target = ESMF_FieldBundleCreate(name="all points target", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + bundle_all_input = ESMF_FieldBundleCreate(name="all points input", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + call ESMF_FieldBundleAdd(bundle_all_target, (/t2m_target_grid,q2m_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_all_input, (/t2m_input_grid,q2m_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + call ESMF_FieldBundleGet(bundle_all_target,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(dozero(num_fields)) + dozero(:) = .True. + + !Call the routine to unit test. + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.) + deallocate(dozero) + + call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + call ESMF_FieldBundleDestroy(bundle_all_input,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + + call ESMF_FieldGather(soil_type_target_grid, sotyp_target, rootPet=0, rc=rc) + + print*,"Check results." + + if (any((abs(t2m_target - t2m_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'T2M SHOULD BE:', t2m_correct + print*,'T2M FROM TEST:', t2m_target + stop 2 + endif + + if (any((abs(q2m_target - q2m_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'Q2M SHOULD BE:', q2m_correct + print*,'Q2M FROM TEST:', q2m_target + stop 2 + endif + + + print*,"OK" + +! Deallocate and destroy + deallocate(t2m_target,t2m_correct,q2m_target,q2m_correct) + call ESMF_FieldDestroy(latitude_input_grid,rc=rc) + call ESMF_FieldDestroy(longitude_input_grid,rc=rc) + call ESMF_FieldDestroy(latitude_target_grid,rc=rc) + call ESMF_FieldDestroy(longitude_target_grid,rc=rc) + call ESMF_FieldDestroy(t2m_input_grid,rc=rc) + call ESMF_FieldDestroy(t2m_input_grid,rc=rc) + call ESMF_FieldDestroy(q2m_input_grid,rc=rc) + call ESMF_FieldDestroy(q2m_input_grid,rc=rc) +call ESMF_GridDestroy(input_grid, rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program surface_interp From 8694f77dfba3b5501d801a7f57d24107c64db0f8 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Fri, 13 Aug 2021 16:25:04 +0000 Subject: [PATCH 10/18] Bug fixes for regrid_many unit test. Test compiles and passes on Hera, but expect it to fail the debug test due to used of FieldBundle/FieldRegrid. --- sorc/chgres_cube.fd/surface.F90 | 1 + tests/chgres_cube/CMakeLists.txt | 37 +----- .../chgres_cube/ftst_surface_regrid_many.F90 | 108 +++++++++++++----- 3 files changed, 84 insertions(+), 62 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index e63555a26..5d70c8e5e 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -157,6 +157,7 @@ module surface public :: cleanup_target_sfc_data public :: nst_land_fill public :: cleanup_target_nst_data + public :: regrid_many contains diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index e1a268ac4..be953f333 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -33,8 +33,6 @@ execute_process( COMMAND ${CMAKE_COMMAND} -E copy # This one does not end up in the data directory. execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/config_gaussian_nemsio.nml ${CMAKE_CURRENT_BINARY_DIR}/fort.41) -execute_process( COMMAND ${CMAKE_COMMAND} -E copy - ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) add_executable(ftst_utils ftst_utils.F90) add_test(NAME chgres_cube-ftst_utils COMMAND ftst_utils) @@ -90,25 +88,6 @@ add_mpi_test(chgres_cube-ftst_convert_winds NUMPROCS 3 TIMEOUT 60) -add_executable(ftst_read_sfc_gfs_nemsio ftst_read_sfc_gfs_nemsio.F90) -target_link_libraries(ftst_read_sfc_gfs_nemsio chgres_cube_lib) - -# Cause test to be run with MPI. -add_mpi_test(chgres_cube-ftst_read_sfc_gfs_nemsio - EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_sfc_gfs_nemsio - NUMPROCS 1 - TIMEOUT 60) - -# Comment out this unit test until ESMF memory leaks are solved -# add_executable(ftst_surface_interp ftst_surface_interp.F90) -# target_link_libraries(ftst_surface_interp chgres_cube_lib) - -# Cause test to be run with MPI. -# add_mpi_test(chgres_cube-ftst_surface_interp -# EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp -# NUMPROCS 1 -# TIMEOUT 60) - add_executable(ftst_read_sfc_nemsio ftst_read_sfc_nemsio.F90) target_link_libraries(ftst_read_sfc_nemsio chgres_cube_lib) @@ -136,15 +115,6 @@ add_mpi_test(chgres_cube-ftst_read_nst_netcdf NUMPROCS 1 TIMEOUT 60) -add_executable(ftst_read_nst_nemsio ftst_read_nst_nemsio.F90) -target_link_libraries(ftst_read_nst_nemsio chgres_cube_lib) - -# Cause test to be run with MPI. -add_mpi_test(chgres_cube-ftst_read_nst_nemsio - EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_nst_nemsio - NUMPROCS 1 - TIMEOUT 60) - add_executable(ftst_read_atm_gaussian_netcdf ftst_read_atm_gaussian_netcdf.F90) target_link_libraries(ftst_read_atm_gaussian_netcdf chgres_cube_lib) @@ -158,11 +128,14 @@ add_executable(ftst_surface_nst_landfill ftst_surface_nst_landfill.F90) target_link_libraries(ftst_surface_nst_landfill chgres_cube_lib) # Cause test to be run with MPI. -add_mpi_test(chgres_cube-ftst_surface_regrid_many - EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many +add_mpi_test(chgres_cube-ftst_surface_nst_landfill + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_nst_landfill NUMPROCS 1 TIMEOUT 60) +add_executable(ftst_surface_regrid_many ftst_surface_regrid_many.F90) +target_link_libraries(ftst_surface_regrid_many chgres_cube_lib) + # Cause test to be run with MPI. add_mpi_test(chgres_cube-ftst_surface_regrid_many EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many diff --git a/tests/chgres_cube/ftst_surface_regrid_many.F90 b/tests/chgres_cube/ftst_surface_regrid_many.F90 index 083d4e1ea..903f40f8b 100644 --- a/tests/chgres_cube/ftst_surface_regrid_many.F90 +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -15,12 +15,14 @@ program surface_interp i_target, j_target, & target_grid, num_tiles_target_grid, & latitude_target_grid, & - longitude_target_grid, & + longitude_target_grid - use static_data, only: soil_type_target_grid, & - veg_type_target_grid, & + use input_data, only: t2m_input_grid, & + q2m_input_grid - use surface, only : regrid_many + use surface, only : regrid_many, & + t2m_target_grid, & + q2m_target_grid implicit none @@ -36,6 +38,7 @@ program surface_interp integer :: clb(4), cub(4) integer :: ierr, localpet, npets, rc integer :: i, j, k, num_fields + integer :: isrctermprocessing real(esmf_kind_r8), allocatable :: latitude(:,:), longitude(:,:) real(esmf_kind_r8), allocatable :: q2m_input(:,:), & @@ -43,7 +46,7 @@ program surface_interp real(esmf_kind_r8), allocatable :: q2m_correct(:,:), & q2m_target(:,:), & t2m_target(:,:), & - t2m_correct(:,:), & + t2m_correct(:,:) real(esmf_kind_r8), pointer :: lon_ptr(:,:), & lat_ptr(:,:) type(esmf_vm) :: vm @@ -63,9 +66,6 @@ program surface_interp call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) - sotyp_from_climo = .False. - vgtyp_from_climo = .False. - !--------------------------------------------------------------------! !----------------- Setup Input Grid & Coordinates -------------------! !--------------------------------------------------------------------! @@ -130,30 +130,34 @@ program surface_interp staggerloc=ESMF_STAGGERLOC_CENTER, & name="input_grid_latitude", & rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) longitude_input_grid = ESMF_FieldCreate(input_grid, & typekind=ESMF_TYPEKIND_R8, & staggerloc=ESMF_STAGGERLOC_CENTER, & name="input_grid_longitude", & rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) call ESMF_FieldScatter(longitude_input_grid, longitude, rootpet=0, rc=rc) call ESMF_FieldScatter(latitude_input_grid, latitude, rootpet=0, rc=rc) deallocate(latitude, longitude) - nullify(lat_corner_ptr, lon_corner_ptr) !Initializes input ESMF fields t2m_input_grid = ESMF_FieldCreate(input_grid, & typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - name="input_grid_t2m", & - rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + q2m_input_grid = ESMF_FieldCreate(input_grid, & typekind=ESMF_TYPEKIND_R8, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - name=" - input_grid_q2m", & - rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + !Allocate and fill in the fields on the input grid that we need to create soil type allocate(t2m_input(i_input,j_input)) allocate(q2m_input(i_input,j_input)) @@ -237,6 +241,21 @@ program surface_interp call ESMF_FieldScatter(latitude_target_grid, latitude, rootpet=0, rc=rc) deallocate(latitude, longitude) + ! Create target t2m and q2m fields + t2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="t2m_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + q2m_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="q2m_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + ! Create masks on the target grid and the correct (expected) soil type on the target grid ! to check against what returns from interp @@ -246,19 +265,47 @@ program surface_interp allocate(q2m_target(i_target,j_target)) - t2m_correct = reshape((/0., 0., 15.,15.,5., 5., 5., 5., & - 0., 0., 5., 5., 6., 6., 6., 6., & - 0., 0., 5., 5., 6., 6., 6., 6., & - 0., 0., 5., 5., 6., 6., 0., 0., & - 0., 0., 5., 5., 6., 6., 0., 0. /),(/i_target,j_target/)) - q2m_correct = reshape((/0., 0.,16.,16., 4., 4., 4., 4., & - 0., 0., 3., 3., 5., 5., 5., 5., & - 0., 0., 3., 3., 5., 5., 5., 5., & - 0., 0., 3., 3., 5., 5., 0., 0., & - 0., 0., 3., 3., 5., 5., 0., 0. /),(/i_target,j_target/)) - - - method=ESMF_REGRIDMETHOD_BILINEAR + !t2m_correct = reshape((/0., 0., 15.,15.,5., 5., 5., 5., & + ! 0., 0., 5., 5., 6., 6., 6., 6., & + ! 0., 0., 5., 5., 6., 6., 6., 6., & + ! 0., 0., 5., 5., 6., 6., 0., 0., & + ! 0., 0., 5., 5., 6., 6., 0., 0. /),(/i_target,j_target/)) + t2m_correct = reshape((/ 292.000000000000, 292.000000000000,& + 292.000000000000, 292.000000000000, 294.000000000000,& + 294.000000000000, 294.000000000000, 294.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000, 293.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 295.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 293.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000, 295.000000000000,& + 293.000000000000, 293.000000000000, 293.000000000000,& + 293.000000000000, 295.000000000000, 295.000000000000,& + 295.000000000000, 295.000000000000/),(/i_target,j_target/)) + !q2m_correct = reshape((/0., 0.,16.,16., 4., 4., 4., 4., & + ! 0., 0., 3., 3., 5., 5., 5., 5., & + ! 0., 0., 3., 3., 5., 5., 5., 5., & + ! 0., 0., 3., 3., 5., 5., 0., 0., & + ! 0., 0., 3., 3., 5., 5., 0., 0. /),(/i_target,j_target/)) + q2m_correct = reshape((/ 7.000000000000000E-004, 7.000000000000000E-004,& + 7.000000000000000E-004, 7.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 8.000000000000000E-004, 8.000000000000000E-004, 8.000000000000000E-004,& + 8.000000000000000E-004, 9.000000000000000E-004, 9.000000000000000E-004,& + 9.000000000000000E-004, 9.000000000000000E-004/),(/i_target,j_target/)) + + + method=ESMF_REGRIDMETHOD_NEAREST_STOD isrctermprocessing = 1 @@ -304,7 +351,8 @@ program surface_interp if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleDestroy", rc) - call ESMF_FieldGather(soil_type_target_grid, sotyp_target, rootPet=0, rc=rc) + call ESMF_FieldGather(t2m_target_grid, t2m_target, rootPet=0, rc=rc) + call ESMF_FieldGather(q2m_target_grid, q2m_target, rootPet=0, rc=rc) print*,"Check results." From 181ee2563acf44992b2bb3877e53017cce9ac42e Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Fri, 13 Aug 2021 17:39:22 +0000 Subject: [PATCH 11/18] Fix for CMake file --- tests/chgres_cube/CMakeLists.txt | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index be953f333..01f3cb673 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -33,6 +33,8 @@ execute_process( COMMAND ${CMAKE_COMMAND} -E copy # This one does not end up in the data directory. execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/config_gaussian_nemsio.nml ${CMAKE_CURRENT_BINARY_DIR}/fort.41) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/LSanSuppress.supp ${CMAKE_CURRENT_BINARY_DIR}/LSanSuppress.supp) add_executable(ftst_utils ftst_utils.F90) add_test(NAME chgres_cube-ftst_utils COMMAND ftst_utils) @@ -88,6 +90,25 @@ add_mpi_test(chgres_cube-ftst_convert_winds NUMPROCS 3 TIMEOUT 60) +add_executable(ftst_read_sfc_gfs_nemsio ftst_read_sfc_gfs_nemsio.F90) +target_link_libraries(ftst_read_sfc_gfs_nemsio chgres_cube_lib) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_read_sfc_gfs_nemsio + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_sfc_gfs_nemsio + NUMPROCS 1 + TIMEOUT 60) + +# Comment out this unit test until ESMF memory leaks are solved +# add_executable(ftst_surface_interp ftst_surface_interp.F90) +# target_link_libraries(ftst_surface_interp chgres_cube_lib) + +# Cause test to be run with MPI. +# add_mpi_test(chgres_cube-ftst_surface_interp +# EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp +# NUMPROCS 1 +# TIMEOUT 60) + add_executable(ftst_read_sfc_nemsio ftst_read_sfc_nemsio.F90) target_link_libraries(ftst_read_sfc_nemsio chgres_cube_lib) @@ -115,6 +136,15 @@ add_mpi_test(chgres_cube-ftst_read_nst_netcdf NUMPROCS 1 TIMEOUT 60) +add_executable(ftst_read_nst_nemsio ftst_read_nst_nemsio.F90) +target_link_libraries(ftst_read_nst_nemsio chgres_cube_lib) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_read_nst_nemsio + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_read_nst_nemsio + NUMPROCS 1 + TIMEOUT 60) + add_executable(ftst_read_atm_gaussian_netcdf ftst_read_atm_gaussian_netcdf.F90) target_link_libraries(ftst_read_atm_gaussian_netcdf chgres_cube_lib) From 46b4fbfe3c6e3a8223640fe7c802f4c6e54046b5 Mon Sep 17 00:00:00 2001 From: Larissa Reames Date: Fri, 13 Aug 2021 16:22:08 -0500 Subject: [PATCH 12/18] Attempt to fix soil_type regrid bundle failure --- sorc/chgres_cube.fd/surface.F90 | 64 ++++++++++++++++++++++++++------- 1 file changed, 51 insertions(+), 13 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 5d70c8e5e..06fdbf7cd 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -404,6 +404,7 @@ subroutine interp(localpet) real(esmf_kind_r8), pointer :: srflag_target_ptr(:,:) real(esmf_kind_r8), pointer :: terrain_from_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_target_ptr(:,:) + real(esmf_kind_r8), pointer :: soil_type_target_ptr(:,:) real(esmf_kind_r8), pointer :: landmask_input_ptr(:,:) real(esmf_kind_r8), pointer :: veg_type_input_ptr(:,:) real(esmf_kind_r8), allocatable :: veg_type_target_one_tile(:,:) @@ -1322,16 +1323,37 @@ subroutine interp(localpet) if (.not. sotyp_from_climo) then - call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_input_grid/), rc=rc) +! call ESMF_FieldBundleAdd(bundle_nolandice_target, (/soil_type_target_grid/), rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldBundleAdd", rc) +! call ESMF_FieldBundleAdd(bundle_nolandice_input, (/soil_type_input_grid/), rc=rc) +! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & +! call error_handler("IN FieldBundleAdd", rc) + print*,"- CALL Field_Regrid ." + call ESMF_FieldRegrid(soil_type_input_grid, & + soil_type_target_grid, & + routehandle=regrid_land, & + zeroregion=ESMF_REGION_SELECT, & + termorderflag=ESMF_TERMORDER_SRCSEQ, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleAdd", rc) - call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + call error_handler("IN FieldRegrid", rc) + + call ESMF_FieldGet(soil_type_target_grid, & + farrayPtr=soil_type_target_ptr, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldBundleGet", rc) - sotyp_ind = num_fields + call error_handler("IN FieldGet", rc) + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) + + do ij = l(1), u(1) + call ij_to_i_j(unmapped_ptr(ij), i_target, j_target, i, j) + soil_type_target_ptr(i,j) = -9999.9 + enddo + ! call ESMF_FieldBundleGet(bundle_nolandice_target,fieldCount=num_fields,rc=rc) + ! if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + ! call error_handler("IN FieldBundleGet", rc) + ! sotyp_ind = 3 endif if (.not. vgfrc_from_climo) then @@ -1392,10 +1414,10 @@ subroutine interp(localpet) search_nums(1:5) = (/85,7,224,85,86/) dozero(1:5) = (/.False.,.False.,.True.,.True.,.False./) - if (.not.sotyp_from_climo) then - search_nums(sotyp_ind) = 226 - dozero(sotyp_ind) = .False. - endif + !if (.not.sotyp_from_climo) then + ! search_nums(sotyp_ind) = 226 + ! dozero(sotyp_ind) = .False. + !endif if (.not. vgfrc_from_climo) then search_nums(vgfrc_ind) = 224 @@ -1476,6 +1498,22 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldScatter", rc) endif + + if (.not. sotyp_from_climo) then + print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile + call ESMF_FieldGather(soil_type_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + if (localpet == 0) then + call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,226) + endif + + print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile + call ESMF_FieldScatter(soil_type_target_grid,data_one_tile,rootPet=0,tile=tile,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + endif enddo @@ -3476,4 +3514,4 @@ subroutine cleanup_target_nst_data end subroutine cleanup_target_nst_data - end module surface + end module surface \ No newline at end of file From 053d3812d1aae163b6cddd21c1d81484a8bc3bd8 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Fri, 20 Aug 2021 18:21:30 +0000 Subject: [PATCH 13/18] Added unit test for search_many --- sorc/chgres_cube.fd/surface.F90 | 53 +- tests/chgres_cube/CMakeLists.txt | 21 +- .../chgres_cube/ftst_surface_search_many.F90 | 523 ++++++++++++++++++ 3 files changed, 566 insertions(+), 31 deletions(-) create mode 100644 tests/chgres_cube/ftst_surface_search_many.F90 diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 06fdbf7cd..e860aef41 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -158,6 +158,7 @@ module surface public :: nst_land_fill public :: cleanup_target_nst_data public :: regrid_many + public :: search_many contains @@ -1193,8 +1194,20 @@ subroutine interp(localpet) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) call ESMF_FieldBundleAdd(bundle_landice_input, (/skin_temp_input_grid, terrain_input_grid,& - soil_temp_input_grid/), rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + soil_temp_input_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + if (.not. sotyp_from_climo) then + call ESMF_FieldBundleAdd(bundle_landice_input, (/soil_type_input_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + call ESMF_FieldBundleAdd(bundle_landice_target,(/soil_type_target_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + endif + + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldBundleAdd", rc) call ESMF_FieldBundleGet(bundle_landice_target,fieldCount=num_fields,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1202,9 +1215,14 @@ subroutine interp(localpet) allocate(search_nums(num_fields)) allocate(dozero(num_fields)) - - search_nums = (/21,7/) - dozero(:) = .False. + + if (sotyp_from_climo) then + search_nums = (/21,7/) + dozero(:)=.False. + else + search_nums = (/21,7,231/) + dozero(:)=(/.False.,.False.,.True./) + endif call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & .True., unmapped_ptr=unmapped_ptr ) @@ -1241,23 +1259,6 @@ subroutine interp(localpet) call search_many(num_fields,bundle_landice_target,data_one_tile, land_target_one_tile,& tile,search_nums,localpet,terrain_land=data_one_tile2,field_data_3d=data_one_tile_3d) - - if (.not. sotyp_from_climo) then - print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID LAND, TILE: ",tile - call ESMF_FieldGather(soil_type_target_grid, data_one_tile,rootPet=0,tile=tile, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldGather", rc) - - if (localpet == 0) then - call search(data_one_tile, mask_target_one_tile, i_target, j_target,tile,231) - endif - - print*,"- CALL FieldScatter FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldScatter(soil_type_target_grid,data_one_tile,rootPet=0,tile=tile,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& - call error_handler("IN FieldScatter", rc) - endif - enddo deallocate (veg_type_target_one_tile) @@ -3380,6 +3381,8 @@ subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & type(esmf_field) :: temp_field character(len=50) :: fname integer, parameter :: SOTYP_LAND_FIELD_NUM = 224 + integer, parameter :: SST_FIELD_NUM = 11 + integer, parameter :: TERRAIN_FIELD_NUM= 7 integer :: j,k, rc, ndims do k = 1,num_field @@ -3396,10 +3399,10 @@ subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldGather", rc) if (localpet == 0) then - if (present(latitude)) then + if (present(latitude) .and. search_nums(k).eq.SST_FIELD_NUM) then print*, "search1" call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) - elseif (present(terrain_land)) then + elseif (present(terrain_land) .and. search_nums(k) .eq. TERRAIN_FIELD_NUM) then print*, "search2" call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then @@ -3514,4 +3517,4 @@ subroutine cleanup_target_nst_data end subroutine cleanup_target_nst_data - end module surface \ No newline at end of file + end module surface diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index 01f3cb673..d33cfaf8a 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -100,14 +100,14 @@ add_mpi_test(chgres_cube-ftst_read_sfc_gfs_nemsio TIMEOUT 60) # Comment out this unit test until ESMF memory leaks are solved -# add_executable(ftst_surface_interp ftst_surface_interp.F90) -# target_link_libraries(ftst_surface_interp chgres_cube_lib) + add_executable(ftst_surface_interp ftst_surface_interp.F90) + target_link_libraries(ftst_surface_interp chgres_cube_lib) # Cause test to be run with MPI. -# add_mpi_test(chgres_cube-ftst_surface_interp -# EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp -# NUMPROCS 1 -# TIMEOUT 60) + add_mpi_test(chgres_cube-ftst_surface_interp + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp + NUMPROCS 1 + TIMEOUT 60) add_executable(ftst_read_sfc_nemsio ftst_read_sfc_nemsio.F90) target_link_libraries(ftst_read_sfc_nemsio chgres_cube_lib) @@ -171,3 +171,12 @@ add_mpi_test(chgres_cube-ftst_surface_regrid_many EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_regrid_many NUMPROCS 1 TIMEOUT 60) + +add_executable(ftst_surface_search_many ftst_surface_search_many.F90) +target_link_libraries(ftst_surface_search_many chgres_cube_lib) + +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_surface_search_many + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_search_many + NUMPROCS 1 + TIMEOUT 60) diff --git a/tests/chgres_cube/ftst_surface_search_many.F90 b/tests/chgres_cube/ftst_surface_search_many.F90 new file mode 100644 index 000000000..ec627d6e8 --- /dev/null +++ b/tests/chgres_cube/ftst_surface_search_many.F90 @@ -0,0 +1,523 @@ + program surface_interp + +! Unit test for surface routine interp that regrids surface +! variables from input to target grid. +! +! Author: Larissa Reames, OU CIMMS/NOAA NSSL + + use esmf + + use model_grid, only : i_target, j_target, & + target_grid, num_tiles_target_grid, & + latitude_target_grid, & + longitude_target_grid, & + lsoil_target + + use program_setup, only : external_model, input_type + + use surface, only : search_many + + implicit none + + integer, parameter :: IPTS_TARGET=3 + integer, parameter :: JPTS_TARGET=3 + + real, parameter :: EPSILON=0.0001 + real(esmf_kind_r8) :: deltalon + + integer :: clb(4), cub(4) + integer :: ierr, localpet, npets, rc + integer :: i, j, k, num_fields + integer :: isrctermprocessing + + integer(esmf_kind_i8),allocatable :: mask_target_search(:,:), & + mask_default(:,:) + integer, allocatable :: field_nums(:) + real(esmf_kind_r8), allocatable :: latitude(:,:), longitude(:,:) + real(esmf_kind_r8), allocatable :: field1_search(:,:), & + field2_search(:,:), & + field1_default(:,:), & + latitude_default(:,:), & + terrain_land(:,:), & + soilt_climo(:,:), & + soil_temp_search(:,:,:) + real(esmf_kind_r8), allocatable :: field1_search_correct(:,:), & + field2_search_correct(:,:), & + field_default_correct(:,:), & + soil_temp_correct(:,:) + real(esmf_kind_r8), allocatable :: dummy_2d(:,:), & + dummy_3d(:,:,:) + real(esmf_kind_r8), pointer :: lon_ptr(:,:), & + lat_ptr(:,:) + + character(len=50) :: fname + + type(esmf_vm) :: vm + type(esmf_field) :: field1_target_grid, & + field2_target_grid, & + field3_target_grid, & + field4_target_grid, & + field_3d_target_grid, & + temp_field + type(esmf_fieldbundle) :: bundle_search1, & + bundle_search2, & + bundle_default1, & + bundle_default2, & + bundle_3d_search + + print*,"Starting test of surface regrid_many." + + call mpi_init(ierr) + + call ESMF_Initialize(rc=ierr) + + call ESMF_VMGetGlobal(vm, rc=ierr) + + call ESMF_VMGet(vm, localPet=localpet, petCount=npets, rc=ierr) + + !--------------------------------------------------------------------! + !---------------- Setup Target Grid & Coordinates -------------------! + !--------------------------------------------------------------------! + + i_target = IPTS_TARGET + j_target = JPTS_TARGET + lsoil_target = 2 + + num_tiles_target_grid = 1 + target_grid = ESMF_GridCreate1PeriDim(maxIndex=(/i_target,j_target/), & + indexflag=ESMF_INDEX_GLOBAL, rc=rc) + + allocate(latitude(i_target,j_target)) + allocate(longitude(i_target,j_target)) + + ! Regional grid + deltalon = 0.5 + do i = 1, i_target + longitude(i,:) = 91.1_esmf_kind_r8 + real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + do i = 1, j_target + latitude(:,i) = 34.1_esmf_kind_r8 - real((i-1),kind=esmf_kind_r8) * deltalon + enddo + + call ESMF_GridAddCoord(target_grid, & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridAddCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=1, & + farrayPtr=lon_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + call ESMF_GridGetCoord(target_grid, & + staggerLoc=ESMF_STAGGERLOC_CENTER, & + coordDim=2, & + computationalLBound=clb, & + computationalUBound=cub, & + farrayPtr=lat_ptr, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN GridGetCoord", rc) + + do j = clb(2), cub(2) + do i = clb(1), cub(1) + lon_ptr(i,j) = longitude(i,j) + if (lon_ptr(i,j) > 360.0_esmf_kind_r8) lon_ptr(i,j) = lon_ptr(i,j) -360.0_esmf_kind_r8 + lat_ptr(i,j) = latitude(i,j) + enddo + enddo + nullify(lat_ptr,lon_ptr) + + + latitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="target_grid_latitude", & + rc=rc) + + longitude_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="input_grid_longitude", & + rc=rc) + + call ESMF_FieldScatter(longitude_target_grid, longitude, rootpet=0, rc=rc) + call ESMF_FieldScatter(latitude_target_grid, latitude, rootpet=0, rc=rc) + deallocate(latitude, longitude) + + ! Create target fields + field1_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field1_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field2_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field2_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field3_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="soil_type_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field4_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + name="field4_target_grid", & + staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldCreate", rc) + + field_3d_target_grid = ESMF_FieldCreate(target_grid, & + typekind=ESMF_TYPEKIND_R8, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + name="field_3d_target_grid", & + ungriddedLBound=(/1/), & + ungriddedUBound=(/lsoil_target/), rc=rc) + + ! Allocate space for arrays + allocate(field1_search_correct(i_target,j_target)) + allocate(field2_search_correct(i_target,j_target)) + allocate(field1_search(i_target,j_target)) + allocate(field2_search(i_target,j_target)) + allocate(mask_target_search(i_target,j_target)) + + allocate(field1_default(i_target,j_target)) + allocate(field_default_correct(i_target,j_target)) + allocate(mask_default(i_target,j_target)) + allocate(latitude_default(i_target,j_target)) + allocate(dummy_2d(i_target,j_target)) + + allocate(terrain_land(i_target,j_target)) + allocate(soilt_climo(i_target,j_target)) + + allocate(soil_temp_search(i_target,j_target,lsoil_target)) + allocate(soil_temp_correct(i_target,j_target)) + allocate(dummy_3d(i_target,j_target,lsoil_target)) + + ! Field values for default replacement tests + field1_default = reshape((/0., 0., 0., 0., -9999.9, 0., 0., 0.,0./),(/i_target,j_target/)) + mask_default = reshape((/0, 0, 0, 0, 1, 0, 0, 0, 0/),(/i_target,j_target/)) + latitude_default = reshape((/-30.0, -30.0, -30.0, 0., 75., 0., 25.0, 25.0,25.0/),(/i_target,j_target/)) + + + ! Field values to check basic search option tests + field1_search=reshape((/-9999.9, 0., 0., 0., .88, 0., 0., 0.,.1/),(/i_target,j_target/)) + field1_search_correct=reshape((/.88, 0., 0., 0., .88, 0., 0.,0.,.1/),(/i_target,j_target/)) + field2_search=reshape((/3., 0., 0., 0., 2., 0., 0., 0., -9999.9/),(/i_target,j_target/)) + field2_search_correct=reshape((/3., 0., 0., 0., 2., 0., 0., 0.,2./),(/i_target,j_target/)) + mask_target_search=reshape((/1, 0, 0, 0, 1, 0, 0, 0, 1/),(/i_target,j_target/)) + soil_temp_search(:,:,1) = reshape((/-9999.9, 0., 0., 0., 280., 0., 0.,0.,290./),(/i_target,j_target/)) + soil_temp_search(:,:,2) = reshape((/-9999.9, 0., 0., 0., 280., 0.,0.,0.,290./),(/i_target,j_target/)) + soil_temp_correct(:,:) = reshape((/280., 0., 0., 0., 280.,0.,0.,0.,290./),(/i_target,j_target/)) + ! Default terrain values to check default terrain replacement + terrain_land = reshape((/0., 0., 0., 0., 75.0, 0., 0., 0.,0./),(/i_target,j_target/)) + + ! Climatology soil type values to check soil type replacement + soilt_climo = reshape((/0., 0., 0., 0., 2., 0., 0., 0.,0./),(/i_target,j_target/)) + + ! Create field bundles and assign fields to them + bundle_default1 = ESMF_FieldBundleCreate(name="fields_default1", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleCreate", rc) + + ! will search sst, terrain height, soil_type_target_grid + call ESMF_FieldBundleAdd(bundle_default1, (/field1_target_grid,field2_target_grid, & + field3_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleAdd", rc) + + bundle_default2 = ESMF_FieldBundleCreate(name="fields_default2", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search GFS grib2 soil type + call ESMF_FieldBundleAdd(bundle_default2,(/field1_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_3d_search = ESMF_FieldBundleCreate(name="fields_search_3d", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search soil temperature + call ESMF_FieldBundleAdd(bundle_3d_search,(/field_3d_target_grid/), rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_search1 = ESMF_FieldBundleCreate(name="fields_search1", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search veg greeness and restart soil type + call ESMF_FieldBundleAdd(bundle_search1,(/field1_target_grid,field2_target_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + + bundle_search2 = ESMF_FieldBundleCreate(name="fields_search2", rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleCreate", rc) + + ! will search hrrr grib2 non-target-grid soil type + call ESMF_FieldBundleAdd(bundle_search2,(/field1_target_grid/),rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleAdd", rc) + +!------------------------------------------------------------------------------------- +! SEARCH TEST CHECKS REPLACEMENT OF VEG FRACTION AND RESTART FILE SOIL TYPE +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for search test + call ESMF_FieldScatter(field1_target_grid, field1_search, rootPet=0,tile=1, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field2_target_grid, field2_search, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_search1,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/226,224/) + input_type="restart" + + !Call the search many routine to test search and replace + call search_many(num_fields,bundle_search1,dummy_2d,mask_target_search,1,field_nums,localpet, & + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_search1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + call ESMF_FieldGather(field1_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field1_search." + + if (any((abs(dummy_2d - field1_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field1_search SHOULD BE:', field1_search_correct + print*,'field1_search FROM TEST:', dummy_2d + stop 2 + endif + call ESMF_FieldGather(field2_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field2_search." + if (any((abs(dummy_2d - field2_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field2_search SHOULD BE:', field2_search_correct + print*,'field2_search FROM TEST:', dummy_2d + stop 2 + endif + +!------------------------------------------------------------------------------------- +! SEARCH TEST CHECKS REPLACEMENT OF HRRR GRIB2 SOIL NO TYPE TARGET GRID +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for search test + call ESMF_FieldScatter(field1_target_grid, field2_search, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_search2,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/224/) + input_type="grib2" + external_model="HRRR" + + !Call the search many routine to test search and replace + call search_many(num_fields,bundle_search2,dummy_2d,mask_target_search,1,field_nums,localpet, & + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_search2,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + call ESMF_FieldGather(field1_target_grid, dummy_2d, rootPet=0, rc=rc) + + print*,"Check results for field2_search." + + if (any((abs(dummy_2d - field2_search_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field2_search SHOULD BE:', field2_search_correct + print*,'field2_search FROM TEST:', dummy_2d + stop 2 + endif + +!------------------------------------------------------------------------------------- +! DEFAULT TEST 1 CHECKS DEFAULT/CLIMO SST,TERRAIN,SOILTYPE REPLACEMENT +!------------------------------------------------------------------------------------- + + ! Fill esmf fields for default1 test + call ESMF_FieldScatter(field1_target_grid, field1_default, rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field2_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldScatter(field3_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_default1,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums = (/11,7,224/) + !Call the search many routine to test some branches of default behavior + call search_many(num_fields,bundle_default1,dummy_2d,mask_default,1,field_nums,localpet, & + latitude=latitude_default,terrain_land=terrain_land,soilt_climo=soilt_climo) + + print*,"Check results for bundle_default1." + + do i = 1,num_fields + call ESMF_FieldBundleGet(bundle_default1,i,temp_field,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + call ESMF_FieldGet(temp_field, name=fname, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGet", rc) + print*, "Check ", trim(fname) + call ESMF_FieldGather(temp_field,dummy_2d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + field_default_correct = field1_default + if (i .eq. 1) then + field_default_correct(2,2) = 273.16 + elseif (i .eq. 2) then + field_default_correct(2,2) = terrain_land(2,2) + else + field_default_correct(2,2) = soilt_climo(2,2) + endif + + if (any((abs(dummy_2d - field_default_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,trim(fname), ' SHOULD BE:', field_default_correct + print*,trim(fname), ' FROM TEST:', dummy_2d + stop 2 + endif + enddo + call ESMF_FieldBundleDestroy(bundle_default1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + +!--------------------------------------------- +! DEFAULT TEST 2 TESTS GFS GRIB2 SOIL TYPE +!--------------------------------------------- + ! Fill esmf fields for default2 test + call ESMF_FieldScatter(field1_target_grid, field1_default,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_default2,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums(:) = (/224/) + + input_type="grib2" + external_model="GFS" + !Call the search many routine to test behavior for GFS grib2 soil type + call search_many(num_fields,bundle_default2,dummy_2d,mask_default,1,field_nums,localpet,& + soilt_climo=soilt_climo) + + call ESMF_FieldBundleDestroy(bundle_default2,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + print*,"Check results for bundle_default2." + + call ESMF_FieldGather(field1_target_grid,dummy_2d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + + if (any((abs(dummy_2d - soilt_climo)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field1_target SHOULD BE:', soilt_climo + print*,'field1_target FROM TEST:', dummy_2d + stop 2 + endif + +!-------------------------------------------------------- +! 3D TEST TESTS REPLACEMENT FOR SOIL TEMPERATURE +!-------------------------------------------------------! +! Fill esmf fields for default2 test + call ESMF_FieldScatter(field_3d_target_grid,soil_temp_search,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldScatter", rc) + + call ESMF_FieldBundleGet(bundle_3d_search,fieldCount=num_fields,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleGet", rc) + + allocate(field_nums(num_fields)) + field_nums(:) = (/21/) + + !Call the search many routine to test behavior for GFS grib2 soil type + call search_many(num_fields,bundle_3d_search,dummy_2d,mask_target_search,1,field_nums,localpet,& + field_data_3d=dummy_3d) + + call ESMF_FieldBundleDestroy(bundle_3d_search,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldBundleDestroy", rc) + deallocate(field_nums) + + print*,"Check results for bundle_3d_search." + + call ESMF_FieldGather(field_3d_target_grid,dummy_3d,rootPet=0,tile=1,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& + call error_handler("IN FieldGather", rc) + do i = 1,lsoil_target + if (any((abs(dummy_3d(:,:,i) - soil_temp_correct)) > EPSILON)) then + print*,'TEST FAILED ' + print*,'field_3d_target SHOULD BE:', soil_temp_correct + print*,'field_3d_target at level ',i,' FROM TEST:', dummy_3d(:,:,i) + stop 2 + endif + enddo + + print*,"Tests Passed!" + +! Deallocate and destroy + deallocate(field1_search_correct,field2_search_correct,field1_search,field2_search,mask_target_search) + deallocate(field1_default,mask_default,latitude_default,dummy_2d,terrain_land,soilt_climo,dummy_3d) + deallocate(soil_temp_correct,soil_temp_search,field_default_correct) + + call ESMF_FieldDestroy(latitude_target_grid,rc=rc) + call ESMF_FieldDestroy(longitude_target_grid,rc=rc) + call ESMF_FieldDestroy(field1_target_grid,rc=rc) + call ESMF_FieldDestroy(field2_target_grid,rc=rc) + call ESMF_FieldDestroy(field3_target_grid,rc=rc) + call ESMF_FieldDestroy(field4_target_grid,rc=rc) + call ESMF_FieldDestroy(field_3d_target_grid,rc=rc) + call ESMF_GridDestroy(target_grid, rc=rc) + + + call ESMF_finalize(endflag=ESMF_END_KEEPMPI) + call mpi_finalize(rc) + + print*,"SUCCESS!" + + end program surface_interp From e34165d0fb0728b210e712e1c2249d516879a622 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Fri, 20 Aug 2021 18:27:55 +0000 Subject: [PATCH 14/18] Re-remove surface_interp unit test --- tests/chgres_cube/CMakeLists.txt | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index f9e1f6d65..1c78690f5 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -105,15 +105,15 @@ add_mpi_test(chgres_cube-ftst_read_sfc_gfs_nemsio NUMPROCS 1 TIMEOUT 60) -# Comment out this unit test until ESMF memory leaks are solved - add_executable(ftst_surface_interp ftst_surface_interp.F90) - target_link_libraries(ftst_surface_interp chgres_cube_lib) - -# Cause test to be run with MPI. - add_mpi_test(chgres_cube-ftst_surface_interp - EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp - NUMPROCS 1 - TIMEOUT 60) +## Comment out this unit test until ESMF memory leaks are solved +## add_executable(ftst_surface_interp ftst_surface_interp.F90) +## target_link_libraries(ftst_surface_interp chgres_cube_lib) +## +## Cause test to be run with MPI. +## add_mpi_test(chgres_cube-ftst_surface_interp +## EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_surface_interp +## NUMPROCS 1 +## TIMEOUT 60) add_executable(ftst_read_sfc_nemsio ftst_read_sfc_nemsio.F90) target_link_libraries(ftst_read_sfc_nemsio chgres_cube_lib) From 5f1e270281ca74b5179134c6aba085e51c2f07c9 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Fri, 20 Aug 2021 21:14:52 +0000 Subject: [PATCH 15/18] Fixed but for processing of landice field bundle. Updated language for error printed when incorrect missing_value var_map table is provided to include "intrp" as possible correct choice --- sorc/chgres_cube.fd/input_data.F90 | 2 +- sorc/chgres_cube.fd/surface.F90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 46bb91871..8b9089d61 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -6492,7 +6492,7 @@ subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d) else call error_handler("ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // & " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// & - " , skip, or stop.", 1) + " , intrp, skip, or stop.", 1) endif end subroutine handle_grib_error diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index e860aef41..5dac6ae8f 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -1217,11 +1217,11 @@ subroutine interp(localpet) allocate(dozero(num_fields)) if (sotyp_from_climo) then - search_nums = (/21,7/) + search_nums = (/21,7,21/) dozero(:)=.False. else - search_nums = (/21,7,231/) - dozero(:)=(/.False.,.False.,.True./) + search_nums = (/21,7,21,231/) + dozero(:)=(/.False.,.False.,.False.,.True./) endif call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & From b92387894fc44b95848f7a9c838fe051da6f676e Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Mon, 4 Oct 2021 20:09:09 +0000 Subject: [PATCH 16/18] Split if statement with optional variable in to two if statements to ensure compatibility with all compilers. --- sorc/chgres_cube.fd/surface.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 5dac6ae8f..b7549be8c 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -3285,11 +3285,13 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, endif enddo - if (present(resetifd) .and. resetifd .and. convert_nst) then - call ESMF_FieldGet(ifd_target_grid,farrayPtr=tmp_ptr,rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) - tmp_ptr = float(nint(tmp_ptr)) + if (present(resetifd)) then + if( resetifd .and. convert_nst) then + call ESMF_FieldGet(ifd_target_grid,farrayPtr=tmp_ptr,rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldGet", rc) + tmp_ptr = float(nint(tmp_ptr)) + endif endif n2d = count(is2d(:)) From 7bbf5bfe5cd65af3c107845ac1e254a28507e497 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Thu, 7 Oct 2021 21:02:18 +0000 Subject: [PATCH 17/18] Removed unnecessary regrid_many option doreplace --- sorc/chgres_cube.fd/surface.F90 | 19 +++++++++---------- .../chgres_cube/ftst_surface_regrid_many.F90 | 2 +- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index b7549be8c..70abbd319 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -471,7 +471,7 @@ subroutine interp(localpet) allocate(dozero(num_fields)) dozero(:) = .True. - call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.) + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) @@ -890,7 +890,7 @@ subroutine interp(localpet) u = ubound(unmapped_ptr) call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & - .True.,unmapped_ptr=unmapped_ptr ) + unmapped_ptr=unmapped_ptr ) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_seaice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1003,7 +1003,7 @@ subroutine interp(localpet) endif call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & - .True., unmapped_ptr=unmapped_ptr, resetifd=.True.) + unmapped_ptr=unmapped_ptr, resetifd=.True.) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_water_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1105,7 +1105,7 @@ subroutine interp(localpet) dozero=(/.True.,.False.,.False./) call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & - .True., unmapped_ptr=unmapped_ptr) + unmapped_ptr=unmapped_ptr) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_allland_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1225,7 +1225,7 @@ subroutine interp(localpet) endif call regrid_many(bundle_landice_input,bundle_landice_target,num_fields,regrid_landice,dozero, & - .True., unmapped_ptr=unmapped_ptr ) + unmapped_ptr=unmapped_ptr ) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_landice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -1439,7 +1439,7 @@ subroutine interp(localpet) endif call regrid_many(bundle_nolandice_input,bundle_nolandice_target,num_fields,regrid_land,dozero, & - .True., unmapped_ptr=unmapped_ptr) + unmapped_ptr=unmapped_ptr) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_nolandice_input,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3207,11 +3207,10 @@ end subroutine ij_to_i_j !! @param[in] num_field Number of fields in target field pointer !! @param[inout] route Route handle to saved ESMF regridding instructions !! @param[in] dozero Logical length num_field for whether field should be zeroed out before regridding -!! @param[in] doreplace Logical indicating wehther to set unmapped locations to missing value for searching and replacing later !! @param[inout] unmapped_ptr (optional) Pointer to unmapped points from FieldRegrid !! @param[in] resetifd (optional) Logical for whether to reset ifd (only for water where nst data is used) !! @author Larissa Reames, OU CIMMS/NOAA/NSSL - subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, & + subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero, & unmapped_ptr,resetifd) use esmf @@ -3223,7 +3222,7 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, integer, intent(in) :: num_field type(esmf_routehandle), intent(inout) :: route type(esmf_fieldbundle), intent(in) :: bundle_pre, bundle_post - logical, intent(in) :: dozero(num_field), doreplace + logical, intent(in) :: dozero(num_field) logical, intent(in), optional :: resetifd integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:) @@ -3297,7 +3296,7 @@ subroutine regrid_many(bundle_pre,bundle_post, num_field,route,dozero,doreplace, n2d = count(is2d(:)) n3d = count(.not.is2d(:)) if(localpet==0) print*, is2d(:) - if (doreplace) then + if (present(unmapped_ptr)) then allocate(ptr_2d(n2d)) if (n3d .ne. 0) allocate(ptr_3d(n3d)) do i=1, num_field diff --git a/tests/chgres_cube/ftst_surface_regrid_many.F90 b/tests/chgres_cube/ftst_surface_regrid_many.F90 index 903f40f8b..9fac01bef 100644 --- a/tests/chgres_cube/ftst_surface_regrid_many.F90 +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -341,7 +341,7 @@ program surface_interp dozero(:) = .True. !Call the routine to unit test. - call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero,.False.) + call regrid_many(bundle_all_input,bundle_all_target,num_fields,regrid_bl_no_mask,dozero) deallocate(dozero) call ESMF_FieldBundleDestroy(bundle_all_target,rc=rc) From 74f33fb34c00c2d48b44acd72ce787a026b54377 Mon Sep 17 00:00:00 2001 From: "larissa.reames@noaa.gov" Date: Fri, 8 Oct 2021 18:51:36 +0000 Subject: [PATCH 18/18] Added additional commentary in search_many to make if branches easier to understand. --- sorc/chgres_cube.fd/surface.F90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 70abbd319..c8cc2961a 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -3401,26 +3401,37 @@ subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & call error_handler("IN FieldGather", rc) if (localpet == 0) then if (present(latitude) .and. search_nums(k).eq.SST_FIELD_NUM) then + ! Sea surface temperatures; pass latitude field to search print*, "search1" call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),latitude=latitude) elseif (present(terrain_land) .and. search_nums(k) .eq. TERRAIN_FIELD_NUM) then + ! Terrain height; pass optional climo terrain array to search print*, "search2" call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),terrain_land=terrain_land) - elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then + elseif (search_nums(k) .eq. SOTYP_LAND_FIELD_NUM) then + ! Soil type over land if (fname .eq. "soil_type_target_grid") then + ! Soil type over land when interpolating input data to target grid + ! *with* the intention of retaining interpolated data in output print*, "search3" call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k),soilt_climo=soilt_climo) elseif (present(soilt_climo)) then if (maxval(field_data_2d) > 0 .and. (trim(external_model) .ne. "GFS" .or. trim(input_type) .ne. "grib2")) then + ! Soil type over land when interpolating input data to target grid + ! *without* the intention of retaining data in output file print*, "search4" - ! If soil type from the input grid has any non-zero points then soil type must exist for use call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k)) - else ! Otherwise, just set the data on the "target" grid to the soil climatology + else + ! If no soil type field exists in input data (e.g., GFS grib2) then don't search + ! but simply set data to the climo field. This may result in + ! somewhat inaccurate soil moistures as no scaling will occur print*, "search5" field_data_2d = soilt_climo endif !check field value endif !sotype from target grid else + ! Any field that doesn't require any of the special treatments or + ! passing of additional variables as in those above call search(field_data_2d, mask, i_target, j_target, tile,search_nums(k)) endif !if present endif !localpet @@ -3428,6 +3439,7 @@ subroutine search_many(num_field,bundle_target,field_data_2d,mask, tile, & if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))& call error_handler("IN FieldScatter", rc) else + ! Process 3d fields soil temperature, moisture, and liquid print*, "FieldGather" call ESMF_FieldGather(temp_field,field_data_3d,rootPet=0,tile=tile,rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__))&