diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index e3f4b12de..b7029a59f 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -72,33 +72,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 :: 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 :: 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 :: 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 :: 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 @@ -107,25 +107,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 :: 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 :: 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 :: 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 @@ -6512,7 +6512,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 e46c79f6c..c8cc2961a 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 :: canopy_mc_target_grid !< canopy moisture content - type(esmf_field), public :: 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 :: 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 :: q2m_target_grid + type(esmf_field), public :: q2m_target_grid !< 2-m specific humidity - type(esmf_field), public :: seaice_depth_target_grid + type(esmf_field), public :: seaice_depth_target_grid !< sea ice depth - type(esmf_field), public :: seaice_fract_target_grid + type(esmf_field), public :: seaice_fract_target_grid !< sea ice fraction - type(esmf_field), public :: seaice_skin_temp_target_grid + type(esmf_field), public :: seaice_skin_temp_target_grid !< sea ice skin temperature - type(esmf_field), public :: skin_temp_target_grid + type(esmf_field), public :: skin_temp_target_grid !< skin temperature/sst - type(esmf_field), public :: srflag_target_grid + type(esmf_field), public :: srflag_target_grid !< snow/rain flag - type(esmf_field), public :: snow_liq_equiv_target_grid + type(esmf_field), public :: snow_liq_equiv_target_grid !< liquid equiv snow depth - type(esmf_field), public :: snow_depth_target_grid + type(esmf_field), public :: snow_depth_target_grid !< physical snow depth - type(esmf_field), public :: soil_temp_target_grid + type(esmf_field), public :: soil_temp_target_grid !< 3-d soil temperature - type(esmf_field), public :: soilm_liq_target_grid + type(esmf_field), public :: soilm_liq_target_grid !< 3-d liquid soil moisture - type(esmf_field), public :: soilm_tot_target_grid + type(esmf_field), public :: soilm_tot_target_grid !< 3-d total soil moisture - type(esmf_field), public :: t2m_target_grid + type(esmf_field), public :: t2m_target_grid !< 2-m temperatrure - type(esmf_field), public :: tprcp_target_grid + type(esmf_field), public :: tprcp_target_grid !< precip - type(esmf_field), public :: ustar_target_grid + type(esmf_field), public :: ustar_target_grid !< friction velocity - type(esmf_field), public :: z0_target_grid + type(esmf_field), public :: z0_target_grid !< roughness length - type(esmf_field), public :: lai_target_grid + type(esmf_field), public :: lai_target_grid !< leaf area index ! nst fields - type(esmf_field), public :: c_d_target_grid + type(esmf_field), public :: c_d_target_grid !< Coefficient 2 to calculate d(tz)/d(ts) - type(esmf_field), public :: c_0_target_grid + type(esmf_field), public :: c_0_target_grid !< Coefficient 1 to calculate d(tz)/d(ts) - type(esmf_field), public :: d_conv_target_grid + type(esmf_field), public :: d_conv_target_grid !< Thickness of free convection layer - type(esmf_field), public :: dt_cool_target_grid + type(esmf_field), public :: dt_cool_target_grid !< Sub-layer cooling amount - type(esmf_field), public :: 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 :: qrain_target_grid + type(esmf_field), public :: qrain_target_grid !< Sensible heat flux due to rainfall - type(esmf_field), public :: tref_target_grid + type(esmf_field), public :: tref_target_grid !< reference temperature - type(esmf_field), public :: w_d_target_grid + type(esmf_field), public :: w_d_target_grid !< Coefficient 4 to calculate d(tz)/d(ts) - type(esmf_field), public :: w_0_target_grid + type(esmf_field), public :: w_0_target_grid !< Coefficient 3 to calculate d(tz)/d(ts) - type(esmf_field), public :: xs_target_grid + type(esmf_field), public :: xs_target_grid !< Salinity content in diurnal !< thermocline layer - type(esmf_field), public :: xt_target_grid + type(esmf_field), public :: xt_target_grid !< Heat content in diurnal thermocline !< layer - type(esmf_field), public :: xu_target_grid + type(esmf_field), public :: xu_target_grid !< u-current content in diurnal !< thermocline layer - type(esmf_field), public :: xv_target_grid + type(esmf_field), public :: xv_target_grid !< v-current content in diurnal !< thermocline layer - type(esmf_field), public :: xz_target_grid + type(esmf_field), public :: xz_target_grid !< Diurnal thermocline layer thickness - type(esmf_field), public :: xtts_target_grid + type(esmf_field), public :: xtts_target_grid !< d(xt)/d(ts) - type(esmf_field), public :: xzts_target_grid + type(esmf_field), public :: xzts_target_grid !< d(xz)/d(ts) - type(esmf_field), public :: z_c_target_grid + type(esmf_field), public :: z_c_target_grid !< Sub-layer cooling thickness - type(esmf_field), public :: zm_target_grid + type(esmf_field), public :: zm_target_grid !< Oceanic mixed layer depth type(esmf_field) :: soil_type_from_input_grid @@ -137,6 +137,18 @@ module surface !< gravity real, parameter, private :: hlice = 3.335E5 !< latent heat of fusion + + + 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 @@ -145,6 +157,8 @@ module surface public :: cleanup_target_sfc_data public :: nst_land_fill public :: cleanup_target_nst_data + public :: regrid_many + public :: search_many contains @@ -219,8 +233,7 @@ subroutine surface_driver(localpet) call interp(localpet) !--------------------------------------------------------------------------------------------- -! Adjust soil/landice column temperatures for any change in elevation between -! the +! Adjust soil/landice column temperatures for any change in elevation between the ! input and target grids. !--------------------------------------------------------------------------------------------- @@ -353,9 +366,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, & @@ -374,6 +385,9 @@ subroutine interp(localpet) integer :: i, j, ij, rc, tile 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(:,:) integer(esmf_kind_i4), pointer :: mask_target_ptr(:,:) @@ -387,47 +401,14 @@ 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), allocatable :: soil_type_target_grid_save(:,:) - 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 :: soil_type_target_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 :: 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(:,:) - 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 @@ -437,6 +418,15 @@ subroutine interp(localpet) type(esmf_routehandle) :: regrid_nonland type(esmf_routehandle) :: regrid_seaice type(esmf_routehandle) :: regrid_water + + type(esmf_fieldbundle) :: bundle_all_target, bundle_all_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 + type(esmf_fieldbundle) :: bundle_nolandice_target, bundle_nolandice_input + + logical, allocatable :: dozero(:) !----------------------------------------------------------------------- ! Interpolate fieids that do not require 'masked' interpolation. @@ -456,62 +446,41 @@ 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) + 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,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, (/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__)) & + 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. - 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) + 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) + 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) + print*,"- CALL FieldGet FOR SRFLAG." call ESMF_FieldGet(srflag_target_grid, & farrayPtr=srflag_target_ptr, rc=rc) @@ -586,12 +555,10 @@ subroutine interp(localpet) allocate(data_one_tile(i_target,j_target)) allocate(data_one_tile_3d(i_target,j_target,lsoil_target)) allocate(mask_target_one_tile(i_target,j_target)) - allocate(soil_type_target_grid_save(i_target,j_target)) else allocate(data_one_tile(0,0)) allocate(data_one_tile_3d(0,0,0)) allocate(mask_target_one_tile(0,0)) - allocate(soil_type_target_grid_save(0,0)) endif !----------------------------------------------------------------------- @@ -892,175 +859,65 @@ 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) - - 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) + 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) + - 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) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + 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 - enddo + + call regrid_many(bundle_seaice_input,bundle_seaice_target,num_fields,regrid_seaice,dozero, & + 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__)) & + 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) - - 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) - 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_seaice_target,data_one_tile, mask_target_one_tile,tile,search_nums,localpet, & + field_data_3d=data_one_tile_3d) 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__)) & @@ -1093,690 +950,114 @@ subroutine interp(localpet) 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 + 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_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) 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) + 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 - 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) + call regrid_many(bundle_water_input,bundle_water_target,num_fields,regrid_water,dozero, & + 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__)) & - call error_handler("IN FieldRegrid", rc) + call error_handler("IN FieldBundleDestroy", 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) + if (localpet == 0) then + allocate(latitude_one_tile(i_target,j_target)) + else + allocate(latitude_one_tile(0,0)) + endif - 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) + do tile = 1, num_tiles_target_grid - 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) + 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 FieldRegrid", rc) + call error_handler("IN FieldGather", 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) + 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 FieldRegrid", rc) + call error_handler("IN FieldGather", 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) + 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 - 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) + call search_many(num_fields,bundle_water_target,data_one_tile, water_target_one_tile,& + tile,search_nums,localpet,latitude=latitude_one_tile) - 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) + if (localpet == 0) deallocate(water_target_one_tile) - 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) + enddo - 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) + deallocate(latitude_one_tile,search_nums) + + 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 FieldRegrid", rc) + call error_handler("IN FieldBundleDestroy", 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 FieldRegridRelease." + call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & + call error_handler("IN FieldRegridRelease", 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) +!--------------------------------------------------------------------------------------------- +! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. +!--------------------------------------------------------------------------------------------- - 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 - - 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) - - enddo - - deallocate(latitude_one_tile) - - print*,"- CALL FieldRegridRelease." - call ESMF_FieldRegridRelease(routehandle=regrid_water, rc=rc) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldRegridRelease", rc) - -!--------------------------------------------------------------------------------------------- -! Now interpolate "all land" to "all land". Here, "all land" means landice and non-land ice. -!--------------------------------------------------------------------------------------------- - - mask_input_ptr = 0 - where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 + mask_input_ptr = 0 + where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 mask_target_ptr = 0 where (landmask_target_ptr == 1) mask_target_ptr = 1 @@ -1799,69 +1080,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) - - 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) - - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) + 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) + 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) + + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) - 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 + search_nums = (/223,66,65/) + dozero=(/.True.,.False.,.False./) + + call regrid_many(bundle_allland_input,bundle_allland_target,num_fields,regrid_all_land,dozero, & + 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__)) & + 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__)) & @@ -1871,45 +1123,19 @@ 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 - - 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 + + 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 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 + 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) + 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__)) & @@ -1957,83 +1183,53 @@ 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) - + 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 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 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) + if (.not. sotyp_from_climo) then - print*,"- CALL FieldGather FOR SOIL TYPE TARGET GRID, TILE: ", tile - call ESMF_FieldGather(soil_type_target_grid,soil_type_target_grid_save,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) - - print*,"- CALL Field_Regrid for soil type over landice." - call ESMF_FieldRegrid(soil_type_input_grid, & - soil_type_target_grid, & - routehandle=regrid_landice, & - termorderflag=ESMF_TERMORDER_SRCSEQ, & - rc=rc) + 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 FieldRegrid", rc) - - print*,"- CALL FieldGet FOR SOIL TYPE TARGET GRID." - call ESMF_FieldGet(soil_type_target_grid, & - farrayPtr=soil_type_from_input_ptr, rc=rc) + 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 FieldGet", rc) - endif + call error_handler("IN FieldBundleAdd", rc) + endif - l = lbound(unmapped_ptr) - u = ubound(unmapped_ptr) + 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 FieldBundleGet", rc) - 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 - if (.not.sotyp_from_climo) soil_type_from_input_ptr(i,j) = -9999.9 - enddo + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + if (sotyp_from_climo) then + search_nums = (/21,7,21/) + dozero(:)=.False. + else + 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, & + 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__)) & + call error_handler("IN FieldBundleDestroy", rc) if (localpet == 0) then allocate (veg_type_target_one_tile(i_target,j_target)) @@ -2046,12 +1242,6 @@ subroutine interp(localpet) 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) - 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) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -2060,71 +1250,24 @@ subroutine interp(localpet) 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) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", 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) - - 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 - - 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 LANDICE 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, land_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) - if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldScatter", rc) - - 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 + 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) + 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) + deallocate(search_nums) + + 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) print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_landice, rc=rc) @@ -2139,204 +1282,168 @@ subroutine interp(localpet) where (nint(landmask_input_ptr) == 1) mask_input_ptr = 1 where (nint(veg_type_input_ptr) == veg_type_landice_input) mask_input_ptr = 0 - mask_target_ptr = 0 - where (landmask_target_ptr == 1) mask_target_ptr = 1 - where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 - - method=ESMF_REGRIDMETHOD_NEAREST_STOD - isrctermprocessing = 1 - - print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." - call ESMF_FieldRegridStore(soilm_tot_input_grid, & - soilm_tot_target_grid, & - srcmaskvalues=(/0/), & - dstmaskvalues=(/0/), & - polemethod=ESMF_POLEMETHOD_NONE, & - srctermprocessing=isrctermprocessing, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - normtype=ESMF_NORMTYPE_FRACAREA, & - routehandle=regrid_land, & - 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 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) - - if (.not. sotyp_from_climo) then - print*,"- CALL Field_Regrid for soil type over land." - 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 FieldRegrid", rc) - endif - - 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) - 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) - - endif - - 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) + mask_target_ptr = 0 + where (landmask_target_ptr == 1) mask_target_ptr = 1 + where (nint(veg_type_target_ptr) == veg_type_landice_target) mask_target_ptr = 0 - 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) + method=ESMF_REGRIDMETHOD_NEAREST_STOD + isrctermprocessing = 1 - print*,"- CALL FieldGet FOR terrain from input grid." - call ESMF_FieldGet(terrain_from_input_grid, & - farrayPtr=terrain_from_input_ptr, rc=rc) + print*,"- CALL FieldRegridStore for 3d land (but no land ice) fields." + call ESMF_FieldRegridStore(soilm_tot_input_grid, & + soilm_tot_target_grid, & + srcmaskvalues=(/0/), & + dstmaskvalues=(/0/), & + polemethod=ESMF_POLEMETHOD_NONE, & + srctermprocessing=isrctermprocessing, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + normtype=ESMF_NORMTYPE_FRACAREA, & + routehandle=regrid_land, & + regridmethod=method, & + unmappedDstList=unmapped_ptr, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & - call error_handler("IN FieldGet", rc) + call error_handler("IN FieldRegridStore", rc) - if (.not. sotyp_from_climo) then - print*,"- CALL FieldGet FOR soil type target grid." + 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 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_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,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) +! 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 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__))& + if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & call error_handler("IN FieldGet", rc) - endif + + l = lbound(unmapped_ptr) + u = ubound(unmapped_ptr) - 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) + 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 + 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) + + mmvg_ind = num_fields-1 + endif + + 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) + allocate(search_nums(num_fields)) + allocate(dozero(num_fields)) + + 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. 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_ind+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 - if (.not. sotyp_from_climo) soil_type_target_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, & + 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__)) & + call error_handler("IN FieldBundleDestroy", rc) if (localpet == 0) then allocate (veg_type_target_one_tile(i_target,j_target)) @@ -2356,140 +1463,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_tile2, mask_target_one_tile, i_target, j_target, tile, 224,soilt_climo=soil_type_target_grid_save) - 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_tile2, 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, 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) @@ -2504,28 +1488,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 @@ -2533,9 +1499,30 @@ 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 + 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) + print*,"- CALL FieldRegridRelease." call ESMF_FieldRegridRelease(routehandle=regrid_land, rc=rc) if(ESMF_logFoundError(rcToCheck=rc,msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) & @@ -3682,6 +2669,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) @@ -3697,6 +2685,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) @@ -3712,6 +2701,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) @@ -3727,6 +2717,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) @@ -3742,6 +2733,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) @@ -3757,6 +2749,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) @@ -3772,6 +2765,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) @@ -3787,6 +2781,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) @@ -3802,6 +2797,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) @@ -3817,6 +2813,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) @@ -3832,6 +2829,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) @@ -3847,6 +2845,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) @@ -3862,6 +2861,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) @@ -3877,6 +2877,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) @@ -3892,6 +2893,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) @@ -3907,6 +2909,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) @@ -3922,6 +2925,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) @@ -3937,7 +2941,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) @@ -3953,6 +2958,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__)) & @@ -3970,6 +2976,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__)) & @@ -3987,6 +2994,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__)) & @@ -4192,6 +3200,266 @@ subroutine ij_to_i_j(ij, itile, jtile, i, j) end subroutine ij_to_i_j +!> Regrid multiple ESMF fields from input to target grid +!! +!! @param[in] bundle_pre ESMF fieldBundle on input grid +!! @param[in] bundle_post ESMF fieldBundle on target grid +!! @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[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, & + unmapped_ptr,resetifd) + + use esmf + use program_setup, only : convert_nst + use model_grid, only : i_target, j_target + + implicit none + + 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) + logical, intent(in), optional :: resetifd + integer(esmf_kind_i4), intent(inout), optional :: unmapped_ptr(:) + + type(esmf_field) :: field_pre,field_post + real(esmf_kind_r8), pointer :: tmp_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, 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) + 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,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,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) + 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 (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(:)) + n3d = count(.not.is2d(:)) + if(localpet==0) print*, is2d(:) + if (present(unmapped_ptr)) then + allocate(ptr_2d(n2d)) + if (n3d .ne. 0) allocate(ptr_3d(n3d)) + do i=1, num_field + if (is2d(i)) then + 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(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 + enddo + do k = 1,n3d + 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 +!! +!! @param[in] num_field Number of fields to process. +!! @param[inout] bundle_target ESMF FieldBundle holding target fields to search +!! @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] 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,& + field_data_3d) + + use model_grid, only : i_target,j_target, lsoil_target + use program_setup, only : external_model, input_type + use search_util + + implicit none + + integer, intent(in) :: num_field + 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) :: tile,localpet + integer, intent(inout) :: search_nums(num_field) + + 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 + 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 (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) .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 + ! 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" + call search(field_data_2d, mask, i_target, j_target, tile, search_nums(k)) + 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 + 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 + ! 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__))& + 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_2d + enddo + 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 !ndims + end do !fields + + end subroutine search_many + !> Free up memory once the target grid surface fields are !! no longer needed. !! diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index f4abbc058..0181ceb64 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -114,15 +114,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) @@ -178,6 +178,24 @@ add_mpi_test(chgres_cube-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 + 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) + add_executable(ftst_read_vcoord ftst_read_vcoord.F90) target_link_libraries(ftst_read_vcoord chgres_cube_lib) add_test(NAME chgres_cube-ftst_read_vcoord COMMAND ftst_read_vcoord) 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..9fac01bef --- /dev/null +++ b/tests/chgres_cube/ftst_surface_regrid_many.F90 @@ -0,0 +1,395 @@ + 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 input_data, only: t2m_input_grid, & + q2m_input_grid + + use surface, only : regrid_many, & + t2m_target_grid, & + q2m_target_grid + + + 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 + integer :: isrctermprocessing + + 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) + + !--------------------------------------------------------------------! + !----------------- 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) + 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) + + !Initializes input ESMF fields + t2m_input_grid = ESMF_FieldCreate(input_grid, & + typekind=ESMF_TYPEKIND_R8, & + 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, 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)) + + 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 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 + + 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/)) + 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 + + 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) + 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(t2m_target_grid, t2m_target, rootPet=0, rc=rc) + call ESMF_FieldGather(q2m_target_grid, q2m_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 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