From 64aa4d99ba744eeeacae84ed53756db93d144e46 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Sat, 21 Mar 2020 11:24:39 -0400 Subject: [PATCH 001/219] Add files via upload --- src/biogeophys/LunaMod.F90 | 36 +++--- src/biogeophys/PhotosynthesisMod.F90 | 31 ++++-- src/biogeophys/TemperatureType.F90 | 52 ++++++--- src/biogeophys/WaterDiagnosticBulkType.F90 | 122 +++++++++++++++++++++ 4 files changed, 203 insertions(+), 38 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 35a38701ec..3ff3fade55 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -306,7 +306,9 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & vcmx25_z => photosyns_inst%vcmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Vc,max25 (umol/m2 leaf/s) for canopy layer jmx25_z => photosyns_inst%jmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Jmax25 (umol electron/m**2/s) for canopy layer pnlc_z => photosyns_inst%pnlc_z_patch , & ! Output: [real(r8) (:,:) ] patch proportion of leaf nitrogen allocated for light capture for canopy layer - enzs_z => photosyns_inst%enzs_z_patch & ! Output: [real(r8) (:,:) ] enzyme decay status 1.0-fully active; 0-all decayed during stress + enzs_z => photosyns_inst%enzs_z_patch , & ! Output: [real(r8) (:,:) ] enzyme decay status 1.0-fully active; 0-all decayed during stress + vcmx_prevyr => photosyns_inst%vcmx_prevyr , & ! Output: [real(r8) (:,:) ] patch leaf Vc,max25 from previous year avg + jmx_prevyr => photosyns_inst%jmx_prevyr & ! Output: [real(r8) (:,:) ] patch leaf Jmax25 from previous year avg ) !---------------------------------------------------------------------------------------------------------------------------------------------------------- !set timestep @@ -332,7 +334,7 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & hourpd = dayl(g) / 3600._r8 tleafd10 = t_veg10_day(p) - tfrz tleafn10 = t_veg10_night(p) - tfrz - tleaf10 = (dayl(g)*tleafd10 +(86400._r8-dayl(g)) * tleafd10)/86400._r8 + tleaf10 = (dayl(g)*tleafd10 +(86400._r8-dayl(g)) * tleafn10)/86400._r8 tair10 = t10(p)- tfrz relh10 = min(1.0_r8, rh10_p(p)) rb10v = rb10_p(p) @@ -409,11 +411,15 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & chg = vcmx25_opt-vcmx25_z(p, z) chg_constrn = min(abs(chg),vcmx25_z(p, z)*max_daily_pchg) + vcmx_prevyr(p,z) = vcmx25_z(p,z) vcmx25_z(p, z) = vcmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn - + vcmx_prevyr(p,z) = (vcmx_prevyr(p,z)+vcmx25_z(p,z))/2.0_r8 + chg = jmx25_opt-jmx25_z(p, z) chg_constrn = min(abs(chg),jmx25_z(p, z)*max_daily_pchg) + jmx_prevyr(p,z) = jmx25_z(p,z) jmx25_z(p, z) = jmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn + jmx_prevyr(p,z) = (jmx_prevyr(p,z)+jmx25_z(p,z))/2.0_r8 PNlc_z(p, z)= PNlcopt @@ -472,8 +478,8 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & endif !if not C3 plants else do z = 1 , nrad(p) - jmx25_z(p, z) = 85._r8 - vcmx25_z(p, z) = 50._r8 + jmx25_z(p, z) = jmx_prevyr(p,z) + vcmx25_z(p, z) = vcmx_prevyr(p,z) end do endif !checking for LAI and LNC endif !the first daycheck @@ -792,7 +798,7 @@ end subroutine Clear24_Climate_LUNA subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PARimx10,rb10, hourpd, tair10, tleafd10, tleafn10, & Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp,& PNlcold, PNetold, PNrespold, PNcbold, & - PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt, dayl_factor) implicit none real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) real(r8), intent (in) :: forc_pbot10 !10-day mean air pressure (Pa) @@ -819,7 +825,7 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR real(r8), intent (out):: PNetopt !optimal proportion of nitrogen for electron transport real(r8), intent (out):: PNrespopt !optimal proportion of nitrogen for respiration real(r8), intent (out):: PNcbopt !optial proportion of nitrogen for carboxyaltion - + real(r8), intent(in) :: dayl_factor !lbirch: added to scaled light: !------------------------------------------------------------------------------------------------------------------------------- !intermediate variables real(r8) :: Carboncost1 !absolute amount of carbon cost associated with maintenance respiration due to deccrease in light capture nitrogen(g dry mass per day) @@ -897,11 +903,11 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR tleafd10c = min(max(tleafd10, Trange1), Trange2) !constrain the physiological range tleafn10c = min(max(tleafn10, Trange1), Trange2) !constrain the physiological range ci = 0.7_r8 * CO2a10 - JmaxCoef = Jmaxb1 * ((hourpd / 12.0_r8)**2.0_r8) * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & + JmaxCoef = Jmaxb1 * dayl_factor * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & (1.0_r8 - minrelh))) do while (PNlcoldi .NE. PNlc .and. jj < 100) - Fc = VcmxTKattge(tair10, tleafd10c) * Fc25 - Fj = JmxTKattge(tair10, tleafd10c) * Fj25 + Fc = VcmxTLeuning(tair10, tleafd10c) * Fc25 + Fj = JmxTLeuning(tair10, tleafd10c) * Fj25 NUEr = Cv * NUEr25 * (RespTBernacchi(tleafd10c) * hourpd + RespTBernacchi(tleafn10c) * (24.0_r8 - hourpd)) !nitrogen use efficiency for respiration (g biomass/m2/day/g N) !**************************************************** !Nitrogen Allocation Scheme: store the initial value @@ -1054,7 +1060,7 @@ subroutine Nitrogen_investments (KcKjFlag, FNCa, Nlc, forc_pbot10, relh10, & A = (1.0_r8 - theta_cj) * max(Wc, Wj) + theta_cj * min(Wc, Wj) endif PSN = Cv * A * hourpd - Vcmaxnight = VcmxTKattge(tair10, tleafn10) / VcmxTKattge(tair10, tleafd10) * Vcmax + Vcmaxnight = VcmxTLeuning(tair10, tleafn10) / VcmxTLeuning(tair10, tleafd10) * Vcmax RESP = Cv * leaf_mr_vcm * (Vcmax * hourpd + Vcmaxnight * (24.0_r8 - hourpd)) Net = Jmax / Fj Ncb = Vcmax / Fc @@ -1209,8 +1215,8 @@ subroutine NUEref(NUEjref,NUEcref,Kj2Kcref) tgrow = 25.0_r8 tleaf = 25.0_r8 - Fc = VcmxTKattge(tgrow, tleaf) * Fc25 - Fj = JmxTKattge(tgrow, tleaf) * Fj25 + Fc = VcmxTLeuning(tgrow, tleaf) * Fc25 + Fj = JmxTLeuning(tgrow, tleaf) * Fj25 CO2c = co2ref * forc_pbot_ref * 1.0e-6_r8 !pa O2c = O2ref * forc_pbot_ref * 1.0e-6_r8 !pa k_c = params_inst%kc25_coef * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) @@ -1250,8 +1256,8 @@ subroutine NUE(O2a, ci, tgrow, tleaf, NUEj,NUEc,Kj2Kc) real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model real(r8) :: c_p !CO2 compenstation point (Pa) - Fc = VcmxTKattge(tgrow, tleaf) * Fc25 - Fj = JmxTKattge(tgrow, tleaf) * Fj25 + Fc = VcmxTLenuning(tgrow, tleaf) * Fc25 + Fj = JmxTLeuning(tgrow, tleaf) * Fj25 k_c = params_inst%kc25_coef * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) k_o = params_inst%ko25_coef * exp((36380.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) c_p = params_inst%cp25_yr2000 * exp((37830.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index a111cab156..11249d534c 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -183,6 +183,8 @@ module PhotosynthesisMod ! LUNA specific variables real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year avg + real(r8), pointer, public :: jmx2_prevyr (:,:) ! patch leaf Jmax25 previous year avg real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) @@ -328,6 +330,8 @@ subroutine InitAllocate(this, bounds) ! statements. allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 + allocate(this%vcmx_prevyr (begp:endp,1:nlevcan)) ; this%vcmx_prevyr (:,:) = 30._r8 + allocate(this%jmx_prevyr (begp:endp,1:nlevcan)) ; this%jmx_prevyr (:,:) = 60._r8 allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 @@ -833,6 +837,14 @@ subroutine Restart(this, bounds, ncid, flag) dim1name='pft', dim2name='levcan', switchdim=.true., & long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='vcmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%vcmx_prevyr) + call restartvar(ncid=ncid, flag=flag, varname='jmx_prevyr', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%jmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & @@ -2791,18 +2803,18 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & kcha = 79430._r8 koha = 36380._r8 cpha = 37830._r8 - vcmaxha = 72000._r8 - jmaxha = 50000._r8 - tpuha = 72000._r8 + vcmaxha = 73637._r8 + jmaxha = 50300._r8 + tpuha = 73637._r8 lmrha = 46390._r8 ! High temperature deactivation, from: ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 ! The factor "c" scales the deactivation to a value of 1.0 at 25C - vcmaxhd = 200000._r8 - jmaxhd = 200000._r8 - tpuhd = 200000._r8 + vcmaxhd = 149252._r8 + jmaxhd = 152044._r8 + tpuhd = 149252._r8 lmrhd = 150650._r8 lmrse = 490._r8 lmrc = fth25 (lmrhd, lmrse) @@ -3162,9 +3174,10 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & kp25_sha = kp25top * nscaler_sha ! Adjust for temperature - - vcmaxse = 668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) - jmaxse = 659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + vcmaxse = 486.0_r8 + jmaxse = 495.0_r8 + !vcmaxse = 668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + !jmaxse = 659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) tpuse = vcmaxse vcmaxc = fth25 (vcmaxhd, vcmaxse) jmaxc = fth25 (jmaxhd, jmaxse) diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 5c69733f8a..4949c5f24b 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -453,13 +453,17 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) call hist_addfld1d (fname='T10', units='K', & avgflag='A', long_name='10-day running mean of 2-m temperature', & ptr_patch=this%t_a10_patch, default='inactive') - - if (use_cn .and. use_crop )then - this%t_a5min_patch(begp:endp) = spval - call hist_addfld1d (fname='A5TMIN', units='K', & - avgflag='A', long_name='5-day running mean of min 2-m temperature', & - ptr_patch=this%t_a5min_patch, default='inactive') - end if + + this%soila10_patch(begp:endp) = spval + call hist_addfld1d (fname='SOIL10', units='K', & + avgflag='A', long_name='10-day running mean of 3rd layer soil', & + ptr_patch=this%soila10_patch, default='inactive') + !if (use_cn .and. use_crop )then + this%t_a5min_patch(begp:endp) = spval + call hist_addfld1d (fname='A5TMIN', units='K', & + avgflag='A', long_name='5-day running mean of min 2-m temperature', & + ptr_patch=this%t_a5min_patch, default='inactive') + !end if if (use_cn .and. use_crop )then this%t_a10min_patch(begp:endp) = spval @@ -1163,6 +1167,12 @@ subroutine InitAccBuffer (this, bounds) call init_accum_field (name='T10', units='K', & desc='10-day running mean of 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8) + call init_accum_field (name='SOIL10', units='K', & + desc='10-day running mean of 3rd layer soil temp.', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ) + call init_accum_field (name='TDM5', units='K', & + desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & + subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) if ( use_crop )then call init_accum_field (name='TDM10', units='K', & @@ -1248,7 +1258,12 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('T10', rbufslp, nstep) this%t_a10_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('SOIL10', rbufslp, nstep) + this%t_a10_patch(begp:endp) = rbufslp(begp:endp) + call extract_accum_field ('TDM5', rbufslp, nstep) + this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) if (use_crop) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) @@ -1432,6 +1447,22 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) + + do p = begp,endp + c = patch%column(p) + rbufslp(p) = this%t_soisno_col(c,3) + end do + call update_accum_field ('SOIL10', rbufslp, nstep) + call extract_accum_field ('SOIL10', this%soila10_patch, nstep) + + ! Accumulate and extract TDM5 + + do p = begp,endp + rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? + if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& + end do !'min_inst' not initialized? + call update_accum_field ('TDM5', rbufslp, nstep) + call extract_accum_field ('TDM5', this%t_a5min_patch, nstep) if ( use_crop )then ! Accumulate and extract TDM10 @@ -1443,14 +1474,7 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('TDM10', rbufslp, nstep) call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) - ! Accumulate and extract TDM5 - do p = begp,endp - rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? - if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& - end do !'min_inst' not initialized? - call update_accum_field ('TDM5', rbufslp, nstep) - call extract_accum_field ('TDM5', this%t_a5min_patch, nstep) ! Accumulate and extract GDD0 diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 21cc9d283b..9b07ceb847 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -38,6 +38,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) + real(r8), pointer :: snow_10day (:) ! col snow height 10 day avg real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] @@ -86,6 +87,9 @@ module WaterDiagnosticBulkType procedure, private :: InitBulkAllocate procedure, private :: InitBulkHistory procedure, private :: InitBulkCold + procedure, private :: InitAccBuffer + procedure, private :: InitAccVars + procedure, private :: UpdateAccVars procedure, private :: RestartBackcompatIssue783 end type waterdiagnosticbulk_type @@ -176,6 +180,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan + allocate(this%snow_10day (begc:endc)) ; this%snow_10day (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan @@ -400,6 +405,14 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('snow height of snow covered area'), & ptr_col=this%snow_depth_col, c2l_scale_type='urbanf') + !lbirch: added lagged snow depth variable + this%snow_10day(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('SNOW_10D'), & + units='m', & + avgflag='A', & + long_name=this%info%lname('10day snow avg'), & + ptr_col=this%snow_10day, c2l_scale_type='urbanf') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & @@ -507,8 +520,109 @@ subroutine InitBulkHistory(this, bounds) ptr_patch=this%qflx_prec_intr_patch, set_lake=0._r8) end subroutine InitBulkHistory + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! + ! !USES + use clm_varcon , only : spval + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(waterdiagnosticbulk_type) :: this + type(bounds_type), intent(in) :: bounds + !--------------------------------------------------------------------- + + !lbirch added 10day avg + call init_accum_field (name='SNOW_10D', units='m', & + desc='10-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & + subgrid_type='column', numlev=1, init_value=0._r8) + + + end subroutine InitAccBuffer !----------------------------------------------------------------------- + subroutine InitAccVars (this, bounds) + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES + use accumulMod , only : extract_accum_field + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(waterdiagnosticbulk_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + begc = bounds%begc; endc = bounds%endc + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begc:endc), stat=ier) + + ! Determine time step + nstep = get_nstep() + !lbirch added + call extract_accum_field ('SNOW_10D', rbufslp, nstep) + this%snow_10day(begc:endc) = rbufslp(begc:endc) + + deallocate(rbufslp) + + end subroutine InitAccVars + +!----------------------------------------------------------------------- + subroutine UpdateAccVars (this, bounds) + ! + ! USES + use clm_time_manager, only : get_nstep + use accumulMod , only : update_accum_field, extract_accum_field + ! + ! !ARGUMENTS: + class(waterdiagnosticbulk_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c ! indices + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: ier ! error status + integer :: begc, endc + real(r8), pointer :: rbufslp(:) ! temporary single level - patch level + !--------------------------------------------------------------------- + !added by lbirch for snow + begc = bounds%begc; endc = bounds%endc + + nstep = get_nstep() + + ! Allocate needed dynamic memory for single level patch field + + allocate(rbufslp(begc:endc), stat=ier) + + ! Accumulate and extract snow 10 day + call update_accum_field ('SNOW_10D', this%snow_depth_col, nstep) + call extract_accum_field ('SNOW_10D', this%snow_10day, nstep) + + + deallocate(rbufslp) + + end subroutine UpdateAccVars + + + !----------------------------------------------------------------------- + subroutine InitBulkCold(this, bounds, & snow_depth_input_col, h2osno_input_col) ! @@ -656,6 +770,14 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil long_name=this%info%lname('snow depth'), & units='m', & interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col) + !lbirch added 10 day snow + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('SNOW_10D'), & + xtype=ncd_double, & + dim1name='column', & + long_name=this%info%lname('10 day snow height'), & + units='m', & + interpinic_flag='interp', readvar=readvar, data=this%snow_10day) call restartvar(ncid=ncid, flag=flag, & varname=this%info%fname('frac_sno_eff'), & From d91b2eea3c4ff1f30a2e94657c9cc9a5a3601dd7 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Sat, 21 Mar 2020 11:25:30 -0400 Subject: [PATCH 002/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 33 +++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 400d46e11a..d32a3fc137 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -299,7 +299,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & call CNSeasonDecidPhenology(num_soilp, filter_soilp, & temperature_inst, cnveg_state_inst, dgvs_inst, & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, waterstatebulk_inst) call CNStressDecidPhenology(num_soilp, filter_soilp, & soilstate_inst, temperature_inst, atm2lnd_inst, wateratm2lndbulk_inst, cnveg_state_inst, & @@ -670,7 +670,8 @@ end subroutine CNEvergreenPhenology !----------------------------------------------------------------------- subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & temperature_inst, cnveg_state_inst, dgvs_inst , & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + waterstatebulk_inst) ! ! !DESCRIPTION: ! For coupled carbon-nitrogen code (CN). @@ -692,12 +693,15 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst ! ! !LOCAL VARIABLES: integer :: g,c,p !indices integer :: fp !lake filter patch index real(r8):: ws_flag !winter-summer solstice flag (0 or 1) real(r8):: crit_onset_gdd !critical onset growing degree-day sum + real(r8):: crit_daylbirch !latitudinal gradient in arctic-boreal + real(r8):: onset_thresh !lbirch: flag onset threshold real(r8):: soilt !----------------------------------------------------------------------- @@ -780,7 +784,10 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] - deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + t10 => temperature_inst%soila10_patch , & ! Output: [real(r8) (:) ] + tmin10 => temperature_inst%t_a10min_patch , & ! Output: [real(r8) (:) ] + snow_depth => waterstate_inst%snow_10day & ! Output: [real(r8) (:) ] ) ! start patch loop @@ -907,13 +914,21 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday end if + !seperate into Arctic boreal and lower latitudes + if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then + onset_thresh=1.0_r8 + else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ .and. tmin10(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_depth(c)<0.1_r8) then + onset_thresh=1.0_r8 + end if + ! set onset_flag if critical growing degree-day sum is exceeded - if (onset_gdd(p) > crit_onset_gdd) then + if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 dormant_flag(p) = 0.0_r8 onset_gddflag(p) = 0.0_r8 onset_gdd(p) = 0.0_r8 + onset_thresh = 0.0_r8 onset_counter(p) = ndays_on * secspday ! move all the storage pools into transfer pools, @@ -954,9 +969,15 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & days_active(p) = days_active(p) + fracday if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if - + ! use 15 hr max to ~11hours in temperate regions ! only begin to test for offset daylength once past the summer sol - if (ws_flag == 0._r8 .and. dayl(g) < crit_dayl) then + crit_daylbirch=54000-360*(65-grc%latdeg(g)) + if (crit_daylbirch < crit_dayl) then + crit_daylbirch = crit_dayl + end if + + !print*,'lbirch',crit_daylbirch + if (ws_flag == 0._r8 .and. dayl(g) < crit_daylbirch) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday prev_leafc_to_litter(p) = 0._r8 From 8a5252e784590c25460b7415da199a00ee39824b Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Sat, 21 Mar 2020 11:36:02 -0400 Subject: [PATCH 003/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index d32a3fc137..0b7239b8c4 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -786,7 +786,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] t10 => temperature_inst%soila10_patch , & ! Output: [real(r8) (:) ] - tmin10 => temperature_inst%t_a10min_patch , & ! Output: [real(r8) (:) ] + tmin5 => temperature_inst%t_a5min_patch , & ! Output: [real(r8) (:) ] snow_depth => waterstate_inst%snow_10day & ! Output: [real(r8) (:) ] ) @@ -917,7 +917,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & !seperate into Arctic boreal and lower latitudes if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ .and. tmin10(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_depth(c)<0.1_r8) then + else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ .and. tmin5(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_depth(c)<0.1_r8) then onset_thresh=1.0_r8 end if From 6432dd2bffd01ee8c75eceb505435ef4fd182653 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Tue, 24 Mar 2020 13:20:41 -0400 Subject: [PATCH 004/219] Add files via upload --- src/biogeophys/LunaMod.F90 | 4 +-- src/biogeophys/PhotosynthesisMod.F90 | 2 -- src/biogeophys/TemperatureType.F90 | 3 +- src/biogeophys/WaterDiagnosticBulkType.F90 | 35 ++++++++++------------ 4 files changed, 19 insertions(+), 25 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 3ff3fade55..f451327f0d 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -820,12 +820,12 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR real(r8), intent (in) :: PNetold !old value of the proportion of nitrogen allocated to electron transport (unitless) real(r8), intent (in) :: PNrespold !old value of the proportion of nitrogen allocated to respiration (unitless) real(r8), intent (in) :: PNcbold !old value of the proportion of nitrogen allocated to carboxylation (unitless) + real(r8), intent (in) :: dayl_factor !daylight scale factor real(r8), intent (out):: PNstoreopt !optimal proportion of nitrogen for storage real(r8), intent (out):: PNlcopt !optimal proportion of nitrogen for light capture real(r8), intent (out):: PNetopt !optimal proportion of nitrogen for electron transport real(r8), intent (out):: PNrespopt !optimal proportion of nitrogen for respiration real(r8), intent (out):: PNcbopt !optial proportion of nitrogen for carboxyaltion - real(r8), intent(in) :: dayl_factor !lbirch: added to scaled light: !------------------------------------------------------------------------------------------------------------------------------- !intermediate variables real(r8) :: Carboncost1 !absolute amount of carbon cost associated with maintenance respiration due to deccrease in light capture nitrogen(g dry mass per day) @@ -1256,7 +1256,7 @@ subroutine NUE(O2a, ci, tgrow, tleaf, NUEj,NUEc,Kj2Kc) real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model real(r8) :: c_p !CO2 compenstation point (Pa) - Fc = VcmxTLenuning(tgrow, tleaf) * Fc25 + Fc = VcmxTLeuning(tgrow, tleaf) * Fc25 Fj = JmxTLeuning(tgrow, tleaf) * Fj25 k_c = params_inst%kc25_coef * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) k_o = params_inst%ko25_coef * exp((36380.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 11249d534c..b1a3205be8 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -3176,8 +3176,6 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & ! Adjust for temperature vcmaxse = 486.0_r8 jmaxse = 495.0_r8 - !vcmaxse = 668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) - !jmaxse = 659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) tpuse = vcmaxse vcmaxc = fth25 (vcmaxhd, vcmaxse) jmaxc = fth25 (jmaxhd, jmaxse) diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 4949c5f24b..4b52472fb4 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -55,6 +55,7 @@ module TemperatureType real(r8), pointer :: thv_col (:) ! col virtual potential temperature (kelvin) real(r8), pointer :: thm_patch (:) ! patch intermediate variable (forc_t+0.0098*forc_hgt_t_patch) real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: soila10_patch (:) ! patch 10-day running mean of the soil layer 3 temperature (K) real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature real(r8), pointer :: t_a5min_patch (:) ! patch 5-day running mean of min 2-m temperature @@ -1260,7 +1261,7 @@ subroutine InitAccVars(this, bounds) this%t_a10_patch(begp:endp) = rbufslp(begp:endp) call extract_accum_field ('SOIL10', rbufslp, nstep) - this%t_a10_patch(begp:endp) = rbufslp(begp:endp) + this%soila10_patch(begp:endp) = rbufslp(begp:endp) call extract_accum_field ('TDM5', rbufslp, nstep) this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 9b07ceb847..b746e689cf 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -38,7 +38,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) - real(r8), pointer :: snow_10day (:) ! col snow height 10 day avg + real(r8), pointer :: snow_5day (:) ! col snow height 5 day avg real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] @@ -180,7 +180,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan - allocate(this%snow_10day (begc:endc)) ; this%snow_10day (:) = nan + allocate(this%snow_5day (begc:endc)) ; this%snow_5day (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan @@ -405,14 +405,13 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('snow height of snow covered area'), & ptr_col=this%snow_depth_col, c2l_scale_type='urbanf') - !lbirch: added lagged snow depth variable - this%snow_10day(begc:endc) = spval + this%snow_5day(begc:endc) = spval call hist_addfld1d ( & - fname=this%info%fname('SNOW_10D'), & + fname=this%info%fname('SNOW_5D'), & units='m', & avgflag='A', & - long_name=this%info%lname('10day snow avg'), & - ptr_col=this%snow_10day, c2l_scale_type='urbanf') + long_name=this%info%lname('5day snow avg'), & + ptr_col=this%snow_5day, c2l_scale_type='urbanf') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & @@ -538,9 +537,8 @@ subroutine InitAccBuffer (this, bounds) type(bounds_type), intent(in) :: bounds !--------------------------------------------------------------------- - !lbirch added 10day avg - call init_accum_field (name='SNOW_10D', units='m', & - desc='10-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & + call init_accum_field (name='SNOW_5D', units='m', & + desc='5-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & subgrid_type='column', numlev=1, init_value=0._r8) @@ -575,9 +573,8 @@ subroutine InitAccVars (this, bounds) ! Determine time step nstep = get_nstep() - !lbirch added - call extract_accum_field ('SNOW_10D', rbufslp, nstep) - this%snow_10day(begc:endc) = rbufslp(begc:endc) + call extract_accum_field ('SNOW_5D', rbufslp, nstep) + this%snow_5day(begc:endc) = rbufslp(begc:endc) deallocate(rbufslp) @@ -602,7 +599,6 @@ subroutine UpdateAccVars (this, bounds) integer :: begc, endc real(r8), pointer :: rbufslp(:) ! temporary single level - patch level !--------------------------------------------------------------------- - !added by lbirch for snow begc = bounds%begc; endc = bounds%endc nstep = get_nstep() @@ -612,8 +608,8 @@ subroutine UpdateAccVars (this, bounds) allocate(rbufslp(begc:endc), stat=ier) ! Accumulate and extract snow 10 day - call update_accum_field ('SNOW_10D', this%snow_depth_col, nstep) - call extract_accum_field ('SNOW_10D', this%snow_10day, nstep) + call update_accum_field ('SNOW_5D', this%snow_depth_col, nstep) + call extract_accum_field ('SNOW_5D', this%snow_5day, nstep) deallocate(rbufslp) @@ -770,14 +766,13 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil long_name=this%info%lname('snow depth'), & units='m', & interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col) - !lbirch added 10 day snow call restartvar(ncid=ncid, flag=flag, & - varname=this%info%fname('SNOW_10D'), & + varname=this%info%fname('SNOW_5D'), & xtype=ncd_double, & dim1name='column', & - long_name=this%info%lname('10 day snow height'), & + long_name=this%info%lname('5 day snow height'), & units='m', & - interpinic_flag='interp', readvar=readvar, data=this%snow_10day) + interpinic_flag='interp', readvar=readvar, data=this%snow_5day) call restartvar(ncid=ncid, flag=flag, & varname=this%info%fname('frac_sno_eff'), & From 35b709863fbf80b91176ca89545fff859b8b7106 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Tue, 24 Mar 2020 13:21:10 -0400 Subject: [PATCH 005/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 0b7239b8c4..c6d2ce7498 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -700,8 +700,8 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer :: fp !lake filter patch index real(r8):: ws_flag !winter-summer solstice flag (0 or 1) real(r8):: crit_onset_gdd !critical onset growing degree-day sum - real(r8):: crit_daylbirch !latitudinal gradient in arctic-boreal - real(r8):: onset_thresh !lbirch: flag onset threshold + real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal + real(r8):: onset_thresh !flag onset threshold real(r8):: soilt !----------------------------------------------------------------------- @@ -714,6 +714,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + t10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] + tmin10 => temperature_inst%t_a10min_patch , & ! input: [real(r8) (:) ] + snow5d => waterdiagnosticbulk_inst%snow_5day , & ! input: [real(r8) (:) ] pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics @@ -784,10 +787,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] - deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] - t10 => temperature_inst%soila10_patch , & ! Output: [real(r8) (:) ] - tmin5 => temperature_inst%t_a5min_patch , & ! Output: [real(r8) (:) ] - snow_depth => waterstate_inst%snow_10day & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch & ! Output: [real(r8) (:) ] ) ! start patch loop @@ -914,10 +914,12 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday end if - !seperate into Arctic boreal and lower latitudes + !separate into Arctic boreal and lower latitudes if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ .and. tmin5(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_depth(c)<0.1_r8) then + else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ & + .and. tmin10(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 & + .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow5d(c)<0.1_r8) then onset_thresh=1.0_r8 end if @@ -971,13 +973,12 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & end if ! use 15 hr max to ~11hours in temperate regions ! only begin to test for offset daylength once past the summer sol - crit_daylbirch=54000-360*(65-grc%latdeg(g)) - if (crit_daylbirch < crit_dayl) then - crit_daylbirch = crit_dayl + crit_daylat=54000-360*(65-grc%latdeg(g)) + if (crit_daylat < crit_dayl) then + crit_daylat = crit_dayl end if - !print*,'lbirch',crit_daylbirch - if (ws_flag == 0._r8 .and. dayl(g) < crit_daylbirch) then + if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday prev_leafc_to_litter(p) = 0._r8 From 298235a7af19a24f0586930033dbb2265597e8fe Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Tue, 31 Mar 2020 17:03:45 -0400 Subject: [PATCH 006/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index c6d2ce7498..866285cc13 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -298,8 +298,8 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNSeasonDecidPhenology(num_soilp, filter_soilp, & - temperature_inst, cnveg_state_inst, dgvs_inst, & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, waterstatebulk_inst) + temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNStressDecidPhenology(num_soilp, filter_soilp, & soilstate_inst, temperature_inst, atm2lnd_inst, wateratm2lndbulk_inst, cnveg_state_inst, & @@ -669,9 +669,8 @@ end subroutine CNEvergreenPhenology !----------------------------------------------------------------------- subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & - temperature_inst, cnveg_state_inst, dgvs_inst , & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & - waterstatebulk_inst) + temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: ! For coupled carbon-nitrogen code (CN). @@ -687,13 +686,13 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(temperature_type) , intent(in) :: temperature_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(dgvs_type) , intent(inout) :: dgvs_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst - type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst ! ! !LOCAL VARIABLES: integer :: g,c,p !indices @@ -714,9 +713,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) - t10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] - tmin10 => temperature_inst%t_a10min_patch , & ! input: [real(r8) (:) ] - snow5d => waterdiagnosticbulk_inst%snow_5day , & ! input: [real(r8) (:) ] + soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] + t_a10min => temperature_inst%t_a10min_patch , & ! input: [real(r8) (:) ] + snow_5day => waterdiagnosticbulk_inst%snow_5day , & ! input: [real(r8) (:) ] pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics @@ -917,9 +916,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & !separate into Arctic boreal and lower latitudes if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. t10(p) > SHR_CONST_TKFRZ & - .and. tmin10(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 & - .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow5d(c)<0.1_r8) then + else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ & + .and. t_a10min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 & + .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then onset_thresh=1.0_r8 end if @@ -971,13 +970,12 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & days_active(p) = days_active(p) + fracday if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if - ! use 15 hr max to ~11hours in temperate regions - ! only begin to test for offset daylength once past the summer sol - crit_daylat=54000-360*(65-grc%latdeg(g)) + ! use 15 hr at 65N from eitel 2019, to ~11hours in temperate regions + crit_daylat=54000-720*(65-abs(grc%latdeg(g))) if (crit_daylat < crit_dayl) then crit_daylat = crit_dayl end if - + ! only begin to test for offset daylength once past the summer sol if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday From 0f0305a09e6e54cd04aab215c23ee4511e288a2b Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Tue, 31 Mar 2020 17:05:09 -0400 Subject: [PATCH 007/219] Add files via upload --- src/biogeophys/LunaMod.F90 | 6 ++--- src/biogeophys/PhotosynthesisMod.F90 | 1 - src/biogeophys/TemperatureType.F90 | 8 +------ src/biogeophys/WaterDiagnosticBulkType.F90 | 26 ++++------------------ 4 files changed, 8 insertions(+), 33 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index f451327f0d..1c9234514b 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -404,7 +404,7 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & PNcbold = 0.0_r8 call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & tair10, tleafd10, tleafn10, & - Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, & + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, dayl_factor(p),& PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) vcmx25_opt= PNcbopt * FNCa * Fc25 jmx25_opt= PNetopt * FNCa * Fj25 @@ -797,8 +797,8 @@ end subroutine Clear24_Climate_LUNA !Use the LUNA model to calculate the Nitrogen partioning subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PARimx10,rb10, hourpd, tair10, tleafd10, tleafn10, & Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp,& - PNlcold, PNetold, PNrespold, PNcbold, & - PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt, dayl_factor) + PNlcold, PNetold, PNrespold, PNcbold, dayl_factor,& + PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) implicit none real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) real(r8), intent (in) :: forc_pbot10 !10-day mean air pressure (Pa) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index b1a3205be8..c94069ce6c 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -1245,7 +1245,6 @@ subroutine Photosynthesis ( bounds, fn, filterp, & ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 - kcha = 79430._r8 koha = 36380._r8 cpha = 37830._r8 diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 4b52472fb4..b54c24af9a 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -459,12 +459,11 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) call hist_addfld1d (fname='SOIL10', units='K', & avgflag='A', long_name='10-day running mean of 3rd layer soil', & ptr_patch=this%soila10_patch, default='inactive') - !if (use_cn .and. use_crop )then + this%t_a5min_patch(begp:endp) = spval call hist_addfld1d (fname='A5TMIN', units='K', & avgflag='A', long_name='5-day running mean of min 2-m temperature', & ptr_patch=this%t_a5min_patch, default='inactive') - !end if if (use_cn .and. use_crop )then this%t_a10min_patch(begp:endp) = spval @@ -1180,9 +1179,6 @@ subroutine InitAccBuffer (this, bounds) desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) - call init_accum_field (name='TDM5', units='K', & - desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & - subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) end if if ( use_crop )then @@ -1269,8 +1265,6 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) - call extract_accum_field ('TDM5', rbufslp, nstep) - this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) end if ! Initialize variables that are to be time accumulated diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index b746e689cf..d0c297633d 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -38,7 +38,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) - real(r8), pointer :: snow_5day (:) ! col snow height 5 day avg + real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] @@ -180,7 +180,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan - allocate(this%snow_5day (begc:endc)) ; this%snow_5day (:) = nan + allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan @@ -561,22 +561,16 @@ subroutine InitAccVars (this, bounds) type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: - integer :: begc, endc integer :: nstep integer :: ier - real(r8), pointer :: rbufslp(:) ! temporary !--------------------------------------------------------------------- - begc = bounds%begc; endc = bounds%endc ! Allocate needed dynamic memory for single level patch field - allocate(rbufslp(begc:endc), stat=ier) ! Determine time step nstep = get_nstep() - call extract_accum_field ('SNOW_5D', rbufslp, nstep) - this%snow_5day(begc:endc) = rbufslp(begc:endc) + call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) - deallocate(rbufslp) end subroutine InitAccVars @@ -596,23 +590,18 @@ subroutine UpdateAccVars (this, bounds) integer :: dtime ! timestep size [seconds] integer :: nstep ! timestep number integer :: ier ! error status - integer :: begc, endc - real(r8), pointer :: rbufslp(:) ! temporary single level - patch level !--------------------------------------------------------------------- - begc = bounds%begc; endc = bounds%endc nstep = get_nstep() ! Allocate needed dynamic memory for single level patch field - allocate(rbufslp(begc:endc), stat=ier) ! Accumulate and extract snow 10 day call update_accum_field ('SNOW_5D', this%snow_depth_col, nstep) - call extract_accum_field ('SNOW_5D', this%snow_5day, nstep) + call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) - deallocate(rbufslp) end subroutine UpdateAccVars @@ -766,13 +755,6 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil long_name=this%info%lname('snow depth'), & units='m', & interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col) - call restartvar(ncid=ncid, flag=flag, & - varname=this%info%fname('SNOW_5D'), & - xtype=ncd_double, & - dim1name='column', & - long_name=this%info%lname('5 day snow height'), & - units='m', & - interpinic_flag='interp', readvar=readvar, data=this%snow_5day) call restartvar(ncid=ncid, flag=flag, & varname=this%info%fname('frac_sno_eff'), & From 2093b5de73030287cb7a3b802c72896c4a64827a Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 00:15:53 -0400 Subject: [PATCH 008/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 130 +++++++++++------------------- 1 file changed, 45 insertions(+), 85 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 866285cc13..8b3e305a47 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -29,13 +29,13 @@ module CNPhenologyMod use pftconMod , only : pftcon use SoilStateType , only : soilstate_type use TemperatureType , only : temperature_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use ColumnType , only : col + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use initVerticalMod , only : find_soil_layer_containing_depth + use ColumnType , only : col use GridcellType , only : grc use PatchType , only : patch use atm2lndType , only : atm2lnd_type - use atm2lndType , only : atm2lnd_type ! implicit none private @@ -59,6 +59,7 @@ module CNPhenologyMod real(r8) :: crit_offset_swi ! critical number of water stress days to initiate offset real(r8) :: soilpsi_off ! critical soil water potential for leaf offset real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + real(r8) :: phenology_soil_depth ! soil depth used for measuring states for phenology triggers end type params_type type(params_type) :: params_inst @@ -76,6 +77,7 @@ module CNPhenologyMod real(r8) :: crit_offset_swi ! water stress days for offset trigger real(r8) :: soilpsi_off ! water potential for offset trigger (MPa) real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + integer :: phenology_soil_layer ! soil layer used for measuring states for phenology triggers ! CropPhenology variables and constants real(r8) :: p1d, p1v ! photoperiod factor constants for crop vernalization @@ -164,77 +166,29 @@ subroutine readParams ( ncid ) ! !DESCRIPTION: ! ! !USES: - use ncdio_pio , only: file_desc_t,ncd_io + use ncdio_pio , only: file_desc_t + use paramUtilMod , only : readNcdioScalar ! !ARGUMENTS: implicit none type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id ! ! !LOCAL VARIABLES: - character(len=32) :: subname = 'CNPhenolParamsType' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading + character(len=*), parameter :: subname = 'readParams_CNPhenology' !----------------------------------------------------------------------- - ! - ! read in parameters - ! - tString='crit_dayl' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%crit_dayl=tempr - - tString='ndays_on' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%ndays_on=tempr - - tString='ndays_off' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%ndays_off=tempr - - tString='fstor2tran' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%fstor2tran=tempr - - tString='crit_onset_fdd' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%crit_onset_fdd=tempr - - tString='crit_onset_swi' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%crit_onset_swi=tempr - - tString='soilpsi_on' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%soilpsi_on=tempr - - tString='crit_offset_fdd' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%crit_offset_fdd=tempr - - tString='crit_offset_swi' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%crit_offset_swi=tempr - - tString='soilpsi_off' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%soilpsi_off=tempr - - tString='lwtop_ann' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - params_inst%lwtop=tempr + call readNcdioScalar(ncid, 'crit_dayl', subname, params_inst%crit_dayl) + call readNcdioScalar(ncid, 'ndays_on', subname, params_inst%ndays_on) + call readNcdioScalar(ncid, 'ndays_off', subname, params_inst%ndays_off) + call readNcdioScalar(ncid, 'fstor2tran', subname, params_inst%fstor2tran) + call readNcdioScalar(ncid, 'crit_onset_fdd', subname, params_inst%crit_onset_fdd) + call readNcdioScalar(ncid, 'crit_onset_swi', subname, params_inst%crit_onset_swi) + call readNcdioScalar(ncid, 'soilpsi_on', subname, params_inst%soilpsi_on) + call readNcdioScalar(ncid, 'crit_offset_fdd', subname, params_inst%crit_offset_fdd) + call readNcdioScalar(ncid, 'crit_offset_swi', subname, params_inst%crit_offset_swi) + call readNcdioScalar(ncid, 'soilpsi_off', subname, params_inst%soilpsi_off) + call readNcdioScalar(ncid, 'lwtop_ann', subname, params_inst%lwtop) + call readNcdioScalar(ncid, 'phenology_soil_depth', subname, params_inst%phenology_soil_depth) end subroutine readParams @@ -298,7 +252,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNSeasonDecidPhenology(num_soilp, filter_soilp, & - temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst, & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst, & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNStressDecidPhenology(num_soilp, filter_soilp, & @@ -376,6 +330,10 @@ subroutine CNPhenologyInit(bounds) ! set transfer parameters fstor2tran=params_inst%fstor2tran + call find_soil_layer_containing_depth( & + depth = params_inst%phenology_soil_depth, & + layer = phenology_soil_layer) + ! ----------------------------------------- ! Constants for CNStressDecidPhenology ! ----------------------------------------- @@ -669,7 +627,7 @@ end subroutine CNEvergreenPhenology !----------------------------------------------------------------------- subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & - temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst , & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst , & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: @@ -686,7 +644,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(temperature_type) , intent(in) :: temperature_inst - type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(dgvs_type) , intent(inout) :: dgvs_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst @@ -699,7 +657,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer :: fp !lake filter patch index real(r8):: ws_flag !winter-summer solstice flag (0 or 1) real(r8):: crit_onset_gdd !critical onset growing degree-day sum - real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal + real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal real(r8):: onset_thresh !flag onset threshold real(r8):: soilt !----------------------------------------------------------------------- @@ -714,9 +672,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] - t_a10min => temperature_inst%t_a10min_patch , & ! input: [real(r8) (:) ] - snow_5day => waterdiagnosticbulk_inst%snow_5day , & ! input: [real(r8) (:) ] - + t_a5min => temperature_inst%t_a5min_patch , & ! input: [real(r8) (:) ] + snow_5day => waterdiagnosticbulk_inst%snow_5day_col , & ! input: [real(r8) (:) ] + pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Input: [real(r8) (:) ] annual average 2m air temperature (K) @@ -790,6 +748,8 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ) ! start patch loop + + do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) @@ -886,7 +846,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! test for switching from dormant period to growth period if (dormant_flag(p) == 1.0_r8) then - + onset_thresh = 0.0_r8 ! Test to turn on growing degree-day sum, if off. ! switch on the growing degree day sum on the winter solstice @@ -909,20 +869,18 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! if the gdd flag is set, and if the soil is above freezing ! then accumulate growing degree days for onset trigger - soilt = t_soisno(c,3) + soilt = t_soisno(c, phenology_soil_layer) if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday end if !separate into Arctic boreal and lower latitudes if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ & - .and. t_a10min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 & - .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then + else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & + t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & + dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then onset_thresh=1.0_r8 - end if - - + end if ! set onset_flag if critical growing degree-day sum is exceeded if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 @@ -970,12 +928,14 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & days_active(p) = days_active(p) + fracday if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if + ! use 15 hr at 65N from eitel 2019, to ~11hours in temperate regions crit_daylat=54000-720*(65-abs(grc%latdeg(g))) if (crit_daylat < crit_dayl) then crit_daylat = crit_dayl end if - ! only begin to test for offset daylength once past the summer sol + + ! only begin to test for offset daylength once past the summer sol if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday @@ -1140,8 +1100,8 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & g = patch%gridcell(p) if (stress_decid(ivt(p)) == 1._r8) then - soilt = t_soisno(c,3) - psi = soilpsi(c,3) + soilt = t_soisno(c, phenology_soil_layer) + psi = soilpsi(c, phenology_soil_layer) ! onset gdd sum from Biome-BGC, v4.1.2 crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) From 2369a1e5b5104589fc836a855c0787ccd70d17f8 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 00:16:57 -0400 Subject: [PATCH 009/219] Add files via upload --- src/biogeophys/LunaMod.F90 | 12 ++++------ src/biogeophys/PhotosynthesisMod.F90 | 12 +++++----- src/biogeophys/TemperatureType.F90 | 2 ++ src/biogeophys/WaterDiagnosticBulkType.F90 | 27 ++++++++++++++-------- src/biogeophys/WaterType.F90 | 3 +++ 5 files changed, 33 insertions(+), 23 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 1c9234514b..488544d22e 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -404,22 +404,20 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & PNcbold = 0.0_r8 call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & tair10, tleafd10, tleafn10, & - Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, dayl_factor(p),& - PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, PNcbold, & + dayl_factor(p), PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) vcmx25_opt= PNcbopt * FNCa * Fc25 jmx25_opt= PNetopt * FNCa * Fj25 chg = vcmx25_opt-vcmx25_z(p, z) chg_constrn = min(abs(chg),vcmx25_z(p, z)*max_daily_pchg) - vcmx_prevyr(p,z) = vcmx25_z(p,z) vcmx25_z(p, z) = vcmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn - vcmx_prevyr(p,z) = (vcmx_prevyr(p,z)+vcmx25_z(p,z))/2.0_r8 + vcmx_prevyr(p,z) = vcmx25_z(p,z) chg = jmx25_opt-jmx25_z(p, z) chg_constrn = min(abs(chg),jmx25_z(p, z)*max_daily_pchg) - jmx_prevyr(p,z) = jmx25_z(p,z) jmx25_z(p, z) = jmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn - jmx_prevyr(p,z) = (jmx_prevyr(p,z)+jmx25_z(p,z))/2.0_r8 + jmx_prevyr(p,z) = jmx25_z(p,z) PNlc_z(p, z)= PNlcopt @@ -902,7 +900,7 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR jj = 1 tleafd10c = min(max(tleafd10, Trange1), Trange2) !constrain the physiological range tleafn10c = min(max(tleafn10, Trange1), Trange2) !constrain the physiological range - ci = 0.7_r8 * CO2a10 + ci = 0.7_r8 * CO2a10 JmaxCoef = Jmaxb1 * dayl_factor * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & (1.0_r8 - minrelh))) do while (PNlcoldi .NE. PNlc .and. jj < 100) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index c94069ce6c..88ad4e142e 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -183,8 +183,8 @@ module PhotosynthesisMod ! LUNA specific variables real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer - real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year avg - real(r8), pointer, public :: jmx2_prevyr (:,:) ! patch leaf Jmax25 previous year avg + real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year running avg + real(r8), pointer, public :: jmx_prevyr (:,:) ! patch leaf Jmax25 previous year running avg real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) @@ -831,19 +831,19 @@ subroutine Restart(this, bounds, ncid, flag) if(use_luna) then call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='Maximum carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='Maximum carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) call restartvar(ncid=ncid, flag=flag, varname='vcmx_prevyr', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%vcmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='jmx_prevyr', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index b54c24af9a..0648dd5854 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -229,6 +229,7 @@ subroutine InitAllocate(this, bounds) allocate(this%thv_col (begc:endc)) ; this%thv_col (:) = nan allocate(this%thm_patch (begp:endp)) ; this%thm_patch (:) = nan allocate(this%t_a10_patch (begp:endp)) ; this%t_a10_patch (:) = nan + allocate(this%soila10_patch (begp:endp)) ; this%soila10_patch (:) = nan allocate(this%t_a10min_patch (begp:endp)) ; this%t_a10min_patch (:) = nan allocate(this%t_a5min_patch (begp:endp)) ; this%t_a5min_patch (:) = nan @@ -1261,6 +1262,7 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('TDM5', rbufslp, nstep) this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) + if (use_crop) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index d0c297633d..68d0b70b04 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -87,9 +87,9 @@ module WaterDiagnosticBulkType procedure, private :: InitBulkAllocate procedure, private :: InitBulkHistory procedure, private :: InitBulkCold - procedure, private :: InitAccBuffer - procedure, private :: InitAccVars - procedure, private :: UpdateAccVars + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars procedure, private :: RestartBackcompatIssue783 end type waterdiagnosticbulk_type @@ -180,7 +180,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan - allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day (:) = nan + allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day_col (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan @@ -405,13 +405,13 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('snow height of snow covered area'), & ptr_col=this%snow_depth_col, c2l_scale_type='urbanf') - this%snow_5day(begc:endc) = spval + this%snow_5day_col(begc:endc) = spval call hist_addfld1d ( & fname=this%info%fname('SNOW_5D'), & units='m', & avgflag='A', & long_name=this%info%lname('5day snow avg'), & - ptr_col=this%snow_5day, c2l_scale_type='urbanf') + ptr_col=this%snow_5day_col, c2l_scale_type='urbanf') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & @@ -533,10 +533,11 @@ subroutine InitAccBuffer (this, bounds) use accumulMod , only : init_accum_field ! ! !ARGUMENTS: - class(waterdiagnosticbulk_type) :: this + class(waterdiagnosticbulk_type) :: this type(bounds_type), intent(in) :: bounds !--------------------------------------------------------------------- + this%snow_5day_col(bounds%begc:bounds%endc) = spval call init_accum_field (name='SNOW_5D', units='m', & desc='5-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & subgrid_type='column', numlev=1, init_value=0._r8) @@ -561,16 +562,22 @@ subroutine InitAccVars (this, bounds) type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: + integer :: begc, endc integer :: nstep integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary !--------------------------------------------------------------------- + begc = bounds%begc; endc = bounds%endc ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begc:endc), stat=ier) ! Determine time step nstep = get_nstep() - call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) + call extract_accum_field ('SNOW_5D', rbufslp, nstep) + this%snow_5day_col(begc:endc) = rbufslp(begc:endc) + deallocate(rbufslp) end subroutine InitAccVars @@ -582,8 +589,8 @@ subroutine UpdateAccVars (this, bounds) use accumulMod , only : update_accum_field, extract_accum_field ! ! !ARGUMENTS: - class(waterdiagnosticbulk_type) :: this - type(bounds_type) , intent(in) :: bounds + class(waterdiagnosticbulk_type) :: this + type(bounds_type) , intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: c ! indices diff --git a/src/biogeophys/WaterType.F90 b/src/biogeophys/WaterType.F90 index 4744b63085..0bc831987a 100644 --- a/src/biogeophys/WaterType.F90 +++ b/src/biogeophys/WaterType.F90 @@ -665,6 +665,7 @@ subroutine InitAccBuffer(this, bounds) call this%waterfluxbulk_inst%InitAccBuffer(bounds) call this%wateratm2lndbulk_inst%InitAccBuffer(bounds) + call this%waterdiagnosticbulk_inst%InitAccBuffer(bounds) end subroutine InitAccBuffer @@ -685,6 +686,7 @@ subroutine InitAccVars(this, bounds) call this%waterfluxbulk_inst%initAccVars(bounds) call this%wateratm2lndbulk_inst%initAccVars(bounds) + call this%waterdiagnosticbulk_inst%initAccVars(bounds) end subroutine InitAccVars @@ -707,6 +709,7 @@ subroutine UpdateAccVars(this, bounds) call this%waterfluxbulk_inst%UpdateAccVars(bounds) call this%wateratm2lndbulk_inst%UpdateAccVars(bounds) + call this%waterdiagnosticbulk_inst%UpdateAccVars(bounds) end subroutine UpdateAccVars From 557047aac568274de8753e2981e3ba49e562ef26 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 18:24:13 -0400 Subject: [PATCH 010/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 8b3e305a47..9f95f492e9 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -929,10 +929,11 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if - ! use 15 hr at 65N from eitel 2019, to ~11hours in temperate regions + ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions + ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude crit_daylat=54000-720*(65-abs(grc%latdeg(g))) if (crit_daylat < crit_dayl) then - crit_daylat = crit_dayl + crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum end if ! only begin to test for offset daylength once past the summer sol From 82de28b9ddb95e7b564883fb4dd6811f18235cbc Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 19:59:50 -0400 Subject: [PATCH 011/219] Add files via upload From 32d085461dedce486371a91f9b7932c6573da974 Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 20:00:34 -0400 Subject: [PATCH 012/219] Add files via upload From aa0f31f860cfa3590e99d43b32bae2434b550fea Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Mon, 13 Apr 2020 00:16:57 -0400 Subject: [PATCH 013/219] Add files via upload --- src/biogeophys/LunaMod.F90 | 12 ++++------ src/biogeophys/PhotosynthesisMod.F90 | 12 +++++----- src/biogeophys/TemperatureType.F90 | 2 ++ src/biogeophys/WaterDiagnosticBulkType.F90 | 27 ++++++++++++++-------- src/biogeophys/WaterType.F90 | 3 +++ 5 files changed, 33 insertions(+), 23 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 1c9234514b..488544d22e 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -404,22 +404,20 @@ subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & PNcbold = 0.0_r8 call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & tair10, tleafd10, tleafn10, & - Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, dayl_factor(p),& - PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNlcold, PNetold, PNrespold, PNcbold, & + dayl_factor(p), PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) vcmx25_opt= PNcbopt * FNCa * Fc25 jmx25_opt= PNetopt * FNCa * Fj25 chg = vcmx25_opt-vcmx25_z(p, z) chg_constrn = min(abs(chg),vcmx25_z(p, z)*max_daily_pchg) - vcmx_prevyr(p,z) = vcmx25_z(p,z) vcmx25_z(p, z) = vcmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn - vcmx_prevyr(p,z) = (vcmx_prevyr(p,z)+vcmx25_z(p,z))/2.0_r8 + vcmx_prevyr(p,z) = vcmx25_z(p,z) chg = jmx25_opt-jmx25_z(p, z) chg_constrn = min(abs(chg),jmx25_z(p, z)*max_daily_pchg) - jmx_prevyr(p,z) = jmx25_z(p,z) jmx25_z(p, z) = jmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn - jmx_prevyr(p,z) = (jmx_prevyr(p,z)+jmx25_z(p,z))/2.0_r8 + jmx_prevyr(p,z) = jmx25_z(p,z) PNlc_z(p, z)= PNlcopt @@ -902,7 +900,7 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR jj = 1 tleafd10c = min(max(tleafd10, Trange1), Trange2) !constrain the physiological range tleafn10c = min(max(tleafn10, Trange1), Trange2) !constrain the physiological range - ci = 0.7_r8 * CO2a10 + ci = 0.7_r8 * CO2a10 JmaxCoef = Jmaxb1 * dayl_factor * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & (1.0_r8 - minrelh))) do while (PNlcoldi .NE. PNlc .and. jj < 100) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index c94069ce6c..88ad4e142e 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -183,8 +183,8 @@ module PhotosynthesisMod ! LUNA specific variables real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer - real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year avg - real(r8), pointer, public :: jmx2_prevyr (:,:) ! patch leaf Jmax25 previous year avg + real(r8), pointer, public :: vcmx_prevyr (:,:) ! patch leaf Vc,max25 previous year running avg + real(r8), pointer, public :: jmx_prevyr (:,:) ! patch leaf Jmax25 previous year running avg real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) @@ -831,19 +831,19 @@ subroutine Restart(this, bounds, ncid, flag) if(use_luna) then call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='Maximum carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='Maximum carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) call restartvar(ncid=ncid, flag=flag, varname='vcmx_prevyr', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%vcmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='jmx_prevyr', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & - long_name='avg carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + long_name='avg carboxylation rate at 25 celsius for canopy layers', units='umol CO2/m**2/s', & interpinic_flag='interp', readvar=readvar, data=this%jmx_prevyr) call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & dim1name='pft', dim2name='levcan', switchdim=.true., & diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index b54c24af9a..0648dd5854 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -229,6 +229,7 @@ subroutine InitAllocate(this, bounds) allocate(this%thv_col (begc:endc)) ; this%thv_col (:) = nan allocate(this%thm_patch (begp:endp)) ; this%thm_patch (:) = nan allocate(this%t_a10_patch (begp:endp)) ; this%t_a10_patch (:) = nan + allocate(this%soila10_patch (begp:endp)) ; this%soila10_patch (:) = nan allocate(this%t_a10min_patch (begp:endp)) ; this%t_a10min_patch (:) = nan allocate(this%t_a5min_patch (begp:endp)) ; this%t_a5min_patch (:) = nan @@ -1261,6 +1262,7 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('TDM5', rbufslp, nstep) this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) + if (use_crop) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index d0c297633d..68d0b70b04 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -87,9 +87,9 @@ module WaterDiagnosticBulkType procedure, private :: InitBulkAllocate procedure, private :: InitBulkHistory procedure, private :: InitBulkCold - procedure, private :: InitAccBuffer - procedure, private :: InitAccVars - procedure, private :: UpdateAccVars + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars procedure, private :: RestartBackcompatIssue783 end type waterdiagnosticbulk_type @@ -180,7 +180,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan - allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day (:) = nan + allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day_col (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan @@ -405,13 +405,13 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('snow height of snow covered area'), & ptr_col=this%snow_depth_col, c2l_scale_type='urbanf') - this%snow_5day(begc:endc) = spval + this%snow_5day_col(begc:endc) = spval call hist_addfld1d ( & fname=this%info%fname('SNOW_5D'), & units='m', & avgflag='A', & long_name=this%info%lname('5day snow avg'), & - ptr_col=this%snow_5day, c2l_scale_type='urbanf') + ptr_col=this%snow_5day_col, c2l_scale_type='urbanf') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & @@ -533,10 +533,11 @@ subroutine InitAccBuffer (this, bounds) use accumulMod , only : init_accum_field ! ! !ARGUMENTS: - class(waterdiagnosticbulk_type) :: this + class(waterdiagnosticbulk_type) :: this type(bounds_type), intent(in) :: bounds !--------------------------------------------------------------------- + this%snow_5day_col(bounds%begc:bounds%endc) = spval call init_accum_field (name='SNOW_5D', units='m', & desc='5-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & subgrid_type='column', numlev=1, init_value=0._r8) @@ -561,16 +562,22 @@ subroutine InitAccVars (this, bounds) type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: + integer :: begc, endc integer :: nstep integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary !--------------------------------------------------------------------- + begc = bounds%begc; endc = bounds%endc ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begc:endc), stat=ier) ! Determine time step nstep = get_nstep() - call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) + call extract_accum_field ('SNOW_5D', rbufslp, nstep) + this%snow_5day_col(begc:endc) = rbufslp(begc:endc) + deallocate(rbufslp) end subroutine InitAccVars @@ -582,8 +589,8 @@ subroutine UpdateAccVars (this, bounds) use accumulMod , only : update_accum_field, extract_accum_field ! ! !ARGUMENTS: - class(waterdiagnosticbulk_type) :: this - type(bounds_type) , intent(in) :: bounds + class(waterdiagnosticbulk_type) :: this + type(bounds_type) , intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: c ! indices diff --git a/src/biogeophys/WaterType.F90 b/src/biogeophys/WaterType.F90 index 4744b63085..0bc831987a 100644 --- a/src/biogeophys/WaterType.F90 +++ b/src/biogeophys/WaterType.F90 @@ -665,6 +665,7 @@ subroutine InitAccBuffer(this, bounds) call this%waterfluxbulk_inst%InitAccBuffer(bounds) call this%wateratm2lndbulk_inst%InitAccBuffer(bounds) + call this%waterdiagnosticbulk_inst%InitAccBuffer(bounds) end subroutine InitAccBuffer @@ -685,6 +686,7 @@ subroutine InitAccVars(this, bounds) call this%waterfluxbulk_inst%initAccVars(bounds) call this%wateratm2lndbulk_inst%initAccVars(bounds) + call this%waterdiagnosticbulk_inst%initAccVars(bounds) end subroutine InitAccVars @@ -707,6 +709,7 @@ subroutine UpdateAccVars(this, bounds) call this%waterfluxbulk_inst%UpdateAccVars(bounds) call this%wateratm2lndbulk_inst%UpdateAccVars(bounds) + call this%waterdiagnosticbulk_inst%UpdateAccVars(bounds) end subroutine UpdateAccVars From dd0cbecd1607bfdedbd4ddda480c1ac7d8fd2d6f Mon Sep 17 00:00:00 2001 From: lmbirch89 <35340409+lmbirch89@users.noreply.github.com> Date: Wed, 15 Apr 2020 14:12:52 -0600 Subject: [PATCH 014/219] Add files via upload --- src/biogeochem/CNPhenologyMod.F90 | 37 +++++++++++++++++-------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 343809307c..9f95f492e9 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -252,7 +252,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNSeasonDecidPhenology(num_soilp, filter_soilp, & - temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst, & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst, & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNStressDecidPhenology(num_soilp, filter_soilp, & @@ -627,7 +627,7 @@ end subroutine CNEvergreenPhenology !----------------------------------------------------------------------- subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & - temperature_inst, waterstatebulk_inst, cnveg_state_inst, dgvs_inst , & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst , & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: @@ -644,7 +644,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(temperature_type) , intent(in) :: temperature_inst - type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(dgvs_type) , intent(inout) :: dgvs_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst @@ -657,7 +657,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & integer :: fp !lake filter patch index real(r8):: ws_flag !winter-summer solstice flag (0 or 1) real(r8):: crit_onset_gdd !critical onset growing degree-day sum - real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal + real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal real(r8):: onset_thresh !flag onset threshold real(r8):: soilt !----------------------------------------------------------------------- @@ -672,9 +672,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] - t_a10min => temperature_inst%t_a10min_patch , & ! input: [real(r8) (:) ] - snow_5day => waterdiagnosticbulk_inst%snow_5day , & ! input: [real(r8) (:) ] - + t_a5min => temperature_inst%t_a5min_patch , & ! input: [real(r8) (:) ] + snow_5day => waterdiagnosticbulk_inst%snow_5day_col , & ! input: [real(r8) (:) ] + pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Input: [real(r8) (:) ] annual average 2m air temperature (K) @@ -748,6 +748,8 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ) ! start patch loop + + do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) @@ -844,7 +846,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! test for switching from dormant period to growth period if (dormant_flag(p) == 1.0_r8) then - + onset_thresh = 0.0_r8 ! Test to turn on growing degree-day sum, if off. ! switch on the growing degree day sum on the winter solstice @@ -874,13 +876,11 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & !separate into Arctic boreal and lower latitudes if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ & - .and. t_a10min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 & - .and. dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then + else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & + t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & + dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then onset_thresh=1.0_r8 - end if - - + end if ! set onset_flag if critical growing degree-day sum is exceeded if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 @@ -928,12 +928,15 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & days_active(p) = days_active(p) + fracday if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if - ! use 15 hr at 65N from eitel 2019, to ~11hours in temperate regions + + ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions + ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude crit_daylat=54000-720*(65-abs(grc%latdeg(g))) if (crit_daylat < crit_dayl) then - crit_daylat = crit_dayl + crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum end if - ! only begin to test for offset daylength once past the summer sol + + ! only begin to test for offset daylength once past the summer sol if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday From cb7cc80fd56e82eba29901d64ab3d7e1a31b77b8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 23 Apr 2020 12:30:35 -0600 Subject: [PATCH 015/219] Set vxmax/jmax to same as lunadaylbugs branch --- src/biogeophys/PhotosynthesisMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 88ad4e142e..beccb7ddbf 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -330,8 +330,8 @@ subroutine InitAllocate(this, bounds) ! statements. allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 - allocate(this%vcmx_prevyr (begp:endp,1:nlevcan)) ; this%vcmx_prevyr (:,:) = 30._r8 - allocate(this%jmx_prevyr (begp:endp,1:nlevcan)) ; this%jmx_prevyr (:,:) = 60._r8 + allocate(this%vcmx_prevyr (begp:endp,1:nlevcan)) ; this%vcmx_prevyr (:,:) = 85._r8 + allocate(this%jmx_prevyr (begp:endp,1:nlevcan)) ; this%jmx_prevyr (:,:) = 50._r8 allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 From 824b765274bf27d849924680e5a0396e4e477c09 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 23 Apr 2020 13:51:39 -0600 Subject: [PATCH 016/219] Use Kattge instead of Leuning in Luna --- src/biogeophys/LunaMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index 56cae57f6f..7d082435ad 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -904,8 +904,8 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR JmaxCoef = Jmaxb1 * dayl_factor * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & (1.0_r8 - minrelh))) do while (PNlcoldi .NE. PNlc .and. jj < 100) - Fc = VcmxTLeuning(tair10, tleafd10c) * Fc25 - Fj = JmxTLeuning(tair10, tleafd10c) * Fj25 + Fc = VcmxTKattge(tair10, tleafd10c) * Fc25 + Fj = JmxTKattge(tair10, tleafd10c) * Fj25 NUEr = Cv * NUEr25 * (RespTBernacchi(tleafd10c) * hourpd + RespTBernacchi(tleafn10c) * (24.0_r8 - hourpd)) !nitrogen use efficiency for respiration (g biomass/m2/day/g N) !**************************************************** !Nitrogen Allocation Scheme: store the initial value @@ -1058,7 +1058,7 @@ subroutine Nitrogen_investments (KcKjFlag, FNCa, Nlc, forc_pbot10, relh10, & A = (1.0_r8 - theta_cj) * max(Wc, Wj) + theta_cj * min(Wc, Wj) endif PSN = Cv * A * hourpd - Vcmaxnight = VcmxTLeuning(tair10, tleafn10) / VcmxTLeuning(tair10, tleafd10) * Vcmax + Vcmaxnight = VcmxTKattge(tair10, tleafn10) / VcmxTKattge(tair10, tleafd10) * Vcmax RESP = Cv * leaf_mr_vcm * (Vcmax * hourpd + Vcmaxnight * (24.0_r8 - hourpd)) Net = Jmax / Fj Ncb = Vcmax / Fc @@ -1213,8 +1213,8 @@ subroutine NUEref(NUEjref,NUEcref,Kj2Kcref) tgrow = 25.0_r8 tleaf = 25.0_r8 - Fc = VcmxTLeuning(tgrow, tleaf) * Fc25 - Fj = JmxTLeuning(tgrow, tleaf) * Fj25 + Fc = VcmxTKattge(tgrow, tleaf) * Fc25 + Fj = JmxTKattge(tgrow, tleaf) * Fj25 CO2c = co2ref * forc_pbot_ref * 1.0e-6_r8 !pa O2c = O2ref * forc_pbot_ref * 1.0e-6_r8 !pa k_c = params_inst%kc25_coef * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) @@ -1254,8 +1254,8 @@ subroutine NUE(O2a, ci, tgrow, tleaf, NUEj,NUEc,Kj2Kc) real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model real(r8) :: c_p !CO2 compenstation point (Pa) - Fc = VcmxTLeuning(tgrow, tleaf) * Fc25 - Fj = JmxTLeuning(tgrow, tleaf) * Fj25 + Fc = VcmxTKattge(tgrow, tleaf) * Fc25 + Fj = JmxTKattge(tgrow, tleaf) * Fj25 k_c = params_inst%kc25_coef * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) k_o = params_inst%ko25_coef * exp((36380.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) c_p = params_inst%cp25_yr2000 * exp((37830.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) From 9cb8fcf84e83ac4f21aa055b032f018017098863 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 24 Apr 2020 13:56:18 -0600 Subject: [PATCH 017/219] @wweider and @lmbirch89 pointed out that some constants need to change as well for the Kattge vs. Leuning switch --- src/biogeophys/PhotosynthesisMod.F90 | 31 +++++++++++++++++++++------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index beccb7ddbf..5a9edb22d3 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2802,18 +2802,29 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & kcha = 79430._r8 koha = 36380._r8 cpha = 37830._r8 - vcmaxha = 73637._r8 - jmaxha = 50300._r8 - tpuha = 73637._r8 lmrha = 46390._r8 + ! Values to use for Leuning + !vcmaxha = 73637._r8 + !jmaxha = 50300._r8 + !tpuha = 73637._r8 + ! Values to use for Kattge + vcmaxha = 72000._r8 + jmaxha = 50000._r8 + tpuha = 72000._r8 ! High temperature deactivation, from: ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 ! The factor "c" scales the deactivation to a value of 1.0 at 25C - vcmaxhd = 149252._r8 - jmaxhd = 152044._r8 - tpuhd = 149252._r8 + ! Values to use for Leuning + !vcmaxhd = 149252._r8 + !jmaxhd = 152044._r8 + !tpuhd = 149252._r8 + ! Values to use for Kattge + vcmaxhd = 200000._r8 + jmaxhd = 200000._r8 + tpuhd = 200000._r8 + lmrhd = 150650._r8 lmrse = 490._r8 lmrc = fth25 (lmrhd, lmrse) @@ -3173,8 +3184,12 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & kp25_sha = kp25top * nscaler_sha ! Adjust for temperature - vcmaxse = 486.0_r8 - jmaxse = 495.0_r8 + ! Acclimation is done for Kattge + vcmaxse = 668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + jmaxse = 659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + ! These values are used for Leuning + !vcmaxse = 486.0_r8 + !jmaxse = 495.0_r8 tpuse = vcmaxse vcmaxc = fth25 (vcmaxhd, vcmaxse) jmaxc = fth25 (jmaxhd, jmaxse) From 34b6dcc107f40c4ca826a1f24c2ffc8e954c781f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 24 Apr 2020 16:50:28 -0600 Subject: [PATCH 018/219] Updated params file with updated stem_leaf and froot_leaf from Leah --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 825db0fc30..6f6a14572e 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -372,7 +372,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c200402.nc +lnd/clm2/paramdata/clm5_params.c200424.nc lnd/clm2/paramdata/clm_params.c200402.nc From 159d3b039eba2dab7663db10ae27b8b754557d11 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 25 Apr 2020 16:35:07 -0600 Subject: [PATCH 019/219] Point to a new paramsfile the same as @lmbirch89 latest that only changes froot_leaf and stem_leaf for arctic plants. So the file is identical to /glade/work/lbirch/devclm4gitfinal/clm5_params_abz_lbirch_update.nc --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 6f6a14572e..9c57870814 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -372,7 +372,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c200424.nc +lnd/clm2/paramdata/clm5_params.c200425.nc lnd/clm2/paramdata/clm_params.c200402.nc From f1dc3f793d3abd028573b17d22ba314cc90cf4bd Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 7 Jul 2020 12:11:19 -0600 Subject: [PATCH 020/219] Changes to replicate @olyson's case clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_leafcnA_stemleafA_frtlfA_sdt_hist, bring in source mod changes and paramsfile --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- src/biogeochem/CNPhenologyMod.F90 | 22 ++++++++++++++++--- src/main/pftconMod.F90 | 14 ++++++++++++ 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 9c57870814..f73bbbc5e2 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -372,7 +372,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/clm5_params.c200425.nc +/glade/p/cgd/tss/people/oleson/modify_param/clm5_params.c200425.slatopA_leafcnA_stemleafA_frtlfA_sdt_kwo.c200618.nc lnd/clm2/paramdata/clm_params.c200402.nc diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 9f95f492e9..5277a1c1a9 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -669,6 +669,9 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) +!KO + season_decid_temperate => pftcon%season_decid_temperate , & ! Input: binary flag for seasonal-deciduous temperate leaf habit (0 or 1) +!KO t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] @@ -873,14 +876,27 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday end if - !separate into Arctic boreal and lower latitudes - if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then +!KO !separate into Arctic boreal and lower latitudes +!KO if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then +!KO onset_thresh=1.0_r8 +!KO else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & +!KO t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & +!KO dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then +!KO onset_thresh=1.0_r8 +!KO end if +!KO + ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous + ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, + ! boreal broadleaf deciduous tree, boreal broadleaf deciduous shrub, C3 arctic grass) + if (onset_gdd(p) > crit_onset_gdd .and. season_decid_temperate(ivt(p)) == 1) then onset_thresh=1.0_r8 - else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & + else if (season_decid_temperate(ivt(p)) == 0 .and. onset_gddflag(p) == 1.0_r8 .and. & + soila10(p) > SHR_CONST_TKFRZ .and. & t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then onset_thresh=1.0_r8 end if +!KO ! set onset_flag if critical growing degree-day sum is exceeded if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 27a61403bc..40e1d6c08d 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -201,6 +201,9 @@ module pftconMod real(r8), allocatable :: evergreen (:) ! binary flag for evergreen leaf habit (0 or 1) real(r8), allocatable :: stress_decid (:) ! binary flag for stress-deciduous leaf habit (0 or 1) real(r8), allocatable :: season_decid (:) ! binary flag for seasonal-deciduous leaf habit (0 or 1) +!KO + real(r8), allocatable :: season_decid_temperate(:) ! binary flag for seasonal-deciduous temperate leaf habit (0 or 1) +!KO real(r8), allocatable :: pconv (:) ! proportion of deadstem to conversion flux real(r8), allocatable :: pprod10 (:) ! proportion of deadstem to 10-yr product pool real(r8), allocatable :: pprod100 (:) ! proportion of deadstem to 100-yr product pool @@ -410,6 +413,9 @@ subroutine InitAllocate (this) allocate( this%evergreen (0:mxpft) ) allocate( this%stress_decid (0:mxpft) ) allocate( this%season_decid (0:mxpft) ) +!KO + allocate( this%season_decid_temperate (0:mxpft) ) +!KO allocate( this%dwood (0:mxpft) ) allocate( this%root_density (0:mxpft) ) allocate( this%root_radius (0:mxpft) ) @@ -740,6 +746,11 @@ subroutine InitRead(this) call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) +!KO + call ncd_io('season_decid_temperate', this%season_decid_temperate, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) +!KO + call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1335,6 +1346,9 @@ subroutine Clean(this) deallocate( this%evergreen) deallocate( this%stress_decid) deallocate( this%season_decid) +!KO + deallocate( this%season_decid_temperate) +!KO deallocate( this%dwood) deallocate( this%root_density) deallocate( this%root_radius) From 82ed3c1e93cd25aba0d5cd1acae62a7851df107a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 7 Jul 2020 12:19:28 -0600 Subject: [PATCH 021/219] New tuned jmaxb1 value used in the clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_leafcnA_stemleafA_frtlfA_sdt_hist simulation, this changes it for clm5_0, but we should change it so that these changes only apply to ctsm5_1 --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index f73bbbc5e2..ebed9726fe 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -421,7 +421,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. .true. -0.093563 +0.17 .false. .false. From 83e839115710e4d0e1f73222743fae427353266e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 16 Jul 2020 23:32:20 -0600 Subject: [PATCH 022/219] Point to file that also has new field on it season_decid_temperate --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index bc3dd0bdd0..cc2b895194 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -390,7 +390,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c200707.nc +lnd/clm2/paramdata/ctsm51_params.c200716.nc lnd/clm2/paramdata/clm45_params.c200624.nc From 97e5202137656f507c7a9b25487a2b8057d88b7d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 16 Jul 2020 23:42:15 -0600 Subject: [PATCH 023/219] Add in new namelist items for cnphenology control: onset_thresh_depends_on_veg, and min_crtical_dayl_depends_on_lat --- bld/namelist_files/namelist_definition_ctsm.xml | 12 ++++++++++++ src/biogeochem/CNPhenologyMod.F90 | 11 ++++++++--- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index e7bb4b3f60..bb0b0e2761 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1053,6 +1053,18 @@ Initial seed Carbon to use at planting (only used when CN is on as well as crop) + +Phenology onset depends on the vegetation type +(only used when CN is on) + + + +The minimum critical day length for onset depends on latitude +(only used when CN is on) + + Toggle to turn on ozone stress diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index c4b371b16d..c6298c24f4 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -94,7 +94,9 @@ module CNPhenologyMod integer, allocatable :: maxplantjday(:,:) ! maximum planting julian day integer :: jdayyrstart(inSH) ! julian day of start of year - real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting + real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting + logical, private :: min_crtical_dayl_depends_on_lat = .false. ! If critical day-length for onset depends on latitude + logical, private :: onset_thresh_depends_on_veg = .false. ! If onset threshold depends on vegetation type character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -125,7 +127,8 @@ subroutine CNPhenologyReadNML( NLFilename ) character(len=*), parameter :: subname = 'CNPhenologyReadNML' character(len=*), parameter :: nmlname = 'cnphenology' !----------------------------------------------------------------------- - namelist /cnphenology/ initial_seed_at_planting + namelist /cnphenology/ initial_seed_at_planting, onset_thresh_depends_on_veg, & + min_crtical_dayl_depends_on_lat ! Initialize options to default values, in case they are not specified in ! the namelist @@ -146,7 +149,9 @@ subroutine CNPhenologyReadNML( NLFilename ) call relavu( unitn ) end if - call shr_mpi_bcast (initial_seed_at_planting, mpicom) + call shr_mpi_bcast (initial_seed_at_planting, mpicom) + call shr_mpi_bcast (onset_thresh_depends_on_veg, mpicom) + call shr_mpi_bcast (min_crtical_dayl_depends_on_lat, mpicom) if (masterproc) then write(iulog,*) ' ' From 4ceab4df8fff45e1883a43f6999431bc3c316686 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 17 Jul 2020 14:26:22 -0600 Subject: [PATCH 024/219] Enable the namelist items, so that clm50 results can be identical to before --- src/biogeochem/CNPhenologyMod.F90 | 43 +++++++++++++++++++------------ 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index c6298c24f4..5da465cdb7 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -890,19 +890,24 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & !KO onset_thresh=1.0_r8 !KO end if !KO - ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous - ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, - ! boreal broadleaf deciduous tree, boreal broadleaf deciduous shrub, C3 arctic grass) - if (onset_gdd(p) > crit_onset_gdd .and. season_decid_temperate(ivt(p)) == 1) then - onset_thresh=1.0_r8 - else if (season_decid_temperate(ivt(p)) == 0 .and. onset_gddflag(p) == 1.0_r8 .and. & - soila10(p) > SHR_CONST_TKFRZ .and. & - t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & - dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then - onset_thresh=1.0_r8 - end if + if ( onset_thresh_depends_on_veg ) then + ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous + ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, + ! boreal broadleaf deciduous tree, boreal broadleaf deciduous shrub, C3 arctic grass) + if (onset_gdd(p) > crit_onset_gdd .and. season_decid_temperate(ivt(p)) == 1) then + onset_thresh=1.0_r8 + else if (season_decid_temperate(ivt(p)) == 0 .and. onset_gddflag(p) == 1.0_r8 .and. & + soila10(p) > SHR_CONST_TKFRZ .and. & + t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & + dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then + onset_thresh=1.0_r8 + end if + else + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) onset_thresh = 1.0_r8 + end if !KO - ! set onset_flag if critical growing degree-day sum is exceeded + ! If onset is being triggered if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 dormant_flag(p) = 0.0_r8 @@ -950,11 +955,15 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if - ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions - ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude - crit_daylat=54000-720*(65-abs(grc%latdeg(g))) - if (crit_daylat < crit_dayl) then - crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum + if ( min_crtical_dayl_depends_on_lat )then + ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions + ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude + crit_daylat=54000-720*(65-abs(grc%latdeg(g))) + if (crit_daylat < crit_dayl) then + crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum + end if + else + crit_daylat = crit_dayl end if ! only begin to test for offset daylength once past the summer sol From 401b7979186e52919a48b073cfdcebf735882bab Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 17 Jul 2020 14:30:00 -0600 Subject: [PATCH 025/219] Use clm45 and clm50 paramfile that just has the addition of seas_decid_temperate, so we can make sure clm45 and clm50 results are identical --- bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index cc2b895194..d474ffb887 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -390,8 +390,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c200716.nc -lnd/clm2/paramdata/clm45_params.c200624.nc +lnd/clm2/paramdata/clm5_params.c200717.nc +lnd/clm2/paramdata/clm45_params.c200717.nc From 0f4536da6aae91d33ebba6cf04a11382714bcf65 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 17 Jul 2020 15:41:30 -0600 Subject: [PATCH 026/219] Make 5 day snow default inactive so that history file field list will be the same as before --- src/biogeophys/WaterDiagnosticBulkType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 68d0b70b04..8cbce707ae 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -411,7 +411,7 @@ subroutine InitBulkHistory(this, bounds) units='m', & avgflag='A', & long_name=this%info%lname('5day snow avg'), & - ptr_col=this%snow_5day_col, c2l_scale_type='urbanf') + ptr_col=this%snow_5day_col, c2l_scale_type='urbanf', default='inactive') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & From 85e00062ecbddd081fccea214b7e3900c65db1cc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Sep 2020 23:35:48 -0600 Subject: [PATCH 027/219] Set onset_thresh_depends_on_veg and min_crtical_dayl_depends_on_lat to true for ctsm5.1 --- bld/CLMBuildNamelist.pm | 23 +++++++++++++++++++ bld/namelist_files/namelist_defaults_ctsm.xml | 5 ++++ 2 files changed, 28 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index ae53889fa2..2fbb8fa477 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1626,6 +1626,11 @@ sub process_namelist_inline_logic { ################################## setup_logic_bgc_shared($opts, $nl_flags, $definition, $defaults, $nl, $physv); + ################################## + # namelist group: cnphenology + ################################## + setup_logic_cnphenology($opts, $nl_flags, $definition, $defaults, $nl, $physv); + ############################################# # namelist group: soilwater_movement_inparm # ############################################# @@ -2635,6 +2640,24 @@ sub setup_logic_bgc_shared { #------------------------------------------------------------------------------- +sub setup_logic_cnphenology { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my @list = ( "onset_thresh_depends_on_veg", "min_crtical_dayl_depends_on_lat" ); + foreach my $var ( @list ) { + if ( &value_is_true($nl_flags->{'use_cn'}) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'phys'=>$physv->as_string(), 'use_cn'=>$nl_flags->{'use_cn'} ); + } else { + if ( defined($nl->get_value($nl->get_value($var))) ) { + $log->fatal_error("$var should only be set if use_cn is on"); + } + } + } +} + +#------------------------------------------------------------------------------- + sub setup_logic_supplemental_nitrogen { # # Supplemental Nitrogen for prognostic crop cases diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 7a7bbe7ddb..5418372eae 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -541,6 +541,11 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 3.d00 1.d00 + +.true. +.true. +.false. +.false. 0.5 From 936f85d0ebd78312f16bc15c21fdf13a1a974ccf Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 24 Sep 2020 00:04:08 -0600 Subject: [PATCH 028/219] Add test for onset_thresh_depends_on_veg set when use_cn is false and get it to work --- bld/CLMBuildNamelist.pm | 2 +- bld/unit_testers/build-namelist_test.pl | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 2fbb8fa477..17d37a4aac 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2649,7 +2649,7 @@ sub setup_logic_cnphenology { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'phys'=>$physv->as_string(), 'use_cn'=>$nl_flags->{'use_cn'} ); } else { - if ( defined($nl->get_value($nl->get_value($var))) ) { + if ( defined($nl->get_value($var)) ) { $log->fatal_error("$var should only be set if use_cn is on"); } } diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index db441b045c..f647a1026d 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,7 +138,7 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 1516; +my $ntests = 1517; if ( defined($opts{'compare'}) ) { $ntests += 1017; } @@ -446,6 +446,11 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "onset_threh w SP" =>{ options=>" -envxml_dir . -bgc sp", + namelst=>"onset_thresh_depends_on_veg=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, "dribble_crphrv w/o CN" =>{ options=>" -envxml_dir . -bgc sp", namelst=>"dribble_crophrv_xsmrpool_2atm=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", From 6dc9ed93f323f3077a9d2da0186920ce70adaca9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 2 Dec 2020 16:02:46 -0700 Subject: [PATCH 029/219] Remove support for CISM1 As of cism2_1_74, CISM1 is no longer supported, so we don't need to have a PE layout section for it. --- cime_config/config_compsets.xml | 2 +- cime_config/config_pes.xml | 15 --------------- 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index cc947a7439..787750a71c 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -18,7 +18,7 @@ ICE = [CICE, DICE, SICE] OCN = [DOCN, ,AQUAP, SOCN] ROF = [RTM, SROF] - GLC = [CISM1, CISM2] + GLC = [CISM2, SGLC] WAV = [SWAV] BGC = optional BGC scenario diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index 909c0d8049..bf141781ec 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -1190,19 +1190,4 @@ - - - - - - 1 - - - 1 - - - - - - From 654b53dd55145bd374c0b3722485b23be4cff26f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 7 Dec 2020 17:14:05 -0700 Subject: [PATCH 030/219] Grid cell-level error check for H2O: non-transient simulations only Works for non-transient simulations. In this attempt I convert most column-level variables to grid cell-level locally in subr. BalanceCheck. Using grid cell-level variables calculated in subr. lnd2atm did not work because subr. lnd2atm is called after subr. BalanceCheck. --- src/biogeophys/BalanceCheckMod.F90 | 312 +++++++++++++++++++++++++--- src/biogeophys/WaterBalanceType.F90 | 18 +- src/main/clm_driver.F90 | 18 +- src/main/lnd2atmMod.F90 | 4 +- 4 files changed, 315 insertions(+), 37 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index c2d58f711e..bc73b68265 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -11,7 +11,7 @@ module BalanceCheckMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varctl , only : iulog - use clm_varcon , only : namep, namec + use clm_varcon , only : namep, namec, nameg use clm_varpar , only : nlevsoi use GetGlobalValuesMod , only : GetGlobalIndex use atm2lndType , only : atm2lnd_type @@ -23,6 +23,7 @@ module BalanceCheckMod use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type use WaterDiagnosticType, only : waterdiagnostic_type use Wateratm2lndType , only : wateratm2lnd_type +! use Waterlnd2atmType , only : waterlnd2atm_type ! slevis: place holder use WaterBalanceType , only : waterbalance_type use WaterFluxType , only : waterflux_type use WaterType , only : water_type @@ -43,8 +44,9 @@ module BalanceCheckMod ! !PUBLIC MEMBER FUNCTIONS: public :: BalanceCheckInit ! Initialization of Water and energy balance check - public :: BeginWaterBalance ! Initialize water balance check - public :: BalanceCheck ! Water and energy balance check + public :: BeginWaterGridcellBalance ! Initialize grid cell-level water balance check + public :: BeginWaterColumnBalance ! Initialize column-level water balance check + public :: BalanceCheck ! Water & energy balance checks public :: GetBalanceCheckSkipSteps ! Get the number of steps to skip for the balance check public :: BalanceCheckClean ! Clean up for BalanceCheck @@ -54,7 +56,8 @@ module BalanceCheckMod ! ! !PRIVATE MEMBER FUNCTIONS: - private :: BeginWaterBalanceSingle ! Initialize water balance check for bulk or a single tracer + private :: BeginWaterGridcellBalanceSingle ! Initialize grid cell-level water balance check for bulk or a single tracer + private :: BeginWaterColumnBalanceSingle ! Initialize column-level water balance check for bulk or a single tracer character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -120,7 +123,46 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine BeginWaterBalance(bounds, & + subroutine BeginWaterGridcellBalance(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + water_inst, soilhydrology_inst, & + use_aquifer_layer) + ! + ! !DESCRIPTION: + ! Initialize grid cell-level water balance at beginning of time step + ! for bulk water and each water tracer + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(water_type) , intent(inout) :: water_inst + type(soilhydrology_type), intent(in) :: soilhydrology_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'BeginWaterGridcellBalance' + !----------------------------------------------------------------------- + + do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end + call BeginWaterGridcellBalanceSingle(bounds, & + num_nolakec, filter_nolakec, & + num_lakec, filter_lakec, & + soilhydrology_inst, & + water_inst%bulk_and_tracers(i)%waterstate_inst, & + water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & + water_inst%bulk_and_tracers(i)%waterbalance_inst, & + use_aquifer_layer = use_aquifer_layer) + end do + + end subroutine BeginWaterGridcellBalance + + !----------------------------------------------------------------------- + subroutine BeginWaterColumnBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & water_inst, soilhydrology_inst, & use_aquifer_layer) @@ -142,11 +184,11 @@ subroutine BeginWaterBalance(bounds, & ! !LOCAL VARIABLES: integer :: i - character(len=*), parameter :: subname = 'BeginWaterBalance' + character(len=*), parameter :: subname = 'BeginWaterColumnBalance' !----------------------------------------------------------------------- do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end - call BeginWaterBalanceSingle(bounds, & + call BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & soilhydrology_inst, & @@ -156,10 +198,85 @@ subroutine BeginWaterBalance(bounds, & use_aquifer_layer = use_aquifer_layer) end do - end subroutine BeginWaterBalance + end subroutine BeginWaterColumnBalance !----------------------------------------------------------------------- - subroutine BeginWaterBalanceSingle(bounds, & + subroutine BeginWaterGridcellBalanceSingle(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + soilhydrology_inst, waterstate_inst, waterdiagnostic_inst, waterbalance_inst, & + use_aquifer_layer) + ! + ! !DESCRIPTION: + ! Initialize grid cell-level water balance at beginning of time step + ! for bulk or a single tracer + ! + ! !USES: + use subgridAveMod, only: c2g + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + class(waterstate_type) , intent(inout) :: waterstate_inst + class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst + class(waterbalance_type) , intent(inout) :: waterbalance_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc ! indices + integer :: begc, endc, begg, endg ! bounds + !----------------------------------------------------------------------- + + associate( & + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) + wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + begwb_col => waterbalance_inst%begwb_col, & ! Output: [real(r8) (:) ] column-level water mass begining of the time step + begwb_grc => waterbalance_inst%begwb_grc & ! Output: [real(r8) (:) ] grid cell-level water mass begining of the time step + ) + + begc = bounds%begc + endc = bounds%endc + begg = bounds%begg + endg = bounds%endg + + ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake + if(use_aquifer_layer) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%hydrologically_active(c)) then + if(zwt(c) <= zi(c,nlevsoi)) then + wa(c) = aquifer_water_baseline + end if + end if + end do + endif + + ! NOTES subroutines Compute*Mass* are in TotalWaterAndHeatMod.F90 + ! endwb is calculated in HydrologyDrainageMod & LakeHydrologyMod + call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & + waterstate_inst, waterdiagnostic_inst, & + subtract_dynbal_baselines = .false., & + water_mass = begwb_col(begc:endc)) + + call ComputeWaterMassLake(bounds, num_lakec, filter_lakec, & + waterstate_inst, & + subtract_dynbal_baselines = .false., & + water_mass = begwb_col(begc:endc)) + + call c2g(bounds, begwb_col(begc:endc), begwb_grc(begg:endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity') + + end associate + + end subroutine BeginWaterGridcellBalanceSingle + + !----------------------------------------------------------------------- + subroutine BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & soilhydrology_inst, waterstate_inst, waterdiagnostic_inst, waterbalance_inst, & use_aquifer_layer) @@ -223,7 +340,7 @@ subroutine BeginWaterBalanceSingle(bounds, & end associate - end subroutine BeginWaterBalanceSingle + end subroutine BeginWaterColumnBalanceSingle !----------------------------------------------------------------------- subroutine BalanceCheck( bounds, & @@ -231,6 +348,7 @@ subroutine BalanceCheck( bounds, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & surfalb_inst, energyflux_inst, canopystate_inst) +! waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) ! ! !DESCRIPTION: ! This subroutine accumulates the numerical truncation errors of the water @@ -251,7 +369,7 @@ subroutine BalanceCheck( bounds, & use clm_time_manager , only : get_step_size_real, get_nstep use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type - use subgridAveMod + use subgridAveMod ! , only : c2g ? ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -263,6 +381,7 @@ subroutine BalanceCheck( bounds, & class(waterstate_type), intent(in) :: waterstate_inst type(waterdiagnosticbulk_type), intent(in) :: waterdiagnosticbulk_inst class(waterbalance_type), intent(inout) :: waterbalance_inst +! class(waterlnd2atm_type), intent(in) :: waterlnd2atm_inst class(wateratm2lnd_type) , intent(in) :: wateratm2lnd_inst type(surfalb_type) , intent(in) :: surfalb_inst type(energyflux_type) , intent(inout) :: energyflux_inst @@ -277,6 +396,18 @@ subroutine BalanceCheck( bounds, & real(r8) :: forc_rain_col(bounds%begc:bounds%endc) ! column level rain rate [mm/s] real(r8) :: forc_snow_col(bounds%begc:bounds%endc) ! column level snow rate [mm/s] real(r8) :: h2osno_total(bounds%begc:bounds%endc) ! total snow water [mm H2O] + real(r8) :: endwb_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_irrig_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_glcice_dyn_water_flux_locgrc(bounds%begg:bounds%endg) ! water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) + real(r8) :: qflx_evap_tot_locgrc(bounds%begg:bounds%endg) ! grid cell level total evapotranspiration [mm/s] + real(r8) :: qflx_surf_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_drain_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_drain_perched_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_qrgwl_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_ice_runoff_snwcp_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_ice_runoff_xs_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now + real(r8) :: qflx_snwcp_discarded_liq_locgrc(bounds%begg:bounds%endg) ! excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] + real(r8) :: qflx_snwcp_discarded_ice_locgrc(bounds%begg:bounds%endg) ! excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -294,6 +425,9 @@ subroutine BalanceCheck( bounds, & associate( & forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (vis=forc_sols , nir=forc_soll ) forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (vis=forc_solsd, nir=forc_solld) + forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] grid cell-level rain rate [mm/s] + forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] grid cell-level snow rate [mm/s] + qflx_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] total grid cell-level runoff from river model forc_rain => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) @@ -302,10 +436,13 @@ subroutine BalanceCheck( bounds, & frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] effective snow fraction frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) - begwb => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step - errh2o => waterbalance_inst%errh2o_col , & ! Output: [real(r8) (:) ] water conservation error (mm H2O) + begwb_grc => waterbalance_inst%begwb_grc , & ! Input: [real(r8) (:) ] grid cell-level water mass begining of the time step +! endwb_grc => waterbalance_inst%endwb_grc , & ! Output: [real(r8) (:) ] grid cell-level water mass end of the time step + errh2o_grc => waterbalance_inst%errh2o_grc , & ! Output: [real(r8) (:) ] grid cell-level water conservation error (mm H2O) + begwb_col => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] column-level water mass begining of the time step + endwb_col => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] column-level water mass end of the time step + errh2o_col => waterbalance_inst%errh2o_col , & ! Output: [real(r8) (:) ] column-level water conservation error (mm H2O) errh2osno => waterbalance_inst%errh2osno_col , & ! Output: [real(r8) (:) ] error in h2osno (kg m-2) - endwb => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] water mass end of the time step snow_sources => waterbalance_inst%snow_sources_col , & ! Output: [real(r8) (:) ] snow sources (mm H2O /s) snow_sinks => waterbalance_inst%snow_sinks_col , & ! Output: [real(r8) (:) ] snow sinks (mm H2O /s) qflx_liq_grnd_col => waterflux_inst%qflx_liq_grnd_col , & ! Input: [real(r8) (:) ] liquid on ground after interception (mm H2O/s) [+] @@ -315,6 +452,7 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_liq => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` qflx_snwcp_discarded_ice => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` qflx_evap_tot => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg +! qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc, & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_soliddew_to_top_layer => waterflux_inst%qflx_soliddew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_solidevap_from_top_layer => waterflux_inst%qflx_solidevap_from_top_layer_col, & ! Input: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] qflx_liqevap_from_top_layer => waterflux_inst%qflx_liqevap_from_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] @@ -323,16 +461,24 @@ subroutine BalanceCheck( bounds, & qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) +! qflx_rofliq_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] total runoff due to flooding qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack +! qflx_liq_dynbal_grc => waterflux_inst%qflx_liq_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder +! qflx_ice_dynbal_grc => waterflux_inst%qflx_ice_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder +! qflx_runoff_col => waterflux_inst%qflx_runoff_col , & ! total runoff (mm H2O / s) slevis: place holder qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) +! qflx_rofliq_qsur_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes +! qflx_rofliq_qgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) +! qflx_rofliq_qsub_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) qflx_ice_runoff_snwcp => waterflux_inst%qflx_ice_runoff_snwcp_col, & ! Input: [real(r8) (:) ] solid runoff from snow capping (mm H2O /s) qflx_ice_runoff_xs => waterflux_inst%qflx_ice_runoff_xs_col , & ! Input: [real(r8) (:) ] solid runoff from excess ice in soil (mm H2O /s) qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Input: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) qflx_sfc_irrig => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) +! qirrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) qflx_glcice_dyn_water_flux => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) @@ -393,14 +539,14 @@ subroutine BalanceCheck( bounds, & end if end do - ! Water balance check + ! Water balance check at the column level do c = bounds%begc, bounds%endc ! add qflx_drain_perched and qflx_flood if (col%active(c)) then - errh2o(c) = endwb(c) - begwb(c) & + errh2o_col(c) = endwb_col(c) - begwb_col(c) & - (forc_rain_col(c) & + forc_snow_col(c) & + qflx_floodc(c) & @@ -418,31 +564,31 @@ subroutine BalanceCheck( bounds, & else - errh2o(c) = 0.0_r8 + errh2o_col(c) = 0.0_r8 end if end do - errh2o_max_val = maxval(abs(errh2o(bounds%begc:bounds%endc))) + errh2o_max_val = maxval(abs(errh2o_col(bounds%begc:bounds%endc))) if (errh2o_max_val > h2o_warning_thresh) then - indexc = maxloc( abs(errh2o(bounds%begc:bounds%endc)), 1 ) + bounds%begc -1 - write(iulog,*)'WARNING: water balance error ',& + indexc = maxloc( abs(errh2o_col(bounds%begc:bounds%endc)), 1 ) + bounds%begc -1 + write(iulog,*)'WARNING: column-level water balance error ',& ' nstep= ',nstep, & ' local indexc= ',indexc,& ! ' global indexc= ',GetGlobalIndex(decomp_index=indexc, clmlevel=namec), & - ' errh2o= ',errh2o(indexc) + ' errh2o= ',errh2o_col(indexc) if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then write(iulog,*)'clm urban model is stopping - error is greater than 1e-5 (mm)' write(iulog,*)'nstep = ',nstep - write(iulog,*)'errh2o = ',errh2o(indexc) + write(iulog,*)'errh2o_col = ',errh2o_col(indexc) write(iulog,*)'forc_rain = ',forc_rain_col(indexc)*dtime write(iulog,*)'forc_snow = ',forc_snow_col(indexc)*dtime - write(iulog,*)'endwb = ',endwb(indexc) - write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'endwb_col = ',endwb_col(indexc) + write(iulog,*)'begwb_col = ',begwb_col(indexc) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime @@ -455,8 +601,8 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime - write(iulog,*)'deltawb = ',endwb(indexc)-begwb(indexc) - write(iulog,*)'deltawb/dtime = ',(endwb(indexc)-begwb(indexc))/dtime + write(iulog,*)'deltawb = ',endwb_col(indexc)-begwb_col(indexc) + write(iulog,*)'deltawb/dtime = ',(endwb_col(indexc)-begwb_col(indexc))/dtime if (.not.(col%itype(indexc) == icol_roof .or. & col%itype(indexc) == icol_road_imperv .or. & @@ -473,7 +619,118 @@ subroutine BalanceCheck( bounds, & end if - ! Snow balance check + ! Water balance check at the grid cell level + + call c2g(bounds, & + endwb_col(bounds%begc:bounds%endc), & + endwb_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity') + call c2g( bounds, & + qflx_sfc_irrig(bounds%begc:bounds%endc), & + qflx_irrig_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_glcice_dyn_water_flux(bounds%begc:bounds%endc), & + qflx_glcice_dyn_water_flux_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_evap_tot(bounds%begc:bounds%endc), & + qflx_evap_tot_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_surf(bounds%begc:bounds%endc), & + qflx_surf_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_qrgwl(bounds%begc:bounds%endc), & + qflx_qrgwl_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_drain(bounds%begc:bounds%endc), & + qflx_drain_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_drain_perched(bounds%begc:bounds%endc), & + qflx_drain_perched_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_ice_runoff_snwcp(bounds%begc:bounds%endc), & + qflx_ice_runoff_snwcp_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_ice_runoff_xs(bounds%begc:bounds%endc), & + qflx_ice_runoff_xs_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_snwcp_discarded_liq(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_liq_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_snwcp_discarded_ice(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_ice_locgrc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + + do g = bounds%begg, bounds%endg + errh2o_grc(g) = endwb_locgrc(g) - begwb_grc(g) & + - (forc_rain_grc(g) & + + forc_snow_grc(g) & + + qflx_flood_grc(g) & + + qflx_irrig_locgrc(g) & + + qflx_glcice_dyn_water_flux_locgrc(g) & + - qflx_evap_tot_locgrc(g) & + - qflx_surf_locgrc(g) & + - qflx_qrgwl_locgrc(g) & + - qflx_drain_locgrc(g) & + - qflx_drain_perched_locgrc(g) & + - qflx_ice_runoff_snwcp_locgrc(g) & + - qflx_ice_runoff_xs_locgrc(g) & + - qflx_snwcp_discarded_liq_locgrc(g) & + - qflx_snwcp_discarded_ice_locgrc(g)) * dtime + end do + + errh2o_max_val = maxval(abs(errh2o_grc(bounds%begg:bounds%endg))) + + if (errh2o_max_val > h2o_warning_thresh) then + + indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg -1 + write(iulog,*)'WARNING: grid cell-level water balance error ',& + ' nstep= ',nstep, & + ' local indexg= ',indexg,& + ' errh2o_grc= ',errh2o_grc(indexg) + if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then + + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errh2o_grc = ',errh2o_grc(indexg) + write(iulog,*)'forc_rain = ',forc_rain_grc(indexg)*dtime + write(iulog,*)'forc_snow = ',forc_snow_grc(indexg)*dtime + write(iulog,*)'endwb_loc = ',endwb_locgrc(indexg) + write(iulog,*)'begwb_grc = ',begwb_grc(indexg) + + write(iulog,*)'qflx_evap_tot_loc = ',qflx_evap_tot_locgrc(indexg)*dtime + write(iulog,*)'qflx_irrig_loc = ',qflx_irrig_locgrc(indexg)*dtime + write(iulog,*)'qflx_surf_loc = ',qflx_surf_locgrc(indexg)*dtime + write(iulog,*)'qflx_qrgwl_loc = ',qflx_qrgwl_locgrc(indexg)*dtime + write(iulog,*)'qflx_drain_loc = ',qflx_drain_locgrc(indexg)*dtime + write(iulog,*)'qflx_ice_runoff_snwcp_loc = ',qflx_ice_runoff_snwcp_locgrc(indexg)*dtime + write(iulog,*)'qflx_ice_runoff_xs_loc = ',qflx_ice_runoff_xs_locgrc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice_loc = ',qflx_snwcp_discarded_ice_locgrc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq_loc = ',qflx_snwcp_discarded_liq_locgrc(indexg)*dtime + write(iulog,*)'deltawb = ',endwb_locgrc(indexg)-begwb_grc(indexg) + write(iulog,*)'deltawb/dtime = ',(endwb_locgrc(indexg)-begwb_grc(indexg))/dtime + write(iulog,*)'qflx_drain_perched_loc = ',qflx_drain_perched_locgrc(indexg)*dtime + write(iulog,*)'qflx_flood = ',qflx_flood_grc(indexg)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux_grc_loc = ',qflx_glcice_dyn_water_flux_locgrc(indexg)*dtime + + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) + end if + + end if + + ! Snow balance check at the grid cell level. + ! Beginning snow balance variable h2osno_old is calculated once + ! for both the column-level and grid cell-level balance checks. call waterstate_inst%CalculateTotalH2osno(bounds, num_allc, filter_allc, & caller = 'BalanceCheck', & @@ -574,6 +831,7 @@ subroutine BalanceCheck( bounds, & end if + ! Energy balance checks do p = bounds%begp, bounds%endp diff --git a/src/biogeophys/WaterBalanceType.F90 b/src/biogeophys/WaterBalanceType.F90 index d8e6f3f8ba..4d747acebe 100644 --- a/src/biogeophys/WaterBalanceType.F90 +++ b/src/biogeophys/WaterBalanceType.F90 @@ -36,10 +36,13 @@ module WaterBalanceType ! Balance Checks - real(r8), pointer :: begwb_col (:) ! water mass begining of the time step - real(r8), pointer :: endwb_col (:) ! water mass end of the time step + real(r8), pointer :: begwb_grc (:) ! grid cell-level water mass begining of the time step + real(r8), pointer :: endwb_grc (:) ! grid cell-level water mass end of the time step + real(r8), pointer :: begwb_col (:) ! column-level water mass begining of the time step + real(r8), pointer :: endwb_col (:) ! column-level water mass end of the time step real(r8), pointer :: errh2o_patch (:) ! water conservation error (mm H2O) - real(r8), pointer :: errh2o_col (:) ! water conservation error (mm H2O) + real(r8), pointer :: errh2o_col (:) ! column-level water conservation error (mm H2O) + real(r8), pointer :: errh2o_grc (:) ! grid cell-level water conservation error (mm H2O) real(r8), pointer :: errh2osno_col (:) ! snow water conservation error(mm H2O) contains @@ -112,6 +115,12 @@ subroutine InitAllocate(this, bounds, tracer_vars) container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%begwb_grc, name = 'begwb_grc', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) + call AllocateVar1d(var = this%endwb_grc, name = 'endwb_grc', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) call AllocateVar1d(var = this%begwb_col, name = 'begwb_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) @@ -124,6 +133,9 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%errh2o_col, name = 'errh2o_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%errh2o_grc, name = 'errh2o_grc', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) call AllocateVar1d(var = this%errh2osno_col, name = 'errh2osno_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index f06c49bc12..c332f9a662 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -26,7 +26,7 @@ module clm_driver use abortutils , only : endrun ! use dynSubgridDriverMod , only : dynSubgrid_driver, dynSubgrid_wrapup_weight_changes - use BalanceCheckMod , only : BeginWaterBalance, BalanceCheck + use BalanceCheckMod , only : BeginWaterGridcellBalance, BeginWaterColumnBalance, BalanceCheck ! use BiogeophysPreFluxCalcsMod , only : BiogeophysPreFluxCalcs use SurfaceHumidityMod , only : CalculateSurfaceHumidity @@ -326,6 +326,13 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if call t_stopf('begcnbal_grc') + call t_startf('begwbal') + call BeginWaterGridcellBalance(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + water_inst, soilhydrology_inst, & + use_aquifer_layer = use_aquifer_layer()) + call t_stopf('begwbal') end do !$OMP END PARALLEL DO @@ -361,9 +368,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! For water: Currently, I believe this needs to be done after weights are updated for ! prescribed transient patches or CNDV, because column-level water is not generally ! conserved when weights change (instead the difference is put in the grid cell-level - ! terms, qflx_liq_dynbal, etc.). In the future, we may want to change the balance - ! checks to ensure that the grid cell-level water is conserved, considering - ! qflx_liq_dynbal; in this case, the call to BeginWaterBalance should be moved to + ! terms, qflx_liq_dynbal, etc.). Grid cell-level balance + ! checks ensure that the grid cell-level water is conserved by considering + ! qflx_liq_dynbal and calling BeginWaterGridcellBalance ! before the weight updates. ! ! For carbon & nitrogen: This needs to be done after dynSubgrid_driver, because the @@ -381,7 +388,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('prescribed_sm') endif call t_startf('begwbal') - call BeginWaterBalance(bounds_clump, & + call BeginWaterColumnBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & water_inst, soilhydrology_inst, & @@ -1103,6 +1110,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & surfalb_inst, energyflux_inst, canopystate_inst) +! water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, canopystate_inst) call t_stopf('balchk') ! ============================================================================ diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index 9a18428264..6c64043d8c 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -405,10 +405,10 @@ subroutine lnd2atm(bounds, & call c2g( bounds, & water_inst%waterbalancebulk_inst%endwb_col(bounds%begc:bounds%endc), & - water_inst%waterdiagnosticbulk_inst%tws_grc (bounds%begg:bounds%endg), & + water_inst%waterbalancebulk_inst%endwb_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterdiagnosticbulk_inst%tws_grc(g) = water_inst%waterdiagnosticbulk_inst%tws_grc(g) + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 + water_inst%waterdiagnosticbulk_inst%tws_grc(g) = water_inst%waterbalancebulk_inst%endwb_grc(g) + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 enddo end subroutine lnd2atm From 5a0c758d672fcae5ef383617663650d76f2348bd Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Dec 2020 16:17:06 -0700 Subject: [PATCH 031/219] Deleted a blank line; committing this in prep for update to latest tag --- src/biogeophys/BalanceCheckMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index bc73b68265..206af92946 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -831,7 +831,6 @@ subroutine BalanceCheck( bounds, & end if - ! Energy balance checks do p = bounds%begp, bounds%endp From ff59a5fe62f57b9b7b795256254311bcda1aafe9 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Dec 2020 17:51:35 -0700 Subject: [PATCH 032/219] Mods required in new code from conflicts not caught by git --- src/biogeophys/BalanceCheckMod.F90 | 12 ++++++++---- src/main/clm_driver.F90 | 8 ++++---- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index ea3e4360ab..b9390c57b3 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -126,7 +126,7 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- subroutine BeginWaterGridcellBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, soilhydrology_inst, & + water_inst, soilhydrology_inst, lakestate_inst, & use_aquifer_layer) ! ! !DESCRIPTION: @@ -140,6 +140,7 @@ subroutine BeginWaterGridcellBalance(bounds, & integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst + type(lakestate_type) , intent(in) :: lakestate_inst type(soilhydrology_type), intent(in) :: soilhydrology_inst logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! @@ -154,6 +155,7 @@ subroutine BeginWaterGridcellBalance(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & soilhydrology_inst, & + lakestate_inst, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & water_inst%bulk_and_tracers(i)%waterbalance_inst, & @@ -206,7 +208,8 @@ end subroutine BeginWaterColumnBalance !----------------------------------------------------------------------- subroutine BeginWaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - soilhydrology_inst, waterstate_inst, waterdiagnostic_inst, waterbalance_inst, & + soilhydrology_inst, lakestate_inst, waterstate_inst, & + waterdiagnostic_inst, waterbalance_inst, & use_aquifer_layer) ! ! !DESCRIPTION: @@ -223,6 +226,7 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst @@ -267,8 +271,8 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & water_mass = begwb_col(begc:endc)) call ComputeWaterMassLake(bounds, num_lakec, filter_lakec, & - waterstate_inst, & - subtract_dynbal_baselines = .false., & + waterstate_inst, lakestate_inst, & + add_lake_water_and_subtract_dynbal_baselines = .false., & water_mass = begwb_col(begc:endc)) call c2g(bounds, begwb_col(begc:endc), begwb_grc(begg:endg), & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 3b619b1e45..943106bbd2 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -327,10 +327,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('begcnbal_grc') call t_startf('begwbal') - call BeginWaterGridcellBalance(bounds_clump, & - filter(nc)%num_nolakec, filter(nc)%nolakec, & - filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, soilhydrology_inst, & + call BeginWaterGridcellBalance(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + water_inst, soilhydrology_inst, lakestate_inst, & use_aquifer_layer = use_aquifer_layer()) call t_stopf('begwbal') end do From 85c37e458baef25b3aa7aa3bc8e4afe2987066cd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 16 Dec 2020 10:14:07 -0700 Subject: [PATCH 033/219] performance udpates --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 36 +- src/cpl/nuopc/lnd_import_export.F90 | 1141 +++++++++++++++------------ 2 files changed, 636 insertions(+), 541 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index af4f1c64bf..30c1c97d61 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -70,6 +70,7 @@ module lnd_comp_nuopc logical :: glc_present logical :: rof_prognostic + logical :: atm_prognostic integer, parameter :: dbug = 0 character(*),parameter :: modName = "(lnd_comp_nuopc)" character(*),parameter :: u_FILE_u = & @@ -290,6 +291,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) rof_prognostic = .true. end if + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'satm' .or. trim(cvalue) == 'datm') then + atm_prognostic = .false. + else + atm_prognostic = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(cvalue) == 'sglc') then @@ -312,14 +321,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_sys_abort(subname//'Need to set cism_evolve if glc is present') endif end if - + if (masterproc) then + write(iulog,*)' atm_prognostic = ',atm_prognostic write(iulog,*)' rof_prognostic = ',rof_prognostic write(iulog,*)' glc_present = ',glc_present if (glc_present) write(iulog,*)' cism_evolve = ',cism_evolve end if - call advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, rc) + call advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- @@ -328,10 +338,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end subroutine InitializeAdvertise !=============================================================================== - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use clm_instMod, only : lnd2atm_inst, lnd2glc_inst, water_inst @@ -885,27 +895,22 @@ subroutine ModelAdvance(gcomp, rc) ! Determine time of next atmospheric shortwave calculation !-------------------------------- + call t_startf(trim(subname)//' nextsw_cday') call State_GetScalar(importState, & flds_scalar_index_nextsw_cday, nextsw_cday, & flds_scalar_name, flds_scalar_num, rc) call set_nextsw_cday( nextsw_cday ) - - !---------------------- - ! Get orbital values - !---------------------- - + call t_stopf(trim(subname)//' nextsw_cday') !-------------------------------- ! Unpack import state !-------------------------------- call t_startf ('lc_lnd_import') - call get_proc_bounds(bounds) call import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf ('lc_lnd_import') !-------------------------------- @@ -974,32 +979,27 @@ subroutine ModelAdvance(gcomp, rc) ! Run CTSM !-------------------------------- - call t_barrierf('sync_ctsm_run1', mpicom) + ! call ESMF_VMBarrier(vm, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_startf ('shr_orb_decl') - ! Note - the orbital inquiries set the values in clm_varorb via the module use statements call clm_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - calday = get_curr_calday() call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) call t_stopf ('shr_orb_decl') call t_startf ('ctsm_run') - ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names - call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync - call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) - call t_stopf ('ctsm_run') !-------------------------------- @@ -1007,11 +1007,9 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call t_startf ('lc_lnd_export') - call export_fields(gcomp, bounds, glc_present, rof_prognostic, & water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf ('lc_lnd_export') !-------------------------------- diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 346e4f6e7f..a705060911 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -36,9 +36,8 @@ module lnd_import_export private :: fldlist_add private :: fldlist_realize - private :: state_getimport - private :: state_setexport private :: state_getfldptr + private :: fldchk type fld_list_type character(len=128) :: stdname @@ -51,7 +50,6 @@ module lnd_import_export integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost ! from atm->lnd integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn @@ -76,7 +74,7 @@ module lnd_import_export contains !=============================================================================== - subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, rc) + subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) use clm_varctl, only : ndep_from_cpl @@ -86,6 +84,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r logical , intent(in) :: glc_present logical , intent(in) :: cism_evolve logical , intent(in) :: rof_prognostic + logical , intent(in) :: atm_prognostic integer , intent(out) :: rc ! local variables @@ -137,22 +136,66 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r !-------------------------------- call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') + + ! export to atm + if (atm_prognostic) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) + ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) + + ! dust fluxes from land (4 sizes) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) + + ! co2 fields from land + if (flds_co2b .or. flds_co2c) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) + end if + + ! Dry Deposition velocities from land - ALSO initialize drydep here + call seq_drydep_readnl("drv_flds_in", drydep_nflds) + if (drydep_nflds > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) + end if - ! export land states - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) - - ! export fluxes to river + ! MEGAN VOC emissions fluxes from land + call shr_megan_readnl('drv_flds_in', megan_nflds) + if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') + if (shr_megan_mechcomps_n > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) + end if + + ! Fire emissions fluxes from land + call shr_fire_emis_readnl('drv_flds_in', emis_nflds) + if (emis_nflds > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') + end if + ! CARMA volumetric soil water from land + ! TODO: is the following correct - the CARMA field exchange is very confusing in mct + call shr_carma_readnl('drv_flds_in', carma_fields) + if (carma_fields /= ' ') then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma + end if + end if + + ! export to rof if (rof_prognostic) then call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) @@ -161,51 +204,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) end if - ! export fluxes to atm - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - - ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) - - ! dust fluxes from land (4 sizes) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) - - ! co2 fields from land - if (flds_co2b .or. flds_co2c) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) - end if - - ! Dry Deposition velocities from land - ALSO initialize drydep here - call seq_drydep_readnl("drv_flds_in", drydep_nflds) - if (drydep_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) - end if - - ! MEGAN VOC emissions fluxes from land - call shr_megan_readnl('drv_flds_in', megan_nflds) - if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') - if (shr_megan_mechcomps_n > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) - end if - - ! Fire emissions fluxes from land - call shr_fire_emis_readnl('drv_flds_in', emis_nflds) - if (emis_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') - end if - ! CARMA volumetric soil water from land - ! TODO: is the following correct - the CARMA field exchange is very confusing in mct - call shr_carma_readnl('drv_flds_in', carma_fields) - if (carma_fields /= ' ') then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma - end if - + ! export to glc if (glc_present .and. cism_evolve) then ! lnd->glc states from land all lnd->glc elevation classes (1:glc_nec) plus bare land (index 0). ! The following puts all of the elevation class fields as an @@ -310,7 +309,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r end subroutine advertise_fields !=============================================================================== - subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) ! input/output variables @@ -354,7 +352,6 @@ subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) end subroutine realize_fields !=============================================================================== - subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst, rc) @@ -382,10 +379,12 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & type(ESMF_State) :: importState type(ESMF_StateItem_Flag) :: itemFlag real(r8), pointer :: dataPtr(:) + real(r8), pointer :: fldPtr1d(:) + real(r8), pointer :: fldPtr2d(:,:) character(len=128) :: fldname integer :: num integer :: begg, endg ! bounds - integer :: g,i,k ! indices + integer :: g,i,k,n ! indices real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) real(r8) :: forc_pbot ! atmospheric pressure (Pa) real(r8) :: co2_ppmv_input(bounds%begg:bounds%endg) ! temporary @@ -424,126 +423,205 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Required atmosphere input fields !-------------------------- - call state_getimport(importState, 'Sa_z', bounds, output=atm2lnd_inst%forc_hgt_grc, rc=rc) + call state_getfldptr(importState, 'Sa_z', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_z', begg) + do g = begg, endg + atm2lnd_inst%forc_hgt_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_topo', bounds, output=atm2lnd_inst%forc_topo_grc, rc=rc) + call state_getfldptr(importState, 'Sa_topo', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_topo', begg) + do g = begg, endg + atm2lnd_inst%forc_topo_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_u', bounds, output=atm2lnd_inst%forc_u_grc, rc=rc ) + call state_getfldptr(importState, 'Sa_u', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_u', begg) + do g = begg, endg + atm2lnd_inst%forc_u_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_v', bounds, output=atm2lnd_inst%forc_v_grc, rc=rc ) + call state_getfldptr(importState, 'Sa_v', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_v', begg) + do g = begg, endg + atm2lnd_inst%forc_v_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_ptem', bounds, output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + call state_getfldptr(importState, 'Sa_ptem', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_ptem', begg) + do g = begg, endg + atm2lnd_inst%forc_th_not_downscaled_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_shum', bounds, output=wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + call state_getfldptr(importState, 'Sa_shum', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_shum', begg) + do g = begg, endg + wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_pbot', bounds, output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + call state_getfldptr(importState, 'Sa_pbot', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_pbot', begg) + do g = begg, endg + atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Sa_tbot', bounds, output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + call state_getfldptr(importState, 'Sa_tbot', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_tbot', begg) + do g = begg, endg + atm2lnd_inst%forc_t_not_downscaled_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_rainc', bounds, output=forc_rainc, rc=rc ) + call state_getfldptr(importState, 'Faxa_rainc', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_rainc', begg) + do g = begg, endg + forc_rainc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_rainl', bounds, output=forc_rainl, rc=rc ) + call state_getfldptr(importState, 'Faxa_rainl', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_rainl', begg) + do g = begg, endg + forc_rainl(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_snowc', bounds, output=forc_snowc, rc=rc ) + call state_getfldptr(importState, 'Faxa_snowc', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_snowc', begg) + do g = begg, endg + forc_snowc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_snowl', bounds, output=forc_snowl, rc=rc ) + call state_getfldptr(importState, 'Faxa_snowl', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_snowl', begg) + do g = begg, endg + forc_snowl(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_lwdn', bounds, output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(importState, 'Faxa_lwdn', fldptr1d, rc=rc) + call check_for_nans(fldptr1d, 'Faxa_lwdn', begg) + do g = begg, endg + atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_swvdr', bounds, output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + call state_getfldptr(importState, 'Faxa_swvdr', fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_swvdr', begg) + do g = begg, endg + atm2lnd_inst%forc_solad_grc(g,1) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_swndr', bounds, output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + call state_getfldptr(importState, 'Faxa_swndr', fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_swndr', begg) + do g = begg, endg + atm2lnd_inst%forc_solad_grc(g,2) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_swvdf', bounds, output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + call state_getfldptr(importState, 'Faxa_swvdf', fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_swvdf', begg) + do g = begg, endg + atm2lnd_inst%forc_solai_grc(g,1) = fldptr1d(g-begg+1) + end do - call state_getimport(importState, 'Faxa_swndf', bounds, output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + call state_getfldptr(importState, 'Faxa_swndf', fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Faxa_swndf', begg) + do g = begg, endg + atm2lnd_inst%forc_solai_grc(g,2) = fldptr1d(g-begg+1) + end do ! Atmosphere prognostic/prescribed aerosol fields + if (fldchk(importState, 'Faxa_bcph')) then + write(6,*)'i am here' + call state_getfldptr(importState, 'Faxa_bcph', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr2d(1,:), 'Faxa_bcph(1)', begg) + call check_for_nans(fldptr2d(2,:), 'Faxa_bcph(2)', begg) + call check_for_nans(fldptr2d(3,:), 'Faxa_bcph(3)', begg) + do g = begg, endg + n = g - begg + 1 + atm2lnd_inst%forc_aer_grc(g,1) = fldptr2d(1,n) ! bcphidry + atm2lnd_inst%forc_aer_grc(g,2) = fldptr2d(2,n) ! bcphodry + atm2lnd_inst%forc_aer_grc(g,3) = fldptr2d(3,n) ! bcphiwet + end do + end if + if (fldchk(importState, 'Faxa_ocph')) then + call state_getfldptr(importState, 'Faxa_ocph', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr2d(1,:), 'Faxa_ocph(1)', begg) + call check_for_nans(fldptr2d(2,:), 'Faxa_ocph(2)', begg) + call check_for_nans(fldptr2d(3,:), 'Faxa_ocph(3)', begg) + do g = begg, endg + n = g - begg + 1 + atm2lnd_inst%forc_aer_grc(g,4) = fldptr2d(1,n) ! ocphidry + atm2lnd_inst%forc_aer_grc(g,5) = fldptr2d(2,n) ! ocphodry + atm2lnd_inst%forc_aer_grc(g,6) = fldptr2d(3,n) ! ocphiwet + end do + end if - ! bcphidry - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! bcphodry - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! bcphiwet - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ocphidry - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ocphodry - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ocphiwet - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & - ungridded_index=4, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & - ungridded_index=4, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(importState, 'Faxa_dstwet')) then + call state_getfldptr(importState, 'Faxa_dstwet', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr2d(1,:), 'Faxa_dstwet(1)', begg) + call check_for_nans(fldptr2d(2,:), 'Faxa_dstwet(2)', begg) + call check_for_nans(fldptr2d(3,:), 'Faxa_dstwet(3)', begg) + call check_for_nans(fldptr2d(4,:), 'Faxa_dstwet(4)', begg) + do g = begg, endg + n = g - begg + 1 + atm2lnd_inst%forc_aer_grc(g,7) = fldptr2d(1,n) + atm2lnd_inst%forc_aer_grc(g,9) = fldptr2d(2,n) + atm2lnd_inst%forc_aer_grc(g,11) = fldptr2d(3,n) + atm2lnd_inst%forc_aer_grc(g,13) = fldptr2d(4,n) + end do + end if + if (fldchk(importState, 'Faxa_dstdry')) then + call state_getfldptr(importState, 'Faxa_dstdry', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr2d(1,:), 'Faxa_dstdry(1)', begg) + call check_for_nans(fldptr2d(2,:), 'Faxa_dstdry(2)', begg) + call check_for_nans(fldptr2d(3,:), 'Faxa_dstdry(3)', begg) + call check_for_nans(fldptr2d(4,:), 'Faxa_dstdry(4)', begg) + do g = begg, endg + n = g - begg + 1 + atm2lnd_inst%forc_aer_grc(g,8) = fldptr2d(1,n) + atm2lnd_inst%forc_aer_grc(g,10) = fldptr2d(2,n) + atm2lnd_inst%forc_aer_grc(g,12) = fldptr2d(3,n) + atm2lnd_inst%forc_aer_grc(g,14) = fldptr2d(4,n) + end do + end if - ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec - ! so the following conversion needs to happen + if (fldchk(importState, 'Sa_methane')) then + call state_getfldptr(importState, 'Sa_methane', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr1d, 'Sa_methane', begg) + do g = begg, endg + atm2lnd_inst%forc_pch4_grc(g) = fldptr1d(g-begg+1) + end do + end if - call state_getimport(importState, 'Faxa_ndep', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_ndep', bounds, output=forc_noy, ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg,endg - atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 - end do + if (fldchk(importState, 'Faxa_ndep')) then + ! The mediator is sending ndep in units if kgN/m2/s - and ctsm + ! uses units of gN/m2/sec so the following conversion needs to happen + call state_getfldptr(importState, 'Faxa_ndep', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call check_for_nans(fldptr2d(1,:), 'Faxa_ndep(1)', begg) + call check_for_nans(fldptr2d(2,:), 'Faxa_ndep(2)', begg) + do g = begg, endg + n = g - begg + 1 + atm2lnd_inst%forc_ndep_grc(g) = (fldptr2d(1,n) + fldptr2d(2,n))*1000._r8 + end do + end if !-------------------------- ! Atmosphere co2 @@ -601,26 +679,30 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! so water sent from rof to land is negative, ! change the sign to indicate addition of water to system. - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_flood', bounds, output=wateratm2lndbulk_inst%forc_flood_grc, rc=rc ) + if (fldchk(importState, 'Flrr_flood')) then + call state_getfldptr(importState, 'Flrr_flood', fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%forc_flood_grc(:) = -wateratm2lndbulk_inst%forc_flood_grc(:) + do g = begg, endg + wateratm2lndbulk_inst%forc_flood_grc(g) = -fldptr1d(g-begg+1) + end do else wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 end if - - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_volr', bounds, output=wateratm2lndbulk_inst%volr_grc, rc=rc ) + if (fldchk(importState, 'Flrr_volr')) then + call state_getfldptr(importState, 'Flrr_flood', fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%volr_grc(:) = wateratm2lndbulk_inst%volr_grc(:) * (ldomain%area(:) * 1.e6_r8) + do g = begg, endg + wateratm2lndbulk_inst%forc_flood_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) + end do else wateratm2lndbulk_inst%volr_grc(:) = 0._r8 end if - - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_volrmch', bounds, output=wateratm2lndbulk_inst%volrmch_grc, rc=rc ) + if (fldchk(importState, 'Flrr_volrmch')) then + call state_getfldptr(importState, 'Flrr_volrmch', fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%volrmch_grc(:) = wateratm2lndbulk_inst%volrmch_grc(:) * (ldomain%area(:) * 1.e6_r8) + do g = begg, endg + wateratm2lndbulk_inst%volrmch_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) + end do else wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 end if @@ -634,19 +716,49 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - do num = 0,glc_nec - call state_getimport(importState, 'Sg_ice_covered_elev', bounds, frac_grc(:,num), ungridded_index=num+1, rc=rc) + if ( fldchk(importState, 'Sg_ice_covered_elev')) then + call state_getfldptr(importState, 'Sg_ice_covered_elev', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + do num = 0,glc_nec + frac_grc(g,num) = fldptr2d(num+1,g-begg+1) + end do + end do + end if + if ( fldchk(importState, 'Sl_topo_elev')) then + call state_getfldptr(importState, 'Sg_topo_elev', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + do num = 0,glc_nec + topo_grc(g,num) = fldptr2d(num+1,g-begg+1) + end do + end do + end if + if ( fldchk(importState, 'Sl_topo_elev')) then + call state_getfldptr(importState, 'Flgg_hflx_elev', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sg_topo_elev' , bounds, topo_grc(:,num), ungridded_index=num+1, rc=rc) + do g = begg, endg + do num = 0,glc_nec + hflx_grc(g,num) = fldptr2d(num+1,g-begg+1) + end do + end do + else + hflx_grc(:,:) = 0._r8 + end if + if ( fldchk(importState, 'Sg_icemask')) then + call state_getfldptr(importState, 'Sg_icemask', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Flgg_hflx_elev' , bounds, hflx_grc(:,num), ungridded_index=num+1, rc=rc) + do g = begg, endg + icemask_grc(g) = fldptr1d(g-begg+1) + end do + end if + if ( fldchk(importState, 'Sg_icemask_coupled_fluxes')) then + call state_getfldptr(importState, 'Sg_icemask', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call state_getimport(importState, 'Sg_icemask' , bounds, icemask_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sg_icemask_coupled_fluxes', bounds, icemask_coupled_fluxes_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + do g = begg, endg + icemask_coupled_fluxes_grc(g) = fldptr1d(g-begg+1) + end do + end if call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc ) end if @@ -664,7 +776,6 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end subroutine import_fields !=============================================================================== - subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) @@ -685,9 +796,12 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & integer , intent(out) :: rc ! local variables - type(ESMF_State) :: exportState - integer :: i, g, num - real(r8) :: array(bounds%begg:bounds%endg) + type(ESMF_State) :: exportState + real(r8), pointer :: fldPtr1d(:) + real(r8), pointer :: fldPtr2d(:,:) + integer :: begg, endg ! bounds + integer :: i, g, num + real(r8) :: array(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -697,121 +811,246 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set bounds + begg = bounds%begg + endg = bounds%endg + ! ----------------------- ! output to mediator ! ----------------------- - - call state_setexport(exportState, 'Sl_lfrin', bounds, input=ldomain%frac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(exportState, 'Sl_lfrin')) then + call state_getfldptr(exportState, 'Sl_lfrin', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = ldomain%frac(g) + end do + end if ! ----------------------- ! output to atm ! ----------------------- - - call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_snowh', bounds, input=waterlnd2atmbulk_inst%h2osno_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_avsdr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_anidr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_avsdf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_anidf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_tref', bounds, input=lnd2atm_inst%t_ref2m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_qref', bounds, input=waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_u10', bounds, input=lnd2atm_inst%u_ref10m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_taux', bounds, input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_tauy', bounds, input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_lat', bounds, input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_sen', bounds, input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_lwup', bounds, input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_evap', bounds, input=waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,1), & - minus=.true., ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,2), & - minus=.true., ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,3), & - minus=.true., ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,4), & - minus=.true., ungridded_index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%ch4_surf_flux_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_soilw', bounds, & - input=waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! co2 from land - if (flds_co2b .or. flds_co2c) then - call state_setexport(exportState, 'Fall_fco2_lnd', bounds, lnd2atm_inst%net_carbon_exchange_grc, minus=.true., rc=rc) + if (fldchk(exportState, 'Sl_t')) then + call state_getfldptr(exportState, 'Sl_t', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%t_rad_grc(g) + end do end if - - ! dry dep velocities - do num = 1, drydep_nflds - call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), & - ungridded_index=num, rc=rc) + if (fldchk(exportState, 'Sl_snowh')) then + call state_getfldptr(exportState, 'Sl_snowh', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - ! MEGAN VOC emis fluxes - do num = 1, shr_megan_mechcomps_n - call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osno_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_avsdr')) then + call state_getfldptr(exportState, 'Sl_avsdr', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - ! fire emis fluxes - if (emis_nflds > 0) then - do num = 1, emis_nflds - call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,1) + end do + end if + if (fldchk(exportState, 'Sl_anidr')) then + call state_getfldptr(exportState, 'Sl_anidr', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,2) + end do + end if + if (fldchk(exportState, 'Sl_avsdf')) then + call state_getfldptr(exportState, 'Sl_avsdf', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,1) + end do + end if + if (fldchk(exportState, 'Sl_anidf')) then + call state_getfldptr(exportState, 'Sl_anidf', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,2) end do - call state_setexport(exportState, 'Sl_fztop', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + end if + if (fldchk(exportState, 'Sl_tref')) then + call state_getfldptr(exportState, 'Sl_tref', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%t_ref2m_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_qref')) then + call state_getfldptr(exportState, 'Sl_qref', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%q_ref2m_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_taux')) then + call state_getfldptr(exportState, 'Fall_taux', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%taux_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_tauy')) then + call state_getfldptr(exportState, 'Fall_tauy', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%tauy_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_lat')) then + call state_getfldptr(exportState, 'Fall_lat', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lh_tot_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_sen')) then + call state_getfldptr(exportState, 'Fall_sen', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_sh_tot_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_lwup')) then + call state_getfldptr(exportState, 'Fall_lwup', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lwrad_out_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_evap')) then + call state_getfldptr(exportState, 'Fall_evap', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_swnet')) then + call state_getfldptr(exportState, 'Fall_swnet', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%fsa_grc(g) + end do + end if + if (fldchk(exportState, 'Fall_flxdst')) then + call state_getfldptr(exportState, 'Fall_flxdst', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do g = begg, endg + fldptr2d(1,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,1) + fldptr2d(2,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,2) + fldptr2d(3,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,3) + fldptr2d(4,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,4) + end do + end if + if (fldchk(exportState, 'Fall_methane')) then + call state_getfldptr(exportState, 'Fall_methane', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%ch4_surf_flux_tot_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_u10')) then + call state_getfldptr(exportState, 'Sl_u10', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%u_ref10m_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_ram1')) then + call state_getfldptr(exportState, 'Sl_ram1', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%ram1_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_fv')) then + call state_getfldptr(exportState, 'Sl_fv', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%fv_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_soilw')) then + call state_getfldptr(exportState, 'Sl_soilw', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1) + end do + end if + if (flds_co2b .or. flds_co2c) then + ! co2 from land + call state_getfldptr(exportState, 'Fall_fco2_lnd', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -lnd2atm_inst%net_carbon_exchange_grc(g) + end do + end if + if (fldchk(exportState, 'Sl_ddvel')) then + ! dry dep velocities + call state_getfldptr(exportState, 'Sl_ddvel', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 1, drydep_nflds + fldptr2d(num,g-begg+1) = lnd2atm_inst%ddvel_grc(g,num) + end do + end do + end if + if (fldchk(exportState, 'Fall_voc')) then + ! megan voc emis fluxes + call state_getfldptr(exportState, 'Fall_voc', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 1, shr_megan_mechcomps_n + fldptr2d(num,g-begg+1) = -lnd2atm_inst%flxvoc_grc(g,num) + end do + end do + end if + if (fldchk(exportState, 'Fall_fire')) then + if (emis_nflds > 0) then + ! fire emis fluxes + call state_getfldptr(exportState, 'Fall_fire', fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 1, emis_nflds + fldptr2d(num,g-begg+1) = -lnd2atm_inst%fireflx_grc(g,num) + end do + end do + call state_getfldptr(exportState, 'Sl_fztop', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%fireztop_grc(g) + end do + end if endif + ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. ! i.e. water sent from land to rof is positive @@ -820,55 +1059,96 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = bounds%begg,bounds%endg - ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) - ! end do - call state_setexport(exportState, 'Flrl_rofsur', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - do g = bounds%begg,bounds%endg - array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - end do - call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! qgwl sent individually to coupler - call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ice sent individually to coupler - call state_setexport(exportState, 'Flrl_rofi', bounds, input=waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! irrigation flux to be removed from main channel storage (negative) - call state_setexport(exportState, 'Flrl_irrig', bounds, input=waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do g = bounds%begg,bounds%endg + ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & + ! waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! end do + if (fldchk(exportState, 'Flrl_rofsur')) then + call state_getfldptr(exportState, 'Flrl_rofsur', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + end do + end if + if (fldchk(exportState, 'Flrl_rofsub')) then + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + call state_getfldptr(exportState, 'Flrl_rofsub', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + end do + end if + if (fldchk(exportState, 'Flrl_rofgwl')) then + ! qgwl sent individually to coupler + call state_getfldptr(exportState, 'Flrl_rofgwl', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) + end do + end if + if (fldchk(exportState, 'Flrl_rofi')) then + ! ice sent individually to coupler + call state_getfldptr(exportState, 'Flrl_rofi', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofice_grc(g) + end do + end if + if (fldchk(exportState, 'Flrl_irrig')) then + ! irrigation flux to be removed from main channel storage (negative) + call state_getfldptr(exportState, 'Flrl_irrig', fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = -waterlnd2atmbulk_inst%qirrig_grc(g) + end do + end if ! ----------------------- ! output to glc ! ----------------------- - ! We could avoid setting these fields if glc_present is .false., if that would ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - - do num = 0,glc_nec - call state_setexport(exportState, 'Sl_tsrf_elev', bounds, input=lnd2glc_inst%tsrf_grc(:,num), & - ungridded_index=num+1, rc=rc) + if (fldchk(exportState, 'Sl_tsrf_elev')) then + call state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_topo_elev', bounds, input=lnd2glc_inst%topo_grc(:,num), & - ungridded_index=num+1, rc=rc) + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 0,glc_nec + fldptr2d(num+1,g-begg+1) = lnd2glc_inst%tsrf_grc(g,num) + end do + end do + end if + if (fldchk(exportState, 'Sl_topo_elev')) then + call state_getfldptr(exportState, 'Sl_topo_elev', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Flgl_qice_elev', bounds, input=lnd2glc_inst%qice_grc(:,num), & - ungridded_index=num+1, rc=rc) + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 0,glc_nec + fldptr2d(num+1,g-begg+1) = lnd2glc_inst%topo_grc(g,num) + end do + end do + end if + if (fldchk(exportState, 'Flgl_qice_elev')) then + call state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 0,glc_nec + fldptr2d(num+1,g-begg+1) = lnd2glc_inst%qice_grc(g,num) + end do + end do + end if end subroutine export_fields !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! input/output variables @@ -901,7 +1181,6 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound end subroutine fldlist_add !=============================================================================== - subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize @@ -944,7 +1223,7 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & - gridToFieldMap=(/gridToFieldMap/), rc=rc) + gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) @@ -1006,185 +1285,6 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== - - subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: output(bounds%begg:bounds%endg) - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: g, i,n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - type(ESMF_StateItem_Flag) :: itemFlag - character(len=cs) :: cvalue - character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - - ! get field pointer - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! determine output array - if (present(ungridded_index)) then - if (gridToFieldMap == 1) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(n,ungridded_index) - end do - else if (gridToFieldMap == 2) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(ungridded_index,n) - end do - end if - else - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr1d(n) - end do - end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 48) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) - end do - end if - - ! check for nans - call check_for_nans(output, trim(fldname), bounds%begg) - end if - - end subroutine state_getimport - - !=============================================================================== - - subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index, rc) - - ! ---------------------------------------------- - ! Map input array to export state field - ! ---------------------------------------------- - - use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: input(bounds%begg:bounds%endg) - logical, optional , intent(in) :: minus - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - logical :: l_minus ! local version of minus - integer :: g, i, n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - character(len=cs) :: cvalue - type(ESMF_StateItem_Flag) :: itemFlag - character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - l_minus = .false. - if (present(minus)) then - l_minus = minus - end if - - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - - ! get field pointer - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points - ! rather than 0 - this is very odd and needs to be understood - !fldptr1d(:) = fillvalue - - ! determine output array - if (present(ungridded_index)) then - fldptr2d(ungridded_index,:) = 0._r8 - !fldptr2d(ungridded_index,:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr2d(ungridded_index,n) = input(g) - end do - if (l_minus) then - fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) - end if - else - fldptr1d(:) = 0._r8 - !fldptr1d(:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr1d(n) = input(g) - end do - if (l_minus) then - fldptr1d(:) = -fldptr1d(:) - end if - end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 48) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) - end do - end if - - ! check for nans - call check_for_nans(input, trim(fldname), bounds%begg) - end if - - end subroutine state_setexport - - !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! ---------------------------------------------- @@ -1205,8 +1305,6 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! local variables type(ESMF_FieldStatus_Flag) :: status type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- @@ -1214,38 +1312,37 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + end subroutine state_getfldptr - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (present(fldptr2d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") - end if - endif ! status + !=============================================================================== + logical function fldchk(state, fldname) + ! ---------------------------------------------- + ! Determine if field with fldname is in the input state + ! ---------------------------------------------- - end subroutine state_getfldptr + ! input/output variables + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: fldname + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + ! ---------------------------------------------- + call ESMF_StateGet(state, trim(fldname), itemFlag) + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + fldchk = .true. + else + fldchk = .false. + endif + end function fldchk end module lnd_import_export From 78a979fd989f1c82875e995b030ddb6ecf7f5465 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 17 Dec 2020 14:46:50 -0700 Subject: [PATCH 034/219] Move call BalanceCheck to after call lnd2atm; use existing _grc vars --- src/biogeophys/BalanceCheckMod.F90 | 139 +++++++++------------------- src/biogeophys/Waterlnd2atmType.F90 | 7 +- src/main/clm_driver.F90 | 32 ++++--- src/main/lnd2atmMod.F90 | 5 +- 4 files changed, 70 insertions(+), 113 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index b9390c57b3..fb73adfaaf 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -24,7 +24,7 @@ module BalanceCheckMod use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type use WaterDiagnosticType, only : waterdiagnostic_type use Wateratm2lndType , only : wateratm2lnd_type -! use Waterlnd2atmType , only : waterlnd2atm_type ! slevis: place holder + use Waterlnd2atmType , only : waterlnd2atm_type use WaterBalanceType , only : waterbalance_type use WaterFluxType , only : waterflux_type use WaterType , only : water_type @@ -356,8 +356,7 @@ subroutine BalanceCheck( bounds, & num_allc, filter_allc, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & - surfalb_inst, energyflux_inst, canopystate_inst) -! waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) + waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) ! ! !DESCRIPTION: ! This subroutine accumulates the numerical truncation errors of the water @@ -390,7 +389,7 @@ subroutine BalanceCheck( bounds, & class(waterstate_type), intent(in) :: waterstate_inst type(waterdiagnosticbulk_type), intent(in) :: waterdiagnosticbulk_inst class(waterbalance_type), intent(inout) :: waterbalance_inst -! class(waterlnd2atm_type), intent(in) :: waterlnd2atm_inst + class(waterlnd2atm_type), intent(in) :: waterlnd2atm_inst class(wateratm2lnd_type) , intent(in) :: wateratm2lnd_inst type(surfalb_type) , intent(in) :: surfalb_inst type(energyflux_type) , intent(inout) :: energyflux_inst @@ -405,18 +404,9 @@ subroutine BalanceCheck( bounds, & real(r8) :: forc_rain_col(bounds%begc:bounds%endc) ! column level rain rate [mm/s] real(r8) :: forc_snow_col(bounds%begc:bounds%endc) ! column level snow rate [mm/s] real(r8) :: h2osno_total(bounds%begc:bounds%endc) ! total snow water [mm H2O] - real(r8) :: endwb_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_irrig_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_glcice_dyn_water_flux_locgrc(bounds%begg:bounds%endg) ! water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) - real(r8) :: qflx_evap_tot_locgrc(bounds%begg:bounds%endg) ! grid cell level total evapotranspiration [mm/s] - real(r8) :: qflx_surf_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_drain_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_drain_perched_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_qrgwl_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_ice_runoff_snwcp_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_ice_runoff_xs_locgrc(bounds%begg:bounds%endg) ! slevis: using local for now - real(r8) :: qflx_snwcp_discarded_liq_locgrc(bounds%begg:bounds%endg) ! excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] - real(r8) :: qflx_snwcp_discarded_ice_locgrc(bounds%begg:bounds%endg) ! excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] + real(r8) :: qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg) ! grid cell-level water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) + real(r8) :: qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg) ! grid cell-level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] + real(r8) :: qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg) ! grid cell-level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -446,7 +436,7 @@ subroutine BalanceCheck( bounds, & frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) begwb_grc => waterbalance_inst%begwb_grc , & ! Input: [real(r8) (:) ] grid cell-level water mass begining of the time step -! endwb_grc => waterbalance_inst%endwb_grc , & ! Output: [real(r8) (:) ] grid cell-level water mass end of the time step + endwb_grc => waterbalance_inst%endwb_grc , & ! Output: [real(r8) (:) ] grid cell-level water mass end of the time step errh2o_grc => waterbalance_inst%errh2o_grc , & ! Output: [real(r8) (:) ] grid cell-level water conservation error (mm H2O) begwb_col => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] column-level water mass begining of the time step endwb_col => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] column-level water mass end of the time step @@ -461,7 +451,7 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_liq => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` qflx_snwcp_discarded_ice => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` qflx_evap_tot => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg -! qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc, & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc, & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_soliddew_to_top_layer => waterflux_inst%qflx_soliddew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_solidevap_from_top_layer => waterflux_inst%qflx_solidevap_from_top_layer_col, & ! Input: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] qflx_liqevap_from_top_layer => waterflux_inst%qflx_liqevap_from_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] @@ -470,24 +460,23 @@ subroutine BalanceCheck( bounds, & qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) -! qflx_rofliq_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) + qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] total runoff due to flooding qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack ! qflx_liq_dynbal_grc => waterflux_inst%qflx_liq_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder ! qflx_ice_dynbal_grc => waterflux_inst%qflx_ice_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder -! qflx_runoff_col => waterflux_inst%qflx_runoff_col , & ! total runoff (mm H2O / s) slevis: place holder qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) -! qflx_rofliq_qsur_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) + qflx_surf_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes -! qflx_rofliq_qgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes + qflx_qrgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) -! qflx_rofliq_qsub_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) - qflx_ice_runoff_snwcp => waterflux_inst%qflx_ice_runoff_snwcp_col, & ! Input: [real(r8) (:) ] solid runoff from snow capping (mm H2O /s) - qflx_ice_runoff_xs => waterflux_inst%qflx_ice_runoff_xs_col , & ! Input: [real(r8) (:) ] solid runoff from excess ice in soil (mm H2O /s) + qflx_drain_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) + qflx_ice_runoff => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) + qflx_ice_runoff_grc => waterlnd2atm_inst%qflx_rofice_grc , & ! Input: [real(r8) (:) ] grid cell-level solid runoff from snow capping and from excess ice in soil (mm H2O /s) qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Input: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) qflx_sfc_irrig => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) -! qirrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) + qirrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) qflx_glcice_dyn_water_flux => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) @@ -566,8 +555,7 @@ subroutine BalanceCheck( bounds, & - qflx_qrgwl(c) & - qflx_drain(c) & - qflx_drain_perched(c) & - - qflx_ice_runoff_snwcp(c) & - - qflx_ice_runoff_xs(c) & + - qflx_ice_runoff(c) & - qflx_snwcp_discarded_liq(c) & - qflx_snwcp_discarded_ice(c)) * dtime @@ -605,8 +593,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime - write(iulog,*)'qflx_ice_runoff_snwcp = ',qflx_ice_runoff_snwcp(indexc)*dtime - write(iulog,*)'qflx_ice_runoff_xs = ',qflx_ice_runoff_xs(indexc)*dtime + write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff(indexc)*dtime write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime @@ -630,71 +617,34 @@ subroutine BalanceCheck( bounds, & ! Water balance check at the grid cell level - call c2g(bounds, & - endwb_col(bounds%begc:bounds%endc), & - endwb_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type='urbanf', l2g_scale_type='unity') - call c2g( bounds, & - qflx_sfc_irrig(bounds%begc:bounds%endc), & - qflx_irrig_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & qflx_glcice_dyn_water_flux(bounds%begc:bounds%endc), & - qflx_glcice_dyn_water_flux_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_evap_tot(bounds%begc:bounds%endc), & - qflx_evap_tot_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_surf(bounds%begc:bounds%endc), & - qflx_surf_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_qrgwl(bounds%begc:bounds%endc), & - qflx_qrgwl_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_drain(bounds%begc:bounds%endc), & - qflx_drain_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_drain_perched(bounds%begc:bounds%endc), & - qflx_drain_perched_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_ice_runoff_snwcp(bounds%begc:bounds%endc), & - qflx_ice_runoff_snwcp_locgrc(bounds%begg:bounds%endg), & - c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call c2g( bounds, & - qflx_ice_runoff_xs(bounds%begc:bounds%endc), & - qflx_ice_runoff_xs_locgrc(bounds%begg:bounds%endg), & + qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & qflx_snwcp_discarded_liq(bounds%begc:bounds%endc), & - qflx_snwcp_discarded_liq_locgrc(bounds%begg:bounds%endg), & + qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & qflx_snwcp_discarded_ice(bounds%begc:bounds%endc), & - qflx_snwcp_discarded_ice_locgrc(bounds%begg:bounds%endg), & + qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - errh2o_grc(g) = endwb_locgrc(g) - begwb_grc(g) & + errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & + forc_snow_grc(g) & + qflx_flood_grc(g) & - + qflx_irrig_locgrc(g) & - + qflx_glcice_dyn_water_flux_locgrc(g) & - - qflx_evap_tot_locgrc(g) & - - qflx_surf_locgrc(g) & - - qflx_qrgwl_locgrc(g) & - - qflx_drain_locgrc(g) & - - qflx_drain_perched_locgrc(g) & - - qflx_ice_runoff_snwcp_locgrc(g) & - - qflx_ice_runoff_xs_locgrc(g) & - - qflx_snwcp_discarded_liq_locgrc(g) & - - qflx_snwcp_discarded_ice_locgrc(g)) * dtime + + qirrig_grc(g) & + + qflx_glcice_dyn_water_flux_grc(g) & + - qflx_evap_tot_grc(g) & + - qflx_surf_grc(g) & + - qflx_qrgwl_grc(g) & + - qflx_drain_grc(g) & + - qflx_drain_perched_grc(g) & + - qflx_ice_runoff_grc(g) & + - qflx_snwcp_discarded_liq_grc(g) & + - qflx_snwcp_discarded_ice_grc(g)) * dtime end do errh2o_max_val = maxval(abs(errh2o_grc(bounds%begg:bounds%endg))) @@ -713,23 +663,22 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errh2o_grc = ',errh2o_grc(indexg) write(iulog,*)'forc_rain = ',forc_rain_grc(indexg)*dtime write(iulog,*)'forc_snow = ',forc_snow_grc(indexg)*dtime - write(iulog,*)'endwb_loc = ',endwb_locgrc(indexg) + write(iulog,*)'endwb_grc = ',endwb_grc(indexg) write(iulog,*)'begwb_grc = ',begwb_grc(indexg) - write(iulog,*)'qflx_evap_tot_loc = ',qflx_evap_tot_locgrc(indexg)*dtime - write(iulog,*)'qflx_irrig_loc = ',qflx_irrig_locgrc(indexg)*dtime - write(iulog,*)'qflx_surf_loc = ',qflx_surf_locgrc(indexg)*dtime - write(iulog,*)'qflx_qrgwl_loc = ',qflx_qrgwl_locgrc(indexg)*dtime - write(iulog,*)'qflx_drain_loc = ',qflx_drain_locgrc(indexg)*dtime - write(iulog,*)'qflx_ice_runoff_snwcp_loc = ',qflx_ice_runoff_snwcp_locgrc(indexg)*dtime - write(iulog,*)'qflx_ice_runoff_xs_loc = ',qflx_ice_runoff_xs_locgrc(indexg)*dtime - write(iulog,*)'qflx_snwcp_discarded_ice_loc = ',qflx_snwcp_discarded_ice_locgrc(indexg)*dtime - write(iulog,*)'qflx_snwcp_discarded_liq_loc = ',qflx_snwcp_discarded_liq_locgrc(indexg)*dtime - write(iulog,*)'deltawb = ',endwb_locgrc(indexg)-begwb_grc(indexg) - write(iulog,*)'deltawb/dtime = ',(endwb_locgrc(indexg)-begwb_grc(indexg))/dtime - write(iulog,*)'qflx_drain_perched_loc = ',qflx_drain_perched_locgrc(indexg)*dtime + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot_grc(indexg)*dtime + write(iulog,*)'qirrig = ',qirrig_grc(indexg)*dtime + write(iulog,*)'qflx_surf = ',qflx_surf_grc(indexg)*dtime + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl_grc(indexg)*dtime + write(iulog,*)'qflx_drain = ',qflx_drain_grc(indexg)*dtime + write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff_grc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_grc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_grc(indexg)*dtime + write(iulog,*)'deltawb = ',endwb_grc(indexg)-begwb_grc(indexg) + write(iulog,*)'deltawb/dtime = ',(endwb_grc(indexg)-begwb_grc(indexg))/dtime + write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_grc(indexg)*dtime write(iulog,*)'qflx_flood = ',qflx_flood_grc(indexg)*dtime - write(iulog,*)'qflx_glcice_dyn_water_flux_grc_loc = ',qflx_glcice_dyn_water_flux_locgrc(indexg)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux_grc = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime write(iulog,*)'clm model is stopping' call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) diff --git a/src/biogeophys/Waterlnd2atmType.F90 b/src/biogeophys/Waterlnd2atmType.F90 index ed6e9ca0dd..fb59d1c83c 100644 --- a/src/biogeophys/Waterlnd2atmType.F90 +++ b/src/biogeophys/Waterlnd2atmType.F90 @@ -32,7 +32,8 @@ module Waterlnd2atmType real(r8), pointer :: qflx_rofliq_qsub_grc (:) ! rof liq -- subsurface runoff component real(r8), pointer :: qflx_rofliq_qgwl_grc (:) ! rof liq -- glacier, wetland and lakes water balance residual component real(r8), pointer :: qflx_rofliq_drain_perched_grc (:) ! rof liq -- perched water table runoff component - real(r8), pointer :: qflx_rofice_grc (:) ! rof ice forcing + real(r8), pointer :: qflx_ice_runoff_col(:) ! rof ice forcing, col level + real(r8), pointer :: qflx_rofice_grc (:) ! rof ice forcing, grc level real(r8), pointer :: qflx_liq_from_ice_col(:) ! liquid runoff from converted ice runoff real(r8), pointer :: qirrig_grc (:) ! irrigation flux @@ -119,6 +120,10 @@ subroutine InitAllocate(this, bounds, tracer_vars) container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL, & ival=ival) + call AllocateVar1d(var = this%qflx_ice_runoff_col, name = 'qflx_ice_runoff_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN, & + ival=ival) call AllocateVar1d(var = this%qflx_rofice_grc, name = 'qflx_rofice_grc', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL, & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 943106bbd2..eb94d5de83 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -1105,20 +1105,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro filter(nc)%num_soilp, filter(nc)%soilp, & filter(nc)%num_allc, filter(nc)%allc) - ! ============================================================================ - ! Check the energy and water balance - ! ============================================================================ - - call t_startf('balchk') - call BalanceCheck(bounds_clump, & - filter(nc)%num_allc, filter(nc)%allc, & - atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & - water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & - surfalb_inst, energyflux_inst, canopystate_inst) -! water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, canopystate_inst) - call t_stopf('balchk') - ! ============================================================================ ! Check the carbon and nitrogen balance ! ============================================================================ @@ -1272,6 +1258,24 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro !$OMP END PARALLEL DO call t_stopf('lnd2glc') + ! ========================================================================== + ! Check the energy and water balance + ! ========================================================================== + + call t_startf('balchk') + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + call BalanceCheck(bounds_clump, & + filter(nc)%num_allc, filter(nc)%allc, & + atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & + water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, canopystate_inst) + end do + !$OMP END PARALLEL DO + call t_stopf('balchk') + ! ============================================================================ ! Write global average diagnostics to standard output ! ============================================================================ diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index e7052b6020..d3eb22d610 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -180,7 +180,6 @@ subroutine lnd2atm(bounds, & ! ! !LOCAL VARIABLES: integer :: c, g ! indices - real(r8) :: qflx_ice_runoff_col(bounds%begc:bounds%endc) ! total column-level ice runoff real(r8) :: eflx_sh_ice_to_liq_grc(bounds%begg:bounds%endg) ! sensible heat flux generated from the ice to liquid conversion, averaged to gridcell real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen @@ -193,7 +192,7 @@ subroutine lnd2atm(bounds, & call handle_ice_runoff(bounds, water_inst%waterfluxbulk_inst, glc_behavior, & melt_non_icesheet_ice_runoff = lnd2atm_inst%params%melt_non_icesheet_ice_runoff, & - qflx_ice_runoff_col = qflx_ice_runoff_col(bounds%begc:bounds%endc), & + qflx_ice_runoff_col = water_inst%waterlnd2atmbulk_inst%qflx_ice_runoff_col(bounds%begc:bounds%endc), & qflx_liq_from_ice_col = water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(bounds%begc:bounds%endc), & eflx_sh_ice_to_liq_col = lnd2atm_inst%eflx_sh_ice_to_liq_col(bounds%begc:bounds%endc)) @@ -391,7 +390,7 @@ subroutine lnd2atm(bounds, & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & - qflx_ice_runoff_col(bounds%begc:bounds%endc), & + water_inst%waterlnd2atmbulk_inst%qflx_ice_runoff_col(bounds%begc:bounds%endc), & water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg From 4ab9f3d54e7151b80d3b5b08f4e5ed5d857ed746 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 17 Dec 2020 19:21:53 -0700 Subject: [PATCH 035/219] Some clean-up before moving on to solving the transient h2o balance --- src/biogeophys/BalanceCheckMod.F90 | 108 ++++++++++++++--------------- 1 file changed, 54 insertions(+), 54 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index fb73adfaaf..91c6b9c0e9 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -377,7 +377,7 @@ subroutine BalanceCheck( bounds, & use clm_time_manager , only : get_step_size_real, get_nstep use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type - use subgridAveMod ! , only : c2g ? + use subgridAveMod , only : c2g ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -424,11 +424,10 @@ subroutine BalanceCheck( bounds, & associate( & forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (vis=forc_sols , nir=forc_soll ) forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (vis=forc_solsd, nir=forc_solld) - forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] grid cell-level rain rate [mm/s] - forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] grid cell-level snow rate [mm/s] - qflx_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] total grid cell-level runoff from river model - forc_rain => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] - forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_rain => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] column level rain rate [mm/s] + forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc, & ! Input: [real(r8) (:)] grid cell-level rain rate [mm/s] + forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] column level snow rate [mm/s] + forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc, & ! Input: [real(r8) (:)] grid cell-level snow rate [mm/s] forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) h2osno_old => waterbalance_inst%h2osno_old_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) at previous time step @@ -448,10 +447,10 @@ subroutine BalanceCheck( bounds, & qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Input: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_col , & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping (outgoing) (mm H2O /s) [+]` qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping (outgoing) (mm H2O /s) [+]` - qflx_snwcp_discarded_liq => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` - qflx_snwcp_discarded_ice => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` - qflx_evap_tot => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg - qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc, & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_snwcp_discarded_liq_col => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] column level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_snwcp_discarded_ice_col => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] column level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_evap_tot_col => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] column level qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_soliddew_to_top_layer => waterflux_inst%qflx_soliddew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_solidevap_from_top_layer => waterflux_inst%qflx_solidevap_from_top_layer_col, & ! Input: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] qflx_liqevap_from_top_layer => waterflux_inst%qflx_liqevap_from_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] @@ -459,25 +458,26 @@ subroutine BalanceCheck( bounds, & qflx_prec_grnd => waterdiagnosticbulk_inst%qflx_prec_grnd_col, & ! Input: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice - qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) - qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) - qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] total runoff due to flooding + qflx_drain_perched_col => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) + qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) + qflx_flood_col => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column level total runoff due to flooding + forc_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] grid cell-level total grid cell-level runoff from river model qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack ! qflx_liq_dynbal_grc => waterflux_inst%qflx_liq_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder ! qflx_ice_dynbal_grc => waterflux_inst%qflx_ice_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder - qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_surf_col => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] column level surface runoff (mm H2O /s) qflx_surf_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) - qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes + qflx_qrgwl_col => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] column level qflx_surf at glaciers, wetlands, lakes qflx_qrgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes - qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_drain_col => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) qflx_drain_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) - qflx_ice_runoff => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) + qflx_ice_runoff_col => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) qflx_ice_runoff_grc => waterlnd2atm_inst%qflx_rofice_grc , & ! Input: [real(r8) (:) ] grid cell-level solid runoff from snow capping and from excess ice in soil (mm H2O /s) qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Input: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) - qflx_sfc_irrig => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) - qirrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) - qflx_glcice_dyn_water_flux => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) + qflx_sfc_irrig_col => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] column level irrigation flux (mm H2O /s) + qflx_sfc_irrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) + qflx_glcice_dyn_water_flux_col => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] column level water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] @@ -547,17 +547,17 @@ subroutine BalanceCheck( bounds, & errh2o_col(c) = endwb_col(c) - begwb_col(c) & - (forc_rain_col(c) & + forc_snow_col(c) & - + qflx_floodc(c) & - + qflx_sfc_irrig(c) & - + qflx_glcice_dyn_water_flux(c) & - - qflx_evap_tot(c) & - - qflx_surf(c) & - - qflx_qrgwl(c) & - - qflx_drain(c) & - - qflx_drain_perched(c) & - - qflx_ice_runoff(c) & - - qflx_snwcp_discarded_liq(c) & - - qflx_snwcp_discarded_ice(c)) * dtime + + qflx_flood_col(c) & + + qflx_sfc_irrig_col(c) & + + qflx_glcice_dyn_water_flux_col(c) & + - qflx_evap_tot_col(c) & + - qflx_surf_col(c) & + - qflx_qrgwl_col(c) & + - qflx_drain_col(c) & + - qflx_drain_perched_col(c) & + - qflx_ice_runoff_col(c) & + - qflx_snwcp_discarded_liq_col(c) & + - qflx_snwcp_discarded_ice_col(c)) * dtime else @@ -587,25 +587,25 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'endwb_col = ',endwb_col(indexc) write(iulog,*)'begwb_col = ',begwb_col(indexc) - write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime - write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime - write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime - write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot_col(indexc)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig_col(indexc)*dtime + write(iulog,*)'qflx_surf = ',qflx_surf_col(indexc)*dtime + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl_col(indexc)*dtime + write(iulog,*)'qflx_drain = ',qflx_drain_col(indexc)*dtime - write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff(indexc)*dtime + write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff_col(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'deltawb = ',endwb_col(indexc)-begwb_col(indexc) write(iulog,*)'deltawb/dtime = ',(endwb_col(indexc)-begwb_col(indexc))/dtime if (.not.(col%itype(indexc) == icol_roof .or. & col%itype(indexc) == icol_road_imperv .or. & col%itype(indexc) == icol_road_perv)) then - write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched(indexc)*dtime - write(iulog,*)'qflx_flood = ',qflx_floodc(indexc)*dtime - write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux(indexc)*dtime + write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_col(indexc)*dtime + write(iulog,*)'qflx_flood = ',qflx_flood_col(indexc)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux_col(indexc)*dtime end if write(iulog,*)'clm model is stopping' @@ -618,15 +618,15 @@ subroutine BalanceCheck( bounds, & ! Water balance check at the grid cell level call c2g( bounds, & - qflx_glcice_dyn_water_flux(bounds%begc:bounds%endc), & + qflx_glcice_dyn_water_flux_col(bounds%begc:bounds%endc), & qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & - qflx_snwcp_discarded_liq(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_liq_col(bounds%begc:bounds%endc), & qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & - qflx_snwcp_discarded_ice(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_ice_col(bounds%begc:bounds%endc), & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) @@ -634,8 +634,8 @@ subroutine BalanceCheck( bounds, & errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & + forc_snow_grc(g) & - + qflx_flood_grc(g) & - + qirrig_grc(g) & + + forc_flood_grc(g) & + + qflx_sfc_irrig_grc(g) & + qflx_glcice_dyn_water_flux_grc(g) & - qflx_evap_tot_grc(g) & - qflx_surf_grc(g) & @@ -667,7 +667,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'begwb_grc = ',begwb_grc(indexg) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot_grc(indexg)*dtime - write(iulog,*)'qirrig = ',qirrig_grc(indexg)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig_grc(indexg)*dtime write(iulog,*)'qflx_surf = ',qflx_surf_grc(indexg)*dtime write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl_grc(indexg)*dtime write(iulog,*)'qflx_drain = ',qflx_drain_grc(indexg)*dtime @@ -677,7 +677,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'deltawb = ',endwb_grc(indexg)-begwb_grc(indexg) write(iulog,*)'deltawb/dtime = ',(endwb_grc(indexg)-begwb_grc(indexg))/dtime write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_grc(indexg)*dtime - write(iulog,*)'qflx_flood = ',qflx_flood_grc(indexg)*dtime + write(iulog,*)'forc_flood = ',forc_flood_grc(indexg)*dtime write(iulog,*)'qflx_glcice_dyn_water_flux_grc = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime write(iulog,*)'clm model is stopping' @@ -709,7 +709,7 @@ subroutine BalanceCheck( bounds, & + qflx_liqdew_to_top_layer(c) snow_sinks(c) = qflx_solidevap_from_top_layer(c) + qflx_liqevap_from_top_layer(c) & + qflx_snow_drain(c) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_sl_top_soil(c) if (lun%itype(l) == istdlak) then @@ -718,7 +718,7 @@ subroutine BalanceCheck( bounds, & + qflx_soliddew_to_top_layer(c) + qflx_liqdew_to_top_layer(c) ) snow_sinks(c) = frac_sno_eff(c) * (qflx_solidevap_from_top_layer(c) & + qflx_liqevap_from_top_layer(c) ) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_snow_drain(c) + qflx_sl_top_soil(c) endif @@ -731,7 +731,7 @@ subroutine BalanceCheck( bounds, & + qflx_h2osfc_to_ice(c) snow_sinks(c) = frac_sno_eff(c) * (qflx_solidevap_from_top_layer(c) & + qflx_liqevap_from_top_layer(c)) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_snow_drain(c) + qflx_sl_top_soil(c) endif @@ -780,8 +780,8 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_liqdew_to_top_layer = ',qflx_liqdew_to_top_layer(indexc)*dtime write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc)*dtime write(iulog,*)'qflx_snwcp_liq = ',qflx_snwcp_liq(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime write(iulog,*)'clm model is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) From bf37912f23f8aec28890bcba3055020d8b7e9998 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 19 Dec 2020 13:10:42 -0700 Subject: [PATCH 036/219] remove extraneous write statement --- src/cpl/nuopc/lnd_import_export.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index a705060911..c951e39505 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -543,7 +543,6 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Atmosphere prognostic/prescribed aerosol fields if (fldchk(importState, 'Faxa_bcph')) then - write(6,*)'i am here' call state_getfldptr(importState, 'Faxa_bcph', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call check_for_nans(fldptr2d(1,:), 'Faxa_bcph(1)', begg) From 77b48f3f82fd1002b46b8208c219a15b3f47776f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 19 Dec 2020 20:03:34 -0700 Subject: [PATCH 037/219] fixed bugs --- src/cpl/nuopc/lnd_import_export.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index c951e39505..8c9359c3a4 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -687,15 +687,17 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & else wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 end if + if (fldchk(importState, 'Flrr_volr')) then - call state_getfldptr(importState, 'Flrr_flood', fldptr1d=fldptr1d, rc=rc ) + call state_getfldptr(importState, 'Flrr_volr', fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg - wateratm2lndbulk_inst%forc_flood_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) + wateratm2lndbulk_inst%volr_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) end do else wateratm2lndbulk_inst%volr_grc(:) = 0._r8 end if + if (fldchk(importState, 'Flrr_volrmch')) then call state_getfldptr(importState, 'Flrr_volrmch', fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -733,7 +735,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if ( fldchk(importState, 'Sl_topo_elev')) then + if ( fldchk(importState, 'Flgg_hflx_elev')) then call state_getfldptr(importState, 'Flgg_hflx_elev', fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg @@ -752,7 +754,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end if if ( fldchk(importState, 'Sg_icemask_coupled_fluxes')) then - call state_getfldptr(importState, 'Sg_icemask', fldptr1d=fldptr1d, rc=rc) + call state_getfldptr(importState, 'Sg_icemask_coupled_fluxes', fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg icemask_coupled_fluxes_grc(g) = fldptr1d(g-begg+1) From c974d6dc4368958d509de694467c752af979b02f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 19 Dec 2020 20:14:40 -0700 Subject: [PATCH 038/219] cleaned up import name specification --- src/cpl/nuopc/lnd_import_export.F90 | 200 ++++++++++++++++------------ 1 file changed, 116 insertions(+), 84 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 8c9359c3a4..9169f5c1aa 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -94,7 +94,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r character(ESMF_MAXSTR) :: cvalue character(len=2) :: nec_str integer :: n, num - character(len=128) :: fldname + character(len=CS) :: fldname character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -381,7 +381,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8), pointer :: dataPtr(:) real(r8), pointer :: fldPtr1d(:) real(r8), pointer :: fldPtr2d(:,:) - character(len=128) :: fldname + character(len=CS) :: fldname integer :: num integer :: begg, endg ! bounds integer :: g,i,k,n ! indices @@ -423,131 +423,149 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Required atmosphere input fields !-------------------------- - call state_getfldptr(importState, 'Sa_z', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_z' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_z', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_hgt_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_topo', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_topo' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_topo', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_topo_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_u', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_u' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_u', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_u_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_v', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_v' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_v', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_v_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_ptem', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_ptem' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_ptem', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_th_not_downscaled_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_shum', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_shum' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_shum', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_pbot', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_pbot' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_pbot', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Sa_tbot', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sa_tbot' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_tbot', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_t_not_downscaled_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_rainc', fldptr1d=fldptr1d, rc=rc) + fldname = 'Faxa_rainc' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_rainc', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg forc_rainc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_rainl', fldptr1d=fldptr1d, rc=rc) + fldname = 'Faxa_rainl' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_rainl', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg forc_rainl(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_snowc', fldptr1d=fldptr1d, rc=rc) + fldname = 'Faxa_snowc' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_snowc', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg forc_snowc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_snowl', fldptr1d=fldptr1d, rc=rc) + fldname = 'Faxa_snowl' + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_snowl', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg forc_snowl(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_lwdn', fldptr1d, rc=rc) - call check_for_nans(fldptr1d, 'Faxa_lwdn', begg) + fldname = 'Faxa_lwdn' + call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_swvdr', fldptr1d, rc=rc) + fldname = 'Faxa_swvdr' + call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_swvdr', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_solad_grc(g,1) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_swndr', fldptr1d, rc=rc) + fldname = 'Faxa_swndr' + call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_swndr', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_solad_grc(g,2) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_swvdf', fldptr1d, rc=rc) + fldname = 'Faxa_swvdf' + call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_swvdf', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_solai_grc(g,1) = fldptr1d(g-begg+1) end do - call state_getfldptr(importState, 'Faxa_swndf', fldptr1d, rc=rc) + fldname = 'Faxa_swndf' + call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Faxa_swndf', begg) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_solai_grc(g,2) = fldptr1d(g-begg+1) end do ! Atmosphere prognostic/prescribed aerosol fields - if (fldchk(importState, 'Faxa_bcph')) then - call state_getfldptr(importState, 'Faxa_bcph', fldptr2d=fldptr2d, rc=rc) + fldname = 'Faxa_bcph' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), 'Faxa_bcph(1)', begg) - call check_for_nans(fldptr2d(2,:), 'Faxa_bcph(2)', begg) - call check_for_nans(fldptr2d(3,:), 'Faxa_bcph(3)', begg) + call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) + call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) + call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) do g = begg, endg n = g - begg + 1 atm2lnd_inst%forc_aer_grc(g,1) = fldptr2d(1,n) ! bcphidry @@ -555,12 +573,13 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst%forc_aer_grc(g,3) = fldptr2d(3,n) ! bcphiwet end do end if - if (fldchk(importState, 'Faxa_ocph')) then - call state_getfldptr(importState, 'Faxa_ocph', fldptr2d=fldptr2d, rc=rc) + fldname = 'Faxa_ocph' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), 'Faxa_ocph(1)', begg) - call check_for_nans(fldptr2d(2,:), 'Faxa_ocph(2)', begg) - call check_for_nans(fldptr2d(3,:), 'Faxa_ocph(3)', begg) + call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) + call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) + call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) do g = begg, endg n = g - begg + 1 atm2lnd_inst%forc_aer_grc(g,4) = fldptr2d(1,n) ! ocphidry @@ -568,14 +587,14 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst%forc_aer_grc(g,6) = fldptr2d(3,n) ! ocphiwet end do end if - - if (fldchk(importState, 'Faxa_dstwet')) then - call state_getfldptr(importState, 'Faxa_dstwet', fldptr2d=fldptr2d, rc=rc) + fldname = 'Faxa_dstwet' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), 'Faxa_dstwet(1)', begg) - call check_for_nans(fldptr2d(2,:), 'Faxa_dstwet(2)', begg) - call check_for_nans(fldptr2d(3,:), 'Faxa_dstwet(3)', begg) - call check_for_nans(fldptr2d(4,:), 'Faxa_dstwet(4)', begg) + call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) + call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) + call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) + call check_for_nans(fldptr2d(4,:), trim(fldname)//'(4)', begg) do g = begg, endg n = g - begg + 1 atm2lnd_inst%forc_aer_grc(g,7) = fldptr2d(1,n) @@ -584,13 +603,14 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst%forc_aer_grc(g,13) = fldptr2d(4,n) end do end if - if (fldchk(importState, 'Faxa_dstdry')) then - call state_getfldptr(importState, 'Faxa_dstdry', fldptr2d=fldptr2d, rc=rc) + fldname = 'Faxa_dstdry' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), 'Faxa_dstdry(1)', begg) - call check_for_nans(fldptr2d(2,:), 'Faxa_dstdry(2)', begg) - call check_for_nans(fldptr2d(3,:), 'Faxa_dstdry(3)', begg) - call check_for_nans(fldptr2d(4,:), 'Faxa_dstdry(4)', begg) + call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) + call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) + call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) + call check_for_nans(fldptr2d(4,:), trim(fldname)//'(4)', begg) do g = begg, endg n = g - begg + 1 atm2lnd_inst%forc_aer_grc(g,8) = fldptr2d(1,n) @@ -600,22 +620,23 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end if - if (fldchk(importState, 'Sa_methane')) then - call state_getfldptr(importState, 'Sa_methane', fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, 'Sa_methane', begg) + fldname = 'Sa_methane' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) + call check_for_nans(fldptr1d, trim(fldname), begg) do g = begg, endg atm2lnd_inst%forc_pch4_grc(g) = fldptr1d(g-begg+1) end do end if - if (fldchk(importState, 'Faxa_ndep')) then + fldname = 'Faxa_ndep' + if (fldchk(importState, trim(fldname))) then ! The mediator is sending ndep in units if kgN/m2/s - and ctsm ! uses units of gN/m2/sec so the following conversion needs to happen - call state_getfldptr(importState, 'Faxa_ndep', fldptr2d=fldptr2d, rc=rc) + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), 'Faxa_ndep(1)', begg) - call check_for_nans(fldptr2d(2,:), 'Faxa_ndep(2)', begg) + call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) + call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) do g = begg, endg n = g - begg + 1 atm2lnd_inst%forc_ndep_grc(g) = (fldptr2d(1,n) + fldptr2d(2,n))*1000._r8 @@ -678,8 +699,9 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! so water sent from rof to land is negative, ! change the sign to indicate addition of water to system. - if (fldchk(importState, 'Flrr_flood')) then - call state_getfldptr(importState, 'Flrr_flood', fldptr1d=fldptr1d, rc=rc ) + fldname = 'Flrr_flood' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg wateratm2lndbulk_inst%forc_flood_grc(g) = -fldptr1d(g-begg+1) @@ -688,8 +710,9 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 end if - if (fldchk(importState, 'Flrr_volr')) then - call state_getfldptr(importState, 'Flrr_volr', fldptr1d=fldptr1d, rc=rc ) + fldname = 'Flrr_volr' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg wateratm2lndbulk_inst%volr_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) @@ -698,8 +721,9 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & wateratm2lndbulk_inst%volr_grc(:) = 0._r8 end if - if (fldchk(importState, 'Flrr_volrmch')) then - call state_getfldptr(importState, 'Flrr_volrmch', fldptr1d=fldptr1d, rc=rc ) + fldname = 'Flrr_volrmch' + if (fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg wateratm2lndbulk_inst%volrmch_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) @@ -717,8 +741,9 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - if ( fldchk(importState, 'Sg_ice_covered_elev')) then - call state_getfldptr(importState, 'Sg_ice_covered_elev', fldptr2d=fldptr2d, rc=rc) + fldname = 'Sg_ice_covered_elev' + if ( fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg do num = 0,glc_nec @@ -726,8 +751,10 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if ( fldchk(importState, 'Sl_topo_elev')) then - call state_getfldptr(importState, 'Sg_topo_elev', fldptr2d=fldptr2d, rc=rc) + + fldname = 'Sg_topo_elev' + if ( fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg do num = 0,glc_nec @@ -735,8 +762,10 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if ( fldchk(importState, 'Flgg_hflx_elev')) then - call state_getfldptr(importState, 'Flgg_hflx_elev', fldptr2d=fldptr2d, rc=rc) + + fldname = 'Flgg_hflx_elev' + if ( fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg do num = 0,glc_nec @@ -746,15 +775,18 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & else hflx_grc(:,:) = 0._r8 end if - if ( fldchk(importState, 'Sg_icemask')) then - call state_getfldptr(importState, 'Sg_icemask', fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + fldname = 'Sg_icemask' + if ( fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) do g = begg, endg icemask_grc(g) = fldptr1d(g-begg+1) end do end if - if ( fldchk(importState, 'Sg_icemask_coupled_fluxes')) then - call state_getfldptr(importState, 'Sg_icemask_coupled_fluxes', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Sg_icemask_coupled_fluxes' + if ( fldchk(importState, trim(fldname))) then + call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg icemask_coupled_fluxes_grc(g) = fldptr1d(g-begg+1) From e289ca0c8934b8e04fdaf7ddf4dbe648ec851bb2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 20 Dec 2020 11:17:35 -0700 Subject: [PATCH 039/219] cleaned up export name specification --- src/cpl/nuopc/lnd_import_export.F90 | 219 ++++++++++++++++------------ 1 file changed, 127 insertions(+), 92 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 9169f5c1aa..ae0813135a 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -400,7 +400,6 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8) :: icemask_grc(bounds%begg:bounds%endg) real(r8) :: icemask_coupled_fluxes_grc(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:import_fields)' - !--------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -832,6 +831,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & type(ESMF_State) :: exportState real(r8), pointer :: fldPtr1d(:) real(r8), pointer :: fldPtr2d(:,:) + character(len=CS) :: fldname integer :: begg, endg ! bounds integer :: i, g, num real(r8) :: array(bounds%begg:bounds%endg) @@ -851,8 +851,9 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! output to mediator ! ----------------------- - if (fldchk(exportState, 'Sl_lfrin')) then - call state_getfldptr(exportState, 'Sl_lfrin', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_lfrin' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg @@ -863,128 +864,144 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! output to atm ! ----------------------- - if (fldchk(exportState, 'Sl_t')) then - call state_getfldptr(exportState, 'Sl_t', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_t' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%t_rad_grc(g) end do end if - if (fldchk(exportState, 'Sl_snowh')) then - call state_getfldptr(exportState, 'Sl_snowh', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_snowh' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osno_grc(g) end do end if - if (fldchk(exportState, 'Sl_avsdr')) then - call state_getfldptr(exportState, 'Sl_avsdr', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_avsdr' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,1) end do end if - if (fldchk(exportState, 'Sl_anidr')) then - call state_getfldptr(exportState, 'Sl_anidr', fldptr1d=fldptr1d, rc=rc) + fldname='Sl_anidr' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,2) end do end if - if (fldchk(exportState, 'Sl_avsdf')) then - call state_getfldptr(exportState, 'Sl_avsdf', fldptr1d=fldptr1d, rc=rc) + fldname= 'Sl_avsdf' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,1) end do end if - if (fldchk(exportState, 'Sl_anidf')) then - call state_getfldptr(exportState, 'Sl_anidf', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_anidf' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,2) end do end if - if (fldchk(exportState, 'Sl_tref')) then - call state_getfldptr(exportState, 'Sl_tref', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_tref' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%t_ref2m_grc(g) end do end if - if (fldchk(exportState, 'Sl_qref')) then - call state_getfldptr(exportState, 'Sl_qref', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_qref' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%q_ref2m_grc(g) end do end if - if (fldchk(exportState, 'Fall_taux')) then - call state_getfldptr(exportState, 'Fall_taux', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_taux' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%taux_grc(g) end do end if - if (fldchk(exportState, 'Fall_tauy')) then - call state_getfldptr(exportState, 'Fall_tauy', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_tauy' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%tauy_grc(g) end do end if - if (fldchk(exportState, 'Fall_lat')) then - call state_getfldptr(exportState, 'Fall_lat', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_lat' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lh_tot_grc(g) end do end if - if (fldchk(exportState, 'Fall_sen')) then - call state_getfldptr(exportState, 'Fall_sen', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_sen' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_sh_tot_grc(g) end do end if - if (fldchk(exportState, 'Fall_lwup')) then - call state_getfldptr(exportState, 'Fall_lwup', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_lwup' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lwrad_out_grc(g) end do end if - if (fldchk(exportState, 'Fall_evap')) then - call state_getfldptr(exportState, 'Fall_evap', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_evap' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g) end do end if - if (fldchk(exportState, 'Fall_swnet')) then - call state_getfldptr(exportState, 'Fall_swnet', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_swnet' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%fsa_grc(g) end do end if - if (fldchk(exportState, 'Fall_flxdst')) then - call state_getfldptr(exportState, 'Fall_flxdst', fldptr2d=fldptr2d, rc=rc) + fldname = 'Fall_flxdst' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg @@ -994,57 +1011,62 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & fldptr2d(4,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,4) end do end if - if (fldchk(exportState, 'Fall_methane')) then - call state_getfldptr(exportState, 'Fall_methane', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_methane' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%ch4_surf_flux_tot_grc(g) end do end if - if (fldchk(exportState, 'Sl_u10')) then - call state_getfldptr(exportState, 'Sl_u10', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_u10' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%u_ref10m_grc(g) end do end if - if (fldchk(exportState, 'Sl_ram1')) then - call state_getfldptr(exportState, 'Sl_ram1', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_ram1' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%ram1_grc(g) end do end if - if (fldchk(exportState, 'Sl_fv')) then - call state_getfldptr(exportState, 'Sl_fv', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_fv' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = lnd2atm_inst%fv_grc(g) end do end if - if (fldchk(exportState, 'Sl_soilw')) then - call state_getfldptr(exportState, 'Sl_soilw', fldptr1d=fldptr1d, rc=rc) + fldname = 'Sl_soilw' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1) end do end if - if (flds_co2b .or. flds_co2c) then - ! co2 from land - call state_getfldptr(exportState, 'Fall_fco2_lnd', fldptr1d=fldptr1d, rc=rc) + fldname = 'Fall_fco2_lnd' ! co2 from land + if (fldchk(exportState, trim(fldname) )) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = -lnd2atm_inst%net_carbon_exchange_grc(g) end do end if - if (fldchk(exportState, 'Sl_ddvel')) then - ! dry dep velocities - call state_getfldptr(exportState, 'Sl_ddvel', fldptr2d=fldptr2d, rc=rc) + fldname = 'Sl_ddvel' ! dry dep velocities + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg @@ -1053,9 +1075,9 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if (fldchk(exportState, 'Fall_voc')) then - ! megan voc emis fluxes - call state_getfldptr(exportState, 'Fall_voc', fldptr2d=fldptr2d, rc=rc) + fldname = 'Fall_voc' ! megan voc emis fluxes + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg @@ -1064,25 +1086,26 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if (fldchk(exportState, 'Fall_fire')) then - if (emis_nflds > 0) then - ! fire emis fluxes - call state_getfldptr(exportState, 'Fall_fire', fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 1, emis_nflds - fldptr2d(num,g-begg+1) = -lnd2atm_inst%fireflx_grc(g,num) - end do - end do - call state_getfldptr(exportState, 'Sl_fztop', fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%fireztop_grc(g) + fldname = 'Fall_fire' ! fire emis from land + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do g = begg, endg + do num = 1, emis_nflds + fldptr2d(num,g-begg+1) = -lnd2atm_inst%fireflx_grc(g,num) end do - end if - endif + end do + end if + fldname = 'Sl_fztop' ! fire emis from land + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + do g = begg, endg + fldptr1d(g-begg+1) = lnd2atm_inst%fireztop_grc(g) + end do + end if ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. ! i.e. water sent from land to rof is positive @@ -1096,17 +1119,20 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & ! waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - if (fldchk(exportState, 'Flrl_rofsur')) then - call state_getfldptr(exportState, 'Flrl_rofsur', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Flrl_rofsur' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) end do end if - if (fldchk(exportState, 'Flrl_rofsub')) then - ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - call state_getfldptr(exportState, 'Flrl_rofsub', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Flrl_rofsub' ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg @@ -1114,27 +1140,30 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) end do end if - if (fldchk(exportState, 'Flrl_rofgwl')) then - ! qgwl sent individually to coupler - call state_getfldptr(exportState, 'Flrl_rofgwl', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Flrl_rofgwl' ! qgwl sent individually to mediator + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) end do end if - if (fldchk(exportState, 'Flrl_rofi')) then - ! ice sent individually to coupler - call state_getfldptr(exportState, 'Flrl_rofi', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Flrl_rofi' ! ice sent individually to mediator + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofice_grc(g) end do end if - if (fldchk(exportState, 'Flrl_irrig')) then - ! irrigation flux to be removed from main channel storage (negative) - call state_getfldptr(exportState, 'Flrl_irrig', fldptr1d=fldptr1d, rc=rc) + + fldname = 'Flrl_irrig' ! irrigation flux to be removed from main channel storage (negative) + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 do g = begg, endg @@ -1148,8 +1177,10 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! We could avoid setting these fields if glc_present is .false., if that would ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - if (fldchk(exportState, 'Sl_tsrf_elev')) then - call state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2d=fldptr2d, rc=rc) + + fldname = 'Sl_tsrf_elev' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg @@ -1158,8 +1189,10 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if (fldchk(exportState, 'Sl_topo_elev')) then - call state_getfldptr(exportState, 'Sl_topo_elev', fldptr2d=fldptr2d, rc=rc) + + fldname = 'Sl_topo_elev' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg @@ -1168,8 +1201,10 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end do end if - if (fldchk(exportState, 'Flgl_qice_elev')) then - call state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2d=fldptr2d, rc=rc) + + fldname = 'Flgl_qice_elev' + if (fldchk(exportState, trim(fldname))) then + call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do g = begg, endg From 4f3a139d811226c89c82ab891e486ff9cda6ded9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 21 Dec 2020 20:41:24 -0700 Subject: [PATCH 040/219] refactor lnd_import_export.F90 with better interfaces --- src/cpl/nuopc/lnd_import_export.F90 | 1101 +++++++++++---------------- 1 file changed, 451 insertions(+), 650 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index ae0813135a..4dd10675b4 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -66,6 +66,78 @@ module lnd_import_export integer :: glc_nec ! number of glc elevation classes integer, parameter :: debug = 0 ! internal debug level + ! import fields + character(*), parameter :: Sa_z = 'Sa_z' + character(*), parameter :: Sa_topo = 'Sa_topo' + character(*), parameter :: Sa_u = 'Sa_u' + character(*), parameter :: Sa_v = 'Sa_v' + character(*), parameter :: Sa_ptem = 'Sa_ptem' + character(*), parameter :: Sa_shum = 'Sa_shum' + character(*), parameter :: Sa_pbot = 'Sa_pbot' + character(*), parameter :: Sa_tbot = 'Sa_tbot' + character(*), parameter :: Faxa_rainc = 'Faxa_rainc' + character(*), parameter :: Faxa_rainl = 'Faxa_rainl' + character(*), parameter :: Faxa_snowc = 'Faxa_snowc' + character(*), parameter :: Faxa_snowl = 'Faxa_snowl' + character(*), parameter :: Faxa_lwdn = 'Faxa_lwdn' + character(*), parameter :: Faxa_swvdr = 'Faxa_swvdr' + character(*), parameter :: Faxa_swndr = 'Faxa_swndr' + character(*), parameter :: Faxa_swvdf = 'Faxa_swvdf' + character(*), parameter :: Faxa_swndf = 'Faxa_swndf' + character(*), parameter :: Faxa_bcph = 'Faxa_bcph' + character(*), parameter :: Faxa_ocph = 'Faxa_ocph' + character(*), parameter :: Faxa_dstwet = 'Faxa_dstwet' + character(*), parameter :: Faxa_dstdry = 'Faxa_dstdry' + character(*), parameter :: Sa_methane = 'Sa_methaneaxa_ndep' + character(*), parameter :: Faxa_ndep = 'Faxa_ndep' + character(*), parameter :: Sa_co2prog = 'Sa_co2prog' + character(*), parameter :: Sa_co2diag = 'Sa_co2diag' + character(*), parameter :: Flrr_flood = 'Flrr_flood' + character(*), parameter :: Flrr_volr = 'Flrr_volr' + character(*), parameter :: Flrr_volrmch = 'Flrr_volrmch' + character(*), parameter :: Sg_ice_covered_elev = 'Sg_ice_covered_elev' + character(*), parameter :: Sg_topo_elev = 'Sg_topo_elev' + character(*), parameter :: Flgg_hflx_elev = 'Flgg_hflx_elev' + character(*), parameter :: Sg_icemask = 'Sg_icemask' + character(*), parameter :: Sg_icemask_coupled_fluxes = 'Sg_icemask_coupled_fluxes' + + ! export fields + character(*), parameter :: Sl_lfrin = 'Sl_lfrin' + character(*), parameter :: Sl_t = 'Sl_t' + character(*), parameter :: Sl_snowh = 'Sl_snowh' + character(*), parameter :: Sl_avsdr = 'Sl_avsdr' + character(*), parameter :: Sl_anidr = 'Sl_anidr' + character(*), parameter :: Sl_avsdf = 'Sl_avsdf' + character(*), parameter :: Sl_anidf = 'Sl_anidf' + character(*), parameter :: Sl_tref = 'Sl_tref' + character(*), parameter :: Sl_qref = 'Sl_qref' + character(*), parameter :: Fall_taux = 'Fall_taux' + character(*), parameter :: Fall_tauy = 'Fall_tauy' + character(*), parameter :: Fall_lat = 'Fall_lat' + character(*), parameter :: Fall_sen = 'Fall_sen' + character(*), parameter :: Fall_lwup = 'Fall_lwup' + character(*), parameter :: Fall_evap = 'Fall_evap' + character(*), parameter :: Fall_swnet = 'Fall_swnet' + character(*), parameter :: Fall_flxdst = 'Fall_flxdst' + character(*), parameter :: Fall_methane = 'Fall_methane' + character(*), parameter :: Sl_u10 = 'Sl_u10' + character(*), parameter :: Sl_ram1 = 'Sl_ram1' + character(*), parameter :: Sl_fv = 'Sl_fv' + character(*), parameter :: Sl_soilw = 'Sl_soilw' + character(*), parameter :: Fall_fco2_lnd = 'Fall_fco2_lnd' + character(*), parameter :: Sl_ddvel = 'Sl_ddvel' + character(*), parameter :: Fall_voc = 'Fall_voc' + character(*), parameter :: Fall_fire = 'Fall_fire' + character(*), parameter :: Sl_fztop = 'Sl_fztop' + character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' + character(*), parameter :: Flrl_rofsub = 'Flrl_rofsub' + character(*), parameter :: Flrl_rofgwl = 'Flrl_rofgwl' + character(*), parameter :: Flrl_rofi = 'Flrl_rofi' + character(*), parameter :: Flrl_irrig = 'Flrl_irrig' + character(*), parameter :: Sl_tsrf_elev = 'Sl_tsrf_elev' + character(*), parameter :: Sl_topo_elev = 'Sl_topo_elev' + character(*), parameter :: Flgl_qice_elev = 'Flgl_qice_elev' + character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -139,69 +211,69 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') ! export to atm - if (atm_prognostic) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) + !if (atm_prognostic) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_t ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_tref ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_qref ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_avsdr ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_anidr ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_avsdf ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_anidf ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_snowh ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_u10 ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_fv ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_ram1 ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_taux ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_tauy ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_lat ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_sen ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_lwup ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_evap ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_swnet ) + ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_methane ) ! dust fluxes from land (4 sizes) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_flxdst, ungridded_lbound=1, ungridded_ubound=4) ! co2 fields from land if (flds_co2b .or. flds_co2c) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_fco2_lnd ) end if ! Dry Deposition velocities from land - ALSO initialize drydep here call seq_drydep_readnl("drv_flds_in", drydep_nflds) if (drydep_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_ddvel, ungridded_lbound=1, ungridded_ubound=drydep_nflds) end if ! MEGAN VOC emissions fluxes from land call shr_megan_readnl('drv_flds_in', megan_nflds) if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') if (shr_megan_mechcomps_n > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_voc, ungridded_lbound=1, ungridded_ubound=megan_nflds) end if ! Fire emissions fluxes from land call shr_fire_emis_readnl('drv_flds_in', emis_nflds) if (emis_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_fire, ungridded_lbound=1, ungridded_ubound=emis_nflds) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_fztop) end if ! CARMA volumetric soil water from land ! TODO: is the following correct - the CARMA field exchange is very confusing in mct call shr_carma_readnl('drv_flds_in', carma_fields) if (carma_fields /= ' ') then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_soilw) ! optional for carma end if - end if + !end if ! export to rof if (rof_prognostic) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofsur) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofgwl) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofsub) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofi ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_irrig ) end if ! export to glc @@ -210,9 +282,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! The following puts all of the elevation class fields as an ! undidstributed dimension in the export state field - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_tsrf_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_topo_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Flgl_qice_elev, ungridded_lbound=1, ungridded_ubound=glc_nec+1) end if ! Now advertise above export fields @@ -228,75 +300,73 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - ! from atm - states - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_topo' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_u' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_v' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ptem' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) - !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_methane' ) - - ! from atm - fluxes - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) + ! from atm + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_z ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_topo ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_u ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_v ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_ptem ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_pbot ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_tbot ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_shum ) + !call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_methane ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_lwdn ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_rainc ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_rainl ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_snowc ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_snowl ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swndr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swvdr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swndf ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swvdf ) ! from atm - black carbon deposition fluxes (3) ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_bcph, ungridded_lbound=1, ungridded_ubound=3) ! from atm - organic carbon deposition fluxes (3) ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_ocph, ungridded_lbound=1, ungridded_ubound=3) ! from atm - wet dust deposition frluxes (4 sizes) ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_dstwet, ungridded_lbound=1, ungridded_ubound=4) ! from - atm dry dust deposition frluxes (4 sizes) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_dstdry, ungridded_lbound=1, ungridded_ubound=4) ! from atm - nitrogen deposition call shr_ndep_readnl("drv_flds_in", ndep_nflds) if (ndep_nflds > 0) then - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_ndep, ungridded_lbound=1, ungridded_ubound=ndep_nflds) ! This sets a variable in clm_varctl ndep_from_cpl = .true. end if ! from atm - co2 exchange scenarios if (flds_co2a .or. flds_co2b .or. flds_co2c) then - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2prog') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2diag') + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_co2prog) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_co2diag) end if if (rof_prognostic) then ! from river - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_flood ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_volr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_volrmch ) end if if (glc_present) then ! from land-ice (glc) - no elevation classes - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask' ) ! mask of where cism is running - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask_coupled_fluxes') ! + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_icemask ) ! mask of where cism is running + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_icemask_coupled_fluxes) ! ! from land-ice (glc) - fields for all glc->lnd elevation classes (1:glc_nec) plus bare land (index 0) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_ice_covered_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_ice_covered_elev, ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_topo_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) !current not used - but could be used in the future - !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flgg_hflx_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + !call fldlist_add(fldsToLnd_num, fldsToLnd, Flgg_hflx_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) end if ! Now advertise import fields @@ -388,6 +458,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) real(r8) :: forc_pbot ! atmospheric pressure (Pa) real(r8) :: co2_ppmv_input(bounds%begg:bounds%endg) ! temporary + real(r8) :: forc_ndep(bounds%begg:bounds%endg,2) real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s real(r8) :: forc_rainl(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s real(r8) :: forc_snowc(bounds%begg:bounds%endg) ! snowfxy Atm flux mm/s @@ -418,240 +489,84 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! by 1000 mm/m resulting in an overall factor of unity. ! Below the units are therefore given in mm/s. - !-------------------------- - ! Required atmosphere input fields - !-------------------------- - - fldname = 'Sa_z' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + ! Required atm input fields + call state_getimport_1d(importState, Sa_z , atm2lnd_inst%forc_hgt_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_hgt_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_topo' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_topo , atm2lnd_inst%forc_topo_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_topo_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_u' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_u , atm2lnd_inst%forc_u_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_u_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_v' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_v , atm2lnd_inst%forc_v_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_v_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_ptem' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_shum , wateratm2lndbulk_inst%forc_q_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_th_not_downscaled_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_shum' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_ptem , atm2lnd_inst%forc_th_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_pbot' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_pbot , atm2lnd_inst%forc_pbot_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Sa_tbot' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Sa_tbot , atm2lnd_inst%forc_t_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_t_not_downscaled_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_rainc' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_rainc, forc_rainc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - forc_rainc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_rainl' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_rainl, forc_rainl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - forc_rainl(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_snowc' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_snowc, forc_snowc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - forc_snowc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_snowl' - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_snowl, forc_snowl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - forc_snowl(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_lwdn' - call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_swvdr' - call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_lwdn , atm2lnd_inst%forc_lwrad_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_solad_grc(g,1) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_swndr' - call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_swvdr, atm2lnd_inst%forc_solad_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_solad_grc(g,2) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_swvdf' - call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_swndr, atm2lnd_inst%forc_solad_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_solai_grc(g,1) = fldptr1d(g-begg+1) - end do - - fldname = 'Faxa_swndf' - call state_getfldptr(importState, trim(fldname), fldptr1d, rc=rc) + call state_getimport_1d(importState, Faxa_swvdf, atm2lnd_inst%forc_solai_grc(begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_1d(importState, Faxa_swndf, atm2lnd_inst%forc_solai_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_solai_grc(g,2) = fldptr1d(g-begg+1) - end do - ! Atmosphere prognostic/prescribed aerosol fields - fldname = 'Faxa_bcph' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + ! optional atm input fields + if (fldchk(importState, Faxa_bcph)) then + ! 1 = bcphidry, 2 = bcphodry, 3 = bcphiwet + call state_getimport_2d(importState, Faxa_bcph, atm2lnd_inst%forc_aer_grc(begg:,1:3), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) - call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) - call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) - do g = begg, endg - n = g - begg + 1 - atm2lnd_inst%forc_aer_grc(g,1) = fldptr2d(1,n) ! bcphidry - atm2lnd_inst%forc_aer_grc(g,2) = fldptr2d(2,n) ! bcphodry - atm2lnd_inst%forc_aer_grc(g,3) = fldptr2d(3,n) ! bcphiwet - end do end if - fldname = 'Faxa_ocph' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(importState, Faxa_ocph)) then + ! 4 = ocphidry, 5 = ocphodry, 6 = ocphiwet + call state_getimport_2d(importState, Faxa_ocph, atm2lnd_inst%forc_aer_grc(begg:,4:6), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) - call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) - call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) - do g = begg, endg - n = g - begg + 1 - atm2lnd_inst%forc_aer_grc(g,4) = fldptr2d(1,n) ! ocphidry - atm2lnd_inst%forc_aer_grc(g,5) = fldptr2d(2,n) ! ocphodry - atm2lnd_inst%forc_aer_grc(g,6) = fldptr2d(3,n) ! ocphiwet - end do end if - fldname = 'Faxa_dstwet' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(importState, Faxa_dstwet)) then + ! 7 = dstwet1, 9 = dstwet2, 11 = dstwet3, 13 = dstwet4 + call state_getimport_2d(importState, Faxa_dstwet, atm2lnd_inst%forc_aer_grc(begg:,7:13:2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) - call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) - call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) - call check_for_nans(fldptr2d(4,:), trim(fldname)//'(4)', begg) - do g = begg, endg - n = g - begg + 1 - atm2lnd_inst%forc_aer_grc(g,7) = fldptr2d(1,n) - atm2lnd_inst%forc_aer_grc(g,9) = fldptr2d(2,n) - atm2lnd_inst%forc_aer_grc(g,11) = fldptr2d(3,n) - atm2lnd_inst%forc_aer_grc(g,13) = fldptr2d(4,n) - end do end if - fldname = 'Faxa_dstdry' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(importState, Faxa_dstdry)) then + ! 8 = dstdry1, 10 = dstdry2, 12 = dstdry3, 14 = dstdry4 + call state_getimport_2d(importState, Faxa_dstdry, atm2lnd_inst%forc_aer_grc(begg:,8:14:2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) - call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) - call check_for_nans(fldptr2d(3,:), trim(fldname)//'(3)', begg) - call check_for_nans(fldptr2d(4,:), trim(fldname)//'(4)', begg) - do g = begg, endg - n = g - begg + 1 - atm2lnd_inst%forc_aer_grc(g,8) = fldptr2d(1,n) - atm2lnd_inst%forc_aer_grc(g,10) = fldptr2d(2,n) - atm2lnd_inst%forc_aer_grc(g,12) = fldptr2d(3,n) - atm2lnd_inst%forc_aer_grc(g,14) = fldptr2d(4,n) - end do end if - - fldname = 'Sa_methane' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) - call check_for_nans(fldptr1d, trim(fldname), begg) - do g = begg, endg - atm2lnd_inst%forc_pch4_grc(g) = fldptr1d(g-begg+1) - end do + if (fldchk(importState, Sa_methane)) then + call state_getimport_1d(importState, Sa_methane, atm2lnd_inst%forc_pch4_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - fldname = 'Faxa_ndep' - if (fldchk(importState, trim(fldname))) then + if (fldchk(importState, Faxa_ndep)) then ! The mediator is sending ndep in units if kgN/m2/s - and ctsm ! uses units of gN/m2/sec so the following conversion needs to happen - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + call state_getimport_2d(importState, Faxa_ndep, forc_ndep(begg:,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call check_for_nans(fldptr2d(1,:), trim(fldname)//'(1)', begg) - call check_for_nans(fldptr2d(2,:), trim(fldname)//'(2)', begg) do g = begg, endg - n = g - begg + 1 - atm2lnd_inst%forc_ndep_grc(g) = (fldptr2d(1,n) + fldptr2d(2,n))*1000._r8 + atm2lnd_inst%forc_ndep_grc(g) = (forc_ndep(g,1) + forc_ndep(g,2))*1000._r8 end do end if - !-------------------------- ! Atmosphere co2 - !-------------------------- - ! Set default value to a constant and overwrite for prognostic and diagnostic do g = begg,endg co2_ppmv_input(g) = co2_ppmv end do if (co2_type == 'prognostic') then - fldName = 'Sa_co2prog' + fldName = Sa_co2prog call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) if ( ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'prognostic') then @@ -665,7 +580,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end if else if (co2_type == 'diagnostic') then - fldName = 'Sa_co2diag' + fldName = Sa_co2diag call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) if ( ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'diagnostic') then @@ -685,112 +600,66 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & do g = begg,endg forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_input(g) * 1.e-6_r8 * forc_pbot - if (use_c13) then - atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_input(g) * c13ratio * 1.e-6_r8 * forc_pbot - end if end do + if (use_c13) then + do g = begg,endg + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_input(g) * c13ratio * 1.e-6_r8 * forc_pbot + end do + end if - !-------------------------- - ! Flooding back from river - !-------------------------- - + ! Flooding from river ! sign convention is positive downward and hierarchy is atm/glc/lnd/rof/ice/ocn. ! so water sent from rof to land is negative, ! change the sign to indicate addition of water to system. - - fldname = 'Flrr_flood' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) + if (fldchk(importState, Flrr_flood)) then + call state_getimport_1d(importState, Flrr_flood, wateratm2lndbulk_inst%forc_flood_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg - wateratm2lndbulk_inst%forc_flood_grc(g) = -fldptr1d(g-begg+1) + wateratm2lndbulk_inst%forc_flood_grc(g) = wateratm2lndbulk_inst%forc_flood_grc(g) * (ldomain%area(g) * 1.e6_r8) end do else wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 end if - - fldname = 'Flrr_volr' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) + if (fldchk(importState, Flrr_volr)) then + call state_getimport_1d(importState, Flrr_volr, wateratm2lndbulk_inst%volr_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg - wateratm2lndbulk_inst%volr_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) + wateratm2lndbulk_inst%volr_grc(g) = wateratm2lndbulk_inst%volr_grc(g) * (ldomain%area(g) * 1.e6_r8) end do else wateratm2lndbulk_inst%volr_grc(:) = 0._r8 end if - - fldname = 'Flrr_volrmch' - if (fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc ) + if (fldchk(importState, Flrr_volrmch)) then + call state_getimport_1d(importState, Flrr_volrmch, wateratm2lndbulk_inst%volrmch_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg - wateratm2lndbulk_inst%volrmch_grc(g) = fldptr1d(g-begg+1) * (ldomain%area(g) * 1.e6_r8) + wateratm2lndbulk_inst%volrmch_grc(g) = wateratm2lndbulk_inst%volrmch_grc(g) * (ldomain%area(g) * 1.e6_r8) end do else wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 end if - !-------------------------- ! Land-ice (glc) fields - !-------------------------- - if (glc_present) then ! We could avoid setting these fields if glc_present is .false., if that would ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - fldname = 'Sg_ice_covered_elev' - if ( fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - do num = 0,glc_nec - frac_grc(g,num) = fldptr2d(num+1,g-begg+1) - end do - end do - end if - - fldname = 'Sg_topo_elev' - if ( fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - do num = 0,glc_nec - topo_grc(g,num) = fldptr2d(num+1,g-begg+1) - end do - end do - end if - - fldname = 'Flgg_hflx_elev' - if ( fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + call state_getimport_2d(importState, Sg_ice_covered_elev , frac_grc(begg:,0:glc_nec), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_2d(importState, Sg_topo_elev , topo_grc(begg:,0:glc_nec), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_1d(importState, Sg_icemask , icemask_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_1d(importState, Sg_icemask_coupled_fluxes , icemask_coupled_fluxes_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(importState, Flgg_hflx_elev)) then + call state_getimport_2d(importState, Flgg_hflx_elev, hflx_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - do num = 0,glc_nec - hflx_grc(g,num) = fldptr2d(num+1,g-begg+1) - end do - end do else hflx_grc(:,:) = 0._r8 end if - - fldname = 'Sg_icemask' - if ( fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - do g = begg, endg - icemask_grc(g) = fldptr1d(g-begg+1) - end do - end if - - fldname = 'Sg_icemask_coupled_fluxes' - if ( fldchk(importState, trim(fldname))) then - call state_getfldptr(importState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - icemask_coupled_fluxes_grc(g) = fldptr1d(g-begg+1) - end do - end if call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc ) end if @@ -813,6 +682,8 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & !------------------------------- ! Pack the export state + ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. + ! i.e. water sent from land to rof is positive !------------------------------- use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type @@ -834,7 +705,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & character(len=CS) :: fldname integer :: begg, endg ! bounds integer :: i, g, num - real(r8) :: array(bounds%begg:bounds%endg) + real(r8) :: data1d(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -851,324 +722,130 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! output to mediator ! ----------------------- - fldname = 'Sl_lfrin' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = ldomain%frac(g) - end do - end if + call state_setexport_1d(exportState, Sl_lfrin, ldomain%frac(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------- ! output to atm ! ----------------------- - fldname = 'Sl_t' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + !if (atm_prognostic) then + call state_setexport_1d(exportState, Sl_t , lnd2atm_inst%t_rad_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%t_rad_grc(g) - end do - end if - fldname = 'Sl_snowh' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_snowh , waterlnd2atmbulk_inst%h2osno_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osno_grc(g) - end do - end if - fldname = 'Sl_avsdr' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_avsdr , lnd2atm_inst%albd_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,1) - end do - end if - fldname='Sl_anidr' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_anidr , lnd2atm_inst%albd_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%albd_grc(g,2) - end do - end if - fldname= 'Sl_avsdf' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,1) - end do - end if - fldname = 'Sl_anidf' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%albi_grc(g,2) - end do - end if - fldname = 'Sl_tref' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_avsdf , lnd2atm_inst%albi_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%t_ref2m_grc(g) - end do - end if - fldname = 'Sl_qref' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%q_ref2m_grc(g) - end do - end if - fldname = 'Fall_taux' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%taux_grc(g) - end do - end if - fldname = 'Fall_tauy' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%tauy_grc(g) - end do - end if - fldname = 'Fall_lat' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lh_tot_grc(g) - end do - end if - fldname = 'Fall_sen' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_sh_tot_grc(g) - end do - end if - fldname = 'Fall_lwup' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%eflx_lwrad_out_grc(g) - end do - end if - fldname = 'Fall_evap' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -waterlnd2atmbulk_inst%qflx_evap_tot_grc(g) - end do - end if - fldname = 'Fall_swnet' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%fsa_grc(g) - end do - end if - fldname = 'Fall_flxdst' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - fldptr2d(1,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,1) - fldptr2d(2,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,2) - fldptr2d(3,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,3) - fldptr2d(4,g-begg+1) = -lnd2atm_inst%flxdst_grc(g,4) - end do - end if - fldname = 'Fall_methane' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_anidf , lnd2atm_inst%albi_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%ch4_surf_flux_tot_grc(g) - end do - end if - fldname = 'Sl_u10' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_tref , lnd2atm_inst%t_ref2m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%u_ref10m_grc(g) - end do - end if - fldname = 'Sl_ram1' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Sl_qref , waterlnd2atmbulk_inst%q_ref2m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%ram1_grc(g) - end do - end if - fldname = 'Sl_fv' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Fall_taux , lnd2atm_inst%taux_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%fv_grc(g) - end do - end if - fldname = 'Sl_soilw' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Fall_tauy , lnd2atm_inst%tauy_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%h2osoi_vol_grc(g,1) - end do - end if - fldname = 'Fall_fco2_lnd' ! co2 from land - if (fldchk(exportState, trim(fldname) )) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Fall_lat , lnd2atm_inst%eflx_lh_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = -lnd2atm_inst%net_carbon_exchange_grc(g) - end do - end if - fldname = 'Sl_ddvel' ! dry dep velocities - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + call state_setexport_1d(exportState, Fall_sen , lnd2atm_inst%eflx_sh_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 1, drydep_nflds - fldptr2d(num,g-begg+1) = lnd2atm_inst%ddvel_grc(g,num) - end do - end do - end if - fldname = 'Fall_voc' ! megan voc emis fluxes - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + call state_setexport_1d(exportState, Fall_lwup , lnd2atm_inst%eflx_lwrad_out_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 1, shr_megan_mechcomps_n - fldptr2d(num,g-begg+1) = -lnd2atm_inst%flxvoc_grc(g,num) - end do - end do - end if - fldname = 'Fall_fire' ! fire emis from land - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + call state_setexport_1d(exportState, Fall_evap , waterlnd2atmbulk_inst%qflx_evap_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 1, emis_nflds - fldptr2d(num,g-begg+1) = -lnd2atm_inst%fireflx_grc(g,num) - end do - end do - end if - fldname = 'Sl_fztop' ! fire emis from land - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + call state_setexport_1d(exportState, Fall_swnet, lnd2atm_inst%fsa_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = lnd2atm_inst%fireztop_grc(g) - end do - end if - ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. - ! i.e. water sent from land to rof is positive + ! optional fields + if (fldchk(exportState, Fall_flxdst)) then + call state_setexport_2d(exportState, Fall_flxdst, lnd2atm_inst%flxdst_grc(begg:,1:4), & + minus= .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_methane)) then + call state_setexport_1d(exportState, Fall_methane, lnd2atm_inst%ch4_surf_flux_tot_grc(begg:), & + minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_u10)) then + call state_setexport_1d(exportState, Sl_u10, lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_ram1)) then + call state_setexport_1d(exportState, Sl_ram1, lnd2atm_inst%ram1_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_fv)) then + call state_setexport_1d(exportState, Sl_fv, lnd2atm_inst%fv_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_soilw)) then + call state_setexport_1d(exportState, Sl_soilw, waterlnd2atmbulk_inst%h2osoi_vol_grc(begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_fco2_lnd)) then + call state_setexport_1d(exportState, Fall_fco2_lnd, lnd2atm_inst%net_carbon_exchange_grc(begg:), & + minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_ddvel)) then ! dry dep velocities + call state_setexport_2d(exportState, Sl_ddvel, lnd2atm_inst%ddvel_grc(begg:,1:drydep_nflds), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_voc)) then ! megan voc emis fluxes + call state_setexport_2d(exportState, Fall_voc, lnd2atm_inst%flxvoc_grc(begg:,1:shr_megan_mechcomps_n), & + minus = .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_fire)) then ! fire emis from land + call state_setexport_2d(exportState, Fall_fire, lnd2atm_inst%fireflx_grc(begg:,1:emis_nflds), & + minus = .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_fztop)) then ! fire emis from land + call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !endif ! ----------------------- ! output to river ! ----------------------- - ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = bounds%begg,bounds%endg - ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & + ! do g = begg,endg + ! data1d(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & ! waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - fldname = 'Flrl_rofsur' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (fldchk(exportState, Flrl_rofsur)) then + call state_setexport_1d(exportState, Flrl_rofsur, waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) - end do end if - - fldname = 'Flrl_rofsub' ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (fldchk(exportState, Flrl_rofgwl)) then ! qgwl sent individually to mediator + call state_setexport_1d(exportState, Flrl_rofgwl, waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & - waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - end do end if - - fldname = 'Flrl_rofgwl' ! qgwl sent individually to mediator - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (fldchk(exportState, Flrl_rofi)) then ! ice set individually to mediator + call state_setexport_1d(exportState, Flrl_rofi, waterlnd2atmbulk_inst%qflx_rofice_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - end do end if - - fldname = 'Flrl_rofi' ! ice sent individually to mediator - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (fldchk(exportState, Flrl_irrig)) then ! irrigation flux to be removed from main channel storage (negative) + call state_setexport_1d(exportState, Flrl_irrig, waterlnd2atmbulk_inst%qirrig_grc(begg:), & + minus = .true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 - do g = begg, endg - fldptr1d(g-begg+1) = waterlnd2atmbulk_inst%qflx_rofice_grc(g) - end do end if - - fldname = 'Flrl_irrig' ! irrigation flux to be removed from main channel storage (negative) - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 + if (fldchk(exportState, Flrl_rofsub)) then + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain do g = begg, endg - fldptr1d(g-begg+1) = -waterlnd2atmbulk_inst%qirrig_grc(g) + data1d(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) end do + call state_setexport_1d(exportState, Flrl_rofsub, data1d(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! ----------------------- @@ -1178,40 +855,18 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - fldname = 'Sl_tsrf_elev' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(exportState, Sl_tsrf_elev)) then + call state_setexport_2d(exportState, Sl_tsrf_elev, lnd2glc_inst%tsrf_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 0,glc_nec - fldptr2d(num+1,g-begg+1) = lnd2glc_inst%tsrf_grc(g,num) - end do - end do end if - - fldname = 'Sl_topo_elev' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(exportState, Sl_topo_elev)) then + call state_setexport_2d(exportState, Sl_topo_elev, lnd2glc_inst%topo_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 0,glc_nec - fldptr2d(num+1,g-begg+1) = lnd2glc_inst%topo_grc(g,num) - end do - end do end if - - fldname = 'Flgl_qice_elev' - if (fldchk(exportState, trim(fldname))) then - call state_getfldptr(exportState, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (fldchk(exportState, Flgl_qice_elev)) then + call state_setexport_2d(exportState, Flgl_qice_elev, lnd2glc_inst%qice_grc(begg:,0:glc_nec), & + minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._r8 - do g = begg, endg - do num = 0,glc_nec - fldptr2d(num+1,g-begg+1) = lnd2glc_inst%qice_grc(g,num) - end do - end do end if end subroutine export_fields @@ -1352,6 +1007,152 @@ end subroutine SetScalarField end subroutine fldlist_realize + !=============================================================================== + subroutine state_getimport_1d(state, fldname, ctsmdata, rc) + + ! fill in ctsm import data for 1d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize + + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: ctsmdata(:) + integer , intent(out) :: rc + + ! local variables + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call state_getfldptr(State, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = 1,size(ctsmdata) + ctsmdata(g) = fldptr1d(g) + end do + call check_for_nans(ctsmdata, trim(fldname), 1) + + end subroutine state_getimport_1d + + !=============================================================================== + subroutine state_getimport_2d(state, fldname, ctsmdata, rc) + + ! fill in ctsm import data for 2d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize + + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: ctsmdata(:,:) + integer , intent(out) :: rc + + ! local variables + real(r8), pointer :: fldPtr2d(:,:) + integer :: g,n + character(len=CS) :: cnum + character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(ctsmdata, dim=2) + write(cnum,'(i0)') n + do g = 1,size(ctsmdata,dim=1) + ctsmdata(g,n) = fldptr2d(n,g) + end do + call check_for_nans(ctsmdata(:,n), trim(fldname)//trim(cnum), 1) + end do + + end subroutine state_getimport_2d + + !=============================================================================== + subroutine state_setexport_1d(state, fldname, ctsmdata, minus, rc) + + ! fill in ctsm export data for 1d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize + + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: ctsmdata(:) + logical, optional, intent(in) :: minus + integer , intent(out):: rc + + ! local variables + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_export_export:state_setexport_1d)' + ! ---------------------------------------------- + + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + if (present(minus)) then + do g = 1,size(ctsmdata) + fldptr1d(g) = -ctsmdata(g) + end do + else + do g = 1,size(ctsmdata) + fldptr1d(g) = ctsmdata(g) + end do + end if + call check_for_nans(ctsmdata, trim(fldname), 1) + + end subroutine state_setexport_1d + + !=============================================================================== + subroutine state_setexport_2d(state, fldname, ctsmdata, minus, rc) + + ! fill in ctsm export data for 2d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize + + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: ctsmdata(:,:) + logical, optional, intent(in) :: minus + integer , intent(out):: rc + + ! local variables + real(r8), pointer :: fldPtr2d(:,:) + integer :: g, n + character(len=CS) :: cnum + character(len=*), parameter :: subname='(lnd_export_export:state_setexport_2d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do n = 1,size(ctsmdata, dim=2) + write(cnum,'(i0)') n + if (present(minus)) then + do g = 1,size(ctsmdata, dim=1) + fldptr2d(n,g) = -ctsmdata(g,n) + end do + else + do g = 1,size(ctsmdata, dim=1) + fldptr2d(n,g) = ctsmdata(g,n) + end do + end if + call check_for_nans(ctsmdata(:,n), trim(fldname)//trim(cnum), 1) + end do + + end subroutine state_setexport_2d + !=============================================================================== subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) From 9940aea5fa495c3d6a7afb5bc702cf3e06d4c25d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 21 Dec 2020 20:46:01 -0700 Subject: [PATCH 041/219] more cleanup --- src/cpl/nuopc/lnd_import_export.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 4dd10675b4..1c18ab253c 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -138,6 +138,8 @@ module lnd_import_export character(*), parameter :: Sl_topo_elev = 'Sl_topo_elev' character(*), parameter :: Flgl_qice_elev = 'Flgl_qice_elev' + logical :: send_to_atm = .false. + character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -162,11 +164,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! local variables type(ESMF_State) :: importState type(ESMF_State) :: exportState - character(ESMF_MAXSTR) :: stdname character(ESMF_MAXSTR) :: cvalue - character(len=2) :: nec_str integer :: n, num - character(len=CS) :: fldname character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -179,6 +178,12 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! determine necessary toggles for below !-------------------------------- + if (atm_prognostic) then + send_to_atm = .true. + else + send_to_atm = .false. + end if + call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a @@ -211,7 +216,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') ! export to atm - !if (atm_prognostic) then + if (send_to_atm) then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_t ) call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_tref ) call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_qref ) @@ -265,7 +270,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (carma_fields /= ' ') then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_soilw) ! optional for carma end if - !end if + end if ! export to rof if (rof_prognostic) then @@ -728,7 +733,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! output to atm ! ----------------------- - !if (atm_prognostic) then + if (send_to_atm) then call state_setexport_1d(exportState, Sl_t , lnd2atm_inst%t_rad_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport_1d(exportState, Sl_snowh , waterlnd2atmbulk_inst%h2osno_grc(begg:), rc=rc) @@ -810,7 +815,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !endif + endif ! ----------------------- ! output to river From 5218525acb22e1880f5835bb213107b97f824f0d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 22 Dec 2020 10:44:09 -0700 Subject: [PATCH 042/219] fixed glc import bug --- src/cpl/nuopc/lnd_import_export.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 1c18ab253c..f53b6ccd5e 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -665,6 +665,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & else hflx_grc(:,:) = 0._r8 end if + call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc ) end if @@ -869,8 +870,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (fldchk(exportState, Flgl_qice_elev)) then - call state_setexport_2d(exportState, Flgl_qice_elev, lnd2glc_inst%qice_grc(begg:,0:glc_nec), & - minus=.true., rc=rc) + call state_setexport_2d(exportState, Flgl_qice_elev, lnd2glc_inst%qice_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 4d875083b0e31fcf8c4eb402a3d6604d317ea78f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Dec 2020 13:34:03 -0700 Subject: [PATCH 043/219] Add private declarations --- src/cpl/nuopc/lnd_import_export.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index f53b6ccd5e..bbcb7d0d52 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -36,6 +36,10 @@ module lnd_import_export private :: fldlist_add private :: fldlist_realize + private :: state_getimport_1d + private :: state_getimport_2d + private :: state_setexport_1d + private :: state_setexport_2d private :: state_getfldptr private :: fldchk From 144137e728e8d5014b8505ee7d2cb946658f87d1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Dec 2020 16:19:02 -0700 Subject: [PATCH 044/219] Return to always sending to atm See https://github.com/ESCOMP/CTSM/issues/1237 for how we want to handle this longer term. --- src/cpl/nuopc/lnd_import_export.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index bbcb7d0d52..e3e4e11bc3 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -170,6 +170,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r type(ESMF_State) :: exportState character(ESMF_MAXSTR) :: cvalue integer :: n, num + + ! BUG(wjs, 2020-12-22, ESCOMP/CTSM#1237) force_send_to_atm should be read from the + ! namelist rather than being hard-coded to true. + logical, parameter :: force_send_to_atm = .true. + character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -182,7 +187,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! determine necessary toggles for below !-------------------------------- - if (atm_prognostic) then + if (atm_prognostic .or. force_send_to_atm) then send_to_atm = .true. else send_to_atm = .false. From 1cf3b8b6cebb9b1ba8b95d34c8062532a7ee12fa Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Dec 2020 16:27:41 -0700 Subject: [PATCH 045/219] Remove unnecessary timer --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 30c1c97d61..2f6ddc921b 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -895,12 +895,10 @@ subroutine ModelAdvance(gcomp, rc) ! Determine time of next atmospheric shortwave calculation !-------------------------------- - call t_startf(trim(subname)//' nextsw_cday') call State_GetScalar(importState, & flds_scalar_index_nextsw_cday, nextsw_cday, & flds_scalar_name, flds_scalar_num, rc) call set_nextsw_cday( nextsw_cday ) - call t_stopf(trim(subname)//' nextsw_cday') !-------------------------------- ! Unpack import state From 16bc97a8ee04d97e4d52c96578cca143f1120e9a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Dec 2020 16:28:54 -0700 Subject: [PATCH 046/219] Remove mistakenly added correction to flood term It seems this was added in error, at least based on comparison with the mct code. Mariana agrees. Note that I have also restored the negative. --- src/cpl/nuopc/lnd_import_export.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index e3e4e11bc3..ef3b72462a 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -630,7 +630,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & call state_getimport_1d(importState, Flrr_flood, wateratm2lndbulk_inst%forc_flood_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg, endg - wateratm2lndbulk_inst%forc_flood_grc(g) = wateratm2lndbulk_inst%forc_flood_grc(g) * (ldomain%area(g) * 1.e6_r8) + wateratm2lndbulk_inst%forc_flood_grc(g) = -wateratm2lndbulk_inst%forc_flood_grc(g) end do else wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 From 219377b39198fe9a8ea502f923b441fe2d08560a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Dec 2020 16:40:57 -0700 Subject: [PATCH 047/219] Fix implementation of minus optional argument --- src/cpl/nuopc/lnd_import_export.F90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index ef3b72462a..d7ca763acd 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -1103,15 +1103,24 @@ subroutine state_setexport_1d(state, fldname, ctsmdata, minus, rc) integer , intent(out):: rc ! local variables + logical :: l_minus ! local version of minus real(r8), pointer :: fldPtr1d(:) integer :: g character(len=*), parameter :: subname='(lnd_export_export:state_setexport_1d)' ! ---------------------------------------------- + rc = ESMF_SUCCESS + + if (present(minus)) then + l_minus = minus + else + l_minus = .false. + end if + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0._r8 - if (present(minus)) then + if (l_minus) then do g = 1,size(ctsmdata) fldptr1d(g) = -ctsmdata(g) end do @@ -1140,6 +1149,7 @@ subroutine state_setexport_2d(state, fldname, ctsmdata, minus, rc) integer , intent(out):: rc ! local variables + logical :: l_minus ! local version of minus real(r8), pointer :: fldPtr2d(:,:) integer :: g, n character(len=CS) :: cnum @@ -1148,12 +1158,18 @@ subroutine state_setexport_2d(state, fldname, ctsmdata, minus, rc) rc = ESMF_SUCCESS + if (present(minus)) then + l_minus = minus + else + l_minus = .false. + end if + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0._r8 do n = 1,size(ctsmdata, dim=2) write(cnum,'(i0)') n - if (present(minus)) then + if (l_minus) then do g = 1,size(ctsmdata, dim=1) fldptr2d(n,g) = -ctsmdata(g,n) end do From d267cebc28311fa6f19e85ab704fcc35b502d780 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 23 Dec 2020 10:13:08 -0700 Subject: [PATCH 048/219] Mods for successful grid cell-level H2O error checks in transient cases These tests PASS: ERP_D.f10_f10_musgs.IHistClm50Bgc.cheyenne_gnu.clm-decStart ERS_Ly3_Mmpi-serial.1x1_smallvilleIA.IHistClm50BgcCropQianRs.cheyenne_gnu.clm-cropMonthOutput --- src/biogeophys/BalanceCheckMod.F90 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 91c6b9c0e9..6bad841b8f 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -159,6 +159,7 @@ subroutine BeginWaterGridcellBalance(bounds, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & water_inst%bulk_and_tracers(i)%waterbalance_inst, & + water_inst%bulk_and_tracers(i)%waterflux_inst, & use_aquifer_layer = use_aquifer_layer) end do @@ -209,7 +210,7 @@ end subroutine BeginWaterColumnBalance subroutine BeginWaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & soilhydrology_inst, lakestate_inst, waterstate_inst, & - waterdiagnostic_inst, waterbalance_inst, & + waterdiagnostic_inst, waterbalance_inst, waterflux_inst, & use_aquifer_layer) ! ! !DESCRIPTION: @@ -228,13 +229,16 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst + class(waterflux_type) , intent(inout) :: waterflux_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: - integer :: c, j, fc ! indices + integer :: c, g, j, fc ! indices integer :: begc, endc, begg, endg ! bounds + real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at beginning of time step + real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux at beginning of time step !----------------------------------------------------------------------- associate( & @@ -278,6 +282,14 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & call c2g(bounds, begwb_col(begc:endc), begwb_grc(begg:endg), & c2l_scale_type='urbanf', l2g_scale_type='unity') + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg(bounds, qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg(bounds, qflx_ice_dynbal_left_to_dribble(begg:endg)) + + do g = begg, endg + begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & + - qflx_ice_dynbal_left_to_dribble(g) + end do + end associate end subroutine BeginWaterGridcellBalanceSingle @@ -407,6 +419,8 @@ subroutine BalanceCheck( bounds, & real(r8) :: qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg) ! grid cell-level water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) real(r8) :: qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg) ! grid cell-level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg) ! grid cell-level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] + real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step + real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -630,7 +644,13 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end(bounds, qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end(bounds, qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg)) + do g = bounds%begg, bounds%endg + endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & + - qflx_ice_dynbal_left_to_dribble(g) + errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & + forc_snow_grc(g) & From 32a793082ee494232457bc35cf5207fa32953e03 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 23 Dec 2020 11:23:14 -0700 Subject: [PATCH 049/219] Minor clean-up --- src/biogeophys/BalanceCheckMod.F90 | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 6bad841b8f..ad2cbd31dd 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -439,9 +439,9 @@ subroutine BalanceCheck( bounds, & forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (vis=forc_sols , nir=forc_soll ) forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (vis=forc_solsd, nir=forc_solld) forc_rain => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] column level rain rate [mm/s] - forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc, & ! Input: [real(r8) (:)] grid cell-level rain rate [mm/s] + forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc, & ! Input: [real(r8) (:) ] grid cell-level rain rate [mm/s] forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] column level snow rate [mm/s] - forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc, & ! Input: [real(r8) (:)] grid cell-level snow rate [mm/s] + forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc, & ! Input: [real(r8) (:) ] grid cell-level snow rate [mm/s] forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) h2osno_old => waterbalance_inst%h2osno_old_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) at previous time step @@ -461,8 +461,8 @@ subroutine BalanceCheck( bounds, & qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Input: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_col , & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping (outgoing) (mm H2O /s) [+]` qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping (outgoing) (mm H2O /s) [+]` - qflx_snwcp_discarded_liq_col => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] column level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] - qflx_snwcp_discarded_ice_col => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] column level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_snwcp_discarded_liq_col => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:)] column level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_snwcp_discarded_ice_col => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:)] column level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] qflx_evap_tot_col => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] column level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_soliddew_to_top_layer => waterflux_inst%qflx_soliddew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] @@ -473,20 +473,18 @@ subroutine BalanceCheck( bounds, & qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice qflx_drain_perched_col => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) - qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:) ] grid cell-level sub-surface runoff (mm H2O /s) + qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:)] grid cell-level sub-surface runoff (mm H2O /s) qflx_flood_col => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column level total runoff due to flooding forc_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] grid cell-level total grid cell-level runoff from river model qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack -! qflx_liq_dynbal_grc => waterflux_inst%qflx_liq_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder -! qflx_ice_dynbal_grc => waterflux_inst%qflx_ice_dynbal_grc , & ! Input: [real(r8) (:) ] slevis: place holder qflx_surf_col => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] column level surface runoff (mm H2O /s) qflx_surf_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) qflx_qrgwl_col => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] column level qflx_surf at glaciers, wetlands, lakes qflx_qrgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes qflx_drain_col => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) qflx_drain_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) - qflx_ice_runoff_col => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) - qflx_ice_runoff_grc => waterlnd2atm_inst%qflx_rofice_grc , & ! Input: [real(r8) (:) ] grid cell-level solid runoff from snow capping and from excess ice in soil (mm H2O /s) + qflx_ice_runoff_col => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) + qflx_ice_runoff_grc => waterlnd2atm_inst%qflx_rofice_grc , & ! Input: [real(r8) (:) ] grid cell-level solid runoff from snow capping and from excess ice in soil (mm H2O /s) qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Input: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) qflx_sfc_irrig_col => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] column level irrigation flux (mm H2O /s) @@ -585,7 +583,7 @@ subroutine BalanceCheck( bounds, & if (errh2o_max_val > h2o_warning_thresh) then - indexc = maxloc( abs(errh2o_col(bounds%begc:bounds%endc)), 1 ) + bounds%begc -1 + indexc = maxloc( abs(errh2o_col(bounds%begc:bounds%endc)), 1 ) + bounds%begc - 1 write(iulog,*)'WARNING: column-level water balance error ',& ' nstep= ',nstep, & ' local indexc= ',indexc,& @@ -671,7 +669,7 @@ subroutine BalanceCheck( bounds, & if (errh2o_max_val > h2o_warning_thresh) then - indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg -1 + indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg - 1 write(iulog,*)'WARNING: grid cell-level water balance error ',& ' nstep= ',nstep, & ' local indexg= ',indexg,& @@ -698,7 +696,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'deltawb/dtime = ',(endwb_grc(indexg)-begwb_grc(indexg))/dtime write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_grc(indexg)*dtime write(iulog,*)'forc_flood = ',forc_flood_grc(indexg)*dtime - write(iulog,*)'qflx_glcice_dyn_water_flux_grc = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime write(iulog,*)'clm model is stopping' call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) From 097ff9805c5d10e55c9be42e6ec19d066a3b963f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 23 Dec 2020 12:08:39 -0700 Subject: [PATCH 050/219] First draft of ChangeLog --- doc/ChangeLog | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 121 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 5642709fc1..a9cbe04d1e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,124 @@ =============================================================== +Tag name: ctsm5.1.dev020 +Originator(s): slevis (Samuel Levis,303-665-1310) +Date: Wed Dec 23 11:29:33 MST 2020 +One-line Summary: Grid cell-level error check for H2O + +Purpose of changes +------------------ + + For more robust mass balance error checking, introduced + grid cell-level error check for H2O following the approach + of pull requests #984 and #1022 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): #201 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[X] clm5_0 + +[X] ctsm5_0-nwp + +[X] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + None + +Changes made to namelist defaults (e.g., changed parameter values): + None + +Changes to the datasets (e.g., parameter, surface or initial files): + None + +Substantial timing or memory changes: [For timing changes, can check PFS test(s) in the test suite] + None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + None + +Changes to tests or testing: + None + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - + + tools-tests (test/tools): + + cheyenne - + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - + + regular tests (aux_clm): + + cheyenne ---- PEND (expect OK) + izumi ------- PEND (expect OK) + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Specific example from running the single point test + ERI_D_Ld9.1x1_camdenNJ.I2000Clm50BgcCruRs.cheyenne_intel.clm-default: + RMS ERRH2O 6.0280E-21 NORMALIZED 7.6050E-06 + + Explanation: Moving call BalanceCheck to after the call lnd2glc in + subroutine clm_drv causes a change in order of operations that leads to + the above change in ERRH2O. + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): + None + +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/1228 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev019 Originator(s): sacks (Bill Sacks) Date: Sat Dec 19 06:55:46 MST 2020 diff --git a/doc/ChangeSum b/doc/ChangeSum index 3789dbee16..6cfae1392f 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev020 slevis 12/23/2020 Grid cell-level error check for H2O ctsm5.1.dev019 sacks 12/19/2020 Fix ndep from coupler ctsm5.1.dev018 slevis 12/08/2020 Add ACTIVE (T/F) column to master hist fields table and alphabetize ctsm5.1.dev017 slevis 11/17/2020 Write history fields master list to separate optional file From 96e1a9293429ca586573697bac119b5ccbdba54f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 26 Dec 2020 12:27:59 -0700 Subject: [PATCH 051/219] refator to set ldecomp and ldomain data types in caps --- src/cpl/lilac/lnd_comp_esmf.F90 | 29 +- src/cpl/lilac/lnd_set_decomp_and_domain.F90 | 596 ++++++++++++++++++++ src/cpl/mct/lnd_comp_mct.F90 | 127 ++--- src/cpl/mct/lnd_set_decomp_and_domain.F90 | 299 ++++++++++ src/cpl/nuopc/lnd_comp_nuopc.F90 | 321 ++--------- src/cpl/nuopc/lnd_import_export.F90 | 36 +- src/main/clm_initializeMod.F90 | 238 ++++---- src/main/clm_varctl.F90 | 3 - src/main/decompInitMod.F90 | 8 +- src/main/surfrdMod.F90 | 262 +-------- 10 files changed, 1162 insertions(+), 757 deletions(-) create mode 100644 src/cpl/lilac/lnd_set_decomp_and_domain.F90 create mode 100644 src/cpl/mct/lnd_set_decomp_and_domain.F90 diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index ba5f73c2b7..ea3af7c88e 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -35,7 +35,7 @@ module lnd_comp_esmf use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday - use clm_initializeMod , only : initialize1, initialize2 + use clm_initializeMod , only : initialize1, initialize2, initialize3 use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose @@ -320,36 +320,31 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_lilac) + call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) !---------------------- ! Read namelist, grid and surface data !---------------------- - ! set default values for run control variables call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) - call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) - - !---------------------- ! Initialize glc_elevclass module - !---------------------- - call glc_elevclass_init(glc_nec) + call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) !---------------------- ! Call initialize1 !---------------------- - - ! Note that the memory for gindex_ocn will be allocated in the following call - - call initialize1(dtime=dtime_lilac, gindex_ocn=gindex_ocn) - - call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) + call initialize1(dtime=dtime_sync) call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) + !---------------------- + ! Initialize decomposition (ldecomp) and domain (ldomain) types + !---------------------- + call lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + !-------------------------------- ! generate the land mesh on ctsm distribution !-------------------------------- - ! obtain global index array for just land points which includes mask=0 or ocean points call get_proc_bounds( bounds ) @@ -359,7 +354,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) n = 1 + (g - bounds%begg) gindex_lnd(n) = ldecomp%gdc2glo(g) end do - call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) ! create a global index that includes both land and ocean points @@ -393,14 +387,13 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !-------------------------------- ! Finish initializing ctsm !-------------------------------- - - call initialize2() + call initialize2(ni,nj) + call initialize3() call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) !-------------------------------- ! Create import state (only assume input from atm - not rof and glc) !-------------------------------- - ! create an empty field bundle for import of atm fields c2l_fb_atm = ESMF_FieldBundleCreate (name='c2l_fb_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 new file mode 100644 index 0000000000..d11ddbf5aa --- /dev/null +++ b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 @@ -0,0 +1,596 @@ +module lnd_set_decomp_and_domain + + use ESMF + use NUOPC , only : NUOPC_CompAttributeGet + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use spmdMod , only : masterproc + use clm_varctl , only : iulog + use perf_mod , only : t_startf, t_stopf, t_barrierf + + implicit none + private ! except + + ! Module public routines + public :: lnd_set_decomp_and_domain_from_meshinfo + public :: lnd_set_decomp_and_domain_from_surfrd + + ! Module private routines + private :: clm_getlandmask_from_lndmesh + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + + ! Initialize ldecomp and ldomain data types + + use clm_varpar , only: nlevsoi + use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams + use decompInitMod , only: decompInit_lnd, decompInit_lnd3D + use decompMod , only: bounds_type, get_proc_bounds + use domainMod , only: ldomain, domain_init, domain_check + + ! input/output variables + logical, intent(out) :: noland + integer, intent(out) :: ni, nj ! global grid sizes + + ! local variables + integer ,pointer :: amask(:) ! global land mask + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds ! bounds + character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' + !----------------------------------------------------------------------- + + ! Read in global land grid and land mask (amask)- needed to set decomposition + ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below + if (masterproc) then + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + endif + + ! Get global mask, ni and nj + call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) + + ! Exit early if no valid land points + if ( all(amask == 0) )then + if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' + noland = .true. + return + else + noland = .false. + end if + + ! Initialize ldecomp data type + ! Determine ctsm gridcell decomposition and processor bounds for gridcells + call decompInit_lnd(ni, nj, amask) + deallocate(amask) + if (use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) + + ! Initialize bounds for just gridcells + ! Remaining bounds (landunits, columns, patches) will be determined + ! after the call to decompInit_glcp - so get_proc_bounds is called + ! twice and the gridcell information is just filled in twice + call get_proc_bounds(bounds) + + ! Get grid cell bounds values + begg = bounds%begg + endg = bounds%endg + + ! Initialize ldomain data type + if (masterproc) then + write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) + endif + call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) + if (masterproc) then + call domain_check(ldomain) + endif + ldomain%mask = 1 !!! TODO - is this needed? + + end subroutine lnd_set_decomp_and_domain_from_surfrd + + !==================================================================================== + subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) + + use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D + use domainMod , only : ldomain, domain_init, lon1d, lat1d + use decompMod , only : bounds_type, get_proc_bounds + use clm_varpar , only : nlevsoi + use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varcon , only : re + use lnd_comp_shr , only : mesh, model_meshfile, model_clock + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: mesh_lnd + type(ESMF_Mesh) :: mesh_ocn + type(ESMF_RouteHandle) :: rhandle_ocn2lnd + type(ESMF_DistGrid) :: distgrid_mesh + type(ESMF_DistGrid) :: distgrid_lnd + character(CL) :: cvalue ! config data + integer :: nlnd, nocn ! local size ofarrays + integer :: g,n ! indices + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + character(CL) :: meshfile_ocn + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex(:) ! global index space for land and ocean points + integer , pointer :: mask(:) ! local land/ocean mask + integer , pointer :: lndmask_loc(:) + real(r8) , pointer :: lndfrac_loc(:) + real(r8) , pointer :: lndarea_loc(:) + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + real(r8) , pointer :: lndarea_glob(:) + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + integer , pointer :: itemp_glob(:) + real(r8) , pointer :: dataptr1d(:) + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + logical :: checkflag = .false. + real(r8) :: fminval = 0.001_r8 + real(r8) :: fmaxval = 1._r8 + integer :: lsize,gsize + logical :: isgrid2d + real(R8) , pointer :: ownedElemCoords(:) + integer :: spatialDim + type(ESMF_Field) :: areaField + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! determine global 2d sizes + call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ni + call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) nj + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + ! read in the land mesh from the file + mesh_lnd = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'land mesh file ',trim(model_meshfile) + end if + + ! read in ocn mask meshfile + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + mesh_ocn = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + end if + + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, landfrac_loc, distgrid_lnd, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex(lsize)) + call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + call ESMF_DistGridDestroy(distgrid_lnd) + + ! determine lnd decomposition that will be used by ctsm + call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Determine ocn decomposition that will be used to create the full mesh + ! note that the memory for gindex_ocn will be allocated in the following call + call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) + + ! *** Get JUST gridcell processor bounds *** + ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp + ! so get_proc_bounds is called twice and the gridcell information is just filled in twice + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create gindex_lnd + nlnd = endg - begg + 1 + allocate(gindex_lnd(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask + do g = begg, endg + n = 1 + (g - begg) + ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) + end do + deallocate(lndmask_glob) + + ! Determine ldomain%frac + allocate(rtemp_glob(gsize)) + allocate(lndfrac_glob(gsize)) + lndfrac_glob(:) = 0._r8 + do n = 1,lsize + lndfrac_glob(gindex(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndfrac_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%frac(g) = lndfrac_glob(gindex_lnd(g-begg+1)) + end do + deallocate(lndfrac_glob) + + ! Get ownedElemCords from the mesh to be used to obtain ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) + allocate(ownedElemCoords(spatialDim*lsize)) + call ESMF_MeshGet(mesh_lnd, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine ldomain%latc and lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,lsize + lndlats_glob(gindex(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndlats_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%latc(g) = lndlats_glob(gindex_lnd(g-begg+1)) + end do + if (isgrid2d) then + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = lndlats_glob((n-1)*ni + 1) + end do + end if + deallocate(lndlats_glob) + + ! Determine ldomain%lonc and lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,lsize + lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndlons_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%lonc(g) = lndlats_glob(gindex_lnd(g-begg+1)) + end do + if (isgrid2d) then + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = lndlons_glob(n) + end do + end if + deallocate(lndlons_glob) + deallocate(rtemp_glob) + + ! Create a global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex(n) = gindex_lnd(n) + else + gindex(n) = gindex_ocn(n-nlnd) + end if + end do + + ! Generate a new mesh on the gindex decomposition + distGrid_mesh = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex) + mesh = ESMF_MeshCreate(mesh_lnd, elementDistGrid=distgrid_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) + end do + call ESMF_FieldDestroy(areaField) + + end subroutine lnd_set_decomp_and_domain_from_inputmesh + + !=============================================================================== + subroutine clm_getlandmask_from_lndmesh(mesh_lnd, lndmask_loc, lndfrac_loc, lsize, distgrid_lnd, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + integer , pointer :: lndmask_loc(:) + real(r8) , pointer :: lndfrac_loc(:) + integer , intent(out) :: lsize + type(ESMF_DistGrid) , intent(out) :: distgrid_lnd + integer , intent(out) :: rc + + ! local variables: + type(ESMF_Array) :: elemMaskArray + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine lsize and distgrid_lnd + call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_lnd, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndfrac_loc + allocate(lndmask_loc(lsize)) + elemMaskArray = ESMF_ArrayCreate(distgrid_lnd, lndmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following calls fills in the values of lndmask_loc + call ESMF_MeshGet(mesh_lnd elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndmask_loc + ! ASSUME that land fraction is identical to land mask in this case + allocate(lndfrac_loc(lsize)) + lndfrac_loc(:) = lndmask_loc(:) + + end subroutine clm_getlandmask_from_lndmesh + + !=============================================================================== + logical function chkerr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + + !=============================================================================== + subroutine surfrd_get_globmask(filename, mask, ni, nj) + ! + ! !DESCRIPTION: + ! Read the surface dataset grid related information: + ! This is the first routine called by clm_initialize + ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET + ! + ! !USES: + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: filename ! grid filename + integer , pointer :: mask(:) ! grid mask + integer , intent(out) :: ni, nj ! global grid sizes + ! + ! !LOCAL VARIABLES: + logical :: isgrid2d + integer :: dimid,varid ! netCDF id's + integer :: ns ! size of grid on file + integer :: n,i,j ! index + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name + !----------------------------------------------------------------------- + + if (filename == ' ') then + mask(:) = 1 + else + ! Check if file exists + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + + ! Open file + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions and if grid file is 2d or 1d + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + if (masterproc) then + write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d + end if + allocate(mask(ns)) + mask(:) = 1 + if (isgrid2d) then + ! Grid is 2d + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + end if + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + end if + deallocate(idata2d) + else + ! Grid is not 2d + call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + end if + end if + if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + + ! Close file + call ncd_pio_closefile(ncid) + end if + + end subroutine surfrd_get_globmask + + !=============================================================================== + subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) + ! + ! !DESCRIPTION: + ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED + ! Read the surface dataset grid related information: + ! o real latitude of grid cell (degrees) + ! o real longitude of grid cell (degrees) + ! + ! !USES: + use clm_varcon , only : spval, re, grlnd + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use fileutils , only : getfil + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen + use pio + ! + ! !ARGUMENTS: + integer , intent(in) :: begg, endg + type(domain_type) , intent(inout) :: ldomain ! domain to init + character(len=*) , intent(in) :: filename ! grid filename + character(len=*) ,optional , intent(in) :: glcfilename ! glc mask filename + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + integer :: beg ! local beg index + integer :: end ! local end index + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: start(1), count(1) ! 1d lat/lon array sections + integer :: ier,ret ! error status + logical :: readvar ! true => variable is on input file + logical :: isgrid2d ! true => file is 2d lat/lon + logical :: istype_domain ! true => input file is of type domain + real(r8), allocatable :: rdata2d(:,:) ! temporary + character(len=16) :: vname ! temporary + character(len=256) :: locfn ! local file name + integer :: n ! indices + character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + ! Determine isgrid2d flag for domain + call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine type of file - old style grid file or new style domain file + call check_var(ncid=ncid, varname='xc', readvar=readvar) + if (readvar)then + istype_domain = .true. + else + istype_domain = .false. + end if + + ! Read in area, lon, lat + if (istype_domain) then + call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + ! convert from radians**2 to km**2 + ldomain%area = ldomain%area * (re**2) + if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(sourcefile, __LINE__)) + call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(sourcefile, __LINE__)) + call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(sourcefile, __LINE__)) + else + call endrun( msg=" ERROR: can no longer read non domain files" ) + end if + + if (isgrid2d) then + allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) + if (istype_domain) vname = 'xc' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lon1d(:) = rdata2d(:,1) + if (istype_domain) vname = 'yc' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lat1d(:) = rdata2d(1,:) + deallocate(rdata2d) + end if + + ! Check lat limited to -90,90 + if (minval(ldomain%latc) < -90.0_r8 .or. & + maxval(ldomain%latc) > 90.0_r8) then + write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & + minval(ldomain%latc),maxval(ldomain%latc) + endif + if ( any(ldomain%lonc < 0.0_r8) )then + call endrun( msg=' ERROR: lonc is negative (see https://github.com/ESCOMP/ctsm/issues/507)' & + //errMsg(sourcefile, __LINE__)) + endif + call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(sourcefile, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) + end if + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_grid + +end module lnd_set_decomp_and_domain diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 1ae6b9f6b9..afd948941f 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -27,11 +27,10 @@ module lnd_comp_mct private :: lnd_setgsmap_mct ! set the land model mct gs map private :: lnd_domain_mct ! set the land model domain information private :: lnd_handle_resume ! handle pause/resume signals from the coupler - !--------------------------------------------------------------------------- +!==================================================================================== contains - - !==================================================================================== +!==================================================================================== subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! @@ -43,9 +42,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use shr_kind_mod , only : shr_kind_cl use abortutils , only : endrun use clm_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday - use clm_initializeMod, only : initialize1, initialize2 + use clm_initializeMod, only : initialize1, initialize2, initialize3 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland + use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use controlMod , only : control_setNL @@ -65,6 +64,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch use clm_cpl_indices , only : clm_cpl_indices_set use mct_mod , only : mct_aVect_init, mct_aVect_zero, mct_gsMap_lsize + use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_surfrd use ESMF ! ! !ARGUMENTS: @@ -103,21 +103,20 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: lbnum ! input to memory diagnostic integer :: shrlogunit,shrloglev ! old values for log unit and log level type(bounds_type) :: bounds ! bounds + logical :: noland + integer :: ni,nj character(len=32), parameter :: sub = 'lnd_init_mct' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" !----------------------------------------------------------------------- ! Set cdata data - call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, & gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) ! Determine attriute vector indices - call clm_cpl_indices_set() ! Initialize clm MPI communicator - call spmd_init( mpicom_lnd, LNDID ) #if (defined _MEMTRACE) @@ -148,18 +147,16 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call shr_file_setLogUnit (iulog) ! Use infodata to set orbital values - call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & orb_lambm0=lambm0, orb_obliqr=obliqr ) ! Consistency check on namelist filename - call control_setNL("lnd_in"//trim(inst_suffix)) ! Initialize clm - ! initialize1 reads namelist, grid and surface data (need this to initialize gsmap) - ! initialize2 performs rest of initialization - + ! initialize1 reads namelists + ! decomp and domain are set in lnd_set_decomp_and_domain_from_surfrd + ! initialize2 and initialize3 perform rest of initialization call seq_timemgr_EClockGetData(EClock, & start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & @@ -169,7 +166,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) if (masterproc) then write(iulog,*)'dtime = ',dtime_sync end if - call seq_infodata_GetData(infodata, case_name=caseid, & case_desc=ctitle, single_column=single_column, & scmlat=scmlat, scmlon=scmlon, & @@ -192,83 +188,76 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call endrun( sub//' ERROR: unknown starttype' ) end if + ! set default values for run control variables call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, & brnch_retain_casename_in=brnch_retain_casename, & single_column_in=single_column, scmlat_in=scmlat, & scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & hostname_in=hostname, username_in=username) - ! Read namelist, grid and surface data - + ! Read namelists call initialize1(dtime=dtime_sync) - ! If no land then exit out of initialization + ! Initialize decomposition (ldecomp) and domain (ldomain) types + call lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + ! If no land then exit out of initialization if ( noland ) then + call seq_infodata_PutData( infodata, lnd_present =.false.) call seq_infodata_PutData( infodata, lnd_prognostic=.false.) - return - end if - - ! Determine if aerosol and dust deposition come from atmosphere component - - call seq_infodata_GetData(infodata, atm_aero=atm_aero ) - if ( .not. atm_aero )then - call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) - end if - - ! Initialize clm gsMap, clm domain and clm attribute vectors - - call get_proc_bounds( bounds ) - - call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) - lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) - - call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) - - call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) - call mct_aVect_zero(x2l_l) - - call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) - call mct_aVect_zero(l2x_l) - ! Finish initializing clm - - call initialize2() - - ! Create land export state - - call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) - - ! Fill in infodata settings + else - call seq_infodata_PutData(infodata, lnd_prognostic=.true.) - call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) + ! Determine if aerosol and dust deposition come from atmosphere component + call seq_infodata_GetData(infodata, atm_aero=atm_aero ) + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if - ! Get infodata info + ! Initialize clm gsMap, clm domain and clm attribute vectors + call get_proc_bounds( bounds ) + call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) + call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) + call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) + call mct_aVect_zero(x2l_l) + call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) + call mct_aVect_zero(l2x_l) + + ! Finish initializing clm + call initialize2(ni,nj) + call initialize3() + + ! Create land export state + call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - call set_nextsw_cday(nextsw_cday) - call lnd_handle_resume( cdata_l ) + ! Fill in infodata settings + call seq_infodata_PutData(infodata, lnd_prognostic=.true.) + call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) - ! Reset shr logging to original values + ! Get infodata info + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + call set_nextsw_cday(nextsw_cday) + call lnd_handle_resume( cdata_l ) - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) + ! Reset shr logging to original values + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) #if (defined _MEMTRACE) - if(masterproc) then - write(iulog,*) TRIM(Sub) // ':end::' - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) - call memmon_reset_addr() - endif + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) + call memmon_reset_addr() + endif #endif + end if end subroutine lnd_init_mct !==================================================================================== - subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! ! !DESCRIPTION: @@ -500,7 +489,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) end subroutine lnd_run_mct !==================================================================================== - subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) ! ! !DESCRIPTION: @@ -522,7 +510,6 @@ subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) end subroutine lnd_final_mct !==================================================================================== - subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) ! ! !DESCRIPTION: @@ -550,11 +537,9 @@ subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) ! Build the land grid numbering for MCT ! NOTE: Numbering scheme is: West to East and South to North ! starting at south pole. Should be the same as what's used in SCRIP - allocate(gindex(bounds%begg:bounds%endg),stat=ier) ! number the local grid - do n = bounds%begg, bounds%endg gindex(n) = ldecomp%gdc2glo(n) end do @@ -568,7 +553,6 @@ subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) end subroutine lnd_SetgsMap_mct !==================================================================================== - subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) ! ! !DESCRIPTION: @@ -660,7 +644,6 @@ subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) end subroutine lnd_domain_mct !==================================================================================== - subroutine lnd_handle_resume( cdata_l ) ! ! !DESCRIPTION: diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 new file mode 100644 index 0000000000..6b343875c7 --- /dev/null +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -0,0 +1,299 @@ +module lnd_set_decomp_and_domain + + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use spmdMod , only : masterproc + use clm_varctl , only : iulog + use perf_mod , only : t_startf, t_stopf, t_barrierf + + implicit none + private ! except + + ! public member routines + public :: lnd_set_decomp_and_domain_from_surfrd + + ! private member routines + public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) + public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + + ! Initialize ldecomp and ldomain data types + + use clm_varpar , only: nlevsoi + use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams + use decompInitMod , only: decompInit_lnd, decompInit_lnd3D + use decompMod , only: bounds_type, get_proc_bounds + use domainMod , only: ldomain, domain_init, domain_check + + ! input/output variables + logical, intent(out) :: noland + integer, intent(out) :: ni, nj ! global grid sizes + + ! local variables + integer ,pointer :: amask(:) ! global land mask + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds ! bounds + character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' + !----------------------------------------------------------------------- + + ! Read in global land grid and land mask (amask)- needed to set decomposition + ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below + if (masterproc) then + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + endif + + ! Get global mask, ni and nj + call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) + + ! Exit early if no valid land points + if ( all(amask == 0) )then + if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' + noland = .true. + return + else + noland = .false. + end if + + ! Initialize ldecomp data type + ! Determine ctsm gridcell decomposition and processor bounds for gridcells + call decompInit_lnd(ni, nj, amask) + deallocate(amask) + if (use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) + + ! Initialize bounds for just gridcells + ! Remaining bounds (landunits, columns, patches) will be determined + ! after the call to decompInit_glcp - so get_proc_bounds is called + ! twice and the gridcell information is just filled in twice + call get_proc_bounds(bounds) + + ! Get grid cell bounds values + begg = bounds%begg + endg = bounds%endg + + ! Initialize ldomain data type + if (masterproc) then + write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) + endif + call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) + if (masterproc) then + call domain_check(ldomain) + endif + ldomain%mask = 1 !!! TODO - is this needed? + + end subroutine lnd_set_decomp_and_domain_from_surfrd + + !----------------------------------------------------------------------- + subroutine surfrd_get_globmask(filename, mask, ni, nj) + ! + ! !DESCRIPTION: + ! Read the surface dataset grid related information: + ! This is the first routine called by clm_initialize + ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET + ! + ! !USES: + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: filename ! grid filename + integer , pointer :: mask(:) ! grid mask + integer , intent(out) :: ni, nj ! global grid sizes + ! + ! !LOCAL VARIABLES: + logical :: isgrid2d + integer :: dimid,varid ! netCDF id's + integer :: ns ! size of grid on file + integer :: n,i,j ! index + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name + !----------------------------------------------------------------------- + + if (filename == ' ') then + mask(:) = 1 + else + ! Check if file exists + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + + ! Open file + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions and if grid file is 2d or 1d + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + if (masterproc) then + write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d + end if + allocate(mask(ns)) + mask(:) = 1 + if (isgrid2d) then + ! Grid is 2d + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + end if + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + end if + deallocate(idata2d) + else + ! Grid is not 2d + call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + end if + end if + if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + + ! Close file + call ncd_pio_closefile(ncid) + end if + + end subroutine surfrd_get_globmask + + !----------------------------------------------------------------------- + subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) + ! + ! !DESCRIPTION: + ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED + ! Read the surface dataset grid related information: + ! o real latitude of grid cell (degrees) + ! o real longitude of grid cell (degrees) + ! + ! !USES: + use clm_varcon , only : spval, re, grlnd + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use fileutils , only : getfil + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen + use pio + ! + ! !ARGUMENTS: + integer , intent(in) :: begg, endg + type(domain_type) , intent(inout) :: ldomain ! domain to init + character(len=*) , intent(in) :: filename ! grid filename + character(len=*) ,optional , intent(in) :: glcfilename ! glc mask filename + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + integer :: beg ! local beg index + integer :: end ! local end index + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: start(1), count(1) ! 1d lat/lon array sections + integer :: ier,ret ! error status + logical :: readvar ! true => variable is on input file + logical :: isgrid2d ! true => file is 2d lat/lon + logical :: istype_domain ! true => input file is of type domain + real(r8), allocatable :: rdata2d(:,:) ! temporary + character(len=16) :: vname ! temporary + character(len=256) :: locfn ! local file name + integer :: n ! indices + character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + ! Determine isgrid2d flag for domain + call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine type of file - old style grid file or new style domain file + call check_var(ncid=ncid, varname='xc', readvar=readvar) + if (readvar)then + istype_domain = .true. + else + istype_domain = .false. + end if + + ! Read in area, lon, lat + if (istype_domain) then + call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + ! convert from radians**2 to km**2 + ldomain%area = ldomain%area * (re**2) + if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(sourcefile, __LINE__)) + call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(sourcefile, __LINE__)) + call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(sourcefile, __LINE__)) + else + call endrun( msg=" ERROR: can no longer read non domain files" ) + end if + + if (isgrid2d) then + allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) + if (istype_domain) vname = 'xc' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lon1d(:) = rdata2d(:,1) + if (istype_domain) vname = 'yc' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lat1d(:) = rdata2d(1,:) + deallocate(rdata2d) + end if + + ! Check lat limited to -90,90 + if (minval(ldomain%latc) < -90.0_r8 .or. & + maxval(ldomain%latc) > 90.0_r8) then + write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & + minval(ldomain%latc),maxval(ldomain%latc) + endif + if ( any(ldomain%lonc < 0.0_r8) )then + call endrun( msg=' ERROR: lonc is negative (see https://github.com/ESCOMP/ctsm/issues/507)' & + //errMsg(sourcefile, __LINE__)) + endif + call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(sourcefile, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) + end if + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_grid + +end module lnd_set_decomp_and_domain diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 30c1c97d61..461e99205e 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -20,35 +20,30 @@ module lnd_comp_nuopc use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use spmdMod , only : masterproc, mpicom, spmd_init - use decompMod , only : bounds_type, ldecomp, get_proc_bounds - use domainMod , only : ldomain - use controlMod , only : control_setNL + use controlMod , only : control_setNL, control_init, control_print, NLFilename use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_varctl , only : single_column, clm_varctl_set, iulog use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_varcon , only : re use clm_time_manager , only : set_timemgr_init, advance_timestep use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday - use clm_initializeMod , only : initialize1, initialize2 - use clm_driver , only : clm_drv + use clm_initializeMod , only : initialize1, initialize2, initialize3 use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance - use perf_mod , only : t_startf, t_stopf, t_barrierf - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror - use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var - use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable use lnd_import_export , only : advertise_fields, realize_fields, import_fields, export_fields use lnd_comp_shr , only : mesh, model_meshfile, model_clock + use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none private ! except - ! Module routines + ! Module public routines public :: SetServices public :: SetVM + + ! Module private routines private :: InitializeP0 private :: InitializeAdvertise private :: InitializeRealize @@ -73,8 +68,6 @@ module lnd_comp_nuopc logical :: atm_prognostic integer, parameter :: dbug = 0 character(*),parameter :: modName = "(lnd_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year @@ -87,6 +80,13 @@ module lnd_comp_nuopc character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + character(len=*) , parameter :: startup_run = 'startup' + character(len=*) , parameter :: continue_run = 'continue' + character(len=*) , parameter :: branch_run = 'branch' + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== contains !=============================================================================== @@ -138,7 +138,6 @@ subroutine SetServices(gcomp, rc) end subroutine SetServices !=============================================================================== - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! input/output variables @@ -151,14 +150,12 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitializeP0 !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! input/output variables @@ -192,7 +189,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=localpet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -321,7 +317,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_sys_abort(subname//'Need to set cism_evolve if glc is present') endif end if - + if (masterproc) then write(iulog,*)' atm_prognostic = ',atm_prognostic write(iulog,*)' rof_prognostic = ',rof_prognostic @@ -344,9 +340,14 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - use clm_instMod, only : lnd2atm_inst, lnd2glc_inst, water_inst -!$ use omp_lib, only : omp_set_num_threads - use ESMF, only : ESMF_VM, ESMF_VMGet + !$ use omp_lib, only : omp_set_num_threads + use ESMF , only : ESMF_VM, ESMF_VMGet + use clm_instMod , only : lnd2atm_inst, lnd2glc_inst, water_inst + use domainMod , only : ldomain + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_newmesh + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_meshinfo + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState @@ -355,8 +356,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Mesh) :: gridmesh ! temporary esmf mesh - type(ESMF_DistGrid) :: DistGrid ! esmf global index space descriptor type(ESMF_VM) :: vm type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time @@ -374,13 +373,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: dtime_sync ! coupling time-step from the input synchronization clock integer :: localPet integer :: localpecount - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - integer, pointer :: mask(:) ! local land/ocean mask character(ESMF_MAXSTR) :: cvalue ! config data - integer :: nlnd, nocn ! local size ofarrays - integer :: g,n ! indices real(r8) :: scmlat ! single-column latitude real(r8) :: scmlon ! single-column longitude real(r8) :: nextsw_cday ! calday from clock of next radiation computation @@ -394,25 +387,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: nsrest ! ctsm restart type logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type integer :: lbnum ! input to memory diagnostic - type(bounds_type) :: bounds ! bounds integer :: shrlogunit ! original log unit - real(r8) :: mesh_lon, mesh_lat, mesh_area - real(r8) :: tolerance_latlon = 1.e-5 - real(r8) :: tolerance_area = 1.e-3 - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - real(r8), pointer :: areaPtr(:) - type(ESMF_Field) :: areaField - integer :: dimid_ni, dimid_nj, dimid_nv - integer :: ncid, ierr - integer :: ni, nj, nv - integer :: varid_xv, varid_yv - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - type(ESMF_Grid) :: lgrid + type(bounds_type) :: bounds ! bounds + integer :: ni, nj character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -447,45 +424,36 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) caseid ctitle= trim(caseid) - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlat - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) single_column - call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) brnch_retain_casename - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype - call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) model_version - call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) hostname - call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) username - !TODO: the following strings must not be hard-wired - must have module variables - if ( trim(starttype) == trim('startup')) then + if ( trim(starttype) == trim(startup_run)) then nsrest = nsrStartup - else if (trim(starttype) == trim('continue') ) then + else if (trim(starttype) == trim(continue_run)) then nsrest = nsrContinue - else if (trim(starttype) == trim('branch')) then + else if (trim(starttype) == trim(branch_run)) then nsrest = nsrBranch else call shr_sys_abort( subname//' ERROR: unknown starttype' ) @@ -494,33 +462,25 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- ! Consistency check on namelist filename !---------------------- - call control_setNL("lnd_in"//trim(inst_suffix)) !---------------------- ! Get properties from clock !---------------------- - - call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, refTime=RefTime, & + call ESMF_ClockGet( clock, currTime=currTime, startTime=startTime, refTime=RefTime, & timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,curr_ymd) - call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) - call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then @@ -528,10 +488,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then write(iulog,*)'dtime = ', dtime_sync end if @@ -539,17 +497,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- ! Initialize module orbital values and update orbital !---------------------- - call clm_orbital_init(gcomp, iulog, masterproc, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call clm_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- ! Initialize CTSM time manager !---------------------- - ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( & @@ -563,13 +518,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- ! Set model clock in lnd_comp_shr !---------------------------------------------------------------------------- - model_clock = clock - !---------------------- - ! Read namelist, grid and surface data - !---------------------- - + ! --------------------- + ! Initialize first phase of ctsm + ! --------------------- ! set default values for run control variables call clm_varctl_set(& caseid_in=caseid, ctitle_in=ctitle, & @@ -580,185 +533,42 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) hostname_in=hostname, & username_in=username) - ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(dtime=dtime_sync, gindex_ocn=gindex_ocn) - - ! If no land then abort for now - ! TODO: need to handle the case of noland with CMEPS - ! if ( noland ) then - ! call shr_sys_abort(trim(subname)//"ERROR: Currently cannot handle case of single column with non-land") - ! end if - - ! obtain global index array for just land points which includes mask=0 or ocean points - call get_proc_bounds( bounds ) - nlnd = bounds%endg - bounds%begg + 1 - allocate(gindex_lnd(nlnd)) - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - ! create a global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) - allocate(mask(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex(n) = gindex_lnd(n) - mask(n) = 1 - else - gindex(n) = gindex_ocn(n-nlnd) - mask(n) = 0 - end if - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gindex) - - !-------------------------------- - ! generate the mesh and realize fields - !-------------------------------- + call initialize1(dtime=dtime_sync) - ! determine if the mesh will be created or read in + ! --------------------- + ! Create ctsm decomp and domain info + ! --------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (single_column) model_meshfile = 'create_mesh' - if (trim(model_meshfile) == 'create_mesh') then - ! get the datm grid from the domain file - call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! open file - ierr = nf90_open(cvalue, NF90_NOWRITE, ncid) - call nc_check_err(ierr, 'nf90_open', trim(cvalue)) - ! get dimension ids - ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) - call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(cvalue)) - ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) - call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(cvalue)) - ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) - call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(cvalue)) - ! get dimension values - ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) - call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(cvalue)) - ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) - call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(cvalue)) - ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) - call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(cvalue)) - ! get variable ids - ierr = nf90_inq_varid(ncid, 'xv', varid_xv) - call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(cvalue)) - ierr = nf90_inq_varid(ncid, 'yv', varid_yv) - call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(cvalue)) - ! allocate memory for variables and get variable values - allocate(xv(nv,ni,nj), yv(nv,ni,nj)) - ierr = nf90_get_var(ncid, varid_xv, xv) - call nc_check_err(ierr, 'nf90_get_var for xv', trim(cvalue)) - ierr = nf90_get_var(ncid, varid_yv, yv) - call nc_check_err(ierr, 'nf90_get_var for yv', trim(cvalue)) - ! close file - ierr = nf90_close(ncid) - call nc_check_err(ierr, 'nf90_close', trim(cvalue)) - ! create the grid - maxIndex(1) = ni ! number of lons - maxIndex(2) = nj ! number of lats - mincornerCoord(1) = xv(1,1,1) ! min lon - mincornerCoord(2) = yv(1,1,1) ! min lat - maxcornerCoord(1) = xv(3,ni,nj) ! max lon - maxcornerCoord(2) = yv(3,ni,nj) ! max lat - deallocate(xv,yv) - lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & - mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & - staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create the mesh from the grid - mesh = ESMF_MeshCreate(lgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! TODO: is the mask by default set to 1 if created from a grid? - ! reset the global mask (which is 1) to the land/ocean mask - ! - ! Currently, this call requires that the information has - ! already been added to the mesh during creation. For example, - ! you can only change the element mask information, if the mesh - ! was initially created with element masking. - !!! call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) - !!! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(mask) - + call lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) else - - ! read in the mesh from the file - mesh = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(model_meshfile) - end if - - ! Determine the areas on the mesh - areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name='mesh_areas', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(areaField, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(areaField, farrayPtr=areaPtr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) end if - ! realize the actively coupled fields - call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) + ! --------------------- + ! Realize the actively coupled fields + ! --------------------- + call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- + ! --------------------- ! Finish initializing ctsm - !-------------------------------- - - call initialize2() - - !-------------------------------- - ! Check that lats, lons and areas on mesh are the same as those internal to ctsm - ! obtain mesh lats and lons - !-------------------------------- + ! --------------------- + ! If no land then abort for now + ! TODO: need to handle the case of noland with CMEPS + ! if ( noland ) then + ! call shr_sys_abort(trim(subname)//"ERROR: Currently cannot handle case of single column with non-land") + ! end if - if (trim(model_meshfile) /= 'create_mesh') then - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - mesh_lon = ownedElemCoords(2*n-1) - mesh_lat = ownedElemCoords(2*n) - mesh_area = areaPtr(n) - if (abs(mesh_lon - ldomain%lonc(g)) > tolerance_latlon) then - write(6,100)'ERROR: clm_lon, mesh_lon, diff_lon = ',& - ldomain%lonc(g), mesh_lon, abs(mesh_lon - ldomain%lonc(g)) - !call shr_sys_abort() - end if - if (abs(mesh_lat - ldomain%latc(g)) > tolerance_latlon) then - write(6,100)'ERROR: clm_lat, mesh_lat, diff_lat = ',& - ldomain%latc(g), mesh_lat, abs(mesh_lat - ldomain%latc(g)) - !call shr_sys_abort() - end if - if (abs(mesh_area - ldomain%area(g)/(re*re)) > tolerance_area) then - write(6,100)'ERROR: clm_area, mesh_area, diff_area = ',& - ldomain%area(g)/(re*re), mesh_area, abs(mesh_area - ldomain%area(g)/(re*re)) - !call shr_sys_abort() - end if - end do -100 format(a,3(d13.5,2x)) - end if + call initialize2(ni, nj) + call initialize3() !-------------------------------- ! Create land export state !-------------------------------- - + call get_proc_bounds(bounds) call export_fields(gcomp, bounds, glc_present, rof_prognostic, & water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -808,16 +618,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize !=============================================================================== - subroutine ModelAdvance(gcomp, rc) !------------------------ ! Run CTSM !------------------------ - use clm_instMod, only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst !$ use omp_lib, only : omp_set_num_threads - use ESMF, only : ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VM, ESMF_VMGet + use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst + use decompMod , only : bounds_type, get_proc_bounds + use clm_driver , only : clm_drv ! input/output variables type(ESMF_GridComp) :: gcomp @@ -902,12 +713,14 @@ subroutine ModelAdvance(gcomp, rc) call set_nextsw_cday( nextsw_cday ) call t_stopf(trim(subname)//' nextsw_cday') + ! Get proc bounds + call get_proc_bounds(bounds) + !-------------------------------- ! Unpack import state !-------------------------------- call t_startf ('lc_lnd_import') - call get_proc_bounds(bounds) call import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1077,7 +890,6 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance !=============================================================================== - subroutine ModelSetRunClock(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1201,7 +1013,6 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock !=============================================================================== - subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1230,7 +1041,6 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize !=============================================================================== - subroutine clm_orbital_init(gcomp, logunit, mastertask, rc) !---------------------------------------------------------- @@ -1330,7 +1140,6 @@ subroutine clm_orbital_init(gcomp, logunit, mastertask, rc) end subroutine clm_orbital_init !=============================================================================== - subroutine clm_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- @@ -1386,18 +1195,4 @@ subroutine clm_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0 end subroutine clm_orbital_update - !=============================================================================== - - subroutine nc_check_err(ierror, description, filename) - integer , intent(in) :: ierror - character(*), intent(in) :: description - character(*), intent(in) :: filename - - if (ierror /= nf90_noerr) then - write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& - '". Error message:', trim(nf90_strerror(ierror)) - call shr_sys_abort() - endif - end subroutine nc_check_err - end module lnd_comp_nuopc diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index f53b6ccd5e..622e3acca9 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -11,7 +11,7 @@ module lnd_import_export use shr_sys_mod , only : shr_sys_abort use clm_varctl , only : iulog use clm_time_manager , only : get_nstep - use decompmod , only : bounds_type + use decompmod , only : bounds_type, get_proc_bounds use lnd2atmType , only : lnd2atm_type use lnd2glcMod , only : lnd2glc_type use atm2lndType , only : atm2lnd_type @@ -183,6 +183,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r else send_to_atm = .false. end if + !DEBUG: + send_to_atm = .true. + !DEBUG call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -305,7 +308,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - ! from atm + ! from atm call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_z ) call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_topo ) call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_u ) @@ -442,11 +445,11 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! input/output variabes type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds + type(bounds_type) , intent(in) :: bounds ! bounds logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF model - type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type - type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type type(Wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst integer , intent(out) :: rc @@ -458,10 +461,10 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8), pointer :: fldPtr2d(:,:) character(len=CS) :: fldname integer :: num - integer :: begg, endg ! bounds - integer :: g,i,k,n ! indices - real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) - real(r8) :: forc_pbot ! atmospheric pressure (Pa) + integer :: begg, endg ! bounds + integer :: g,i,k,n ! indices + real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) real(r8) :: co2_ppmv_input(bounds%begg:bounds%endg) ! temporary real(r8) :: forc_ndep(bounds%begg:bounds%endg,2) real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s @@ -696,7 +699,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! input/output variables type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds + type(bounds_type) , intent(in) :: bounds logical , intent(in) :: glc_present logical , intent(in) :: rof_prognostic type(waterlnd2atmbulk_type) , intent(inout) :: waterlnd2atmbulk_inst @@ -709,7 +712,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8), pointer :: fldPtr1d(:) real(r8), pointer :: fldPtr2d(:,:) character(len=CS) :: fldname - integer :: begg, endg ! bounds + integer :: begg, endg integer :: i, g, num real(r8) :: data1d(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' @@ -728,6 +731,7 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! ----------------------- ! output to mediator ! ----------------------- + call state_setexport_1d(exportState, Sl_lfrin, ldomain%frac(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -807,12 +811,12 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & minus = .true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (fldchk(exportState, Fall_fire)) then ! fire emis from land + if (fldchk(exportState, Fall_fire)) then ! fire emis from land call state_setexport_2d(exportState, Fall_fire, lnd2atm_inst%fireflx_grc(begg:,1:emis_nflds), & minus = .true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (fldchk(exportState, Sl_fztop)) then ! fire emis from land + if (fldchk(exportState, Sl_fztop)) then ! fire emis from land call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -861,15 +865,15 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - if (fldchk(exportState, Sl_tsrf_elev)) then + if (fldchk(exportState, Sl_tsrf_elev)) then call state_setexport_2d(exportState, Sl_tsrf_elev, lnd2glc_inst%tsrf_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (fldchk(exportState, Sl_topo_elev)) then + if (fldchk(exportState, Sl_topo_elev)) then call state_setexport_2d(exportState, Sl_topo_elev, lnd2glc_inst%topo_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (fldchk(exportState, Flgl_qice_elev)) then + if (fldchk(exportState, Flgl_qice_elev)) then call state_setexport_2d(exportState, Flgl_qice_elev, lnd2glc_inst%qice_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 36bf1d8a80..86aae3f5a0 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -2,76 +2,68 @@ module clm_initializeMod !----------------------------------------------------------------------- ! Performs land model initialization - ! - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_sys_mod , only : shr_sys_flush - use shr_log_mod , only : errMsg => shr_log_errMsg - use spmdMod , only : masterproc - use decompMod , only : bounds_type, get_proc_bounds, get_proc_clumps, get_clump_bounds - use abortutils , only : endrun - use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch - use clm_varctl , only : is_cold_start, is_interpolated_start - use clm_varctl , only : iulog - use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates - use clm_varctl , only : use_soil_moisture_streams - use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft, irrig_method, wt_glc_mec, topo_glc_mec, haslake - use perf_mod , only : t_startf, t_stopf - use readParamsMod , only : readParameters - use ncdio_pio , only : file_desc_t - use GridcellType , only : grc ! instance - use LandunitType , only : lun ! instance - use ColumnType , only : col ! instance - use PatchType , only : patch ! instance - use reweightMod , only : reweight_wrapup - use filterMod , only : allocFilters, filter, filter_inactive_and_active - use FatesInterfaceMod, only : set_fates_global_elements - use dynSubgridControlMod, only: dynSubgridControl_init, get_reset_dynbal_baselines - use SelfTestDriver, only : self_test_driver + !----------------------------------------------------------------------- + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use decompMod , only : bounds_type, get_proc_bounds, get_proc_clumps, get_clump_bounds + use abortutils , only : endrun + use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch + use clm_varctl , only : is_cold_start, is_interpolated_start + use clm_varctl , only : iulog + use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates + use clm_varctl , only : use_soil_moisture_streams + use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft + use clm_instur , only : irrig_method, wt_glc_mec, topo_glc_mec, haslake + use perf_mod , only : t_startf, t_stopf + use readParamsMod , only : readParameters + use ncdio_pio , only : file_desc_t + use GridcellType , only : grc ! instance + use LandunitType , only : lun ! instance + use ColumnType , only : col ! instance + use PatchType , only : patch ! instance + use reweightMod , only : reweight_wrapup + use filterMod , only : allocFilters, filter, filter_inactive_and_active + use FatesInterfaceMod , only : set_fates_global_elements + use dynSubgridControlMod , only : dynSubgridControl_init, get_reset_dynbal_baselines + use SelfTestDriver , only : self_test_driver + use SoilMoistureStreamMod , only : PrescribedSoilMoistureInit use clm_instMod - use SoilMoistureStreamMod, only : PrescribedSoilMoistureInit ! implicit none private ! By default everything is private - ! public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initialization - !----------------------------------------------------------------------- + public :: initialize3 ! Phase two initialization + integer :: actual_numcft ! numcft from sfc dataset + +!----------------------------------------------------------------------- contains +!----------------------------------------------------------------------- - !----------------------------------------------------------------------- - subroutine initialize1(dtime, gindex_ocn) + subroutine initialize1(dtime) ! ! !DESCRIPTION: ! CLM initialization first phase ! ! !USES: - use clm_varpar , only: clm_varpar_init, natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec, nlevsoi - use clm_varcon , only: clm_varcon_init - use landunit_varcon , only: landunit_varcon_init, max_lunit - use clm_varctl , only: fsurdat, fatmlndfrc, noland, version - use pftconMod , only: pftcon - use decompInitMod , only: decompInit_lnd, decompInit_clumps, decompInit_glcp, decompInit_lnd3D - use decompInitMod , only: decompInit_ocn - use domainMod , only: domain_check, ldomain, domain_init - use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid, surfrd_get_data, surfrd_get_num_patches - use controlMod , only: control_init, control_print, NLFilename - use ncdio_pio , only: ncd_pio_init - use initGridCellsMod , only: initGridCells - use ch4varcon , only: ch4conrd - use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + use clm_varpar , only: clm_varpar_init + use clm_varcon , only: clm_varcon_init + use landunit_varcon , only: landunit_varcon_init + use clm_varctl , only: fsurdat, version + use surfrdMod , only: surfrd_get_num_patches + use controlMod , only: control_init, control_print, NLFilename + use ncdio_pio , only: ncd_pio_init + use initGridCellsMod , only: initGridCells + use UrbanParamsType , only: IsSimpleBuildTemp + use dynSubgridControlMod , only: dynSubgridControl_init ! ! !ARGUMENTS integer, intent(in) :: dtime ! model time step (seconds) - - ! COMPILER_BUG(wjs, 2020-02-20, intel18.0.3) Although gindex_ocn could be - ! intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't - ! have this argument present when this is declared intent(out). (It works fine on - ! intel 19.0.2 when declared as intent(out).) See also - ! https://github.com/ESCOMP/CTSM/issues/930. - integer, pointer, optional, intent(inout) :: gindex_ocn(:) ! If present, this will hold the decomposition of ocean points (which is needed for the nuopc interface); note that this variable is allocated here, and is assumed to start unallocated ! ! !LOCAL VARIABLES: integer :: ier ! error status @@ -84,16 +76,13 @@ subroutine initialize1(dtime, gindex_ocn) integer :: nclumps ! number of clumps on this processor integer :: nc ! clump index integer :: actual_maxsoil_patches ! value from surface dataset - integer :: actual_numcft ! numcft from sfc dataset integer ,pointer :: amask(:) ! global land mask character(len=32) :: subname = 'initialize1' ! subroutine name !----------------------------------------------------------------------- call t_startf('clm_init1') - ! ------------------------------------------------------------------------ ! Initialize run control variables, timestep - ! ------------------------------------------------------------------------ if ( masterproc )then write(iulog,*) trim(version) @@ -109,121 +98,99 @@ subroutine initialize1(dtime, gindex_ocn) call clm_varpar_init(actual_maxsoil_patches, actual_numcft) call clm_varcon_init( IsSimpleBuildTemp() ) call landunit_varcon_init() - if (masterproc) call control_print() - call dynSubgridControl_init(NLFilename) - ! ------------------------------------------------------------------------ - ! Read in global land grid and land mask (amask)- needed to set decomposition - ! ------------------------------------------------------------------------ - - ! global memory for amask is allocate in surfrd_get_glomask - must be - ! deallocated below - if (masterproc) then - write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) - call shr_sys_flush(iulog) - endif - call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) + call t_stopf('clm_init1') - ! Exit early if no valid land points - if ( all(amask == 0) )then - if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' - noland = .true. - return - end if + end subroutine initialize1 - ! ------------------------------------------------------------------------ + !----------------------------------------------------------------------- + subroutine initialize2(ni,nj) + ! + ! !DESCRIPTION: + ! CLM initialization second phase ! Determine clm gridcell decomposition and processor bounds for gridcells - ! ------------------------------------------------------------------------ - - call decompInit_lnd(ni, nj, amask) - if (present(gindex_ocn)) then - call decompInit_ocn(ni, nj, amask, gindex_ocn=gindex_ocn) - end if - deallocate(amask) + ! + ! !USES: + use clm_varpar , only: natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec + use landunit_varcon , only: landunit_varcon_init, max_lunit + use clm_varctl , only: fsurdat + use pftconMod , only: pftcon + use decompInitMod , only: decompInit_clumps, decompInit_glcp + use domainMod , only: domain_check, ldomain, domain_init + use surfrdMod , only: surfrd_get_data + use controlMod , only: NLFilename + use initGridCellsMod , only: initGridCells + use ch4varcon , only: ch4conrd + use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + ! + ! !ARGUMENTS + integer, intent(in) :: ni, nj ! global grid sizes + ! + ! !LOCAL VARIABLES: + integer :: i,j,n,k,c,l,g ! indices + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds_proc + type(bounds_type) :: bounds_clump + integer :: nclumps ! number of clumps on this processor + integer :: nc ! clump index + character(len=32) :: subname = 'initialize2' ! subroutine name + !----------------------------------------------------------------------- - if(use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) - ! *** Get JUST gridcell processor bounds *** - ! Remaining bounds (landunits, columns, patches) will be determined - ! after the call to decompInit_glcp - so get_proc_bounds is called - ! twice and the gridcell information is just filled in twice + call t_startf('clm_init2') + ! Get processor bounds call get_proc_bounds(begg, endg) - ! ------------------------------------------------------------------------ - ! Get grid and land fraction (set ldomain) - ! ------------------------------------------------------------------------ - - if (masterproc) then - write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) - call shr_sys_flush(iulog) - endif - call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) - if (masterproc) then - call domain_check(ldomain) - endif - ldomain%mask = 1 !!! TODO - is this needed? - ! Initialize glc behavior call glc_behavior%Init(begg, endg, NLFilename) ! Initialize urban model input (initialize urbinp data structure) ! This needs to be called BEFORE the call to surfrd_get_data since ! that will call surfrd_get_special which in turn calls check_urban - call UrbanInput(begg, endg, mode='initialize') ! Allocate surface grid dynamic memory (just gridcell bounds dependent) - allocate (wt_lunit (begg:endg, max_lunit )) allocate (urban_valid (begg:endg )) allocate (wt_nat_patch (begg:endg, natpft_lb:natpft_ub )) allocate (wt_cft (begg:endg, cft_lb:cft_ub )) allocate (fert_cft (begg:endg, cft_lb:cft_ub )) allocate (irrig_method (begg:endg, cft_lb:cft_ub )) - allocate (wt_glc_mec (begg:endg, maxpatch_glcmec)) - allocate (topo_glc_mec(begg:endg, maxpatch_glcmec)) + allocate (wt_glc_mec (begg:endg, maxpatch_glcmec )) + allocate (topo_glc_mec (begg:endg, maxpatch_glcmec )) allocate (haslake (begg:endg )) + ! Read list of Patches and their corresponding parameter values ! Independent of model resolution, Needs to stay before surfrd_get_data - call pftcon%Init() ! Read surface dataset and set up subgrid weight arrays call surfrd_get_data(begg, endg, ldomain, fsurdat, actual_numcft) - ! ------------------------------------------------------------------------ ! Ask Fates to evaluate its own dimensioning needs. ! This determines the total amount of space it requires in its largest ! dimension. We are currently calling that the "cohort" dimension, but ! it is really a utility dimension that captures the models largest ! size need. ! Sets: - ! fates_maxElementsPerPatch - ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) - ! + ! fates_maxElementsPerPatch + ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) ! (Note: fates_maxELementsPerSite is the critical variable used by CLM ! to allocate space) - ! ------------------------------------------------------------------------ - call set_fates_global_elements(use_fates) - ! ------------------------------------------------------------------------ ! Determine decomposition of subgrid scale landunits, columns, patches - ! ------------------------------------------------------------------------ - - call decompInit_clumps(ns, ni, nj, glc_behavior) + call decompInit_clumps(ni, nj, glc_behavior) ! *** Get ALL processor bounds - for gridcells, landunit, columns and patches *** - call get_proc_bounds(bounds_proc) ! Allocate memory for subgrid data structures ! This is needed here BEFORE the following call to initGridcells ! Note that the assumption is made that none of the subgrid initialization ! can depend on other elements of the subgrid in the calls below - call grc%Init (bounds_proc%begg, bounds_proc%endg) call lun%Init (bounds_proc%begl, bounds_proc%endl) call col%Init (bounds_proc%begc, bounds_proc%endc) @@ -231,15 +198,12 @@ subroutine initialize1(dtime, gindex_ocn) ! Build hierarchy and topological info for derived types ! This is needed here for the following call to decompInit_glcp - call initGridCells(glc_behavior) ! Set global seg maps for gridcells, landlunits, columns and patches - - call decompInit_glcp(ns, ni, nj, glc_behavior) + call decompInit_glcp(ni, nj, glc_behavior) ! Set filters - call allocFilters() nclumps = get_proc_clumps() @@ -250,14 +214,10 @@ subroutine initialize1(dtime, gindex_ocn) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ - ! Remainder of initialization1 - ! ------------------------------------------------------------------------ ! Set CH4 Model Parameters from namelist. ! Need to do before initTimeConst so that it knows whether to ! look for several optional parameters on surfdata file. - if (use_lch4) then call ch4conrd() end if @@ -268,21 +228,19 @@ subroutine initialize1(dtime, gindex_ocn) ! Deallocate surface grid dynamic memory for variables that aren't needed elsewhere. ! Some things are kept until the end of initialize2; urban_valid is kept through the ! end of the run for error checking. - deallocate (wt_lunit, wt_cft, wt_glc_mec, haslake) - call t_stopf('clm_init1') + call t_stopf('clm_init2') - end subroutine initialize1 + end subroutine initialize2 !----------------------------------------------------------------------- - subroutine initialize2( ) + subroutine initialize3( ) ! ! !DESCRIPTION: - ! CLM initialization - second phase + ! CLM initialization - third phase ! ! !USES: - use shr_orb_mod , only : shr_orb_decl use shr_scam_mod , only : shr_scam_getCloseLatLon use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND @@ -349,10 +307,10 @@ subroutine initialize2( ) integer :: begc, endc integer :: begl, endl real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays - character(len=32) :: subname = 'initialize2' + character(len=32) :: subname = 'initialize3' !---------------------------------------------------------------------- - call t_startf('clm_init2') + call t_startf('clm_init3') ! ------------------------------------------------------------------------ ! Determine processor bounds and clumps for this processor @@ -510,30 +468,24 @@ subroutine initialize2( ) ! NOTE(wjs, 2016-02-23) Maybe the rest of the body of this conditional should also ! be moved into bgc_vegetation_inst%Init2 - if (n_drydep > 0 .and. drydep_method == DD_XLND) then ! Must do this also when drydeposition is used so that estimates of monthly ! differences in LAI can be computed call SatellitePhenologyInit(bounds_proc) end if - if ( use_c14 .and. use_c14_bombspike ) then call C14_init_BombSpike() end if - if ( use_c13 .and. use_c13_timeseries ) then call C13_init_TimeSeries() end if else call SatellitePhenologyInit(bounds_proc) end if - - if(use_soil_moisture_streams) then + if (use_soil_moisture_streams) then call PrescribedSoilMoistureInit(bounds_proc) endif - - ! ------------------------------------------------------------------------ ! On restart only - process the history namelist. ! ------------------------------------------------------------------------ @@ -803,8 +755,6 @@ subroutine initialize2( ) endif call t_stopf('init_wlog') - call t_stopf('clm_init2') - if (water_inst%DoConsistencyCheck()) then !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps @@ -814,6 +764,8 @@ subroutine initialize2( ) !$OMP END PARALLEL DO end if - end subroutine initialize2 + call t_stopf('clm_init3') + + end subroutine initialize3 end module clm_initializeMod diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index b70827a084..05a68c4c9a 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -50,9 +50,6 @@ module clm_varctl ! by default this is not allowed logical, public :: brnch_retain_casename = .false. - !true => no valid land points -- do NOT run - logical, public :: noland = .false. - ! true => run tests of ncdio_pio logical, public :: for_testing_run_ncdiopio_tests = .false. diff --git a/src/main/decompInitMod.F90 b/src/main/decompInitMod.F90 index 540dd3cde9..0ad490aaf1 100644 --- a/src/main/decompInitMod.F90 +++ b/src/main/decompInitMod.F90 @@ -428,7 +428,7 @@ subroutine decompInit_ocn(ni, nj, amask, gindex_ocn) end subroutine decompInit_ocn !------------------------------------------------------------------------------ - subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) + subroutine decompInit_clumps(lni,lnj,glc_behavior) ! ! !DESCRIPTION: ! This subroutine initializes the land surface decomposition into a clump @@ -441,7 +441,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) ! ! !ARGUMENTS: implicit none - integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , intent(in) :: lni,lnj ! land domain global size type(glc_behavior_type), intent(in) :: glc_behavior ! ! !LOCAL VARIABLES: @@ -590,7 +590,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) end subroutine decompInit_clumps !------------------------------------------------------------------------------ - subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) + subroutine decompInit_glcp(lni,lnj,glc_behavior) ! ! !DESCRIPTION: ! Determine gsMaps for landunits, columns, patches and cohorts @@ -602,7 +602,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) ! ! !ARGUMENTS: implicit none - integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , intent(in) :: lni,lnj ! land domain global size type(glc_behavior_type), intent(in) :: glc_behavior ! ! !LOCAL VARIABLES: diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index 6412fafe9c..33c5194423 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -15,7 +15,8 @@ module surfrdMod use clm_varcon , only : grlnd use clm_varctl , only : iulog use clm_varctl , only : use_cndv, use_crop - use surfrdUtilsMod , only : check_sums_equal_1, collapse_crop_types, collapse_to_dominant, collapse_crop_var, collapse_individual_lunits + use surfrdUtilsMod , only : check_sums_equal_1, collapse_crop_types + use surfrdUtilsMod , only : collapse_to_dominant, collapse_crop_var, collapse_individual_lunits use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen use pio @@ -26,238 +27,23 @@ module surfrdMod save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) - public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) - public :: surfrd_get_data ! Read surface dataset and determine subgrid weights + public :: surfrd_get_data ! Read surface dataset and determine subgrid weights public :: surfrd_get_num_patches ! Read surface dataset to determine maxsoil_patches and numcft ! !PRIVATE MEMBER FUNCTIONS: - private :: surfrd_special ! Read the special landunits - private :: surfrd_veg_all ! Read all of the vegetated landunits - private :: surfrd_veg_dgvm ! Read vegetated landunits for DGVM mode - private :: surfrd_pftformat ! Read crop pfts in file format where they are part of the vegetated land unit - private :: surfrd_cftformat ! Read crop pfts in file format where they are on their own landunit + private :: surfrd_special ! Read the special landunits + private :: surfrd_veg_all ! Read all of the vegetated landunits + private :: surfrd_veg_dgvm ! Read vegetated landunits for DGVM mode + private :: surfrd_pftformat ! Read crop pfts in file format where they are part of the vegetated land unit + private :: surfrd_cftformat ! Read crop pfts in file format where they are on their own landunit ! ! !PRIVATE DATA MEMBERS: - ! default multiplication factor for epsilon for error checks - real(r8), private, parameter :: eps_fact = 2._r8 - character(len=*), parameter, private :: sourcefile = & __FILE__ !----------------------------------------------------------------------- contains - !----------------------------------------------------------------------- - subroutine surfrd_get_globmask(filename, mask, ni, nj) - ! - ! !DESCRIPTION: - ! Read the surface dataset grid related information: - ! This is the first routine called by clm_initialize - ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET - ! - ! !USES: - use fileutils , only : getfil - ! - ! !ARGUMENTS: - character(len=*), intent(in) :: filename ! grid filename - integer , pointer :: mask(:) ! grid mask - integer , intent(out) :: ni, nj ! global grid sizes - ! - ! !LOCAL VARIABLES: - logical :: isgrid2d - integer :: dimid,varid ! netCDF id's - integer :: ns ! size of grid on file - integer :: n,i,j ! index - integer :: ier ! error status - type(file_desc_t) :: ncid ! netcdf id - character(len=256) :: varname ! variable name - character(len=256) :: locfn ! local file name - logical :: readvar ! read variable in or not - integer , allocatable :: idata2d(:,:) - character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name - !----------------------------------------------------------------------- - - if (filename == ' ') then - mask(:) = 1 - RETURN - end if - - if (masterproc) then - if (filename == ' ') then - write(iulog,*) trim(subname),' ERROR: filename must be specified ' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - end if - - call getfil( filename, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - ! Determine dimensions and if grid file is 2d or 1d - - call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) - if (masterproc) then - write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d - end if - - allocate(mask(ns)) - mask(:) = 1 - - if (isgrid2d) then - allocate(idata2d(ni,nj)) - idata2d(:,:) = 1 - call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) - if (.not. readvar) then - call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) - end if - if (readvar) then - do j = 1,nj - do i = 1,ni - n = (j-1)*ni + i - mask(n) = idata2d(i,j) - enddo - enddo - end if - deallocate(idata2d) - else - call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) - if (.not. readvar) then - call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) - end if - end if - if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - - call ncd_pio_closefile(ncid) - - end subroutine surfrd_get_globmask - - !----------------------------------------------------------------------- - subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) - ! - ! !DESCRIPTION: - ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED - ! Read the surface dataset grid related information: - ! o real latitude of grid cell (degrees) - ! o real longitude of grid cell (degrees) - ! - ! !USES: - use clm_varcon, only : spval, re - use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d - use fileutils , only : getfil - ! - ! !ARGUMENTS: - integer ,intent(in) :: begg, endg - type(domain_type),intent(inout) :: ldomain ! domain to init - character(len=*) ,intent(in) :: filename ! grid filename - character(len=*) ,optional, intent(in) :: glcfilename ! glc mask filename - ! - ! !LOCAL VARIABLES: - type(file_desc_t) :: ncid ! netcdf id - integer :: beg ! local beg index - integer :: end ! local end index - integer :: ni,nj,ns ! size of grid on file - integer :: dimid,varid ! netCDF id's - integer :: start(1), count(1) ! 1d lat/lon array sections - integer :: ier,ret ! error status - logical :: readvar ! true => variable is on input file - logical :: isgrid2d ! true => file is 2d lat/lon - logical :: istype_domain ! true => input file is of type domain - real(r8), allocatable :: rdata2d(:,:) ! temporary - character(len=16) :: vname ! temporary - character(len=256):: locfn ! local file name - integer :: n ! indices - real(r8):: eps = 1.0e-12_r8 ! lat/lon error tolerance - character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name -!----------------------------------------------------------------------- - - if (masterproc) then - if (filename == ' ') then - write(iulog,*) trim(subname),' ERROR: filename must be specified ' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - end if - - call getfil( filename, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - ! Determine dimensions - call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) - - ! Determine isgrid2d flag for domain - call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine type of file - old style grid file or new style domain file - call check_var(ncid=ncid, varname='xc', readvar=readvar) - if (readvar)then - istype_domain = .true. - else - istype_domain = .false. - end if - - ! Read in area, lon, lat - - if (istype_domain) then - call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & - dim1name=grlnd, readvar=readvar) - ! convert from radians**2 to km**2 - ldomain%area = ldomain%area * (re**2) - if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(sourcefile, __LINE__)) - - call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(sourcefile, __LINE__)) - - call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(sourcefile, __LINE__)) - else - call endrun( msg=" ERROR: can no longer read non domain files" ) - end if - - if (isgrid2d) then - allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) - if (istype_domain) vname = 'xc' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) - lon1d(:) = rdata2d(:,1) - if (istype_domain) vname = 'yc' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) - lat1d(:) = rdata2d(1,:) - deallocate(rdata2d) - end if - - ! Check lat limited to -90,90 - - if (minval(ldomain%latc) < -90.0_r8 .or. & - maxval(ldomain%latc) > 90.0_r8) then - write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & - minval(ldomain%latc),maxval(ldomain%latc) - ! call endrun( msg=' ERROR: lat is outside [-90,90]'//errMsg(sourcefile, __LINE__)) - ! write(iulog,*) trim(subname),' Limiting lat/lon to [-90/90] from ', & - ! minval(domain%latc),maxval(domain%latc) - ! where (ldomain%latc < -90.0_r8) ldomain%latc = -90.0_r8 - ! where (ldomain%latc > 90.0_r8) ldomain%latc = 90.0_r8 - endif - if ( any(ldomain%lonc < 0.0_r8) )then - call endrun( msg=' ERROR: lonc is negative and currently can NOT be (see https://github.com/ESCOMP/ctsm/issues/507)' & - //errMsg(sourcefile, __LINE__)) - endif - - call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(sourcefile, __LINE__)) - end if - - call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) - end if - - call ncd_pio_closefile(ncid) - - end subroutine surfrd_get_grid - !----------------------------------------------------------------------- subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) ! @@ -523,24 +309,24 @@ subroutine surfrd_special(begg, endg, ncid, ns) integer , intent(in) :: ns ! domain size ! ! !LOCAL VARIABLES: - integer :: n,nl,nurb,g ! indices - integer :: dimid,varid ! netCDF id's - real(r8) :: nlevsoidata(nlevsoifl) - logical :: found ! temporary for error check - integer :: nindx ! temporary for error check - integer :: ier ! error status - logical :: readvar - real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier - real(r8),pointer :: pctlak(:) ! percent of grid cell is lake - real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland - real(r8),pointer :: pcturb(:,:) ! percent of grid cell is urbanized + integer :: n,nl,nurb,g ! indices + integer :: dimid,varid ! netCDF id's + real(r8) :: nlevsoidata(nlevsoifl) + logical :: found ! temporary for error check + integer :: nindx ! temporary for error check + integer :: ier ! error status + logical :: readvar + real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier + real(r8),pointer :: pctlak(:) ! percent of grid cell is lake + real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland + real(r8),pointer :: pcturb(:,:) ! percent of grid cell is urbanized integer ,pointer :: urban_region_id(:) - real(r8),pointer :: pcturb_tot(:) ! percent of grid cell is urban (sum over density classes) - real(r8),pointer :: pctspec(:) ! percent of spec lunits wrt gcell - integer :: dens_index ! urban density index - character(len=32) :: subname = 'surfrd_special' ! subroutine name - real(r8) closelat,closelon + real(r8),pointer :: pcturb_tot(:) ! percent of grid cell is urban (sum over density classes) + real(r8),pointer :: pctspec(:) ! percent of spec lunits wrt gcell + integer :: dens_index ! urban density index + real(r8) :: closelat,closelon integer, parameter :: urban_invalid_region = 0 ! urban_region_id indicating invalid point + character(len=32) :: subname = 'surfrd_special' ! subroutine name !----------------------------------------------------------------------- allocate(pctgla(begg:endg)) From 0df69be0fed13be5975d8a1c640931bd1f051a0a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 26 Dec 2020 14:50:22 -0700 Subject: [PATCH 052/219] added new file --- src/cpl/nuopc/lnd_set_decomp_and_domain.F90 | 543 ++++++++++++++++++++ 1 file changed, 543 insertions(+) create mode 100644 src/cpl/nuopc/lnd_set_decomp_and_domain.F90 diff --git a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 new file mode 100644 index 0000000000..de65fa9b58 --- /dev/null +++ b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 @@ -0,0 +1,543 @@ +module lnd_set_decomp_and_domain + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use spmdMod , only : masterproc + use clm_varctl , only : iulog + use nuopc_shr_methods , only : chkerr + + implicit none + private ! except + + ! Module public routines + public :: lnd_set_decomp_and_domain_from_meshinfo + public :: lnd_set_decomp_and_domain_from_newmesh + + ! Module private routines + private :: clm_getlandmask_from_ocnmesh + private :: clm_getlandmask_from_lndmesh + private :: nc_check_err + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) + + use NUOPC , only : NUOPC_CompAttributeGet + use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D + use domainMod , only : ldomain, domain_init, lon1d, lat1d + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use clm_varpar , only : nlevsoi + use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varcon , only : re + use lnd_comp_shr , only : model_meshfile, model_clock + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: mesh_lnd + type(ESMF_Mesh) :: mesh_ocn + type(ESMF_DistGrid) :: distgrid_mesh + type(ESMF_DistGrid) :: distgrid_lnd + character(CL) :: cvalue ! config data + integer :: nlnd, nocn ! local size of arrays + integer :: g,n ! indices + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + character(CL) :: meshfile_ocn + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex(:) ! global index space for land and ocean points + integer , pointer :: mask(:) ! local land/ocean mask + integer , pointer :: lndmask_loc(:) + real(r8) , pointer :: lndfrac_loc(:) + real(r8) , pointer :: lndarea_loc(:) + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + real(r8) , pointer :: lndarea_glob(:) + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + integer , pointer :: itemp_glob(:) + real(r8) , pointer :: ownedElemCoords(:) + real(r8) , pointer :: dataptr1d(:) + integer :: lsize, gsize + logical :: isgrid2d + integer :: spatialDim + type(ESMF_Field) :: areaField + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! get vm + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine global 2d sizes + call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ni + call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) nj + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + ! read in the land mesh from the file + mesh_lnd = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'land mesh file ',trim(model_meshfile) + end if + + ! read in ocn mask meshfile + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + mesh_ocn = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + end if + + ! set local land fraction and land mask for input read decomposition + ! Note that lndmask_loc and lndfrac_loc are allocated in the following calls and lsize is returned + if (trim(meshfile_ocn) == 'null') then + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex(lsize)) + call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + + ! determine lnd decomposition that will be used by ctsm + call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Determine ocn decomposition that will be used to create the full mesh + ! note that the memory for gindex_ocn will be allocated in the following call + call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) + + ! *** Get JUST gridcell processor bounds *** + ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp + ! so get_proc_bounds is called twice and the gridcell information is just filled in twice + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create gindex_lnd + nlnd = endg - begg + 1 + allocate(gindex_lnd(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask + do g = begg, endg + n = 1 + (g - begg) + ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) + end do + deallocate(lndmask_glob) + + ! Determine ldomain%frac + allocate(rtemp_glob(gsize)) + allocate(lndfrac_glob(gsize)) + lndfrac_glob(:) = 0._r8 + do n = 1,lsize + lndfrac_glob(gindex(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndfrac_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%frac(g) = lndfrac_glob(gindex_lnd(g-begg+1)) + end do + deallocate(lndfrac_glob) + + ! Get ownedElemCords from the mesh to be used to obtain ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) + allocate(ownedElemCoords(spatialDim*lsize)) + call ESMF_MeshGet(mesh_lnd, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine ldomain%latc and global lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,lsize + lndlats_glob(gindex(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndlats_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%latc(g) = lndlats_glob(gindex_lnd(g-begg+1)) + end do + if (isgrid2d) then + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = lndlats_glob((n-1)*ni + 1) + end do + end if + deallocate(lndlats_glob) + + ! Determine ldomain%lonc and global lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,lsize + lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndlons_glob(:) = rtemp_glob(:) + do g = begg, endg + ldomain%lonc(g) = lndlons_glob(gindex_lnd(g-begg+1)) + end do + if (isgrid2d) then + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = lndlons_glob(n) + end do + end if + deallocate(lndlons_glob) + deallocate(rtemp_glob) + + ! Create a global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex(n) = gindex_lnd(n) + else + gindex(n) = gindex_ocn(n-nlnd) + end if + end do + + ! Generate a new mesh on the gindex decomposition + distGrid_mesh = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex) + mesh = ESMF_MeshCreate(mesh_lnd, elementDistGrid=distgrid_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) + end do + call ESMF_FieldDestroy(areaField) + + end subroutine lnd_set_decomp_and_domain_from_meshinfo + + !=============================================================================== + subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) + + use NUOPC , only : NUOPC_CompAttributeGet + use clm_varctl , only : single_column + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror + use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var + use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc + + ! local variables + integer :: ncid, ierr + integer :: nv + integer :: dimid_ni, dimid_nj, dimid_nv + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + type(ESMF_Grid) :: lgrid + real(r8), allocatable :: xv(:,:,:), yv(:,:,:) + integer :: varid_xv, varid_yv + character(len=CL) :: cvalue + integer :: gsize + logical :: isgrid2d + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! determine global 2d sizes + call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ni + call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) nj + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + ! get the datm grid from the domain file + call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! open file + ierr = nf90_open(cvalue, NF90_NOWRITE, ncid) + call nc_check_err(ierr, 'nf90_open', trim(cvalue)) + ! get dimension ids + ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) + call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(cvalue)) + ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) + call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(cvalue)) + ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) + call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(cvalue)) + ! get dimension values + ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) + call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(cvalue)) + ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) + call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(cvalue)) + ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) + call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(cvalue)) + ! get variable ids + ierr = nf90_inq_varid(ncid, 'xv', varid_xv) + call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(cvalue)) + ierr = nf90_inq_varid(ncid, 'yv', varid_yv) + call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(cvalue)) + ! allocate memory for variables and get variable values + allocate(xv(nv,ni,nj), yv(nv,ni,nj)) + ierr = nf90_get_var(ncid, varid_xv, xv) + call nc_check_err(ierr, 'nf90_get_var for xv', trim(cvalue)) + ierr = nf90_get_var(ncid, varid_yv, yv) + call nc_check_err(ierr, 'nf90_get_var for yv', trim(cvalue)) + ! close file + ierr = nf90_close(ncid) + call nc_check_err(ierr, 'nf90_close', trim(cvalue)) + ! create the grid + maxIndex(1) = ni ! number of lons + maxIndex(2) = nj ! number of lats + mincornerCoord(1) = xv(1,1,1) ! min lon + mincornerCoord(2) = yv(1,1,1) ! min lat + maxcornerCoord(1) = xv(3,ni,nj) ! max lon + maxcornerCoord(2) = yv(3,ni,nj) ! max lat + deallocate(xv,yv) + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the grid + mesh = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! TODO: initialize the decomposition + ! initialize ldomain + ! initialize the mask and mesh + ! for created meshes assume the mask is 1 + ! create a pointer for mask and set it to 1 + ! call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! deallocate(mask) + + end subroutine lnd_set_decomp_and_domain_from_newmesh + + !=============================================================================== + subroutine clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize_lnd, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + type(ESMF_Mesh) , intent(in) :: mesh_ocn + integer , pointer :: lndmask_loc(:) + real(r8) , pointer :: lndfrac_loc(:) + integer , intent(out) :: lsize_lnd + type(ESMF_DistGrid) , intent(out) :: distgrid_lnd + integer , intent(out) :: rc + + ! local variables: + type(ESMF_RouteHandle) :: rhandle_ocn2lnd + type(ESMF_Field) :: field_lnd + type(ESMF_Field) :: field_ocn + type(ESMF_DistGrid) :: distgrid_ocn + real(r8) , pointer :: ocnmask_loc(:) ! on ocean mesh + real(r8) , pointer :: ocnfrac_loc(:) ! on land mesh + real(r8) , pointer :: dataptr1d(:) + type(ESMF_Array) :: elemMaskArray + integer :: lsize_ocn + integer :: n, spatialDim + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + real(r8) :: fminval = 0.001_r8 + real(r8) :: fmaxval = 1._r8 + logical :: checkflag = .false. + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, numOwnedElements=lsize_lnd, & + elementDistGrid=distgrid_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_loc(lsize_lnd)) + allocate(lndfrac_loc(lsize_lnd)) + + ! create fields on land and ocean meshes + field_lnd = ESMF_FieldCreate(mesh_lnd, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + field_ocn = ESMF_FieldCreate(mesh_ocn, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create route handle to map ocean mask from ocn mesh to land mesh + call ESMF_FieldRegridStore(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill in values for field_ocn with mask on ocn mesh + call ESMF_MeshGet(mesh_ocn, elementdistGrid=distgrid_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_ocn, localDe=0, elementCount=lsize_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ocnmask_loc(lsize_ocn)) + elemMaskArray = ESMF_ArrayCreate(distgrid_ocn, ocnmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_ocn, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_ocn, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = ocnmask_loc(:) + + ! map ocn mask to land mesh + call ESMF_FieldRegrid(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ocnfrac_loc(lsize_lnd)) + call ESMF_FieldGet(field_lnd, farrayptr=ocnfrac_loc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndfrac_loc(n) = 1._r8 - ocnfrac_loc(n) + if (lndfrac_loc(n) > fmaxval) lndfrac_loc(n) = 1._r8 + if (lndfrac_loc(n) < fminval) lndfrac_loc(n) = 0._r8 + if (lndfrac_loc(n) /= 0._r8) then + lndmask_loc(n) = 1 + else + lndmask_loc(n) = 0 + end if + enddo + + ! deallocate memory + call ESMF_FieldDestroy(field_lnd) + call ESMF_FieldDestroy(field_ocn) + deallocate(ocnmask_loc) + + end subroutine clm_getlandmask_from_ocnmesh + + !=============================================================================== + subroutine clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + integer , intent(out) :: lsize + integer , pointer :: lndmask_loc(:) + real(r8) , pointer :: lndfrac_loc(:) + type(ESMF_DistGrid) , intent(out) :: distgrid_lnd + integer , intent(out) :: rc + + ! local variables: + type(ESMF_Array) :: elemMaskArray + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine lsize and distgrid_lnd + call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_lnd, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndfrac_loc + ! The call to ESMF_MeshGet fills in the values of lndmask_loc + allocate(lndmask_loc(lsize)) + elemMaskArray = ESMF_ArrayCreate(distgrid_lnd, lndmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_lnd, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndmask_loc + ! ASSUME that land fraction is identical to land mask in this case + allocate(lndfrac_loc(lsize)) + lndfrac_loc(:) = lndmask_loc(:) + + end subroutine clm_getlandmask_from_lndmesh + + !=============================================================================== + subroutine nc_check_err(ierror, description, filename) + + use shr_sys_mod , only : shr_sys_abort + use netcdf , only : nf90_noerr, nf90_strerror + + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + + if (ierror /= nf90_noerr) then + write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& + '". Error message:', trim(nf90_strerror(ierror)) + call shr_sys_abort() + endif + end subroutine nc_check_err + +end module lnd_set_decomp_and_domain From e0beea686ac6ad5c73805352bfdc372e494b9d47 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 27 Dec 2020 11:53:22 -0700 Subject: [PATCH 053/219] refactor of lilac cap to optionally obtain all info from the land mesh --- src/cpl/lilac/lnd_comp_esmf.F90 | 56 +- src/cpl/lilac/lnd_set_decomp_and_domain.F90 | 637 ++++++-------------- src/cpl/nuopc/lnd_set_decomp_and_domain.F90 | 2 - 3 files changed, 201 insertions(+), 494 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index ea3af7c88e..d04aa66d9a 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -39,6 +39,7 @@ module lnd_comp_esmf use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose + use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_meshinfo implicit none private ! By default make data private except @@ -129,12 +130,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! mesh generation type(ESMF_Mesh) :: lnd_mesh character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file - integer :: nlnd, nocn ! local size ofarrays integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points type(ESMF_DistGrid) :: distgrid integer :: fileunit + integer :: ni, nj ! clock info character(len=CL) :: calendar ! calendar type name @@ -334,62 +333,21 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- ! Call initialize1 !---------------------- - call initialize1(dtime=dtime_sync) + call initialize1(dtime=dtime_lilac) call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) !---------------------- - ! Initialize decomposition (ldecomp) and domain (ldomain) types + ! Initialize decomposition (ldecomp) and domain (ldomain) types and generate land mesh !---------------------- - call lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) - - !-------------------------------- - ! generate the land mesh on ctsm distribution - !-------------------------------- - ! obtain global index array for just land points which includes mask=0 or ocean points - call get_proc_bounds( bounds ) - - nlnd = bounds%endg - bounds%begg + 1 - allocate(gindex_lnd(nlnd)) - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) - - ! create a global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex(n) = gindex_lnd(n) - else - gindex(n) = gindex_ocn(n-nlnd) - end if - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + call lnd_set_decomp_and_domain_from_meshinfo(lnd_mesh_filename, lnd_mesh, ni, nj, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(gindex) - call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) - - ! create esmf mesh using distgrid and lnd_mesh_filename - lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) then - call shr_sys_abort("Error in creating mesh "// trim(lnd_mesh_filename)) - end if - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(lnd_mesh_filename) - end if - call ESMF_LogWrite(subname//" Create Mesh using file ...."//trim(lnd_mesh_filename), ESMF_LOGMSG_INFO) !-------------------------------- ! Finish initializing ctsm !-------------------------------- call initialize2(ni,nj) call initialize3() - call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"ctsm initialize done...", ESMF_LOGMSG_INFO) !-------------------------------- ! Create import state (only assume input from atm - not rof and glc) @@ -470,6 +428,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Fill in ctsm export state !-------------------------------- + call get_proc_bounds( bounds ) + call export_fields(export_state, bounds, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) diff --git a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 index d11ddbf5aa..315f5a835c 100644 --- a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 @@ -1,7 +1,6 @@ module lnd_set_decomp_and_domain use ESMF - use NUOPC , only : NUOPC_CompAttributeGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use spmdMod , only : masterproc use clm_varctl , only : iulog @@ -12,151 +11,94 @@ module lnd_set_decomp_and_domain ! Module public routines public :: lnd_set_decomp_and_domain_from_meshinfo - public :: lnd_set_decomp_and_domain_from_surfrd ! Module private routines - private :: clm_getlandmask_from_lndmesh + private :: chkerr character(len=*) , parameter :: u_FILE_u = & __FILE__ + character(len=*), parameter, private :: sourcefile = & + __FILE__ !=============================================================================== contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) - - ! Initialize ldecomp and ldomain data types - - use clm_varpar , only: nlevsoi - use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams - use decompInitMod , only: decompInit_lnd, decompInit_lnd3D - use decompMod , only: bounds_type, get_proc_bounds - use domainMod , only: ldomain, domain_init, domain_check - - ! input/output variables - logical, intent(out) :: noland - integer, intent(out) :: ni, nj ! global grid sizes - - ! local variables - integer ,pointer :: amask(:) ! global land mask - integer :: begg, endg ! processor bounds - type(bounds_type) :: bounds ! bounds - character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' - !----------------------------------------------------------------------- - - ! Read in global land grid and land mask (amask)- needed to set decomposition - ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below - if (masterproc) then - write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) - endif - - ! Get global mask, ni and nj - call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) - - ! Exit early if no valid land points - if ( all(amask == 0) )then - if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' - noland = .true. - return - else - noland = .false. - end if - - ! Initialize ldecomp data type - ! Determine ctsm gridcell decomposition and processor bounds for gridcells - call decompInit_lnd(ni, nj, amask) - deallocate(amask) - if (use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) - - ! Initialize bounds for just gridcells - ! Remaining bounds (landunits, columns, patches) will be determined - ! after the call to decompInit_glcp - so get_proc_bounds is called - ! twice and the gridcell information is just filled in twice - call get_proc_bounds(bounds) - - ! Get grid cell bounds values - begg = bounds%begg - endg = bounds%endg - - ! Initialize ldomain data type - if (masterproc) then - write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) - endif - call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) - if (masterproc) then - call domain_check(ldomain) - endif - ldomain%mask = 1 !!! TODO - is this needed? - - end subroutine lnd_set_decomp_and_domain_from_surfrd - - !==================================================================================== - subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) + subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D use domainMod , only : ldomain, domain_init, lon1d, lat1d - use decompMod , only : bounds_type, get_proc_bounds + use decompMod , only : ldecomp, bounds_type, get_proc_bounds use clm_varpar , only : nlevsoi - use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varctl , only : fatmlndfrc, fsurdat, use_soil_moisture_streams, single_column use clm_varcon , only : re - use lnd_comp_shr , only : mesh, model_meshfile, model_clock + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use fileutils , only : getfil ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(out) :: mesh + character(len=*) , intent(in) :: model_meshfile + type(ESMF_Mesh) , intent(out) :: mesh_ctsm + integer , intent(out) :: ni,nj ! global sizes of dimensions integer , intent(out) :: rc ! local variables type(ESMF_VM) :: vm - type(ESMF_Mesh) :: mesh_lnd - type(ESMF_Mesh) :: mesh_ocn - type(ESMF_RouteHandle) :: rhandle_ocn2lnd - type(ESMF_DistGrid) :: distgrid_mesh - type(ESMF_DistGrid) :: distgrid_lnd + type(ESMF_Mesh) :: mesh_input + type(ESMF_DistGrid) :: distgrid_ctsm + type(ESMF_DistGrid) :: distgrid_input character(CL) :: cvalue ! config data integer :: nlnd, nocn ! local size ofarrays integer :: g,n ! indices type(bounds_type) :: bounds ! bounds integer :: begg,endg - character(CL) :: meshfile_ocn integer , pointer :: gindex_lnd(:) ! global index space for just land points integer , pointer :: gindex_ocn(:) ! global index space for just ocean points integer , pointer :: gindex(:) ! global index space for land and ocean points + integer , pointer :: gindex_temp(:) ! temporary global index space integer , pointer :: mask(:) ! local land/ocean mask integer , pointer :: lndmask_loc(:) real(r8) , pointer :: lndfrac_loc(:) - real(r8) , pointer :: lndarea_loc(:) integer , pointer :: lndmask_glob(:) real(r8) , pointer :: lndfrac_glob(:) - real(r8) , pointer :: lndarea_glob(:) real(r8) , pointer :: lndlats_glob(:) real(r8) , pointer :: lndlons_glob(:) real(r8) , pointer :: rtemp_glob(:) integer , pointer :: itemp_glob(:) real(r8) , pointer :: dataptr1d(:) - integer :: srcMaskValue = 0 - integer :: dstMaskValue = -987987 ! spval for RH mask values - integer :: srcTermProcessing_Value = 0 - logical :: checkflag = .false. - real(r8) :: fminval = 0.001_r8 - real(r8) :: fmaxval = 1._r8 integer :: lsize,gsize logical :: isgrid2d + integer :: numownedelements real(R8) , pointer :: ownedElemCoords(:) integer :: spatialDim type(ESMF_Field) :: areaField + type(ESMF_Array) :: elemMaskArray + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! determine global 2d sizes - call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ni - call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) + ! Get current vm + call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) nj + + ! Determine global 2d sizes from read of dimensions of surface dataset + if (masterproc) then + write(iulog,*) 'Attempting to global dimensions from surface dataset' + if (fsurdat == ' ') then + write(iulog,*)'fsurdat must be specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + call getfil(fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + call ncd_pio_closefile(ncid) gsize = ni*nj if (single_column) then isgrid2d = .true. @@ -175,50 +117,82 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) end if ! read in the land mesh from the file - mesh_lnd = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + mesh_input = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then write(iulog,'(a)')'land mesh file ',trim(model_meshfile) end if - ! read in ocn mask meshfile - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh_ocn = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + ! Obtain global land amsk + if (trim(fatmlndfrc) /= 'null') then + if (masterproc) then + write(iulog,*) 'Generating ctsm decomposition from ',trim(fatmlndfrc) + endif + else + if (masterproc) then + write(iulog,*) 'Generating ctsm decomposition from ',trim(model_meshfile) + endif end if - ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, landfrac_loc, distgrid_lnd, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_glob(ni*nj)); lndmask_glob(:) = 0 + allocate(rtemp_glob(gsize)) + + if (trim(fatmlndfrc) /= 'null') then - ! determine global landmask_glob - needed to determine the ctsm decomposition - ! land frac, lats, lons and areas will be done below - allocate(gindex(lsize)) - call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 - do n = 1,lsize - lndmask_glob(gindex(n)) = lndmask_loc(n) - end do - allocate(itemp_glob(gsize)) - call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndmask_glob(:) = int(itemp_glob(:)) - deallocate(itemp_glob) - call ESMF_DistGridDestroy(distgrid_lnd) + ! Read in global land mask and land fraction from fatmlndfrc + call getfil( trim(fatmlndfrc), locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 + call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + call ncd_pio_closefile(ncid) + + else + + ! Obtain land mask from land mesh file - ASSUME THAT LAND FRAC IS IDENTICAL TO LAND MASK + call ESMF_MeshGet(mesh_input, elementdistGrid=distgrid_input, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_input, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndmask_loc + allocate(lndmask_loc(lsize)) + elemMaskArray = ESMF_ArrayCreate(distgrid_input, lndmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following calls fills in the values of lndmask_loc + call ESMF_MeshGet(mesh_input, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndfrac_loc + ! ASSUME that land fraction is identical to land mask in this case + allocate(lndfrac_loc(lsize)) + lndfrac_loc(:) = lndmask_loc(:) + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex_temp(lsize)) + call ESMF_DistGridGet(distgrid_input, 0, seqIndexList=gindex_temp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + + end if - ! determine lnd decomposition that will be used by ctsm + ! Determine lnd decomposition that will be used by ctsm call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) if (use_soil_moisture_streams) then call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) end if - ! Determine ocn decomposition that will be used to create the full mesh - ! note that the memory for gindex_ocn will be allocated in the following call - call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) - ! *** Get JUST gridcell processor bounds *** ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp ! so get_proc_bounds is called twice and the gridcell information is just filled in twice @@ -234,74 +208,10 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) gindex_lnd(n) = ldecomp%gdc2glo(g) end do - ! Initialize domain data structure - call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine ldomain%mask - do g = begg, endg - n = 1 + (g - begg) - ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) - end do - deallocate(lndmask_glob) - - ! Determine ldomain%frac - allocate(rtemp_glob(gsize)) - allocate(lndfrac_glob(gsize)) - lndfrac_glob(:) = 0._r8 - do n = 1,lsize - lndfrac_glob(gindex(n)) = lndfrac_loc(n) - end do - call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndfrac_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%frac(g) = lndfrac_glob(gindex_lnd(g-begg+1)) - end do - deallocate(lndfrac_glob) - - ! Get ownedElemCords from the mesh to be used to obtain ldoman%latc and ldomain%lonc - call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) - allocate(ownedElemCoords(spatialDim*lsize)) - call ESMF_MeshGet(mesh_lnd, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ldomain%latc and lat1d - allocate(lndlats_glob(gsize)) - lndlats_glob(:) = 0._r8 - do n = 1,lsize - lndlats_glob(gindex(n)) = ownedElemCoords(2*n) - end do - call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndlats_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%latc(g) = lndlats_glob(gindex_lnd(g-begg+1)) - end do - if (isgrid2d) then - allocate(lat1d(nj)) - do n = 1,nj - lat1d(n) = lndlats_glob((n-1)*ni + 1) - end do - end if - deallocate(lndlats_glob) - - ! Determine ldomain%lonc and lon1d - allocate(lndlons_glob(gsize)) - lndlons_glob(:) = 0._r8 - do n = 1,lsize - lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) - end do - call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndlons_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%lonc(g) = lndlats_glob(gindex_lnd(g-begg+1)) - end do - if (isgrid2d) then - allocate(lon1d(ni)) - do n = 1,ni - lon1d(n) = lndlons_glob(n) - end do - end if - deallocate(lndlons_glob) - deallocate(rtemp_glob) + ! Create gindex_ocn + ! Need this decomposition to create the full mesh + ! Note that the memory for gindex_ocn will be allocated in the following call + call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) ! Create a global index that includes both land and ocean points nocn = size(gindex_ocn) @@ -314,15 +224,62 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) end if end do - ! Generate a new mesh on the gindex decomposition - distGrid_mesh = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + ! Generate a new distgrid based on gindex + distgrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gindex) - mesh = ESMF_MeshCreate(mesh_lnd, elementDistGrid=distgrid_mesh, rc=rc) + + ! Generate the ctsm mesh on the gindex decomposition + mesh_ctsm = ESMF_MeshCreate(mesh_input, elementDistGrid=distgrid_ctsm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Create ldomain%area by querying the mesh on the ctsm decomposition - areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask + do g = begg, endg + n = gindex(g-begg+1) + ldomain%mask(g) = lndmask_glob(n) + end do + deallocate(lndmask_glob) + + ! Determine ldomain%frac + ! note that lndfrac_glob was read in from fatmlndfrc above if it was not set to null + if (trim(fatmlndfrc) == 'null') then + allocate(lndfrac_glob(gsize)) + do n = 1,nlnd + lndfrac_glob(gindex_lnd(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + do g = begg, endg + n = gindex(g-begg+1) + ldomain%frac(g) = rtemp_glob(n) + end do + deallocate(lndfrac_glob) + else + do g = begg, endg + n = gindex(g-begg+1) + ldomain%frac(g) = lndfrac_glob(n) + end do + deallocate(lndfrac_glob) + end if + + ! Determine ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh_ctsm, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg,endg + n = g - begg + 1 + ldomain%lonc(g) = ownedElemCoords(2*n-1) + if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? + ldomain%latc(g) = ownedElemCoords(2*n) + end do + + ! Determine ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh_ctsm, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridGetArea(areaField, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -333,45 +290,44 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, rc) end do call ESMF_FieldDestroy(areaField) - end subroutine lnd_set_decomp_and_domain_from_inputmesh - - !=============================================================================== - subroutine clm_getlandmask_from_lndmesh(mesh_lnd, lndmask_loc, lndfrac_loc, lsize, distgrid_lnd, rc) - - ! input/out variables - type(ESMF_Mesh) , intent(in) :: mesh_lnd - integer , pointer :: lndmask_loc(:) - real(r8) , pointer :: lndfrac_loc(:) - integer , intent(out) :: lsize - type(ESMF_DistGrid) , intent(out) :: distgrid_lnd - integer , intent(out) :: rc - - ! local variables: - type(ESMF_Array) :: elemMaskArray - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Determine lsize and distgrid_lnd - call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid_lnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_lnd, localDe=0, elementCount=lsize, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! If grid is 2d, determine lon1d and lat1d + if (isgrid2d) then + ! Determine lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,numownedelements + if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? + lndlons_glob(gindex(n)) = 0._r8 + else + lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) + end if + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlons_glob) + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = rtemp_glob(n) + end do - ! Determine lndfrac_loc - allocate(lndmask_loc(lsize)) - elemMaskArray = ESMF_ArrayCreate(distgrid_lnd, lndmask_loc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! The following calls fills in the values of lndmask_loc - call ESMF_MeshGet(mesh_lnd elemMaskArray=elemMaskArray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,numownedelements + lndlats_glob(gindex(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlats_glob) + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = rtemp_glob((n-1)*ni + 1) + end do + end if - ! Determine lndmask_loc - ! ASSUME that land fraction is identical to land mask in this case - allocate(lndfrac_loc(lsize)) - lndfrac_loc(:) = lndmask_loc(:) + deallocate(ownedElemCoords) + deallocate(rtemp_glob) + deallocate(gindex) - end subroutine clm_getlandmask_from_lndmesh + end subroutine lnd_set_decomp_and_domain_from_meshinfo !=============================================================================== logical function chkerr(rc, line, file) @@ -386,211 +342,4 @@ logical function chkerr(rc, line, file) endif end function chkerr - !=============================================================================== - subroutine surfrd_get_globmask(filename, mask, ni, nj) - ! - ! !DESCRIPTION: - ! Read the surface dataset grid related information: - ! This is the first routine called by clm_initialize - ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET - ! - ! !USES: - use fileutils , only : getfil - use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t - use abortutils , only : endrun - use shr_log_mod, only : errMsg => shr_log_errMsg - ! - ! !ARGUMENTS: - character(len=*), intent(in) :: filename ! grid filename - integer , pointer :: mask(:) ! grid mask - integer , intent(out) :: ni, nj ! global grid sizes - ! - ! !LOCAL VARIABLES: - logical :: isgrid2d - integer :: dimid,varid ! netCDF id's - integer :: ns ! size of grid on file - integer :: n,i,j ! index - integer :: ier ! error status - type(file_desc_t) :: ncid ! netcdf id - character(len=256) :: varname ! variable name - character(len=256) :: locfn ! local file name - logical :: readvar ! read variable in or not - integer , allocatable :: idata2d(:,:) - character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name - !----------------------------------------------------------------------- - - if (filename == ' ') then - mask(:) = 1 - else - ! Check if file exists - if (masterproc) then - if (filename == ' ') then - write(iulog,*) trim(subname),' ERROR: filename must be specified ' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - end if - - ! Open file - call getfil( filename, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - ! Determine dimensions and if grid file is 2d or 1d - call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) - if (masterproc) then - write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d - end if - allocate(mask(ns)) - mask(:) = 1 - if (isgrid2d) then - ! Grid is 2d - allocate(idata2d(ni,nj)) - idata2d(:,:) = 1 - call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) - if (.not. readvar) then - call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) - end if - if (readvar) then - do j = 1,nj - do i = 1,ni - n = (j-1)*ni + i - mask(n) = idata2d(i,j) - enddo - enddo - end if - deallocate(idata2d) - else - ! Grid is not 2d - call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) - if (.not. readvar) then - call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) - end if - end if - if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - - ! Close file - call ncd_pio_closefile(ncid) - end if - - end subroutine surfrd_get_globmask - - !=============================================================================== - subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) - ! - ! !DESCRIPTION: - ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED - ! Read the surface dataset grid related information: - ! o real latitude of grid cell (degrees) - ! o real longitude of grid cell (degrees) - ! - ! !USES: - use clm_varcon , only : spval, re, grlnd - use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d - use fileutils , only : getfil - use abortutils , only : endrun - use shr_log_mod, only : errMsg => shr_log_errMsg - use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile - use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen - use pio - ! - ! !ARGUMENTS: - integer , intent(in) :: begg, endg - type(domain_type) , intent(inout) :: ldomain ! domain to init - character(len=*) , intent(in) :: filename ! grid filename - character(len=*) ,optional , intent(in) :: glcfilename ! glc mask filename - ! - ! !LOCAL VARIABLES: - type(file_desc_t) :: ncid ! netcdf id - integer :: beg ! local beg index - integer :: end ! local end index - integer :: ni,nj,ns ! size of grid on file - integer :: dimid,varid ! netCDF id's - integer :: start(1), count(1) ! 1d lat/lon array sections - integer :: ier,ret ! error status - logical :: readvar ! true => variable is on input file - logical :: isgrid2d ! true => file is 2d lat/lon - logical :: istype_domain ! true => input file is of type domain - real(r8), allocatable :: rdata2d(:,:) ! temporary - character(len=16) :: vname ! temporary - character(len=256) :: locfn ! local file name - integer :: n ! indices - character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name -!----------------------------------------------------------------------- - - if (masterproc) then - if (filename == ' ') then - write(iulog,*) trim(subname),' ERROR: filename must be specified ' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - end if - - call getfil( filename, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - - ! Determine dimensions - call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) - - ! Determine isgrid2d flag for domain - call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine type of file - old style grid file or new style domain file - call check_var(ncid=ncid, varname='xc', readvar=readvar) - if (readvar)then - istype_domain = .true. - else - istype_domain = .false. - end if - - ! Read in area, lon, lat - if (istype_domain) then - call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & - dim1name=grlnd, readvar=readvar) - ! convert from radians**2 to km**2 - ldomain%area = ldomain%area * (re**2) - if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(sourcefile, __LINE__)) - call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(sourcefile, __LINE__)) - call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(sourcefile, __LINE__)) - else - call endrun( msg=" ERROR: can no longer read non domain files" ) - end if - - if (isgrid2d) then - allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) - if (istype_domain) vname = 'xc' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) - lon1d(:) = rdata2d(:,1) - if (istype_domain) vname = 'yc' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) - lat1d(:) = rdata2d(1,:) - deallocate(rdata2d) - end if - - ! Check lat limited to -90,90 - if (minval(ldomain%latc) < -90.0_r8 .or. & - maxval(ldomain%latc) > 90.0_r8) then - write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & - minval(ldomain%latc),maxval(ldomain%latc) - endif - if ( any(ldomain%lonc < 0.0_r8) )then - call endrun( msg=' ERROR: lonc is negative (see https://github.com/ESCOMP/ctsm/issues/507)' & - //errMsg(sourcefile, __LINE__)) - endif - call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(sourcefile, __LINE__)) - end if - call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & - dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) - end if - - call ncd_pio_closefile(ncid) - - end subroutine surfrd_get_grid - end module lnd_set_decomp_and_domain diff --git a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 index de65fa9b58..ca91bf4ce5 100644 --- a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 @@ -60,10 +60,8 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) integer , pointer :: mask(:) ! local land/ocean mask integer , pointer :: lndmask_loc(:) real(r8) , pointer :: lndfrac_loc(:) - real(r8) , pointer :: lndarea_loc(:) integer , pointer :: lndmask_glob(:) real(r8) , pointer :: lndfrac_glob(:) - real(r8) , pointer :: lndarea_glob(:) real(r8) , pointer :: lndlats_glob(:) real(r8) , pointer :: lndlons_glob(:) real(r8) , pointer :: rtemp_glob(:) From 36b3f33611c9c146006f0f20774d415a93634132 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 27 Dec 2020 12:14:55 -0700 Subject: [PATCH 054/219] merged intialize2 and initialize3 into initialize2 - so back to two phase intialization and move call go single column init to the caps --- src/cpl/lilac/lnd_comp_esmf.F90 | 5 +- src/cpl/mct/lnd_comp_mct.F90 | 5 +- src/cpl/mct/lnd_set_decomp_and_domain.F90 | 66 ++--- src/cpl/nuopc/lnd_comp_nuopc.F90 | 4 +- src/cpl/nuopc/lnd_import_export.F90 | 66 +++-- src/main/clm_initializeMod.F90 | 291 +++++++--------------- 6 files changed, 160 insertions(+), 277 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index d04aa66d9a..a0e1cdec22 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -35,7 +35,7 @@ module lnd_comp_esmf use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday - use clm_initializeMod , only : initialize1, initialize2, initialize3 + use clm_initializeMod , only : initialize1, initialize2 use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose @@ -346,8 +346,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Finish initializing ctsm !-------------------------------- call initialize2(ni,nj) - call initialize3() - call ESMF_LogWrite(subname//"ctsm initialize done...", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) !-------------------------------- ! Create import state (only assume input from atm - not rof and glc) diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index afd948941f..21745d0ce6 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -42,7 +42,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use shr_kind_mod , only : shr_kind_cl use abortutils , only : endrun use clm_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday - use clm_initializeMod, only : initialize1, initialize2, initialize3 + use clm_initializeMod, only : initialize1, initialize2 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog use clm_varctl , only : inst_index, inst_suffix, inst_name @@ -156,7 +156,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! Initialize clm ! initialize1 reads namelists ! decomp and domain are set in lnd_set_decomp_and_domain_from_surfrd - ! initialize2 and initialize3 perform rest of initialization + ! initialize2 performs the rest of initialization call seq_timemgr_EClockGetData(EClock, & start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & @@ -227,7 +227,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! Finish initializing clm call initialize2(ni,nj) - call initialize3() ! Create land export state call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 index 6b343875c7..1b8edece43 100644 --- a/src/cpl/mct/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -71,7 +71,7 @@ subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) ! Remaining bounds (landunits, columns, patches) will be determined ! after the call to decompInit_glcp - so get_proc_bounds is called ! twice and the gridcell information is just filled in twice - call get_proc_bounds(bounds) + call get_proc_bounds(bounds) ! Get grid cell bounds values begg = bounds%begg @@ -91,24 +91,21 @@ end subroutine lnd_set_decomp_and_domain_from_surfrd !----------------------------------------------------------------------- subroutine surfrd_get_globmask(filename, mask, ni, nj) - ! - ! !DESCRIPTION: - ! Read the surface dataset grid related information: - ! This is the first routine called by clm_initialize - ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET - ! - ! !USES: + + ! Read the surface dataset grid related information + ! This is used to set the domain decomposition - so global data is read here + use fileutils , only : getfil use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t use abortutils , only : endrun use shr_log_mod, only : errMsg => shr_log_errMsg - ! - ! !ARGUMENTS: + + ! input/output variables character(len=*), intent(in) :: filename ! grid filename integer , pointer :: mask(:) ! grid mask integer , intent(out) :: ni, nj ! global grid sizes - ! - ! !LOCAL VARIABLES: + + ! local variables logical :: isgrid2d integer :: dimid,varid ! netCDF id's integer :: ns ! size of grid on file @@ -178,30 +175,30 @@ end subroutine surfrd_get_globmask !----------------------------------------------------------------------- subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) - ! - ! !DESCRIPTION: - ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED + ! Read the surface dataset grid related information: - ! o real latitude of grid cell (degrees) - ! o real longitude of grid cell (degrees) - ! - ! !USES: - use clm_varcon , only : spval, re, grlnd - use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d - use fileutils , only : getfil - use abortutils , only : endrun - use shr_log_mod, only : errMsg => shr_log_errMsg - use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile - use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen + ! This is called after the domain decomposition has been created + ! - real latitude of grid cell (degrees) + ! - real longitude of grid cell (degrees) + + use clm_varcon , only : spval, re, grlnd + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use fileutils , only : getfil + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen + use clm_varctl , only : single_column, scmlat, scmlon + use shr_scam_mod , only : shr_scam_getCloseLatLon use pio - ! - ! !ARGUMENTS: + + ! input/output variables integer , intent(in) :: begg, endg type(domain_type) , intent(inout) :: ldomain ! domain to init character(len=*) , intent(in) :: filename ! grid filename character(len=*) ,optional , intent(in) :: glcfilename ! glc mask filename - ! - ! !LOCAL VARIABLES: + + ! local variables type(file_desc_t) :: ncid ! netcdf id integer :: beg ! local beg index integer :: end ! local end index @@ -216,6 +213,10 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) character(len=16) :: vname ! temporary character(len=256) :: locfn ! local file name integer :: n ! indices + integer :: closelatidx + integer :: closelonidx + real(r8) :: closelat + real(r8) :: closelon character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name !----------------------------------------------------------------------- @@ -292,6 +293,11 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) end if + if (single_column) then + call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & + closelat, closelon, closelatidx, closelonidx) + end if + call ncd_pio_closefile(ncid) end subroutine surfrd_get_grid diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 461e99205e..b6bec64684 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -29,7 +29,7 @@ module lnd_comp_nuopc use clm_time_manager , only : set_nextsw_cday, update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday - use clm_initializeMod , only : initialize1, initialize2, initialize3 + use clm_initializeMod , only : initialize1, initialize2 use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance use lnd_import_export , only : advertise_fields, realize_fields, import_fields, export_fields @@ -561,9 +561,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! if ( noland ) then ! call shr_sys_abort(trim(subname)//"ERROR: Currently cannot handle case of single column with non-land") ! end if - call initialize2(ni, nj) - call initialize3() !-------------------------------- ! Create land export state diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 622e3acca9..508e51ce9d 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -1,30 +1,27 @@ module lnd_import_export - use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet - use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : operator(/=), operator(==) - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use clm_varctl , only : iulog - use clm_time_manager , only : get_nstep - use decompmod , only : bounds_type, get_proc_bounds - use lnd2atmType , only : lnd2atm_type - use lnd2glcMod , only : lnd2glc_type - use atm2lndType , only : atm2lnd_type - use glc2lndMod , only : glc2lnd_type - use domainMod , only : ldomain - use spmdMod , only : masterproc - use seq_drydep_mod , only : seq_drydep_readnl, n_drydep - use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n - use shr_fire_emis_mod , only : shr_fire_emis_readnl - use shr_carma_mod , only : shr_carma_readnl - use shr_ndep_mod , only : shr_ndep_readnl - use nuopc_shr_methods , only : chkerr - use lnd_import_export_utils, only : derive_quantities, check_for_errors, check_for_nans + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet + use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use ESMF , only : operator(/=), operator(==) + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use decompmod , only : bounds_type, get_proc_bounds + use lnd2atmType , only : lnd2atm_type + use lnd2glcMod , only : lnd2glc_type + use atm2lndType , only : atm2lnd_type + use glc2lndMod , only : glc2lnd_type + use domainMod , only : ldomain + use spmdMod , only : masterproc + use seq_drydep_mod , only : seq_drydep_readnl, n_drydep + use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n + use nuopc_shr_methods , only : chkerr + use lnd_import_export_utils , only : check_for_errors, check_for_nans implicit none private ! except @@ -150,7 +147,10 @@ module lnd_import_export subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) - use clm_varctl, only : ndep_from_cpl + use shr_carma_mod , only : shr_carma_readnl + use shr_ndep_mod , only : shr_ndep_readnl + use shr_fire_emis_mod , only : shr_fire_emis_readnl + use clm_varctl , only : ndep_from_cpl ! input/output variables type(ESMF_GridComp) :: gcomp @@ -183,9 +183,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r else send_to_atm = .false. end if - !DEBUG: - send_to_atm = .true. - !DEBUG call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -437,11 +434,12 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Convert the input data from the mediator to the land model !--------------------------------------------------------------------------- - use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl - use clm_varcon , only: rair, o2_molar_const, c13ratio - use shr_const_mod , only: SHR_CONST_TKFRZ - use Wateratm2lndBulkType , only: wateratm2lndbulk_type - use QSatMod , only: QSat + use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use Wateratm2lndBulkType , only: wateratm2lndbulk_type + use QSatMod , only: QSat + use lnd_import_export_utils , only: derive_quantities, check_for_errors ! input/output variabes type(ESMF_GridComp) :: gcomp diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 86aae3f5a0..f2e07696f9 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -31,13 +31,12 @@ module clm_initializeMod use SelfTestDriver , only : self_test_driver use SoilMoistureStreamMod , only : PrescribedSoilMoistureInit use clm_instMod - ! + ! implicit none private ! By default everything is private ! public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initialization - public :: initialize3 ! Phase two initialization integer :: actual_numcft ! numcft from sfc dataset @@ -110,31 +109,84 @@ subroutine initialize2(ni,nj) ! ! !DESCRIPTION: ! CLM initialization second phase - ! Determine clm gridcell decomposition and processor bounds for gridcells ! ! !USES: - use clm_varpar , only: natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec - use landunit_varcon , only: landunit_varcon_init, max_lunit - use clm_varctl , only: fsurdat - use pftconMod , only: pftcon - use decompInitMod , only: decompInit_clumps, decompInit_glcp - use domainMod , only: domain_check, ldomain, domain_init - use surfrdMod , only: surfrd_get_data - use controlMod , only: NLFilename - use initGridCellsMod , only: initGridCells - use ch4varcon , only: ch4conrd - use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + use clm_varcon , only : spval + use clm_varpar , only : natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec + use clm_varpar , only : nlevsno + use clm_varctl , only : fsurdat + use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat + use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_fates + use clm_varctl , only : use_crop, ndep_from_cpl + use clm_varorb , only : eccen, mvelpp, lambm0, obliqr + use landunit_varcon , only : landunit_varcon_init, max_lunit + use pftconMod , only : pftcon + use decompInitMod , only : decompInit_clumps, decompInit_glcp + use domainMod , only : domain_check, ldomain, domain_init + use surfrdMod , only : surfrd_get_data + use controlMod , only : NLFilename + use initGridCellsMod , only : initGridCells + use ch4varcon , only : ch4conrd + use UrbanParamsType , only : UrbanInput, IsSimpleBuildTemp + use shr_orb_mod , only : shr_orb_decl + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use accumulMod , only : print_accum_fields + use clm_time_manager , only : get_step_size_real, get_curr_calday + use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep + use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart + use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries + use DaylengthMod , only : InitDaylength + use dynSubgridDriverMod , only : dynSubgrid_init + use dynConsBiogeophysMod , only : dyn_hwcontent_set_baselines + use fileutils , only : getfil + use initInterpMod , only : initInterp + use subgridWeightsMod , only : init_subgrid_weights_mod + use histFileMod , only : hist_htapes_build, htapes_fieldlist, hist_printflds + use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal + use restFileMod , only : restFile_getfile, restFile_open, restFile_close + use restFileMod , only : restFile_read, restFile_write + use ndepStreamMod , only : ndep_init, ndep_interp + use LakeCon , only : LakeConInit + use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg + use SnowSnicarMod , only : SnowAge_init, SnowOptics_init + use lnd2atmMod , only : lnd2atm_minimal + use controlMod , only : NLFilename + use clm_instMod , only : clm_fates + use BalanceCheckMod , only : BalanceCheckInit + use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method ! ! !ARGUMENTS integer, intent(in) :: ni, nj ! global grid sizes ! ! !LOCAL VARIABLES: - integer :: i,j,n,k,c,l,g ! indices - integer :: begg, endg ! processor bounds - type(bounds_type) :: bounds_proc - type(bounds_type) :: bounds_clump - integer :: nclumps ! number of clumps on this processor - integer :: nc ! clump index + integer :: c,g,i,j,k,l,n,p ! indices + integer :: yr ! current year (0, ...) + integer :: mon ! current month (1 -> 12) + integer :: day ! current day (1 -> 31) + integer :: ncsec ! current time of day [seconds] + character(len=256) :: fnamer ! name of netcdf restart file + character(len=256) :: pnamer ! full pathname of netcdf restart file + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + real(r8) :: dtime ! time step increment (sec) + integer :: nstep ! model time step + real(r8) :: calday ! calendar day for nstep + real(r8) :: caldaym1 ! calendar day for nstep-1 + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinm1 ! solar declination angle in radians for nstep-1 + real(r8) :: eccf ! earth orbit eccentricity factor + type(bounds_type) :: bounds_proc ! processor bounds + type(bounds_type) :: bounds_clump ! clump bounds + integer :: nclumps ! number of clumps on this processor + integer :: nc ! clump index + logical :: lexist + logical :: reset_dynbal_baselines_all_columns + logical :: reset_dynbal_baselines_lake_columns + integer :: begg, endg + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays character(len=32) :: subname = 'initialize2' ! subroutine name !----------------------------------------------------------------------- @@ -214,7 +266,6 @@ subroutine initialize2(ni,nj) end do !$OMP END PARALLEL DO - ! Set CH4 Model Parameters from namelist. ! Need to do before initTimeConst so that it knows whether to ! look for several optional parameters on surfdata file. @@ -230,109 +281,17 @@ subroutine initialize2(ni,nj) ! end of the run for error checking. deallocate (wt_lunit, wt_cft, wt_glc_mec, haslake) - call t_stopf('clm_init2') - - end subroutine initialize2 - - !----------------------------------------------------------------------- - subroutine initialize3( ) - ! - ! !DESCRIPTION: - ! CLM initialization - third phase - ! - ! !USES: - use shr_orb_mod , only : shr_orb_decl - use shr_scam_mod , only : shr_scam_getCloseLatLon - use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND - use accumulMod , only : print_accum_fields - use clm_varpar , only : nlevsno - use clm_varcon , only : spval - use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat - use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_fates - use clm_varctl , only : use_crop, ndep_from_cpl - use clm_varorb , only : eccen, mvelpp, lambm0, obliqr - use clm_time_manager , only : get_step_size_real, get_curr_calday - use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep - use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart - use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries - use DaylengthMod , only : InitDaylength - use dynSubgridDriverMod , only : dynSubgrid_init - use dynConsBiogeophysMod , only : dyn_hwcontent_set_baselines - use fileutils , only : getfil - use initInterpMod , only : initInterp - use subgridWeightsMod , only : init_subgrid_weights_mod - use histFileMod , only : hist_htapes_build, htapes_fieldlist, hist_printflds - use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal - use restFileMod , only : restFile_getfile, restFile_open, restFile_close - use restFileMod , only : restFile_read, restFile_write - use ndepStreamMod , only : ndep_init, ndep_interp - use LakeCon , only : LakeConInit - use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg - use SnowSnicarMod , only : SnowAge_init, SnowOptics_init - use lnd2atmMod , only : lnd2atm_minimal - use NutrientCompetitionFactoryMod, only : create_nutrient_competition_method - use controlMod , only : NLFilename - use clm_instMod , only : clm_fates - use BalanceCheckMod , only : BalanceCheckInit - ! - ! !ARGUMENTS - ! - ! !LOCAL VARIABLES: - integer :: c,i,j,k,l,p! indices - integer :: yr ! current year (0, ...) - integer :: mon ! current month (1 -> 12) - integer :: day ! current day (1 -> 31) - integer :: ncsec ! current time of day [seconds] - integer :: nc ! clump index - integer :: nclumps ! number of clumps on this processor - character(len=256) :: fnamer ! name of netcdf restart file - character(len=256) :: pnamer ! full pathname of netcdf restart file - character(len=256) :: locfn ! local file name - type(file_desc_t) :: ncid ! netcdf id - real(r8) :: dtime ! time step increment (sec) - integer :: nstep ! model time step - real(r8) :: calday ! calendar day for nstep - real(r8) :: caldaym1 ! calendar day for nstep-1 - real(r8) :: declin ! solar declination angle in radians for nstep - real(r8) :: declinm1 ! solar declination angle in radians for nstep-1 - real(r8) :: eccf ! earth orbit eccentricity factor - type(bounds_type) :: bounds_proc ! processor bounds - type(bounds_type) :: bounds_clump ! clump bounds - logical :: lexist - integer :: closelatidx,closelonidx - real(r8) :: closelat,closelon - logical :: reset_dynbal_baselines_all_columns - logical :: reset_dynbal_baselines_lake_columns - integer :: begp, endp - integer :: begc, endc - integer :: begl, endl - real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays - character(len=32) :: subname = 'initialize3' - !---------------------------------------------------------------------- - - call t_startf('clm_init3') - - ! ------------------------------------------------------------------------ ! Determine processor bounds and clumps for this processor - ! ------------------------------------------------------------------------ - call get_proc_bounds(bounds_proc) nclumps = get_proc_clumps() - ! ------------------------------------------------------------------------ ! Read in parameters files - ! ------------------------------------------------------------------------ - call clm_instReadNML( NLFilename ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst) - ! ------------------------------------------------------------------------ ! Initialize time manager - ! ------------------------------------------------------------------------ - if (nsrest == nsrStartup) then call timemgr_init() else @@ -343,28 +302,20 @@ subroutine initialize3( ) call timemgr_restart() end if - ! ------------------------------------------------------------------------ ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly) - ! ------------------------------------------------------------------------ - call t_startf('init_orbd') - calday = get_curr_calday() call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) - dtime = get_step_size_real() caldaym1 = get_curr_calday(offset=-int(dtime)) call shr_orb_decl( caldaym1, eccen, mvelpp, lambm0, obliqr, declinm1, eccf ) - call t_stopf('init_orbd') - call InitDaylength(bounds_proc, declin=declin, declinm1=declinm1, obliquity=obliqr) ! Initialize Balance checking (after time-manager) call BalanceCheckInit() ! History file variables - if (use_cn) then call hist_addfld1d (fname='DAYL', units='s', & avgflag='A', long_name='daylength', & @@ -375,13 +326,9 @@ subroutine initialize3( ) ptr_gcell=grc%prev_dayl, default='inactive') end if - ! ------------------------------------------------------------------------ ! Initialize component data structures - ! ------------------------------------------------------------------------ - ! Note: new logic is in place that sets all the history fields to spval so ! there is no guesswork in the initialization to nans of the allocated variables - ! First put in history calls for subgrid data structures - these cannot appear in the ! module for the subgrid data definition due to circular dependencies that are introduced @@ -402,47 +349,41 @@ subroutine initialize3( ) ptr_col=col%zii, default='inactive') ! If single-column determine closest latitude and longitude - - if (single_column) then - call getfil (fsurdat, locfn, 0) - call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & - closelat, closelon, closelatidx, closelonidx) - end if + ! TODO: for mct this should use fatmlnd file - for nuopc should use esmf functionality for nearest neighbor, + ! for lilac not applicable + ! TODO: these values are never used - is scam even working for ctsm? + ! if (single_column) then + ! call getfil (fsurdat, locfn, 0) + ! call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & + ! closelat, closelon, closelatidx, closelonidx) + ! end if ! Initialize instances of all derived types as well as time constant variables call clm_instInit(bounds_proc) - ! Initialize SNICAR optical and aging parameters + ! Initialize SNICAR optical and aging parameters call SnowOptics_init( ) ! SNICAR optical parameters: call SnowAge_init( ) ! SNICAR aging parameters: + ! Print history field info to standard out call hist_printflds() - ! ------------------------------------------------------------------------ ! Initializate dynamic subgrid weights (for prescribed transient Patches, CNDV - ! and/or dynamic landunits); note that these will be overwritten in a - ! restart run - ! ------------------------------------------------------------------------ - + ! and/or dynamic landunits); note that these will be overwritten in a restart run call t_startf('init_dyn_subgrid') call init_subgrid_weights_mod(bounds_proc) call dynSubgrid_init(bounds_proc, glc_behavior, crop_inst) call t_stopf('init_dyn_subgrid') - ! ------------------------------------------------------------------------ ! Initialize baseline water and energy states needed for dynamic subgrid operation - ! ! This will be overwritten by the restart file, but needs to be done for a cold start ! case. - ! ! BACKWARDS_COMPATIBILITY(wjs, 2019-03-05) dyn_hwcontent_set_baselines is called again ! later in initialization if reset_dynbal_baselines is set. I think we could just have ! a single call in that location (adding some logic to also do the call if we're doing ! a cold start) once we can assume that all finidat files have the necessary restart ! fields on them. But for now, having the extra call here handles the case where the ! relevant restart fields are missing from an old finidat file. - ! ------------------------------------------------------------------------ - !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) @@ -459,10 +400,7 @@ subroutine initialize3( ) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ ! Initialize modules (after time-manager initialization in most cases) - ! ------------------------------------------------------------------------ - if (use_cn) then call bgc_vegetation_inst%Init2(bounds_proc, NLFilename) @@ -482,31 +420,22 @@ subroutine initialize3( ) else call SatellitePhenologyInit(bounds_proc) end if - if (use_soil_moisture_streams) then + if (use_soil_moisture_streams) then call PrescribedSoilMoistureInit(bounds_proc) endif - ! ------------------------------------------------------------------------ ! On restart only - process the history namelist. - ! ------------------------------------------------------------------------ - ! Later the namelist from the restart file will be used. This allows basic ! checking to make sure you didn't try to change the history namelist on restart. - if (nsrest == nsrContinue ) then call htapes_fieldlist() end if - ! ------------------------------------------------------------------------ ! Read restart/initial info - ! ------------------------------------------------------------------------ - is_cold_start = .false. is_interpolated_start = .false. reset_dynbal_baselines_lake_columns = .false. - if (nsrest == nsrStartup) then - if (finidat == ' ') then if (finidat_interp_source == ' ') then is_cold_start = .true. @@ -527,9 +456,7 @@ subroutine initialize3( ) call restFile_read(bounds_proc, fnamer, glc_behavior, & reset_dynbal_baselines_lake_columns = reset_dynbal_baselines_lake_columns) end if - else if ((nsrest == nsrContinue) .or. (nsrest == nsrBranch)) then - if (masterproc) then write(iulog,*)'Reading restart file ',trim(fnamer) end if @@ -537,12 +464,8 @@ subroutine initialize3( ) reset_dynbal_baselines_lake_columns = reset_dynbal_baselines_lake_columns) end if - ! ------------------------------------------------------------------------ ! If appropriate, create interpolated initial conditions - ! ------------------------------------------------------------------------ - if (nsrest == nsrStartup .and. finidat_interp_source /= ' ') then - is_interpolated_start = .true. ! Check that finidat is not cold start - abort if it is @@ -566,16 +489,11 @@ subroutine initialize3( ) ! Reset finidat to now be finidat_interp_dest ! (to be compatible with routines still using finidat) finidat = trim(finidat_interp_dest) - end if - ! ------------------------------------------------------------------------ ! If requested, reset dynbal baselines - ! ! This needs to happen after reading the restart file (including after reading the ! interpolated restart file, if applicable). - ! ------------------------------------------------------------------------ - reset_dynbal_baselines_all_columns = get_reset_dynbal_baselines() if (nsrest == nsrBranch) then if (reset_dynbal_baselines_all_columns) then @@ -620,10 +538,7 @@ subroutine initialize3( ) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ ! Initialize nitrogen deposition - ! ------------------------------------------------------------------------ - if (use_cn) then call t_startf('init_ndep') if (.not. ndep_from_cpl) then @@ -633,45 +548,31 @@ subroutine initialize3( ) call t_stopf('init_ndep') end if - ! ------------------------------------------------------------------------ ! Initialize active history fields. - ! ------------------------------------------------------------------------ - ! This is only done if not a restart run. If a restart run, then this ! information has already been obtained from the restart data read above. ! Note that routine hist_htapes_build needs time manager information, ! so this call must be made after the restart information has been read. - if (nsrest /= nsrContinue) then call hist_htapes_build() end if - ! ------------------------------------------------------------------------ ! Initialize variables that are associated with accumulated fields. - ! ------------------------------------------------------------------------ - ! The following is called for both initial and restart runs and must ! must be called after the restart file is read - call atm2lnd_inst%initAccVars(bounds_proc) call temperature_inst%initAccVars(bounds_proc) call water_inst%initAccVars(bounds_proc) call energyflux_inst%initAccVars(bounds_proc) call canopystate_inst%initAccVars(bounds_proc) - call bgc_vegetation_inst%initAccVars(bounds_proc) - if (use_crop) then call crop_inst%initAccVars(bounds_proc) end if - !------------------------------------------------------------ ! Read monthly vegetation - !------------------------------------------------------------ - ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation ! to get estimates of monthly LAI - if ( n_drydep > 0 .and. drydep_method == DD_XLND )then call readAnnualVegetation(bounds_proc, canopystate_inst) if (nsrest == nsrStartup .and. finidat /= ' ') then @@ -681,10 +582,7 @@ subroutine initialize3( ) end if end if - !------------------------------------------------------------ ! Determine gridcell averaged properties to send to atm - !------------------------------------------------------------ - if (nsrest == nsrStartup) then call t_startf('init_map2gc') call lnd2atm_minimal(bounds_proc, & @@ -692,10 +590,7 @@ subroutine initialize3( ) call t_stopf('init_map2gc') end if - !------------------------------------------------------------ ! Initialize sno export state to send to glc - !------------------------------------------------------------ - !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) @@ -709,19 +604,12 @@ subroutine initialize3( ) end do !$OMP END PARALLEL DO - !------------------------------------------------------------ ! Deallocate wt_nat_patch - !------------------------------------------------------------ - ! wt_nat_patch was allocated in initialize1, but needed to be kept around through ! initialize2 for some consistency checking; now it can be deallocated - deallocate(wt_nat_patch) - ! -------------------------------------------------------------- ! Initialise the fates model state structure - ! -------------------------------------------------------------- - if ( use_fates .and. .not.is_restart() .and. finidat == ' ') then call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & @@ -729,15 +617,10 @@ subroutine initialize3( ) end if ! topo_glc_mec was allocated in initialize1, but needed to be kept around through - ! initialize2 because it is used to initialize other variables; now it can be - ! deallocated - + ! initialize2 because it is used to initialize other variables; now it can be deallocated deallocate(topo_glc_mec, fert_cft, irrig_method) - !------------------------------------------------------------ ! Write log output for end of initialization - !------------------------------------------------------------ - call t_startf('init_wlog') if (masterproc) then write(iulog,*) 'Successfully initialized the land model' @@ -764,8 +647,8 @@ subroutine initialize3( ) !$OMP END PARALLEL DO end if - call t_stopf('clm_init3') + call t_stopf('clm_init2') - end subroutine initialize3 + end subroutine initialize2 end module clm_initializeMod From 52681285c688659f2c3191406a5fea01de3ac372 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 27 Dec 2020 18:25:29 -0700 Subject: [PATCH 055/219] refactored nuopc cap some more --- src/cpl/nuopc/lnd_import_export.F90 | 3 + src/cpl/nuopc/lnd_set_decomp_and_domain.F90 | 206 +++++++++++--------- 2 files changed, 115 insertions(+), 94 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 508e51ce9d..a63ba87eac 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -183,6 +183,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r else send_to_atm = .false. end if + !DEBUG + send_to_atm = .true. + !DEBUG call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 index ca91bf4ce5..7e2f800089 100644 --- a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 @@ -25,7 +25,7 @@ module lnd_set_decomp_and_domain contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) + subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh_ctsm, ni, nj, rc) use NUOPC , only : NUOPC_CompAttributeGet use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D @@ -38,26 +38,27 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(out) :: mesh + type(ESMF_Mesh) , intent(out) :: mesh_ctsm integer , intent(out) :: ni,nj ! global grid dimensions integer , intent(out) :: rc ! local variables type(ESMF_VM) :: vm - type(ESMF_Mesh) :: mesh_lnd - type(ESMF_Mesh) :: mesh_ocn - type(ESMF_DistGrid) :: distgrid_mesh - type(ESMF_DistGrid) :: distgrid_lnd - character(CL) :: cvalue ! config data - integer :: nlnd, nocn ! local size of arrays - integer :: g,n ! indices - type(bounds_type) :: bounds ! bounds + type(ESMF_Mesh) :: mesh_ocninput + type(ESMF_Mesh) :: mesh_lndinput + type(ESMF_DistGrid) :: distgrid_lndinput + type(ESMF_DistGrid) :: distgrid_ctsm + character(CL) :: cvalue ! config data + integer :: nlnd, nocn ! local size of arrays + integer :: g,n ! indices + type(bounds_type) :: bounds ! bounds integer :: begg,endg character(CL) :: meshfile_ocn - integer , pointer :: gindex_lnd(:) ! global index space for just land points - integer , pointer :: gindex_ocn(:) ! global index space for just ocean points - integer , pointer :: gindex(:) ! global index space for land and ocean points - integer , pointer :: mask(:) ! local land/ocean mask + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points + integer , pointer :: gindex_input(:) ! global index space for land and ocean points + integer , pointer :: mask(:) ! local land/ocean mask integer , pointer :: lndmask_loc(:) real(r8) , pointer :: lndfrac_loc(:) integer , pointer :: lndmask_glob(:) @@ -66,9 +67,11 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) real(r8) , pointer :: lndlons_glob(:) real(r8) , pointer :: rtemp_glob(:) integer , pointer :: itemp_glob(:) + integer :: numownedelements real(r8) , pointer :: ownedElemCoords(:) real(r8) , pointer :: dataptr1d(:) - integer :: lsize, gsize + integer :: lsize_input + integer :: gsize logical :: isgrid2d integer :: spatialDim type(ESMF_Field) :: areaField @@ -87,7 +90,7 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nj - gsize = ni*nj + gsize = ni*nj if (single_column) then isgrid2d = .true. else if (nj == 1) then @@ -105,7 +108,7 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) end if ! read in the land mesh from the file - mesh_lnd = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + mesh_lndinput = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then write(iulog,'(a)')'land mesh file ',trim(model_meshfile) @@ -114,31 +117,34 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) ! read in ocn mask meshfile call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh_ocn = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) end if ! set local land fraction and land mask for input read decomposition - ! Note that lndmask_loc and lndfrac_loc are allocated in the following calls and lsize is returned + ! Note that lndmask_loc and lndfrac_loc are + ! - allocated in the following calls and lsize is returned + ! - on the input decomposition (gindex_input) + ! - lsize references to the local size of the input decomposition if (trim(meshfile_ocn) == 'null') then ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + call clm_getlandmask_from_lndmesh(mesh_lndinput, lsize_input, lndmask_loc, lndfrac_loc, distgrid_lndinput, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + call clm_getlandmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, lsize_input, lndmask_loc, lndfrac_loc, distgrid_lndinput, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! determine global landmask_glob - needed to determine the ctsm decomposition ! land frac, lats, lons and areas will be done below - allocate(gindex(lsize)) - call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex, rc=rc) + allocate(gindex_input(lsize_input)) + call ESMF_DistGridGet(distgrid_lndinput, 0, seqIndexList=gindex_input, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 - do n = 1,lsize - lndmask_glob(gindex(n)) = lndmask_loc(n) + do n = 1,lsize_input + lndmask_glob(gindex_input(n)) = lndmask_loc(n) end do allocate(itemp_glob(gsize)) call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) @@ -162,7 +168,7 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) begg = bounds%begg endg = bounds%endg - ! Create gindex_lnd + ! Create ctsm gindex_lnd nlnd = endg - begg + 1 allocate(gindex_lnd(nlnd)) do g = begg, endg @@ -173,92 +179,64 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) ! Initialize domain data structure call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - ! Determine ldomain%mask + ! Determine ldomain%mask using ctsm decomposition do g = begg, endg n = 1 + (g - begg) ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) end do deallocate(lndmask_glob) - ! Determine ldomain%frac + ! Determine ldomain%frac using both input and ctsm decompositions + ! lndfrac_glob is filled using the input decomposition and + ! ldomin%frac is set using the ctsm decomposition allocate(rtemp_glob(gsize)) allocate(lndfrac_glob(gsize)) lndfrac_glob(:) = 0._r8 - do n = 1,lsize - lndfrac_glob(gindex(n)) = lndfrac_loc(n) + do n = 1,lsize_input + lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) end do - call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) lndfrac_glob(:) = rtemp_glob(:) do g = begg, endg ldomain%frac(g) = lndfrac_glob(gindex_lnd(g-begg+1)) end do deallocate(lndfrac_glob) - ! Get ownedElemCords from the mesh to be used to obtain ldoman%latc and ldomain%lonc - call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) - allocate(ownedElemCoords(spatialDim*lsize)) - call ESMF_MeshGet(mesh_lnd, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ldomain%latc and global lat1d - allocate(lndlats_glob(gsize)) - lndlats_glob(:) = 0._r8 - do n = 1,lsize - lndlats_glob(gindex(n)) = ownedElemCoords(2*n) - end do - call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndlats_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%latc(g) = lndlats_glob(gindex_lnd(g-begg+1)) - end do - if (isgrid2d) then - allocate(lat1d(nj)) - do n = 1,nj - lat1d(n) = lndlats_glob((n-1)*ni + 1) - end do - end if - deallocate(lndlats_glob) - - ! Determine ldomain%lonc and global lon1d - allocate(lndlons_glob(gsize)) - lndlons_glob(:) = 0._r8 - do n = 1,lsize - lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) - end do - call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndlons_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%lonc(g) = lndlons_glob(gindex_lnd(g-begg+1)) - end do - if (isgrid2d) then - allocate(lon1d(ni)) - do n = 1,ni - lon1d(n) = lndlons_glob(n) - end do - end if - deallocate(lndlons_glob) - deallocate(rtemp_glob) - - ! Create a global index that includes both land and ocean points + ! Generate a ctsm global index that includes both land and ocean points nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) + allocate(gindex_ctsm(nlnd + nocn)) do n = 1,nlnd+nocn if (n <= nlnd) then - gindex(n) = gindex_lnd(n) + gindex_ctsm(n) = gindex_lnd(n) else - gindex(n) = gindex_ocn(n-nlnd) + gindex_ctsm(n) = gindex_ocn(n-nlnd) end if end do ! Generate a new mesh on the gindex decomposition - distGrid_mesh = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gindex) - mesh = ESMF_MeshCreate(mesh_lnd, elementDistGrid=distgrid_mesh, rc=rc) + mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh_ctsm, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg,endg + n = g - begg + 1 + ldomain%lonc(g) = ownedElemCoords(2*n-1) + if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? + ldomain%latc(g) = ownedElemCoords(2*n) + end do + ! Create ldomain%area by querying the mesh on the ctsm decomposition - areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + areaField = ESMF_FieldCreate(mesh_ctsm, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridGetArea(areaField, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -269,11 +247,49 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) end do call ESMF_FieldDestroy(areaField) + ! If grid is 2d, determine lon1d and lat1d + if (isgrid2d) then + ! Determine lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,numownedelements + if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? + lndlons_glob(gindex_ctsm(n)) = 0._r8 + else + lndlons_glob(gindex_ctsm(n)) = ownedElemCoords(2*n-1) + end if + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlons_glob) + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = rtemp_glob(n) + end do + + ! Determine lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,numownedelements + lndlats_glob(gindex_ctsm(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlats_glob) + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = rtemp_glob((n-1)*ni + 1) + end do + end if + + deallocate(gindex_ctsm) + deallocate(rtemp_glob) + end subroutine lnd_set_decomp_and_domain_from_meshinfo !=============================================================================== subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) + ! Generate a new mesh from the global 2d sizes and set the mask to 1 + use NUOPC , only : NUOPC_CompAttributeGet use clm_varctl , only : single_column use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror @@ -299,6 +315,8 @@ subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) character(len=CL) :: cvalue integer :: gsize logical :: isgrid2d + integer :: numownedelements + integer, allocatable :: mask(:) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -310,7 +328,7 @@ subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nj - gsize = ni*nj + gsize = ni*nj if (single_column) then isgrid2d = .true. else if (nj == 1) then @@ -378,14 +396,14 @@ subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) mesh = ESMF_MeshCreate(lgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: initialize the decomposition - ! initialize ldomain - ! initialize the mask and mesh - ! for created meshes assume the mask is 1 - ! create a pointer for mask and set it to 1 - ! call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! deallocate(mask) + ! Set the mesh mask to 1 + call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(mask(numownedelements)) + mask(:) = 1 + call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(mask) end subroutine lnd_set_decomp_and_domain_from_newmesh @@ -441,7 +459,7 @@ subroutine clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize_lnd, lndmask_l srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + ! fill in values for field_ocn with mask on ocn mesh call ESMF_MeshGet(mesh_ocn, elementdistGrid=distgrid_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 04670adf533555ff247a0ca7468ba36ca9489185 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 Dec 2020 13:22:59 -0700 Subject: [PATCH 056/219] unification of lilac and nuopc code for lnd_set_decomp_and_domain.F90 --- src/cpl/lilac/lnd_comp_esmf.F90 | 5 +- src/cpl/lilac/lnd_set_decomp_and_domain.F90 | 717 +++++++++++++++----- src/cpl/nuopc/lnd_comp_nuopc.F90 | 21 +- src/cpl/nuopc/lnd_set_decomp_and_domain.F90 | 651 +++++++++++------- 4 files changed, 953 insertions(+), 441 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index a0e1cdec22..d038170baf 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -339,7 +339,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- ! Initialize decomposition (ldecomp) and domain (ldomain) types and generate land mesh !---------------------- - call lnd_set_decomp_and_domain_from_meshinfo(lnd_mesh_filename, lnd_mesh, ni, nj, rc) + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lnd_set_decomp_and_domain_from_meshinfo(mode='lilac', vm=vm, & + meshfile_lnd=lnd_mesh_filename, meshfile_ocn='null', mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !-------------------------------- diff --git a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 index 315f5a835c..f3be6085e9 100644 --- a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/lilac/lnd_set_decomp_and_domain.F90 @@ -4,187 +4,123 @@ module lnd_set_decomp_and_domain use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use spmdMod , only : masterproc use clm_varctl , only : iulog - use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none private ! except ! Module public routines - public :: lnd_set_decomp_and_domain_from_meshinfo + public :: lnd_set_decomp_and_domain_from_readmesh + public :: lnd_set_decomp_and_domain_from_newmesh ! Module private routines - private :: chkerr + private :: lnd_get_global_dims + private :: lnd_get_lndmask_from_ocnmesh + private :: lnd_get_lndmask_from_lndmesh + private :: lnd_set_ldomain_gridinfo + private :: nc_check_err + private :: chkerr character(len=*) , parameter :: u_FILE_u = & __FILE__ + character(len=*), parameter, private :: sourcefile = & __FILE__ - + !=============================================================================== contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni, nj, rc) + subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D - use domainMod , only : ldomain, domain_init, lon1d, lat1d + use domainMod , only : ldomain, domain_init use decompMod , only : ldecomp, bounds_type, get_proc_bounds use clm_varpar , only : nlevsoi - use clm_varctl , only : fatmlndfrc, fsurdat, use_soil_moisture_streams, single_column - use clm_varcon , only : re + use clm_varctl , only : fatmlndfrc, fsurdat + use clm_varctl , only : use_soil_moisture_streams, single_column + ! use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg use fileutils , only : getfil ! input/output variables - character(len=*) , intent(in) :: model_meshfile + character(len=*) , intent(in) :: mode ! lilac or nuopc mode + type(ESMF_VM) , intent(in) :: vm + character(len=*) , intent(in) :: meshfile_lnd + character(len=*) , intent(in) :: meshfile_ocn type(ESMF_Mesh) , intent(out) :: mesh_ctsm - integer , intent(out) :: ni,nj ! global sizes of dimensions + integer , intent(out) :: ni,nj ! global grid dimensions integer , intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - type(ESMF_Mesh) :: mesh_input + type(ESMF_Mesh) :: mesh_ocninput + type(ESMF_Mesh) :: mesh_lndinput type(ESMF_DistGrid) :: distgrid_ctsm - type(ESMF_DistGrid) :: distgrid_input - character(CL) :: cvalue ! config data - integer :: nlnd, nocn ! local size ofarrays - integer :: g,n ! indices - type(bounds_type) :: bounds ! bounds + character(CL) :: cvalue ! config data + integer :: nlnd, nocn ! local size of arrays + integer :: g,n ! indices + type(bounds_type) :: bounds ! bounds integer :: begg,endg - integer , pointer :: gindex_lnd(:) ! global index space for just land points - integer , pointer :: gindex_ocn(:) ! global index space for just ocean points - integer , pointer :: gindex(:) ! global index space for land and ocean points - integer , pointer :: gindex_temp(:) ! temporary global index space - integer , pointer :: mask(:) ! local land/ocean mask - integer , pointer :: lndmask_loc(:) - real(r8) , pointer :: lndfrac_loc(:) + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points + integer , pointer :: gindex_input(:) ! global index space for land and ocean points integer , pointer :: lndmask_glob(:) real(r8) , pointer :: lndfrac_glob(:) - real(r8) , pointer :: lndlats_glob(:) - real(r8) , pointer :: lndlons_glob(:) - real(r8) , pointer :: rtemp_glob(:) - integer , pointer :: itemp_glob(:) - real(r8) , pointer :: dataptr1d(:) - integer :: lsize,gsize + integer :: lsize_input + integer :: gsize logical :: isgrid2d - integer :: numownedelements - real(R8) , pointer :: ownedElemCoords(:) - integer :: spatialDim - type(ESMF_Field) :: areaField - type(ESMF_Array) :: elemMaskArray character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - logical :: readvar ! read variable in or not + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Get current vm - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine global 2d sizes from read of dimensions of surface dataset - if (masterproc) then - write(iulog,*) 'Attempting to global dimensions from surface dataset' - if (fsurdat == ' ') then - write(iulog,*)'fsurdat must be specified' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - endif - call getfil(fsurdat, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') - call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') - call ncd_pio_closefile(ncid) - gsize = ni*nj - if (single_column) then - isgrid2d = .true. - else if (nj == 1) then - isgrid2d = .false. - else - isgrid2d = .true. - end if - if (masterproc) then - write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj - if (isgrid2d) then - write(iulog,'(a)') 'model grid is 2-dimensional' - else - write(iulog,'(a)') 'model grid is not 2-dimensional' - end if - end if + call lnd_get_global_dims(ni, nj, gsize, isgrid2d) + + ! Allocate global memory for land mask and land fraction + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + allocate(lndfrac_glob(gsize)); lndfrac_glob(:) = 0._r8 ! read in the land mesh from the file - mesh_input = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then - write(iulog,'(a)')'land mesh file ',trim(model_meshfile) - end if - - ! Obtain global land amsk - if (trim(fatmlndfrc) /= 'null') then - if (masterproc) then - write(iulog,*) 'Generating ctsm decomposition from ',trim(fatmlndfrc) - endif - else - if (masterproc) then - write(iulog,*) 'Generating ctsm decomposition from ',trim(model_meshfile) - endif + write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) end if - allocate(lndmask_glob(ni*nj)); lndmask_glob(:) = 0 - allocate(rtemp_glob(gsize)) - - if (trim(fatmlndfrc) /= 'null') then - - ! Read in global land mask and land fraction from fatmlndfrc - call getfil( trim(fatmlndfrc), locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 - call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - call ncd_pio_closefile(ncid) - - else - - ! Obtain land mask from land mesh file - ASSUME THAT LAND FRAC IS IDENTICAL TO LAND MASK - call ESMF_MeshGet(mesh_input, elementdistGrid=distgrid_input, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_input, localDe=0, elementCount=lsize, rc=rc) + ! Set global land fraction and global land mask across all processors + if (trim(meshfile_ocn) /= 'null') then + ! read in ocn mask meshfile + mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + end if - ! Determine lndmask_loc - allocate(lndmask_loc(lsize)) - elemMaskArray = ESMF_ArrayCreate(distgrid_input, lndmask_loc, rc=rc) + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! The following calls fills in the values of lndmask_loc - call ESMF_MeshGet(mesh_input, elemMaskArray=elemMaskArray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine lndfrac_loc - ! ASSUME that land fraction is identical to land mask in this case - allocate(lndfrac_loc(lsize)) - lndfrac_loc(:) = lndmask_loc(:) - - ! determine global landmask_glob - needed to determine the ctsm decomposition - ! land frac, lats, lons and areas will be done below - allocate(gindex_temp(lsize)) - call ESMF_DistGridGet(distgrid_input, 0, seqIndexList=gindex_temp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 - do n = 1,lsize - lndmask_glob(gindex(n)) = lndmask_loc(n) - end do - allocate(itemp_glob(gsize)) - call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndmask_glob(:) = int(itemp_glob(:)) - deallocate(itemp_glob) - + else + if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then + ! Read in global land mask and land fraction from fatmlndfrc + call getfil( trim(fatmlndfrc), locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 + call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + call ncd_pio_closefile(ncid) + else + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call lnd_get_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if ! Determine lnd decomposition that will be used by ctsm @@ -193,14 +129,19 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) end if - ! *** Get JUST gridcell processor bounds *** + ! Determine ocn decomposition that will be used to create the full mesh + ! note that the memory for gindex_ocn will be allocated in the following call + ! but deallocated at the end of this routine + call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) + + ! Get JUST gridcell processor bounds ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp ! so get_proc_bounds is called twice and the gridcell information is just filled in twice call get_proc_bounds(bounds) begg = bounds%begg endg = bounds%endg - ! Create gindex_lnd + ! Create ctsm gindex_lnd nlnd = endg - begg + 1 allocate(gindex_lnd(nlnd)) do g = begg, endg @@ -208,68 +149,462 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni gindex_lnd(n) = ldecomp%gdc2glo(g) end do - ! Create gindex_ocn - ! Need this decomposition to create the full mesh - ! Note that the memory for gindex_ocn will be allocated in the following call - call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask and ldomain%frac using ctsm decomposition + do g = begg, endg + n = 1 + (g - begg) + ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) + ldomain%frac(g) = lndfrac_glob(gindex_lnd(n)) + end do + deallocate(lndmask_glob) + deallocate(lndfrac_glob) - ! Create a global index that includes both land and ocean points + ! Generate a ctsm global index that includes both land and ocean points nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) + allocate(gindex_ctsm(nlnd + nocn)) do n = 1,nlnd+nocn if (n <= nlnd) then - gindex(n) = gindex_lnd(n) + gindex_ctsm(n) = gindex_lnd(n) else - gindex(n) = gindex_ocn(n-nlnd) + gindex_ctsm(n) = gindex_ocn(n-nlnd) end if end do - ! Generate a new distgrid based on gindex - distgrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + ! Generate a new mesh on the gindex decomposition + distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get ldomain%lonc, ldomain%latc and ldomain%area and optionally + ! lon1d and lat1d if isgrid2d + call lnd_set_ldomain_gridinfo(mesh_ctsm, vm, gindex_ctsm, bounds, isgrid2d, ni, nj, ldomain, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Deallocate memory + deallocate(gindex_lnd) + deallocate(gindex_ocn) + deallocate(gindex_ctsm) + + end subroutine lnd_set_decomp_and_domain_from_readmesh + + !=============================================================================== + subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) + + ! Generate a new mesh from the input domain file and set the mask to 1 + + use decompInitMod , only : decompInit_lnd, decompInit_lnd3D + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use domainMod , only : ldomain, domain_init + use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varpar , only : nlevsoi + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror + use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var + use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable + + ! input/output variables + character(len=CL) , intent(in) :: domain_file + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc + + ! local variables + logical :: isgrid2d + integer :: g,n + integer :: nv + integer :: ncid, ierr + integer :: dimid_ni, dimid_nj, dimid_nv + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + type(ESMF_Grid) :: lgrid + real(r8), allocatable :: xv(:,:,:), yv(:,:,:) + integer :: varid_xv, varid_yv + integer :: numownedelements + integer, allocatable :: lnd_mask(:) + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + integer :: nlnd + integer, pointer :: gindex_lnd(:) ! global index space for just land points + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! open file + ierr = nf90_open(domain_file, NF90_NOWRITE, ncid) + call nc_check_err(ierr, 'nf90_open', trim(domain_file)) + ! get dimension ids + ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) + call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(domain_file)) + ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) + call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(domain_file)) + ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) + call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(domain_file)) + ! get dimension values + ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) + call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(domain_file)) + ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) + call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(domain_file)) + ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) + call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(domain_file)) + ! get variable ids + ierr = nf90_inq_varid(ncid, 'xv', varid_xv) + call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(domain_file)) + ierr = nf90_inq_varid(ncid, 'yv', varid_yv) + call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(domain_file)) + ! allocate memory for variables and get variable values + allocate(xv(nv,ni,nj), yv(nv,ni,nj)) + ierr = nf90_get_var(ncid, varid_xv, xv) + call nc_check_err(ierr, 'nf90_get_var for xv', trim(domain_file)) + ierr = nf90_get_var(ncid, varid_yv, yv) + call nc_check_err(ierr, 'nf90_get_var for yv', trim(domain_file)) + ! close file + ierr = nf90_close(ncid) + call nc_check_err(ierr, 'nf90_close', trim(domain_file)) + ! create the grid + maxIndex(1) = ni ! number of lons + maxIndex(2) = nj ! number of lats + mincornerCoord(1) = xv(1,1,1) ! min lon + mincornerCoord(2) = yv(1,1,1) ! min lat + maxcornerCoord(1) = xv(3,ni,nj) ! max lon + maxcornerCoord(2) = yv(3,ni,nj) ! max lat + deallocate(xv,yv) + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the grid + mesh = ESMF_MeshCreate(lgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Generate the ctsm mesh on the gindex decomposition - mesh_ctsm = ESMF_MeshCreate(mesh_input, elementDistGrid=distgrid_ctsm, rc=rc) + ! Set the mesh mask to 1 + call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lnd_mask(numownedelements)) + lnd_mask(:) = 1 + call ESMF_MeshSet(mesh, elementMask=lnd_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine ldecomp and ldomain + call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Initialize processor bounds + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create ctsm gindex_lnd + nlnd = endg - begg + 1 + allocate(gindex_lnd(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + ! Initialize domain data structure + isgrid2d = .true. call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - ! Determine ldomain%mask + ! Determine ldomain%mask and ldomain%frac do g = begg, endg - n = gindex(g-begg+1) - ldomain%mask(g) = lndmask_glob(n) + ldomain%mask(g) = 1 + ldomain%frac(g) = 1._r8 end do - deallocate(lndmask_glob) + deallocate(lnd_mask) - ! Determine ldomain%frac - ! note that lndfrac_glob was read in from fatmlndfrc above if it was not set to null - if (trim(fatmlndfrc) == 'null') then - allocate(lndfrac_glob(gsize)) - do n = 1,nlnd - lndfrac_glob(gindex_lnd(n)) = lndfrac_loc(n) - end do - call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - do g = begg, endg - n = gindex(g-begg+1) - ldomain%frac(g) = rtemp_glob(n) - end do - deallocate(lndfrac_glob) + end subroutine lnd_set_decomp_and_domain_from_newmesh + + !=============================================================================== + subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) + + ! Determine global 2d sizes from read of dimensions of surface dataset + + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + + ! input/output variables + integer, intent(out) :: ni + integer, intent(out) :: nj + integer, intent(out) :: gsize + logical, intent(out) :: isgrid2d + + ! local variables + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not + !------------------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to global dimensions from surface dataset' + if (fsurdat == ' ') then + write(iulog,*)'fsurdat must be specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + call getfil(fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + call ncd_pio_closefile(ncid) + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. else - do g = begg, endg - n = gindex(g-begg+1) - ldomain%frac(g) = lndfrac_glob(n) - end do - deallocate(lndfrac_glob) + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if end if + end subroutine lnd_get_global_dims + + !=============================================================================== + subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_glob, lndfrac_glob, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + type(ESMF_Mesh) , intent(in) :: mesh_ocn + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(out) :: rc + + ! local variables: + type(ESMF_DistGrid) :: distgrid_lnd + type(ESMF_RouteHandle) :: rhandle_ocn2lnd + type(ESMF_Field) :: field_lnd + type(ESMF_Field) :: field_ocn + type(ESMF_DistGrid) :: distgrid_ocn + integer , pointer :: gindex_input(:) ! global index space for land and ocean points + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + real(r8) , pointer :: rtemp_glob(:) + real(r8) , pointer :: lndfrac_loc(:) + real(r8) , pointer :: ocnmask_loc(:) ! on ocean mesh + real(r8) , pointer :: ocnfrac_loc(:) ! on land mesh + real(r8) , pointer :: dataptr1d(:) + type(ESMF_Array) :: elemMaskArray + integer :: lsize_lnd + integer :: lsize_ocn + integer :: n, spatialDim + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + real(r8) :: fminval = 0.001_r8 + real(r8) :: fmaxval = 1._r8 + logical :: checkflag = .false. + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, numOwnedElements=lsize_lnd, & + elementDistGrid=distgrid_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_loc(lsize_lnd)) + allocate(lndfrac_loc(lsize_lnd)) + + ! create fields on land and ocean meshes + field_lnd = ESMF_FieldCreate(mesh_lnd, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + field_ocn = ESMF_FieldCreate(mesh_ocn, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create route handle to map ocean mask from ocn mesh to land mesh + call ESMF_FieldRegridStore(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill in values for field_ocn with mask on ocn mesh + call ESMF_MeshGet(mesh_ocn, elementdistGrid=distgrid_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_ocn, localDe=0, elementCount=lsize_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ocnmask_loc(lsize_ocn)) + elemMaskArray = ESMF_ArrayCreate(distgrid_ocn, ocnmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_ocn, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_ocn, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = ocnmask_loc(:) + + ! map ocn mask to land mesh + call ESMF_FieldRegrid(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ocnfrac_loc(lsize_lnd)) + call ESMF_FieldGet(field_lnd, farrayptr=ocnfrac_loc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndfrac_loc(n) = 1._r8 - ocnfrac_loc(n) + if (lndfrac_loc(n) > fmaxval) lndfrac_loc(n) = 1._r8 + if (lndfrac_loc(n) < fminval) lndfrac_loc(n) = 0._r8 + if (lndfrac_loc(n) /= 0._r8) then + lndmask_loc(n) = 1 + else + lndmask_loc(n) = 0 + end if + enddo + call ESMF_FieldDestroy(field_lnd) + call ESMF_FieldDestroy(field_ocn) + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex_input(lsize_lnd)) + call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex_input, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndmask_glob(gindex_input(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + + ! Determine ldomain%frac using both input and ctsm decompositions + ! lndfrac_glob is filled using the input decomposition and + ! ldomin%frac is set using the ctsm decomposition + allocate(rtemp_glob(gsize)) + do n = 1,lsize_lnd + lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndfrac_glob(:) = rtemp_glob(:) + deallocate(rtemp_glob) + + ! deallocate memory + deallocate(ocnmask_loc) + deallocate(lndmask_loc) + deallocate(lndfrac_loc) + + end subroutine lnd_get_lndmask_from_ocnmesh + + !=============================================================================== + subroutine lnd_get_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(out) :: rc + + ! local variables: + integer :: n + integer :: lsize + integer , pointer :: gindex(:) + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: elemMaskArray + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine lsize and distgrid_lnd + call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndmask_loc + ! The call to ESMF_MeshGet fills in the values of lndmask_loc + allocate(lndmask_loc(lsize)) + elemMaskArray = ESMF_ArrayCreate(distgrid, lndmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_lnd, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex(lsize)) + allocate(itemp_glob(gsize)) + call ESMF_DistGridGet(distgrid, 0, seqIndexList=gindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + deallocate(gindex) + deallocate(lndmask_loc) + + ! ASSUME that land fraction is identical to land mask in this case + lndfrac_glob(:) = lndmask_glob(:) + + end subroutine lnd_get_lndmask_from_lndmesh + + !=============================================================================== + subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, ldomain, rc) + + use domainMod , only : domain_type, lon1d, lat1d + use decompMod , only : bounds_type, get_proc_bounds + use clm_varcon , only : re + + ! input/output variables + type(ESMF_Mesh) , intent(in) :: mesh + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gindex(:) + type(bounds_type) , intent(in) :: bounds + logical , intent(in) :: isgrid2d + integer , intent(in) :: ni,nj + type(domain_type) , intent(inout) :: ldomain + integer , intent(out) :: rc + + ! local variables + integer :: g,n + integer :: gsize + integer :: begg,endg + integer :: numownedelements + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + real(r8) , pointer :: ownedElemCoords(:) + integer :: spatialDim + real(r8) , pointer :: dataptr1d(:) + type(ESMF_Field) :: areaField + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + begg = bounds%begg + endg = bounds%endg + ! Determine ldoman%latc and ldomain%lonc - call ESMF_MeshGet(mesh_ctsm, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords, rc=rc) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg,endg n = g - begg + 1 @@ -278,8 +613,8 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni ldomain%latc(g) = ownedElemCoords(2*n) end do - ! Determine ldomain%area by querying the mesh on the ctsm decomposition - areaField = ESMF_FieldCreate(mesh_ctsm, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + ! Create ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridGetArea(areaField, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -292,6 +627,9 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni ! If grid is 2d, determine lon1d and lat1d if (isgrid2d) then + gsize = ni*nj + allocate(rtemp_glob(gsize)) + ! Determine lon1d allocate(lndlons_glob(gsize)) lndlons_glob(:) = 0._r8 @@ -302,7 +640,8 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) end if end do - call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) deallocate(lndlons_glob) allocate(lon1d(ni)) do n = 1,ni @@ -315,25 +654,41 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(model_meshfile, mesh_ctsm, ni do n = 1,numownedelements lndlats_glob(gindex(n)) = ownedElemCoords(2*n) end do - call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) deallocate(lndlats_glob) allocate(lat1d(nj)) do n = 1,nj lat1d(n) = rtemp_glob((n-1)*ni + 1) end do + deallocate(rtemp_glob) end if - deallocate(ownedElemCoords) - deallocate(rtemp_glob) - deallocate(gindex) + end subroutine lnd_set_ldomain_gridinfo + + !=============================================================================== + subroutine nc_check_err(ierror, description, filename) + + use shr_sys_mod , only : shr_sys_abort + use netcdf , only : nf90_noerr, nf90_strerror - end subroutine lnd_set_decomp_and_domain_from_meshinfo + integer , intent(in) :: ierror + character(*), intent(in) :: description + character(*), intent(in) :: filename + + if (ierror /= nf90_noerr) then + write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& + '". Error message:', trim(nf90_strerror(ierror)) + call shr_sys_abort() + endif + end subroutine nc_check_err !=============================================================================== logical function chkerr(rc, line, file) - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file + integer , intent(in) :: rc + integer , intent(in) :: line + character(len=*) , intent(in) :: file + integer :: lrc chkerr = .false. lrc = rc diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index b6bec64684..170c47ab99 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -346,7 +346,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use domainMod , only : ldomain use decompMod , only : ldecomp, bounds_type, get_proc_bounds use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_newmesh - use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_meshinfo + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_readmesh ! input/output variables type(ESMF_GridComp) :: gcomp @@ -390,6 +390,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: shrlogunit ! original log unit type(bounds_type) :: bounds ! bounds integer :: ni, nj + character(len=CL) :: meshfile_ocn + character(len=CL) :: domain_file character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -414,7 +416,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -!$ call omp_set_num_threads(localPeCount) + !$ call omp_set_num_threads(localPeCount) !---------------------- ! Obtain attribute values @@ -541,10 +543,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (single_column) model_meshfile = 'create_mesh' + if (trim(model_meshfile) == 'create_mesh') then - call lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) + ! TODO: can't this just be fatmlndfrc + call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=domain_file, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh, ni, nj, rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call lnd_set_decomp_and_domain_from_readmesh(mode='nuopc', vm=vm, & + meshfile_lnd=model_meshfile, meshfile_ocn=meshfile_ocn, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! --------------------- diff --git a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 index 7e2f800089..f3be6085e9 100644 --- a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 @@ -4,154 +4,126 @@ module lnd_set_decomp_and_domain use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl use spmdMod , only : masterproc use clm_varctl , only : iulog - use nuopc_shr_methods , only : chkerr implicit none private ! except ! Module public routines - public :: lnd_set_decomp_and_domain_from_meshinfo + public :: lnd_set_decomp_and_domain_from_readmesh public :: lnd_set_decomp_and_domain_from_newmesh ! Module private routines - private :: clm_getlandmask_from_ocnmesh - private :: clm_getlandmask_from_lndmesh + private :: lnd_get_global_dims + private :: lnd_get_lndmask_from_ocnmesh + private :: lnd_get_lndmask_from_lndmesh + private :: lnd_set_ldomain_gridinfo private :: nc_check_err + private :: chkerr character(len=*) , parameter :: u_FILE_u = & __FILE__ + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !=============================================================================== contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh_ctsm, ni, nj, rc) + subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, ni, nj, rc) - use NUOPC , only : NUOPC_CompAttributeGet use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D - use domainMod , only : ldomain, domain_init, lon1d, lat1d + use domainMod , only : ldomain, domain_init use decompMod , only : ldecomp, bounds_type, get_proc_bounds use clm_varpar , only : nlevsoi + use clm_varctl , only : fatmlndfrc, fsurdat use clm_varctl , only : use_soil_moisture_streams, single_column - use clm_varcon , only : re - use lnd_comp_shr , only : model_meshfile, model_clock + ! + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use fileutils , only : getfil ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*) , intent(in) :: mode ! lilac or nuopc mode + type(ESMF_VM) , intent(in) :: vm + character(len=*) , intent(in) :: meshfile_lnd + character(len=*) , intent(in) :: meshfile_ocn type(ESMF_Mesh) , intent(out) :: mesh_ctsm integer , intent(out) :: ni,nj ! global grid dimensions integer , intent(out) :: rc ! local variables - type(ESMF_VM) :: vm type(ESMF_Mesh) :: mesh_ocninput type(ESMF_Mesh) :: mesh_lndinput - type(ESMF_DistGrid) :: distgrid_lndinput type(ESMF_DistGrid) :: distgrid_ctsm character(CL) :: cvalue ! config data integer :: nlnd, nocn ! local size of arrays integer :: g,n ! indices type(bounds_type) :: bounds ! bounds integer :: begg,endg - character(CL) :: meshfile_ocn integer , pointer :: gindex_lnd(:) ! global index space for just land points integer , pointer :: gindex_ocn(:) ! global index space for just ocean points integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points integer , pointer :: gindex_input(:) ! global index space for land and ocean points - integer , pointer :: mask(:) ! local land/ocean mask - integer , pointer :: lndmask_loc(:) - real(r8) , pointer :: lndfrac_loc(:) integer , pointer :: lndmask_glob(:) real(r8) , pointer :: lndfrac_glob(:) - real(r8) , pointer :: lndlats_glob(:) - real(r8) , pointer :: lndlons_glob(:) - real(r8) , pointer :: rtemp_glob(:) - integer , pointer :: itemp_glob(:) - integer :: numownedelements - real(r8) , pointer :: ownedElemCoords(:) - real(r8) , pointer :: dataptr1d(:) integer :: lsize_input integer :: gsize logical :: isgrid2d - integer :: spatialDim - type(ESMF_Field) :: areaField + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! get vm - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine global 2d sizes from read of dimensions of surface dataset + call lnd_get_global_dims(ni, nj, gsize, isgrid2d) - ! determine global 2d sizes - call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ni - call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) nj - gsize = ni*nj - if (single_column) then - isgrid2d = .true. - else if (nj == 1) then - isgrid2d = .false. - else - isgrid2d = .true. - end if - if (masterproc) then - write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj - if (isgrid2d) then - write(iulog,'(a)') 'model grid is 2-dimensional' - else - write(iulog,'(a)') 'model grid is not 2-dimensional' - end if - end if + ! Allocate global memory for land mask and land fraction + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + allocate(lndfrac_glob(gsize)); lndfrac_glob(:) = 0._r8 ! read in the land mesh from the file - mesh_lndinput = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then - write(iulog,'(a)')'land mesh file ',trim(model_meshfile) + write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) end if - ! read in ocn mask meshfile - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) - end if + ! Set global land fraction and global land mask across all processors + if (trim(meshfile_ocn) /= 'null') then + ! read in ocn mask meshfile + mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + end if - ! set local land fraction and land mask for input read decomposition - ! Note that lndmask_loc and lndfrac_loc are - ! - allocated in the following calls and lsize is returned - ! - on the input decomposition (gindex_input) - ! - lsize references to the local size of the input decomposition - if (trim(meshfile_ocn) == 'null') then - ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call clm_getlandmask_from_lndmesh(mesh_lndinput, lsize_input, lndmask_loc, lndfrac_loc, distgrid_lndinput, rc) + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call clm_getlandmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, lsize_input, lndmask_loc, lndfrac_loc, distgrid_lndinput, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then + ! Read in global land mask and land fraction from fatmlndfrc + call getfil( trim(fatmlndfrc), locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 + call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + call ncd_pio_closefile(ncid) + else + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call lnd_get_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if - ! determine global landmask_glob - needed to determine the ctsm decomposition - ! land frac, lats, lons and areas will be done below - allocate(gindex_input(lsize_input)) - call ESMF_DistGridGet(distgrid_lndinput, 0, seqIndexList=gindex_input, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 - do n = 1,lsize_input - lndmask_glob(gindex_input(n)) = lndmask_loc(n) - end do - allocate(itemp_glob(gsize)) - call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndmask_glob(:) = int(itemp_glob(:)) - deallocate(itemp_glob) - - ! determine lnd decomposition that will be used by ctsm + ! Determine lnd decomposition that will be used by ctsm call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) if (use_soil_moisture_streams) then call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) @@ -159,9 +131,10 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh_ctsm, ni, nj, rc) ! Determine ocn decomposition that will be used to create the full mesh ! note that the memory for gindex_ocn will be allocated in the following call + ! but deallocated at the end of this routine call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) - ! *** Get JUST gridcell processor bounds *** + ! Get JUST gridcell processor bounds ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp ! so get_proc_bounds is called twice and the gridcell information is just filled in twice call get_proc_bounds(bounds) @@ -179,28 +152,13 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh_ctsm, ni, nj, rc) ! Initialize domain data structure call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - ! Determine ldomain%mask using ctsm decomposition + ! Determine ldomain%mask and ldomain%frac using ctsm decomposition do g = begg, endg n = 1 + (g - begg) ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) + ldomain%frac(g) = lndfrac_glob(gindex_lnd(n)) end do deallocate(lndmask_glob) - - ! Determine ldomain%frac using both input and ctsm decompositions - ! lndfrac_glob is filled using the input decomposition and - ! ldomin%frac is set using the ctsm decomposition - allocate(rtemp_glob(gsize)) - allocate(lndfrac_glob(gsize)) - lndfrac_glob(:) = 0._r8 - do n = 1,lsize_input - lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) - end do - call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndfrac_glob(:) = rtemp_glob(:) - do g = begg, endg - ldomain%frac(g) = lndfrac_glob(gindex_lnd(g-begg+1)) - end do deallocate(lndfrac_glob) ! Generate a ctsm global index that includes both land and ocean points @@ -220,165 +178,91 @@ subroutine lnd_set_decomp_and_domain_from_meshinfo(gcomp, mesh_ctsm, ni, nj, rc) mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine ldoman%latc and ldomain%lonc - call ESMF_MeshGet(mesh_ctsm, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh_ctsm, ownedElemCoords=ownedElemCoords, rc=rc) + ! Get ldomain%lonc, ldomain%latc and ldomain%area and optionally + ! lon1d and lat1d if isgrid2d + call lnd_set_ldomain_gridinfo(mesh_ctsm, vm, gindex_ctsm, bounds, isgrid2d, ni, nj, ldomain, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg,endg - n = g - begg + 1 - ldomain%lonc(g) = ownedElemCoords(2*n-1) - if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? - ldomain%latc(g) = ownedElemCoords(2*n) - end do - - ! Create ldomain%area by querying the mesh on the ctsm decomposition - areaField = ESMF_FieldCreate(mesh_ctsm, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(areaField, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) - end do - call ESMF_FieldDestroy(areaField) - - ! If grid is 2d, determine lon1d and lat1d - if (isgrid2d) then - ! Determine lon1d - allocate(lndlons_glob(gsize)) - lndlons_glob(:) = 0._r8 - do n = 1,numownedelements - if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? - lndlons_glob(gindex_ctsm(n)) = 0._r8 - else - lndlons_glob(gindex_ctsm(n)) = ownedElemCoords(2*n-1) - end if - end do - call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - deallocate(lndlons_glob) - allocate(lon1d(ni)) - do n = 1,ni - lon1d(n) = rtemp_glob(n) - end do - - ! Determine lat1d - allocate(lndlats_glob(gsize)) - lndlats_glob(:) = 0._r8 - do n = 1,numownedelements - lndlats_glob(gindex_ctsm(n)) = ownedElemCoords(2*n) - end do - call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, reduceflag=ESMF_REDUCE_SUM, rc=rc) - deallocate(lndlats_glob) - allocate(lat1d(nj)) - do n = 1,nj - lat1d(n) = rtemp_glob((n-1)*ni + 1) - end do - end if + ! Deallocate memory + deallocate(gindex_lnd) + deallocate(gindex_ocn) deallocate(gindex_ctsm) - deallocate(rtemp_glob) - end subroutine lnd_set_decomp_and_domain_from_meshinfo + end subroutine lnd_set_decomp_and_domain_from_readmesh !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) + subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) - ! Generate a new mesh from the global 2d sizes and set the mask to 1 + ! Generate a new mesh from the input domain file and set the mask to 1 - use NUOPC , only : NUOPC_CompAttributeGet - use clm_varctl , only : single_column - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror - use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var - use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable + use decompInitMod , only : decompInit_lnd, decompInit_lnd3D + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use domainMod , only : ldomain, domain_init + use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varpar , only : nlevsoi + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror + use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var + use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(out) :: mesh - integer , intent(out) :: ni,nj ! global grid dimensions - integer , intent(out) :: rc + character(len=CL) , intent(in) :: domain_file + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc ! local variables - integer :: ncid, ierr - integer :: nv - integer :: dimid_ni, dimid_nj, dimid_nv - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - type(ESMF_Grid) :: lgrid - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) - integer :: varid_xv, varid_yv - character(len=CL) :: cvalue - integer :: gsize - logical :: isgrid2d - integer :: numownedelements - integer, allocatable :: mask(:) + logical :: isgrid2d + integer :: g,n + integer :: nv + integer :: ncid, ierr + integer :: dimid_ni, dimid_nj, dimid_nv + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + type(ESMF_Grid) :: lgrid + real(r8), allocatable :: xv(:,:,:), yv(:,:,:) + integer :: varid_xv, varid_yv + integer :: numownedelements + integer, allocatable :: lnd_mask(:) + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + integer :: nlnd + integer, pointer :: gindex_lnd(:) ! global index space for just land points !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! determine global 2d sizes - call NUOPC_CompAttributeGet(gcomp, name='lnd_ni', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ni - call NUOPC_CompAttributeGet(gcomp, name='lnd_nj', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) nj - gsize = ni*nj - if (single_column) then - isgrid2d = .true. - else if (nj == 1) then - isgrid2d = .false. - else - isgrid2d = .true. - end if - if (masterproc) then - write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj - if (isgrid2d) then - write(iulog,'(a)') 'model grid is 2-dimensional' - else - write(iulog,'(a)') 'model grid is not 2-dimensional' - end if - end if - - ! get the datm grid from the domain file - call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return ! open file - ierr = nf90_open(cvalue, NF90_NOWRITE, ncid) - call nc_check_err(ierr, 'nf90_open', trim(cvalue)) + ierr = nf90_open(domain_file, NF90_NOWRITE, ncid) + call nc_check_err(ierr, 'nf90_open', trim(domain_file)) ! get dimension ids ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) - call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(domain_file)) ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) - call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(domain_file)) ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) - call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(domain_file)) ! get dimension values ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) - call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(domain_file)) ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) - call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(domain_file)) ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) - call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(domain_file)) ! get variable ids ierr = nf90_inq_varid(ncid, 'xv', varid_xv) - call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(domain_file)) ierr = nf90_inq_varid(ncid, 'yv', varid_yv) - call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(domain_file)) ! allocate memory for variables and get variable values allocate(xv(nv,ni,nj), yv(nv,ni,nj)) ierr = nf90_get_var(ncid, varid_xv, xv) - call nc_check_err(ierr, 'nf90_get_var for xv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_get_var for xv', trim(domain_file)) ierr = nf90_get_var(ncid, varid_yv, yv) - call nc_check_err(ierr, 'nf90_get_var for yv', trim(cvalue)) + call nc_check_err(ierr, 'nf90_get_var for yv', trim(domain_file)) ! close file ierr = nf90_close(ncid) - call nc_check_err(ierr, 'nf90_close', trim(cvalue)) + call nc_check_err(ierr, 'nf90_close', trim(domain_file)) ! create the grid maxIndex(1) = ni ! number of lons maxIndex(2) = nj ! number of lats @@ -399,35 +283,126 @@ subroutine lnd_set_decomp_and_domain_from_newmesh(gcomp, mesh, ni, nj, rc) ! Set the mesh mask to 1 call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(mask(numownedelements)) - mask(:) = 1 - call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) + allocate(lnd_mask(numownedelements)) + lnd_mask(:) = 1 + call ESMF_MeshSet(mesh, elementMask=lnd_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(mask) + + ! Determine ldecomp and ldomain + call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Initialize processor bounds + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create ctsm gindex_lnd + nlnd = endg - begg + 1 + allocate(gindex_lnd(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + ! Initialize domain data structure + isgrid2d = .true. + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask and ldomain%frac + do g = begg, endg + ldomain%mask(g) = 1 + ldomain%frac(g) = 1._r8 + end do + deallocate(lnd_mask) end subroutine lnd_set_decomp_and_domain_from_newmesh !=============================================================================== - subroutine clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize_lnd, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) + + ! Determine global 2d sizes from read of dimensions of surface dataset + + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + + ! input/output variables + integer, intent(out) :: ni + integer, intent(out) :: nj + integer, intent(out) :: gsize + logical, intent(out) :: isgrid2d + + ! local variables + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not + !------------------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to global dimensions from surface dataset' + if (fsurdat == ' ') then + write(iulog,*)'fsurdat must be specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + call getfil(fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + call ncd_pio_closefile(ncid) + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + end subroutine lnd_get_global_dims + + !=============================================================================== + subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_glob, lndfrac_glob, rc) ! input/out variables type(ESMF_Mesh) , intent(in) :: mesh_lnd type(ESMF_Mesh) , intent(in) :: mesh_ocn - integer , pointer :: lndmask_loc(:) - real(r8) , pointer :: lndfrac_loc(:) - integer , intent(out) :: lsize_lnd - type(ESMF_DistGrid) , intent(out) :: distgrid_lnd + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) integer , intent(out) :: rc ! local variables: + type(ESMF_DistGrid) :: distgrid_lnd type(ESMF_RouteHandle) :: rhandle_ocn2lnd type(ESMF_Field) :: field_lnd type(ESMF_Field) :: field_ocn type(ESMF_DistGrid) :: distgrid_ocn + integer , pointer :: gindex_input(:) ! global index space for land and ocean points + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + real(r8) , pointer :: rtemp_glob(:) + real(r8) , pointer :: lndfrac_loc(:) real(r8) , pointer :: ocnmask_loc(:) ! on ocean mesh real(r8) , pointer :: ocnfrac_loc(:) ! on land mesh real(r8) , pointer :: dataptr1d(:) type(ESMF_Array) :: elemMaskArray + integer :: lsize_lnd integer :: lsize_ocn integer :: n, spatialDim integer :: srcMaskValue = 0 @@ -493,51 +468,203 @@ subroutine clm_getlandmask_from_ocnmesh(mesh_lnd, mesh_ocn, lsize_lnd, lndmask_l lndmask_loc(n) = 0 end if enddo - - ! deallocate memory call ESMF_FieldDestroy(field_lnd) call ESMF_FieldDestroy(field_ocn) + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex_input(lsize_lnd)) + call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex_input, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndmask_glob(gindex_input(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + + ! Determine ldomain%frac using both input and ctsm decompositions + ! lndfrac_glob is filled using the input decomposition and + ! ldomin%frac is set using the ctsm decomposition + allocate(rtemp_glob(gsize)) + do n = 1,lsize_lnd + lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndfrac_glob(:) = rtemp_glob(:) + deallocate(rtemp_glob) + + ! deallocate memory deallocate(ocnmask_loc) + deallocate(lndmask_loc) + deallocate(lndfrac_loc) - end subroutine clm_getlandmask_from_ocnmesh + end subroutine lnd_get_lndmask_from_ocnmesh !=============================================================================== - subroutine clm_getlandmask_from_lndmesh(mesh_lnd, lsize, lndmask_loc, lndfrac_loc, distgrid_lnd, rc) + subroutine lnd_get_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) ! input/out variables type(ESMF_Mesh) , intent(in) :: mesh_lnd - integer , intent(out) :: lsize - integer , pointer :: lndmask_loc(:) - real(r8) , pointer :: lndfrac_loc(:) - type(ESMF_DistGrid) , intent(out) :: distgrid_lnd + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) integer , intent(out) :: rc ! local variables: - type(ESMF_Array) :: elemMaskArray + integer :: n + integer :: lsize + integer , pointer :: gindex(:) + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: elemMaskArray !------------------------------------------------------------------------------- rc = ESMF_SUCCESS ! Determine lsize and distgrid_lnd - call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid_lnd, rc=rc) + call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_lnd, localDe=0, elementCount=lsize, rc=rc) + call ESMF_DistGridGet(distgrid, localDe=0, elementCount=lsize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine lndfrac_loc + ! Determine lndmask_loc ! The call to ESMF_MeshGet fills in the values of lndmask_loc allocate(lndmask_loc(lsize)) - elemMaskArray = ESMF_ArrayCreate(distgrid_lnd, lndmask_loc, rc=rc) + elemMaskArray = ESMF_ArrayCreate(distgrid, lndmask_loc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh_lnd, elemMaskArray=elemMaskArray, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine lndmask_loc + ! Determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex(lsize)) + allocate(itemp_glob(gsize)) + call ESMF_DistGridGet(distgrid, 0, seqIndexList=gindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + deallocate(gindex) + deallocate(lndmask_loc) + ! ASSUME that land fraction is identical to land mask in this case - allocate(lndfrac_loc(lsize)) - lndfrac_loc(:) = lndmask_loc(:) + lndfrac_glob(:) = lndmask_glob(:) + + end subroutine lnd_get_lndmask_from_lndmesh + + !=============================================================================== + subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, ldomain, rc) + + use domainMod , only : domain_type, lon1d, lat1d + use decompMod , only : bounds_type, get_proc_bounds + use clm_varcon , only : re + + ! input/output variables + type(ESMF_Mesh) , intent(in) :: mesh + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gindex(:) + type(bounds_type) , intent(in) :: bounds + logical , intent(in) :: isgrid2d + integer , intent(in) :: ni,nj + type(domain_type) , intent(inout) :: ldomain + integer , intent(out) :: rc + + ! local variables + integer :: g,n + integer :: gsize + integer :: begg,endg + integer :: numownedelements + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + real(r8) , pointer :: ownedElemCoords(:) + integer :: spatialDim + real(r8) , pointer :: dataptr1d(:) + type(ESMF_Field) :: areaField + !------------------------------------------------------------------------------- - end subroutine clm_getlandmask_from_lndmesh + rc = ESMF_SUCCESS + + begg = bounds%begg + endg = bounds%endg + + ! Determine ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg,endg + n = g - begg + 1 + ldomain%lonc(g) = ownedElemCoords(2*n-1) + if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? + ldomain%latc(g) = ownedElemCoords(2*n) + end do + + ! Create ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) + end do + call ESMF_FieldDestroy(areaField) + + ! If grid is 2d, determine lon1d and lat1d + if (isgrid2d) then + gsize = ni*nj + allocate(rtemp_glob(gsize)) + + ! Determine lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,numownedelements + if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? + lndlons_glob(gindex(n)) = 0._r8 + else + lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) + end if + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlons_glob) + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = rtemp_glob(n) + end do + + ! Determine lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,numownedelements + lndlats_glob(gindex(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlats_glob) + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = rtemp_glob((n-1)*ni + 1) + end do + deallocate(rtemp_glob) + end if + + end subroutine lnd_set_ldomain_gridinfo !=============================================================================== subroutine nc_check_err(ierror, description, filename) @@ -556,4 +683,18 @@ subroutine nc_check_err(ierror, description, filename) endif end subroutine nc_check_err + !=============================================================================== + logical function chkerr(rc, line, file) + integer , intent(in) :: rc + integer , intent(in) :: line + character(len=*) , intent(in) :: file + + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + end module lnd_set_decomp_and_domain From 264adb65bb1a30abd665b2c79e251cb68a12dc07 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 Dec 2020 19:58:57 -0700 Subject: [PATCH 057/219] updates to have share code --- cime_config/buildlib | 3 + src/cpl/lilac/lnd_import_export.F90 | 587 ++++++--------- src/cpl/nuopc/lnd_set_decomp_and_domain.F90 | 700 ------------------ .../lnd_set_decomp_and_domain.F90 | 43 +- 4 files changed, 255 insertions(+), 1078 deletions(-) delete mode 100644 src/cpl/nuopc/lnd_set_decomp_and_domain.F90 rename src/cpl/{lilac => share_esmf}/lnd_set_decomp_and_domain.F90 (94%) diff --git a/cime_config/buildlib b/cime_config/buildlib index 1b32e401ed..55c47be4e9 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -133,6 +133,9 @@ def _main_func(): # to use its directories in place of stub_rof paths.append(os.path.join(lnd_root,"lilac","stub_rof")) + if (driver == 'lilac' or driver == 'nuopc'): + paths.append(os.path.join(lnd_root,"src","cpl","share_esmf")) + with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) filepath.write("\n") diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 581bdbedc8..95c5d6426f 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -27,14 +27,80 @@ module lnd_import_export private :: state_setexport private :: state_getfldptr + ! import fields + character(*), parameter :: Sa_z = 'Sa_z' + character(*), parameter :: Sa_topo = 'Sa_topo' + character(*), parameter :: Sa_u = 'Sa_u' + character(*), parameter :: Sa_v = 'Sa_v' + character(*), parameter :: Sa_ptem = 'Sa_ptem' + character(*), parameter :: Sa_shum = 'Sa_shum' + character(*), parameter :: Sa_pbot = 'Sa_pbot' + character(*), parameter :: Sa_tbot = 'Sa_tbot' + character(*), parameter :: Sa_methane = 'Sa_methane' + character(*), parameter :: Faxa_rainc = 'Faxa_rainc' + character(*), parameter :: Faxa_rainl = 'Faxa_rainl' + character(*), parameter :: Faxa_snowc = 'Faxa_snowc' + character(*), parameter :: Faxa_snowl = 'Faxa_snowl' + character(*), parameter :: Faxa_lwdn = 'Faxa_lwdn' + character(*), parameter :: Faxa_swvdr = 'Faxa_swvdr' + character(*), parameter :: Faxa_swndr = 'Faxa_swndr' + character(*), parameter :: Faxa_swvdf = 'Faxa_swvdf' + character(*), parameter :: Faxa_swndf = 'Faxa_swndf' + character(*), parameter :: Faxa_bcphidry = 'Faxa_bcphidry' + character(*), parameter :: Faxa_bcphodry = 'Faxa_bcphodry' + character(*), parameter :: Faxa_bcphiwet = 'Faxa_bcphiwet' + character(*), parameter :: Faxa_ocphidry = 'Faxa_ocphidry' + character(*), parameter :: Faxa_ocphodry = 'Faxa_ocphodry' + character(*), parameter :: Faxa_ocphiwet = 'Faxa_ocphiwet' + character(*), parameter :: Faxa_dstwet1 = 'Faxa_dstwet1' + character(*), parameter :: Faxa_dstwet2 = 'Faxa_dstwet2' + character(*), parameter :: Faxa_dstwet3 = 'Faxa_dstwet3' + character(*), parameter :: Faxa_dstwet4 = 'Faxa_dstwet4' + character(*), parameter :: Faxa_dstdry1 = 'Faxa_dstdry1' + character(*), parameter :: Faxa_dstdry2 = 'Faxa_dstdry2' + character(*), parameter :: Faxa_dstdry3 = 'Faxa_dstdry3' + character(*), parameter :: Faxa_dstdry3 = 'Faxa_dstdry4' + character(*), parameter :: Faxa_ndep = 'Faxa_ndep' + + ! export fields + character(*), parameter :: Sl_t = 'Sl_t' + character(*), parameter :: Sl_snowh = 'Sl_snowh' + character(*), parameter :: Sl_avsdr = 'Sl_avsdr' + character(*), parameter :: Sl_anidr = 'Sl_anidr' + character(*), parameter :: Sl_avsdf = 'Sl_avsdf' + character(*), parameter :: Sl_anidf = 'Sl_anidf' + character(*), parameter :: Sl_tref = 'Sl_tref' + character(*), parameter :: Sl_qref = 'Sl_qref' + character(*), parameter :: Sl_u10 = 'Sl_u10' + character(*), parameter :: Sl_ram1 = 'Sl_ram1' + character(*), parameter :: Sl_fv = 'Sl_fv' + character(*), parameter :: Sl_z0m = 'Sl_z0m' + character(*), parameter :: Sl_soilw = 'Sl_soilw' + character(*), parameter :: Sl_ddvel = 'Sl_ddvel' + character(*), parameter :: Sl_fztop = 'Sl_fztop' + character(*), parameter :: Fall_taux = 'Fall_taux' + character(*), parameter :: Fall_tauy = 'Fall_tauy' + character(*), parameter :: Fall_lat = 'Fall_lat' + character(*), parameter :: Fall_sen = 'Fall_sen' + character(*), parameter :: Fall_lwup = 'Fall_lwup' + character(*), parameter :: Fall_evap = 'Fall_evap' + character(*), parameter :: Fall_swnet = 'Fall_swnet' + character(*), parameter :: Fall_flxdst = 'Fall_flxdst' + character(*), parameter :: Fall_methane = 'Fall_methane' + character(*), parameter :: Fall_voc = 'Fall_voc' + character(*), parameter :: Fall_fire = 'Fall_fire' + character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' + character(*), parameter :: Flrl_rofsub = 'Flrl_rofsub' + character(*), parameter :: Flrl_rofgwl = 'Flrl_rofgwl' + character(*), parameter :: Flrl_rofi = 'Flrl_rofi' + character(*), parameter :: Flrl_irrig = 'Flrl_irrig' + ! from atm->lnd integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn ! from lnd->atm integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm integer :: emis_nflds ! number of fire emission fields from lnd-> atm - - integer :: glc_nec = 10 ! number of glc elevation classes integer, parameter :: debug = 0 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" @@ -101,129 +167,80 @@ subroutine import_fields( importState, bounds, first_call, rc) ! Required atmosphere input fields !-------------------------- - call state_getimport(importState, 'c2l_fb_atm', 'Sa_z', bounds, & - output=atm2lnd_inst%forc_hgt_grc, rc=rc) + call state_getimport_1d(importState, Sa_z , atm2lnd_inst%forc_hgt_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_topo', bounds, & - output=atm2lnd_inst%forc_topo_grc, rc=rc) + call state_getimport_1d(importState, Sa_topo , atm2lnd_inst%forc_topo_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_u', bounds, & - output=atm2lnd_inst%forc_u_grc, rc=rc ) + call state_getimport_1d(importState, Sa_u , atm2lnd_inst%forc_u_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_v', bounds, & - output=atm2lnd_inst%forc_v_grc, rc=rc ) + call state_getimport_1d(importState, Sa_v , atm2lnd_inst%forc_v_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_ptem', bounds, & - output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_shum , wateratm2lndbulk_inst%forc_q_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_shum', bounds, & - output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_ptem , atm2lnd_inst%forc_th_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_pbot', bounds, & - output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_pbot , atm2lnd_inst%forc_pbot_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Sa_tbot', bounds, & - output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_tbot , atm2lnd_inst%forc_t_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainc', bounds, & - output=forc_rainc, rc=rc ) + call state_getimport_1d(importState, Faxa_rainc, forc_rainc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainl', bounds, & - output=forc_rainl, rc=rc ) + call state_getimport_1d(importState, Faxa_rainl, forc_rainl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowc', bounds, & - output=forc_snowc, rc=rc ) + call state_getimport_1d(importState, Faxa_snowc, forc_snowc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowl', bounds, & - output=forc_snowl, rc=rc ) + call state_getimport_1d(importState, Faxa_snowl, forc_snowl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_lwdn', bounds, & - output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Faxa_lwdn , atm2lnd_inst%forc_lwrad_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdr', bounds, & - output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + call state_getimport_1d(importState, Faxa_swvdr, atm2lnd_inst%forc_solad_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndr', bounds, & - output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + call state_getimport_1d(importState, Faxa_swndr, atm2lnd_inst%forc_solad_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdf', bounds, & - output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + call state_getimport_1d(importState, Faxa_swvdf, atm2lnd_inst%forc_solai_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndf', bounds, & - output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + call state_getimport_1d(importState, Faxa_swndf, atm2lnd_inst%forc_solai_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ! Atmosphere prognostic/prescribed aerosol fields - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphidry', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) + call state_getimport_1d(importState, Faxa_bcphidry, atm2lnd_inst%forc_aer_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphodry', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) + call state_getimport_1d(importState, Faxa_bcphodry, atm2lnd_inst%forc_aer_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphiwet', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) + call state_getimport_1d(importState, Faxa_bcphiwet, atm2lnd_inst%forc_aer_grc(begg:,3), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphidry', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) + call state_getimport_1d(importState, Faxa_ocphidry, atm2lnd_inst%forc_aer_grc(begg:,4), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphodry', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) + call state_getimport_1d(importState, Faxa_ocphodry, atm2lnd_inst%forc_aer_grc(begg:,5), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphiwet', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) + call state_getimport_1d(importState, Faxa_ocphiwet, atm2lnd_inst%forc_aer_grc(begg:,6), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet1', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) + call state_getimport_1d(importState, Faxa_dstwet1, output=atm2lnd_inst%forc_aer_grc(begg:,7), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry1', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) + call state_getimport_1d(importState, Faxa_dstwet2, output=atm2lnd_inst%forc_aer_grc(begg:,9), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet2', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) + call state_getimport_1d(importState, Faxa_dstwet3, output=atm2lnd_inst%forc_aer_grc(begg:,11), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry2', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) + call state_getimport_1d(importState, Faxa_dstwet4, output=atm2lnd_inst%forc_aer_grc(begg:,13), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet3', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) + + call state_getimport_1d(importState, Faxa_dstdry1, output=atm2lnd_inst%forc_aer_grc(begg:,8), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry3', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) + call state_getimport_1d(importState, Faxa_dstdry2, output=atm2lnd_inst%forc_aer_grc(begg:,10), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet4', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) + call state_getimport_1d(importState, Faxa_dstdry3, output=atm2lnd_inst%forc_aer_grc(begg:,12), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry4', bounds, & - output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) + call state_getimport_1d(importState, Faxa_dstdry4, output=atm2lnd_inst%forc_aer_grc(begg:,14), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'c2l_fb_atm', 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call state_getimport_1d(importState, Sa_methane, atm2lnd_inst%forc_pch4_grc(begg:), rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return ! The lilac is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec ! so the following conversion needs to happen - ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) + ! call state_getimport_1d(importState, Faxa_nhx, output=forc_nhx(begg:), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_noy', bounds, output=forc_noy, rc=rc ) + ! call state_getimport_1d(importState, Faxa_nhy, output=forc_nhy(begg:), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do g = begg,endg ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 @@ -316,139 +333,102 @@ subroutine export_fields(exportState, bounds, rc) ! local variables integer :: i, g, num + integer :: begg, endg real(r8) :: array(bounds%begg:bounds%endg) + character(len=CS) :: cnum character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS + begg = bounds%begg + endg = bounds%endg + ! ----------------------- ! output to atm ! ----------------------- - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_t', bounds, & - input=lnd2atm_inst%t_rad_grc, rc=rc) + call state_setexport_1d(exportState, Sl_t , lnd2atm_inst%t_rad_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_snowh', bounds, & - input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) + call state_setexport_1d(exportState, Sl_snowh , waterlnd2atmbulk_inst%h2osno_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdr', bounds, & - input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) + call state_setexport_1d(exportState, Sl_avsdr , lnd2atm_inst%albd_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidr', bounds, & - input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) + call state_setexport_1d(exportState, Sl_anidr , lnd2atm_inst%albd_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdf', bounds, & - input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) + call state_setexport_1d(exportState, Sl_avsdf , lnd2atm_inst%albi_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidf', bounds, & - input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) + call state_setexport_1d(exportState, Sl_anidf , lnd2atm_inst%albi_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_tref', bounds, & - input=lnd2atm_inst%t_ref2m_grc, rc=rc) + call state_setexport_1d(exportState, Sl_tref , lnd2atm_inst%t_ref2m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_qref', bounds, & - input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) + call state_setexport_1d(exportState, Sl_qref , waterlnd2atmbulk_inst%q_ref2m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_u10', bounds, & - input=lnd2atm_inst%u_ref10m_grc, rc=rc) + call state_setexport_1d(exportState, Sl_u10 , lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_taux', bounds, & - input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_taux , lnd2atm_inst%taux_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_tauy', bounds, & - input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_tauy , lnd2atm_inst%tauy_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lat', bounds, & - input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_lat , lnd2atm_inst%eflx_lh_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_sen', bounds, & - input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_sen , lnd2atm_inst%eflx_sh_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lwup', bounds, & - input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_lwup , lnd2atm_inst%eflx_lwrad_out_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_evap', bounds, & - input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_evap , waterlnd2atmbulk_inst%qflx_evap_tot_grc(begg:), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_swnet', bounds, & - input=lnd2atm_inst%fsa_grc, rc=rc) + call state_setexport_1d(exportState, Fall_swnet , lnd2atm_inst%fsa_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst1', bounds, & - input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_flxdst1 , lnd2atm_inst%flxdst_grc(begg:,1), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst2', bounds, & - input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_flxdst2 , lnd2atm_inst%flxdst_grc(begg:,2), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst3', bounds, & - input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_flxdst3 , lnd2atm_inst%flxdst_grc(begg:,3), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst4', bounds, & - input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) + call state_setexport_1d(exportState, Fall_flxdst4 , lnd2atm_inst%flxdst_grc(begg:,4), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ram1', bounds, & - input=lnd2atm_inst%ram1_grc, rc=rc) + call state_setexport_1d(exportState, Sl_ram1 , lnd2atm_inst%ram1_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fv', bounds, & - input=lnd2atm_inst%fv_grc, rc=rc) + call state_setexport_1d(exportState, Sl_fv , lnd2atm_inst%fv_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'l2c_fb_atm', 'Sl_z0m', bounds, & - input=lnd2atm_inst%z0m_grc, rc=rc) + call state_setexport_1d(exportState, Sl_z0m , lnd2atm_inst%z0m_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! methanem - ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_methane', bounds, & - ! input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) + ! methane + ! call state_setexport_1d(exportState, Fall_methane , lnd2atm_inst%flux_ch4_grc(begg:), minus=.true., rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! soil water - ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_soilw', bounds, & - ! input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) + ! call state_setexport_1d(exportState, Sl_soilw , water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(begg:,1), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! dry dep velocities ! do num = 1, drydep_nflds - ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ddvel', bounds, & - ! input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! write(cnum,'(i0)') num + ! call state_setexport_1d(exportState, trim(Sl_ddvel)//trim(cnum), & + ! lnd2atm_inst%ddvel_grc(begg:,num), rc=rc) ! end do ! MEGAN VOC emis fluxes ! do num = 1, shr_megan_mechcomps_n - ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_voc', bounds, & - ! input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! write(cnum,'(i0)') num + ! call state_setexport_1d(exportState, trim(Fall_voc)//trim(cnum), & + ! lnd2atm_inst%flxvoc_grc(begg:,num), minus=.true., rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! fire emis fluxes ! do num = 1, emis_nflds - ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_fire', bounds, & - ! input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! end do + ! write(cnum,'(i0)') num + ! call state_setexport_2d(exportState, trim(Fall_fire)//trim(cnum), lnd2atm_inst%fireflx_grc(begg:,num), & + ! minus = .true., rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! if (emis_nflds > 0) then - ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + ! call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! endif + ! end if + ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. ! i.e. water sent from land to rof is positive @@ -457,211 +437,118 @@ subroutine export_fields(exportState, bounds, rc) ! ----------------------- ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = bounds%begg,bounds%endg + ! do g = begg,endg ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsur', bounds, & - input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) + call state_setexport_1d(exportState, Flrl_rofsur, waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - do g = bounds%begg,bounds%endg + do g = begg,endg array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) end do - call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsub', bounds, & - input=array, rc=rc) + call state_setexport_1d(exportState, Flrl_rofsub, array(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! qgwl sent individually to coupler - call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofgwl', bounds, & - input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) + call state_setexport_1d(exportState, Flrl_rofgwl, waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ice sent individually to coupler - call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofi', bounds, & - input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) + call state_setexport_1d(exportState, Flrl_rofi, waterlnd2atmbulk_inst%qflx_rofice_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! irrigation flux to be removed from main channel storage (negative) - call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_irrig', bounds, & - input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) + call state_setexport_1d(exportState, Flrl_irrig, waterlnd2atmbulk_inst%qirrig_grc(begg:), & + minus = .true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine export_fields !=============================================================================== + subroutine state_getimport_1d(state, fldname, ctsmdata, rc) - subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, rc) + ! fill in ctsm import data for 1d field - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fb - character(len=*) , intent(in) :: fldname - type(bounds_type) , intent(in) :: bounds - real(r8) , intent(out) :: output(bounds%begg:bounds%endg) - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: ctsmdata(:) + integer , intent(out) :: rc ! local variables - integer :: g, i,n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - character(len=cs) :: cvalue - character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - - if (masterproc .and. debug > 0) then - write(iulog,F01)' Show me what is in the state? for '//trim(fldname) - call ESMF_StatePrint(state, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Get the pointer to data in the field - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Fill in output array - if (present(ungridded_index)) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(ungridded_index,n) - end do - else - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr1d(n) - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) - end if - end do - end if - - ! Write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) - end do - end if - - ! Check for nans - call check_for_nans(output, trim(fldname), bounds%begg) + call state_getfldptr(State, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = 1,size(ctsmdata) + ctsmdata(g) = fldptr1d(g) + end do + call check_for_nans(ctsmdata, trim(fldname), 1) - end subroutine state_getimport + end subroutine state_getimport_1d !=============================================================================== + subroutine state_setexport_1d(state, fldname, ctsmdata, minus, rc) - subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_index, rc) + ! fill in ctsm export data for 1d field - ! ---------------------------------------------- - ! Map input array to export state field - ! ---------------------------------------------- + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fb - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: input(bounds%begg:bounds%endg) - logical, optional , intent(in) :: minus - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: ctsmdata(:) + logical, optional, intent(in) :: minus + integer , intent(out):: rc ! local variables - logical :: l_minus ! local version of minus - integer :: g, i, n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - character(len=cs) :: cvalue - character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_export_export:state_setexport_1d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - - l_minus = .false. + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 if (present(minus)) then - l_minus = minus - end if - - ! get field pointer - if (present(ungridded_index)) then - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! determine output array - if (present(ungridded_index)) then - fldptr2d(ungridded_index,:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - if (l_minus) then - fldptr2d(ungridded_index,n) = -input(g) - else - fldptr2d(ungridded_index,n) = input(g) - end if + do g = 1,size(ctsmdata) + fldptr1d(g) = -ctsmdata(g) end do else - fldptr1d(:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - if (l_minus) then - fldptr1d(n) = -input(g) - else - fldptr1d(n) = input(g) - end if - end do - end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 5) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + do g = 1,size(ctsmdata) + fldptr1d(g) = ctsmdata(g) end do end if + call check_for_nans(ctsmdata, trim(fldname), 1) - ! check for nans - call check_for_nans(input, trim(fldname), bounds%begg) - - end subroutine state_setexport + end subroutine state_setexport_1d !=============================================================================== - - subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) + subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! ---------------------------------------------- ! Get pointer to a state field ! ---------------------------------------------- + use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + ! input/output variables type(ESMF_State), intent(in) :: State - character(len=*), intent(in) :: fb character(len=*), intent(in) :: fldname real(R8), pointer, optional , intent(out) :: fldptr1d(:) real(R8), pointer, optional , intent(out) :: fldptr2d(:,:) @@ -670,58 +557,44 @@ subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) ! local variables type(ESMF_FieldStatus_Flag) :: status type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements - type(ESMF_FieldBundle) :: fieldBundle character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- rc = ESMF_SUCCESS - ! Get the fieldbundle from the state... - call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in state") - - ! Get the field from the field bundle - call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Get the status of the field - call ESMF_FieldGet(lfield, status=status, rc=rc) + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + end subroutine state_getfldptr - ! Get the data from the field - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc .and. debug > 0) then - write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' - end if - else if (present(fldptr2d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") - end if - endif ! status + !=============================================================================== + logical function fldchk(state, fldname) + ! ---------------------------------------------- + ! Determine if field with fldname is in the input state + ! ---------------------------------------------- - end subroutine state_getfldptr + ! input/output variables + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: fldname + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + ! ---------------------------------------------- + call ESMF_StateGet(state, trim(fldname), itemFlag) + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + fldchk = .true. + else + fldchk = .false. + endif + end function fldchk end module lnd_import_export diff --git a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 b/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 deleted file mode 100644 index f3be6085e9..0000000000 --- a/src/cpl/nuopc/lnd_set_decomp_and_domain.F90 +++ /dev/null @@ -1,700 +0,0 @@ -module lnd_set_decomp_and_domain - - use ESMF - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use spmdMod , only : masterproc - use clm_varctl , only : iulog - - implicit none - private ! except - - ! Module public routines - public :: lnd_set_decomp_and_domain_from_readmesh - public :: lnd_set_decomp_and_domain_from_newmesh - - ! Module private routines - private :: lnd_get_global_dims - private :: lnd_get_lndmask_from_ocnmesh - private :: lnd_get_lndmask_from_lndmesh - private :: lnd_set_ldomain_gridinfo - private :: nc_check_err - private :: chkerr - - character(len=*) , parameter :: u_FILE_u = & - __FILE__ - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, ni, nj, rc) - - use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D - use domainMod , only : ldomain, domain_init - use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use clm_varpar , only : nlevsoi - use clm_varctl , only : fatmlndfrc, fsurdat - use clm_varctl , only : use_soil_moisture_streams, single_column - ! - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - use fileutils , only : getfil - - ! input/output variables - character(len=*) , intent(in) :: mode ! lilac or nuopc mode - type(ESMF_VM) , intent(in) :: vm - character(len=*) , intent(in) :: meshfile_lnd - character(len=*) , intent(in) :: meshfile_ocn - type(ESMF_Mesh) , intent(out) :: mesh_ctsm - integer , intent(out) :: ni,nj ! global grid dimensions - integer , intent(out) :: rc - - ! local variables - type(ESMF_Mesh) :: mesh_ocninput - type(ESMF_Mesh) :: mesh_lndinput - type(ESMF_DistGrid) :: distgrid_ctsm - character(CL) :: cvalue ! config data - integer :: nlnd, nocn ! local size of arrays - integer :: g,n ! indices - type(bounds_type) :: bounds ! bounds - integer :: begg,endg - integer , pointer :: gindex_lnd(:) ! global index space for just land points - integer , pointer :: gindex_ocn(:) ! global index space for just ocean points - integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points - integer , pointer :: gindex_input(:) ! global index space for land and ocean points - integer , pointer :: lndmask_glob(:) - real(r8) , pointer :: lndfrac_glob(:) - integer :: lsize_input - integer :: gsize - logical :: isgrid2d - character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - logical :: readvar ! read variable in or not - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Determine global 2d sizes from read of dimensions of surface dataset - call lnd_get_global_dims(ni, nj, gsize, isgrid2d) - - ! Allocate global memory for land mask and land fraction - allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 - allocate(lndfrac_glob(gsize)); lndfrac_glob(:) = 0._r8 - - ! read in the land mesh from the file - mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) - end if - - ! Set global land fraction and global land mask across all processors - if (trim(meshfile_ocn) /= 'null') then - ! read in ocn mask meshfile - mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) - end if - - ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then - ! Read in global land mask and land fraction from fatmlndfrc - call getfil( trim(fatmlndfrc), locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 - call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - call ncd_pio_closefile(ncid) - else - ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call lnd_get_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - ! Determine lnd decomposition that will be used by ctsm - call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) - if (use_soil_moisture_streams) then - call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) - end if - - ! Determine ocn decomposition that will be used to create the full mesh - ! note that the memory for gindex_ocn will be allocated in the following call - ! but deallocated at the end of this routine - call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) - - ! Get JUST gridcell processor bounds - ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp - ! so get_proc_bounds is called twice and the gridcell information is just filled in twice - call get_proc_bounds(bounds) - begg = bounds%begg - endg = bounds%endg - - ! Create ctsm gindex_lnd - nlnd = endg - begg + 1 - allocate(gindex_lnd(nlnd)) - do g = begg, endg - n = 1 + (g - begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - ! Initialize domain data structure - call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine ldomain%mask and ldomain%frac using ctsm decomposition - do g = begg, endg - n = 1 + (g - begg) - ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) - ldomain%frac(g) = lndfrac_glob(gindex_lnd(n)) - end do - deallocate(lndmask_glob) - deallocate(lndfrac_glob) - - ! Generate a ctsm global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex_ctsm(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex_ctsm(n) = gindex_lnd(n) - else - gindex_ctsm(n) = gindex_ocn(n-nlnd) - end if - end do - - ! Generate a new mesh on the gindex decomposition - distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Get ldomain%lonc, ldomain%latc and ldomain%area and optionally - ! lon1d and lat1d if isgrid2d - call lnd_set_ldomain_gridinfo(mesh_ctsm, vm, gindex_ctsm, bounds, isgrid2d, ni, nj, ldomain, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Deallocate memory - deallocate(gindex_lnd) - deallocate(gindex_ocn) - deallocate(gindex_ctsm) - - end subroutine lnd_set_decomp_and_domain_from_readmesh - - !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) - - ! Generate a new mesh from the input domain file and set the mask to 1 - - use decompInitMod , only : decompInit_lnd, decompInit_lnd3D - use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use domainMod , only : ldomain, domain_init - use clm_varctl , only : use_soil_moisture_streams, single_column - use clm_varpar , only : nlevsoi - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror - use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var - use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable - - ! input/output variables - character(len=CL) , intent(in) :: domain_file - type(ESMF_Mesh) , intent(out) :: mesh - integer , intent(out) :: ni,nj ! global grid dimensions - integer , intent(out) :: rc - - ! local variables - logical :: isgrid2d - integer :: g,n - integer :: nv - integer :: ncid, ierr - integer :: dimid_ni, dimid_nj, dimid_nv - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - type(ESMF_Grid) :: lgrid - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) - integer :: varid_xv, varid_yv - integer :: numownedelements - integer, allocatable :: lnd_mask(:) - type(bounds_type) :: bounds ! bounds - integer :: begg,endg - integer :: nlnd - integer, pointer :: gindex_lnd(:) ! global index space for just land points - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! open file - ierr = nf90_open(domain_file, NF90_NOWRITE, ncid) - call nc_check_err(ierr, 'nf90_open', trim(domain_file)) - ! get dimension ids - ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) - call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(domain_file)) - ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) - call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(domain_file)) - ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) - call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(domain_file)) - ! get dimension values - ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) - call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(domain_file)) - ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) - call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(domain_file)) - ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) - call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(domain_file)) - ! get variable ids - ierr = nf90_inq_varid(ncid, 'xv', varid_xv) - call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(domain_file)) - ierr = nf90_inq_varid(ncid, 'yv', varid_yv) - call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(domain_file)) - ! allocate memory for variables and get variable values - allocate(xv(nv,ni,nj), yv(nv,ni,nj)) - ierr = nf90_get_var(ncid, varid_xv, xv) - call nc_check_err(ierr, 'nf90_get_var for xv', trim(domain_file)) - ierr = nf90_get_var(ncid, varid_yv, yv) - call nc_check_err(ierr, 'nf90_get_var for yv', trim(domain_file)) - ! close file - ierr = nf90_close(ncid) - call nc_check_err(ierr, 'nf90_close', trim(domain_file)) - ! create the grid - maxIndex(1) = ni ! number of lons - maxIndex(2) = nj ! number of lats - mincornerCoord(1) = xv(1,1,1) ! min lon - mincornerCoord(2) = yv(1,1,1) ! min lat - maxcornerCoord(1) = xv(3,ni,nj) ! max lon - maxcornerCoord(2) = yv(3,ni,nj) ! max lat - deallocate(xv,yv) - lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & - mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & - staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create the mesh from the grid - mesh = ESMF_MeshCreate(lgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set the mesh mask to 1 - call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lnd_mask(numownedelements)) - lnd_mask(:) = 1 - call ESMF_MeshSet(mesh, elementMask=lnd_mask, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ldecomp and ldomain - call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) - if (use_soil_moisture_streams) then - call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) - end if - - ! Initialize processor bounds - call get_proc_bounds(bounds) - begg = bounds%begg - endg = bounds%endg - - ! Create ctsm gindex_lnd - nlnd = endg - begg + 1 - allocate(gindex_lnd(nlnd)) - do g = begg, endg - n = 1 + (g - begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - ! Initialize domain data structure - isgrid2d = .true. - call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine ldomain%mask and ldomain%frac - do g = begg, endg - ldomain%mask(g) = 1 - ldomain%frac(g) = 1._r8 - end do - deallocate(lnd_mask) - - end subroutine lnd_set_decomp_and_domain_from_newmesh - - !=============================================================================== - subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) - - ! Determine global 2d sizes from read of dimensions of surface dataset - - use clm_varctl , only : fsurdat, single_column - use fileutils , only : getfil - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - - ! input/output variables - integer, intent(out) :: ni - integer, intent(out) :: nj - integer, intent(out) :: gsize - logical, intent(out) :: isgrid2d - - ! local variables - character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - logical :: readvar ! read variable in or not - !------------------------------------------------------------------------------- - - if (masterproc) then - write(iulog,*) 'Attempting to global dimensions from surface dataset' - if (fsurdat == ' ') then - write(iulog,*)'fsurdat must be specified' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - endif - call getfil(fsurdat, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') - call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') - call ncd_pio_closefile(ncid) - gsize = ni*nj - if (single_column) then - isgrid2d = .true. - else if (nj == 1) then - isgrid2d = .false. - else - isgrid2d = .true. - end if - if (masterproc) then - write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj - if (isgrid2d) then - write(iulog,'(a)') 'model grid is 2-dimensional' - else - write(iulog,'(a)') 'model grid is not 2-dimensional' - end if - end if - - end subroutine lnd_get_global_dims - - !=============================================================================== - subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_glob, lndfrac_glob, rc) - - ! input/out variables - type(ESMF_Mesh) , intent(in) :: mesh_lnd - type(ESMF_Mesh) , intent(in) :: mesh_ocn - type(ESMF_VM) , intent(in) :: vm - integer , intent(in) :: gsize - integer , pointer :: lndmask_glob(:) - real(r8) , pointer :: lndfrac_glob(:) - integer , intent(out) :: rc - - ! local variables: - type(ESMF_DistGrid) :: distgrid_lnd - type(ESMF_RouteHandle) :: rhandle_ocn2lnd - type(ESMF_Field) :: field_lnd - type(ESMF_Field) :: field_ocn - type(ESMF_DistGrid) :: distgrid_ocn - integer , pointer :: gindex_input(:) ! global index space for land and ocean points - integer , pointer :: lndmask_loc(:) - integer , pointer :: itemp_glob(:) - real(r8) , pointer :: rtemp_glob(:) - real(r8) , pointer :: lndfrac_loc(:) - real(r8) , pointer :: ocnmask_loc(:) ! on ocean mesh - real(r8) , pointer :: ocnfrac_loc(:) ! on land mesh - real(r8) , pointer :: dataptr1d(:) - type(ESMF_Array) :: elemMaskArray - integer :: lsize_lnd - integer :: lsize_ocn - integer :: n, spatialDim - integer :: srcMaskValue = 0 - integer :: dstMaskValue = -987987 ! spval for RH mask values - integer :: srcTermProcessing_Value = 0 - real(r8) :: fminval = 0.001_r8 - real(r8) :: fmaxval = 1._r8 - logical :: checkflag = .false. - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, numOwnedElements=lsize_lnd, & - elementDistGrid=distgrid_lnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(lndmask_loc(lsize_lnd)) - allocate(lndfrac_loc(lsize_lnd)) - - ! create fields on land and ocean meshes - field_lnd = ESMF_FieldCreate(mesh_lnd, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - field_ocn = ESMF_FieldCreate(mesh_ocn, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create route handle to map ocean mask from ocn mesh to land mesh - call ESMF_FieldRegridStore(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & - srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! fill in values for field_ocn with mask on ocn mesh - call ESMF_MeshGet(mesh_ocn, elementdistGrid=distgrid_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_ocn, localDe=0, elementCount=lsize_ocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ocnmask_loc(lsize_ocn)) - elemMaskArray = ESMF_ArrayCreate(distgrid_ocn, ocnmask_loc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh_ocn, elemMaskArray=elemMaskArray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_ocn, farrayptr=dataptr1d, rc=rc) - dataptr1d(:) = ocnmask_loc(:) - - ! map ocn mask to land mesh - call ESMF_FieldRegrid(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ocnfrac_loc(lsize_lnd)) - call ESMF_FieldGet(field_lnd, farrayptr=ocnfrac_loc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,lsize_lnd - lndfrac_loc(n) = 1._r8 - ocnfrac_loc(n) - if (lndfrac_loc(n) > fmaxval) lndfrac_loc(n) = 1._r8 - if (lndfrac_loc(n) < fminval) lndfrac_loc(n) = 0._r8 - if (lndfrac_loc(n) /= 0._r8) then - lndmask_loc(n) = 1 - else - lndmask_loc(n) = 0 - end if - enddo - call ESMF_FieldDestroy(field_lnd) - call ESMF_FieldDestroy(field_ocn) - - ! determine global landmask_glob - needed to determine the ctsm decomposition - ! land frac, lats, lons and areas will be done below - allocate(gindex_input(lsize_lnd)) - call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex_input, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,lsize_lnd - lndmask_glob(gindex_input(n)) = lndmask_loc(n) - end do - allocate(itemp_glob(gsize)) - call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndmask_glob(:) = int(itemp_glob(:)) - deallocate(itemp_glob) - - ! Determine ldomain%frac using both input and ctsm decompositions - ! lndfrac_glob is filled using the input decomposition and - ! ldomin%frac is set using the ctsm decomposition - allocate(rtemp_glob(gsize)) - do n = 1,lsize_lnd - lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) - end do - call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndfrac_glob(:) = rtemp_glob(:) - deallocate(rtemp_glob) - - ! deallocate memory - deallocate(ocnmask_loc) - deallocate(lndmask_loc) - deallocate(lndfrac_loc) - - end subroutine lnd_get_lndmask_from_ocnmesh - - !=============================================================================== - subroutine lnd_get_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) - - ! input/out variables - type(ESMF_Mesh) , intent(in) :: mesh_lnd - type(ESMF_VM) , intent(in) :: vm - integer , intent(in) :: gsize - integer , pointer :: lndmask_glob(:) - real(r8) , pointer :: lndfrac_glob(:) - integer , intent(out) :: rc - - ! local variables: - integer :: n - integer :: lsize - integer , pointer :: gindex(:) - integer , pointer :: lndmask_loc(:) - integer , pointer :: itemp_glob(:) - type(ESMF_DistGrid) :: distgrid - type(ESMF_Array) :: elemMaskArray - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Determine lsize and distgrid_lnd - call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDe=0, elementCount=lsize, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine lndmask_loc - ! The call to ESMF_MeshGet fills in the values of lndmask_loc - allocate(lndmask_loc(lsize)) - elemMaskArray = ESMF_ArrayCreate(distgrid, lndmask_loc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh_lnd, elemMaskArray=elemMaskArray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine global landmask_glob - needed to determine the ctsm decomposition - ! land frac, lats, lons and areas will be done below - allocate(gindex(lsize)) - allocate(itemp_glob(gsize)) - call ESMF_DistGridGet(distgrid, 0, seqIndexList=gindex, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,lsize - lndmask_glob(gindex(n)) = lndmask_loc(n) - end do - call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - lndmask_glob(:) = int(itemp_glob(:)) - deallocate(itemp_glob) - deallocate(gindex) - deallocate(lndmask_loc) - - ! ASSUME that land fraction is identical to land mask in this case - lndfrac_glob(:) = lndmask_glob(:) - - end subroutine lnd_get_lndmask_from_lndmesh - - !=============================================================================== - subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, ldomain, rc) - - use domainMod , only : domain_type, lon1d, lat1d - use decompMod , only : bounds_type, get_proc_bounds - use clm_varcon , only : re - - ! input/output variables - type(ESMF_Mesh) , intent(in) :: mesh - type(ESMF_VM) , intent(in) :: vm - integer , intent(in) :: gindex(:) - type(bounds_type) , intent(in) :: bounds - logical , intent(in) :: isgrid2d - integer , intent(in) :: ni,nj - type(domain_type) , intent(inout) :: ldomain - integer , intent(out) :: rc - - ! local variables - integer :: g,n - integer :: gsize - integer :: begg,endg - integer :: numownedelements - real(r8) , pointer :: lndlats_glob(:) - real(r8) , pointer :: lndlons_glob(:) - real(r8) , pointer :: rtemp_glob(:) - real(r8) , pointer :: ownedElemCoords(:) - integer :: spatialDim - real(r8) , pointer :: dataptr1d(:) - type(ESMF_Field) :: areaField - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - begg = bounds%begg - endg = bounds%endg - - ! Determine ldoman%latc and ldomain%lonc - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg,endg - n = g - begg + 1 - ldomain%lonc(g) = ownedElemCoords(2*n-1) - if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? - ldomain%latc(g) = ownedElemCoords(2*n) - end do - - ! Create ldomain%area by querying the mesh on the ctsm decomposition - areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(areaField, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg, endg - ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) - end do - call ESMF_FieldDestroy(areaField) - - ! If grid is 2d, determine lon1d and lat1d - if (isgrid2d) then - gsize = ni*nj - allocate(rtemp_glob(gsize)) - - ! Determine lon1d - allocate(lndlons_glob(gsize)) - lndlons_glob(:) = 0._r8 - do n = 1,numownedelements - if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? - lndlons_glob(gindex(n)) = 0._r8 - else - lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) - end if - end do - call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - deallocate(lndlons_glob) - allocate(lon1d(ni)) - do n = 1,ni - lon1d(n) = rtemp_glob(n) - end do - - ! Determine lat1d - allocate(lndlats_glob(gsize)) - lndlats_glob(:) = 0._r8 - do n = 1,numownedelements - lndlats_glob(gindex(n)) = ownedElemCoords(2*n) - end do - call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - deallocate(lndlats_glob) - allocate(lat1d(nj)) - do n = 1,nj - lat1d(n) = rtemp_glob((n-1)*ni + 1) - end do - deallocate(rtemp_glob) - end if - - end subroutine lnd_set_ldomain_gridinfo - - !=============================================================================== - subroutine nc_check_err(ierror, description, filename) - - use shr_sys_mod , only : shr_sys_abort - use netcdf , only : nf90_noerr, nf90_strerror - - integer , intent(in) :: ierror - character(*), intent(in) :: description - character(*), intent(in) :: filename - - if (ierror /= nf90_noerr) then - write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& - '". Error message:', trim(nf90_strerror(ierror)) - call shr_sys_abort() - endif - end subroutine nc_check_err - - !=============================================================================== - logical function chkerr(rc, line, file) - integer , intent(in) :: rc - integer , intent(in) :: line - character(len=*) , intent(in) :: file - - integer :: lrc - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif - end function chkerr - -end module lnd_set_decomp_and_domain diff --git a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 similarity index 94% rename from src/cpl/lilac/lnd_set_decomp_and_domain.F90 rename to src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index f3be6085e9..1cc0ee4ce1 100644 --- a/src/cpl/lilac/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -94,28 +94,29 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf end if ! Set global land fraction and global land mask across all processors - if (trim(meshfile_ocn) /= 'null') then - ! read in ocn mask meshfile - mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) - end if - - ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then + ! Note that is just for backwards compatibility + ! Read in global land mask and land fraction from fatmlndfrc + call getfil( trim(fatmlndfrc), locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 + call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + call ncd_pio_closefile(ncid) else - if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then - ! Read in global land mask and land fraction from fatmlndfrc - call getfil( trim(fatmlndfrc), locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 - call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - call ncd_pio_closefile(ncid) + if (trim(meshfile_ocn) /= 'null') then + ! read in ocn mask meshfile + mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc) then + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + end if + + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! obtain land mask from land mesh file - assume that land frac is identical to land mask call lnd_get_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) From df3748fff4bd7e942c5a02579baa6181a6ebab07 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 Dec 2020 20:47:02 -0700 Subject: [PATCH 058/219] reverted changes to lnd_import_export --- src/cpl/lilac/lnd_comp_esmf.F90 | 13 +- src/cpl/lilac/lnd_import_export.F90 | 583 +++++++++++++++++----------- 2 files changed, 352 insertions(+), 244 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index d038170baf..05613e23a1 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -39,7 +39,7 @@ module lnd_comp_esmf use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose - use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_meshinfo + use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_readmesh implicit none private ! By default make data private except @@ -341,7 +341,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_meshinfo(mode='lilac', vm=vm, & + call lnd_set_decomp_and_domain_from_readmesh(mode='lilac', vm=vm, & meshfile_lnd=lnd_mesh_filename, meshfile_ocn='null', mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -815,15 +815,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! diagnostics !-------------------------------- - !if (dbug > 1) then - ! call State_diagnose(exportState,subname//':ES',rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (masterproc) then - ! call log_clock_advance(clock, 'CTSM', iulog, rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! end if - !end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) #if (defined _MEMTRACE) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 95c5d6426f..951b9f239d 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -27,80 +27,13 @@ module lnd_import_export private :: state_setexport private :: state_getfldptr - ! import fields - character(*), parameter :: Sa_z = 'Sa_z' - character(*), parameter :: Sa_topo = 'Sa_topo' - character(*), parameter :: Sa_u = 'Sa_u' - character(*), parameter :: Sa_v = 'Sa_v' - character(*), parameter :: Sa_ptem = 'Sa_ptem' - character(*), parameter :: Sa_shum = 'Sa_shum' - character(*), parameter :: Sa_pbot = 'Sa_pbot' - character(*), parameter :: Sa_tbot = 'Sa_tbot' - character(*), parameter :: Sa_methane = 'Sa_methane' - character(*), parameter :: Faxa_rainc = 'Faxa_rainc' - character(*), parameter :: Faxa_rainl = 'Faxa_rainl' - character(*), parameter :: Faxa_snowc = 'Faxa_snowc' - character(*), parameter :: Faxa_snowl = 'Faxa_snowl' - character(*), parameter :: Faxa_lwdn = 'Faxa_lwdn' - character(*), parameter :: Faxa_swvdr = 'Faxa_swvdr' - character(*), parameter :: Faxa_swndr = 'Faxa_swndr' - character(*), parameter :: Faxa_swvdf = 'Faxa_swvdf' - character(*), parameter :: Faxa_swndf = 'Faxa_swndf' - character(*), parameter :: Faxa_bcphidry = 'Faxa_bcphidry' - character(*), parameter :: Faxa_bcphodry = 'Faxa_bcphodry' - character(*), parameter :: Faxa_bcphiwet = 'Faxa_bcphiwet' - character(*), parameter :: Faxa_ocphidry = 'Faxa_ocphidry' - character(*), parameter :: Faxa_ocphodry = 'Faxa_ocphodry' - character(*), parameter :: Faxa_ocphiwet = 'Faxa_ocphiwet' - character(*), parameter :: Faxa_dstwet1 = 'Faxa_dstwet1' - character(*), parameter :: Faxa_dstwet2 = 'Faxa_dstwet2' - character(*), parameter :: Faxa_dstwet3 = 'Faxa_dstwet3' - character(*), parameter :: Faxa_dstwet4 = 'Faxa_dstwet4' - character(*), parameter :: Faxa_dstdry1 = 'Faxa_dstdry1' - character(*), parameter :: Faxa_dstdry2 = 'Faxa_dstdry2' - character(*), parameter :: Faxa_dstdry3 = 'Faxa_dstdry3' - character(*), parameter :: Faxa_dstdry3 = 'Faxa_dstdry4' - character(*), parameter :: Faxa_ndep = 'Faxa_ndep' - - ! export fields - character(*), parameter :: Sl_t = 'Sl_t' - character(*), parameter :: Sl_snowh = 'Sl_snowh' - character(*), parameter :: Sl_avsdr = 'Sl_avsdr' - character(*), parameter :: Sl_anidr = 'Sl_anidr' - character(*), parameter :: Sl_avsdf = 'Sl_avsdf' - character(*), parameter :: Sl_anidf = 'Sl_anidf' - character(*), parameter :: Sl_tref = 'Sl_tref' - character(*), parameter :: Sl_qref = 'Sl_qref' - character(*), parameter :: Sl_u10 = 'Sl_u10' - character(*), parameter :: Sl_ram1 = 'Sl_ram1' - character(*), parameter :: Sl_fv = 'Sl_fv' - character(*), parameter :: Sl_z0m = 'Sl_z0m' - character(*), parameter :: Sl_soilw = 'Sl_soilw' - character(*), parameter :: Sl_ddvel = 'Sl_ddvel' - character(*), parameter :: Sl_fztop = 'Sl_fztop' - character(*), parameter :: Fall_taux = 'Fall_taux' - character(*), parameter :: Fall_tauy = 'Fall_tauy' - character(*), parameter :: Fall_lat = 'Fall_lat' - character(*), parameter :: Fall_sen = 'Fall_sen' - character(*), parameter :: Fall_lwup = 'Fall_lwup' - character(*), parameter :: Fall_evap = 'Fall_evap' - character(*), parameter :: Fall_swnet = 'Fall_swnet' - character(*), parameter :: Fall_flxdst = 'Fall_flxdst' - character(*), parameter :: Fall_methane = 'Fall_methane' - character(*), parameter :: Fall_voc = 'Fall_voc' - character(*), parameter :: Fall_fire = 'Fall_fire' - character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' - character(*), parameter :: Flrl_rofsub = 'Flrl_rofsub' - character(*), parameter :: Flrl_rofgwl = 'Flrl_rofgwl' - character(*), parameter :: Flrl_rofi = 'Flrl_rofi' - character(*), parameter :: Flrl_irrig = 'Flrl_irrig' - ! from atm->lnd integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn ! from lnd->atm integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm integer :: emis_nflds ! number of fire emission fields from lnd-> atm + integer, parameter :: debug = 0 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" @@ -141,7 +74,6 @@ subroutine import_fields( importState, bounds, first_call, rc) !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Set bounds begg = bounds%begg; endg=bounds%endg @@ -167,80 +99,129 @@ subroutine import_fields( importState, bounds, first_call, rc) ! Required atmosphere input fields !-------------------------- - call state_getimport_1d(importState, Sa_z , atm2lnd_inst%forc_hgt_grc(begg:), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Sa_z', bounds, & + output=atm2lnd_inst%forc_hgt_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_topo , atm2lnd_inst%forc_topo_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_topo', bounds, & + output=atm2lnd_inst%forc_topo_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_u , atm2lnd_inst%forc_u_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_u', bounds, & + output=atm2lnd_inst%forc_u_grc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_v , atm2lnd_inst%forc_v_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_v', bounds, & + output=atm2lnd_inst%forc_v_grc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_shum , wateratm2lndbulk_inst%forc_q_not_downscaled_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_ptem', bounds, & + output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_ptem , atm2lnd_inst%forc_th_not_downscaled_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_shum', bounds, & + output=water_inst%wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_pbot , atm2lnd_inst%forc_pbot_not_downscaled_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_pbot', bounds, & + output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Sa_tbot , atm2lnd_inst%forc_t_not_downscaled_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Sa_tbot', bounds, & + output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_rainc, forc_rainc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainc', bounds, & + output=forc_rainc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_rainl, forc_rainl(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_rainl', bounds, & + output=forc_rainl, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_snowc, forc_snowc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowc', bounds, & + output=forc_snowc, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_snowl, forc_snowl(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_snowl', bounds, & + output=forc_snowl, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_lwdn , atm2lnd_inst%forc_lwrad_not_downscaled_grc(begg:), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_lwdn', bounds, & + output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_swvdr, atm2lnd_inst%forc_solad_grc(begg:,1), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_swndr, atm2lnd_inst%forc_solad_grc(begg:,2), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndr', bounds, & + output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_swvdf, atm2lnd_inst%forc_solai_grc(begg:,1), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swvdf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_swndf, atm2lnd_inst%forc_solai_grc(begg:,2), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_swndf', bounds, & + output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ! Atmosphere prognostic/prescribed aerosol fields - call state_getimport_1d(importState, Faxa_bcphidry, atm2lnd_inst%forc_aer_grc(begg:,1), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_bcphodry, atm2lnd_inst%forc_aer_grc(begg:,2), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_bcphiwet, atm2lnd_inst%forc_aer_grc(begg:,3), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_bcphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,3), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_ocphidry, atm2lnd_inst%forc_aer_grc(begg:,4), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphidry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,4), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_ocphodry, atm2lnd_inst%forc_aer_grc(begg:,5), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphodry', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,5), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_ocphiwet, atm2lnd_inst%forc_aer_grc(begg:,6), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_ocphiwet', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,6), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstwet1, output=atm2lnd_inst%forc_aer_grc(begg:,7), rc=rc) + + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,7), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstwet2, output=atm2lnd_inst%forc_aer_grc(begg:,9), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry1', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,8), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstwet3, output=atm2lnd_inst%forc_aer_grc(begg:,11), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,9), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstwet4, output=atm2lnd_inst%forc_aer_grc(begg:,13), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry2', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,10), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport_1d(importState, Faxa_dstdry1, output=atm2lnd_inst%forc_aer_grc(begg:,8), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,11), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstdry2, output=atm2lnd_inst%forc_aer_grc(begg:,10), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry3', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,12), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstdry3, output=atm2lnd_inst%forc_aer_grc(begg:,12), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstwet4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,13), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport_1d(importState, Faxa_dstdry4, output=atm2lnd_inst%forc_aer_grc(begg:,14), rc=rc) + call state_getimport(importState, 'c2l_fb_atm', 'Faxa_dstdry4', bounds, & + output=atm2lnd_inst%forc_aer_grc(:,14), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call state_getimport_1d(importState, Sa_methane, atm2lnd_inst%forc_pch4_grc(begg:), rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'c2l_fb_atm', 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! The lilac is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec ! so the following conversion needs to happen - ! call state_getimport_1d(importState, Faxa_nhx, output=forc_nhx(begg:), rc=rc) + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_nhx', bounds, output=forc_nhx, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getimport_1d(importState, Faxa_nhy, output=forc_nhy(begg:), rc=rc) + ! call state_getimport(importState, 'c2l_fb_atm', 'Faxa_noy', bounds, output=forc_noy, rc=rc ) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do g = begg,endg ! atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 @@ -333,102 +314,139 @@ subroutine export_fields(exportState, bounds, rc) ! local variables integer :: i, g, num - integer :: begg, endg real(r8) :: array(bounds%begg:bounds%endg) - character(len=CS) :: cnum character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - begg = bounds%begg - endg = bounds%endg - ! ----------------------- ! output to atm ! ----------------------- - call state_setexport_1d(exportState, Sl_t , lnd2atm_inst%t_rad_grc(begg:), rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_t', bounds, & + input=lnd2atm_inst%t_rad_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_snowh , waterlnd2atmbulk_inst%h2osno_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_snowh', bounds, & + input=water_inst%waterlnd2atmbulk_inst%h2osno_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_avsdr , lnd2atm_inst%albd_grc(begg:,1), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_anidr , lnd2atm_inst%albd_grc(begg:,2), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidr', bounds, & + input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_avsdf , lnd2atm_inst%albi_grc(begg:,1), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_avsdf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_anidf , lnd2atm_inst%albi_grc(begg:,2), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_anidf', bounds, & + input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_tref , lnd2atm_inst%t_ref2m_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_tref', bounds, & + input=lnd2atm_inst%t_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_qref , waterlnd2atmbulk_inst%q_ref2m_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_qref', bounds, & + input=water_inst%waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_u10 , lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_u10', bounds, & + input=lnd2atm_inst%u_ref10m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_taux , lnd2atm_inst%taux_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_taux', bounds, & + input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_tauy , lnd2atm_inst%tauy_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_tauy', bounds, & + input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_lat , lnd2atm_inst%eflx_lh_tot_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lat', bounds, & + input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_sen , lnd2atm_inst%eflx_sh_tot_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_sen', bounds, & + input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_lwup , lnd2atm_inst%eflx_lwrad_out_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_lwup', bounds, & + input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_evap , waterlnd2atmbulk_inst%qflx_evap_tot_grc(begg:), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_evap', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_swnet , lnd2atm_inst%fsa_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_swnet', bounds, & + input=lnd2atm_inst%fsa_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_flxdst1 , lnd2atm_inst%flxdst_grc(begg:,1), minus=.true., rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst1', bounds, & + input=lnd2atm_inst%flxdst_grc(:,1), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_flxdst2 , lnd2atm_inst%flxdst_grc(begg:,2), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst2', bounds, & + input=lnd2atm_inst%flxdst_grc(:,2), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_flxdst3 , lnd2atm_inst%flxdst_grc(begg:,3), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst3', bounds, & + input=lnd2atm_inst%flxdst_grc(:,3), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Fall_flxdst4 , lnd2atm_inst%flxdst_grc(begg:,4), minus=.true., rc=rc) + call state_setexport(exportState, 'l2c_fb_atm', 'Fall_flxdst4', bounds, & + input=lnd2atm_inst%flxdst_grc(:,4), minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_ram1 , lnd2atm_inst%ram1_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ram1', bounds, & + input=lnd2atm_inst%ram1_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_fv , lnd2atm_inst%fv_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fv', bounds, & + input=lnd2atm_inst%fv_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport_1d(exportState, Sl_z0m , lnd2atm_inst%z0m_grc(begg:), rc=rc) + + call state_setexport(exportState, 'l2c_fb_atm', 'Sl_z0m', bounds, & + input=lnd2atm_inst%z0m_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! methane - ! call state_setexport_1d(exportState, Fall_methane , lnd2atm_inst%flux_ch4_grc(begg:), minus=.true., rc=rc) + ! methanem + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_methane', bounds, & + ! input=lnd2atm_inst%flux_ch4_grc, minus=.true., rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! soil water - ! call state_setexport_1d(exportState, Sl_soilw , water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(begg:,1), rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_soilw', bounds, & + ! input=water_inst%waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! dry dep velocities ! do num = 1, drydep_nflds - ! write(cnum,'(i0)') num - ! call state_setexport_1d(exportState, trim(Sl_ddvel)//trim(cnum), & - ! lnd2atm_inst%ddvel_grc(begg:,num), rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_ddvel', bounds, & + ! input=lnd2atm_inst%ddvel_grc(:,num), ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! MEGAN VOC emis fluxes ! do num = 1, shr_megan_mechcomps_n - ! write(cnum,'(i0)') num - ! call state_setexport_1d(exportState, trim(Fall_voc)//trim(cnum), & - ! lnd2atm_inst%flxvoc_grc(begg:,num), minus=.true., rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_voc', bounds, & + ! input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., ungridded_index=num, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end do ! fire emis fluxes ! do num = 1, emis_nflds - ! write(cnum,'(i0)') num - ! call state_setexport_2d(exportState, trim(Fall_fire)//trim(cnum), lnd2atm_inst%fireflx_grc(begg:,num), & - ! minus = .true., rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_setexport(exportState, 'l2c_fb_atm', 'Fall_fire', bounds, & + ! input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., ungridded_index=num, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! end do ! if (emis_nflds > 0) then - ! call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) + ! call state_setexport(exportState, 'l2c_fb_atm', 'Sl_fztopo', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! end if - + ! endif ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. ! i.e. water sent from land to rof is positive @@ -437,118 +455,217 @@ subroutine export_fields(exportState, bounds, rc) ! ----------------------- ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = begg,endg + ! do g = bounds%begg,bounds%endg ! array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & ! water_inst%waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) ! end do - call state_setexport_1d(exportState, Flrl_rofsur, waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(begg:), rc=rc) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsur', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - do g = begg,endg + do g = bounds%begg,bounds%endg array(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) end do - call state_setexport_1d(exportState, Flrl_rofsub, array(begg:), rc=rc) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofsub', bounds, & + input=array, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! qgwl sent individually to coupler - call state_setexport_1d(exportState, Flrl_rofgwl, waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(begg:), rc=rc) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofgwl', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ice sent individually to coupler - call state_setexport_1d(exportState, Flrl_rofi, waterlnd2atmbulk_inst%qflx_rofice_grc(begg:), rc=rc) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_rofi', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! irrigation flux to be removed from main channel storage (negative) - call state_setexport_1d(exportState, Flrl_irrig, waterlnd2atmbulk_inst%qirrig_grc(begg:), & - minus = .true., rc=rc) + call state_setexport(exportState, 'l2c_fb_rof', 'Flrl_irrig', bounds, & + input=water_inst%waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine export_fields !=============================================================================== - subroutine state_getimport_1d(state, fldname, ctsmdata, rc) - ! fill in ctsm import data for 1d field + subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, rc) - use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError - use ESMF, only : ESMF_Finalize + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- - ! input/output variabes - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(inout) :: ctsmdata(:) - integer , intent(out) :: rc + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fb + character(len=*) , intent(in) :: fldname + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(out) :: output(bounds%begg:bounds%endg) + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc ! local variables - real(r8), pointer :: fldPtr1d(:) - integer :: g - character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' + integer :: g, i,n + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + character(len=cs) :: cvalue + character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' ! ---------------------------------------------- rc = ESMF_SUCCESS - call state_getfldptr(State, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = 1,size(ctsmdata) - ctsmdata(g) = fldptr1d(g) - end do - call check_for_nans(ctsmdata, trim(fldname), 1) + if (masterproc .and. debug > 0) then + write(iulog,F01)' Show me what is in the state? for '//trim(fldname) + call ESMF_StatePrint(state, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - end subroutine state_getimport_1d + ! Get the pointer to data in the field + if (present(ungridded_index)) then + write(cvalue,*) ungridded_index + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + end if + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + end if + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill in output array + if (present(ungridded_index)) then + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr2d(ungridded_index,n) + end do + else + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + output(g) = fldptr1d(n) + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + write(iulog,F02)' n, g , fldptr1d(n) '//trim(fldname)//' = ',n, g, fldptr1d(n) + end if + end do + end if + + ! Write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F02)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) + end do + end if + + ! Check for nans + call check_for_nans(output, trim(fldname), bounds%begg) + + end subroutine state_getimport !=============================================================================== - subroutine state_setexport_1d(state, fldname, ctsmdata, minus, rc) - ! fill in ctsm export data for 1d field + subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_index, rc) - use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError - use ESMF, only : ESMF_Finalize + ! ---------------------------------------------- + ! Map input array to export state field + ! ---------------------------------------------- - ! input/output variabes - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: ctsmdata(:) - logical, optional, intent(in) :: minus - integer , intent(out):: rc + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fb + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: input(bounds%begg:bounds%endg) + logical, optional , intent(in) :: minus + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc ! local variables - real(r8), pointer :: fldPtr1d(:) - integer :: g - character(len=*), parameter :: subname='(lnd_export_export:state_setexport_1d)' + logical :: l_minus ! local version of minus + integer :: g, i, n + real(R8), pointer :: fldptr1d(:) + real(R8), pointer :: fldptr2d(:,:) + character(len=cs) :: cvalue + character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' ! ---------------------------------------------- - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._r8 + rc = ESMF_SUCCESS + + l_minus = .false. if (present(minus)) then - do g = 1,size(ctsmdata) - fldptr1d(g) = -ctsmdata(g) + l_minus = minus + end if + + ! get field pointer + if (present(ungridded_index)) then + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + end if + call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + end if + call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! determine output array + if (present(ungridded_index)) then + fldptr2d(ungridded_index,:) = fillvalue + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + if (l_minus) then + fldptr2d(ungridded_index,n) = -input(g) + else + fldptr2d(ungridded_index,n) = input(g) + end if end do else - do g = 1,size(ctsmdata) - fldptr1d(g) = ctsmdata(g) + fldptr1d(:) = fillvalue + do g = bounds%begg, bounds%endg + n = g - bounds%begg + 1 + if (l_minus) then + fldptr1d(n) = -input(g) + else + fldptr1d(n) = input(g) + end if end do end if - call check_for_nans(ctsmdata, trim(fldname), 1) - end subroutine state_setexport_1d + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = bounds%begg,bounds%endg + i = 1 + g - bounds%begg + write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + end do + end if + + ! check for nans + call check_for_nans(input, trim(fldname), bounds%begg) + + end subroutine state_setexport !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) + + subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) ! ---------------------------------------------- ! Get pointer to a state field ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE - ! input/output variables type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fb character(len=*), intent(in) :: fldname real(R8), pointer, optional , intent(out) :: fldptr1d(:) real(R8), pointer, optional , intent(out) :: fldptr2d(:,:) @@ -557,44 +674,44 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! local variables type(ESMF_FieldStatus_Flag) :: status type(ESMF_Field) :: lfield + type(ESMF_FieldBundle) :: fieldBundle character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- rc = ESMF_SUCCESS - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (present(fldptr2d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") - end if + ! Get the fieldbundle from the state... + call ESMF_StateGet(state, trim(fb), fieldBundle, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) call shr_sys_abort("ERROR: fb "//trim(fb)//" not found in state") - end subroutine state_getfldptr - - !=============================================================================== - logical function fldchk(state, fldname) - ! ---------------------------------------------- - ! Determine if field with fldname is in the input state - ! ---------------------------------------------- + ! Get the field from the field bundle + call ESMF_FieldBundleGet(fieldBundle,fieldName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! input/output variables - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: fldname + ! Get the status of the field + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! local variables - type(ESMF_StateItem_Flag) :: itemFlag - ! ---------------------------------------------- - call ESMF_StateGet(state, trim(fldname), itemFlag) - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - fldchk = .true. + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return else - fldchk = .false. - endif - end function fldchk + ! Get the data from the field + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (masterproc .and. debug > 0) then + write(iulog,F01)' in '//trim(subname)//'fldptr1d for '//trim(fldname)//' is ' + end if + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if + endif ! status + + end subroutine state_getfldptr end module lnd_import_export From bbdab6a6a8354b82d97b85cae4fa265b4a62c03f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 31 Dec 2020 10:48:42 -0700 Subject: [PATCH 059/219] added ability to read surface data dimensions from non lat/lon grids --- cime_config/testdefs/testlist_clm_nuopc.xml | 1911 ----------------- .../share_esmf/lnd_set_decomp_and_domain.F90 | 26 +- 2 files changed, 22 insertions(+), 1915 deletions(-) delete mode 100644 cime_config/testdefs/testlist_clm_nuopc.xml diff --git a/cime_config/testdefs/testlist_clm_nuopc.xml b/cime_config/testdefs/testlist_clm_nuopc.xml deleted file mode 100644 index fe8f121f4a..0000000000 --- a/cime_config/testdefs/testlist_clm_nuopc.xml +++ /dev/null @@ -1,1911 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 1cc0ee4ce1..649140deea 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -38,7 +38,6 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf use clm_varpar , only : nlevsoi use clm_varctl , only : fatmlndfrc, fsurdat use clm_varctl , only : use_soil_moisture_streams, single_column - ! use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg @@ -328,9 +327,10 @@ subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) use clm_varctl , only : fsurdat, single_column use fileutils , only : getfil - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen, ncd_inqdid use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort ! input/output variables integer, intent(out) :: ni @@ -343,6 +343,8 @@ subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) type(file_desc_t) :: ncid ! netcdf file id integer :: dimid ! netCDF dimension id logical :: readvar ! read variable in or not + logical :: dim_exists + logical :: dim_found = .false. !------------------------------------------------------------------------------- if (masterproc) then @@ -354,8 +356,24 @@ subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) endif call getfil(fsurdat, locfn, 0 ) call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') - call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + dim_found = .false. + call ncd_inqdid(ncid, 'lsmlon', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + end if + if (.not. dim_found) then + call ncd_inqdid(ncid, 'gridcell', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'gridcell') + nj = 1 + end if + end if + if (.not. dim_found) then + call shr_sys_abort('ERROR: surface dataset does not contain dims of lsmlon,lsmlat or gridcell') + end if call ncd_pio_closefile(ncid) gsize = ni*nj if (single_column) then From 7a7a526e4cedcaef7773f0ce40b6799878308cc1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Jan 2021 12:48:03 -0700 Subject: [PATCH 060/219] fixes for calculating dynamic fraction at run time --- .../namelist_defaults_overall.xml | 16 +- cime_config/testdefs/testlist_clm.xml | 232 +++++----- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 +- src/cpl/nuopc/lnd_import_export.F90 | 40 +- .../share_esmf/lnd_set_decomp_and_domain.F90 | 400 +++++++++++------- 5 files changed, 382 insertions(+), 308 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_overall.xml b/bld/namelist_files/namelist_defaults_overall.xml index 5839ef7451..f0c7f3c0ff 100644 --- a/bld/namelist_files/namelist_defaults_overall.xml +++ b/bld/namelist_files/namelist_defaults_overall.xml @@ -82,18 +82,18 @@ determine default values for namelists. gx1v6 gx1v6 -gx1v6 -gx1v6 +gx1v7 +gx1v7 gx3v7 gx3v7 -USGS +gx3v7 cruncep -USGS -USGS +gx1v7 +gx1v7 gx3v7 -USGS -USGS +gx3v7 +gx3v7 T62 @@ -111,7 +111,7 @@ determine default values for namelists. test navy test -gx1v6 +gx1v7 diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 2e3ff301f6..165f6be9b4 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1,6 +1,6 @@ - + @@ -46,7 +46,7 @@ - + @@ -139,7 +139,7 @@ - + @@ -156,7 +156,7 @@ - + @@ -190,7 +190,7 @@ - + @@ -198,7 +198,7 @@ - + @@ -206,7 +206,7 @@ - + @@ -214,7 +214,7 @@ - + @@ -247,7 +247,7 @@ - + @@ -256,7 +256,7 @@ - + @@ -265,7 +265,7 @@ - + @@ -331,7 +331,7 @@ - + @@ -340,7 +340,7 @@ - + @@ -348,7 +348,7 @@ - + @@ -356,7 +356,7 @@ - + @@ -381,7 +381,7 @@ - + @@ -389,7 +389,7 @@ - + @@ -406,7 +406,7 @@ - + @@ -443,7 +443,7 @@ - + @@ -451,7 +451,7 @@ - + @@ -460,7 +460,7 @@ - + @@ -468,7 +468,7 @@ - + @@ -484,7 +484,7 @@ - + @@ -495,7 +495,7 @@ - + @@ -503,7 +503,7 @@ - + @@ -511,7 +511,7 @@ - + @@ -519,7 +519,7 @@ - + @@ -527,7 +527,7 @@ - + @@ -536,7 +536,7 @@ - + @@ -545,7 +545,7 @@ - + @@ -554,7 +554,7 @@ - + @@ -563,7 +563,7 @@ - + @@ -573,7 +573,7 @@ - + @@ -582,7 +582,7 @@ - + @@ -590,7 +590,7 @@ - + @@ -598,7 +598,7 @@ - + @@ -641,7 +641,7 @@ - + @@ -649,7 +649,7 @@ - + @@ -685,7 +685,7 @@ - + @@ -693,7 +693,7 @@ - + @@ -701,7 +701,7 @@ - + @@ -709,7 +709,7 @@ - + @@ -717,7 +717,7 @@ - + @@ -725,7 +725,7 @@ - + @@ -754,7 +754,7 @@ - + @@ -763,7 +763,7 @@ - + @@ -772,7 +772,7 @@ - + @@ -780,7 +780,7 @@ - + @@ -788,7 +788,7 @@ - + @@ -797,7 +797,7 @@ - + @@ -807,7 +807,7 @@ - + @@ -856,7 +856,7 @@ - + @@ -884,7 +884,7 @@ - + @@ -938,7 +938,7 @@ - + @@ -947,7 +947,7 @@ - + @@ -957,7 +957,7 @@ - + @@ -965,7 +965,7 @@ - + @@ -974,7 +974,7 @@ - + @@ -984,7 +984,7 @@ - + @@ -994,7 +994,7 @@ - + @@ -1002,7 +1002,7 @@ - + @@ -1020,7 +1020,7 @@ - + @@ -1029,7 +1029,7 @@ - + @@ -1038,7 +1038,7 @@ - + @@ -1047,7 +1047,7 @@ - + @@ -1056,7 +1056,7 @@ - + @@ -1077,7 +1077,7 @@ - + @@ -1086,7 +1086,7 @@ - + @@ -1094,7 +1094,7 @@ - + @@ -1110,7 +1110,7 @@ - + @@ -1199,7 +1199,7 @@ - + @@ -1217,7 +1217,7 @@ - + @@ -1234,7 +1234,7 @@ - + @@ -1243,7 +1243,7 @@ - + @@ -1280,7 +1280,7 @@ - + @@ -1289,7 +1289,7 @@ - + @@ -1299,7 +1299,7 @@ - + @@ -1317,7 +1317,7 @@ - + @@ -1326,7 +1326,7 @@ - + @@ -1336,7 +1336,7 @@ - + @@ -1446,7 +1446,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1504,7 +1504,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1512,7 +1512,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1522,7 +1522,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1530,7 +1530,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1541,7 +1541,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1559,7 +1559,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1568,7 +1568,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1597,7 +1597,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1625,7 +1625,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1693,7 +1693,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1720,7 +1720,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1728,7 +1728,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1736,7 +1736,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1746,7 +1746,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1755,7 +1755,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1772,7 +1772,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1791,7 +1791,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1819,7 +1819,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1872,7 +1872,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1890,7 +1890,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1934,7 +1934,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1952,7 +1952,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1996,7 +1996,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2012,7 +2012,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2029,7 +2029,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2039,7 +2039,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2051,7 +2051,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2063,7 +2063,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2073,7 +2073,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2241,7 +2241,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2263,7 +2263,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this 2-degree since that resolution turns off Carbon isotopes - + @@ -2293,7 +2293,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2314,7 +2314,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2325,7 +2325,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2338,7 +2338,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 170c47ab99..43ab789e96 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -551,7 +551,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocnmask', value=meshfile_ocn, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lndmask', value=meshfile_ocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index a63ba87eac..1ba40f22f1 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -183,9 +183,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r else send_to_atm = .false. end if - !DEBUG + ! for now always send to atm send_to_atm = .true. - !DEBUG call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -215,10 +214,25 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! Advertise export fields !-------------------------------- - call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') + ! The following namelist reads should always be called regardless of the send_to_atm value + + ! Dry Deposition velocities from land - ALSO initialize drydep here + call seq_drydep_readnl("drv_flds_in", drydep_nflds) + + ! Fire emissions fluxes from land + call shr_fire_emis_readnl('drv_flds_in', emis_nflds) + + ! MEGAN VOC emissions fluxes from land + call shr_megan_readnl('drv_flds_in', megan_nflds) + if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') + + ! CARMA volumetric soil water from land + ! TODO: is the following correct - the CARMA field exchange is very confusing in mct + call shr_carma_readnl('drv_flds_in', carma_fields) ! export to atm + call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') if (send_to_atm) then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_t ) call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_tref ) @@ -239,37 +253,21 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_evap ) call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_swnet ) ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_methane ) - ! dust fluxes from land (4 sizes) call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_flxdst, ungridded_lbound=1, ungridded_ubound=4) - - ! co2 fields from land if (flds_co2b .or. flds_co2c) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_fco2_lnd ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_fco2_lnd ) ! co2 fields from land end if - - ! Dry Deposition velocities from land - ALSO initialize drydep here - call seq_drydep_readnl("drv_flds_in", drydep_nflds) if (drydep_nflds > 0) then call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_ddvel, ungridded_lbound=1, ungridded_ubound=drydep_nflds) end if - - ! MEGAN VOC emissions fluxes from land - call shr_megan_readnl('drv_flds_in', megan_nflds) - if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') if (shr_megan_mechcomps_n > 0) then call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_voc, ungridded_lbound=1, ungridded_ubound=megan_nflds) end if - - ! Fire emissions fluxes from land - call shr_fire_emis_readnl('drv_flds_in', emis_nflds) if (emis_nflds > 0) then call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_fire, ungridded_lbound=1, ungridded_ubound=emis_nflds) call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_fztop) end if - ! CARMA volumetric soil water from land - ! TODO: is the following correct - the CARMA field exchange is very confusing in mct - call shr_carma_readnl('drv_flds_in', carma_fields) if (carma_fields /= ' ') then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_soilw) ! optional for carma end if diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 649140deea..6b6de817aa 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -14,23 +14,24 @@ module lnd_set_decomp_and_domain ! Module private routines private :: lnd_get_global_dims - private :: lnd_get_lndmask_from_ocnmesh - private :: lnd_get_lndmask_from_lndmesh - private :: lnd_set_ldomain_gridinfo + private :: lnd_set_lndmask_from_maskmesh + private :: lnd_set_lndmask_from_lndmesh + private :: lnd_set_ldomain_gridinfo_from_mesh + private :: chkerr private :: nc_check_err - private :: chkerr character(len=*) , parameter :: u_FILE_u = & __FILE__ character(len=*), parameter, private :: sourcefile = & __FILE__ - + !=============================================================================== contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, ni, nj, rc) + subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, & + ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D use domainMod , only : ldomain, domain_init @@ -38,7 +39,9 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf use clm_varpar , only : nlevsoi use clm_varctl , only : fatmlndfrc, fsurdat use clm_varctl , only : use_soil_moisture_streams, single_column - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen + use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg use fileutils , only : getfil @@ -53,27 +56,33 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf integer , intent(out) :: rc ! local variables - type(ESMF_Mesh) :: mesh_ocninput - type(ESMF_Mesh) :: mesh_lndinput - type(ESMF_DistGrid) :: distgrid_ctsm - character(CL) :: cvalue ! config data - integer :: nlnd, nocn ! local size of arrays - integer :: g,n ! indices - type(bounds_type) :: bounds ! bounds - integer :: begg,endg - integer , pointer :: gindex_lnd(:) ! global index space for just land points - integer , pointer :: gindex_ocn(:) ! global index space for just ocean points - integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points - integer , pointer :: gindex_input(:) ! global index space for land and ocean points - integer , pointer :: lndmask_glob(:) - real(r8) , pointer :: lndfrac_glob(:) - integer :: lsize_input - integer :: gsize - logical :: isgrid2d - character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - logical :: readvar ! read variable in or not + type(ESMF_Mesh) :: mesh_ocninput + type(ESMF_Mesh) :: mesh_lndinput + type(ESMF_DistGrid) :: distgrid_ctsm + character(CL) :: cvalue ! config data + integer :: nlnd, nocn ! local size of arrays + integer :: g,n ! indices + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points + integer , pointer :: gindex_input(:) ! global index space for land and ocean points + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer :: lsize_input + integer :: gsize + logical :: isgrid2d + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + integer :: varid + logical :: readvar ! read variable in or not + logical :: fileexists + logical :: read_fatmlndfrc + logical :: write_landmask_file + logical :: read_landmask_file + character(len=CL) :: flandfrac = 'landfrac.nc' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -92,9 +101,15 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) end if - ! Set global land fraction and global land mask across all processors if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then - ! Note that is just for backwards compatibility + read_fatmlndfrc = .true. + else + read_fatmlndfrc = .false. + end if + + ! Set global land fraction and global land mask across all processors + if (read_fatmlndfrc) then + ! Read in global land mask and land fraction from fatmlndfrc call getfil( trim(fatmlndfrc), locfn, 0 ) call ncd_pio_openfile (ncid, trim(locfn), 0) @@ -104,21 +119,55 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) call ncd_pio_closefile(ncid) + else + + ! TODO: write landmask_file on initialization and read it in on restart or branch + ! for now see if any tests fail like ERP if the file is not written out + write_landmask_file = .false. + read_landmask_file = .false. + + ! Read in ocean mesh file if its not null, map the mask to the land mesh and write out the landfrac and land mask if (trim(meshfile_ocn) /= 'null') then - ! read in ocn mask meshfile + ! first read in ocn mask meshfile mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) end if - ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_get_lndmask_from_ocnmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (write_landmask_file) then + ! NOW write land mesh/fraction to file in executable directory - this will be used from now on + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: writing landmask and landfrac data to landfrac.nc' + write(iulog,*) + end if + call ncd_pio_createfile(ncid, trim(flandfrac)) + call ncd_defdim (ncid, 'gridcell', gsize, dimid) + call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int , dim1name='gridcell') + call ncd_defvar(ncid=ncid, varname='landfrac', xtype=ncd_double, dim1name='gridcell') + call ncd_enddef(ncid) + call ncd_io(ncid=ncid, varname='landmask', data=lndmask_glob, flag='write') + call ncd_io(ncid=ncid, varname='landfrac', data=lndfrac_glob, flag='write') + call ncd_pio_closefile(ncid) + else if (read_landmask_file) then + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: reading landmask and landfrac data from landfrac.nc' + write(iulog,*) + end if + call ncd_pio_openfile (ncid, trim(flandfrac), 0) + call ncd_io(ncid=ncid, varname='landmask', data=lndmask_glob, flag='read') + call ncd_io(ncid=ncid, varname='landfrac', data=lndfrac_glob, flag='read') + call ncd_pio_closefile(ncid) + end if else ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call lnd_get_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if @@ -178,9 +227,8 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get ldomain%lonc, ldomain%latc and ldomain%area and optionally - ! lon1d and lat1d if isgrid2d - call lnd_set_ldomain_gridinfo(mesh_ctsm, vm, gindex_ctsm, bounds, isgrid2d, ni, nj, ldomain, rc) + ! Set ldomain%lonc, ldomain%latc and ldomain%area + call lnd_set_ldomain_gridinfo_from_mesh(mesh_ctsm, vm, gindex_ctsm, begg, endg, isgrid2d, ni, nj, ldomain, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Deallocate memory @@ -190,6 +238,80 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf end subroutine lnd_set_decomp_and_domain_from_readmesh + !=============================================================================== + subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) + + ! Determine global 2d sizes from read of dimensions of surface dataset + + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen, ncd_inqdid + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort + + ! input/output variables + integer, intent(out) :: ni + integer, intent(out) :: nj + integer, intent(out) :: gsize + logical, intent(out) :: isgrid2d + + ! local variables + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not + logical :: dim_exists + logical :: dim_found = .false. + !------------------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to global dimensions from surface dataset' + if (fsurdat == ' ') then + write(iulog,*)'fsurdat must be specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + call getfil(fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + dim_found = .false. + call ncd_inqdid(ncid, 'lsmlon', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + end if + if (.not. dim_found) then + call ncd_inqdid(ncid, 'gridcell', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'gridcell') + nj = 1 + end if + end if + if (.not. dim_found) then + call shr_sys_abort('ERROR: surface dataset does not contain dims of lsmlon,lsmlat or gridcell') + end if + call ncd_pio_closefile(ncid) + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + end subroutine lnd_get_global_dims + !=============================================================================== subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) @@ -321,85 +443,11 @@ subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) end subroutine lnd_set_decomp_and_domain_from_newmesh !=============================================================================== - subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) - - ! Determine global 2d sizes from read of dimensions of surface dataset - - use clm_varctl , only : fsurdat, single_column - use fileutils , only : getfil - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen, ncd_inqdid - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - use shr_sys_mod , only : shr_sys_abort - - ! input/output variables - integer, intent(out) :: ni - integer, intent(out) :: nj - integer, intent(out) :: gsize - logical, intent(out) :: isgrid2d - - ! local variables - character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - logical :: readvar ! read variable in or not - logical :: dim_exists - logical :: dim_found = .false. - !------------------------------------------------------------------------------- - - if (masterproc) then - write(iulog,*) 'Attempting to global dimensions from surface dataset' - if (fsurdat == ' ') then - write(iulog,*)'fsurdat must be specified' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - endif - call getfil(fsurdat, locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - dim_found = .false. - call ncd_inqdid(ncid, 'lsmlon', dimid, dim_exists) - if ( dim_exists ) then - dim_found = .true. - call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') - call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') - end if - if (.not. dim_found) then - call ncd_inqdid(ncid, 'gridcell', dimid, dim_exists) - if ( dim_exists ) then - dim_found = .true. - call ncd_inqdlen(ncid, dimid, ni, 'gridcell') - nj = 1 - end if - end if - if (.not. dim_found) then - call shr_sys_abort('ERROR: surface dataset does not contain dims of lsmlon,lsmlat or gridcell') - end if - call ncd_pio_closefile(ncid) - gsize = ni*nj - if (single_column) then - isgrid2d = .true. - else if (nj == 1) then - isgrid2d = .false. - else - isgrid2d = .true. - end if - if (masterproc) then - write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj - if (isgrid2d) then - write(iulog,'(a)') 'model grid is 2-dimensional' - else - write(iulog,'(a)') 'model grid is not 2-dimensional' - end if - end if - - end subroutine lnd_get_global_dims - - !=============================================================================== - subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_glob, lndfrac_glob, rc) + subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask_glob, lndfrac_glob, rc) ! input/out variables type(ESMF_Mesh) , intent(in) :: mesh_lnd - type(ESMF_Mesh) , intent(in) :: mesh_ocn + type(ESMF_Mesh) , intent(in) :: mesh_mask type(ESMF_VM) , intent(in) :: vm integer , intent(in) :: gsize integer , pointer :: lndmask_glob(:) @@ -408,21 +456,21 @@ subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_g ! local variables: type(ESMF_DistGrid) :: distgrid_lnd - type(ESMF_RouteHandle) :: rhandle_ocn2lnd + type(ESMF_RouteHandle) :: rhandle_mask2lnd type(ESMF_Field) :: field_lnd - type(ESMF_Field) :: field_ocn - type(ESMF_DistGrid) :: distgrid_ocn + type(ESMF_Field) :: field_mask + type(ESMF_DistGrid) :: distgrid_mask integer , pointer :: gindex_input(:) ! global index space for land and ocean points integer , pointer :: lndmask_loc(:) integer , pointer :: itemp_glob(:) real(r8) , pointer :: rtemp_glob(:) real(r8) , pointer :: lndfrac_loc(:) - real(r8) , pointer :: ocnmask_loc(:) ! on ocean mesh - real(r8) , pointer :: ocnfrac_loc(:) ! on land mesh + real(r8) , pointer :: maskmask_loc(:) ! on ocean mesh + real(r8) , pointer :: maskfrac_loc(:) ! on land mesh real(r8) , pointer :: dataptr1d(:) type(ESMF_Array) :: elemMaskArray integer :: lsize_lnd - integer :: lsize_ocn + integer :: lsize_mask integer :: n, spatialDim integer :: srcMaskValue = 0 integer :: dstMaskValue = -987987 ! spval for RH mask values @@ -443,42 +491,42 @@ subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_g ! create fields on land and ocean meshes field_lnd = ESMF_FieldCreate(mesh_lnd, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - field_ocn = ESMF_FieldCreate(mesh_ocn, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + field_mask = ESMF_FieldCreate(mesh_mask, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! create route handle to map ocean mask from ocn mesh to land mesh - call ESMF_FieldRegridStore(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + ! create route handle to map ocean mask from mask mesh to land mesh + call ESMF_FieldRegridStore(field_mask, field_lnd, routehandle=rhandle_mask2lnd, & srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! fill in values for field_ocn with mask on ocn mesh - call ESMF_MeshGet(mesh_ocn, elementdistGrid=distgrid_ocn, rc=rc) + ! fill in values for field_mask with mask on mask mesh + call ESMF_MeshGet(mesh_mask, elementdistGrid=distgrid_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_ocn, localDe=0, elementCount=lsize_ocn, rc=rc) + call ESMF_DistGridGet(distgrid_mask, localDe=0, elementCount=lsize_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ocnmask_loc(lsize_ocn)) - elemMaskArray = ESMF_ArrayCreate(distgrid_ocn, ocnmask_loc, rc=rc) + allocate(maskmask_loc(lsize_mask)) + elemMaskArray = ESMF_ArrayCreate(distgrid_mask, maskmask_loc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh_ocn, elemMaskArray=elemMaskArray, rc=rc) + call ESMF_MeshGet(mesh_mask, elemMaskArray=elemMaskArray, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_ocn, farrayptr=dataptr1d, rc=rc) - dataptr1d(:) = ocnmask_loc(:) + call ESMF_FieldGet(field_mask, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = maskmask_loc(:) - ! map ocn mask to land mesh - call ESMF_FieldRegrid(field_ocn, field_lnd, routehandle=rhandle_ocn2lnd, & + ! map mask mask to land mesh + call ESMF_FieldRegrid(field_mask, field_lnd, routehandle=rhandle_mask2lnd, & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ocnfrac_loc(lsize_lnd)) - call ESMF_FieldGet(field_lnd, farrayptr=ocnfrac_loc, rc=rc) + allocate(maskfrac_loc(lsize_lnd)) + call ESMF_FieldGet(field_lnd, farrayptr=maskfrac_loc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize_lnd - lndfrac_loc(n) = 1._r8 - ocnfrac_loc(n) + lndfrac_loc(n) = 1._r8 - maskfrac_loc(n) if (lndfrac_loc(n) > fmaxval) lndfrac_loc(n) = 1._r8 if (lndfrac_loc(n) < fminval) lndfrac_loc(n) = 0._r8 if (lndfrac_loc(n) /= 0._r8) then @@ -488,7 +536,7 @@ subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_g end if enddo call ESMF_FieldDestroy(field_lnd) - call ESMF_FieldDestroy(field_ocn) + call ESMF_FieldDestroy(field_mask) ! determine global landmask_glob - needed to determine the ctsm decomposition ! land frac, lats, lons and areas will be done below @@ -517,14 +565,14 @@ subroutine lnd_get_lndmask_from_ocnmesh(mesh_lnd, mesh_ocn, vm, gsize, lndmask_g deallocate(rtemp_glob) ! deallocate memory - deallocate(ocnmask_loc) + deallocate(maskmask_loc) deallocate(lndmask_loc) deallocate(lndfrac_loc) - end subroutine lnd_get_lndmask_from_ocnmesh + end subroutine lnd_set_lndmask_from_maskmesh !=============================================================================== - subroutine lnd_get_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) + subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) ! input/out variables type(ESMF_Mesh) , intent(in) :: mesh_lnd @@ -579,44 +627,53 @@ subroutine lnd_get_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfr ! ASSUME that land fraction is identical to land mask in this case lndfrac_glob(:) = lndmask_glob(:) - end subroutine lnd_get_lndmask_from_lndmesh - + end subroutine lnd_set_lndmask_from_lndmesh + !=============================================================================== - subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, ldomain, rc) + subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgrid2d, ni, nj, ldomain, rc) use domainMod , only : domain_type, lon1d, lat1d - use decompMod , only : bounds_type, get_proc_bounds use clm_varcon , only : re + ! for reading in fatmlndfrc to override mesh data + use clm_varctl , only : fatmlndfrc + use clm_varcon , only : grlnd + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile + ! input/output variables type(ESMF_Mesh) , intent(in) :: mesh type(ESMF_VM) , intent(in) :: vm integer , intent(in) :: gindex(:) - type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: begg,endg logical , intent(in) :: isgrid2d - integer , intent(in) :: ni,nj + integer , intent(in) :: ni, nj type(domain_type) , intent(inout) :: ldomain - integer , intent(out) :: rc + integer , intent(out) :: rc ! local variables - integer :: g,n - integer :: gsize - integer :: begg,endg - integer :: numownedelements - real(r8) , pointer :: lndlats_glob(:) - real(r8) , pointer :: lndlons_glob(:) - real(r8) , pointer :: rtemp_glob(:) - real(r8) , pointer :: ownedElemCoords(:) - integer :: spatialDim - real(r8) , pointer :: dataptr1d(:) - type(ESMF_Field) :: areaField + integer :: g,n + integer :: gsize + integer :: numownedelements + real(r8) , pointer :: ownedElemCoords(:) + integer :: spatialDim + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + type(ESMF_Field) :: areaField + + ! for reading in fatmlndfrc to override mesh data + type(file_desc_t) :: ncid ! netcdf id + character(len=CL) :: locfn ! local file name + logical :: override_lon = .false. + logical :: override_lat = .true. + logical :: override_area = .false. + real(r8), allocatable :: rdata2d(:,:) ! temporary !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - begg = bounds%begg - endg = bounds%endg - ! Determine ldoman%latc and ldomain%lonc call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -644,7 +701,7 @@ subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, end do call ESMF_FieldDestroy(areaField) - ! If grid is 2d, determine lon1d and lat1d + ! If grid is 2d, determine lon1d and lat1d from mesh if (isgrid2d) then gsize = ni*nj allocate(rtemp_glob(gsize)) @@ -683,7 +740,26 @@ subroutine lnd_set_ldomain_gridinfo(mesh, vm, gindex, bounds, isgrid2d, ni, nj, deallocate(rtemp_glob) end if - end subroutine lnd_set_ldomain_gridinfo + ! TODO: For BFB with previous baselines - the following read will overwrite + ! ldomain%latc, ldomain%lonc and ldomain%area with the data above + ! Note that latitude and longitude read in are in degrees + call getfil( trim(fatmlndfrc), locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + if (override_lon .or. override_lat .or. override_area) then + if (override_lon) then + call ncd_io(ncid=ncid, varname= 'xc' , flag='read', data=ldomain%lonc , dim1name=grlnd) + end if + if (override_lat) then + call ncd_io(ncid=ncid, varname= 'yc' , flag='read', data=ldomain%latc , dim1name=grlnd) + end if + if (override_area) then + call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, dim1name=grlnd) + ldomain%area = ldomain%area * (re**2) ! convert from radians**2 to km**2 + end if + end if + call ncd_pio_closefile(ncid) + + end subroutine lnd_set_ldomain_gridinfo_from_mesh !=============================================================================== subroutine nc_check_err(ierror, description, filename) From 47e55987582af7806808ed3d01f4b11d1b994551 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Jan 2021 17:08:14 -0700 Subject: [PATCH 061/219] updates for using maskfile --- src/cpl/lilac/lnd_comp_esmf.F90 | 2 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 6 +- .../share_esmf/lnd_set_decomp_and_domain.F90 | 74 ++++++++++--------- 3 files changed, 43 insertions(+), 39 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 05613e23a1..7e8f55e464 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -342,7 +342,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call lnd_set_decomp_and_domain_from_readmesh(mode='lilac', vm=vm, & - meshfile_lnd=lnd_mesh_filename, meshfile_ocn='null', mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) + meshfile_lnd=lnd_mesh_filename, meshfile_mask='null', mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !-------------------------------- diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 43ab789e96..60938b9cc9 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -390,7 +390,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: shrlogunit ! original log unit type(bounds_type) :: bounds ! bounds integer :: ni, nj - character(len=CL) :: meshfile_ocn + character(len=CL) :: meshfile_mask character(len=CL) :: domain_file character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -551,12 +551,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call NUOPC_CompAttributeGet(gcomp, name='mesh_lndmask', value=meshfile_ocn, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=meshfile_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call lnd_set_decomp_and_domain_from_readmesh(mode='nuopc', vm=vm, & - meshfile_lnd=model_meshfile, meshfile_ocn=meshfile_ocn, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) + meshfile_lnd=model_meshfile, meshfile_mask=meshfile_mask, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 6b6de817aa..7b43e4584e 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -1,9 +1,10 @@ module lnd_set_decomp_and_domain use ESMF - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use spmdMod , only : masterproc - use clm_varctl , only : iulog + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use spmdMod , only : masterproc + use clm_varctl , only : iulog implicit none private ! except @@ -30,15 +31,14 @@ module lnd_set_decomp_and_domain contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_ocn, mesh_ctsm, & + subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D use domainMod , only : ldomain, domain_init use decompMod , only : ldecomp, bounds_type, get_proc_bounds use clm_varpar , only : nlevsoi - use clm_varctl , only : fatmlndfrc, fsurdat - use clm_varctl , only : use_soil_moisture_streams, single_column + use clm_varctl , only : fatmlndfrc, use_soil_moisture_streams, single_column use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile @@ -50,13 +50,13 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf character(len=*) , intent(in) :: mode ! lilac or nuopc mode type(ESMF_VM) , intent(in) :: vm character(len=*) , intent(in) :: meshfile_lnd - character(len=*) , intent(in) :: meshfile_ocn + character(len=*) , intent(in) :: meshfile_mask type(ESMF_Mesh) , intent(out) :: mesh_ctsm integer , intent(out) :: ni,nj ! global grid dimensions integer , intent(out) :: rc ! local variables - type(ESMF_Mesh) :: mesh_ocninput + type(ESMF_Mesh) :: mesh_maskinput type(ESMF_Mesh) :: mesh_lndinput type(ESMF_DistGrid) :: distgrid_ctsm character(CL) :: cvalue ! config data @@ -101,7 +101,8 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) end if - if (mode == 'lilac' .and. trim(fatmlndfrc) /= 'null') then + if (mode == 'lilac') then + ! TODO: how can lilac be generalized to not read fatmlndfrc- for now this is hard-wired read_fatmlndfrc = .true. else read_fatmlndfrc = .false. @@ -127,16 +128,16 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf write_landmask_file = .false. read_landmask_file = .false. - ! Read in ocean mesh file if its not null, map the mask to the land mesh and write out the landfrac and land mask - if (trim(meshfile_ocn) /= 'null') then - ! first read in ocn mask meshfile - mesh_ocninput = ESMF_MeshCreate(filename=trim(meshfile_ocn), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + ! Read in mask mesh file if its not null, map the mask to the land mesh and write out the landfrac and land mask + if (trim(meshfile_mask) /= 'null') then + ! first read in mask meshfile + mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_ocn) + write(iulog,'(a)')'ocean mesh file ',trim(meshfile_mask) end if ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_ocninput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (write_landmask_file) then @@ -663,13 +664,11 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr real(r8) , pointer :: rtemp_glob(:) type(ESMF_Field) :: areaField - ! for reading in fatmlndfrc to override mesh data - type(file_desc_t) :: ncid ! netcdf id - character(len=CL) :: locfn ! local file name - logical :: override_lon = .false. - logical :: override_lat = .true. - logical :: override_area = .false. - real(r8), allocatable :: rdata2d(:,:) ! temporary + ! for sanity check - remove when this is done + type(file_desc_t) :: ncid ! netcdf id + character(len=CL) :: locfn ! local file name + real(r8), pointer :: lonc_atmlndfrc(:) + real(r8), pointer :: latc_atmlndfrc(:) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -740,23 +739,28 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr deallocate(rtemp_glob) end if - ! TODO: For BFB with previous baselines - the following read will overwrite - ! ldomain%latc, ldomain%lonc and ldomain%area with the data above - ! Note that latitude and longitude read in are in degrees + ! Sanity check- remove this when it is done call getfil( trim(fatmlndfrc), locfn, 0 ) call ncd_pio_openfile (ncid, trim(locfn), 0) - if (override_lon .or. override_lat .or. override_area) then - if (override_lon) then - call ncd_io(ncid=ncid, varname= 'xc' , flag='read', data=ldomain%lonc , dim1name=grlnd) - end if - if (override_lat) then - call ncd_io(ncid=ncid, varname= 'yc' , flag='read', data=ldomain%latc , dim1name=grlnd) + allocate(lonc_atmlndfrc(numownedelements)) + allocate(latc_atmlndfrc(numownedelements)) + call ncd_io(ncid=ncid, varname= 'xc' , flag='read', data=lonc_atmlndfrc , dim1name=grlnd) + call ncd_io(ncid=ncid, varname= 'yc' , flag='read', data=latc_atmlndfrc , dim1name=grlnd) + do g = begg,endg + n = g - begg + 1 + if (abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) > 1.e-11) then + write(6,'(a,3(d20.13,2x))')'ERROR: lonc_atmlndfrac(n), ldomain%lonc(g), abs(diff) = ',& + lonc_atmlndfrc(n), ldomain%lonc(g), abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) + call shr_sys_abort() end if - if (override_area) then - call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, dim1name=grlnd) - ldomain%area = ldomain%area * (re**2) ! convert from radians**2 to km**2 + if (abs(latc_atmlndfrc(n) - ldomain%latc(g)) > 1.e-11) then + write(6,'(a,3(d20.13,2x))')'ERROR: latc_atmlndfrac(n), ldomain%latc(g), abs(diff) = ',& + latc_atmlndfrc(n), ldomain%latc(g), abs(latc_atmlndfrc(n) - ldomain%latc(g)) + call shr_sys_abort() end if - end if + end do + deallocate(lonc_atmlndfrc) + deallocate(latc_atmlndfrc) call ncd_pio_closefile(ncid) end subroutine lnd_set_ldomain_gridinfo_from_mesh From ba572465ad9f9fce127d14369fc97962e965e8a2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Jan 2021 21:43:37 -0700 Subject: [PATCH 062/219] minor change to diagnostic output --- src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 7b43e4584e..ec2f0ed19f 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -134,7 +134,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (masterproc) then - write(iulog,'(a)')'ocean mesh file ',trim(meshfile_mask) + write(iulog,'(a)')'mask mesh file ',trim(meshfile_mask) end if ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) From 87ccf2b5c4e18d9e822a7fb68d86406f238af205 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 8 Jan 2021 10:58:22 -0700 Subject: [PATCH 063/219] bug fixes found in aux_clm tests and cleanup --- src/cpl/lilac/lnd_comp_esmf.F90 | 2 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 6 +- .../share_esmf/lnd_set_decomp_and_domain.F90 | 584 ++++++++++-------- src/main/clm_initializeMod.F90 | 10 - 4 files changed, 337 insertions(+), 265 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 7e8f55e464..27b022f10c 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -342,7 +342,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call lnd_set_decomp_and_domain_from_readmesh(mode='lilac', vm=vm, & - meshfile_lnd=lnd_mesh_filename, meshfile_mask='null', mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) + meshfile_lnd=lnd_mesh_filename, meshfile_mask=lnd_mesh_filename, mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return !-------------------------------- diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 60938b9cc9..373c16c486 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -345,7 +345,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use clm_instMod , only : lnd2atm_inst, lnd2glc_inst, water_inst use domainMod , only : ldomain use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_newmesh + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_createmesh use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_readmesh ! input/output variables @@ -545,10 +545,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (single_column) model_meshfile = 'create_mesh' if (trim(model_meshfile) == 'create_mesh') then - ! TODO: can't this just be fatmlndfrc call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=domain_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) + call lnd_set_decomp_and_domain_from_createmesh(domain_file=domain_file, vm=vm, & + mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=meshfile_mask, rc=rc) diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index ec2f0ed19f..0f9ec9bd51 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -2,7 +2,7 @@ module lnd_set_decomp_and_domain use ESMF use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use shr_sys_mod , only : shr_sys_abort + use shr_sys_mod , only : shr_sys_abort use spmdMod , only : masterproc use clm_varctl , only : iulog @@ -11,7 +11,7 @@ module lnd_set_decomp_and_domain ! Module public routines public :: lnd_set_decomp_and_domain_from_readmesh - public :: lnd_set_decomp_and_domain_from_newmesh + public :: lnd_set_decomp_and_domain_from_createmesh ! Module private routines private :: lnd_get_global_dims @@ -19,11 +19,10 @@ module lnd_set_decomp_and_domain private :: lnd_set_lndmask_from_lndmesh private :: lnd_set_ldomain_gridinfo_from_mesh private :: chkerr - private :: nc_check_err + private :: pio_check_err character(len=*) , parameter :: u_FILE_u = & __FILE__ - character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -38,13 +37,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf use domainMod , only : ldomain, domain_init use decompMod , only : ldecomp, bounds_type, get_proc_bounds use clm_varpar , only : nlevsoi - use clm_varctl , only : fatmlndfrc, use_soil_moisture_streams, single_column - use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile - use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen - use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - use fileutils , only : getfil + use clm_varctl , only : use_soil_moisture_streams ! input/output variables character(len=*) , intent(in) :: mode ! lilac or nuopc mode @@ -59,121 +52,61 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf type(ESMF_Mesh) :: mesh_maskinput type(ESMF_Mesh) :: mesh_lndinput type(ESMF_DistGrid) :: distgrid_ctsm - character(CL) :: cvalue ! config data - integer :: nlnd, nocn ! local size of arrays integer :: g,n ! indices + integer :: nlnd, nocn ! local size of arrays + integer :: gsize ! global size of grid + logical :: isgrid2d ! true => grid is 2d type(bounds_type) :: bounds ! bounds - integer :: begg,endg + integer :: begg,endg ! local bounds integer , pointer :: gindex_lnd(:) ! global index space for just land points integer , pointer :: gindex_ocn(:) ! global index space for just ocean points integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points - integer , pointer :: gindex_input(:) ! global index space for land and ocean points integer , pointer :: lndmask_glob(:) real(r8) , pointer :: lndfrac_glob(:) - integer :: lsize_input - integer :: gsize - logical :: isgrid2d - character(len=CL) :: locfn - type(file_desc_t) :: ncid ! netcdf file id - integer :: dimid ! netCDF dimension id - integer :: varid - logical :: readvar ! read variable in or not - logical :: fileexists - logical :: read_fatmlndfrc - logical :: write_landmask_file - logical :: read_landmask_file - character(len=CL) :: flandfrac = 'landfrac.nc' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - ! Determine global 2d sizes from read of dimensions of surface dataset - call lnd_get_global_dims(ni, nj, gsize, isgrid2d) + ! Write diag info + if (masterproc) then + write(iulog,*) + write(iulog,'(a)')' Input land mesh file '//trim(meshfile_lnd) + write(iulog,'(a)')' Input mask mesh file '//trim(meshfile_mask) + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + write(iulog, '(a)') ' Obtaining land mask and fraction from mask file '//trim(meshfile_mask) + else + write(iulog, '(a)') ' Obtaining land mask and fraction from land mesh file '//trim(meshfile_lnd) + end if + write(iulog,*) + end if - ! Allocate global memory for land mask and land fraction + ! Determine global 2d sizes from read of dimensions of surface dataset and allocate global memory + call lnd_get_global_dims(ni, nj, gsize, isgrid2d) allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 allocate(lndfrac_glob(gsize)); lndfrac_glob(:) = 0._r8 - ! read in the land mesh from the file + ! Read in the land mesh from the file mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'land mesh file ',trim(meshfile_lnd) - end if - if (mode == 'lilac') then - ! TODO: how can lilac be generalized to not read fatmlndfrc- for now this is hard-wired - read_fatmlndfrc = .true. - else - read_fatmlndfrc = .false. + ! Read in mask meshfile if needed + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Set global land fraction and global land mask across all processors - if (read_fatmlndfrc) then - - ! Read in global land mask and land fraction from fatmlndfrc - call getfil( trim(fatmlndfrc), locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - call ncd_io(ncid=ncid, varname='mask', data=lndmask_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - allocate(lndfrac_glob(ni*nj)); lndfrac_glob(:) = 0._r8 - call ncd_io(ncid=ncid, varname='frac', data=lndfrac_glob, flag='read', readvar=readvar) - if (.not. readvar) call endrun( msg=' ERROR: variable frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) - call ncd_pio_closefile(ncid) - + ! Determine lndmask_glob and lndfrac_glob + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else - - ! TODO: write landmask_file on initialization and read it in on restart or branch - ! for now see if any tests fail like ERP if the file is not written out - write_landmask_file = .false. - read_landmask_file = .false. - - ! Read in mask mesh file if its not null, map the mask to the land mesh and write out the landfrac and land mask - if (trim(meshfile_mask) /= 'null') then - ! first read in mask meshfile - mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,'(a)')'mask mesh file ',trim(meshfile_mask) - end if - ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (write_landmask_file) then - ! NOW write land mesh/fraction to file in executable directory - this will be used from now on - if (masterproc) then - write(iulog,*) - write(iulog,'(a)') 'lnd_set_decomp_and_domain: writing landmask and landfrac data to landfrac.nc' - write(iulog,*) - end if - call ncd_pio_createfile(ncid, trim(flandfrac)) - call ncd_defdim (ncid, 'gridcell', gsize, dimid) - call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int , dim1name='gridcell') - call ncd_defvar(ncid=ncid, varname='landfrac', xtype=ncd_double, dim1name='gridcell') - call ncd_enddef(ncid) - call ncd_io(ncid=ncid, varname='landmask', data=lndmask_glob, flag='write') - call ncd_io(ncid=ncid, varname='landfrac', data=lndfrac_glob, flag='write') - call ncd_pio_closefile(ncid) - else if (read_landmask_file) then - if (masterproc) then - write(iulog,*) - write(iulog,'(a)') 'lnd_set_decomp_and_domain: reading landmask and landfrac data from landfrac.nc' - write(iulog,*) - end if - call ncd_pio_openfile (ncid, trim(flandfrac), 0) - call ncd_io(ncid=ncid, varname='landmask', data=lndmask_glob, flag='read') - call ncd_io(ncid=ncid, varname='landfrac', data=lndfrac_glob, flag='read') - call ncd_pio_closefile(ncid) - end if - else - ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Determine lnd decomposition that will be used by ctsm + ! Determine lnd decomposition that will be used by ctsm from lndmask_glob call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) if (use_soil_moisture_streams) then call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) @@ -208,6 +141,8 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) ldomain%frac(g) = lndfrac_glob(gindex_lnd(n)) end do + + ! Deallocate global pointer memory deallocate(lndmask_glob) deallocate(lndfrac_glob) @@ -232,13 +167,249 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf call lnd_set_ldomain_gridinfo_from_mesh(mesh_ctsm, vm, gindex_ctsm, begg, endg, isgrid2d, ni, nj, ldomain, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Deallocate memory + ! Deallocate local pointer memory deallocate(gindex_lnd) deallocate(gindex_ocn) deallocate(gindex_ctsm) end subroutine lnd_set_decomp_and_domain_from_readmesh + !=============================================================================== + subroutine lnd_set_decomp_and_domain_from_createmesh(domain_file, vm, mesh_ctsm, ni, nj, rc) + + ! Generate a new mesh from the input domain file and set the mask to 1 + + use decompInitMod , only : decompInit_lnd, decompInit_lnd3D + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use domainMod , only : ldomain, domain_init + use clm_varctl , only : use_soil_moisture_streams + use clm_varctl , only : scmlat, scmlon, single_column + use clm_varpar , only : nlevsoi + use ncdio_pio , only : pio_subsystem, io_type + use pio + + ! input/output variables + character(len=CL) , intent(in) :: domain_file + type(ESMF_VM) , intent(in) :: vm + type(ESMF_Mesh) , intent(out) :: mesh_ctsm + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc + + ! local variables + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: mesh_lndcreate + type(ESMF_DistGrid) :: distgrid_ctsm + integer, pointer :: gindex_ctsm(:) ! global index space for just land points + logical :: isgrid2d + integer :: i,j,g,n + integer :: nv + integer :: ierr + integer :: dimid + integer :: varid_xv, varid_yv + integer :: varid_xc, varid_yc + integer :: varid_area + real(r8), allocatable :: xc(:,:), yc(:,:) ! coordinates of centers + real(r8), allocatable :: xv(:,:,:), yv(:,:,:) ! coordinates of corners + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + integer :: spatialDim + integer :: numownedelements + real(r8) , pointer :: ownedElemCoords(:) + integer, allocatable :: lnd_mask(:) + type(bounds_type) :: bounds ! bounds + integer :: begg,endg + integer :: nlnd + integer :: start(2) ! start index to read in for single column mode + integer :: count(2) ! number of points to read in + real(r8) :: scol_data(1) ! temporary + integer , allocatable :: mask(:) ! temporary + real(r8), allocatable :: lats(:) ! temporary + real(r8), allocatable :: lons(:) ! temporary + real(r8), allocatable :: pos_lons(:) ! temporary + real(r8) :: pos_scmlon ! temporary + real(r8) :: scol_area ! temporary + type(file_desc_t) :: pioid + integer :: rcode ! error code + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + rcode = pio_openfile(pio_subsystem, pioid, io_type, trim(domain_file), pio_nowrite) + call pio_check_err(rcode, 'error opening file '//trim(domain_file)) + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + rcode = pio_inq_dimid(pioid, 'ni', dimid) + call pio_check_err(rcode, 'pio_inq_dimid for ni in file '//trim(domain_file)) + rcode = pio_inquire_dimension(pioid, dimid, len=ni) + call pio_check_err(rcode, 'pio_inq_dimension for ni in file '//trim(domain_file)) + rcode = pio_inq_dimid(pioid, 'nj', dimid) + call pio_check_err(rcode, 'pio_inq_dimid for nj in file '//trim(domain_file)) + rcode = pio_inquire_dimension(pioid, dimid, len=nj) + call pio_check_err(rcode, 'pio_inq_dimension for nj in file '//trim(domain_file)) + rcode = pio_inq_dimid(pioid, 'nv', dimid) + call pio_check_err(rcode, 'pio_inq_dimid for nv in file '//trim(domain_file)) + rcode = pio_inquire_dimension(pioid, dimid, len=nv) + call pio_check_err(rcode, 'pio_inq_dimension for nv in file '//trim(domain_file)) + rcode = pio_inq_varid(pioid, 'xc' , varid_xc) + call pio_check_err(rcode, 'pio_inq_varid for yc in file '//trim(domain_file)) + rcode = pio_inq_varid(pioid, 'yc' , varid_yc) + call pio_check_err(rcode, 'pio_inq_varid for yc in file '//trim(domain_file)) + rcode = pio_inq_varid(pioid, 'xv' , varid_xv) + call pio_check_err(rcode, 'pio_inq_varid for xv in file '//trim(domain_file)) + rcode = pio_inq_varid(pioid, 'yv' , varid_yv) + call pio_check_err(rcode, 'pio_inq_varid for yv in file '//trim(domain_file)) + rcode = pio_inq_varid(pioid, 'area', varid_area) + call pio_check_err(rcode, 'pio_inq_varid for area in file '//trim(domain_file)) + + if (single_column) then + + ! In this case the domain file is not a single point file - but normally a + ! global domain file where a nearest neighbor search will be done to find + ! the closest point in the domin file to scol_lon and scol_lat + + ! get center lats and lons from domain file + allocate(xc(ni,nj)) + allocate(yc(ni,nj)) + rcode = pio_get_var(pioid, varid_xc, xc) + call pio_check_err(rcode, 'pio_get_var for xc in file '//trim(domain_file)) + rcode = pio_get_var(pioid, varid_yc, yc) + call pio_check_err(rcode, 'pio_get_var for yc in file '//trim(domain_file)) + + ! find nearest neighbor indices of scmlon and scmlat in domain file + allocate(lats(nj)) + allocate(lons(ni)) + allocate(pos_lons(ni)) + do i = 1,ni + lons(i) = xc(i,1) + end do + do j = 1,nj + lats(j) = yc(1,j) + end do + pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) + pos_scmlon = mod(scmlon + 360._r8, 360._r8) + start(1) = (MINLOC(abs(pos_lons - pos_scmlon), dim=1)) + start(2) = (MINLOC(abs(lats -scmlat ), dim=1)) + count(:) = 1 + deallocate(lons) + deallocate(lats) + + ! read in value of nearest neighbor lon and RESET scmlat + rcode = pio_get_var(pioid, varid_xc, start, count, scol_data) + call pio_check_err(rcode, 'pio_get_var for xc in file '//trim(domain_file)) + scmlon = scol_data(1) + + ! read in value of nearest neighbor lon and RESET scmlon + rcode = pio_get_var(pioid, varid_yc, start, count, scol_data) + call pio_check_err(rcode, 'pio_get_var for yc in file '//trim(domain_file)) + scmlat = scol_data(1) + + ! get area of gridcell + rcode = pio_get_var(pioid, varid_area, start, count, scol_data) + call pio_check_err(rcode, 'pio_get_var for area in file '//trim(domain_file)) + scol_area = scol_data(1) + + ! reset ni and nj to be single point values + ni = 1 + nj = 1 + + ! determine mincornerCoord and maxcornerCoord neede to create ESMF grid + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scmlon - scol_area/2._r8 ! min lon + mincornerCoord(2) = scmlat - scol_area/2._r8 ! min lat + maxcornerCoord(1) = scmlon + scol_area/2._r8 ! max lon + maxcornerCoord(2) = scmlat + scol_area/2._r8 ! max lat + deallocate(xc,yc) + + else + + ! allocate xv and yv and read them in + allocate(xv(nv,ni,nj)) + allocate(yv(nv,ni,nj)) + rcode = pio_get_var(pioid, varid_xv, xv) + call pio_check_err(rcode, 'pio_get_var for xv in file '//trim(domain_file)) + rcode = pio_get_var(pioid, varid_yv, yv) + call pio_check_err(rcode, 'pio_get_var for yv in file '//trim(domain_file)) + + ! determine mincornerCoord and maxcornerCoord neede to create ESMF grid + maxIndex(1) = ni ! number of lons + maxIndex(2) = nj ! number of lats + mincornerCoord(1) = xv(1,1,1) ! min lon + mincornerCoord(2) = yv(1,1,1) ! min lat + maxcornerCoord(1) = xv(3,ni,nj) ! max lon + maxcornerCoord(2) = yv(3,ni,nj) ! max lat + deallocate(xv,yv) + + end if + + ! close file + call pio_seterrorhandling(pioid, PIO_INTERNAL_ERROR) + call pio_closefile(pioid) + + ! create the ESMF grid + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the lgrid + mesh_lndcreate = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set the mesh mask to 1 + call ESMF_MeshGet(mesh_lndcreate, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(mesh_lndcreate, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lnd_mask(numownedelements)) + lnd_mask(:) = 1 + ! call ESMF_MeshSet(mesh_lndcreate, elementMask=lnd_mask, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine ldecomp and ldomain + call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Initialize processor bounds + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create gindex_ctsm + nlnd = endg - begg + 1 + allocate(gindex_ctsm(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_ctsm(n) = ldecomp%gdc2glo(g) + end do + + ! Initialize domain data structure + isgrid2d = .true. + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask and ldomain%frac + do g = begg, endg + ldomain%mask(g) = 1 + ldomain%frac(g) = 1._r8 + end do + + ! Generate a new mesh on the gindex decomposition + distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + mesh_ctsm = ESMF_MeshCreate(mesh_lndcreate, elementDistGrid=distgrid_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set ldomain%lonc, ldomain%latc and ldomain%area + call lnd_set_ldomain_gridinfo_from_mesh(mesh_ctsm, vm, gindex_ctsm, begg, endg, isgrid2d, ni, nj, ldomain, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(lnd_mask) + + end subroutine lnd_set_decomp_and_domain_from_createmesh + !=============================================================================== subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) @@ -313,136 +484,6 @@ subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) end subroutine lnd_get_global_dims - !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_newmesh(domain_file, mesh, ni, nj, rc) - - ! Generate a new mesh from the input domain file and set the mask to 1 - - use decompInitMod , only : decompInit_lnd, decompInit_lnd3D - use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use domainMod , only : ldomain, domain_init - use clm_varctl , only : use_soil_moisture_streams, single_column - use clm_varpar , only : nlevsoi - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror - use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var - use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable - - ! input/output variables - character(len=CL) , intent(in) :: domain_file - type(ESMF_Mesh) , intent(out) :: mesh - integer , intent(out) :: ni,nj ! global grid dimensions - integer , intent(out) :: rc - - ! local variables - logical :: isgrid2d - integer :: g,n - integer :: nv - integer :: ncid, ierr - integer :: dimid_ni, dimid_nj, dimid_nv - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - type(ESMF_Grid) :: lgrid - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) - integer :: varid_xv, varid_yv - integer :: numownedelements - integer, allocatable :: lnd_mask(:) - type(bounds_type) :: bounds ! bounds - integer :: begg,endg - integer :: nlnd - integer, pointer :: gindex_lnd(:) ! global index space for just land points - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! open file - ierr = nf90_open(domain_file, NF90_NOWRITE, ncid) - call nc_check_err(ierr, 'nf90_open', trim(domain_file)) - ! get dimension ids - ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) - call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(domain_file)) - ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) - call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(domain_file)) - ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) - call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(domain_file)) - ! get dimension values - ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) - call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(domain_file)) - ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) - call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(domain_file)) - ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) - call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(domain_file)) - ! get variable ids - ierr = nf90_inq_varid(ncid, 'xv', varid_xv) - call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(domain_file)) - ierr = nf90_inq_varid(ncid, 'yv', varid_yv) - call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(domain_file)) - ! allocate memory for variables and get variable values - allocate(xv(nv,ni,nj), yv(nv,ni,nj)) - ierr = nf90_get_var(ncid, varid_xv, xv) - call nc_check_err(ierr, 'nf90_get_var for xv', trim(domain_file)) - ierr = nf90_get_var(ncid, varid_yv, yv) - call nc_check_err(ierr, 'nf90_get_var for yv', trim(domain_file)) - ! close file - ierr = nf90_close(ncid) - call nc_check_err(ierr, 'nf90_close', trim(domain_file)) - ! create the grid - maxIndex(1) = ni ! number of lons - maxIndex(2) = nj ! number of lats - mincornerCoord(1) = xv(1,1,1) ! min lon - mincornerCoord(2) = yv(1,1,1) ! min lat - maxcornerCoord(1) = xv(3,ni,nj) ! max lon - maxcornerCoord(2) = yv(3,ni,nj) ! max lat - deallocate(xv,yv) - lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & - mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & - staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create the mesh from the grid - mesh = ESMF_MeshCreate(lgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set the mesh mask to 1 - call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lnd_mask(numownedelements)) - lnd_mask(:) = 1 - call ESMF_MeshSet(mesh, elementMask=lnd_mask, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ldecomp and ldomain - call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) - if (use_soil_moisture_streams) then - call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) - end if - - ! Initialize processor bounds - call get_proc_bounds(bounds) - begg = bounds%begg - endg = bounds%endg - - ! Create ctsm gindex_lnd - nlnd = endg - begg + 1 - allocate(gindex_lnd(nlnd)) - do g = begg, endg - n = 1 + (g - begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - ! Initialize domain data structure - isgrid2d = .true. - call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) - - ! Determine ldomain%mask and ldomain%frac - do g = begg, endg - ldomain%mask(g) = 1 - ldomain%frac(g) = 1._r8 - end do - deallocate(lnd_mask) - - end subroutine lnd_set_decomp_and_domain_from_newmesh - !=============================================================================== subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask_glob, lndfrac_glob, rc) @@ -648,7 +689,7 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr integer , intent(in) :: gindex(:) integer , intent(in) :: begg,endg logical , intent(in) :: isgrid2d - integer , intent(in) :: ni, nj + integer , intent(in) :: ni, nj type(domain_type) , intent(inout) :: ldomain integer , intent(out) :: rc @@ -665,8 +706,8 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr type(ESMF_Field) :: areaField ! for sanity check - remove when this is done - type(file_desc_t) :: ncid ! netcdf id - character(len=CL) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + character(len=CL) :: locfn ! local file name real(r8), pointer :: lonc_atmlndfrc(:) real(r8), pointer :: latc_atmlndfrc(:) !------------------------------------------------------------------------------- @@ -677,8 +718,6 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do g = begg,endg @@ -748,7 +787,8 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr call ncd_io(ncid=ncid, varname= 'yc' , flag='read', data=latc_atmlndfrc , dim1name=grlnd) do g = begg,endg n = g - begg + 1 - if (abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) > 1.e-11) then + if ( abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) > 1.e-11 .and. & + abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) /= 360._r8) then write(6,'(a,3(d20.13,2x))')'ERROR: lonc_atmlndfrac(n), ldomain%lonc(g), abs(diff) = ',& lonc_atmlndfrc(n), ldomain%lonc(g), abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) call shr_sys_abort() @@ -766,21 +806,15 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr end subroutine lnd_set_ldomain_gridinfo_from_mesh !=============================================================================== - subroutine nc_check_err(ierror, description, filename) - - use shr_sys_mod , only : shr_sys_abort - use netcdf , only : nf90_noerr, nf90_strerror - + subroutine pio_check_err(ierror, description) + use pio, only : PIO_NOERR integer , intent(in) :: ierror character(*), intent(in) :: description - character(*), intent(in) :: filename - - if (ierror /= nf90_noerr) then - write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& - '". Error message:', trim(nf90_strerror(ierror)) + if (ierror /= PIO_NOERR) then + write (*,'(6a)') 'ERROR ', trim(description) call shr_sys_abort() endif - end subroutine nc_check_err + end subroutine pio_check_err !=============================================================================== logical function chkerr(rc, line, file) @@ -796,4 +830,52 @@ logical function chkerr(rc, line, file) endif end function chkerr + !=============================================================================== + subroutine lnd_set_read_write_landmask(write_file, read_file, lndmask_glob, lndfrac_glob, gsize) + + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen + use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile + + ! input/output variables + logical , intent(in) :: write_file + logical , intent(in) :: read_file + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(in) :: gsize + + ! local variables + type(file_desc_t) :: pioid ! netcdf file id + integer :: dimid + character(len=CL) :: flandfrac = 'landfrac.nc' + !------------------------------------------------------------------------------- + + if (write_file) then + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: writing landmask and landfrac data to landfrac.nc' + write(iulog,*) + end if + call ncd_pio_createfile(pioid, trim(flandfrac)) + call ncd_defdim (pioid, 'gridcell', gsize, dimid) + call ncd_defvar(ncid=pioid, varname='landmask', xtype=ncd_int , dim1name='gridcell') + call ncd_defvar(ncid=pioid, varname='landfrac', xtype=ncd_double, dim1name='gridcell') + call ncd_enddef(pioid) + call ncd_io(ncid=pioid, varname='landmask', data=lndmask_glob, flag='write') + call ncd_io(ncid=pioid, varname='landfrac', data=lndfrac_glob, flag='write') + call ncd_pio_closefile(pioid) + else if (read_file) then + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: reading landmask and landfrac data from landfrac.nc' + write(iulog,*) + end if + call ncd_pio_openfile (pioid, trim(flandfrac), 0) + call ncd_io(ncid=pioid, varname='landmask', data=lndmask_glob, flag='read') + call ncd_io(ncid=pioid, varname='landfrac', data=lndfrac_glob, flag='read') + call ncd_pio_closefile(pioid) + end if + + end subroutine lnd_set_read_write_landmask + end module lnd_set_decomp_and_domain diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index f2e07696f9..53cbd237c2 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -348,16 +348,6 @@ subroutine initialize2(ni,nj) avgflag='A', long_name='convective boundary height', & ptr_col=col%zii, default='inactive') - ! If single-column determine closest latitude and longitude - ! TODO: for mct this should use fatmlnd file - for nuopc should use esmf functionality for nearest neighbor, - ! for lilac not applicable - ! TODO: these values are never used - is scam even working for ctsm? - ! if (single_column) then - ! call getfil (fsurdat, locfn, 0) - ! call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & - ! closelat, closelon, closelatidx, closelonidx) - ! end if - ! Initialize instances of all derived types as well as time constant variables call clm_instInit(bounds_proc) From 6455221078d05af8b1c4cd6cc2d94cead2db5a26 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 11 Jan 2021 12:40:17 -0700 Subject: [PATCH 064/219] added more diagnostic output info --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 244 ++++++++++++---------------- src/cpl/nuopc/lnd_import_export.F90 | 71 ++++---- 2 files changed, 143 insertions(+), 172 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 373c16c486..0b1c41445c 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -165,17 +165,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - integer :: lmpicom - integer :: ierr - integer :: n - integer :: localpet - integer :: compid ! component id - integer :: shrlogunit ! original log unit - character(len=CL) :: cvalue - character(len=CL) :: logmsg - logical :: isPresent, isSet - logical :: cism_evolve + type(ESMF_VM) :: vm + integer :: lmpicom + integer :: ierr + integer :: n + integer :: localpet + integer :: compid ! component id + integer :: shrlogunit ! original log unit + character(len=CL) :: cvalue + character(len=CL) :: logmsg + logical :: cism_evolve + character(len=CL) :: atm_model + character(len=CL) :: rof_model + character(len=CL) :: glc_model character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" !------------------------------------------------------------------------------- @@ -225,104 +227,69 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise fields !---------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - flds_scalar_name = trim(cvalue) - call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + flds_scalar_name = trim(cvalue) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue, *) flds_scalar_num - write(logmsg,*) flds_scalar_num - call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue, *) flds_scalar_num + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nx - write(logmsg,*) flds_scalar_index_nx - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue,*) flds_scalar_index_nx + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_ny - write(logmsg,*) flds_scalar_index_ny - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue,*) flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nextsw_cday - write(logmsg,*) flds_scalar_index_nextsw_cday - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') - endif - - call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=cvalue, rc=rc) + read(cvalue,*) flds_scalar_index_nextsw_cday + call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=rof_model, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'srof' .or. trim(cvalue) == 'drof') then + if (trim(rof_model) == 'srof' .or. trim(rof_model) == 'drof') then rof_prognostic = .false. else rof_prognostic = .true. end if - - call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=atm_model, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'satm' .or. trim(cvalue) == 'datm') then + if (trim(atm_model) == 'satm' .or. trim(atm_model) == 'datm') then atm_prognostic = .false. else atm_prognostic = .true. end if - - call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=glc_model, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'sglc') then + if (trim(glc_model) == 'sglc') then glc_present = .false. else glc_present = .true. - cism_evolve = .true. - call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + end if + if (.not. glc_present) then + cism_evolve = .false. + else + call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call ESMF_LogWrite(trim(subname)//' cism_evolve = '//trim(cvalue), ESMF_LOGMSG_INFO) - if (trim(cvalue) .eq. '.true.') then - cism_evolve = .true. - else if (trim(cvalue) .eq. '.false.') then - cism_evolve = .false. - else - call shr_sys_abort(subname//'Could not determine cism_evolve value '//trim(cvalue)) - endif - else - call shr_sys_abort(subname//'Need to set cism_evolve if glc is present') + if (trim(cvalue) == '.true.') then + cism_evolve = .true. + else if (trim(cvalue) == '.false.') then + cism_evolve = .false. endif end if if (masterproc) then - write(iulog,*)' atm_prognostic = ',atm_prognostic - write(iulog,*)' rof_prognostic = ',rof_prognostic - write(iulog,*)' glc_present = ',glc_present - if (glc_present) write(iulog,*)' cism_evolve = ',cism_evolve + write(iulog,'(a )')' atm component = '//trim(atm_model) + write(iulog,'(a )')' rof component = '//trim(rof_model) + write(iulog,'(a )')' glc component = '//trim(glc_model) + write(iulog,'(a,l )')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,l )')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,l )')' glc_present = ',glc_present + if (glc_present) then + write(iulog,'(a,l)')' cism_evolve = ',cism_evolve + end if + write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) + write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num + write(iulog,'(a,i8)')' flds_scalar_index_nx = ',flds_scalar_index_nx + write(iulog,'(a,i8)')' flds_scalar_index_ny = ',flds_scalar_index_ny + write(iulog,'(a,i8)')' flds_scalar_index_nextsw_cday = ',flds_scalar_index_nextsw_cday end if call advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) @@ -373,25 +340,25 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: dtime_sync ! coupling time-step from the input synchronization clock integer :: localPet integer :: localpecount - character(ESMF_MAXSTR) :: cvalue ! config data - real(r8) :: scmlat ! single-column latitude - real(r8) :: scmlon ! single-column longitude real(r8) :: nextsw_cday ! calday from clock of next radiation computation - character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) character(len=CL) :: calendar ! calendar type name - character(len=CL) :: hostname ! hostname of machine running on - character(len=CL) :: model_version ! Model version - character(len=CL) :: username ! user running the model - integer :: nsrest ! ctsm restart type logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + integer :: nsrest ! ctsm restart type integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! original log unit type(bounds_type) :: bounds ! bounds integer :: ni, nj + character(len=CL) :: cvalue ! config data character(len=CL) :: meshfile_mask character(len=CL) :: domain_file + character(len=CL) :: ctitle ! case description title + character(len=CL) :: caseid ! case identifier name + real(r8) :: scmlat ! single-column latitude + real(r8) :: scmlon ! single-column longitude + character(len=CL) :: model_version ! Model version + character(len=CL) :: hostname ! hostname of machine running on + character(len=CL) :: username ! user running the model character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -418,49 +385,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !$ call omp_set_num_threads(localPeCount) - !---------------------- - ! Obtain attribute values - !---------------------- - - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) caseid - ctitle= trim(caseid) - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) single_column - call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) brnch_retain_casename - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) starttype - call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) model_version - call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hostname - call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) username - - if ( trim(starttype) == trim(startup_run)) then - nsrest = nsrStartup - else if (trim(starttype) == trim(continue_run)) then - nsrest = nsrContinue - else if (trim(starttype) == trim(branch_run)) then - nsrest = nsrBranch - else - call shr_sys_abort( subname//' ERROR: unknown starttype' ) - end if - !---------------------- ! Consistency check on namelist filename !---------------------- @@ -507,6 +431,33 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- ! Initialize CTSM time manager !---------------------- + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) caseid + ctitle= trim(caseid) + call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) model_version + call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) username + call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hostname + call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) single_column + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + + ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( & @@ -517,14 +468,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ref_tod_in=ref_tod, & dtime_in=dtime_sync) - !---------------------------------------------------------------------------- ! Set model clock in lnd_comp_shr - !---------------------------------------------------------------------------- model_clock = clock ! --------------------- ! Initialize first phase of ctsm ! --------------------- + call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) brnch_retain_casename + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + + if ( trim(starttype) == trim(startup_run)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(continue_run)) then + nsrest = nsrContinue + else if (trim(starttype) == trim(branch_run)) then + nsrest = nsrBranch + else + call shr_sys_abort( subname//' ERROR: unknown starttype' ) + end if + ! set default values for run control variables call clm_varctl_set(& caseid_in=caseid, ctitle_in=ctitle, & diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 1ba40f22f1..2265ee4263 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -135,7 +135,7 @@ module lnd_import_export character(*), parameter :: Sl_topo_elev = 'Sl_topo_elev' character(*), parameter :: Flgl_qice_elev = 'Flgl_qice_elev' - logical :: send_to_atm = .false. + logical :: send_to_atm character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: u_FILE_u = & @@ -162,10 +162,12 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - character(ESMF_MAXSTR) :: cvalue - integer :: n, num + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + character(len=CS) :: cvalue + integer :: n, num + logical :: send_co2_to_atm = .false. + logical :: recv_co2_fr_atm = .false. character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -174,33 +176,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! determine necessary toggles for below - !-------------------------------- - - if (atm_prognostic) then - send_to_atm = .true. - else - send_to_atm = .false. - end if - ! for now always send to atm - send_to_atm = .true. - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) - ! Determine number of elevation classes call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -214,6 +189,36 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! Advertise export fields !-------------------------------- + ! Is any data going to sent back to the atm + ! For now always send to atm + if (atm_prognostic) then + send_to_atm = .true. + else + send_to_atm = .false. + end if + send_to_atm = .true. + + if (send_to_atm) then + call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2a + call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2b + call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2c + if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. + if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. + if (masterproc) then + write(iulog,'(a,l)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,l)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,l)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,l)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,l)') 'receiving co2 from atm = ',recv_co2_fr_atm + end if + end if + ! The following namelist reads should always be called regardless of the send_to_atm value ! Dry Deposition velocities from land - ALSO initialize drydep here @@ -255,7 +260,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_methane ) ! dust fluxes from land (4 sizes) call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_flxdst, ungridded_lbound=1, ungridded_ubound=4) - if (flds_co2b .or. flds_co2c) then + if (send_co2_to_atm) then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_fco2_lnd ) ! co2 fields from land end if if (drydep_nflds > 0) then From 219083113137926af0d1be522375c878a31a42b0 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 15 Jan 2021 07:45:09 -0700 Subject: [PATCH 065/219] replace constant lma --- src/biogeophys/CanopyFluxesMod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 348af3a613..32015ac134 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -228,7 +228,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice, c_to_b use clm_varcon , only : denh2o, tfrz, tlsai_crit, alpha_aero use clm_varcon , only : c14ratio - use clm_varcon , only : c_water, c_dry_biomass + use clm_varcon , only : c_water, c_dry_biomass, c_to_b use perf_mod , only : t_startf, t_stopf use QSatMod , only : QSat use CLMFatesInterfaceMod, only : hlm_fates_interface_type @@ -447,6 +447,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, is_shrub => pftcon%is_shrub , & ! Input: shrub patch or not dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) + slatop => pftcon%slatop , & ! SLA at top of canopy [m^2/gC] fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) @@ -728,14 +729,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, sa_stem(p) = 0.0 endif - ! cross-sectional area of stems - carea_stem = shr_const_pi * (dbh(p)*0.5)**2 - ! if using Satellite Phenology mode, calculate leaf and stem biomass if(.not. use_cn) then - ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - leaf_biomass(p) = 0.25_r8 * max(0.01_r8, sa_leaf(p)) & + ! 2gbiomass/gC * (1/SLA) * 1e-3 = kg dry mass/m2(leaf) + leaf_biomass(p) = (1.e-3_r8*c_to_b/slatop(patch%itype(p))) & + * max(0.01_r8, 0.5_r8*sa_leaf(p)) & / (1.-fbw(patch%itype(p))) + ! cross-sectional area of stems + carea_stem = shr_const_pi * (dbh(p)*0.5)**2 stem_biomass(p) = carea_stem * htop(p) * k_cyl_vol & * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & /(1.-fbw(patch%itype(p))) @@ -1346,13 +1347,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Test for convergence itlef = itlef+1 - num_iter(p) = itlef if (itlef > itmin) then do f = 1, fn p = filterp(f) dele(p) = abs(efe(p)-efeb(p)) efeb(p) = efe(p) det(p) = max(del(p),del2(p)) + num_iter(p) = itlef end do fnold = fn fn = 0 From f74a74d1997856286aa08b0c30a7258c89029c22 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 15 Jan 2021 21:46:29 -0700 Subject: [PATCH 066/219] Set updated paramsfile with updated nstem/dbh from Sean --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index b80f529904..c09e2e3db7 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -473,7 +473,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c210112.nc +lnd/clm2/paramdata/ctsm51_params.c210115.nc lnd/clm2/paramdata/clm50_params.c210112.nc lnd/clm2/paramdata/clm45_params.c210112.nc From e565c37ccfc11a45f46d7b0ccd2f0aee6ffc9e8c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 17 Jan 2021 15:33:28 -0700 Subject: [PATCH 067/219] updates to Externals.cfg needed for PR --- Externals.cfg | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index aecac45976..a0cf8ffb44 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -8,22 +8,24 @@ required = True local_path = components/cism protocol = git repo_url = https://github.com/ESCOMP/CISM-wrapper -tag = cism2_1_69 +tag = df1bbfa externals = Externals_CISM.cfg required = True +# rtm branch nuopc_cap - needs to have a PR to master [rtm] local_path = components/rtm protocol = git repo_url = https://github.com/ESCOMP/RTM -tag = rtm1_0_73 +tag = c2927b6 required = True +# mosart branch jedwards/nuopc_update - needs to have a PR to master [mosart] local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -tag = mosart1_0_38 +tag = 0089e744a required = True [mizuRoute] @@ -33,25 +35,28 @@ repo_url = https://github.com/nmizukami/mizuRoute hash = 34723c2 required = True +# this is cime master and needs a branch that will enable lilac to build [cime] local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.32_a02 +hash = 91c9f65b3 required = True +# cmeps branch mvertens/dynfrac (has changes from mvertens/ocn2glc_coupling) [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -hash = 7654038 +hash = b829de9 required = True -[cdeps] +# cdeps branch mvertens/dynfrac +[cdeps] local_path = components/cdeps protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git -hash = 45b7a85 +hash = 2e77890 required = True [doc-builder] From 8dceacdd343aabdc9a4b2381ba18e7941ef16183 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 19 Jan 2021 13:54:18 -0700 Subject: [PATCH 068/219] replace limit of evaporation from surface layer --- src/biogeophys/BareGroundFluxesMod.F90 | 26 +++++- src/biogeophys/CanopyFluxesMod.F90 | 17 ++++ src/biogeophys/SoilFluxesMod.F90 | 118 +++++++++++-------------- 3 files changed, 95 insertions(+), 66 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 89893e3aa4..cbcc3694cb 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -89,6 +89,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & swbgt, hmdex, dis_coi, dis_coiS, THIndex, & SwampCoolEff, KtoC, VaporPres + use clm_time_manager , only : get_step_size_real + ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -143,6 +145,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] real(r8) :: www ! surface soil wetness [-] + + real(r8) :: snow_evaporation_limit + real(r8) :: ev_snow_unconstrained + real(r8) :: dtime ! land model time step (sec) !------------------------------------------------------------------------------ associate( & @@ -202,7 +208,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature beta => temperature_inst%beta_col , & ! Input: [real(r8) (:) ] coefficient of conective velocity [-] - frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] @@ -259,6 +265,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & endp => bounds%endp & ) + ! Get step size + + dtime = get_step_size_real() + ! First do some simple settings of values over points where frac vegetation covered ! by snow is zero @@ -417,6 +427,20 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & qflx_ev_soil(p) = -raiw*(forc_q(c) - qg_soil(c)) qflx_ev_h2osfc(p) = -raiw*(forc_q(c) - qg_h2osfc(c)) + ! adjust snow surface layer evaporation + j = col%snl(c)+1 + if ((h2osoi_ice(c,j)+h2osoi_liq(c,j)) > 0._r8 .and. j < 1) then + ! assumes for j < 1 that frac_sno_eff > 0 + snow_evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno_eff(c) + if (qflx_ev_snow(p)*dtime > snow_evaporation_limit) then + ev_snow_unconstrained = qflx_ev_snow(p) + qflx_ev_snow(p) = snow_evaporation_limit/dtime + + qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(ev_snow_unconstrained - qflx_ev_snow(p)) + qflx_evap_tot(p) = qflx_evap_soi(p) + endif + endif + ! 2 m height air temperature t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 348af3a613..bfc1499455 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -431,6 +431,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8), parameter :: min_stem_diameter = 0.05_r8 !minimum stem diameter for which to calculate stem interactions integer :: dummy_to_make_pgi_happy + + real(r8) :: snow_evaporation_limit + real(r8) :: ev_snow_unconstrained + !------------------------------------------------------------------------------ SHR_ASSERT_ALL_FL((ubound(downreg_patch) == (/bounds%endp/)), sourcefile, __LINE__) @@ -1435,6 +1439,19 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, delq_h2osfc = wtalq(p)*qg_h2osfc(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) qflx_ev_h2osfc(p) = forc_rho(c)*wtgq(p)*delq_h2osfc + ! adjust snow surface layer evaporation + j = col%snl(c)+1 + if ((h2osoi_ice(c,j)+h2osoi_liq(c,j)) > 0._r8 .and. j < 1) then + ! assumes for j < 1 that frac_sno_eff > 0 + snow_evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno(c) + if (qflx_ev_snow(p)*dtime > snow_evaporation_limit) then + ev_snow_unconstrained = qflx_ev_snow(p) + qflx_ev_snow(p) = snow_evaporation_limit/dtime + + qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno(c)*(ev_snow_unconstrained - qflx_ev_snow(p)) + endif + endif + ! 2 m height air temperature t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 10082db373..f70800ecf6 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -74,17 +74,12 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & integer :: p,c,g,j,pi,l ! indices integer :: fc,fp ! lake filtered column and pft indices real(r8) :: dtime ! land model time step (sec) - real(r8) :: egsmax(bounds%begc:bounds%endc) ! max. evaporation which soil can provide at one time step - real(r8) :: egirat(bounds%begc:bounds%endc) ! ratio of topsoil_evap_tot : egsmax real(r8) :: tinc(bounds%begc:bounds%endc) ! temperature difference of two time step - real(r8) :: sumwt(bounds%begc:bounds%endc) ! temporary - real(r8) :: evaprat(bounds%begp:bounds%endp) ! ratio of qflx_evap_soi/topsoil_evap_tot - real(r8) :: save_qflx_evap_soi ! temporary storage for qflx_evap_soi - real(r8) :: topsoil_evap_tot(bounds%begc:bounds%endc) ! column-level total evaporation from top soil layer real(r8) :: eflx_lwrad_del(bounds%begp:bounds%endp) ! update due to eflx_lwrad real(r8) :: t_grnd0(bounds%begc:bounds%endc) ! t_grnd of previous time step real(r8) :: lw_grnd - real(r8) :: fsno_eff + real(r8) :: evaporation_limit + real(r8) :: ev_unconstrained !----------------------------------------------------------------------- associate( & @@ -186,23 +181,8 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & tinc(c) = t_grnd(c) - t_grnd0(c) - ! Determine ratio of topsoil_evap_tot - - egsmax(c) = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) / dtime - - ! added to trap very small negative soil water,ice - - if (egsmax(c) < 0._r8) then - egsmax(c) = 0._r8 - end if end do - ! A preliminary pft loop to determine if corrections are required for - ! excess evaporation from the top soil layer... Includes new logic - ! to distribute the corrections between patches on the basis of their - ! evaporative demands. - ! egirat holds the ratio of demand to availability if demand is - ! greater than availability, or 1.0 otherwise. ! Correct fluxes to present soil temperature do fp = 1,num_nolakep @@ -224,40 +204,43 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & endif end do - ! Set the column-average qflx_evap_soi as the weighted average over all patches - ! but only count the patches that are evaporating - - do fc = 1,num_nolakec - c = filter_nolakec(fc) - topsoil_evap_tot(c) = 0._r8 - sumwt(c) = 0._r8 - end do - - do pi = 1,max_patch_per_col - do fc = 1,num_nolakec - c = filter_nolakec(fc) - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - topsoil_evap_tot(c) = topsoil_evap_tot(c) + qflx_evap_soi(p) * patch%wtcol(p) - end if - end if - end do - end do + ! evaporation from snow may be larger than available moisture + ! after flux update from tinc*cgrnd, repeat adjustment of ev_snow + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + j = col%snl(c)+1 + ! snow layers + if (j < 1) then + ! assumes for j < 1 that frac_sno_eff > 0 + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno_eff(c) + if (qflx_ev_snow(p)*dtime > evaporation_limit) then + ev_unconstrained = qflx_ev_snow(p) + qflx_ev_snow(p) = evaporation_limit/dtime + + qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(ev_unconstrained - qflx_ev_snow(p)) + ! conserve total energy flux + eflx_sh_grnd(p) = eflx_sh_grnd(p) + frac_sno_eff(c)*(ev_unconstrained - qflx_ev_snow(p))*htvp(c) + endif + endif + + ! top soil layer for urban columns; adjust qflx_evap_soi directly + if (lun%urbpoi(patch%landunit(p))) then + j = 1 + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p) + if (qflx_evap_soi(p)*dtime > evaporation_limit) then + ev_unconstrained = qflx_evap_soi(p) + qflx_evap_soi(p) = evaporation_limit/dtime + ! conserve total energy flux + eflx_sh_grnd(p) = eflx_sh_grnd(p) +(ev_unconstrained - qflx_evap_soi(p))*htvp(c) + endif + endif + + enddo + call t_stopf('bgp2_loop_1') call t_startf('bgp2_loop_2') - ! Calculate ratio for rescaling patch-level fluxes to meet availability - - do fc = 1,num_nolakec - c = filter_nolakec(fc) - if (topsoil_evap_tot(c) > egsmax(c)) then - egirat(c) = (egsmax(c)/topsoil_evap_tot(c)) - else - egirat(c) = 1.0_r8 - end if - end do - do fp = 1,num_nolakep p = filter_nolakep(fp) c = patch%column(p) @@ -265,18 +248,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & g = patch%gridcell(p) j = col%snl(c)+1 - ! Correct soil fluxes for possible evaporation in excess of top layer water - ! excess energy is added to the sensible heat flux from soil - - if (egirat(c) < 1.0_r8) then - save_qflx_evap_soi = qflx_evap_soi(p) - qflx_evap_soi(p) = qflx_evap_soi(p) * egirat(c) - eflx_sh_grnd(p) = eflx_sh_grnd(p) + (save_qflx_evap_soi - qflx_evap_soi(p))*htvp(c) - qflx_ev_snow(p) = qflx_ev_snow(p) * egirat(c) - qflx_ev_soil(p) = qflx_ev_soil(p) * egirat(c) - qflx_ev_h2osfc(p) = qflx_ev_h2osfc(p) * egirat(c) - end if - ! Update ev_snow for urban landunits here if (lun%urbpoi(l)) then qflx_ev_snow(p) = qflx_evap_soi(p) @@ -318,6 +289,14 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) + + if (c==82328) then + write(*,*) ' ' + write(*,*) 'evaptot1: ',c,j,qflx_evap_tot(p),qflx_evap_tot(p)*dtime + write(*,*) 'evaptot2: ',c,j,qflx_evap_soi(p),qflx_evap_veg(p) + write(*,*) ' ' + endif + eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then eflx_lh_tot_r(p)= eflx_lh_tot(p) @@ -352,6 +331,15 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._r8) then qflx_liqevap_from_top_layer(p) = max(qflx_ev_snow(p)*(h2osoi_liq(c,j)/ & (h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8) + !scs + if(c==-8212) then + write(iulog,*) 'evtupdate: ',c,tinc(c)*cgrndl(p) + write(iulog,*) 'evsnow2: ',c,j,qflx_ev_snow(p),qflx_liqevap_from_top_layer(p),qflx_liqevap_from_top_layer(p)*dtime + write(*,*) 'h2oamt2: ',c,j,h2osoi_liq(c,j),h2osoi_ice(c,j),(h2osoi_ice(c,j)+h2osoi_liq(c,j)) + write(*,*) 'h2ofrac2: ',c,j,(h2osoi_liq(c,j))/(h2osoi_ice(c,j)+h2osoi_liq(c,j)) + write(*,*) ' ' + endif + else qflx_liqevap_from_top_layer(p) = 0._r8 end if From 3a4ce3d171b3b5f74b30dc4c51d18eafff41a1de Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 19 Jan 2021 13:57:28 -0700 Subject: [PATCH 069/219] remove write statements --- src/biogeophys/SoilFluxesMod.F90 | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index f70800ecf6..eecdcb24a8 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -290,13 +290,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(p) qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) - if (c==82328) then - write(*,*) ' ' - write(*,*) 'evaptot1: ',c,j,qflx_evap_tot(p),qflx_evap_tot(p)*dtime - write(*,*) 'evaptot2: ',c,j,qflx_evap_soi(p),qflx_evap_veg(p) - write(*,*) ' ' - endif - eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then eflx_lh_tot_r(p)= eflx_lh_tot(p) @@ -331,15 +324,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._r8) then qflx_liqevap_from_top_layer(p) = max(qflx_ev_snow(p)*(h2osoi_liq(c,j)/ & (h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8) - !scs - if(c==-8212) then - write(iulog,*) 'evtupdate: ',c,tinc(c)*cgrndl(p) - write(iulog,*) 'evsnow2: ',c,j,qflx_ev_snow(p),qflx_liqevap_from_top_layer(p),qflx_liqevap_from_top_layer(p)*dtime - write(*,*) 'h2oamt2: ',c,j,h2osoi_liq(c,j),h2osoi_ice(c,j),(h2osoi_ice(c,j)+h2osoi_liq(c,j)) - write(*,*) 'h2ofrac2: ',c,j,(h2osoi_liq(c,j))/(h2osoi_ice(c,j)+h2osoi_liq(c,j)) - write(*,*) ' ' - endif - else qflx_liqevap_from_top_layer(p) = 0._r8 end if From 1675cbb23fc04f798ed0c24ab27704a6b060efea Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 22 Jan 2021 07:35:26 -0700 Subject: [PATCH 070/219] remove initial corrections --- src/biogeophys/BareGroundFluxesMod.F90 | 22 ---------------------- src/biogeophys/CanopyFluxesMod.F90 | 16 ---------------- src/biogeophys/SoilFluxesMod.F90 | 22 +++++++++++++++++++--- src/biogeophys/SoilHydrologyMod.F90 | 14 +++++++++++--- 4 files changed, 30 insertions(+), 44 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index cbcc3694cb..0e6985c22b 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -89,7 +89,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & swbgt, hmdex, dis_coi, dis_coiS, THIndex, & SwampCoolEff, KtoC, VaporPres - use clm_time_manager , only : get_step_size_real ! ! !ARGUMENTS: @@ -146,9 +145,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] real(r8) :: www ! surface soil wetness [-] - real(r8) :: snow_evaporation_limit - real(r8) :: ev_snow_unconstrained - real(r8) :: dtime ! land model time step (sec) !------------------------------------------------------------------------------ associate( & @@ -265,10 +261,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & endp => bounds%endp & ) - ! Get step size - - dtime = get_step_size_real() - ! First do some simple settings of values over points where frac vegetation covered ! by snow is zero @@ -427,20 +419,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & qflx_ev_soil(p) = -raiw*(forc_q(c) - qg_soil(c)) qflx_ev_h2osfc(p) = -raiw*(forc_q(c) - qg_h2osfc(c)) - ! adjust snow surface layer evaporation - j = col%snl(c)+1 - if ((h2osoi_ice(c,j)+h2osoi_liq(c,j)) > 0._r8 .and. j < 1) then - ! assumes for j < 1 that frac_sno_eff > 0 - snow_evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno_eff(c) - if (qflx_ev_snow(p)*dtime > snow_evaporation_limit) then - ev_snow_unconstrained = qflx_ev_snow(p) - qflx_ev_snow(p) = snow_evaporation_limit/dtime - - qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(ev_snow_unconstrained - qflx_ev_snow(p)) - qflx_evap_tot(p) = qflx_evap_soi(p) - endif - endif - ! 2 m height air temperature t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index bfc1499455..9c26942559 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -432,9 +432,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, integer :: dummy_to_make_pgi_happy - real(r8) :: snow_evaporation_limit - real(r8) :: ev_snow_unconstrained - !------------------------------------------------------------------------------ SHR_ASSERT_ALL_FL((ubound(downreg_patch) == (/bounds%endp/)), sourcefile, __LINE__) @@ -1439,19 +1436,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, delq_h2osfc = wtalq(p)*qg_h2osfc(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) qflx_ev_h2osfc(p) = forc_rho(c)*wtgq(p)*delq_h2osfc - ! adjust snow surface layer evaporation - j = col%snl(c)+1 - if ((h2osoi_ice(c,j)+h2osoi_liq(c,j)) > 0._r8 .and. j < 1) then - ! assumes for j < 1 that frac_sno_eff > 0 - snow_evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno(c) - if (qflx_ev_snow(p)*dtime > snow_evaporation_limit) then - ev_snow_unconstrained = qflx_ev_snow(p) - qflx_ev_snow(p) = snow_evaporation_limit/dtime - - qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno(c)*(ev_snow_unconstrained - qflx_ev_snow(p)) - endif - endif - ! 2 m height air temperature t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index eecdcb24a8..ffb6aa8056 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -5,7 +5,7 @@ module SoilFluxesMod ! Updates surface fluxes based on the new ground temperature. ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun @@ -213,7 +213,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! snow layers if (j < 1) then ! assumes for j < 1 that frac_sno_eff > 0 - evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p)/frac_sno_eff(c) + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/frac_sno_eff(c) if (qflx_ev_snow(p)*dtime > evaporation_limit) then ev_unconstrained = qflx_ev_snow(p) qflx_ev_snow(p) = evaporation_limit/dtime @@ -227,7 +227,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! top soil layer for urban columns; adjust qflx_evap_soi directly if (lun%urbpoi(patch%landunit(p))) then j = 1 - evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))*patch%wtcol(p) + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) if (qflx_evap_soi(p)*dtime > evaporation_limit) then ev_unconstrained = qflx_evap_soi(p) qflx_evap_soi(p) = evaporation_limit/dtime @@ -358,6 +358,22 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & end if + ! limit only solid evaporation (sublimation) from top soil layer + ! (liquid evaporation from soil should not be limited) + if (j==1 .and. frac_h2osfc(c) < 1._r8) then + + if (real((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(p) * dtime,r4) > real(h2osoi_ice(c,j),r4)) then + + qflx_liqevap_from_top_layer(p) & + = qflx_liqevap_from_top_layer(p) & + + (qflx_solidevap_from_top_layer(p) & + - h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c)))) + qflx_solidevap_from_top_layer(p) & + = h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c))) + + endif + endif + ! Variables needed by history tape qflx_evap_can(p) = qflx_evap_veg(p) - qflx_tran_veg(p) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 436b35e1cf..61f0767ce4 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -844,11 +844,15 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then + if ((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - qflx_solidevap_from_top_layer(c)) + + if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > 1.e-8) then + call endrun(msg="solid evap too large! "//errmsg(sourcefile, __LINE__)) + endif h2osoi_ice(c,1) = 0._r8 else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime @@ -2315,11 +2319,15 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then + if ((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) + - qflx_solidevap_from_top_layer(c)) + if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > 1.e-8) then + call endrun(msg="solid evap too large! "//errmsg(sourcefile, __LINE__)) + endif + h2osoi_ice(c,1) = 0._r8 else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime From cb6a84042a47e785e365ac3629715bd22a5810d0 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Sat, 23 Jan 2021 16:48:50 -0700 Subject: [PATCH 071/219] Revisions part 1 in response to code review --- src/biogeophys/BalanceCheckMod.F90 | 52 ++++++++++------------------- src/biogeophys/WaterBalanceType.F90 | 4 --- src/main/clm_driver.F90 | 3 +- src/main/lnd2atmMod.F90 | 21 ++++++++---- 4 files changed, 34 insertions(+), 46 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index ad2cbd31dd..733f24403d 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -168,8 +168,7 @@ end subroutine BeginWaterGridcellBalance !----------------------------------------------------------------------- subroutine BeginWaterColumnBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, soilhydrology_inst, lakestate_inst, & - use_aquifer_layer) + water_inst, lakestate_inst) ! ! !DESCRIPTION: ! Initialize column-level water balance at beginning of time step, for bulk water and @@ -183,8 +182,6 @@ subroutine BeginWaterColumnBalance(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst type(lakestate_type) , intent(in) :: lakestate_inst - type(soilhydrology_type) , intent(in) :: soilhydrology_inst - logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: i @@ -196,12 +193,10 @@ subroutine BeginWaterColumnBalance(bounds, & call BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & - soilhydrology_inst, & lakestate_inst, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & - water_inst%bulk_and_tracers(i)%waterbalance_inst, & - use_aquifer_layer = use_aquifer_layer) + water_inst%bulk_and_tracers(i)%waterbalance_inst) end do end subroutine BeginWaterColumnBalance @@ -282,8 +277,12 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & call c2g(bounds, begwb_col(begc:endc), begwb_grc(begg:endg), & c2l_scale_type='urbanf', l2g_scale_type='unity') - call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg(bounds, qflx_liq_dynbal_left_to_dribble(begg:endg)) - call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg(bounds, qflx_ice_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_ice_dynbal_left_to_dribble(begg:endg)) do g = begg, endg begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & @@ -297,9 +296,8 @@ end subroutine BeginWaterGridcellBalanceSingle !----------------------------------------------------------------------- subroutine BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - soilhydrology_inst, lakestate_inst, waterstate_inst, & - waterdiagnostic_inst, waterbalance_inst, & - use_aquifer_layer) + lakestate_inst, waterstate_inst, & + waterdiagnostic_inst, waterbalance_inst) ! ! !DESCRIPTION: ! Initialize column-level water balance at beginning of time step, for bulk or a @@ -311,37 +309,19 @@ subroutine BeginWaterColumnBalanceSingle(bounds, & integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points - type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst - logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: - integer :: c, j, fc ! indices !----------------------------------------------------------------------- associate( & - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) - zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) - aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) - wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) begwb => waterbalance_inst%begwb_col , & ! Output: [real(r8) (:) ] water mass begining of the time step h2osno_old => waterbalance_inst%h2osno_old_col & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step ) - if(use_aquifer_layer) then - do fc = 1, num_nolakec - c = filter_nolakec(fc) - if (col%hydrologically_active(c)) then - if(zwt(c) <= zi(c,nlevsoi)) then - wa(c) = aquifer_water_baseline - end if - end if - end do - endif - call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstate_inst, waterdiagnostic_inst, & subtract_dynbal_baselines = .false., & @@ -413,6 +393,7 @@ subroutine BalanceCheck( bounds, & integer :: nstep ! time step number integer :: DAnstep ! time step number since last Data Assimilation (DA) integer :: indexp,indexc,indexl,indexg ! index of first found in search loop + real(r8) :: errh2o_grc(bounds%begg:bounds%endg) ! grid cell level water conservation error [mm H2O] real(r8) :: forc_rain_col(bounds%begc:bounds%endc) ! column level rain rate [mm/s] real(r8) :: forc_snow_col(bounds%begc:bounds%endc) ! column level snow rate [mm/s] real(r8) :: h2osno_total(bounds%begc:bounds%endc) ! total snow water [mm H2O] @@ -450,7 +431,6 @@ subroutine BalanceCheck( bounds, & snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) begwb_grc => waterbalance_inst%begwb_grc , & ! Input: [real(r8) (:) ] grid cell-level water mass begining of the time step endwb_grc => waterbalance_inst%endwb_grc , & ! Output: [real(r8) (:) ] grid cell-level water mass end of the time step - errh2o_grc => waterbalance_inst%errh2o_grc , & ! Output: [real(r8) (:) ] grid cell-level water conservation error (mm H2O) begwb_col => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] column-level water mass begining of the time step endwb_col => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] column-level water mass end of the time step errh2o_col => waterbalance_inst%errh2o_col , & ! Output: [real(r8) (:) ] column-level water conservation error (mm H2O) @@ -642,8 +622,12 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end(bounds, qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg)) - call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end(bounds, qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg)) + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg)) do g = bounds%begg, bounds%endg endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & @@ -704,7 +688,7 @@ subroutine BalanceCheck( bounds, & end if - ! Snow balance check at the grid cell level. + ! Snow balance check at the column level. ! Beginning snow balance variable h2osno_old is calculated once ! for both the column-level and grid cell-level balance checks. diff --git a/src/biogeophys/WaterBalanceType.F90 b/src/biogeophys/WaterBalanceType.F90 index 4d747acebe..6b10895549 100644 --- a/src/biogeophys/WaterBalanceType.F90 +++ b/src/biogeophys/WaterBalanceType.F90 @@ -42,7 +42,6 @@ module WaterBalanceType real(r8), pointer :: endwb_col (:) ! column-level water mass end of the time step real(r8), pointer :: errh2o_patch (:) ! water conservation error (mm H2O) real(r8), pointer :: errh2o_col (:) ! column-level water conservation error (mm H2O) - real(r8), pointer :: errh2o_grc (:) ! grid cell-level water conservation error (mm H2O) real(r8), pointer :: errh2osno_col (:) ! snow water conservation error(mm H2O) contains @@ -133,9 +132,6 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%errh2o_col, name = 'errh2o_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) - call AllocateVar1d(var = this%errh2o_grc, name = 'errh2o_grc', & - container = tracer_vars, & - bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) call AllocateVar1d(var = this%errh2osno_col, name = 'errh2osno_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index eb94d5de83..2340b5d139 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -391,8 +391,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call BeginWaterColumnBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, soilhydrology_inst, lakestate_inst, & - use_aquifer_layer = use_aquifer_layer()) + water_inst, lakestate_inst) call t_stopf('begwbal') diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index d3eb22d610..ed9d44f36f 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -358,8 +358,9 @@ subroutine lnd2atm(bounds, & ! qflx_runoff is the sum of a number of terms, including qflx_qrgwl. Since we ! are adjusting qflx_qrgwl above, we need to adjust qflx_runoff analogously. - water_inst%waterfluxbulk_inst%qflx_runoff_col(c) = water_inst%waterfluxbulk_inst%qflx_runoff_col(c) + & - water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(c) + water_inst%waterfluxbulk_inst%qflx_runoff_col(c) = & + water_inst%waterfluxbulk_inst%qflx_runoff_col(c) + & + water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(c) end if end do @@ -374,8 +375,12 @@ subroutine lnd2atm(bounds, & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) - water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) - water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) enddo call c2g( bounds, & @@ -394,7 +399,9 @@ subroutine lnd2atm(bounds, & water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) - water_inst%waterfluxbulk_inst%qflx_ice_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_ice_dynbal_grc(g) enddo ! calculate total water storage for history files @@ -407,7 +414,9 @@ subroutine lnd2atm(bounds, & water_inst%waterbalancebulk_inst%endwb_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterdiagnosticbulk_inst%tws_grc(g) = water_inst%waterbalancebulk_inst%endwb_grc(g) + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 + water_inst%waterdiagnosticbulk_inst%tws_grc(g) = & + water_inst%waterbalancebulk_inst%endwb_grc(g) + & + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 enddo end subroutine lnd2atm From 799e011fe71a02f4ddb8c97ed267cb6b5de6ebaf Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Sat, 23 Jan 2021 18:43:36 -0700 Subject: [PATCH 072/219] Revisions part 2: bypass `for_testing_zero_dynbal_fluxes` cases --- src/biogeophys/BalanceCheckMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 733f24403d..fae724f58d 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -370,6 +370,7 @@ subroutine BalanceCheck( bounds, & use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type use subgridAveMod , only : c2g + use dynSubgridControlMod, only : get_for_testing_zero_dynbal_fluxes ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -658,7 +659,8 @@ subroutine BalanceCheck( bounds, & ' nstep= ',nstep, & ' local indexg= ',indexg,& ' errh2o_grc= ',errh2o_grc(indexg) - if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then + if (errh2o_max_val > error_thresh .and. DAnstep > skip_steps .and. & + .not. get_for_testing_zero_dynbal_fluxes()) then write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' write(iulog,*)'nstep = ',nstep From 23bf38baa6142b478ccff8c0cb7326d402edefb5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 25 Jan 2021 14:48:21 -0700 Subject: [PATCH 073/219] Revisions part 3: Insert comment about negative dribble terms --- src/biogeophys/BalanceCheckMod.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index fae724f58d..f1df93fa4a 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -284,6 +284,10 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & bounds, & qflx_ice_dynbal_left_to_dribble(begg:endg)) + ! These dynbal dribblers store the delta state, (end - beg). Thus, the + ! amount dribbled out is the negative of the amount stored in the + ! dribblers. Therefore, conservation requires us to subtract the amount + ! remaining to dribble. do g = begg, endg begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - qflx_ice_dynbal_left_to_dribble(g) @@ -630,6 +634,10 @@ subroutine BalanceCheck( bounds, & bounds, & qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg)) + ! These dynbal dribblers store the delta state, (end - beg). Thus, the + ! amount dribbled out is the negative of the amount stored in the + ! dribblers. Therefore, conservation requires us to subtract the amount + ! remaining to dribble. do g = bounds%begg, bounds%endg endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - qflx_ice_dynbal_left_to_dribble(g) From c5b09617be65bab70f00820e1162713f50883058 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 25 Jan 2021 18:05:33 -0700 Subject: [PATCH 074/219] Addition of text to the comment that I added in the last commit --- src/biogeophys/BalanceCheckMod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index f1df93fa4a..56dabca84c 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -288,6 +288,11 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & ! amount dribbled out is the negative of the amount stored in the ! dribblers. Therefore, conservation requires us to subtract the amount ! remaining to dribble. + ! This sign convention is opposite to the convention chosen for the + ! respective dribble terms used in the carbon balance. At some point + ! it may be worth making the two conventions consistent. + ! Bill Sacks states: I think the convention used for the water and + ! energy dribblers is counter-intuitive. do g = begg, endg begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - qflx_ice_dynbal_left_to_dribble(g) @@ -638,6 +643,11 @@ subroutine BalanceCheck( bounds, & ! amount dribbled out is the negative of the amount stored in the ! dribblers. Therefore, conservation requires us to subtract the amount ! remaining to dribble. + ! This sign convention is opposite to the convention chosen for the + ! respective dribble terms used in the carbon balance. At some point + ! it may be worth making the two conventions consistent. + ! Bill Sacks states: I think the convention used for the water and + ! energy dribblers is counter-intuitive. do g = bounds%begg, bounds%endg endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - qflx_ice_dynbal_left_to_dribble(g) From 9bc64e0f1cf5a99daf72e6dcad1b6d3ce9556022 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 27 Jan 2021 12:32:03 -0700 Subject: [PATCH 075/219] move leaf_biomass calculation out of if woody=1 block --- src/biogeochem/CNVegStructUpdateMod.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 1c0ec70fa0..a3e0438544 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -181,6 +181,17 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & tsai_min = tsai_min * 0.5_r8 tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min) + ! calculate vegetation physiological parameters used in biomass heat storage + ! + if (use_biomass_heat_storage) then + ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems + leaf_biomass(p) = max(0.0025_r8,leafc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + + else + leaf_biomass(p) = 0_r8 + end if + if (woody(ivt(p)) == 1._r8) then ! trees and shrubs for now have a very simple allometry, with hard-wired @@ -204,22 +215,15 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & endif - ! - ! calculate vegetation physiological parameters used in biomass heat storage - ! if (use_biomass_heat_storage) then ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems - leaf_biomass(p) = max(0.0025_r8,leafc(p)) & - * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - stem_biomass(p) = (spinup_factor_deadwood*deadstemc(p) + livestemc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - else - leaf_biomass(p) = 0_r8 stem_biomass(p) = 0_r8 end if + ! ! Peter Thornton, 5/3/2004 ! Adding test to keep htop from getting too close to forcing height for windspeed ! Also added for grass, below, although it is not likely to ever be an issue. From 6e38fc28ebab92d41981f4097c2f9ef039d14321 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Jan 2021 15:46:07 -0700 Subject: [PATCH 076/219] Revisions part 4: Tracking wa_reset_nonconservation_gain --- src/biogeophys/BalanceCheckMod.F90 | 81 ++++++++++++++++++++--------- src/biogeophys/WaterBalanceType.F90 | 23 +++++++- src/main/clm_driver.F90 | 5 +- 3 files changed, 80 insertions(+), 29 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 56dabca84c..50575eb5c9 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -126,7 +126,7 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- subroutine BeginWaterGridcellBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, soilhydrology_inst, lakestate_inst, & + water_inst, lakestate_inst, & use_aquifer_layer) ! ! !DESCRIPTION: @@ -141,7 +141,6 @@ subroutine BeginWaterGridcellBalance(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst type(lakestate_type) , intent(in) :: lakestate_inst - type(soilhydrology_type), intent(in) :: soilhydrology_inst logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: @@ -154,7 +153,6 @@ subroutine BeginWaterGridcellBalance(bounds, & call BeginWaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & - soilhydrology_inst, & lakestate_inst, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & @@ -168,7 +166,8 @@ end subroutine BeginWaterGridcellBalance !----------------------------------------------------------------------- subroutine BeginWaterColumnBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, lakestate_inst) + water_inst, soilhydrology_inst, lakestate_inst, & + use_aquifer_layer) ! ! !DESCRIPTION: ! Initialize column-level water balance at beginning of time step, for bulk water and @@ -182,6 +181,8 @@ subroutine BeginWaterColumnBalance(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst type(lakestate_type) , intent(in) :: lakestate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: i @@ -193,10 +194,12 @@ subroutine BeginWaterColumnBalance(bounds, & call BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & + soilhydrology_inst, & lakestate_inst, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & - water_inst%bulk_and_tracers(i)%waterbalance_inst) + water_inst%bulk_and_tracers(i)%waterbalance_inst, & + use_aquifer_layer = use_aquifer_layer) end do end subroutine BeginWaterColumnBalance @@ -204,7 +207,7 @@ end subroutine BeginWaterColumnBalance !----------------------------------------------------------------------- subroutine BeginWaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - soilhydrology_inst, lakestate_inst, waterstate_inst, & + lakestate_inst, waterstate_inst, & waterdiagnostic_inst, waterbalance_inst, waterflux_inst, & use_aquifer_layer) ! @@ -221,7 +224,6 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points - type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst class(waterflux_type) , intent(inout) :: waterflux_inst @@ -230,17 +232,15 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: - integer :: c, g, j, fc ! indices + integer :: g ! indices integer :: begc, endc, begg, endg ! bounds real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at beginning of time step real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux at beginning of time step + real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) !----------------------------------------------------------------------- associate( & - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) - zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) - aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) - wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb_col => waterbalance_inst%begwb_col, & ! Output: [real(r8) (:) ] column-level water mass begining of the time step begwb_grc => waterbalance_inst%begwb_grc & ! Output: [real(r8) (:) ] grid cell-level water mass begining of the time step ) @@ -250,17 +250,20 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & begg = bounds%begg endg = bounds%endg - ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake - if(use_aquifer_layer) then - do fc = 1, num_nolakec - c = filter_nolakec(fc) - if (col%hydrologically_active(c)) then - if(zwt(c) <= zi(c,nlevsoi)) then - wa(c) = aquifer_water_baseline - end if - end if - end do - endif + if (use_aquifer_layer) then + ! wa_reset_nonconservation_gain_col should be non-zero only when + ! use_aquifer_layer is true. We do this c2g call only when needed + ! to avoid unnecessary calculations; by adding this term only when + ! use_aquifer_layer is true, we effectively let the balance checks + ! ensure that this term is zero when use_aquifer_layer is false, + ! as it should be. + call c2g( bounds, & + wa_reset_nonconservation_gain_col(begc:endc), & + wa_reset_nonconservation_gain_grc(begg:endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity' ) + else + wa_reset_nonconservation_gain_grc(begg:endg) = 0._r8 + end if ! NOTES subroutines Compute*Mass* are in TotalWaterAndHeatMod.F90 ! endwb is calculated in HydrologyDrainageMod & LakeHydrologyMod @@ -295,7 +298,8 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & ! energy dribblers is counter-intuitive. do g = begg, endg begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - - qflx_ice_dynbal_left_to_dribble(g) + - qflx_ice_dynbal_left_to_dribble(g) & + - wa_reset_nonconservation_gain_grc(g) end do end associate @@ -305,8 +309,9 @@ end subroutine BeginWaterGridcellBalanceSingle !----------------------------------------------------------------------- subroutine BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - lakestate_inst, waterstate_inst, & - waterdiagnostic_inst, waterbalance_inst) + soilhydrology_inst, lakestate_inst, waterstate_inst, & + waterdiagnostic_inst, waterbalance_inst, & + use_aquifer_layer) ! ! !DESCRIPTION: ! Initialize column-level water balance at beginning of time step, for bulk or a @@ -318,19 +323,43 @@ subroutine BeginWaterColumnBalanceSingle(bounds, & integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: + integer :: c, fc ! indices !----------------------------------------------------------------------- associate( & + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) + wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + wa_reset_nonconservation_gain => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb => waterbalance_inst%begwb_col , & ! Output: [real(r8) (:) ] water mass begining of the time step h2osno_old => waterbalance_inst%h2osno_old_col & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step ) + ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake + if(use_aquifer_layer) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%hydrologically_active(c)) then + if(zwt(c) <= zi(c,nlevsoi)) then + wa_reset_nonconservation_gain(c) = aquifer_water_baseline - & + wa(c) + wa(c) = aquifer_water_baseline + else + wa_reset_nonconservation_gain(c) = 0._r8 + end if + end if + end do + endif + call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstate_inst, waterdiagnostic_inst, & subtract_dynbal_baselines = .false., & diff --git a/src/biogeophys/WaterBalanceType.F90 b/src/biogeophys/WaterBalanceType.F90 index 6b10895549..0bf0573913 100644 --- a/src/biogeophys/WaterBalanceType.F90 +++ b/src/biogeophys/WaterBalanceType.F90 @@ -33,6 +33,7 @@ module WaterBalanceType real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s) real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s) + real(r8), pointer :: wa_reset_nonconservation_gain_col(:) ! col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) ! Balance Checks @@ -49,6 +50,7 @@ module WaterBalanceType procedure :: Init procedure, private :: InitAllocate procedure, private :: InitHistory + procedure, private :: InitCold end type waterbalance_type @@ -70,8 +72,8 @@ subroutine Init(this, bounds, info, tracer_vars) this%info => info call this%InitAllocate(bounds, tracer_vars) - call this%InitHistory(bounds) + call this%InitCold(bounds) end subroutine Init @@ -113,6 +115,9 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%snow_sinks_col, name = 'snow_sinks_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%wa_reset_nonconservation_gain_col, name = 'wa_reset_nonconservation_gain_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) call AllocateVar1d(var = this%begwb_grc, name = 'begwb_grc', & container = tracer_vars, & @@ -233,4 +238,20 @@ subroutine InitHistory(this, bounds) ptr_col=this%errh2osno_col, c2l_scale_type='urbanf') end subroutine InitHistory + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(waterbalance_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + !----------------------------------------------------------------------- + + this%wa_reset_nonconservation_gain_col(bounds%begc:bounds%endc) = 0.0_r8 + + end subroutine InitCold + end module WaterBalanceType diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 2340b5d139..7504ae1c28 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -330,7 +330,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call BeginWaterGridcellBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, soilhydrology_inst, lakestate_inst, & + water_inst, lakestate_inst, & use_aquifer_layer = use_aquifer_layer()) call t_stopf('begwbal') end do @@ -391,7 +391,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call BeginWaterColumnBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, lakestate_inst) + water_inst, soilhydrology_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer()) call t_stopf('begwbal') From 6f0bf37db5e22422b7d58474989ee331957ee4c2 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 28 Jan 2021 15:12:05 -0700 Subject: [PATCH 077/219] Minor cleanup of comments and write statements --- src/biogeophys/BalanceCheckMod.F90 | 42 ++++++++++++++++-------------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 50575eb5c9..84f4bc9484 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -240,7 +240,7 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & !----------------------------------------------------------------------- associate( & - wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) + wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb_col => waterbalance_inst%begwb_col, & ! Output: [real(r8) (:) ] column-level water mass begining of the time step begwb_grc => waterbalance_inst%begwb_grc & ! Output: [real(r8) (:) ] grid cell-level water mass begining of the time step ) @@ -251,7 +251,7 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & endg = bounds%endg if (use_aquifer_layer) then - ! wa_reset_nonconservation_gain_col should be non-zero only when + ! wa_reset_nonconservation_gain may be non-zero only when ! use_aquifer_layer is true. We do this c2g call only when needed ! to avoid unnecessary calculations; by adding this term only when ! use_aquifer_layer is true, we effectively let the balance checks @@ -309,7 +309,7 @@ end subroutine BeginWaterGridcellBalanceSingle !----------------------------------------------------------------------- subroutine BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - soilhydrology_inst, lakestate_inst, waterstate_inst, & + soilhydrology_inst, lakestate_inst, waterstate_inst, & waterdiagnostic_inst, waterbalance_inst, & use_aquifer_layer) ! @@ -335,16 +335,20 @@ subroutine BeginWaterColumnBalanceSingle(bounds, & !----------------------------------------------------------------------- associate( & - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) - zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) - wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) - wa_reset_nonconservation_gain => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) + wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + wa_reset_nonconservation_gain => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb => waterbalance_inst%begwb_col , & ! Output: [real(r8) (:) ] water mass begining of the time step h2osno_old => waterbalance_inst%h2osno_old_col & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step ) ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake + ! wa_reset_nonconservation_gain is calculated for the grid cell-level + ! water balance check and may be non-zero only when + ! use_aquifer_layer is true. The grid cell-level balance check ensures + ! that this term is zero when use_aquifer_layer is false, as it should be. if(use_aquifer_layer) then do fc = 1, num_nolakec c = filter_nolakec(fc) @@ -610,7 +614,7 @@ subroutine BalanceCheck( bounds, & ' errh2o= ',errh2o_col(indexc) if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then - write(iulog,*)'clm urban model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'CTSM model stopping because errh2o > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2o_col = ',errh2o_col(indexc) write(iulog,*)'forc_rain = ',forc_rain_col(indexc)*dtime @@ -639,7 +643,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux_col(indexc)*dtime end if - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if @@ -709,7 +713,7 @@ subroutine BalanceCheck( bounds, & if (errh2o_max_val > error_thresh .and. DAnstep > skip_steps .and. & .not. get_for_testing_zero_dynbal_fluxes()) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'CTSM model stopping because errh2o > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2o_grc = ',errh2o_grc(indexg) write(iulog,*)'forc_rain = ',forc_rain_grc(indexg)*dtime @@ -731,7 +735,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'forc_flood = ',forc_flood_grc(indexg)*dtime write(iulog,*)'qflx_glcice_dyn_water_flux = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) end if @@ -811,7 +815,7 @@ subroutine BalanceCheck( bounds, & ' errh2osno= ',errh2osno(indexc) if ((errh2osno_max_val > error_thresh) .and. (DAnstep > skip_steps) ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'CTSM model stopping because errh2osno > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2osno = ',errh2osno(indexc) write(iulog,*)'snl = ',col%snl(indexc) @@ -834,7 +838,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if @@ -906,7 +910,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsol = ',errsol(indexp) if (errsol_max_val > error_thresh) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM model stopping because errsol > ', error_thresh, ' W/m2' write(iulog,*)'fsa = ',fsa(indexp) write(iulog,*)'fsr = ',fsr(indexp) write(iulog,*)'forc_solad(1) = ',forc_solad(indexg,1) @@ -915,7 +919,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'forc_solai(2) = ',forc_solai(indexg,2) write(iulog,*)'forc_tot = ',forc_solad(indexg,1)+forc_solad(indexg,2) & +forc_solai(indexg,1)+forc_solai(indexg,2) - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -932,7 +936,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'nstep = ',nstep write(iulog,*)'errlon = ',errlon(indexp) if (errlon_max_val > error_thresh ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM model stopping because errlon > ', error_thresh, ' W/m2' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -952,7 +956,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errseb = ' ,errseb(indexp) if ( errseb_max_val > error_thresh ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM model stopping because errseb > ', error_thresh, ' W/m2' write(iulog,*)'sabv = ' ,sabv(indexp) write(iulog,*)'sabg = ' ,sabg(indexp), ((1._r8- frac_sno(indexc))*sabg_soil(indexp) + & frac_sno(indexc)*sabg_snow(indexp)),sabg_chk(indexp) @@ -968,7 +972,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'albd albi = ' ,albd(indexp,:), albi(indexp,:) write(iulog,*)'ftii ftdd ftid = ' ,ftii(indexp,:), ftdd(indexp,:),ftid(indexp,:) write(iulog,*)'elai esai = ' ,elai(indexp), esai(indexp) - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -985,7 +989,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsoi_col = ',errsoi_col(indexc) if ((errsoi_col_max_val > 1.e-4_r8) .and. (DAnstep > skip_steps)) then - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM model is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if end if From bf52b8ae0843dd7f3f3a6262847ebb103cc32ec8 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Jan 2021 12:49:05 -0700 Subject: [PATCH 078/219] Cleanup of comments, write-statmts, and formatting --- doc/ChangeLog | 14 ++++----- src/biogeophys/BalanceCheckMod.F90 | 50 +++++++++++++++++++----------- 2 files changed, 39 insertions(+), 25 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a9cbe04d1e..dfa751387f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,5 @@ =============================================================== -Tag name: ctsm5.1.dev020 +Tag name: ctsm5.1.dev0?? Originator(s): slevis (Samuel Levis,303-665-1310) Date: Wed Dec 23 11:29:33 MST 2020 One-line Summary: Grid cell-level error check for H2O @@ -26,13 +26,13 @@ Does this tag change answers significantly for any of the following physics conf [Put an [X] in the box for any configuration with significant answer changes.] -[X] clm5_1 +[ ] clm5_1 -[X] clm5_0 +[ ] clm5_0 -[X] ctsm5_0-nwp +[ ] ctsm5_0-nwp -[X] clm4_5 +[ ] clm4_5 Notes of particular relevance for users --------------------------------------- @@ -93,12 +93,12 @@ If the tag used for baseline comparisons was NOT the previous tag, note that her Answer changes -------------- -Changes answers relative to baseline: +Changes answers relative to baseline: YES Summarize any changes to answers, i.e., - what code configurations: ALL - what platforms/compilers: ALL - - nature of change (roundoff; larger than roundoff/same climate; new climate): + - nature of change: ROUNDOFF Specific example from running the single point test ERI_D_Ld9.1x1_camdenNJ.I2000Clm50BgcCruRs.cheyenne_intel.clm-default: RMS ERRH2O 6.0280E-21 NORMALIZED 7.6050E-06 diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 84f4bc9484..b36f23893a 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -257,6 +257,9 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & ! use_aquifer_layer is true, we effectively let the balance checks ! ensure that this term is zero when use_aquifer_layer is false, ! as it should be. + ! The _col term converted to _grc here gets determined in + ! BeginWaterColumnBalanceSingle in the previous time step after any + ! dynamic landuse adjustments. call c2g( bounds, & wa_reset_nonconservation_gain_col(begc:endc), & wa_reset_nonconservation_gain_grc(begg:endg), & @@ -335,20 +338,33 @@ subroutine BeginWaterColumnBalanceSingle(bounds, & !----------------------------------------------------------------------- associate( & - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) - zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) - wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) wa_reset_nonconservation_gain => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb => waterbalance_inst%begwb_col , & ! Output: [real(r8) (:) ] water mass begining of the time step h2osno_old => waterbalance_inst%h2osno_old_col & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step ) - ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake + ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake called here. ! wa_reset_nonconservation_gain is calculated for the grid cell-level ! water balance check and may be non-zero only when ! use_aquifer_layer is true. The grid cell-level balance check ensures ! that this term is zero when use_aquifer_layer is false, as it should be. + ! In particular, we adjust wa back to the baseline under certain + ! conditions. The right way to do this might be to use explicit fluxes from + ! some other state, but in this case we don't have a source to pull from, + ! so we adjust wa without explicit fluxes. Because we do this before + ! initializing the column-level balance check, the column-level check is + ! unaware of the adjustment. However, since this adjustment happens after + ! initializing the gridcell-level balance check, we have to account for + ! it in the gridcell-level balance check. The normal way to account for an + ! adjustment like this would be to include the flux in the balance check. + ! Here we don't have an explicit flux, so instead we track the + ! non-conservation state. In principle, we could calculate an explicit flux + ! and use that, but we don't gain anything from using an explicit flux in + ! this case. if(use_aquifer_layer) then do fc = 1, num_nolakec c = filter_nolakec(fc) @@ -614,7 +630,7 @@ subroutine BalanceCheck( bounds, & ' errh2o= ',errh2o_col(indexc) if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then - write(iulog,*)'CTSM model stopping because errh2o > ', error_thresh, ' mm' + write(iulog,*)'CTSM is stopping because errh2o > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2o_col = ',errh2o_col(indexc) write(iulog,*)'forc_rain = ',forc_rain_col(indexc)*dtime @@ -643,7 +659,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux_col(indexc)*dtime end if - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if @@ -713,7 +729,7 @@ subroutine BalanceCheck( bounds, & if (errh2o_max_val > error_thresh .and. DAnstep > skip_steps .and. & .not. get_for_testing_zero_dynbal_fluxes()) then - write(iulog,*)'CTSM model stopping because errh2o > ', error_thresh, ' mm' + write(iulog,*)'CTSM is stopping because errh2o > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2o_grc = ',errh2o_grc(indexg) write(iulog,*)'forc_rain = ',forc_rain_grc(indexg)*dtime @@ -735,15 +751,13 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'forc_flood = ',forc_flood_grc(indexg)*dtime write(iulog,*)'qflx_glcice_dyn_water_flux = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) end if end if ! Snow balance check at the column level. - ! Beginning snow balance variable h2osno_old is calculated once - ! for both the column-level and grid cell-level balance checks. call waterstate_inst%CalculateTotalH2osno(bounds, num_allc, filter_allc, & caller = 'BalanceCheck', & @@ -815,7 +829,7 @@ subroutine BalanceCheck( bounds, & ' errh2osno= ',errh2osno(indexc) if ((errh2osno_max_val > error_thresh) .and. (DAnstep > skip_steps) ) then - write(iulog,*)'CTSM model stopping because errh2osno > ', error_thresh, ' mm' + write(iulog,*)'CTSM is stopping because errh2osno > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2osno = ',errh2osno(indexc) write(iulog,*)'snl = ',col%snl(indexc) @@ -838,7 +852,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if @@ -910,7 +924,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsol = ',errsol(indexp) if (errsol_max_val > error_thresh) then - write(iulog,*)'CTSM model stopping because errsol > ', error_thresh, ' W/m2' + write(iulog,*)'CTSM is stopping because errsol > ', error_thresh, ' W/m2' write(iulog,*)'fsa = ',fsa(indexp) write(iulog,*)'fsr = ',fsr(indexp) write(iulog,*)'forc_solad(1) = ',forc_solad(indexg,1) @@ -919,7 +933,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'forc_solai(2) = ',forc_solai(indexg,2) write(iulog,*)'forc_tot = ',forc_solad(indexg,1)+forc_solad(indexg,2) & +forc_solai(indexg,1)+forc_solai(indexg,2) - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -936,7 +950,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'nstep = ',nstep write(iulog,*)'errlon = ',errlon(indexp) if (errlon_max_val > error_thresh ) then - write(iulog,*)'CTSM model stopping because errlon > ', error_thresh, ' W/m2' + write(iulog,*)'CTSM is stopping because errlon > ', error_thresh, ' W/m2' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -956,7 +970,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errseb = ' ,errseb(indexp) if ( errseb_max_val > error_thresh ) then - write(iulog,*)'CTSM model stopping because errseb > ', error_thresh, ' W/m2' + write(iulog,*)'CTSM is stopping because errseb > ', error_thresh, ' W/m2' write(iulog,*)'sabv = ' ,sabv(indexp) write(iulog,*)'sabg = ' ,sabg(indexp), ((1._r8- frac_sno(indexc))*sabg_soil(indexp) + & frac_sno(indexc)*sabg_snow(indexp)),sabg_chk(indexp) @@ -972,7 +986,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'albd albi = ' ,albd(indexp,:), albi(indexp,:) write(iulog,*)'ftii ftdd ftid = ' ,ftii(indexp,:), ftdd(indexp,:),ftid(indexp,:) write(iulog,*)'elai esai = ' ,elai(indexp), esai(indexp) - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -989,7 +1003,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsoi_col = ',errsoi_col(indexc) if ((errsoi_col_max_val > 1.e-4_r8) .and. (DAnstep > skip_steps)) then - write(iulog,*)'CTSM model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if end if From 5dbbc81bbf4ab78dd671ad865266085a06ac30bf Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Jan 2021 15:02:28 -0700 Subject: [PATCH 079/219] Revisions 4b: Move code from the beg. to the ending of h2o balance check --- src/biogeophys/BalanceCheckMod.F90 | 59 ++++++++++++++---------------- src/main/clm_driver.F90 | 6 +-- 2 files changed, 30 insertions(+), 35 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index b36f23893a..c1b672975a 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -126,8 +126,7 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- subroutine BeginWaterGridcellBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, lakestate_inst, & - use_aquifer_layer) + water_inst, lakestate_inst) ! ! !DESCRIPTION: ! Initialize grid cell-level water balance at beginning of time step @@ -141,7 +140,6 @@ subroutine BeginWaterGridcellBalance(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst type(lakestate_type) , intent(in) :: lakestate_inst - logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: i @@ -157,8 +155,7 @@ subroutine BeginWaterGridcellBalance(bounds, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & water_inst%bulk_and_tracers(i)%waterbalance_inst, & - water_inst%bulk_and_tracers(i)%waterflux_inst, & - use_aquifer_layer = use_aquifer_layer) + water_inst%bulk_and_tracers(i)%waterflux_inst) end do end subroutine BeginWaterGridcellBalance @@ -208,8 +205,7 @@ end subroutine BeginWaterColumnBalance subroutine BeginWaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & lakestate_inst, waterstate_inst, & - waterdiagnostic_inst, waterbalance_inst, waterflux_inst, & - use_aquifer_layer) + waterdiagnostic_inst, waterbalance_inst, waterflux_inst) ! ! !DESCRIPTION: ! Initialize grid cell-level water balance at beginning of time step @@ -229,18 +225,15 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & class(waterflux_type) , intent(inout) :: waterflux_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst - logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: g ! indices integer :: begc, endc, begg, endg ! bounds real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at beginning of time step real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux at beginning of time step - real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) !----------------------------------------------------------------------- associate( & - wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb_col => waterbalance_inst%begwb_col, & ! Output: [real(r8) (:) ] column-level water mass begining of the time step begwb_grc => waterbalance_inst%begwb_grc & ! Output: [real(r8) (:) ] grid cell-level water mass begining of the time step ) @@ -250,24 +243,6 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & begg = bounds%begg endg = bounds%endg - if (use_aquifer_layer) then - ! wa_reset_nonconservation_gain may be non-zero only when - ! use_aquifer_layer is true. We do this c2g call only when needed - ! to avoid unnecessary calculations; by adding this term only when - ! use_aquifer_layer is true, we effectively let the balance checks - ! ensure that this term is zero when use_aquifer_layer is false, - ! as it should be. - ! The _col term converted to _grc here gets determined in - ! BeginWaterColumnBalanceSingle in the previous time step after any - ! dynamic landuse adjustments. - call c2g( bounds, & - wa_reset_nonconservation_gain_col(begc:endc), & - wa_reset_nonconservation_gain_grc(begg:endg), & - c2l_scale_type='urbanf', l2g_scale_type='unity' ) - else - wa_reset_nonconservation_gain_grc(begg:endg) = 0._r8 - end if - ! NOTES subroutines Compute*Mass* are in TotalWaterAndHeatMod.F90 ! endwb is calculated in HydrologyDrainageMod & LakeHydrologyMod call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & @@ -301,8 +276,7 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & ! energy dribblers is counter-intuitive. do g = begg, endg begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - - qflx_ice_dynbal_left_to_dribble(g) & - - wa_reset_nonconservation_gain_grc(g) + - qflx_ice_dynbal_left_to_dribble(g) end do end associate @@ -406,7 +380,8 @@ subroutine BalanceCheck( bounds, & num_allc, filter_allc, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & - waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) + waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst, & + use_aquifer_layer) ! ! !DESCRIPTION: ! This subroutine accumulates the numerical truncation errors of the water @@ -445,6 +420,7 @@ subroutine BalanceCheck( bounds, & type(surfalb_type) , intent(in) :: surfalb_inst type(energyflux_type) , intent(inout) :: energyflux_inst type(canopystate_type), intent(inout) :: canopystate_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: p,c,l,g,fc ! indices @@ -461,6 +437,7 @@ subroutine BalanceCheck( bounds, & real(r8) :: qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg) ! grid cell-level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step + real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -513,6 +490,7 @@ subroutine BalanceCheck( bounds, & qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice qflx_drain_perched_col => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:)] grid cell-level sub-surface runoff (mm H2O /s) + wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col, & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) qflx_flood_col => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column level total runoff due to flooding forc_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] grid cell-level total grid cell-level runoff from river model qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack @@ -680,6 +658,22 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_ice_col(bounds%begc:bounds%endc), & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + if (use_aquifer_layer) then + ! wa_reset_nonconservation_gain may be non-zero only when + ! use_aquifer_layer is true. We do this c2g call only when needed + ! to avoid unnecessary calculations; by adding this term only when + ! use_aquifer_layer is true, we effectively let the balance checks + ! ensure that this term is zero when use_aquifer_layer is false, + ! as it should be. + ! The _col term was determined in BeginWaterColumnBalanceSingle + ! after any dynamic landuse adjustments. + call c2g( bounds, & + wa_reset_nonconservation_gain_col(bounds%begc:bounds%endc), & + wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity' ) + else + wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) = 0._r8 + end if call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end( & bounds, & @@ -699,7 +693,8 @@ subroutine BalanceCheck( bounds, & ! energy dribblers is counter-intuitive. do g = bounds%begg, bounds%endg endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - - qflx_ice_dynbal_left_to_dribble(g) + - qflx_ice_dynbal_left_to_dribble(g) & + - wa_reset_nonconservation_gain_grc(g) errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 7504ae1c28..4f88a5ef90 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -330,8 +330,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call BeginWaterGridcellBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, lakestate_inst, & - use_aquifer_layer = use_aquifer_layer()) + water_inst, lakestate_inst) call t_stopf('begwbal') end do !$OMP END PARALLEL DO @@ -1271,7 +1270,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & - water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, canopystate_inst) + water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, & + canopystate_inst, use_aquifer_layer = use_aquifer_layer()) end do !$OMP END PARALLEL DO call t_stopf('balchk') From 5567b1f6e40cce16f5b2e5dbc668c3a00f064419 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 4 Feb 2021 16:12:47 -0700 Subject: [PATCH 080/219] Fix non-standard hexadecimal constant Resolves ESCOMP/CTSM#1270 --- src/biogeochem/FireEmisFactorsMod.F90 | 2 +- src/biogeochem/MEGANFactorsMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/FireEmisFactorsMod.F90 b/src/biogeochem/FireEmisFactorsMod.F90 index 7aef11ffc3..e97082c0b8 100644 --- a/src/biogeochem/FireEmisFactorsMod.F90 +++ b/src/biogeochem/FireEmisFactorsMod.F90 @@ -227,7 +227,7 @@ integer function gen_hashkey(string) integer :: i integer :: strlen integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 - integer, parameter :: gen_hash_key_offset = z'000053db' + integer, parameter :: gen_hash_key_offset = int(z'000053db') integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) hash = gen_hash_key_offset diff --git a/src/biogeochem/MEGANFactorsMod.F90 b/src/biogeochem/MEGANFactorsMod.F90 index 8c91959b88..661bfbdde2 100644 --- a/src/biogeochem/MEGANFactorsMod.F90 +++ b/src/biogeochem/MEGANFactorsMod.F90 @@ -274,7 +274,7 @@ integer function gen_hashkey(string) integer :: i integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 - integer, parameter :: gen_hash_key_offset = z'000053db' + integer, parameter :: gen_hash_key_offset = int(z'000053db') integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) hash = gen_hash_key_offset From 6b13bfe0634d08fecb5c538bb094e1fea1a80432 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 4 Feb 2021 16:38:04 -0700 Subject: [PATCH 081/219] Use typed allocation rather than sourced allocation I feel like this is cleaner, and I've had problems with sourced allocation in some cases --- src/biogeophys/OzoneFactoryMod.F90 | 4 ++-- src/biogeophys/OzoneMod.F90 | 29 ----------------------------- 2 files changed, 2 insertions(+), 31 deletions(-) diff --git a/src/biogeophys/OzoneFactoryMod.F90 b/src/biogeophys/OzoneFactoryMod.F90 index 2b28587a99..fa68b31851 100644 --- a/src/biogeophys/OzoneFactoryMod.F90 +++ b/src/biogeophys/OzoneFactoryMod.F90 @@ -41,9 +41,9 @@ function create_and_init_ozone_type(bounds) result(ozone) !----------------------------------------------------------------------- if (use_ozone) then - allocate(ozone, source = ozone_type()) + allocate(ozone_type :: ozone) else - allocate(ozone, source = ozone_off_type()) + allocate(ozone_off_type :: ozone) end if call ozone%Init(bounds) diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 82c012a815..5dcce46270 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -63,10 +63,6 @@ module OzoneMod procedure, private, nopass :: CalcOzoneStressOnePoint end type ozone_type - interface ozone_type - module procedure constructor - end interface ozone_type - ! !PRIVATE TYPES: ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying @@ -111,31 +107,6 @@ module OzoneMod ! Infrastructure routines (initialization, restart, etc.) ! ======================================================================== - !----------------------------------------------------------------------- - function constructor() result(ozone) - ! - ! !DESCRIPTION: - ! Return an instance of ozone_type - ! - ! !USES: - ! - ! !ARGUMENTS: - type(ozone_type) :: ozone ! function result - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'constructor' - !----------------------------------------------------------------------- - - ! DO NOTHING (simply return a variable of the appropriate type) - - ! Eventually this should call the Init routine (or replace the Init routine - ! entirely). But I think it would be confusing to do that until we switch everything - ! to use a constructor rather than the init routine. - - end function constructor - - !----------------------------------------------------------------------- subroutine Init(this, bounds) ! From 0c05d6ce3ad3e4566d8bfd794ed38a674d389c62 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 4 Feb 2021 16:45:33 -0700 Subject: [PATCH 082/219] Don't unnecessarily set things to 1 This adds up in terms of performance --- src/biogeophys/OzoneOffMod.F90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/biogeophys/OzoneOffMod.F90 b/src/biogeophys/OzoneOffMod.F90 index ac5a946de9..01104f2647 100644 --- a/src/biogeophys/OzoneOffMod.F90 +++ b/src/biogeophys/OzoneOffMod.F90 @@ -104,13 +104,7 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & SHR_ASSERT_ALL_FL((ubound(ram) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(tlai) == (/bounds%endp/)), sourcefile, __LINE__) - ! Explicitly set outputs to 1. This isn't really needed, because they should still be - ! at 1 from cold-start initialization, but do this for clarity here. - - this%o3coefvsha_patch(bounds%begp:bounds%endp) = 1._r8 - this%o3coefvsun_patch(bounds%begp:bounds%endp) = 1._r8 - this%o3coefgsha_patch(bounds%begp:bounds%endp) = 1._r8 - this%o3coefgsun_patch(bounds%begp:bounds%endp) = 1._r8 + ! Do nothing: Outputs are already fixed at 1 from cold start initialization. end subroutine CalcOzoneStress From b5997684ee8c817cdfccf6094ff2d41f2b11aafc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 5 Feb 2021 13:59:55 -0700 Subject: [PATCH 083/219] Fix #1261 by setting spinup_factor_deadwood always in InitCold when spinup_state, having it only set in Restart was the problem --- .../testdefs/testmods_dirs/clm/ADspinup/include_user_mods | 1 + .../testdefs/testmods_dirs/clm/ADspinup/shell_commands | 4 ++++ src/biogeochem/CNVegCarbonStateType.F90 | 5 +++-- 3 files changed, 8 insertions(+), 2 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands b/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands new file mode 100644 index 0000000000..771777c92a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands @@ -0,0 +1,4 @@ +#!/bin/bash + +./xmlchange CLM_ACCELERATED_SPINUP="on" + diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index f7c9178453..28cf07869b 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -872,7 +872,7 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst ! ! !USES: use landunit_varcon , only : istsoil, istcrop - use clm_varctl, only : MM_Nuptake_opt + use clm_varctl, only : MM_Nuptake_opt, spinup_state ! ! !ARGUMENTS: class(cnveg_carbonstate_type) :: this @@ -895,6 +895,8 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst call endrun(msg=' ERROR: for C13 or C14 must pass in c12_cnveg_carbonstate_inst as argument' //& errMsg(sourcefile, __LINE__)) end if + else + if ( spinup_state == 2 ) spinup_factor_deadwood = spinup_factor_AD end if ! Set column filters @@ -1247,7 +1249,6 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then if ( masterproc ) write(iulog, *) 'exit_spinup ',exit_spinup,' restart_file_spinup_state ',restart_file_spinup_state - if ( spinup_state == 2 ) spinup_factor_deadwood = spinup_factor_AD if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools out of AD spinup mode' exit_spinup = .true. From 8cd34647aa9e3b57c0046166340ab7b2616d9dfb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 5 Feb 2021 14:16:52 -0700 Subject: [PATCH 084/219] Reverse order of modules as given in #1255 --- tools/mkmapdata/mkmapdata.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/mkmapdata/mkmapdata.sh b/tools/mkmapdata/mkmapdata.sh index d0691a9817..c778261234 100755 --- a/tools/mkmapdata/mkmapdata.sh +++ b/tools/mkmapdata/mkmapdata.sh @@ -344,8 +344,8 @@ case $hostname in fi esmfvers=7.1.0r intelvers=18.0.5 # Could also use intel/19.0.2 EBK 10/4/2019 - module load esmf_libs/$esmfvers module load intel/$intelvers + module load esmf_libs/$esmfvers module load ncl module load nco From 977ec171020a5cf8be0286d1844f7d4402ddfcc7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 5 Feb 2021 20:25:41 -0700 Subject: [PATCH 085/219] Make separate subroutines for ozone uptake & stress This will support introducing alternative methods for ozone stress, as well as removing some variables from the restart file. --- src/biogeophys/CanopyFluxesMod.F90 | 5 +- src/biogeophys/OzoneBaseMod.F90 | 16 +++- src/biogeophys/OzoneMod.F90 | 118 ++++++++++++++++++++++------- src/biogeophys/OzoneOffMod.F90 | 16 +++- 4 files changed, 119 insertions(+), 36 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 348af3a613..97b40be7e1 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1557,7 +1557,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! needed with pgi 14.7 on yellowstone; without it, forc_pbot_downscaled_col gets ! resized inappropriately in the following subroutine call, due to a compiler bug. dummy_to_make_pgi_happy = ubound(atm2lnd_inst%forc_pbot_downscaled_col, 1) - call ozone_inst%CalcOzoneStress( & + call ozone_inst%CalcOzoneUptake( & bounds, fn, filterp, & forc_pbot = atm2lnd_inst%forc_pbot_downscaled_col(bounds%begc:bounds%endc), & forc_th = atm2lnd_inst%forc_th_downscaled_col(bounds%begc:bounds%endc), & @@ -1566,7 +1566,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, rb = frictionvel_inst%rb1_patch(bounds%begp:bounds%endp), & ram = frictionvel_inst%ram1_patch(bounds%begp:bounds%endp), & tlai = canopystate_inst%tlai_patch(bounds%begp:bounds%endp)) - + call ozone_inst%CalcOzoneStress(bounds, fn, filterp) + !--------------------------------------------------------- !update Vc,max and Jmax by LUNA model if(use_luna)then diff --git a/src/biogeophys/OzoneBaseMod.F90 b/src/biogeophys/OzoneBaseMod.F90 index c50818f380..a93a22f4eb 100644 --- a/src/biogeophys/OzoneBaseMod.F90 +++ b/src/biogeophys/OzoneBaseMod.F90 @@ -31,6 +31,7 @@ module OzoneBaseMod ! The following routines need to be implemented by all type extensions procedure(Init_interface) , public, deferred :: Init procedure(Restart_interface) , public, deferred :: Restart + procedure(CalcOzoneUptake_interface) , public, deferred :: CalcOzoneUptake procedure(CalcOzoneStress_interface) , public, deferred :: CalcOzoneStress ! The following routines should only be called by extensions of the ozone_base_type @@ -59,8 +60,8 @@ subroutine Restart_interface(this, bounds, ncid, flag) type(file_desc_t) , intent(inout) :: ncid ! netcdf id character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define' end subroutine Restart_interface - - subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_exposedvegp, & + + subroutine CalcOzoneUptake_interface(this, bounds, num_exposedvegp, filter_exposedvegp, & forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) use decompMod , only : bounds_type use shr_kind_mod , only : r8 => shr_kind_r8 @@ -77,8 +78,17 @@ subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_expos real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m) real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow - end subroutine CalcOzoneStress_interface + end subroutine CalcOzoneUptake_interface + + subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_exposedvegp) + use decompMod, only : bounds_type + import :: ozone_base_type + class(ozone_base_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + end subroutine CalcOzoneStress_interface end interface contains diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 5dcce46270..3abac46d5e 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -18,6 +18,8 @@ module OzoneMod use clm_varcon , only : spval use OzoneBaseMod, only : ozone_base_type use abortutils , only : endrun + use PatchType , only : patch + use pftconMod , only : pftcon implicit none save @@ -52,6 +54,7 @@ module OzoneMod ! Public routines procedure, public :: Init procedure, public :: Restart + procedure, public :: CalcOzoneUptake procedure, public :: CalcOzoneStress ! Private routines @@ -59,6 +62,9 @@ module OzoneMod procedure, private :: InitHistory procedure, private :: InitCold + ! Calculate ozone uptake for a single point, for just sunlit or shaded leaves + procedure, private, nopass :: CalcOzoneUptakeOnePoint + ! Calculate ozone stress for a single point, for just sunlit or shaded leaves procedure, private, nopass :: CalcOzoneStressOnePoint end type ozone_type @@ -278,14 +284,11 @@ end subroutine Restart ! ======================================================================== !----------------------------------------------------------------------- - subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & + subroutine CalcOzoneUptake(this, bounds, num_exposedvegp, filter_exposedvegp, & forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) ! ! !DESCRIPTION: - ! Calculate ozone stress. - ! - ! !USES: - use PatchType , only : patch + ! Calculate ozone uptake. ! ! !ARGUMENTS: class(ozone_type) , intent(inout) :: this @@ -305,7 +308,7 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & integer :: p ! patch index integer :: c ! column index - character(len=*), parameter :: subname = 'CalcOzoneStress' + character(len=*), parameter :: subname = 'CalcOzoneUptake' !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -318,10 +321,6 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & SHR_ASSERT_ALL_FL((ubound(tlai) == (/bounds%endp/)), sourcefile, __LINE__) associate( & - o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsun => this%o3coefgsun_patch , & ! Output: [real(r8) (:)] ozone coef o3uptakesha => this%o3uptakesha_patch , & ! Output: [real(r8) (:)] ozone dose o3uptakesun => this%o3uptakesun_patch , & ! Output: [real(r8) (:)] ozone dose tlai_old => this%tlai_old_patch & ! Output: [real(r8) (:)] tlai from last time step @@ -331,41 +330,87 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & p = filter_exposedvegp(fp) c = patch%column(p) - ! Ozone stress for shaded leaves - call CalcOzoneStressOnePoint( & + ! Ozone uptake for shaded leaves + call CalcOzoneUptakeOnePoint( & forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), & rs=rssha(p), rb=rb(p), ram=ram(p), & tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), & - o3uptake=o3uptakesha(p), o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) + o3uptake=o3uptakesha(p)) - ! Ozone stress for sunlit leaves - call CalcOzoneStressOnePoint( & + ! Ozone uptake for sunlit leaves + call CalcOzoneUptakeOnePoint( & forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), & rs=rssun(p), rb=rb(p), ram=ram(p), & tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), & - o3uptake=o3uptakesun(p), o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) + o3uptake=o3uptakesun(p)) tlai_old(p) = tlai(p) end do + end associate + + end subroutine CalcOzoneUptake + + !----------------------------------------------------------------------- + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + ! + ! !LOCAL VARIABLES: + integer :: fp ! filter index + integer :: p ! patch index + + character(len=*), parameter :: subname = 'CalcOzoneStress' + !----------------------------------------------------------------------- + + associate( & + o3uptakesha => this%o3uptakesha_patch , & ! Input: [real(r8) (:)] ozone dose + o3uptakesun => this%o3uptakesun_patch , & ! Input: [real(r8) (:)] ozone dose + o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsun => this%o3coefgsun_patch & ! Output: [real(r8) (:)] ozone coef + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + + ! Ozone stress for shaded leaves + call CalcOzoneStressOnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & + o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) + + ! Ozone stress for sunlit leaves + call CalcOzoneStressOnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & + o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) + end do + + end associate end subroutine CalcOzoneStress !----------------------------------------------------------------------- - subroutine CalcOzoneStressOnePoint( & + subroutine CalcOzoneUptakeOnePoint( & forc_ozone, forc_pbot, forc_th, & rs, rb, ram, & tlai, tlai_old, pft_type, & - o3uptake, o3coefv, o3coefg) + o3uptake) ! ! !DESCRIPTION: - ! Calculates ozone stress for a single point, for just sunlit or shaded leaves + ! Calculates ozone uptake for a single point, for just sunlit or shaded leaves ! ! !USES: use shr_const_mod , only : SHR_CONST_RGAS - use pftconMod , only : pftcon use clm_time_manager , only : get_step_size ! ! !ARGUMENTS: @@ -379,8 +424,6 @@ subroutine CalcOzoneStressOnePoint( & real(r8) , intent(in) :: tlai_old ! tlai from last time step integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays real(r8) , intent(inout) :: o3uptake ! ozone entering the leaf - real(r8) , intent(out) :: o3coefv ! ozone coefficient for photosynthesis (0 - 1) - real(r8) , intent(out) :: o3coefg ! ozone coefficient for conductance (0 - 1) ! ! !LOCAL VARIABLES: integer :: dtime ! land model time step (sec) @@ -392,12 +435,8 @@ subroutine CalcOzoneStressOnePoint( & real(r8) :: heal ! o3uptake healing rate based on % of new leaves growing (mmol m^-2) real(r8) :: leafturn ! leaf turnover time / mortality rate (per hour) real(r8) :: decay ! o3uptake decay rate based on leaf lifetime (mmol m^-2) - real(r8) :: photoInt ! intercept for photosynthesis - real(r8) :: photoSlope ! slope for photosynthesis - real(r8) :: condInt ! intercept for conductance - real(r8) :: condSlope ! slope for conductance - character(len=*), parameter :: subname = 'CalcOzoneStressOnePoint' + character(len=*), parameter :: subname = 'CalcOzoneUptakeOnePoint' !----------------------------------------------------------------------- ! convert o3 from mol/mol to nmol m^-3 @@ -443,6 +482,30 @@ subroutine CalcOzoneStressOnePoint( & o3uptake = 0._r8 end if + end subroutine CalcOzoneUptakeOnePoint + + !----------------------------------------------------------------------- + subroutine CalcOzoneStressOnePoint( & + pft_type, o3uptake, & + o3coefv, o3coefg) + ! + ! !DESCRIPTION: + ! Calculates ozone stress for a single point, for just sunlit or shaded leaves + ! + ! !ARGUMENTS: + integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays + real(r8) , intent(in) :: o3uptake ! ozone entering the leaf + real(r8) , intent(out) :: o3coefv ! ozone coefficient for photosynthesis (0 - 1) + real(r8) , intent(out) :: o3coefg ! ozone coefficient for conductance (0 - 1) + ! + ! !LOCAL VARIABLES: + real(r8) :: photoInt ! intercept for photosynthesis + real(r8) :: photoSlope ! slope for photosynthesis + real(r8) :: condInt ! intercept for conductance + real(r8) :: condSlope ! slope for conductance + + character(len=*), parameter :: subname = 'CalcOzoneStressOnePoint' + !----------------------------------------------------------------------- if (o3uptake == 0._r8) then ! No o3 damage if no o3 uptake @@ -479,5 +542,4 @@ subroutine CalcOzoneStressOnePoint( & end subroutine CalcOzoneStressOnePoint - end module OzoneMod diff --git a/src/biogeophys/OzoneOffMod.F90 b/src/biogeophys/OzoneOffMod.F90 index 01104f2647..f42707f667 100644 --- a/src/biogeophys/OzoneOffMod.F90 +++ b/src/biogeophys/OzoneOffMod.F90 @@ -22,6 +22,7 @@ module OzoneOffMod contains procedure, public :: Init procedure, public :: Restart + procedure, public :: CalcOzoneUptake procedure, public :: CalcOzoneStress end type ozone_off_type @@ -79,8 +80,8 @@ subroutine Restart(this, bounds, ncid, flag) end subroutine Restart - subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & - forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) + subroutine CalcOzoneUptake(this, bounds, num_exposedvegp, filter_exposedvegp, & + forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) class(ozone_off_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds @@ -104,8 +105,17 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & SHR_ASSERT_ALL_FL((ubound(ram) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(tlai) == (/bounds%endp/)), sourcefile, __LINE__) - ! Do nothing: Outputs are already fixed at 1 from cold start initialization. + ! Do nothing: In the ozone off case, we don't need to track ozone uptake + end subroutine CalcOzoneUptake + + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) + class(ozone_off_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) + + ! Do nothing: Outputs (stress terms) are already fixed at 1 from cold start initialization end subroutine CalcOzoneStress end module OzoneOffMod From 0ac085b1a36d385bfe90be7b08d771d5a21e81d2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 6 Feb 2021 08:03:28 -0700 Subject: [PATCH 086/219] Rearrange subroutines --- src/biogeophys/OzoneMod.F90 | 96 ++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 3abac46d5e..5822a26f30 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -352,53 +352,6 @@ subroutine CalcOzoneUptake(this, bounds, num_exposedvegp, filter_exposedvegp, & end subroutine CalcOzoneUptake - !----------------------------------------------------------------------- - subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) - ! - ! !DESCRIPTION: - ! Calculate ozone stress. - ! - ! !ARGUMENTS: - class(ozone_type), intent(inout) :: this - type(bounds_type), intent(in) :: bounds - integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp - integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg - ! - ! !LOCAL VARIABLES: - integer :: fp ! filter index - integer :: p ! patch index - - character(len=*), parameter :: subname = 'CalcOzoneStress' - !----------------------------------------------------------------------- - - associate( & - o3uptakesha => this%o3uptakesha_patch , & ! Input: [real(r8) (:)] ozone dose - o3uptakesun => this%o3uptakesun_patch , & ! Input: [real(r8) (:)] ozone dose - o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsun => this%o3coefgsun_patch & ! Output: [real(r8) (:)] ozone coef - ) - - do fp = 1, num_exposedvegp - p = filter_exposedvegp(fp) - - ! Ozone stress for shaded leaves - call CalcOzoneStressOnePoint( & - pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & - o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) - - ! Ozone stress for sunlit leaves - call CalcOzoneStressOnePoint( & - pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & - o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) - end do - - - end associate - - end subroutine CalcOzoneStress - !----------------------------------------------------------------------- subroutine CalcOzoneUptakeOnePoint( & forc_ozone, forc_pbot, forc_th, & @@ -445,7 +398,7 @@ subroutine CalcOzoneUptakeOnePoint( & ! calculate instantaneous flux o3flux = o3concnmolm3/ (ko3*rs+ rb + ram) - ! apply o3 flux threshold + ! apply o3 flux threshold if (o3flux < o3_flux_threshold) then o3fluxcrit = 0._r8 else @@ -484,6 +437,53 @@ subroutine CalcOzoneUptakeOnePoint( & end subroutine CalcOzoneUptakeOnePoint + !----------------------------------------------------------------------- + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + ! + ! !LOCAL VARIABLES: + integer :: fp ! filter index + integer :: p ! patch index + + character(len=*), parameter :: subname = 'CalcOzoneStress' + !----------------------------------------------------------------------- + + associate( & + o3uptakesha => this%o3uptakesha_patch , & ! Input: [real(r8) (:)] ozone dose + o3uptakesun => this%o3uptakesun_patch , & ! Input: [real(r8) (:)] ozone dose + o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsun => this%o3coefgsun_patch & ! Output: [real(r8) (:)] ozone coef + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + + ! Ozone stress for shaded leaves + call CalcOzoneStressOnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & + o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) + + ! Ozone stress for sunlit leaves + call CalcOzoneStressOnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & + o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) + end do + + + end associate + + end subroutine CalcOzoneStress + !----------------------------------------------------------------------- subroutine CalcOzoneStressOnePoint( & pft_type, o3uptake, & From a78bb45736ffd8b8936762225672dd7aecd514ef Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 6 Feb 2021 09:40:47 -0700 Subject: [PATCH 087/219] Demonstrate method for selecting between different ozone stress methods --- src/biogeophys/OzoneMod.F90 | 57 +++++++++++++++++++++++++++++++------ 1 file changed, 49 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 5822a26f30..6210d574ad 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -16,6 +16,7 @@ module OzoneMod use shr_kind_mod, only : r8 => shr_kind_r8 use decompMod , only : bounds_type use clm_varcon , only : spval + use clm_varctl , only : iulog use OzoneBaseMod, only : ozone_base_type use abortutils , only : endrun use PatchType , only : patch @@ -29,6 +30,8 @@ module OzoneMod type, extends(ozone_base_type), public :: ozone_type private ! Private data members + integer :: stress_method ! Which ozone stress parameterization we're using in this run + real(r8), pointer :: o3uptakesha_patch(:) ! ozone dose, shaded leaves (mmol O3/m^2) real(r8), pointer :: o3uptakesun_patch(:) ! ozone dose, sunlit leaves (mmol O3/m^2) @@ -65,11 +68,15 @@ module OzoneMod ! Calculate ozone uptake for a single point, for just sunlit or shaded leaves procedure, private, nopass :: CalcOzoneUptakeOnePoint + ! Original ozone stress parameterization, from Danica Lombardozzi + procedure, private :: CalcOzoneStressLombardozzi + ! Calculate ozone stress for a single point, for just sunlit or shaded leaves - procedure, private, nopass :: CalcOzoneStressOnePoint + procedure, private, nopass :: CalcOzoneStressLombardozziOnePoint end type ozone_type ! !PRIVATE TYPES: + integer, parameter :: stress_method_lombardozzi = 1 ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying ! value, obtained from ATM @@ -124,6 +131,9 @@ subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds !----------------------------------------------------------------------- + ! TODO(wjs, 2021-02-06) This will be based on a namelist variable + this%stress_method = stress_method_lombardozzi + call this%InitAllocate(bounds) call this%InitHistory(bounds) call this%InitCold(bounds) @@ -450,10 +460,39 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg ! ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'CalcOzoneStress' + !----------------------------------------------------------------------- + + select case (this%stress_method) + case (stress_method_lombardozzi) + call this%CalcOzoneStressLombardozzi(bounds, num_exposedvegp, filter_exposedvegp) + case default + write(iulog,*) 'ERROR: unknown ozone stress method: ', this%stress_method + call endrun('Unknown ozone stress method') + end select + + end subroutine CalcOzoneStress + + !----------------------------------------------------------------------- + subroutine CalcOzoneStressLombardozzi(this, bounds, num_exposedvegp, filter_exposedvegp) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! This subroutine uses the Lombardozzi formulation for ozone stress + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + ! + ! !LOCAL VARIABLES: integer :: fp ! filter index integer :: p ! patch index - character(len=*), parameter :: subname = 'CalcOzoneStress' + character(len=*), parameter :: subname = 'CalcOzoneStressLombardozzi' !----------------------------------------------------------------------- associate( & @@ -469,12 +508,12 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) p = filter_exposedvegp(fp) ! Ozone stress for shaded leaves - call CalcOzoneStressOnePoint( & + call CalcOzoneStressLombardozziOnePoint( & pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) ! Ozone stress for sunlit leaves - call CalcOzoneStressOnePoint( & + call CalcOzoneStressLombardozziOnePoint( & pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) end do @@ -482,16 +521,18 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) end associate - end subroutine CalcOzoneStress + end subroutine CalcOzoneStressLombardozzi !----------------------------------------------------------------------- - subroutine CalcOzoneStressOnePoint( & + subroutine CalcOzoneStressLombardozziOnePoint( & pft_type, o3uptake, & o3coefv, o3coefg) ! ! !DESCRIPTION: ! Calculates ozone stress for a single point, for just sunlit or shaded leaves ! + ! This subroutine uses the Lombardozzi formulation for ozone stress + ! ! !ARGUMENTS: integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays real(r8) , intent(in) :: o3uptake ! ozone entering the leaf @@ -504,7 +545,7 @@ subroutine CalcOzoneStressOnePoint( & real(r8) :: condInt ! intercept for conductance real(r8) :: condSlope ! slope for conductance - character(len=*), parameter :: subname = 'CalcOzoneStressOnePoint' + character(len=*), parameter :: subname = 'CalcOzoneStressLombardozziOnePoint' !----------------------------------------------------------------------- if (o3uptake == 0._r8) then @@ -540,6 +581,6 @@ subroutine CalcOzoneStressOnePoint( & end if - end subroutine CalcOzoneStressOnePoint + end subroutine CalcOzoneStressLombardozziOnePoint end module OzoneMod From c5b8f4e952d14069c72c75d7eb357b707979890f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 6 Feb 2021 11:09:23 -0700 Subject: [PATCH 088/219] Move call to CalcOzoneStress to earlier in the driver loop This way, we don't need the stress terms on the restart file. --- src/biogeophys/CanopyFluxesMod.F90 | 9 ++++----- src/biogeophys/OzoneMod.F90 | 20 -------------------- src/main/clm_driver.F90 | 4 ++-- 3 files changed, 6 insertions(+), 27 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 97b40be7e1..a88df97448 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1548,10 +1548,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, call PhotosynthesisTotal(fn, filterp, & atm2lnd_inst, canopystate_inst, photosyns_inst) - ! Calculate ozone stress. This needs to be done after rssun and rsshade are - ! computed by the Photosynthesis routine. However, Photosynthesis also uses the - ! ozone stress computed here. Thus, the ozone stress computed in timestep i is - ! applied in timestep (i+1). + ! Calculate ozone uptake. This needs to be done after rssun and rsshade are + ! computed by the Photosynthesis routine. The updated ozone uptake computed here + ! will be used in the next time step to calculate ozone stress for the next time + ! step's photosynthesis calculations. ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) The following dummy variable assignment is ! needed with pgi 14.7 on yellowstone; without it, forc_pbot_downscaled_col gets @@ -1566,7 +1566,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, rb = frictionvel_inst%rb1_patch(bounds%begp:bounds%endp), & ram = frictionvel_inst%ram1_patch(bounds%begp:bounds%endp), & tlai = canopystate_inst%tlai_patch(bounds%begp:bounds%endp)) - call ozone_inst%CalcOzoneStress(bounds, fn, filterp) !--------------------------------------------------------- !update Vc,max and Jmax by LUNA model diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 6210d574ad..95d6fde5c4 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -267,26 +267,6 @@ subroutine Restart(this, bounds, ncid, flag) long_name='ozone uptake for sunlit leaves', units='mmol m^-3', & readvar=readvar, interpinic_flag='interp', data=this%o3uptakesun_patch) - call restartvar(ncid=ncid, flag=flag, varname='o3coefvsun', xtype=ncd_double, & - dim1name='pft', & - long_name='ozone coefficient for photosynthesis for sunlit leaves', units='unitless', & - readvar=readvar, interpinic_flag='interp', data=this%o3coefvsun_patch) - - call restartvar(ncid=ncid, flag=flag, varname='o3coefgsun', xtype=ncd_double, & - dim1name='pft', & - long_name='ozone coefficient for stomatal conductance for sunlit leaves', units='unitless', & - readvar=readvar, interpinic_flag='interp', data=this%o3coefgsun_patch) - - call restartvar(ncid=ncid, flag=flag, varname='o3coefvsha', xtype=ncd_double, & - dim1name='pft', & - long_name='ozone coefficient for photosynthesis for shaded leaves', units='unitless', & - readvar=readvar, interpinic_flag='interp', data=this%o3coefvsha_patch) - - call restartvar(ncid=ncid, flag=flag, varname='o3coefgsha', xtype=ncd_double, & - dim1name='pft', & - long_name='ozone coefficient for stomatal conductance for shaded leaves', units='unitless', & - readvar=readvar, interpinic_flag='interp', data=this%o3coefgsha_patch) - end subroutine Restart ! ======================================================================== diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index b16b0ae576..11daa19354 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -74,13 +74,11 @@ module clm_driver use DaylengthMod , only : UpdateDaylength use perf_mod ! - use clm_instMod , only : nutrient_competition_method use GridcellType , only : grc use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch use clm_instMod - use clm_instMod , only : soil_water_retention_curve use EDBGCDynMod , only : EDBGCDyn, EDBGCDynSummary use SoilMoistureStreamMod , only : PrescribedSoilMoistureInterp, PrescribedSoilMoistureAdvance ! @@ -610,6 +608,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro water_inst%wateratm2lndbulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterstatebulk_inst) + call ozone_inst%CalcOzoneStress(bounds_clump, filter(nc)%num_exposedvegp, filter(nc)%exposedvegp) + ! TODO(wjs, 2019-10-02) I'd like to keep moving this down until it is below ! LakeFluxes... I'll probably leave it in place there. if (water_inst%DoConsistencyCheck()) then From 57e604446940360fae73d8addba9d19ec51169c2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 8 Feb 2021 19:40:05 -0700 Subject: [PATCH 089/219] Handel SOILWATER_10CM properly in Summary rather than too early as in #932 --- src/biogeophys/HydrologyNoDrainageMod.F90 | 8 ---- src/biogeophys/WaterDiagnosticBulkType.F90 | 56 +++++++++++++++++++--- src/biogeophys/WaterDiagnosticType.F90 | 3 ++ src/biogeophys/WaterType.F90 | 9 +++- src/main/clm_driver.F90 | 3 +- 5 files changed, 62 insertions(+), 17 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 9a3009d968..a3803238b4 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -245,7 +245,6 @@ subroutine HydrologyNoDrainage(bounds, & snowice => b_waterdiagnostic_inst%snowice_col , & ! Output: [real(r8) (:) ] average snow ice lens snowliq => b_waterdiagnostic_inst%snowliq_col , & ! Output: [real(r8) (:) ] average snow liquid water snow_persistence => b_waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered - h2osoi_liqice_10cm => b_waterdiagnostic_inst%h2osoi_liqice_10cm_col , & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) h2osoi_ice => b_waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_liq => b_waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice_tot => b_waterdiagnostic_inst%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) @@ -511,7 +510,6 @@ subroutine HydrologyNoDrainage(bounds, & if (.not. lun%urbpoi(l)) then t_soi_10cm(c) = 0._r8 tsoi17(c) = 0._r8 - h2osoi_liqice_10cm(c) = 0._r8 h2osoi_liq_tot(c) = 0._r8 h2osoi_ice_tot(c) = 0._r8 end if @@ -538,16 +536,10 @@ subroutine HydrologyNoDrainage(bounds, & if (zi(c,j) <= 0.1_r8) then fracl = 1._r8 t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl - h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & - (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & - fracl else if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) < 0.1_r8) then fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl - h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & - (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & - fracl end if end if diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 21cc9d283b..55125f232d 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -829,31 +829,45 @@ end subroutine RestartBackcompatIssue783 subroutine Summary(this, bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) ! ! !DESCRIPTION: ! Compute end-of-timestep summaries of water diagnostic terms ! + ! !USES: + use clm_varpar , only : nlevsoi ! !ARGUMENTS: class(waterdiagnosticbulk_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilp ! number of patches in soilp filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_soilp ! number of patches in soilp filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of columns in no-lake columnc filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns class(waterstate_type) , intent(in) :: waterstate_inst class(waterflux_type) , intent(in) :: waterflux_inst ! ! !LOCAL VARIABLES: - integer :: fp, p - integer :: fc, c + integer :: fp, p, j, l, fc, c ! Indices + real(r8):: fracl ! fraction of soil layer contributing to 10cm total soil water character(len=*), parameter :: subname = 'Summary' !----------------------------------------------------------------------- + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_liqice_10cm => this%h2osoi_liqice_10cm_col & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) + ) call this%waterdiagnostic_type%Summary(bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) call waterstate_inst%CalculateTotalH2osno(bounds, num_allc, filter_allc, & @@ -873,6 +887,36 @@ subroutine Summary(this, bounds, & waterflux_inst%qflx_liq_grnd_col(c) + & waterflux_inst%qflx_snow_grnd_col(c) end do + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + h2osoi_liqice_10cm(c) = 0.0_r8 + end if + end do + do j = 1, nlevsoi + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (zi(c,j) <= 0.1_r8) then + fracl = 1._r8 + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + else + if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) < 0.1_r8) then + fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + end if + end if + end if + end do + end do + + end associate end subroutine Summary diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 448d422877..0006ecc20d 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -335,6 +335,7 @@ end subroutine Restart subroutine Summary(this, bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) ! ! !DESCRIPTION: @@ -347,6 +348,8 @@ subroutine Summary(this, bounds, & integer , intent(in) :: filter_soilp(:) ! filter for soil patches integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of columns in no-lake filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns class(waterstate_type) , intent(in) :: waterstate_inst class(waterflux_type) , intent(in) :: waterflux_inst ! diff --git a/src/biogeophys/WaterType.F90 b/src/biogeophys/WaterType.F90 index 4744b63085..9e3431daa5 100644 --- a/src/biogeophys/WaterType.F90 +++ b/src/biogeophys/WaterType.F90 @@ -1009,8 +1009,9 @@ end subroutine ResetCheckedTracers !----------------------------------------------------------------------- subroutine Summary(this, bounds, & - num_soilp, filter_soilp, & - num_allc, filter_allc) + num_soilp, filter_soilp, & + num_allc, filter_allc, & + num_nolakec, filter_nolakec) ! ! !DESCRIPTION: ! Compute end-of-timestep summaries of water diagnostic terms @@ -1022,6 +1023,8 @@ subroutine Summary(this, bounds, & integer , intent(in) :: filter_soilp(:) ! filter for soil patches integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of no-lake filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns ! ! !LOCAL VARIABLES: integer :: i @@ -1037,6 +1040,8 @@ subroutine Summary(this, bounds, & filter_soilp = filter_soilp, & num_allc = num_allc, & filter_allc = filter_allc, & + num_nolakec = num_nolakec, & + filter_nolakec = filter_nolakec, & waterstate_inst = bulk_or_tracer%waterstate_inst, & waterflux_inst = bulk_or_tracer%waterflux_inst) end associate diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 400aa65f56..927acabf49 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -1112,7 +1112,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call water_inst%Summary(bounds_clump, & filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_allc, filter(nc)%allc) + filter(nc)%num_allc, filter(nc)%allc, & + filter(nc)%num_nolakec, filter(nc)%nolakec) ! ============================================================================ ! Check the energy and water balance From 36454eb38caf81bdd18fd92d99d671a6547b0962 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 8 Feb 2021 21:07:30 -0700 Subject: [PATCH 090/219] Add handling of TOTSOILICE and TOTSOILLIQ to Summary for #932 as well, finishing it off --- src/biogeophys/WaterDiagnosticBulkType.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 55125f232d..d592948f9b 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -855,13 +855,16 @@ subroutine Summary(this, bounds, & character(len=*), parameter :: subname = 'Summary' !----------------------------------------------------------------------- - associate( & - dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) - zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) - h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) - h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) - h2osoi_liqice_10cm => this%h2osoi_liqice_10cm_col & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col, & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col, & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + + h2osoi_ice_tot => this%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) + h2osoi_liq_tot => this%h2osoi_liq_tot_col , & ! Output: [real(r8) (:) ] vertically summed liquid water (kg/m2) + h2osoi_liqice_10cm => this%h2osoi_liqice_10cm_col & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) ) call this%waterdiagnostic_type%Summary(bounds, & @@ -892,6 +895,8 @@ subroutine Summary(this, bounds, & l = col%landunit(c) if (.not. lun%urbpoi(l)) then h2osoi_liqice_10cm(c) = 0.0_r8 + h2osoi_liq_tot(c) = 0._r8 + h2osoi_ice_tot(c) = 0._r8 end if end do do j = 1, nlevsoi @@ -912,6 +917,8 @@ subroutine Summary(this, bounds, & fracl end if end if + h2osoi_liq_tot(c) = h2osoi_liq_tot(c) + h2osoi_liq(c,j) + h2osoi_ice_tot(c) = h2osoi_ice_tot(c) + h2osoi_ice(c,j) end if end do end do From 493ba048a5aa784bda0d0c55e867405acabe84fe Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 8 Feb 2021 21:55:49 -0700 Subject: [PATCH 091/219] Remove sum of h2osoi_liq_tot and h2osoi_ice_tot from HydrologyNoDrainage as it's moved to the Summary routine (note also for validation I checked that answers stay the same for these variables if I use the previous version of HydrologyNoDrainage and comment out the sums in Summary and it does). --- src/biogeophys/HydrologyNoDrainageMod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index a3803238b4..d65a01e2b9 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -247,8 +247,6 @@ subroutine HydrologyNoDrainage(bounds, & snow_persistence => b_waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered h2osoi_ice => b_waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_liq => b_waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) - h2osoi_ice_tot => b_waterdiagnostic_inst%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) - h2osoi_liq_tot => b_waterdiagnostic_inst%h2osoi_liq_tot_col , & ! Output: [real(r8) (:) ] vertically summed liquid water (kg/m2) h2osoi_vol => b_waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] h2osno_top => b_waterdiagnostic_inst%h2osno_top_col , & ! Output: [real(r8) (:) ] mass of snow in top layer (col) [kg] wf => b_waterdiagnostic_inst%wf_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m @@ -510,8 +508,6 @@ subroutine HydrologyNoDrainage(bounds, & if (.not. lun%urbpoi(l)) then t_soi_10cm(c) = 0._r8 tsoi17(c) = 0._r8 - h2osoi_liq_tot(c) = 0._r8 - h2osoi_ice_tot(c) = 0._r8 end if end do do j = 1, nlevsoi @@ -543,9 +539,6 @@ subroutine HydrologyNoDrainage(bounds, & end if end if - h2osoi_liq_tot(c) = h2osoi_liq_tot(c) + h2osoi_liq(c,j) - h2osoi_ice_tot(c) = h2osoi_ice_tot(c) + h2osoi_ice(c,j) - end if end do end do From c004581e74fce7f12f335e272d76c975cd9bfae0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 8 Feb 2021 23:00:25 -0700 Subject: [PATCH 092/219] Add ADspinup test --- cime_config/testdefs/testlist_clm.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 95db622a9c..8c91bd9d88 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1813,6 +1813,15 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + From 27cac9294bfd32cdb5be0ec42c4e3a6407fa40d1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 8 Feb 2021 23:20:45 -0700 Subject: [PATCH 093/219] Update paramsfile to fix issues #1262, #1184, and #478 --- bld/namelist_files/namelist_defaults_ctsm.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index e73adfe305..3ccbe89a0e 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -473,9 +473,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/ctsm51_params.c210115.nc -lnd/clm2/paramdata/clm50_params.c210112.nc -lnd/clm2/paramdata/clm45_params.c210112.nc +lnd/clm2/paramdata/ctsm51_params.c210208.nc +lnd/clm2/paramdata/clm50_params.c210208.nc +lnd/clm2/paramdata/clm45_params.c210208.nc From 329977fb7d08be4aed309e6793e917cb300dfa2d Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Feb 2021 10:55:45 -0700 Subject: [PATCH 094/219] Add year in Lombardozzi method --- src/biogeophys/OzoneMod.F90 | 38 +++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 95d6fde5c4..8e3a5d0dc2 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -9,7 +9,9 @@ module OzoneMod ! computed here. Thus, the ozone stress computed in timestep i is applied in timestep ! (i+1), requiring these stresses to be saved on the restart file. ! - ! Developed by Danica Lombardozzi. + ! Developed by Danica Lombardozzi: Lombardozzi, D., S. Levis, G. Bonan, P. G. Hess, and + ! J. P. Sparks (2015), The Influence of Chronic Ozone Exposure on Global Carbon and + ! Water Cycles, J Climate, 28(1), 292–305, doi:10.1175/JCLI-D-14-00223.1. ! ! !USES: #include "shr_assert.h" @@ -68,15 +70,15 @@ module OzoneMod ! Calculate ozone uptake for a single point, for just sunlit or shaded leaves procedure, private, nopass :: CalcOzoneUptakeOnePoint - ! Original ozone stress parameterization, from Danica Lombardozzi - procedure, private :: CalcOzoneStressLombardozzi + ! Original ozone stress parameterization, from Danica Lombardozzi 2015 + procedure, private :: CalcOzoneStressLombardozzi2015 ! Calculate ozone stress for a single point, for just sunlit or shaded leaves - procedure, private, nopass :: CalcOzoneStressLombardozziOnePoint + procedure, private, nopass :: CalcOzoneStressLombardozzi2015OnePoint end type ozone_type ! !PRIVATE TYPES: - integer, parameter :: stress_method_lombardozzi = 1 + integer, parameter :: stress_method_lombardozzi2015 = 1 ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying ! value, obtained from ATM @@ -132,7 +134,7 @@ subroutine Init(this, bounds) !----------------------------------------------------------------------- ! TODO(wjs, 2021-02-06) This will be based on a namelist variable - this%stress_method = stress_method_lombardozzi + this%stress_method = stress_method_lombardozzi2015 call this%InitAllocate(bounds) call this%InitHistory(bounds) @@ -445,8 +447,8 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) !----------------------------------------------------------------------- select case (this%stress_method) - case (stress_method_lombardozzi) - call this%CalcOzoneStressLombardozzi(bounds, num_exposedvegp, filter_exposedvegp) + case (stress_method_lombardozzi2015) + call this%CalcOzoneStressLombardozzi2015(bounds, num_exposedvegp, filter_exposedvegp) case default write(iulog,*) 'ERROR: unknown ozone stress method: ', this%stress_method call endrun('Unknown ozone stress method') @@ -455,12 +457,12 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) end subroutine CalcOzoneStress !----------------------------------------------------------------------- - subroutine CalcOzoneStressLombardozzi(this, bounds, num_exposedvegp, filter_exposedvegp) + subroutine CalcOzoneStressLombardozzi2015(this, bounds, num_exposedvegp, filter_exposedvegp) ! ! !DESCRIPTION: ! Calculate ozone stress. ! - ! This subroutine uses the Lombardozzi formulation for ozone stress + ! This subroutine uses the Lombardozzi2015 formulation for ozone stress ! ! !ARGUMENTS: class(ozone_type), intent(inout) :: this @@ -472,7 +474,7 @@ subroutine CalcOzoneStressLombardozzi(this, bounds, num_exposedvegp, filter_expo integer :: fp ! filter index integer :: p ! patch index - character(len=*), parameter :: subname = 'CalcOzoneStressLombardozzi' + character(len=*), parameter :: subname = 'CalcOzoneStressLombardozzi2015' !----------------------------------------------------------------------- associate( & @@ -488,12 +490,12 @@ subroutine CalcOzoneStressLombardozzi(this, bounds, num_exposedvegp, filter_expo p = filter_exposedvegp(fp) ! Ozone stress for shaded leaves - call CalcOzoneStressLombardozziOnePoint( & + call CalcOzoneStressLombardozzi2015OnePoint( & pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) ! Ozone stress for sunlit leaves - call CalcOzoneStressLombardozziOnePoint( & + call CalcOzoneStressLombardozzi2015OnePoint( & pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) end do @@ -501,17 +503,17 @@ subroutine CalcOzoneStressLombardozzi(this, bounds, num_exposedvegp, filter_expo end associate - end subroutine CalcOzoneStressLombardozzi + end subroutine CalcOzoneStressLombardozzi2015 !----------------------------------------------------------------------- - subroutine CalcOzoneStressLombardozziOnePoint( & + subroutine CalcOzoneStressLombardozzi2015OnePoint( & pft_type, o3uptake, & o3coefv, o3coefg) ! ! !DESCRIPTION: ! Calculates ozone stress for a single point, for just sunlit or shaded leaves ! - ! This subroutine uses the Lombardozzi formulation for ozone stress + ! This subroutine uses the Lombardozzi2015 formulation for ozone stress ! ! !ARGUMENTS: integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays @@ -525,7 +527,7 @@ subroutine CalcOzoneStressLombardozziOnePoint( & real(r8) :: condInt ! intercept for conductance real(r8) :: condSlope ! slope for conductance - character(len=*), parameter :: subname = 'CalcOzoneStressLombardozziOnePoint' + character(len=*), parameter :: subname = 'CalcOzoneStressLombardozzi2015OnePoint' !----------------------------------------------------------------------- if (o3uptake == 0._r8) then @@ -561,6 +563,6 @@ subroutine CalcOzoneStressLombardozziOnePoint( & end if - end subroutine CalcOzoneStressLombardozziOnePoint + end subroutine CalcOzoneStressLombardozzi2015OnePoint end module OzoneMod From ff4f3a793d71f57b002ca3ce0358cafe5aa23043 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 10 Feb 2021 15:40:11 -0700 Subject: [PATCH 095/219] Update change files --- doc/ChangeLog | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 116 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index bc681f955a..479ba86070 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,119 @@ =============================================================== +Tag name: ctsm5.1.dev023 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed Feb 10 13:33:19 MST 2021 +One-line Summary: Calculate leaf biomass for non-woody PFTS, and a few other small answer changes + +Purpose and description of changes +---------------------------------- + +Replace hard code constant 0.25 for leaf mass per area with calculation based on parameter slatop (specific leaf area, top of +canopy). Also move num_iter into loop over patches; currently it sits outside a loop, so p index is incorrect. + +Also do some small answer changes in terms of new parameter files, and some other existing issues that have mild answer changes. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +Issues fixed (include CTSM Issue #): + Fixes #1256 + Fixes #1268 + Fixes #1262 + Fixes #1261 + Fixes #1256 + Fixes #1255 + Fixes #1252 + Fixes #1184 + Fixes #932 + Fixes #478 + +Known bugs found since the previous tag (include issue #): + #1274 -- Dead PFTs in PPE2_BHSon simulations + + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + +Changes made to namelist defaults (e.g., changed parameter values): + Parameter files are updated + +Changes to the datasets (e.g., parameter, surface or initial files): + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + +Changes to tests or testing: Add ADspinup test + Add an ADspinup restart test that would've detected one of the bugs fixed here + + +Testing summary: regular tools +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS (348 tests are different because of parameter file update) + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- PASS + izumi ------- PASS + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: Yes, clm51, clm50-non-crop, clm45 two diagnostics + + Summarize any changes to answers, i.e., + - what code configurations: clm5_1 for all, clm50 for non-crop (Sp and Bgc), clm4_5 two diagnostics + - what platforms/compilers: All + - nature of change: clm51--BGC climate, others similar climate + +Other details +------------- +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + + #1254 -- replace constant leaf mass per area (lma) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev022 Originator(s): gregorylemieux (Gregory Lemieux,LBL/NGEET,510-486-5049) Date: Fri Feb 5 00:03:28 MST 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index ffd5a805a4..d6059635da 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev023 erik 02/10/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes ctsm5.1.dev022 glemieux 02/05/2021 Merge fates_main_api into ctsm master ctsm5.1.dev021 erik 01/12/2021 Add option for biomass heat storage (BHS) to clm5_1 physics ctsm5.1.dev020 erik 12/30/2020 Potential roundoff changes in preparation for bio-mass heat storage option From 0da34ed0e3fb915005e87a92e529916cc82d2ff8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 10 Feb 2021 22:16:40 -0700 Subject: [PATCH 096/219] Go back to previous version of urban dataset so that you can at least use a created surface dataset with this version partial fix for #1252 --- bld/namelist_files/namelist_defaults_ctsm_tools.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm_tools.xml b/bld/namelist_files/namelist_defaults_ctsm_tools.xml index 2a14f2df50..78ab368110 100644 --- a/bld/namelist_files/namelist_defaults_ctsm_tools.xml +++ b/bld/namelist_files/namelist_defaults_ctsm_tools.xml @@ -269,7 +269,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c170724.nc +>lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120621.nc lnd/clm2/rawdata/mksrf_urban_0.05x0.05_zerourbanpct.c181014.nc From 52210c5c93a637669f415d30bfa3fe91efb3dbb1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 11 Feb 2021 00:06:23 -0700 Subject: [PATCH 097/219] Add a mkmapdata script test for a single-point and do what's needed for it to run --- test/tools/README | 2 +- test/tools/nl_files/mkmapdata_i1x1_brazil | 1 + test/tools/nl_files/mkmapdata_if10 | 2 +- test/tools/test_driver.sh | 1 + test/tools/tests_pretag_cheyenne_nompi | 1 + 5 files changed, 5 insertions(+), 2 deletions(-) create mode 100644 test/tools/nl_files/mkmapdata_i1x1_brazil diff --git a/test/tools/README b/test/tools/README index 4929144b20..8972894527 100644 --- a/test/tools/README +++ b/test/tools/README @@ -13,7 +13,7 @@ To use... on cheyenne -qcmd -l walltime=06:00:00 -- ./test_driver.sh -i >& run.out & +qcmd -l select=mem=109GB -l walltime=06:00:00 -- ./test_driver.sh -i >& run.out & Intended for use on NCAR machines cheyenne, geyser (DAV) and hobart. diff --git a/test/tools/nl_files/mkmapdata_i1x1_brazil b/test/tools/nl_files/mkmapdata_i1x1_brazil new file mode 100644 index 0000000000..879ffa6d47 --- /dev/null +++ b/test/tools/nl_files/mkmapdata_i1x1_brazil @@ -0,0 +1 @@ +-t regional -r 1x1_brazil diff --git a/test/tools/nl_files/mkmapdata_if10 b/test/tools/nl_files/mkmapdata_if10 index 1c30796e2e..c3218edc1c 100644 --- a/test/tools/nl_files/mkmapdata_if10 +++ b/test/tools/nl_files/mkmapdata_if10 @@ -1 +1 @@ --t regional -r 10x15 +-r 10x15 diff --git a/test/tools/test_driver.sh b/test/tools/test_driver.sh index 0cd322b9d2..28ecb07072 100755 --- a/test/tools/test_driver.sh +++ b/test/tools/test_driver.sh @@ -78,6 +78,7 @@ export MACH_WORKSPACE="/glade/scratch" export CPRNC_EXE="$CESMDATAROOT/tools/cime/tools/cprnc/cprnc.cheyenne" dataroot="$CESMDATAROOT" export TOOLSLIBS="" +export REGRID_PROC=1 export TOOLS_CONF_STRING="--mpilib mpi-serial" diff --git a/test/tools/tests_pretag_cheyenne_nompi b/test/tools/tests_pretag_cheyenne_nompi index b80d9a78c1..3bdeef5deb 100644 --- a/test/tools/tests_pretag_cheyenne_nompi +++ b/test/tools/tests_pretag_cheyenne_nompi @@ -1,3 +1,4 @@ +smi79 bli79 smc#4 blc#4 sme14 ble14 sme@4 ble@4 From c49631da7726b8d1f0b4af5016708a138004f41c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 11 Feb 2021 00:07:26 -0700 Subject: [PATCH 098/219] Add a module purge at the start on cheyenne, so that it's for sure loading the desired modules --- tools/mkmapdata/mkmapdata.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/mkmapdata/mkmapdata.sh b/tools/mkmapdata/mkmapdata.sh index c778261234..9c5ef63db4 100755 --- a/tools/mkmapdata/mkmapdata.sh +++ b/tools/mkmapdata/mkmapdata.sh @@ -344,6 +344,7 @@ case $hostname in fi esmfvers=7.1.0r intelvers=18.0.5 # Could also use intel/19.0.2 EBK 10/4/2019 + module purge module load intel/$intelvers module load esmf_libs/$esmfvers module load ncl From 5613c355151fc529ff99b02ba5db5046a0898abb Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 11 Feb 2021 00:14:19 -0700 Subject: [PATCH 099/219] More updates to change files --- doc/ChangeLog | 24 +++++++++++------------- doc/ChangeSum | 2 +- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 479ba86070..f959e21e1f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev023 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) -Date: Wed Feb 10 13:33:19 MST 2021 +Date: Thu Feb 11 00:14:03 MST 2021 One-line Summary: Calculate leaf biomass for non-woody PFTS, and a few other small answer changes Purpose and description of changes @@ -33,16 +33,15 @@ Does this tag change answers significantly for any of the following physics conf Bugs fixed or introduced ------------------------ Issues fixed (include CTSM Issue #): - Fixes #1256 - Fixes #1268 - Fixes #1262 - Fixes #1261 - Fixes #1256 - Fixes #1255 - Fixes #1252 - Fixes #1184 - Fixes #932 - Fixes #478 + Fixes #1256 -- num_iter incorrect + Fixes #1268 -- Leaf biomass not updated for + Fixes #1262 -- pconv should be 1 for crops + Fixes #1261 -- Restarts fail in AD-spinup mode + Fixes #1255 -- mkmapdata crashes because of modules + Fixes #1252 -- New urban dataset for fsurdat fails when used with new model + Fixes #1184 -- slatop for generic crop + Fixes #932 --- Diagnostic variables are incorrect + Fixes #478 --- Bare soil g1 should be zero Known bugs found since the previous tag (include issue #): #1274 -- Dead PFTs in PPE2_BHSon simulations @@ -51,8 +50,6 @@ Known bugs found since the previous tag (include issue #): Notes of particular relevance for users --------------------------------------- -Caveats for users (e.g., need to interpolate initial conditions): - Changes made to namelist defaults (e.g., changed parameter values): Parameter files are updated @@ -63,6 +60,7 @@ Notes of particular relevance for developers: NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Leaf biomass should still be completely moved outside of CanopyFluxes Changes to tests or testing: Add ADspinup test Add an ADspinup restart test that would've detected one of the bugs fixed here diff --git a/doc/ChangeSum b/doc/ChangeSum index d6059635da..68c10d64a1 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm5.1.dev023 erik 02/10/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes + ctsm5.1.dev023 erik 02/11/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes ctsm5.1.dev022 glemieux 02/05/2021 Merge fates_main_api into ctsm master ctsm5.1.dev021 erik 01/12/2021 Add option for biomass heat storage (BHS) to clm5_1 physics ctsm5.1.dev020 erik 12/30/2020 Potential roundoff changes in preparation for bio-mass heat storage option From 6768534c40e9a185a45aff256af819160bd731ae Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Sat, 13 Feb 2021 17:28:40 -0700 Subject: [PATCH 100/219] Bypass grc-level h2o check when use_soil_moisture_streams = .true. --- src/biogeophys/BalanceCheckMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index c0aafe60e9..79eab50610 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -18,7 +18,6 @@ module BalanceCheckMod use EnergyFluxType , only : energyflux_type use SolarAbsorbedType , only : solarabs_type use SoilHydrologyType , only : soilhydrology_type - use SurfaceAlbedoType , only : surfalb_type use WaterStateType , only : waterstate_type use LakestateType , only : lakestate_type use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type @@ -399,6 +398,7 @@ subroutine BalanceCheck( bounds, & ! ! !USES: use clm_varcon , only : spval + use clm_varctl , only : use_soil_moisture_streams use clm_time_manager , only : get_step_size_real, get_nstep use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type @@ -724,6 +724,7 @@ subroutine BalanceCheck( bounds, & ' local indexg= ',indexg,& ' errh2o_grc= ',errh2o_grc(indexg) if (errh2o_max_val > error_thresh .and. DAnstep > skip_steps .and. & + .not. use_soil_moisture_streams .and. & .not. get_for_testing_zero_dynbal_fluxes()) then write(iulog,*)'CTSM is stopping because errh2o > ', error_thresh, ' mm' From 8409364397a304097c220cdeb49d1a2d0862eed8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 16 Feb 2021 15:42:02 -0700 Subject: [PATCH 101/219] changes needed for nag --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 9 ++++----- src/cpl/nuopc/lnd_import_export.F90 | 10 +++++----- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index de743d481e..14ab1032f5 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -279,11 +279,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(iulog,'(a )')' atm component = '//trim(atm_model) write(iulog,'(a )')' rof component = '//trim(rof_model) write(iulog,'(a )')' glc component = '//trim(glc_model) - write(iulog,'(a,l )')' atm_prognostic = ',atm_prognostic - write(iulog,'(a,l )')' rof_prognostic = ',rof_prognostic - write(iulog,'(a,l )')' glc_present = ',glc_present + write(iulog,'(a,L1 )')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,L1 )')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,L1 )')' glc_present = ',glc_present if (glc_present) then - write(iulog,'(a,l)')' cism_evolve = ',cism_evolve + write(iulog,'(a,L1)')' cism_evolve = ',cism_evolve end if write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num @@ -328,7 +328,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type integer :: ref_ymd ! reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (sec) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 3839ff6331..1c5a6423ad 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -216,11 +216,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. if (masterproc) then - write(iulog,'(a,l)') 'flds_co2a= ',flds_co2a - write(iulog,'(a,l)') 'flds_co2b= ',flds_co2b - write(iulog,'(a,l)') 'flds_co2c= ',flds_co2c - write(iulog,'(a,l)') 'sending co2 to atm = ',send_co2_to_atm - write(iulog,'(a,l)') 'receiving co2 from atm = ',recv_co2_fr_atm + write(iulog,'(a,l1)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,l1)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,l1)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,l1)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,l1)') 'receiving co2 from atm = ',recv_co2_fr_atm end if end if From 59576bf329336a4f0591f5752c56c73118c9e187 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 18 Feb 2021 09:04:02 -0700 Subject: [PATCH 102/219] add tolerance parameter --- src/biogeophys/SoilFluxesMod.F90 | 9 ++++----- src/biogeophys/SoilHydrologyMod.F90 | 14 +++++++++----- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index ffb6aa8056..d94dac723e 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -5,7 +5,7 @@ module SoilFluxesMod ! Updates surface fluxes based on the new ground temperature. ! ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4 + use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun @@ -78,8 +78,8 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & real(r8) :: eflx_lwrad_del(bounds%begp:bounds%endp) ! update due to eflx_lwrad real(r8) :: t_grnd0(bounds%begc:bounds%endc) ! t_grnd of previous time step real(r8) :: lw_grnd - real(r8) :: evaporation_limit - real(r8) :: ev_unconstrained + real(r8) :: evaporation_limit ! top layer moisture available for evaporation + real(r8) :: ev_unconstrained ! evaporative demand !----------------------------------------------------------------------- associate( & @@ -361,8 +361,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! limit only solid evaporation (sublimation) from top soil layer ! (liquid evaporation from soil should not be limited) if (j==1 .and. frac_h2osfc(c) < 1._r8) then - - if (real((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(p) * dtime,r4) > real(h2osoi_ice(c,j),r4)) then + if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(p)*dtime) >= h2osoi_ice(c,j)) then qflx_liqevap_from_top_layer(p) & = qflx_liqevap_from_top_layer(p) & diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 61f0767ce4..cc79fd9461 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -66,6 +66,7 @@ module SoilHydrologyMod !----------------------------------------------------------------------- real(r8), private :: baseflow_scalar = 1.e-2_r8 + real(r8), parameter :: tolerance = 1.e-12_r8 ! tolerance for checking whether sublimation is greater than ice in top soil layer character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -850,8 +851,8 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - qflx_solidevap_from_top_layer(c)) - if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > 1.e-8) then - call endrun(msg="solid evap too large! "//errmsg(sourcefile, __LINE__)) + if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > tolerance) then + call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) endif h2osoi_ice(c,1) = 0._r8 else @@ -2322,10 +2323,13 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & if ((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & + qflx_ev_snow(c) = qflx_ev_snow(c) & + - (qflx_solidevap_from_top_layer_save & - qflx_solidevap_from_top_layer(c)) - if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > 1.e-8) then - call endrun(msg="solid evap too large! "//errmsg(sourcefile, __LINE__)) + ! qflx_solidevap_from_top_layer should be constrained + ! in SoilFluxesMod to be <= h2osoi_ice, but check here + if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > tolerance) then + call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) endif h2osoi_ice(c,1) = 0._r8 From 09e35531f7422229a332fe7e972801981339e9f4 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 18 Feb 2021 18:02:52 -0700 Subject: [PATCH 103/219] Revisions required for I*G tests and *clm-prescribed tests to PASS 1) Addressed the former with some code reorg. At the crux of it though was the need to pass subtract_dynbal_baselines = .true. and add_lake_water_and_subtract_dynbal_baselines = .true. instead of .false. when calling ComputeWaterMassNonLake and ComputeWaterMassLake at the beginning and end of the time step. 2) Addressed the *clm-prescribed test failure by bypassing the grc-level water balance check when use_soil_moisture_streams = .false. --- src/biogeophys/BalanceCheckMod.F90 | 183 ++++++++++++++++------------- src/main/clm_driver.F90 | 12 +- src/main/lnd2atmMod.F90 | 4 +- 3 files changed, 113 insertions(+), 86 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 79eab50610..e1d7497198 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -44,7 +44,7 @@ module BalanceCheckMod ! !PUBLIC MEMBER FUNCTIONS: public :: BalanceCheckInit ! Initialization of Water and energy balance check - public :: BeginWaterGridcellBalance ! Initialize grid cell-level water balance check + public :: WaterGridcellBalance ! Grid cell-level water balance check public :: BeginWaterColumnBalance ! Initialize column-level water balance check public :: BalanceCheck ! Water & energy balance checks public :: GetBalanceCheckSkipSteps ! Get the number of steps to skip for the balance check @@ -56,7 +56,7 @@ module BalanceCheckMod ! ! !PRIVATE MEMBER FUNCTIONS: - private :: BeginWaterGridcellBalanceSingle ! Initialize grid cell-level water balance check for bulk or a single tracer + private :: WaterGridcellBalanceSingle ! Grid cell-level water balance check for bulk or a single tracer private :: BeginWaterColumnBalanceSingle ! Initialize column-level water balance check for bulk or a single tracer character(len=*), parameter, private :: sourcefile = & @@ -123,13 +123,12 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine BeginWaterGridcellBalance(bounds, & + subroutine WaterGridcellBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, lakestate_inst) + water_inst, lakestate_inst, use_aquifer_layer, flag) ! ! !DESCRIPTION: - ! Initialize grid cell-level water balance at beginning of time step - ! for bulk water and each water tracer + ! Grid cell-level water balance for bulk water and each water tracer ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -139,25 +138,28 @@ subroutine BeginWaterGridcellBalance(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(water_type) , intent(inout) :: water_inst type(lakestate_type) , intent(in) :: lakestate_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + character(len=5) , intent(in) :: flag ! specifies begwb or endwb ! ! !LOCAL VARIABLES: integer :: i - character(len=*), parameter :: subname = 'BeginWaterGridcellBalance' + character(len=*), parameter :: subname = 'WaterGridcellBalance' !----------------------------------------------------------------------- do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end - call BeginWaterGridcellBalanceSingle(bounds, & - num_nolakec, filter_nolakec, & - num_lakec, filter_lakec, & + ! Obtain begwb_grc + call WaterGridcellBalanceSingle(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & lakestate_inst, & water_inst%bulk_and_tracers(i)%waterstate_inst, & water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & water_inst%bulk_and_tracers(i)%waterbalance_inst, & - water_inst%bulk_and_tracers(i)%waterflux_inst) + water_inst%bulk_and_tracers(i)%waterflux_inst, & + use_aquifer_layer = use_aquifer_layer, flag = flag) end do - end subroutine BeginWaterGridcellBalance + end subroutine WaterGridcellBalance !----------------------------------------------------------------------- subroutine BeginWaterColumnBalance(bounds, & @@ -201,14 +203,14 @@ subroutine BeginWaterColumnBalance(bounds, & end subroutine BeginWaterColumnBalance !----------------------------------------------------------------------- - subroutine BeginWaterGridcellBalanceSingle(bounds, & + subroutine WaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - lakestate_inst, waterstate_inst, & - waterdiagnostic_inst, waterbalance_inst, waterflux_inst) + lakestate_inst, waterstate_inst, waterdiagnostic_inst, & + waterbalance_inst, waterflux_inst, use_aquifer_layer, flag) ! ! !DESCRIPTION: - ! Initialize grid cell-level water balance at beginning of time step - ! for bulk or a single tracer + ! Grid cell-level water balance for bulk or a single tracer + ! at beginning or end of time step as specified by "flag" ! ! !USES: use subgridAveMod, only: c2g @@ -221,20 +223,28 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(lakestate_type) , intent(in) :: lakestate_inst class(waterstate_type) , intent(inout) :: waterstate_inst - class(waterflux_type) , intent(inout) :: waterflux_inst class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst class(waterbalance_type) , intent(inout) :: waterbalance_inst + class(waterflux_type) , intent(inout) :: waterflux_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + character(len=5) , intent(in) :: flag ! specifies begwb or endwb ! ! !LOCAL VARIABLES: integer :: g ! indices integer :: begc, endc, begg, endg ! bounds - real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at beginning of time step - real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux at beginning of time step + real(r8) :: wb_col(bounds%begc:bounds%endc) ! temporary column-level water mass + real(r8) :: wb_grc(bounds%begg:bounds%endg) ! temporary grid cell-level water mass + real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux + real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux + real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) + + character(len=*), parameter :: subname = 'WaterGridcellBalanceSingle' !----------------------------------------------------------------------- associate( & - begwb_col => waterbalance_inst%begwb_col, & ! Output: [real(r8) (:) ] column-level water mass begining of the time step - begwb_grc => waterbalance_inst%begwb_grc & ! Output: [real(r8) (:) ] grid cell-level water mass begining of the time step + begwb_grc => waterbalance_inst%begwb_grc, & ! Output: [real(r8) (:)] grid cell-level water mass begining of the time step + endwb_grc => waterbalance_inst%endwb_grc, & ! Output: [real(r8) (:)] grid cell-level water mass end of the time step + wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col & ! Input: [real(r8) (:)] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) ) begc = bounds%begc @@ -242,27 +252,40 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & begg = bounds%begg endg = bounds%endg - ! NOTES subroutines Compute*Mass* are in TotalWaterAndHeatMod.F90 - ! endwb is calculated in HydrologyDrainageMod & LakeHydrologyMod call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstate_inst, waterdiagnostic_inst, & - subtract_dynbal_baselines = .false., & - water_mass = begwb_col(begc:endc)) + subtract_dynbal_baselines = .true., & + water_mass = wb_col(begc:endc)) call ComputeWaterMassLake(bounds, num_lakec, filter_lakec, & waterstate_inst, lakestate_inst, & - add_lake_water_and_subtract_dynbal_baselines = .false., & - water_mass = begwb_col(begc:endc)) + add_lake_water_and_subtract_dynbal_baselines = .true., & + water_mass = wb_col(begc:endc)) - call c2g(bounds, begwb_col(begc:endc), begwb_grc(begg:endg), & + call c2g(bounds, wb_col(begc:endc), wb_grc(begg:endg), & c2l_scale_type='urbanf', l2g_scale_type='unity') - call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg( & - bounds, & - qflx_liq_dynbal_left_to_dribble(begg:endg)) - call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg( & - bounds, & - qflx_ice_dynbal_left_to_dribble(begg:endg)) + ! Call the beginning or ending version of the subroutine according + ! to flag value + if (flag == 'begwb') then + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_ice_dynbal_left_to_dribble(begg:endg)) + else if (flag == 'endwb') then + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_ice_dynbal_left_to_dribble(begg:endg)) + else + write(iulog,*) 'Unknown flag passed into this subroutine.' + write(iulog,*) 'Expecting either begwb or endwb.' + call endrun(msg=errmsg(sourcefile, __LINE__)) + end if ! These dynbal dribblers store the delta state, (end - beg). Thus, the ! amount dribbled out is the negative of the amount stored in the @@ -271,16 +294,42 @@ subroutine BeginWaterGridcellBalanceSingle(bounds, & ! This sign convention is opposite to the convention chosen for the ! respective dribble terms used in the carbon balance. At some point ! it may be worth making the two conventions consistent. - ! Bill Sacks states: I think the convention used for the water and - ! energy dribblers is counter-intuitive. do g = begg, endg - begwb_grc(g) = begwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - - qflx_ice_dynbal_left_to_dribble(g) + wb_grc(g) = wb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & + - qflx_ice_dynbal_left_to_dribble(g) end do + ! Map wb_grc to beginning/ending water balance according to flag + if (flag == 'begwb') then + do g = begg, endg + begwb_grc(g) = wb_grc(g) + end do + else if (flag == 'endwb') then + ! endwb_grc requires one more step first + if (use_aquifer_layer) then + ! wa_reset_nonconservation_gain may be non-zero only when + ! use_aquifer_layer is true. We do this c2g call only when needed + ! to avoid unnecessary calculations; by adding this term only when + ! use_aquifer_layer is true, we effectively let the balance checks + ! ensure that this term is zero when use_aquifer_layer is false, + ! as it should be. + ! The _col term was determined in BeginWaterColumnBalanceSingle + ! after any dynamic landuse adjustments. + call c2g( bounds, & + wa_reset_nonconservation_gain_col(begc:endc), & + wa_reset_nonconservation_gain_grc(begg:endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity' ) + else + wa_reset_nonconservation_gain_grc(begg:endg) = 0._r8 + end if + do g = begg, endg + endwb_grc(g) = wb_grc(g) - wa_reset_nonconservation_gain_grc(g) + end do + end if + end associate - end subroutine BeginWaterGridcellBalanceSingle + end subroutine WaterGridcellBalanceSingle !----------------------------------------------------------------------- subroutine BeginWaterColumnBalanceSingle(bounds, & @@ -377,6 +426,8 @@ end subroutine BeginWaterColumnBalanceSingle !----------------------------------------------------------------------- subroutine BalanceCheck( bounds, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + water_inst, lakestate_inst, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst, & @@ -410,6 +461,12 @@ subroutine BalanceCheck( bounds, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(water_type) , intent(inout) :: water_inst + type(lakestate_type) , intent(in) :: lakestate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(solarabs_type) , intent(in) :: solarabs_inst class(waterflux_type) , intent(in) :: waterflux_inst @@ -436,9 +493,6 @@ subroutine BalanceCheck( bounds, & real(r8) :: qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg) ! grid cell-level water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) real(r8) :: qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg) ! grid cell-level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg) ! grid cell-level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] - real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step - real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux at end of time step - real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -491,7 +545,6 @@ subroutine BalanceCheck( bounds, & qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice qflx_drain_perched_col => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:)] grid cell-level sub-surface runoff (mm H2O /s) - wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col, & ! Output: [real(r8) (:) ] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) qflx_flood_col => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column level total runoff due to flooding forc_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] grid cell-level total grid cell-level runoff from river model qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack @@ -660,44 +713,14 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_ice_col(bounds%begc:bounds%endc), & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - if (use_aquifer_layer) then - ! wa_reset_nonconservation_gain may be non-zero only when - ! use_aquifer_layer is true. We do this c2g call only when needed - ! to avoid unnecessary calculations; by adding this term only when - ! use_aquifer_layer is true, we effectively let the balance checks - ! ensure that this term is zero when use_aquifer_layer is false, - ! as it should be. - ! The _col term was determined in BeginWaterColumnBalanceSingle - ! after any dynamic landuse adjustments. - call c2g( bounds, & - wa_reset_nonconservation_gain_col(bounds%begc:bounds%endc), & - wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg), & - c2l_scale_type='urbanf', l2g_scale_type='unity' ) - else - wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) = 0._r8 - end if - call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end( & - bounds, & - qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg)) - call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end( & - bounds, & - qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg)) - - ! These dynbal dribblers store the delta state, (end - beg). Thus, the - ! amount dribbled out is the negative of the amount stored in the - ! dribblers. Therefore, conservation requires us to subtract the amount - ! remaining to dribble. - ! This sign convention is opposite to the convention chosen for the - ! respective dribble terms used in the carbon balance. At some point - ! it may be worth making the two conventions consistent. - ! Bill Sacks states: I think the convention used for the water and - ! energy dribblers is counter-intuitive. - do g = bounds%begg, bounds%endg - endwb_grc(g) = endwb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & - - qflx_ice_dynbal_left_to_dribble(g) & - - wa_reset_nonconservation_gain_grc(g) + ! Obtain endwb_grc + call WaterGridcellBalance(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + water_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer, flag = 'endwb') + do g = bounds%begg, bounds%endg errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & + forc_snow_grc(g) & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 1df3a3640c..1122455abf 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -26,7 +26,7 @@ module clm_driver use abortutils , only : endrun ! use dynSubgridDriverMod , only : dynSubgrid_driver, dynSubgrid_wrapup_weight_changes - use BalanceCheckMod , only : BeginWaterGridcellBalance, BeginWaterColumnBalance, BalanceCheck + use BalanceCheckMod , only : WaterGridcellBalance, BeginWaterColumnBalance, BalanceCheck ! use BiogeophysPreFluxCalcsMod , only : BiogeophysPreFluxCalcs use SurfaceHumidityMod , only : CalculateSurfaceHumidity @@ -328,10 +328,11 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('begcnbal_grc') call t_startf('begwbal') - call BeginWaterGridcellBalance(bounds_clump, & + call WaterGridcellBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & - water_inst, lakestate_inst) + water_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer(), flag = 'begwb') call t_stopf('begwbal') end do !$OMP END PARALLEL DO @@ -370,7 +371,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! conserved when weights change (instead the difference is put in the grid cell-level ! terms, qflx_liq_dynbal, etc.). Grid cell-level balance ! checks ensure that the grid cell-level water is conserved by considering - ! qflx_liq_dynbal and calling BeginWaterGridcellBalance + ! qflx_liq_dynbal and calling WaterGridcellBalance ! before the weight updates. ! ! For carbon & nitrogen: This needs to be done after dynSubgrid_driver, because the @@ -1284,6 +1285,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call get_clump_bounds(nc, bounds_clump) call BalanceCheck(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + water_inst, lakestate_inst, & atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index ed9d44f36f..b05013ea09 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -411,11 +411,11 @@ subroutine lnd2atm(bounds, & call c2g( bounds, & water_inst%waterbalancebulk_inst%endwb_col(bounds%begc:bounds%endc), & - water_inst%waterbalancebulk_inst%endwb_grc(bounds%begg:bounds%endg), & + water_inst%waterdiagnosticbulk_inst%tws_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg water_inst%waterdiagnosticbulk_inst%tws_grc(g) = & - water_inst%waterbalancebulk_inst%endwb_grc(g) + & + water_inst%waterdiagnosticbulk_inst%tws_grc(g) + & water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 enddo From 5a0ba100a094c7152fa0f7247d44f2e88a42823f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Sat, 20 Feb 2021 14:51:46 -0700 Subject: [PATCH 104/219] Small updates to ChangeLog and ChangeSum --- doc/ChangeLog | 11 ++++------- doc/ChangeSum | 2 +- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a5e4b0c493..a25df070f3 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev024 Originator(s): slevis (Samuel Levis,303-665-1310) -Date: Wed Feb 11 10:35:33 MST 2021 +Date: Sat Feb 20 14:42:33 MST 2021 One-line Summary: Grid cell-level error check for H2O Purpose of changes @@ -84,8 +84,8 @@ CTSM testing: regular tests (aux_clm): - cheyenne ---- PEND (expect OK) - izumi ------- PEND (expect OK) + cheyenne ---- OK (comparisons to baseline fail as expected) + izumi ------- OK (comparisons to baseline fail as expected) If the tag used for baseline comparisons was NOT the previous tag, note that here: @@ -99,13 +99,10 @@ Changes answers relative to baseline: YES - what code configurations: ALL - what platforms/compilers: ALL - nature of change: ROUNDOFF - Specific example from running the single point test - ERI_D_Ld9.1x1_camdenNJ.I2000Clm50BgcCruRs.cheyenne_intel.clm-default: - RMS ERRH2O 6.0280E-21 NORMALIZED 7.6050E-06 Explanation: Moving call BalanceCheck to after the call lnd2glc in subroutine clm_drv causes a change in order of operations that leads to - the above change in ERRH2O. + roundoff change in ERRH2O. Confirmed by running ./summarize_cprnc_diffs Detailed list of changes diff --git a/doc/ChangeSum b/doc/ChangeSum index 3337e6e449..e179f3cd2d 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm5.1.dev024 slevis 02/11/2021 Grid cell-level error check for H2O + ctsm5.1.dev024 slevis 02/20/2021 Grid cell-level error check for H2O ctsm5.1.dev023 erik 02/11/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes ctsm5.1.dev022 glemieux 02/05/2021 Merge fates_main_api into ctsm master ctsm5.1.dev021 erik 01/12/2021 Add option for biomass heat storage (BHS) to clm5_1 physics From 53e9efed6ab20b4982edfa8f1b29503133dd74d5 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sun, 21 Feb 2021 16:49:25 -0700 Subject: [PATCH 105/219] Move final WaterGridcellBalance call out to clm_driver I prefer this for two reasons: - It is more symmetrical: since the initial WaterGridcellBalance call happens from clm_driver, it is nice to have the final one happen there, too, so that you can more clearly see the order of when things happen in the driver - It is confusing to me to have both water_inst and individual components of water_inst passed in to the same routine; I've been trying to avoid this. Resolves ESCOMP/CTSM#1286 --- src/biogeophys/BalanceCheckMod.F90 | 20 ++------------------ src/main/clm_driver.F90 | 8 +++++--- 2 files changed, 7 insertions(+), 21 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index e1d7497198..c94a4095ac 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -148,7 +148,7 @@ subroutine WaterGridcellBalance(bounds, & !----------------------------------------------------------------------- do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end - ! Obtain begwb_grc + ! Obtain begwb_grc or endwb_grc call WaterGridcellBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & lakestate_inst, & @@ -426,12 +426,9 @@ end subroutine BeginWaterColumnBalanceSingle !----------------------------------------------------------------------- subroutine BalanceCheck( bounds, & num_allc, filter_allc, & - num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, lakestate_inst, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & - waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst, & - use_aquifer_layer) + waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) ! ! !DESCRIPTION: ! This subroutine accumulates the numerical truncation errors of the water @@ -461,12 +458,6 @@ subroutine BalanceCheck( bounds, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns - integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter - integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points - integer , intent(in) :: num_lakec ! number of column lake points in column filter - integer , intent(in) :: filter_lakec(:) ! column filter for lake points - type(water_type) , intent(inout) :: water_inst - type(lakestate_type) , intent(in) :: lakestate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(solarabs_type) , intent(in) :: solarabs_inst class(waterflux_type) , intent(in) :: waterflux_inst @@ -478,7 +469,6 @@ subroutine BalanceCheck( bounds, & type(surfalb_type) , intent(in) :: surfalb_inst type(energyflux_type) , intent(inout) :: energyflux_inst type(canopystate_type), intent(inout) :: canopystate_inst - logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: p,c,l,g,fc ! indices @@ -714,12 +704,6 @@ subroutine BalanceCheck( bounds, & qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) - ! Obtain endwb_grc - call WaterGridcellBalance(bounds, & - num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - water_inst, lakestate_inst, & - use_aquifer_layer = use_aquifer_layer, flag = 'endwb') - do g = bounds%begg, bounds%endg errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & - (forc_rain_grc(g) & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index f64aa4531c..276dfbc467 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -1283,16 +1283,18 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) - call BalanceCheck(bounds_clump, & - filter(nc)%num_allc, filter(nc)%allc, & + call WaterGridcellBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & water_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer(), flag = 'endwb') + call BalanceCheck(bounds_clump, & + filter(nc)%num_allc, filter(nc)%allc, & atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, & - canopystate_inst, use_aquifer_layer = use_aquifer_layer()) + canopystate_inst) end do !$OMP END PARALLEL DO call t_stopf('balchk') From 8dd43f6232878b78fd3bea5fff456d51aa09f499 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sun, 21 Feb 2021 19:48:12 -0700 Subject: [PATCH 106/219] Only add WA and QCHARGE history fields if use_aquifer_layer is true Resolves ESCOMP/CTSM#1281 --- bld/namelist_files/use_cases/stdurbpt_pd.xml | 2 +- src/biogeophys/SoilHydrologyType.F90 | 15 +++++++++------ src/biogeophys/WaterStateType.F90 | 19 ++++++++++--------- 3 files changed, 20 insertions(+), 16 deletions(-) diff --git a/bld/namelist_files/use_cases/stdurbpt_pd.xml b/bld/namelist_files/use_cases/stdurbpt_pd.xml index ab1da63bcf..65786f32ae 100644 --- a/bld/namelist_files/use_cases/stdurbpt_pd.xml +++ b/bld/namelist_files/use_cases/stdurbpt_pd.xml @@ -10,7 +10,7 @@ 'TBUILD','BUILDHEAT','TRAFFICFLUX','WASTEHEAT','SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','COSZEN' -'TG','TBOT','FIRE','FIRA','FLDS','FSDS','FSR','FSA','FGEV','FSH','FGR','TSOI','ERRSOI','BUILDHEAT','SABV','SABG','FSDSVD','FSDSND','FSDSVI','FSDSNI','FSRVD','FSRND','FSRVI','FSRNI','TSA','FCTR','FCEV','QBOT','Q2M','H2OSOI','H2OSNO','SOILLIQ','SOILICE','SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','SoilAlpha_U','ZWT','WA' +'TG','TBOT','FIRE','FIRA','FLDS','FSDS','FSR','FSA','FGEV','FSH','FGR','TSOI','ERRSOI','BUILDHEAT','SABV','SABG','FSDSVD','FSDSND','FSDSVI','FSDSNI','FSRVD','FSRND','FSRVI','FSRNI','TSA','FCTR','FCEV','QBOT','Q2M','H2OSOI','H2OSNO','SOILLIQ','SOILICE','SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','SoilAlpha_U','ZWT' 'SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','FSA','FIRA','TG','COSZEN','SoilAlpha_U','TBUILD','BUILDHEAT' diff --git a/src/biogeophys/SoilHydrologyType.F90 b/src/biogeophys/SoilHydrologyType.F90 index 752fae220a..4dfca06811 100644 --- a/src/biogeophys/SoilHydrologyType.F90 +++ b/src/biogeophys/SoilHydrologyType.F90 @@ -86,7 +86,7 @@ subroutine Init(this, bounds, NLFilename, waterstatebulk_inst, use_aquifer_layer call this%ReadNL(NLFilename) call this%InitAllocate(bounds) - call this%InitHistory(bounds) + call this%InitHistory(bounds, use_aquifer_layer) call this%InitCold(bounds, waterstatebulk_inst, use_aquifer_layer) end subroutine Init @@ -150,7 +150,7 @@ subroutine InitAllocate(this, bounds) end subroutine InitAllocate !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) + subroutine InitHistory(this, bounds, use_aquifer_layer) ! ! !USES: use histFileMod , only : hist_addfld1d @@ -158,6 +158,7 @@ subroutine InitHistory(this, bounds) ! !ARGUMENTS: class(soilhydrology_type) :: this type(bounds_type), intent(in) :: bounds + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: begc, endc @@ -167,10 +168,12 @@ subroutine InitHistory(this, bounds) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg - this%qcharge_col(begc:endc) = spval - call hist_addfld1d (fname='QCHARGE', units='mm/s', & - avgflag='A', long_name='aquifer recharge rate (natural vegetated and crop landunits only)', & - ptr_col=this%qcharge_col, l2g_scale_type='veg') + if (use_aquifer_layer) then + this%qcharge_col(begc:endc) = spval + call hist_addfld1d (fname='QCHARGE', units='mm/s', & + avgflag='A', long_name='aquifer recharge rate (natural vegetated and crop landunits only)', & + ptr_col=this%qcharge_col, l2g_scale_type='veg') + end if this%num_substeps_col(begc:endc) = spval call hist_addfld1d (fname='NSUBSTEPS', units='unitless', & diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index 243e93ca48..c0b7abc6a5 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -87,7 +87,7 @@ subroutine Init(this, bounds, info, tracer_vars, & call this%InitAllocate(bounds, tracer_vars) - call this%InitHistory(bounds) + call this%InitHistory(bounds, use_aquifer_layer) call this%InitCold(bounds = bounds, & h2osno_input_col = h2osno_input_col, & @@ -154,7 +154,7 @@ subroutine InitAllocate(this, bounds, tracer_vars) end subroutine InitAllocate !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) + subroutine InitHistory(this, bounds, use_aquifer_layer) ! ! !DESCRIPTION: ! Initialize module data structure @@ -166,6 +166,7 @@ subroutine InitHistory(this, bounds) ! !ARGUMENTS: class(waterstate_type), intent(in) :: this type(bounds_type), intent(in) :: bounds + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: begp, endp @@ -259,13 +260,13 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('surface water depth'), & ptr_col=this%h2osfc_col) - this%wa_col(begc:endc) = spval - call hist_addfld1d (fname=this%info%fname('WA'), units='mm', & - avgflag='A', & - long_name=this%info%lname('water in the unconfined aquifer (natural vegetated and crop landunits only)'), & - ptr_col=this%wa_col, l2g_scale_type='veg') - - + if (use_aquifer_layer) then + this%wa_col(begc:endc) = spval + call hist_addfld1d (fname=this%info%fname('WA'), units='mm', & + avgflag='A', & + long_name=this%info%lname('water in the unconfined aquifer (natural vegetated and crop landunits only)'), & + ptr_col=this%wa_col, l2g_scale_type='veg') + end if ! (rgk 02-02-2017) There is intentionally no entry here for stored plant water ! I think that since the value is zero in all cases except From eb41917ab099402954c806b9e4443a3111d89b81 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 22 Feb 2021 21:22:06 -0700 Subject: [PATCH 107/219] Consolidate conditional structures for VIC initialization Resolves ESCOMP/CTSM#1287 (Inconsistent logic for VIC initialization can cause crash in debug mode) --- .../SoilHydrologyInitTimeConstMod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 b/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 index 64ede52fc4..f06fdd691e 100644 --- a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 +++ b/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 @@ -167,22 +167,6 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_inst end if end do - end if - end if ! end of if not lake - - if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types - if (lun%urbpoi(l)) then - if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall .or. col%itype(c)==icol_roof) then - ! do nothing - else - soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic - soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd) - - ! create weights to map soil moisture profiles (10 layer) to 3 layers for VIC hydrology, M.Huang - call initCLMVICMap(c, soilhydrology_inst) - call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst) - end if - else soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd) @@ -191,7 +175,6 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_inst call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst) end if end if ! end of if not lake - end do ! end of loop over columns deallocate(b2d, ds2d, dsmax2d, ws2d) From d71e650bc8feaf4c34ad3940e52260e7201ee969 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 23 Feb 2021 13:27:12 -0700 Subject: [PATCH 108/219] Update ChangeLog --- doc/ChangeLog | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 83 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index a25df070f3..bf36f50415 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,86 @@ =============================================================== +Tag name: ctsm5.1.dev025 +Originator(s): sacks (Bill Sacks) +Date: Tue Feb 23 11:20:17 MST 2021 +One-line Summary: Refactor ozone code, and misc. small fixes + +Purpose and description of changes +---------------------------------- + +(1) Restructure ozone code (https://github.com/ESCOMP/CTSM/pull/1276) in + preparation for new ozone parameterization. + +(2) Fix non-standard hexadecimal constant + (https://github.com/ESCOMP/CTSM/pull/1271), needed for gfortran 10 + +(3) Remove support for CISM1 (https://github.com/ESCOMP/CTSM/pull/1226) + +(4) Move final WaterGridcellBalance call out to clm_driver (resolves + ESCOMP/CTSM#1286) + +(5) Only add WA and QCHARGE history fields if use_aquifer_layer is true + (resolves ESCOMP/CTSM#1281) + +(6) Consolidate conditional structures for VIC initialization (resolves + ESCOMP/CTSM#1287) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1286 (Move call to WaterGridcellBalance out to + the driver) +- Resolves ESCOMP/CTSM#1281 (Remove deprecated history output) +- Resolves ESCOMP/CTSM#1287 (Inconsistent logic for VIC initialization + can cause crash in debug mode) +- Resolves ESCOMP/CTSM#1270 (Hexadecimal constants use non-standard + Fortran) + + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + Field lists differ for Clm50 / Clm51 / Ctsm50 tests; otherwise + bit-for-bit + +Other details +------------- +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1276 (Restructure ozone code) +- https://github.com/ESCOMP/CTSM/pull/1271 (Fix non-standard hexadecimal constant) +- https://github.com/ESCOMP/CTSM/pull/1226 (Remove support for CISM1) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev024 Originator(s): slevis (Samuel Levis,303-665-1310) Date: Sat Feb 20 14:42:33 MST 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index e179f3cd2d..74dab4b0cc 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev025 sacks 02/23/2021 Refactor ozone code, and misc. small fixes ctsm5.1.dev024 slevis 02/20/2021 Grid cell-level error check for H2O ctsm5.1.dev023 erik 02/11/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes ctsm5.1.dev022 glemieux 02/05/2021 Merge fates_main_api into ctsm master From 0f72db027645ee7183ba4316942c610ae75b44ea Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 24 Feb 2021 13:52:55 -0700 Subject: [PATCH 109/219] Minor clean up of some diffs --- src/biogeophys/BareGroundFluxesMod.F90 | 5 +---- src/biogeophys/CanopyFluxesMod.F90 | 1 - 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 0e6985c22b..cc14091a26 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -89,7 +89,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & swbgt, hmdex, dis_coi, dis_coiS, THIndex, & SwampCoolEff, KtoC, VaporPres - ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -144,7 +143,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] real(r8) :: www ! surface soil wetness [-] - !------------------------------------------------------------------------------ associate( & @@ -204,8 +202,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature beta => temperature_inst%beta_col , & ! Input: [real(r8) (:) ] coefficient of conective velocity [-] - frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) - qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] qg => waterdiagnosticbulk_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 9c26942559..348af3a613 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -431,7 +431,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8), parameter :: min_stem_diameter = 0.05_r8 !minimum stem diameter for which to calculate stem interactions integer :: dummy_to_make_pgi_happy - !------------------------------------------------------------------------------ SHR_ASSERT_ALL_FL((ubound(downreg_patch) == (/bounds%endp/)), sourcefile, __LINE__) From e58a245fe0de821a87522d9b05d2e919bb5e8df1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Feb 2021 10:37:45 -0700 Subject: [PATCH 110/219] removed additional musgs in test --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 06a7c97893..47d2f79709 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -424,7 +424,7 @@ - + From 74d4394e31a9056cfffc2288eb173415b7d21f6c Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 26 Feb 2021 13:20:09 -0700 Subject: [PATCH 111/219] fix urban conditional for j=1 --- src/biogeophys/SoilFluxesMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index d94dac723e..9bff7ce42f 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -224,9 +224,8 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & endif endif - ! top soil layer for urban columns; adjust qflx_evap_soi directly - if (lun%urbpoi(patch%landunit(p))) then - j = 1 + ! top soil layer for urban columns (excluding pervious road); adjust qflx_evap_soi directly + if (lun%urbpoi(patch%landunit(p)) .and. (col%itype(c)/=icol_road_perv) .and. (j == 1)) then evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) if (qflx_evap_soi(p)*dtime > evaporation_limit) then ev_unconstrained = qflx_evap_soi(p) From f41c0e8fe3078e6217346350e54c3deee02ed05b Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 1 Mar 2021 10:23:21 -0700 Subject: [PATCH 112/219] remove solid evap adjustment in SoilHydrologyMod --- src/biogeophys/SoilFluxesMod.F90 | 49 +++++++++++++---------------- src/biogeophys/SoilHydrologyMod.F90 | 30 +++++------------- 2 files changed, 28 insertions(+), 51 deletions(-) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 9bff7ce42f..d700148774 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -79,7 +79,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & real(r8) :: t_grnd0(bounds%begc:bounds%endc) ! t_grnd of previous time step real(r8) :: lw_grnd real(r8) :: evaporation_limit ! top layer moisture available for evaporation - real(r8) :: ev_unconstrained ! evaporative demand + real(r8) :: evaporation_demand ! evaporative demand !----------------------------------------------------------------------- associate( & @@ -204,8 +204,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & endif end do - ! evaporation from snow may be larger than available moisture - ! after flux update from tinc*cgrnd, repeat adjustment of ev_snow + ! Constrain evaporation from snow to be <= available moisture do fp = 1,num_nolakep p = filter_nolakep(fp) c = patch%column(p) @@ -213,25 +212,25 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! snow layers if (j < 1) then ! assumes for j < 1 that frac_sno_eff > 0 - evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/frac_sno_eff(c) - if (qflx_ev_snow(p)*dtime > evaporation_limit) then - ev_unconstrained = qflx_ev_snow(p) - qflx_ev_snow(p) = evaporation_limit/dtime - - qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(ev_unconstrained - qflx_ev_snow(p)) + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/(frac_sno_eff(c)*dtime) + if (qflx_ev_snow(p) > evaporation_limit) then + evaporation_demand = qflx_ev_snow(p) + qflx_ev_snow(p) = evaporation_limit + qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(evaporation_demand - evaporation_limit) ! conserve total energy flux - eflx_sh_grnd(p) = eflx_sh_grnd(p) + frac_sno_eff(c)*(ev_unconstrained - qflx_ev_snow(p))*htvp(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) + frac_sno_eff(c)*(evaporation_demand - evaporation_limit)*htvp(c) endif endif - ! top soil layer for urban columns (excluding pervious road); adjust qflx_evap_soi directly + ! top soil layer for urban columns (excluding pervious road) if (lun%urbpoi(patch%landunit(p)) .and. (col%itype(c)/=icol_road_perv) .and. (j == 1)) then - evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) - if (qflx_evap_soi(p)*dtime > evaporation_limit) then - ev_unconstrained = qflx_evap_soi(p) - qflx_evap_soi(p) = evaporation_limit/dtime + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dtime + if (qflx_evap_soi(p) > evaporation_limit) then + evaporation_demand = qflx_evap_soi(p) + qflx_evap_soi(p) = evaporation_limit + qflx_ev_snow(p) = qflx_evap_soi(p) ! conserve total energy flux - eflx_sh_grnd(p) = eflx_sh_grnd(p) +(ev_unconstrained - qflx_evap_soi(p))*htvp(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) +(evaporation_demand -evaporation_limit)*htvp(c) endif endif @@ -247,11 +246,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & g = patch%gridcell(p) j = col%snl(c)+1 - ! Update ev_snow for urban landunits here - if (lun%urbpoi(l)) then - qflx_ev_snow(p) = qflx_evap_soi(p) - end if - ! Ground heat flux if (.not. lun%urbpoi(l)) then @@ -360,15 +354,14 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & ! limit only solid evaporation (sublimation) from top soil layer ! (liquid evaporation from soil should not be limited) if (j==1 .and. frac_h2osfc(c) < 1._r8) then - if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(p)*dtime) >= h2osoi_ice(c,j)) then - + evaporation_limit = h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c))) + if (qflx_solidevap_from_top_layer(p) >= evaporation_limit) then + evaporation_demand = qflx_solidevap_from_top_layer(p) + qflx_solidevap_from_top_layer(p) & + = evaporation_limit qflx_liqevap_from_top_layer(p) & = qflx_liqevap_from_top_layer(p) & - + (qflx_solidevap_from_top_layer(p) & - - h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c)))) - qflx_solidevap_from_top_layer(p) & - = h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c))) - + + (evaporation_demand - evaporation_limit) endif endif diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index cc79fd9461..2f9993f058 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -65,7 +65,7 @@ module SoilHydrologyMod type(params_type), private :: params_inst !----------------------------------------------------------------------- - real(r8), private :: baseflow_scalar = 1.e-2_r8 + real(r8), private :: baseflow_scalar = 1.e-2_r8 real(r8), parameter :: tolerance = 1.e-12_r8 ! tolerance for checking whether sublimation is greater than ice in top soil layer character(len=*), parameter, private :: sourcefile = & @@ -845,16 +845,8 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if ((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - - if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > tolerance) then - call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - endif - h2osoi_ice(c,1) = 0._r8 + if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1) > tolerance)) then + call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime end if @@ -870,12 +862,8 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil if (snl(c)+1 >= 1) then h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 + if ((qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then + call endrun(msg="urban qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) end if @@ -2349,12 +2337,8 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & if (snl(c)+1 >= 1) then h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 + if ((qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then + call endrun(msg="urban qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) end if From 9630325c372fae5e398f0c95cebfa6043223dd38 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 1 Mar 2021 14:11:16 -0700 Subject: [PATCH 113/219] fix conditional in renewcondensation --- src/biogeophys/SoilHydrologyMod.F90 | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 2f9993f058..c0089cc84f 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2308,19 +2308,8 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if ((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) & - - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - ! qflx_solidevap_from_top_layer should be constrained - ! in SoilFluxesMod to be <= h2osoi_ice, but check here - if((abs((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1))) > tolerance) then - call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - endif - - h2osoi_ice(c,1) = 0._r8 + if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then + call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) else h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime end if From a3274091725e89f3a398804f8ea4e00d60383966 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 2 Mar 2021 08:27:44 -0700 Subject: [PATCH 114/219] add comments --- src/biogeophys/SoilFluxesMod.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index d700148774..bb88042797 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -209,9 +209,12 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & p = filter_nolakep(fp) c = patch%column(p) j = col%snl(c)+1 - ! snow layers + ! snow layers; assumes for j < 1 that frac_sno_eff > 0 if (j < 1) then - ! assumes for j < 1 that frac_sno_eff > 0 + ! Defining the limitation uniformly for all patches is more + ! strict than absolutely necessary. This definition assumes + ! each patch is spatially distinct and may remove all the snow + ! on its patch, but may not remove snow from adjacent patches. evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/(frac_sno_eff(c)*dtime) if (qflx_ev_snow(p) > evaporation_limit) then evaporation_demand = qflx_ev_snow(p) @@ -222,7 +225,9 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & endif endif - ! top soil layer for urban columns (excluding pervious road) + ! top soil layer for urban columns (excluding pervious road, which + ! shouldn't be limited here b/c it uses the uses the soilwater + ! equations, while the other urban columns do not) if (lun%urbpoi(patch%landunit(p)) .and. (col%itype(c)/=icol_road_perv) .and. (j == 1)) then evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dtime if (qflx_evap_soi(p) > evaporation_limit) then From 71a4c2ff8fe2a0ad42972c66dd8f78d1eaaa5183 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Mar 2021 13:37:22 -0700 Subject: [PATCH 115/219] Update externals to version in cesm2_3_alpha02b Resolves ESCOMP/CTSM#1175 --- Externals.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index aecac45976..85182ac0f8 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -8,7 +8,7 @@ required = True local_path = components/cism protocol = git repo_url = https://github.com/ESCOMP/CISM-wrapper -tag = cism2_1_69 +tag = cism2_1_75 externals = Externals_CISM.cfg required = True @@ -16,14 +16,14 @@ required = True local_path = components/rtm protocol = git repo_url = https://github.com/ESCOMP/RTM -tag = rtm1_0_73 +tag = rtm1_0_74 required = True [mosart] local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -tag = mosart1_0_38 +tag = branch_tag/pio2.n01_mosart1_0_38 required = True [mizuRoute] @@ -37,21 +37,21 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.32_a02 +tag = cime5.8.37 required = True [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -hash = 7654038 +hash = c4acaa8 required = True [cdeps] local_path = components/cdeps protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git -hash = 45b7a85 +hash = 1f02a73 required = True [doc-builder] From a7345406cd4e7ee923ac8aa954ce59c0ceb733bb Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Mar 2021 16:20:09 -0700 Subject: [PATCH 116/219] Now that pio2 is the default, use pio_rearranger=2 for pnetcdf Resolves ESCOMP/CTSM#1194 --- lilac/bld_templates/lnd_modelio_template.nml | 2 +- python/ctsm/lilac_build_ctsm.py | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lilac/bld_templates/lnd_modelio_template.nml b/lilac/bld_templates/lnd_modelio_template.nml index 6ee97fb119..8686ebeeca 100644 --- a/lilac/bld_templates/lnd_modelio_template.nml +++ b/lilac/bld_templates/lnd_modelio_template.nml @@ -1,7 +1,7 @@ &pio_inparm pio_netcdf_format = "64bit_offset" pio_numiotasks = -99 - pio_rearranger = 1 + pio_rearranger = $PIO_REARRANGER pio_root = 1 pio_stride = $PIO_STRIDE pio_typename = "$PIO_TYPENAME" diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 4774993e7e..2e428d69a8 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -658,12 +658,18 @@ def _stage_runtime_inputs(build_dir, no_pnetcdf): pio_stride = _xmlquery('MAX_MPITASKS_PER_NODE', build_dir) if no_pnetcdf: pio_typename = 'netcdf' + # pio_rearranger = 1 is generally more efficient with netcdf (see + # https://github.com/ESMCI/cime/pull/3732#discussion_r508954806 and the following + # discussion) + pio_rearranger = 1 else: pio_typename = 'pnetcdf' + pio_rearranger = 2 fill_template_file( path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lnd_modelio_template.nml'), path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lnd_modelio.nml'), - substitutions={'PIO_STRIDE':pio_stride, + substitutions={'PIO_REARRANGER':pio_rearranger, + 'PIO_STRIDE':pio_stride, 'PIO_TYPENAME':pio_typename}) shutil.copyfile( From a54bd894ad83d967519c43b90b45392262852043 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Mar 2021 16:46:34 -0700 Subject: [PATCH 117/219] Point to cime branch tag Same as cime5.8.37 but with ESMCI/cime#3841 cherry-picked in This was a PR from Mariana Vertenstein: Introduction of MASK_GRID for CMEPS This PR introduces the a new mask grid specification for CMEPS and also updates the config_grids.xml to add new ESMF meshes. --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 85182ac0f8..7b93187762 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -37,7 +37,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = cime5.8.37 +tag = branch_tags/cime5.8.37_a01 required = True [cmeps] From 9032470649800f6f89edceb2cd371ca0a3aeb3b8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Mar 2021 20:10:16 -0700 Subject: [PATCH 118/219] Change f10 tests to use mg37 mask The musgs mask will soon be dropped, and has already been dropped for nuopc --- cime_config/testdefs/testlist_clm.xml | 230 +++++++++++++------------- 1 file changed, 115 insertions(+), 115 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 8c91bd9d88..c304a4bb27 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1,6 +1,6 @@ - + @@ -46,7 +46,7 @@ - + @@ -139,7 +139,7 @@ - + @@ -156,7 +156,7 @@ - + @@ -190,7 +190,7 @@ - + @@ -198,7 +198,7 @@ - + @@ -206,7 +206,7 @@ - + @@ -214,7 +214,7 @@ - + @@ -247,7 +247,7 @@ - + @@ -256,7 +256,7 @@ - + @@ -265,7 +265,7 @@ - + @@ -331,7 +331,7 @@ - + @@ -340,7 +340,7 @@ - + @@ -348,7 +348,7 @@ - + @@ -356,7 +356,7 @@ - + @@ -381,7 +381,7 @@ - + @@ -390,7 +390,7 @@ - + @@ -407,7 +407,7 @@ - + @@ -424,7 +424,7 @@ - + @@ -453,7 +453,7 @@ - + @@ -461,7 +461,7 @@ - + @@ -470,7 +470,7 @@ - + @@ -478,7 +478,7 @@ - + @@ -494,7 +494,7 @@ - + @@ -505,7 +505,7 @@ - + @@ -513,7 +513,7 @@ - + @@ -521,7 +521,7 @@ - + @@ -529,7 +529,7 @@ - + @@ -537,7 +537,7 @@ - + @@ -546,7 +546,7 @@ - + @@ -555,7 +555,7 @@ - + @@ -564,7 +564,7 @@ - + @@ -573,7 +573,7 @@ - + @@ -583,7 +583,7 @@ - + @@ -592,7 +592,7 @@ - + @@ -600,7 +600,7 @@ - + @@ -608,7 +608,7 @@ - + @@ -651,7 +651,7 @@ - + @@ -659,7 +659,7 @@ - + @@ -695,7 +695,7 @@ - + @@ -703,7 +703,7 @@ - + @@ -711,7 +711,7 @@ - + @@ -719,7 +719,7 @@ - + @@ -748,7 +748,7 @@ - + @@ -757,7 +757,7 @@ - + @@ -766,7 +766,7 @@ - + @@ -774,7 +774,7 @@ - + @@ -782,7 +782,7 @@ - + @@ -791,7 +791,7 @@ - + @@ -801,7 +801,7 @@ - + @@ -850,7 +850,7 @@ - + @@ -878,7 +878,7 @@ - + @@ -932,7 +932,7 @@ - + @@ -941,7 +941,7 @@ - + @@ -951,7 +951,7 @@ - + @@ -959,7 +959,7 @@ - + @@ -968,7 +968,7 @@ - + @@ -978,7 +978,7 @@ - + @@ -988,7 +988,7 @@ - + @@ -996,7 +996,7 @@ - + @@ -1014,7 +1014,7 @@ - + @@ -1023,7 +1023,7 @@ - + @@ -1032,7 +1032,7 @@ - + @@ -1041,7 +1041,7 @@ - + @@ -1050,7 +1050,7 @@ - + @@ -1071,7 +1071,7 @@ - + @@ -1080,7 +1080,7 @@ - + @@ -1088,7 +1088,7 @@ - + @@ -1104,7 +1104,7 @@ - + @@ -1193,7 +1193,7 @@ - + @@ -1211,7 +1211,7 @@ - + @@ -1220,7 +1220,7 @@ - + @@ -1229,7 +1229,7 @@ - + @@ -1266,7 +1266,7 @@ - + @@ -1275,7 +1275,7 @@ - + @@ -1285,7 +1285,7 @@ - + @@ -1303,7 +1303,7 @@ - + @@ -1312,7 +1312,7 @@ - + @@ -1322,7 +1322,7 @@ - + @@ -1432,7 +1432,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1490,7 +1490,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1498,7 +1498,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1508,7 +1508,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1516,7 +1516,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1527,7 +1527,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1545,7 +1545,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1554,7 +1554,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1583,7 +1583,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1611,7 +1611,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1678,7 +1678,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1705,7 +1705,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1713,7 +1713,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1721,7 +1721,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1731,7 +1731,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1740,7 +1740,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1757,7 +1757,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1776,7 +1776,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1804,7 +1804,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1875,7 +1875,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1893,7 +1893,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1937,7 +1937,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1955,7 +1955,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2000,7 +2000,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2016,7 +2016,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2033,7 +2033,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2043,7 +2043,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2055,7 +2055,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2067,7 +2067,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2077,7 +2077,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2328,7 +2328,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2350,7 +2350,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this 2-degree since that resolution turns off Carbon isotopes - + @@ -2380,7 +2380,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2403,7 +2403,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2414,7 +2414,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2427,7 +2427,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + From 1451d94d67b7532e9958517b41e6f3ac28ebcd00 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 3 Mar 2021 21:09:09 -0700 Subject: [PATCH 119/219] Fix mask used in lilac case --- python/ctsm/lilac_build_ctsm.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 4774993e7e..c48c283a2b 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -23,7 +23,7 @@ # these are arbitrary, since we only use the case for its build, not any of the runtime # settings; they just need to be valid _COMPSET = 'I2000Ctsm50NwpSpAsRs' -_RES = 'f10_f10_musgs' +_RES = 'f10_f10_mg37' _PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), 'lilac', From 4a9faaddf7d47247b04211dffc5d924e28220aaa Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Mar 2021 13:24:25 -0700 Subject: [PATCH 120/219] Update ChangeLog --- doc/ChangeLog | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 51 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index bf36f50415..4b42c37131 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,54 @@ =============================================================== +Tag name: ctsm5.1.dev026 +Originator(s): sacks (Bill Sacks) +Date: Mon Mar 8 13:20:33 MST 2021 +One-line Summary: Change f10 tests to use mg37 mask + +Purpose and description of changes +---------------------------------- + +The musgs mask will soon be dropped, and has already been dropped for +nuopc + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: All f10_f10_musgs tests changed to f10_f10_mg37 + + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- pass + izumi ------- pass + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + BFAIL results for all f10 tests because the tests have changed, but + no answer changes + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev025 Originator(s): sacks (Bill Sacks) Date: Tue Feb 23 11:20:17 MST 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 74dab4b0cc..1ecd52894f 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev026 sacks 03/08/2021 Change f10 tests to use mg37 mask ctsm5.1.dev025 sacks 02/23/2021 Refactor ozone code, and misc. small fixes ctsm5.1.dev024 slevis 02/20/2021 Grid cell-level error check for H2O ctsm5.1.dev023 erik 02/11/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes From adc35d239bc5e83557e737251cf1b8a0a445a42f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 8 Mar 2021 16:09:08 -0700 Subject: [PATCH 121/219] Replace shared code with call to RenewCondensation --- src/biogeophys/SoilHydrologyMod.F90 | 56 +++++++---------------------- 1 file changed, 13 insertions(+), 43 deletions(-) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index c0089cc84f..99aa6275c0 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -633,8 +633,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil !----------------------------------------------------------------------- associate( & - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) @@ -644,10 +643,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] - frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] - qflx_liqdew_to_top_layer => waterfluxbulk_inst%qflx_liqdew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water deposited on top soil or snow layer (dew) (mm H2O /s) [+] - qflx_soliddew_to_top_layer => waterfluxbulk_inst%qflx_soliddew_to_top_layer_col, & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_col , & ! In/Out: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) @@ -662,8 +658,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil qcharge => soilhydrology_inst%qcharge_col , & ! Input: [real(r8) (:) ] aquifer recharge rate (mm/s) origflag => soilhydrology_inst%origflag , & ! Input: logical - qflx_solidevap_from_top_layer => waterfluxbulk_inst%qflx_solidevap_from_top_layer_col, & ! Output: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] - qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) qflx_drain_perched => waterfluxbulk_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] perched wt sub-surface runoff (mm H2O /s) qflx_rsub_sat => waterfluxbulk_inst%qflx_rsub_sat_col & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] ) @@ -835,42 +830,17 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil endif end do - do fc = 1, num_hydrologyc - c = filter_hydrologyc(fc) - - ! Renew the ice and liquid mass due to condensation - - if (snl(c)+1 >= 1) then - - ! make consistent with how evap_grnd removed in infiltration - h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime - h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1) > tolerance)) then - call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime - end if - end if - end do - - - do fc = 1, num_urbanc - c = filter_urbanc(fc) - ! Renew the ice and liquid mass due to condensation for urban roof and impervious road - - if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then - if (snl(c)+1 >= 1) then - h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_liqdew_to_top_layer(c) * dtime - h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if ((qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then - call endrun(msg="urban qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) - end if - end if - end if - - end do + call RenewCondensation(& + bounds = bounds, & + num_hydrologyc = num_hydrologyc, & + filter_hydrologyc = filter_hydrologyc, & + num_urbanc = num_urbanc, & + filter_urbanc = filter_urbanc, & + soilhydrology_inst = soilhydrology_inst, & + soilstate_inst = soilstate_inst, & + waterstatebulk_inst = waterstatebulk_inst, & + waterdiagnosticbulk_inst = waterdiagnosticbulk_inst, & + waterfluxbulk_inst = waterfluxbulk_inst) end associate From a283fd6e1f57718171e5ccb7f7c7900b69109610 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 9 Mar 2021 11:36:34 -0700 Subject: [PATCH 122/219] Move RenewCondensation call up a level This way RenewCondensation is called from the same place whether or not use_aquifer_layer is true. --- src/biogeophys/HydrologyNoDrainageMod.F90 | 16 ++++++++-------- src/biogeophys/SoilHydrologyMod.F90 | 19 ++----------------- 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 9a3009d968..7cb1e5575f 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -357,9 +357,9 @@ subroutine HydrologyNoDrainage(bounds, & end if if (use_aquifer_layer()) then - call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, & soilhydrology_inst, soilstate_inst, temperature_inst, b_waterstate_inst, & - b_waterdiagnostic_inst, b_waterflux_inst) + b_waterflux_inst) else call PerchedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & @@ -370,12 +370,12 @@ subroutine HydrologyNoDrainage(bounds, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & b_waterstate_inst, b_waterflux_inst) - call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & - num_urbanc, filter_urbanc,& - soilhydrology_inst, soilstate_inst, & - b_waterstate_inst, b_waterdiagnostic_inst, b_waterflux_inst) - - endif + end if + + call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc,& + soilhydrology_inst, soilstate_inst, & + b_waterstate_inst, b_waterdiagnostic_inst, b_waterflux_inst) ! BUG(wjs, 2019-09-16, ESCOMP/ctsm#762) This is needed so that we can test the ! tracerization of the following snow stuff without having tracerized everything diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 99aa6275c0..dbead59f9f 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -571,8 +571,8 @@ subroutine UpdateUrbanPonding(bounds, num_urbanc, filter_urbanc, & end subroutine UpdateUrbanPonding !----------------------------------------------------------------------- - subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - soilhydrology_inst, soilstate_inst, temperature_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst) + subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, soilstate_inst, temperature_inst, waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Calculate watertable, considering aquifer recharge but no drainage. @@ -584,14 +584,11 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter - integer , intent(in) :: num_urbanc ! number of column urban points in column filter - integer , intent(in) :: filter_urbanc(:) ! column filter for urban points integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points type(soilhydrology_type) , intent(inout) :: soilhydrology_inst type(soilstate_type) , intent(in) :: soilstate_inst type(temperature_type) , intent(in) :: temperature_inst type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst - type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: @@ -830,18 +827,6 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil endif end do - call RenewCondensation(& - bounds = bounds, & - num_hydrologyc = num_hydrologyc, & - filter_hydrologyc = filter_hydrologyc, & - num_urbanc = num_urbanc, & - filter_urbanc = filter_urbanc, & - soilhydrology_inst = soilhydrology_inst, & - soilstate_inst = soilstate_inst, & - waterstatebulk_inst = waterstatebulk_inst, & - waterdiagnosticbulk_inst = waterdiagnosticbulk_inst, & - waterfluxbulk_inst = waterfluxbulk_inst) - end associate end subroutine WaterTable From 5ad3c8c17512b4f2df2ed0876ee0886df4dbff3e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Mar 2021 15:29:08 -0700 Subject: [PATCH 123/219] In RenewCondensation, truncate small values using standard approach --- src/biogeophys/SoilHydrologyMod.F90 | 54 +++++++++++++++++++++-------- 1 file changed, 40 insertions(+), 14 deletions(-) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index dbead59f9f..817280c7f4 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -17,6 +17,7 @@ module SoilHydrologyMod use column_varcon , only : icol_road_imperv use landunit_varcon , only : istsoil, istcrop use clm_time_manager , only : get_step_size_real + use NumericsMod , only : truncate_small_values use EnergyFluxType , only : energyflux_type use InfiltrationExcessRunoffMod, only : infiltration_excess_runoff_type use SoilHydrologyType , only : soilhydrology_type @@ -2233,9 +2234,12 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: - integer :: c,j,fc,i ! indices - real(r8) :: dtime ! land model time step (sec) - real(r8) :: qflx_solidevap_from_top_layer_save ! temporary + integer :: c ,j,fc,i ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: qflx_solidevap_from_top_layer_save ! temporary + integer :: num_modifiedc ! number of columns in filter_modifiedc + integer :: filter_modifiedc(bounds%endc-bounds%begc+1) ! column filter of points modified in this subroutine + real(r8) :: h2osoi_ice_before_evap(bounds%begc:bounds%endc) ! h2osoi_ice in layer 1 before applying solidevap !----------------------------------------------------------------------- associate( & @@ -2252,6 +2256,7 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! Get time step dtime = get_step_size_real() + num_modifiedc = 0 do fc = 1, num_hydrologyc c = filter_hydrologyc(fc) @@ -2259,15 +2264,14 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! Renew the ice and liquid mass due to condensation if (snl(c)+1 >= 1) then + num_modifiedc = num_modifiedc + 1 + filter_modifiedc(num_modifiedc) = c ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (((1._r8 - frac_h2osfc(c))*qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then - call endrun(msg="qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime - end if + h2osoi_ice_before_evap(c) = h2osoi_ice(c,1) + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime end if end do @@ -2279,19 +2283,41 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then if (snl(c)+1 >= 1) then + num_modifiedc = num_modifiedc + 1 + filter_modifiedc(num_modifiedc) = c + h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if ((qflx_solidevap_from_top_layer(c)*dtime - h2osoi_ice(c,1)) > tolerance) then - call endrun(msg="urban qflx_solidevap_from_top_layer too large! "//errmsg(sourcefile, __LINE__)) - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) - end if + h2osoi_ice_before_evap(c) = h2osoi_ice(c,1) + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) end if end if end do - end associate + call truncate_small_values( & + num_f = num_modifiedc, & + filter_f = filter_modifiedc, & + lb = bounds%begc, & + ub = bounds%endc, & + data_baseline = h2osoi_ice_before_evap(bounds%begc:bounds%endc), & + data = h2osoi_ice(bounds%begc:bounds%endc, 1), & + custom_rel_epsilon = tolerance) + + do fc = 1, num_modifiedc + c = filter_modifiedc(fc) + + if (h2osoi_ice(c,1) < 0._r8) then + write(iulog,*) "ERROR: In RenewCondensation, h2osoi_ice has gone significantly negative" + write(iulog,*) "c = ", c + write(iulog,*) "h2osoi_ice_before_evap = ", h2osoi_ice_before_evap(c) + write(iulog,*) "h2osoi_ice(c,1) = ", h2osoi_ice(c,1) + write(iulog,*) "qflx_solidevap_from_top_layer*dtime = ", qflx_solidevap_from_top_layer(c)*dtime + call endrun("In RenewCondensation, h2osoi_ice has gone significantly negative") + end if + end do + + end associate end subroutine RenewCondensation !#8 From a4c2e3d73a70f8bd9e6469a35f51e4de7569c189 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 11 Mar 2021 16:05:56 -0700 Subject: [PATCH 124/219] Use a valid resolution for lilac --- python/ctsm/lilac_build_ctsm.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 2e428d69a8..c44ad6831e 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -23,7 +23,7 @@ # these are arbitrary, since we only use the case for its build, not any of the runtime # settings; they just need to be valid _COMPSET = 'I2000Ctsm50NwpSpAsRs' -_RES = 'f10_f10_musgs' +_RES = 'f10_f10_mg37' _PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), 'lilac', From c4a83b807d036e826538e6d6ace407dc08136494 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 12 Mar 2021 12:50:10 -0700 Subject: [PATCH 125/219] Add -k oed to qsub command for cheyenne cheyenne has disabled qpeek, so this seems useful so we can see the ongoing job output --- python/ctsm/machine_defaults.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/machine_defaults.py b/python/ctsm/machine_defaults.py index f4df95b768..78b6062f50 100644 --- a/python/ctsm/machine_defaults.py +++ b/python/ctsm/machine_defaults.py @@ -49,7 +49,7 @@ # to add more flexibility in the future, making the node / proc counts # individually selectable required_args= - '-l select=1:ncpus=36:mpiprocs=1 -r n -l inception=login') + '-l select=1:ncpus=36:mpiprocs=1 -r n -l inception=login -k oed') }), 'hobart': MachineDefaults( job_launcher_type=JOB_LAUNCHER_QSUB, From d25a22f1196b56d2b2948fd2fded6fa9b99b7de0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 12 Mar 2021 20:08:44 -0700 Subject: [PATCH 126/219] Point to updated cime branch Avoid adding CDEPS things to inc & lib paths with LILAC --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 7b93187762..efca327610 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -37,7 +37,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.37_a01 +tag = branch_tags/cime5.8.37_a02 required = True [cmeps] From c14e9331817b50d9a163b8d831e2d86b194594ef Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 15 Mar 2021 14:32:17 -0600 Subject: [PATCH 127/219] Update ChangeLog --- doc/ChangeLog | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 114 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 4b42c37131..43ca9a65fd 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,117 @@ =============================================================== +Tag name: ctsm5.1.dev027 +Originator(s): sacks (Bill Sacks) +Date: Mon Mar 15 14:05:20 MDT 2021 +One-line Summary: Update cime and other externals; includes switch to pio2 + +Purpose and description of changes +---------------------------------- + +Updates cime and other externals to version in cesm2_3_alpha02b (with +some minor changes to cime on top of that). This includes substantial +changes to cime, including switching to PIO2 rather than PIO1. + +Also: + +- For LILAC, changes default pio_rearranger now that we're using PIO2 by + default + +- In run_sys_tests, adds '-k oed' to qsub command on cheyenne; this is + useful now that qpeek is disabled on cheyenne (this puts the job's + stdout and stderr files directly in their final location from the + beginning, rather than keeping them in some temporary location on the + compute node until the job completes) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1175 (Once there is a cime tag with pio2 as the + default, update to it) +- Resolves ESCOMP/CTSM#1194 (Once we switch to pio2 by default, change + the default rearranger used in LILAC) + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): +- PIO2 is now the default. This has been tested extensively, but let us + know if you run into any I/O related issues. Also, from testing we've + done, I/O performance looks better than with PIO1 in many cases, but + also let us know if you see a substantial degradation in I/O + performance. + +Changes made to namelist defaults (e.g., changed parameter values): +- Some I/O-related defaults change with the use of PIO2 rather than PIO1 + +Substantial timing or memory changes: +- Various changes due to the change to PIO2, some of them large. For the + most part, timing improves with PIO2, particularly for production + resolutions. +- The PFS test and many others show a substantial improvement in timing. + This is especially noticeable in initialization time. For example, the + initialization time of + PFS_Ld20.f09_g17.I2000Clm50BgcCrop.cheyenne_intel dropped from 111 sec + to 34 sec. (These tests were run a couple of weeks apart, before and + after a cheyenne upgrade, so there may be some machine variability in + these numbers, but I saw a big improvement a few months ago with a + more objective comparison.) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- ok + izumi ------- pass + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: YES, but just for nuopc + + Summarize any changes to answers, i.e., + - what code configurations: Just with nuopc driver + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated + + The only test that changes answers is + SMS_D_Ld5_Vnuopc.f10_f10_mg37.I2000Clm50BgcCrop.cheyenne_intel.clm-default + + (There are NLCOMP failures in all tests, though, due to the update to pio2.) + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- CISM: cism2_1_69 -> cism2_1_75 +- RTM: rtm1_0_73 -> rtm1_0_74 +- MOSART: mosart1_0_38 -> branch_tag/pio2.n01_mosart1_0_38 +- CIME: branch_tags/cime5.8.32_a02 -> branch_tags/cime5.8.37_a02 +- CMEPS: 7654038 -> c4acaa8 +- CDEPS: 45b7a85 -> 1f02a73 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev026 Originator(s): sacks (Bill Sacks) Date: Mon Mar 8 13:20:33 MST 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 1ecd52894f..879dd24fea 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev027 sacks 03/15/2021 Update cime and other externals; includes switch to pio2 ctsm5.1.dev026 sacks 03/08/2021 Change f10 tests to use mg37 mask ctsm5.1.dev025 sacks 02/23/2021 Refactor ozone code, and misc. small fixes ctsm5.1.dev024 slevis 02/20/2021 Grid cell-level error check for H2O From f82a97d7392b90c71fa8b5145701daa3d80a159c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 16 Mar 2021 23:53:12 -0600 Subject: [PATCH 128/219] Minor cleanup --- src/cpl/mct/lnd_set_decomp_and_domain.F90 | 4 ++-- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 index 1b8edece43..13fa52a6dd 100644 --- a/src/cpl/mct/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -12,8 +12,8 @@ module lnd_set_decomp_and_domain public :: lnd_set_decomp_and_domain_from_surfrd ! private member routines - public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) - public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) + private :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) + private :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) character(len=*), parameter, private :: sourcefile = & __FILE__ diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 14ab1032f5..028ea7e0da 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -272,6 +272,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) cism_evolve = .true. else if (trim(cvalue) == '.false.') then cism_evolve = .false. + else + call shr_sys_abort(subname//'Could not determine cism_evolve value '//trim(cvalue)) endif end if From 07d117f6d3558d12331ca6d2e3b525337c85aacf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 17 Mar 2021 15:34:53 -0600 Subject: [PATCH 129/219] Remove unused argument --- src/cpl/lilac/lnd_comp_esmf.F90 | 2 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 +- src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 | 3 +-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 27b022f10c..5a28db04dc 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -341,7 +341,7 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- call ESMF_VMGetCurrent(vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_readmesh(mode='lilac', vm=vm, & + call lnd_set_decomp_and_domain_from_readmesh(vm=vm, & meshfile_lnd=lnd_mesh_filename, meshfile_mask=lnd_mesh_filename, mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 028ea7e0da..3420e131c4 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -522,7 +522,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_readmesh(mode='nuopc', vm=vm, & + call lnd_set_decomp_and_domain_from_readmesh(vm=vm, & meshfile_lnd=model_meshfile, meshfile_mask=meshfile_mask, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 0f9ec9bd51..230e65daa4 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -30,7 +30,7 @@ module lnd_set_decomp_and_domain contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & + subroutine lnd_set_decomp_and_domain_from_readmesh(vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D @@ -40,7 +40,6 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(mode, vm, meshfile_lnd, meshf use clm_varctl , only : use_soil_moisture_streams ! input/output variables - character(len=*) , intent(in) :: mode ! lilac or nuopc mode type(ESMF_VM) , intent(in) :: vm character(len=*) , intent(in) :: meshfile_lnd character(len=*) , intent(in) :: meshfile_mask From ffb17526d725642d1359c19a98fbb24b9884292a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 17 Mar 2021 15:41:57 -0600 Subject: [PATCH 130/219] Add a comment --- src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 230e65daa4..94d22c4069 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -832,6 +832,17 @@ end function chkerr !=============================================================================== subroutine lnd_set_read_write_landmask(write_file, read_file, lndmask_glob, lndfrac_glob, gsize) + ! This subroutine is currently unused (as of 2021-03-17), but it may be needed in the + ! future. Its purpose is: Now that we get landmask and landfrac at runtime, from + ! mapping the ocean mask to the land grid, it's possible that landfrac will be + ! roundoff-level different with different processor counts. Mariana Vertenstein + ! hasn't seen this happen yet, but if it does, then we can use this subroutine to + ! solve this issue in tests that change processor count (ERP, PEM). I think Mariana's + ! intent was: in the first run, we would write landmask and landfrac to a landfrac.nc + ! file; then, in the second run (with different processor count), we would read that + ! file rather than doing the mapping again. This way, both runs of the ERP or PEM + ! test would use consistent landmask and landfrac values. + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile From 87aaa7afbdeba337cc811396e0e053a7e3d23fb3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 17 Mar 2021 15:43:03 -0600 Subject: [PATCH 131/219] Add a comment (wording from Mariana Vertenstein) --- src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index 94d22c4069..a0ca93e84a 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -413,6 +413,12 @@ end subroutine lnd_set_decomp_and_domain_from_createmesh subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) ! Determine global 2d sizes from read of dimensions of surface dataset + ! + ! Meshes do not indicate if the mesh can be represented as a logically rectangular + ! grid. However, CTSM needs this information in the history file generation via the + ! logical variable isgrid2d. Since for CMEPS and LILAC there is no longer the need for + ! the fatmlndfrc file (where the isgrid2d variable was determined from before), the + ! surface dataset is now used to determine if the underlying grid is 2d or not. use clm_varctl , only : fsurdat, single_column use fileutils , only : getfil From 660cc8bce57a0dfb79c0400ba02055ba62c1e16f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 17 Mar 2021 21:32:31 -0600 Subject: [PATCH 132/219] Update to latest rtm and mosart tags --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index efca327610..617adb644f 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -16,14 +16,14 @@ required = True local_path = components/rtm protocol = git repo_url = https://github.com/ESCOMP/RTM -tag = rtm1_0_74 +tag = rtm1_0_75 required = True [mosart] local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -tag = branch_tag/pio2.n01_mosart1_0_38 +tag = mosart1_0_41 required = True [mizuRoute] From 51519a8846cb567741ba08f94eba78555111727e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 17 Mar 2021 22:01:44 -0600 Subject: [PATCH 133/219] Update ChangeLog --- doc/ChangeLog | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 84 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 43ca9a65fd..2a472c46e0 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,87 @@ =============================================================== +Tag name: ctsm5.1.dev028 +Originator(s): swensosc (Sean Swenson) +Date: Wed Mar 17 20:08:51 MDT 2021 +One-line Summary: Change limitation of top layer evaporation/sublimation + +Purpose and description of changes +---------------------------------- + +Sublimation from top soil layer and evaporation/sublimation from top +snow layer needs to be limited to ensure moisture states do not become +negative. The original formulation did not always work, so we added a +new limitation to SoilFluxesMod. + +Also removes a limitation in SoilHydrologyMod that seemed not to +conserve energy and should no longer be necessary with the reworked +limitation in SoilFluxesMod. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1253 (h2osoi_ice can go significantly negative) + + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): +- The old flux limitation in SoilHydrologyMod has been replaced by a + truncation of roundoff-level values followed by a check that the final + state is non-negative. Although this check hasn't been triggered in + any of our testing, it's possible that we'll run into situations where + we need to relax the tolerance for this check. + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated carefully, but expected to be larger than + roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + +Other details +------------- + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1282 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev027 Originator(s): sacks (Bill Sacks) Date: Mon Mar 15 14:05:20 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 879dd24fea..03ce7353d5 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev028 swensosc 03/17/2021 Change limitation of top layer evaporation/sublimation ctsm5.1.dev027 sacks 03/15/2021 Update cime and other externals; includes switch to pio2 ctsm5.1.dev026 sacks 03/08/2021 Change f10 tests to use mg37 mask ctsm5.1.dev025 sacks 02/23/2021 Refactor ozone code, and misc. small fixes From efedea0373cfab83905d12b283adffc21dd22586 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 18 Mar 2021 15:13:33 -0600 Subject: [PATCH 134/219] changes to get LILAC working - verified that nuopc cap is bfb --- src/cpl/lilac/lnd_comp_esmf.F90 | 12 +- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 +- .../share_esmf/lnd_set_decomp_and_domain.F90 | 136 +++++++++++++++--- 3 files changed, 124 insertions(+), 26 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index 5a28db04dc..c3ba631577 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -39,7 +39,7 @@ module lnd_comp_esmf use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose - use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_readmesh + use lnd_set_decomp_and_domain, only :lnd_set_decomp_and_domain_from_readmesh implicit none private ! By default make data private except @@ -339,11 +339,11 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) !---------------------- ! Initialize decomposition (ldecomp) and domain (ldomain) types and generate land mesh !---------------------- - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_readmesh(vm=vm, & - meshfile_lnd=lnd_mesh_filename, meshfile_mask=lnd_mesh_filename, mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! TODO: generalize this so that a mask mesh is read in like for nuopc/cmeps + ! For now set the meshfile_mask equal to the model_meshfile + call lnd_set_decomp_and_domain_from_readmesh(driver='lilac', vm=vm, & + meshfile_lnd=lnd_mesh_filename, meshfile_mask=lnd_mesh_filename, & + mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) !-------------------------------- ! Finish initializing ctsm diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 3420e131c4..3c8006e5b4 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -522,7 +522,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_readmesh(vm=vm, & + call lnd_set_decomp_and_domain_from_readmesh(driver='cmeps', vm=vm, & meshfile_lnd=model_meshfile, meshfile_mask=meshfile_mask, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index a0ca93e84a..c37ad36c07 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -10,13 +10,14 @@ module lnd_set_decomp_and_domain private ! except ! Module public routines - public :: lnd_set_decomp_and_domain_from_readmesh - public :: lnd_set_decomp_and_domain_from_createmesh + public :: lnd_set_decomp_and_domain_from_readmesh ! nuopc/cmeps + public :: lnd_set_decomp_and_domain_from_createmesh ! nuopc/cmeps ! Module private routines private :: lnd_get_global_dims private :: lnd_set_lndmask_from_maskmesh private :: lnd_set_lndmask_from_lndmesh + private :: lnd_set_lndmask_from_fatmlndfrc private :: lnd_set_ldomain_gridinfo_from_mesh private :: chkerr private :: pio_check_err @@ -30,7 +31,7 @@ module lnd_set_decomp_and_domain contains !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_readmesh(vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & + subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & ni, nj, rc) use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D @@ -40,11 +41,12 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(vm, meshfile_lnd, meshfile_ma use clm_varctl , only : use_soil_moisture_streams ! input/output variables + character(len=*) , intent(in) :: driver ! cmeps or lilac type(ESMF_VM) , intent(in) :: vm character(len=*) , intent(in) :: meshfile_lnd character(len=*) , intent(in) :: meshfile_mask type(ESMF_Mesh) , intent(out) :: mesh_ctsm - integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: ni,nj ! global grid dimensions integer , intent(out) :: rc ! local variables @@ -88,21 +90,27 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(vm, meshfile_lnd, meshfile_ma mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Read in mask meshfile if needed - if (trim(meshfile_mask) /= trim(meshfile_lnd)) then - mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (trim(driver) == 'cmeps') then + ! Read in mask meshfile if needed + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! Determine lndmask_glob and lndfrac_glob - if (trim(meshfile_mask) /= trim(meshfile_lnd)) then - ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh - call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine lndmask_glob and lndfrac_glob + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else if (trim(driver) == 'lilac') then + call lnd_set_lndmask_from_fatmlndfrc(lndmask_glob, lndfrac_glob, ni,nj) else - ! obtain land mask from land mesh file - assume that land frac is identical to land mask - call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_sys_abort('driver '//trim(driver)//' is not supported, must be lilac or cmeps') end if ! Determine lnd decomposition that will be used by ctsm from lndmask_glob @@ -307,8 +315,8 @@ subroutine lnd_set_decomp_and_domain_from_createmesh(domain_file, vm, mesh_ctsm, call pio_check_err(rcode, 'pio_get_var for area in file '//trim(domain_file)) scol_area = scol_data(1) - ! reset ni and nj to be single point values - ni = 1 + ! reset ni and nj to be single point values + ni = 1 nj = 1 ! determine mincornerCoord and maxcornerCoord neede to create ESMF grid @@ -676,6 +684,95 @@ subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfr end subroutine lnd_set_lndmask_from_lndmesh + !=============================================================================== + subroutine lnd_set_lndmask_from_fatmlndfrc(mask, frac, ni, nj) + + ! Read the surface dataset grid related information + ! This is used to set the domain decomposition - so global data is read here + + use clm_varctl , only : fatmlndfrc + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + + ! input/output variables + integer , pointer :: mask(:) ! grid mask + real(r8) , pointer :: frac(:) ! grid fraction + integer , intent(out) :: ni, nj ! global grid sizes + + ! local variables + logical :: isgrid2d + integer :: dimid,varid ! netCDF id's + integer :: ns ! size of grid on file + integer :: n,i,j ! index + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + real(r8), allocatable :: rdata2d(:,:) + character(len=32) :: subname = 'lnd_set_mask_from_fatmlndfrc' ! subroutine name + !----------------------------------------------------------------------- + + ! Open file + call getfil( fatmlndfrc, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions and if grid file is 2d or 1d + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + if (masterproc) then + write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d + end if + + if (isgrid2d) then + ! Grid is 2d + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + else + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + deallocate(idata2d) + allocate(rdata2d(ni,nj)) + rdata2d(:,:) = 1._r8 + call ncd_io(ncid=ncid, varname='frac', data=rdata2d, flag='read', readvar=readvar) + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + frac(n) = rdata2d(i,j) + enddo + enddo + else + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + deallocate(rdata2d) + else + ! Grid is not 2d + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='frac', data=frac, flag='read', readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + end if + + ! Close file + call ncd_pio_closefile(ncid) + + end subroutine lnd_set_lndmask_from_fatmlndfrc + !=============================================================================== subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgrid2d, ni, nj, ldomain, rc) @@ -894,4 +991,5 @@ subroutine lnd_set_read_write_landmask(write_file, read_file, lndmask_glob, lndf end subroutine lnd_set_read_write_landmask + end module lnd_set_decomp_and_domain From 1e63871d7d69c13ee0019db4a91fa4761a41b5e9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 18 Mar 2021 21:31:31 -0600 Subject: [PATCH 135/219] Update ChangeLog --- doc/ChangeLog | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 83 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 2a472c46e0..0457cbf22a 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,86 @@ =============================================================== +Tag name: ctsm5.1.dev029 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Thu Mar 18 21:21:21 MDT 2021 +One-line Summary: Rework domain initialization for nuopc + +Purpose and description of changes +---------------------------------- + +Total rework of land domain initialization - no longer need domain files +to be created with NUOPC cap. + +Also, significant performance improvements with the NUOPC cap. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Notes of particular relevance for developers: +--------------------------------------------- + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): +- We still need to figure out how to apply this to LILAC: for now, LILAC + is still using the old method (as is MCT): reading domain information + from fatmlndfrac + + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- PASS + +Answer changes +-------------- + +Changes answers relative to baseline: YES, but just for NUOPC and +limited changes for LILAC + + Summarize any changes to answers, i.e., + - what code configurations: NUOPC, and limited changes for LILAC + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + For nuopc: changes in area (relatively large differences in the + f10 test in the test suite, but Mariana saw only very small + changes in an f09 case), landfrac; these influence l2r fields, + which in turn influence TWS and methane fields. + + For lilac: just changes in area + + If bitwise differences were observed, how did you show they were no worse + than roundoff? Examination of cprnc diffs. + +Other details +------------- + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- rtm: rtm1_0_74 -> rtm1_0_75 +- mosart: branch_tag/pio2.n01_mosart1_0_38 -> mosart1_0_41 + +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1258 +- https://github.com/ESCOMP/CTSM/pull/1236 (closed and replaced by 1258) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev028 Originator(s): swensosc (Sean Swenson) Date: Wed Mar 17 20:08:51 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 03ce7353d5..7b4a2b02a9 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev029 mvertens 03/18/2021 Rework domain initialization for nuopc ctsm5.1.dev028 swensosc 03/17/2021 Change limitation of top layer evaporation/sublimation ctsm5.1.dev027 sacks 03/15/2021 Update cime and other externals; includes switch to pio2 ctsm5.1.dev026 sacks 03/08/2021 Change f10 tests to use mg37 mask From 8b7236d96dd8943122fa7ebb7ff5c99e2400f56b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Mar 2021 21:34:33 -0700 Subject: [PATCH 136/219] updates for single column --- cime_config/buildnml | 1 + cime_config/testdefs/testlist_clm.xml | 8 +- src/biogeochem/SatellitePhenologyMod.F90 | 17 - src/cpl/nuopc/lnd_comp_nuopc.F90 | 167 +++++++--- src/cpl/nuopc/lnd_import_export.F90 | 12 +- .../share_esmf/lnd_set_decomp_and_domain.F90 | 298 ++++-------------- 6 files changed, 187 insertions(+), 316 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index f60206a01d..9f76913010 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -61,6 +61,7 @@ def buildnml(case, caseroot, compname): run_reftod = case.get_value("RUN_REFTOD") glc_nec = case.get_value("GLC_NEC") mask = case.get_value("MASK_GRID") + driver = case.get_value("COMP_INTERFACE").lower() # ----------------------------------------------------- # Set ctsmconf diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index c304a4bb27..b3f93c0ae1 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1477,7 +1477,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1653,7 +1653,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1662,7 +1662,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1670,7 +1670,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90 index 7b5aea35dd..1d273a9e64 100644 --- a/src/biogeochem/SatellitePhenologyMod.F90 +++ b/src/biogeochem/SatellitePhenologyMod.F90 @@ -17,7 +17,6 @@ module SatellitePhenologyMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : scmlat,scmlon,single_column use clm_varctl , only : iulog, use_lai_streams, inst_name use clm_varcon , only : grlnd use controlMod , only : NLFilename @@ -501,7 +500,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) use domainMod , only : ldomain use fileutils , only : getfil use clm_varctl , only : fsurdat - use shr_scam_mod, only : shr_scam_getCloseLatLon ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds @@ -511,7 +509,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) type(file_desc_t) :: ncid ! netcdf id real(r8), pointer :: annlai(:,:) ! 12 months of monthly lai from input data set real(r8), pointer :: mlai(:,:) ! lai read from input files - real(r8):: closelat,closelon ! single column vars integer :: ier ! error code integer :: g,k,l,m,n,p ! indices integer :: ni,nj,ns ! indices @@ -520,7 +517,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) integer :: nlon_i ! number of input data longitudes integer :: nlat_i ! number of input data latitudes integer :: npft_i ! number of input data patch types - integer :: closelatidx,closelonidx ! single column vars logical :: isgrid2d ! true => file is 2d character(len=256) :: locfn ! local file name character(len=32) :: subname = 'readAnnualVegetation' @@ -553,11 +549,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) end if call check_dim_size(ncid, 'lsmpft', maxsoil_patches) - if (single_column) then - call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & - closelat, closelon, closelatidx, closelonidx) - endif - do k=1,12 !! loop over months and read vegetated data call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, & @@ -600,7 +591,6 @@ subroutine readMonthlyVegetation (bounds, & use pftconMod , only : noveg use fileutils , only : getfil use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_INTEGER - use shr_scam_mod , only : shr_scam_getCloseLatLon use clm_time_manager , only : get_nstep use netcdf ! @@ -620,8 +610,6 @@ subroutine readMonthlyVegetation (bounds, & integer :: nlat_i ! number of input data latitudes integer :: npft_i ! number of input data patch types integer :: ier ! error code - integer :: closelatidx,closelonidx - real(r8):: closelat,closelon logical :: readvar real(r8), pointer :: mlai(:,:) ! lai read from input files real(r8), pointer :: msai(:,:) ! sai read from input files @@ -651,11 +639,6 @@ subroutine readMonthlyVegetation (bounds, & call getfil(fveg, locfn, 0) call ncd_pio_openfile (ncid, trim(locfn), 0) - if (single_column) then - call shr_scam_getCloseLatLon (ncid, scmlat, scmlon, closelat, closelon,& - closelatidx, closelonidx) - endif - do k=1,2 !loop over months and read vegetated data call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, dim1name=grlnd, & diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 3c8006e5b4..83943c3f76 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -76,6 +76,9 @@ module lnd_comp_nuopc real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + logical :: single_column ! single column mode (nn search of domainfile) + logical :: scol_valid ! if single_column, does point have a mask of zero + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -281,11 +284,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(iulog,'(a )')' atm component = '//trim(atm_model) write(iulog,'(a )')' rof component = '//trim(rof_model) write(iulog,'(a )')' glc component = '//trim(glc_model) - write(iulog,'(a,L1 )')' atm_prognostic = ',atm_prognostic - write(iulog,'(a,L1 )')' rof_prognostic = ',rof_prognostic - write(iulog,'(a,L1 )')' glc_present = ',glc_present + write(iulog,'(a,l )')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,l )')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,l )')' glc_present = ',glc_present if (glc_present) then - write(iulog,'(a,L1)')' cism_evolve = ',cism_evolve + write(iulog,'(a,l)')' cism_evolve = ',cism_evolve end if write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num @@ -314,8 +317,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use clm_instMod , only : lnd2atm_inst, lnd2glc_inst, water_inst use domainMod , only : ldomain use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_createmesh use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_readmesh + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_single_column + use lnd_set_decomp_and_domain , only : lnd_set_mesh_for_single_column ! input/output variables type(ESMF_GridComp) :: gcomp @@ -330,6 +334,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type integer :: ref_ymd ! reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (sec) @@ -349,14 +354,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! original log unit type(bounds_type) :: bounds ! bounds - integer :: ni, nj + integer :: n, ni, nj character(len=CL) :: cvalue ! config data character(len=CL) :: meshfile_mask - character(len=CL) :: domain_file character(len=CL) :: ctitle ! case description title character(len=CL) :: caseid ! case identifier name - real(r8) :: scmlat ! single-column latitude - real(r8) :: scmlon ! single-column longitude + character(len=CL) :: single_column_domainfile + real(r8) :: scol_lat ! single-column latitude + real(r8) :: scol_lon ! single-column longitude + real(r8) :: scol_area ! single-column area + real(r8) :: scol_frac ! single-column frac + integer :: scol_mask ! single-column mask + type(ESMF_Field) :: lfield + character(CL) ,pointer :: lfieldnamelist(:) => null() + integer :: fieldCount + real(r8), pointer :: fldptr(:) character(len=CL) :: model_version ! Model version character(len=CL) :: hostname ! hostname of machine running on character(len=CL) :: username ! user running the model @@ -366,6 +378,73 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + !---------------------------------------------------------------------------- + ! Single column logic - if mask is zero for nearest neighbor search then + ! set all export state fields to zero and return + !---------------------------------------------------------------------------- + + ! If single_column is true - use single_column_domainfile to + ! obtain nearest neighbor values for scol_lon and scol_lat + ! If single_column is false and scol_lon and scol_lat are not equal to -999 then + ! use scol_lon and scol_lat directly + + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_lon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_lat + call NUOPC_CompAttributeGet(gcomp, name='single_column_domainfile', value=single_column_domainfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (scol_lon > -900. .and. scol_lat > -900.) then + if (trim(single_column_domainfile) /= 'null') then + single_column = .true. + write(iulog,'(a)')' single column mode is active:' + write(iulog,'(a,f13.5,a,f10.5,a)')' will find nearest neighbor values of ',scol_lon,' and ',& + scol_lat,' in '//trim(single_column_domainfile) + else + single_column = .false. + write(iulog,'(a)')' single point mode is active' + write(iulog,'(a,f13.5,a,f13.5,a)')' scol_lon is ',scol_lon,' and scol_lat is ' + end if + call lnd_set_mesh_for_single_column(single_column_domainfile, scol_lon, scol_lat, & + scol_area, scol_mask, scol_frac, mesh, scol_valid, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. scol_valid) then + write(iulog,'(a)')' single column mode point does not contain any land - will set all export data to 0' + ! if single column is not valid - set all export state fields to zero and return + call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(1._r8, flds_scalar_index_nx, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(1._r8, flds_scalar_index_ny, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr(:) = 0._r8 + enddo + deallocate(lfieldnamelist) + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN + else + write(iulog,'(a,f10.5)')' single column mode lon/lat does contain land with land fraction ',scol_frac + end if + end if + !---------------------------------------------------------------------------- ! Reset shr logging to my log file !---------------------------------------------------------------------------- @@ -439,25 +518,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) model_version - call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) username - call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hostname - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) single_column - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) starttype - ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. @@ -475,6 +535,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- ! Initialize first phase of ctsm ! --------------------- + call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hostname + call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) username call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) brnch_retain_casename @@ -496,7 +562,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call clm_varctl_set(& caseid_in=caseid, ctitle_in=ctitle, & brnch_retain_casename_in=brnch_retain_casename, & - single_column_in=single_column, scmlat_in=scmlat, scmlon_in=scmlon, & + single_column_in=single_column, scmlat_in=scol_lat, scmlon_in=scol_lon, & nsrest_in=nsrest, & version_in=model_version, & hostname_in=hostname, & @@ -507,17 +573,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- ! Create ctsm decomp and domain info ! --------------------- - call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (single_column) model_meshfile = 'create_mesh' - - if (trim(model_meshfile) == 'create_mesh') then - call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=domain_file, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call lnd_set_decomp_and_domain_from_createmesh(domain_file=domain_file, vm=vm, & - mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) + if (scol_lon > -900. .and. scol_lat > -900.) then + call lnd_set_decomp_and_domain_from_single_column(scol_lon, scol_lat, & + scol_area, scol_mask, scol_frac) if (ChkErr(rc,__LINE__,u_FILE_u)) return else + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=meshfile_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -536,11 +598,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- ! Finish initializing ctsm ! --------------------- - ! If no land then abort for now - ! TODO: need to handle the case of noland with CMEPS - ! if ( noland ) then - ! call shr_sys_abort(trim(subname)//"ERROR: Currently cannot handle case of single column with non-land") - ! end if call initialize2(ni, nj) !-------------------------------- @@ -566,7 +623,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call State_SetScalar(dble(ldomain%ni), flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(dble(ldomain%nj), flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -596,6 +652,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize !=============================================================================== + subroutine ModelAdvance(gcomp, rc) !------------------------ @@ -656,10 +713,17 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + !-------------------------------- + ! Single column logic if nearest neighbor point has a mask of zero + !-------------------------------- + + if (single_column .and. .not. scol_valid) then + RETURN + end if + + !-------------------------------- + ! Reset share log units + !-------------------------------- !$ call omp_set_num_threads(localPeCount) @@ -674,9 +738,14 @@ subroutine ModelAdvance(gcomp, rc) #endif !-------------------------------- - ! Query the Component for its clock, importState and exportState + ! Query the Component for its clock, importState and exportState and vm !-------------------------------- + call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 1c5a6423ad..df4b4d1a6e 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -197,6 +197,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! Advertise export fields !-------------------------------- + ! Need to determine if there is no land for single column before the advertise call is done + if (atm_prognostic .or. force_send_to_atm) then send_to_atm = .true. else @@ -216,11 +218,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. if (masterproc) then - write(iulog,'(a,l1)') 'flds_co2a= ',flds_co2a - write(iulog,'(a,l1)') 'flds_co2b= ',flds_co2b - write(iulog,'(a,l1)') 'flds_co2c= ',flds_co2c - write(iulog,'(a,l1)') 'sending co2 to atm = ',send_co2_to_atm - write(iulog,'(a,l1)') 'receiving co2 from atm = ',recv_co2_fr_atm + write(iulog,'(a,l)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,l)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,l)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,l)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,l)') 'receiving co2 from atm = ',recv_co2_fr_atm end if end if diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 index c37ad36c07..55ab210e18 100644 --- a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -10,8 +10,9 @@ module lnd_set_decomp_and_domain private ! except ! Module public routines - public :: lnd_set_decomp_and_domain_from_readmesh ! nuopc/cmeps - public :: lnd_set_decomp_and_domain_from_createmesh ! nuopc/cmeps + public :: lnd_set_decomp_and_domain_from_readmesh + public :: lnd_set_mesh_for_single_column + public :: lnd_set_decomp_and_domain_for_single_column ! Module private routines private :: lnd_get_global_dims @@ -182,177 +183,35 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes end subroutine lnd_set_decomp_and_domain_from_readmesh !=============================================================================== - subroutine lnd_set_decomp_and_domain_from_createmesh(domain_file, vm, mesh_ctsm, ni, nj, rc) + subroutine lnd_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) - ! Generate a new mesh from the input domain file and set the mask to 1 - - use decompInitMod , only : decompInit_lnd, decompInit_lnd3D - use decompMod , only : ldecomp, bounds_type, get_proc_bounds - use domainMod , only : ldomain, domain_init - use clm_varctl , only : use_soil_moisture_streams - use clm_varctl , only : scmlat, scmlon, single_column - use clm_varpar , only : nlevsoi - use ncdio_pio , only : pio_subsystem, io_type - use pio + ! Generate a mesh for single column + use netcdf + use clm_varcon, only : spval ! input/output variables - character(len=CL) , intent(in) :: domain_file - type(ESMF_VM) , intent(in) :: vm - type(ESMF_Mesh) , intent(out) :: mesh_ctsm - integer , intent(out) :: ni,nj ! global grid dimensions - integer , intent(out) :: rc + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: rc ! local variables - type(ESMF_Grid) :: lgrid - type(ESMF_Mesh) :: mesh_lndcreate - type(ESMF_DistGrid) :: distgrid_ctsm - integer, pointer :: gindex_ctsm(:) ! global index space for just land points - logical :: isgrid2d - integer :: i,j,g,n - integer :: nv - integer :: ierr - integer :: dimid - integer :: varid_xv, varid_yv - integer :: varid_xc, varid_yc - integer :: varid_area - real(r8), allocatable :: xc(:,:), yc(:,:) ! coordinates of centers - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) ! coordinates of corners - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - integer :: spatialDim - integer :: numownedelements - real(r8) , pointer :: ownedElemCoords(:) - integer, allocatable :: lnd_mask(:) - type(bounds_type) :: bounds ! bounds - integer :: begg,endg - integer :: nlnd - integer :: start(2) ! start index to read in for single column mode - integer :: count(2) ! number of points to read in - real(r8) :: scol_data(1) ! temporary - integer , allocatable :: mask(:) ! temporary - real(r8), allocatable :: lats(:) ! temporary - real(r8), allocatable :: lons(:) ! temporary - real(r8), allocatable :: pos_lons(:) ! temporary - real(r8) :: pos_scmlon ! temporary - real(r8) :: scol_area ! temporary - type(file_desc_t) :: pioid - integer :: rcode ! error code + type(ESMF_Grid) :: lgrid + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + character(len=*), parameter :: subname= ' (lnd_set_mesh_for_single_column) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - rcode = pio_openfile(pio_subsystem, pioid, io_type, trim(domain_file), pio_nowrite) - call pio_check_err(rcode, 'error opening file '//trim(domain_file)) - call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) - rcode = pio_inq_dimid(pioid, 'ni', dimid) - call pio_check_err(rcode, 'pio_inq_dimid for ni in file '//trim(domain_file)) - rcode = pio_inquire_dimension(pioid, dimid, len=ni) - call pio_check_err(rcode, 'pio_inq_dimension for ni in file '//trim(domain_file)) - rcode = pio_inq_dimid(pioid, 'nj', dimid) - call pio_check_err(rcode, 'pio_inq_dimid for nj in file '//trim(domain_file)) - rcode = pio_inquire_dimension(pioid, dimid, len=nj) - call pio_check_err(rcode, 'pio_inq_dimension for nj in file '//trim(domain_file)) - rcode = pio_inq_dimid(pioid, 'nv', dimid) - call pio_check_err(rcode, 'pio_inq_dimid for nv in file '//trim(domain_file)) - rcode = pio_inquire_dimension(pioid, dimid, len=nv) - call pio_check_err(rcode, 'pio_inq_dimension for nv in file '//trim(domain_file)) - rcode = pio_inq_varid(pioid, 'xc' , varid_xc) - call pio_check_err(rcode, 'pio_inq_varid for yc in file '//trim(domain_file)) - rcode = pio_inq_varid(pioid, 'yc' , varid_yc) - call pio_check_err(rcode, 'pio_inq_varid for yc in file '//trim(domain_file)) - rcode = pio_inq_varid(pioid, 'xv' , varid_xv) - call pio_check_err(rcode, 'pio_inq_varid for xv in file '//trim(domain_file)) - rcode = pio_inq_varid(pioid, 'yv' , varid_yv) - call pio_check_err(rcode, 'pio_inq_varid for yv in file '//trim(domain_file)) - rcode = pio_inq_varid(pioid, 'area', varid_area) - call pio_check_err(rcode, 'pio_inq_varid for area in file '//trim(domain_file)) - - if (single_column) then - - ! In this case the domain file is not a single point file - but normally a - ! global domain file where a nearest neighbor search will be done to find - ! the closest point in the domin file to scol_lon and scol_lat - - ! get center lats and lons from domain file - allocate(xc(ni,nj)) - allocate(yc(ni,nj)) - rcode = pio_get_var(pioid, varid_xc, xc) - call pio_check_err(rcode, 'pio_get_var for xc in file '//trim(domain_file)) - rcode = pio_get_var(pioid, varid_yc, yc) - call pio_check_err(rcode, 'pio_get_var for yc in file '//trim(domain_file)) - - ! find nearest neighbor indices of scmlon and scmlat in domain file - allocate(lats(nj)) - allocate(lons(ni)) - allocate(pos_lons(ni)) - do i = 1,ni - lons(i) = xc(i,1) - end do - do j = 1,nj - lats(j) = yc(1,j) - end do - pos_lons(:) = mod(lons(:) + 360._r8, 360._r8) - pos_scmlon = mod(scmlon + 360._r8, 360._r8) - start(1) = (MINLOC(abs(pos_lons - pos_scmlon), dim=1)) - start(2) = (MINLOC(abs(lats -scmlat ), dim=1)) - count(:) = 1 - deallocate(lons) - deallocate(lats) - - ! read in value of nearest neighbor lon and RESET scmlat - rcode = pio_get_var(pioid, varid_xc, start, count, scol_data) - call pio_check_err(rcode, 'pio_get_var for xc in file '//trim(domain_file)) - scmlon = scol_data(1) - - ! read in value of nearest neighbor lon and RESET scmlon - rcode = pio_get_var(pioid, varid_yc, start, count, scol_data) - call pio_check_err(rcode, 'pio_get_var for yc in file '//trim(domain_file)) - scmlat = scol_data(1) - - ! get area of gridcell - rcode = pio_get_var(pioid, varid_area, start, count, scol_data) - call pio_check_err(rcode, 'pio_get_var for area in file '//trim(domain_file)) - scol_area = scol_data(1) - - ! reset ni and nj to be single point values - ni = 1 - nj = 1 - - ! determine mincornerCoord and maxcornerCoord neede to create ESMF grid - maxIndex(1) = 1 ! number of lons - maxIndex(2) = 1 ! number of lats - mincornerCoord(1) = scmlon - scol_area/2._r8 ! min lon - mincornerCoord(2) = scmlat - scol_area/2._r8 ! min lat - maxcornerCoord(1) = scmlon + scol_area/2._r8 ! max lon - maxcornerCoord(2) = scmlat + scol_area/2._r8 ! max lat - deallocate(xc,yc) - - else - - ! allocate xv and yv and read them in - allocate(xv(nv,ni,nj)) - allocate(yv(nv,ni,nj)) - rcode = pio_get_var(pioid, varid_xv, xv) - call pio_check_err(rcode, 'pio_get_var for xv in file '//trim(domain_file)) - rcode = pio_get_var(pioid, varid_yv, yv) - call pio_check_err(rcode, 'pio_get_var for yv in file '//trim(domain_file)) - - ! determine mincornerCoord and maxcornerCoord neede to create ESMF grid - maxIndex(1) = ni ! number of lons - maxIndex(2) = nj ! number of lats - mincornerCoord(1) = xv(1,1,1) ! min lon - mincornerCoord(2) = yv(1,1,1) ! min lat - maxcornerCoord(1) = xv(3,ni,nj) ! max lon - maxcornerCoord(2) = yv(3,ni,nj) ! max lat - deallocate(xv,yv) - - end if - - ! close file - call pio_seterrorhandling(pioid, PIO_INTERNAL_ERROR) - call pio_closefile(pioid) - + ! Use center and come up with arbitrary area delta lon and lat = .1 degree + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scol_lon - .1_r8 ! min lon + mincornerCoord(2) = scol_lat - .1_r8 ! min lat + maxcornerCoord(1) = scol_lon + .1_r8 ! max lon + maxcornerCoord(2) = scol_lat + .1_r8 ! max lat ! create the ESMF grid lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & @@ -360,62 +219,51 @@ subroutine lnd_set_decomp_and_domain_from_createmesh(domain_file, vm, mesh_ctsm, if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create the mesh from the lgrid - mesh_lndcreate = ESMF_MeshCreate(lgrid, rc=rc) + mesh = ESMF_MeshCreate(lgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set the mesh mask to 1 - call ESMF_MeshGet(mesh_lndcreate, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(mesh_lndcreate, ownedElemCoords=ownedElemCoords, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(lnd_mask(numownedelements)) - lnd_mask(:) = 1 - ! call ESMF_MeshSet(mesh_lndcreate, elementMask=lnd_mask, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine lnd_set_mesh_for_single_column + + !=============================================================================== + subroutine lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_mask, scol_frac) + + use decompInitMod , only : decompInit_lnd, decompInit_lnd3D + use decompMod , only : bounds_type, get_proc_bounds + use domainMod , only : ldomain, domain_init + use clm_varctl , only : use_soil_moisture_streams + use clm_varpar , only : nlevsoi + use clm_varcon , only : spval + + ! input/output variables + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + integer , intent(in) :: scol_mask + real(r8) , intent(in) :: scol_frac + + ! local variables + type(bounds_type) :: bounds ! bounds + !------------------------------------------------------------------------------- ! Determine ldecomp and ldomain - call decompInit_lnd(lni=ni, lnj=nj, amask=lnd_mask) + call decompInit_lnd(lni=1, lnj=1, amask=(/1/)) if (use_soil_moisture_streams) then - call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + call decompInit_lnd3D(lni=1, lnj=1, lnk=nlevsoi) end if ! Initialize processor bounds call get_proc_bounds(bounds) - begg = bounds%begg - endg = bounds%endg - - ! Create gindex_ctsm - nlnd = endg - begg + 1 - allocate(gindex_ctsm(nlnd)) - do g = begg, endg - n = 1 + (g - begg) - gindex_ctsm(n) = ldecomp%gdc2glo(g) - end do ! Initialize domain data structure - isgrid2d = .true. - call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + call domain_init(domain=ldomain, isgrid2d=.false., ni=1, nj=1, nbeg=1, nend=1) - ! Determine ldomain%mask and ldomain%frac - do g = begg, endg - ldomain%mask(g) = 1 - ldomain%frac(g) = 1._r8 - end do + ! Initialize ldomain attributes + ldomain%lonc(1) = scol_lon + ldomain%latc(1) = scol_lat + ldomain%area(1) = spval + ldomain%mask(1) = scol_mask + ldomain%frac(1) = scol_frac - ! Generate a new mesh on the gindex decomposition - distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh_ctsm = ESMF_MeshCreate(mesh_lndcreate, elementDistGrid=distgrid_ctsm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Set ldomain%lonc, ldomain%latc and ldomain%area - call lnd_set_ldomain_gridinfo_from_mesh(mesh_ctsm, vm, gindex_ctsm, begg, endg, isgrid2d, ni, nj, ldomain, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(lnd_mask) - - end subroutine lnd_set_decomp_and_domain_from_createmesh + end subroutine lnd_set_decomp_and_domain_for_single_column !=============================================================================== subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) @@ -713,7 +561,8 @@ subroutine lnd_set_lndmask_from_fatmlndfrc(mask, frac, ni, nj) logical :: readvar ! read variable in or not integer , allocatable :: idata2d(:,:) real(r8), allocatable :: rdata2d(:,:) - character(len=32) :: subname = 'lnd_set_mask_from_fatmlndfrc' ! subroutine name + integer :: unitn + character(len=32) :: subname = 'lnd_set_mask_from_fatmlndfrc' ! subroutine name !----------------------------------------------------------------------- ! Open file @@ -779,8 +628,6 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr use domainMod , only : domain_type, lon1d, lat1d use clm_varcon , only : re - ! for reading in fatmlndfrc to override mesh data - use clm_varctl , only : fatmlndfrc use clm_varcon , only : grlnd use fileutils , only : getfil use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile @@ -806,12 +653,6 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr real(r8) , pointer :: lndlons_glob(:) real(r8) , pointer :: rtemp_glob(:) type(ESMF_Field) :: areaField - - ! for sanity check - remove when this is done - type(file_desc_t) :: ncid ! netcdf id - character(len=CL) :: locfn ! local file name - real(r8), pointer :: lonc_atmlndfrc(:) - real(r8), pointer :: latc_atmlndfrc(:) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -880,31 +721,6 @@ subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgr deallocate(rtemp_glob) end if - ! Sanity check- remove this when it is done - call getfil( trim(fatmlndfrc), locfn, 0 ) - call ncd_pio_openfile (ncid, trim(locfn), 0) - allocate(lonc_atmlndfrc(numownedelements)) - allocate(latc_atmlndfrc(numownedelements)) - call ncd_io(ncid=ncid, varname= 'xc' , flag='read', data=lonc_atmlndfrc , dim1name=grlnd) - call ncd_io(ncid=ncid, varname= 'yc' , flag='read', data=latc_atmlndfrc , dim1name=grlnd) - do g = begg,endg - n = g - begg + 1 - if ( abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) > 1.e-11 .and. & - abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) /= 360._r8) then - write(6,'(a,3(d20.13,2x))')'ERROR: lonc_atmlndfrac(n), ldomain%lonc(g), abs(diff) = ',& - lonc_atmlndfrc(n), ldomain%lonc(g), abs(lonc_atmlndfrc(n) - ldomain%lonc(g)) - call shr_sys_abort() - end if - if (abs(latc_atmlndfrc(n) - ldomain%latc(g)) > 1.e-11) then - write(6,'(a,3(d20.13,2x))')'ERROR: latc_atmlndfrac(n), ldomain%latc(g), abs(diff) = ',& - latc_atmlndfrc(n), ldomain%latc(g), abs(latc_atmlndfrc(n) - ldomain%latc(g)) - call shr_sys_abort() - end if - end do - deallocate(lonc_atmlndfrc) - deallocate(latc_atmlndfrc) - call ncd_pio_closefile(ncid) - end subroutine lnd_set_ldomain_gridinfo_from_mesh !=============================================================================== From bf8989cd03da3c855340e91275cf4dc582001d9f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Mar 2021 22:43:42 -0700 Subject: [PATCH 137/219] bug fixes --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 12 ++++-------- src/cpl/nuopc/lnd_import_export.F90 | 18 +++++++----------- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 83943c3f76..10999d51c5 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -413,15 +413,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (.not. scol_valid) then write(iulog,'(a)')' single column mode point does not contain any land - will set all export data to 0' ! if single column is not valid - set all export state fields to zero and return - call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) + call realize_fields(importState, exportState, mesh, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) + call State_SetScalar(1._r8, flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(1._r8, flds_scalar_index_nx, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(1._r8, flds_scalar_index_ny, exportState, & - flds_scalar_name, flds_scalar_num, rc) + call State_SetScalar(1._r8, flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -592,7 +588,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- ! Realize the actively coupled fields ! --------------------- - call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) + call realize_fields(importState, exportState, mesh, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! --------------------- diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index df4b4d1a6e..e84d267e1f 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -397,26 +397,22 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r end subroutine advertise_fields !=============================================================================== - subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) + subroutine realize_fields(importState, exportState, Emesh, flds_scalar_name, flds_scalar_num, rc) ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(in) :: Emesh - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: importState + type(ESMF_State) , intent(inout) :: exportState + type(ESMF_Mesh) , intent(in) :: Emesh + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState character(len=*), parameter :: subname='(lnd_import_export:realize_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldlist_realize( & state=ExportState, & fldList=fldsFrLnd, & From 3134c88d095bfa56f1ab7543db3f10bfce960bf1 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 12 Mar 2021 12:39:36 -0700 Subject: [PATCH 138/219] updates for single column functionality --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 70 ++++++++++++++++++-------------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 10999d51c5..42a446234e 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -318,8 +318,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use domainMod , only : ldomain use decompMod , only : ldecomp, bounds_type, get_proc_bounds use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_readmesh - use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_single_column use lnd_set_decomp_and_domain , only : lnd_set_mesh_for_single_column + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_for_single_column ! input/output variables type(ESMF_GridComp) :: gcomp @@ -359,16 +359,18 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(len=CL) :: meshfile_mask character(len=CL) :: ctitle ! case description title character(len=CL) :: caseid ! case identifier name - character(len=CL) :: single_column_domainfile real(r8) :: scol_lat ! single-column latitude real(r8) :: scol_lon ! single-column longitude real(r8) :: scol_area ! single-column area real(r8) :: scol_frac ! single-column frac integer :: scol_mask ! single-column mask + character(len=CL) :: single_column_lnd_domainfile type(ESMF_Field) :: lfield character(CL) ,pointer :: lfieldnamelist(:) => null() integer :: fieldCount - real(r8), pointer :: fldptr(:) + integer :: rank + real(r8), pointer :: fldptr1d(:) + real(r8), pointer :: fldptr2d(:,:) character(len=CL) :: model_version ! Model version character(len=CL) :: hostname ! hostname of machine running on character(len=CL) :: username ! user running the model @@ -383,7 +385,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! set all export state fields to zero and return !---------------------------------------------------------------------------- - ! If single_column is true - use single_column_domainfile to + ! If single_column is true - used single_column_domainfile to ! obtain nearest neighbor values for scol_lon and scol_lat ! If single_column is false and scol_lon and scol_lat are not equal to -999 then ! use scol_lon and scol_lat directly @@ -394,42 +396,50 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scol_lat - call NUOPC_CompAttributeGet(gcomp, name='single_column_domainfile', value=single_column_domainfile, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (scol_lon > -900. .and. scol_lat > -900.) then - if (trim(single_column_domainfile) /= 'null') then - single_column = .true. - write(iulog,'(a)')' single column mode is active:' - write(iulog,'(a,f13.5,a,f10.5,a)')' will find nearest neighbor values of ',scol_lon,' and ',& - scol_lat,' in '//trim(single_column_domainfile) - else - single_column = .false. - write(iulog,'(a)')' single point mode is active' - write(iulog,'(a,f13.5,a,f13.5,a)')' scol_lon is ',scol_lon,' and scol_lat is ' - end if - call lnd_set_mesh_for_single_column(single_column_domainfile, scol_lon, scol_lat, & - scol_area, scol_mask, scol_frac, mesh, scol_valid, rc) + + if (scol_lon > -999. .and. scol_lat > -999.) then + single_column = (trim(single_column_lnd_domainfile) /= 'null') + + call NUOPC_CompAttributeGet(gcomp, name='scol_lndmask', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_mask + + call NUOPC_CompAttributeGet(gcomp, name='scol_lndfrac', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_frac + + call lnd_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + scol_valid = (scol_mask == 1) if (.not. scol_valid) then write(iulog,'(a)')' single column mode point does not contain any land - will set all export data to 0' ! if single column is not valid - set all export state fields to zero and return call realize_fields(importState, exportState, mesh, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(1._r8, flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(1._r8, flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount - call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr(:) = 0._r8 + if (trim(lfieldnamelist(n)) /= flds_scalar_name) then + call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + else + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + end if + end if enddo deallocate(lfieldnamelist) ! ******************* @@ -437,7 +447,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! ******************* RETURN else - write(iulog,'(a,f10.5)')' single column mode lon/lat does contain land with land fraction ',scol_frac + write(iulog,'(a,3(f10.5,2x))')' single column mode scol_lon/scol_lat/scol_frac is ',& + scol_lon,scol_lat,scol_frac end if end if @@ -570,8 +581,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Create ctsm decomp and domain info ! --------------------- if (scol_lon > -900. .and. scol_lat > -900.) then - call lnd_set_decomp_and_domain_from_single_column(scol_lon, scol_lat, & - scol_area, scol_mask, scol_frac) + call lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_mask, scol_frac) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) From 326ed8d7c3b9ab4c3ce44aee4d0d79ac0f927be2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 14 Mar 2021 16:03:44 -0600 Subject: [PATCH 139/219] updates for single column and removal of fatmlndfrc references other than in mct cap --- bld/CLMBuildNamelist.pm | 22 ++++++---- .../namelist_definition_ctsm.xml | 2 +- cime_config/buildnml | 5 ++- cime_config/testdefs/ExpectedTestFails.xml | 2 +- cime_config/testdefs/testlist_clm.xml | 22 +++++----- .../testmods_dirs/clm/pts/shell_commands | 2 + src/biogeophys/SoilMoistureStreamMod.F90 | 3 +- src/cpl/lilac/lnd_import_export.F90 | 3 +- src/cpl/mct/lnd_comp_mct.F90 | 13 +++++- src/cpl/mct/lnd_set_decomp_and_domain.F90 | 40 +++++++++++++++---- src/cpl/nuopc/lnd_comp_nuopc.F90 | 3 +- src/main/clm_initializeMod.F90 | 2 +- src/main/clm_varctl.F90 | 2 - src/main/controlMod.F90 | 8 +--- src/main/surfrdMod.F90 | 4 +- 15 files changed, 86 insertions(+), 47 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 83128f7357..a345965611 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1781,15 +1781,19 @@ sub setup_logic_lnd_frac { $log->fatal_error("Can NOT set both -lnd_frac option (set via LND_DOMAIN_PATH/LND_DOMAIN_FILE " . "env variables) AND fatmlndfrac on namelist"); } - my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac ); + if ($opts->{$var} ne 'UNSET') { + my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac ); + } } - # Get the fraction file - if (defined $nl->get_value('fatmlndfrc')) { - # do nothing - use value provided by config_grid.xml and clm.cpl7.template - } else { - $log->fatal_error("fatmlndfrc was NOT sent into CLM build-namelist."); + if ($opts->{$var} ne 'UNSET') { + # Get the fraction file + if (defined $nl->get_value('fatmlndfrc')) { + # do nothing - use value provided by config_grid.xml and clm.cpl7.template + } else { + $log->fatal_error("fatmlndfrc was NOT sent into CLM build-namelist."); + } } } @@ -3933,6 +3937,10 @@ sub write_output_files { cnprecision_inparm clm_glacier_behavior crop irrigation_inparm surfacealbedo_inparm water_tracers_inparm); + if ($opts->{'lnd_frac'} ne 'UNSET') { + push @groups, "clm_lndfrac"; + } + #@groups = qw(clm_inparm clm_canopyhydrology_inparm clm_soilhydrology_inparm # finidat_consistency_checks dynpft_consistency_checks); # Eventually only list namelists that are actually used when CN on diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 9543fbcf6f..2d7e4a5d82 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -62,7 +62,7 @@ Component name to use in history and restart files type="char*256" category="datasets" input_pathname="abs" - group="clm_inparm" + group="clm_lndfrac" valid_values="" > Full pathname of land fraction data file. diff --git a/cime_config/buildnml b/cime_config/buildnml index 9f76913010..1771e4bf2a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -153,7 +153,10 @@ def buildnml(case, caseroot, compname): inputdata_file = os.path.join(caseroot,"Buildconf","ctsm.input_data_list") - lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) + if (driver == 'mct'): + lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) + else: + lndfrac_file = 'UNSET' config_cache_file = os.path.join(caseroot,"Buildconf", compname+"conf","config_cache.xml") diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 04ff4b5dee..1147fb7bc3 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,7 +30,7 @@ - + FAIL #1117 diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index b3f93c0ae1..c7371650a0 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -55,7 +55,7 @@ - + @@ -172,7 +172,7 @@ - + @@ -181,7 +181,7 @@ - + @@ -302,7 +302,7 @@ - + @@ -1005,7 +1005,7 @@ - + @@ -1348,7 +1348,7 @@ - + @@ -1358,7 +1358,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this high core count test with every tag, but include it in the less frequent ctsm_sci testing)" - + @@ -1367,7 +1367,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1376,7 +1376,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1405,7 +1405,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1414,7 +1414,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + diff --git a/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands b/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands index ad140e45e1..1613d28b25 100644 --- a/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands @@ -22,3 +22,5 @@ ./xmlchange NTASKS_ROF=1 ./xmlchange NTASKS_WAV=1 ./xmlchange NTASKS_ESP=1 +./xmlchange MOSART_MODE=NULL +./xmlchange RTM_MODE=NULL diff --git a/src/biogeophys/SoilMoistureStreamMod.F90 b/src/biogeophys/SoilMoistureStreamMod.F90 index 421d729f0b..eab6d26c02 100644 --- a/src/biogeophys/SoilMoistureStreamMod.F90 +++ b/src/biogeophys/SoilMoistureStreamMod.F90 @@ -23,8 +23,7 @@ module SoilMoistureStreamMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : scmlat,scmlon,single_column, inst_name - use clm_varctl , only : iulog, use_soil_moisture_streams + use clm_varctl , only : iulog, use_soil_moisture_streams, inst_name use clm_varcon , only : grlnd use controlMod , only : NLFilename use decompMod , only : gsMap_lnd2Dsoi_gdc2glo diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 951b9f239d..9e2d921563 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -275,7 +275,7 @@ subroutine check_atm_landfrac(importState, bounds, rc) !--------------------------------------------------------------------------- ! Implementation notes: The CTSM decomposition is set up so that ocean points appear - ! at the end of the vectors received from the coupler. Thus, in order to check if + ! at the end of the vectors received from the atm. Thus, in order to check if ! there are any points that the atmosphere considers land but CTSM considers ocean, ! it is sufficient to check the points following the typical ending bounds in the ! vectors received from the coupler. @@ -291,7 +291,6 @@ subroutine check_atm_landfrac(importState, bounds, rc) if (atm_landfrac(n) > 0._r8) then write(iulog,*) 'At point ', n, ' atm landfrac = ', atm_landfrac(n) write(iulog,*) 'but CTSM thinks this is ocean.' - write(iulog,*) "Make sure the mask on CTSM's fatmlndfrc file agrees with the atmosphere's land mask" call shr_sys_abort( subname//& ' ERROR: atm landfrac > 0 for a point that CTSM thinks is ocean') end if diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 21745d0ce6..fdab1f7d25 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -9,6 +9,7 @@ module lnd_comp_mct ! !uses: use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg use mct_mod , only : mct_avect, mct_gsmap, mct_gGrid use decompmod , only : bounds_type, ldecomp use lnd_import_export, only : lnd_import, lnd_export @@ -28,6 +29,9 @@ module lnd_comp_mct private :: lnd_domain_mct ! set the land model domain information private :: lnd_handle_resume ! handle pause/resume signals from the coupler + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !==================================================================================== contains !==================================================================================== @@ -44,7 +48,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use clm_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday use clm_initializeMod, only : initialize1, initialize2 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog + use clm_varctl , only : finidat, single_column, clm_varctl_set, iulog use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use controlMod , only : control_setNL @@ -105,6 +109,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) type(bounds_type) :: bounds ! bounds logical :: noland integer :: ni,nj + real(r8) , parameter :: rundef = -9999999._r8 character(len=32), parameter :: sub = 'lnd_init_mct' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" !----------------------------------------------------------------------- @@ -173,6 +178,12 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) start_type=starttype, model_version=version, & hostname=hostname, username=username ) + ! Single Column + if ( single_column .and. (scmlat == rundef .or. scmlon == rundef ) ) then + call endrun(msg=' ERROR:: single column mode on -- but scmlat and scmlon are NOT set'//& + errMsg(sourcefile, __LINE__)) + end if + ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 index 13fa52a6dd..59d4f51bfe 100644 --- a/src/cpl/mct/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -1,8 +1,10 @@ module lnd_set_decomp_and_domain use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use spmdMod , only : masterproc + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, mpicom use clm_varctl , only : iulog + use abortutils , only : endrun use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none @@ -26,28 +28,52 @@ subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) ! Initialize ldecomp and ldomain data types + use shr_nl_mod , only: shr_nl_find_group_name use clm_varpar , only: nlevsoi - use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams + use clm_varctl , only: use_soil_moisture_streams use decompInitMod , only: decompInit_lnd, decompInit_lnd3D use decompMod , only: bounds_type, get_proc_bounds use domainMod , only: ldomain, domain_init, domain_check + use spmdMod , only: MPI_CHARACTER ! input/output variables logical, intent(out) :: noland integer, intent(out) :: ni, nj ! global grid sizes ! local variables - integer ,pointer :: amask(:) ! global land mask - integer :: begg, endg ! processor bounds - type(bounds_type) :: bounds ! bounds + character(len=CL) :: fatmlndfrc = ' ' ! lnd frac file on atm grid + integer ,pointer :: amask(:) ! global land mask + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds ! bounds + integer :: unitn + integer :: ierr character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' !----------------------------------------------------------------------- ! Read in global land grid and land mask (amask)- needed to set decomposition ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below + namelist /clm_lndfrac/ fatmlndfrc + if (masterproc) then - write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) - endif + open( newunit=unitn, file='lnd_in', status='old' ) + call shr_nl_find_group_name(unitn, 'clm_lndfrac', status=ierr) + if (ierr == 0) then + read(unitn, clm_lndfrac, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='ERROR reading clm_lndfrac namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg='ERROR finding clm_lndfrac namelist'//errMsg(sourcefile, __LINE__)) + end if + close(unitn) + if (fatmlndfrc == ' ') then + write(iulog,*) 'fatmlndfrc not set, setting frac/mask to 1' + else + write(iulog,*) 'Land frac data = ',trim(fatmlndfrc) + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + end if + end if + call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ierr) ! Get global mask, ni and nj call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 42a446234e..de7813fcf4 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -76,7 +76,6 @@ module lnd_comp_nuopc real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity - logical :: single_column ! single column mode (nn search of domainfile) logical :: scol_valid ! if single_column, does point have a mask of zero character(len=*) , parameter :: orb_fixed_year = 'fixed_year' @@ -400,7 +399,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (scol_lon > -999. .and. scol_lat > -999.) then - single_column = (trim(single_column_lnd_domainfile) /= 'null') + single_column = (trim(single_column_lnd_domainfile) /= 'UNSET') call NUOPC_CompAttributeGet(gcomp, name='scol_lndmask', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 625b86ae84..eef3168b38 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -116,7 +116,7 @@ subroutine initialize2(ni,nj) use clm_varpar , only : nlevsno use clm_varctl , only : fsurdat use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat - use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_fates + use clm_varctl , only : use_century_decomp, use_cn, use_fates use clm_varctl , only : use_crop, ndep_from_cpl, fates_spitfire_mode use clm_varorb , only : eccen, mvelpp, lambm0, obliqr use landunit_varcon , only : landunit_varcon_init, max_lunit diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 0f50a53b96..e8c210e11c 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -89,8 +89,6 @@ module clm_varctl character(len=fname_len), public :: finidat = ' ' ! initial conditions file name character(len=fname_len), public :: fsurdat = ' ' ! surface data file name - character(len=fname_len), public :: fatmgrid = ' ' ! atm grid file name - character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid character(len=fname_len), public :: paramfile = ' ' ! ASCII data file with PFT physiological constants character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ec22fff5c7..d1d3715f08 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -140,7 +140,7 @@ subroutine control_init(dtime) ! CLM namelist settings namelist /clm_inparm/ & - fatmlndfrc, finidat, nrevsn, & + finidat, nrevsn, & finidat_interp_dest, & use_init_interp, compname @@ -649,7 +649,6 @@ subroutine control_spmd() call mpi_bcast (finidat_interp_source, len(finidat_interp_source), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (finidat_interp_dest, len(finidat_interp_dest), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsurdat, len(fsurdat), MPI_CHARACTER, 0, mpicom, ier) - call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) @@ -892,11 +891,6 @@ subroutine control_print () else write(iulog,*) ' surface data = ',trim(fsurdat) end if - if (fatmlndfrc == ' ') then - write(iulog,*) ' fatmlndfrc not set, setting frac/mask to 1' - else - write(iulog,*) ' land frac data = ',trim(fatmlndfrc) - end if write(iulog,*) ' Number of ACTIVE PFTS (0 means input pft data NOT collapsed to n_dom_pfts) =', n_dom_pfts write(iulog,*) ' Number of ACTIVE LANDUNITS (0 means input landunit data NOT collapsed to n_dom_landunits) =', n_dom_landunits write(iulog,*) ' Collapse urban landunits; done before collapsing all landunits to n_dom_landunits; .false. means do nothing i.e. keep all the urban landunits, though n_dom_landunits may still remove them =', collapse_urban diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index 33c5194423..4a7f8b8c9f 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -125,7 +125,7 @@ subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) dim1name=grlnd, readvar=readvar) if (.not. readvar) call endrun( msg=' ERROR: pftm NOT on surface dataset'//errMsg(sourcefile, __LINE__)) - ! Check if fsurdat grid is "close" to fatmlndfrc grid, exit if lats/lon > 0.001 + ! Cmopare surfdat_domain attributes to ldomain attributes call check_var(ncid=ncid, varname='xc', readvar=readvar) if (readvar) then @@ -173,7 +173,7 @@ subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) rmaxlat = max(rmaxlat,abs(ldomain%latc(n)-surfdata_domain%latc(n))) enddo if (rmaxlon > 0.001_r8 .or. rmaxlat > 0.001_r8) then - write(iulog,*)' ERROR: surfdata/fatmgrid lon/lat mismatch error', rmaxlon,rmaxlat + write(iulog,*)' ERROR: surfdata_domain/ldomain lon/lat mismatch error', rmaxlon,rmaxlat call endrun(msg=errMsg(sourcefile, __LINE__)) end if From 09aeff5b9246485e14ae84e579b3738f421c8164 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 15 Mar 2021 21:34:39 -0600 Subject: [PATCH 140/219] used scol_spval --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index de7813fcf4..d084674598 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -363,6 +363,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(r8) :: scol_area ! single-column area real(r8) :: scol_frac ! single-column frac integer :: scol_mask ! single-column mask + real(r8) :: scol_spval character(len=CL) :: single_column_lnd_domainfile type(ESMF_Field) :: lfield character(CL) ,pointer :: lfieldnamelist(:) => null() @@ -386,7 +387,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! If single_column is true - used single_column_domainfile to ! obtain nearest neighbor values for scol_lon and scol_lat - ! If single_column is false and scol_lon and scol_lat are not equal to -999 then + ! If single_column is false and scol_lon and scol_lat are not equal to scol_spval then ! use scol_lon and scol_lat directly call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) @@ -395,10 +396,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scol_lat + call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_spval call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (scol_lon > -999. .and. scol_lat > -999.) then + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then single_column = (trim(single_column_lnd_domainfile) /= 'UNSET') call NUOPC_CompAttributeGet(gcomp, name='scol_lndmask', value=cvalue, rc=rc) @@ -579,7 +583,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- ! Create ctsm decomp and domain info ! --------------------- - if (scol_lon > -900. .and. scol_lat > -900.) then + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then call lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_mask, scol_frac) if (ChkErr(rc,__LINE__,u_FILE_u)) return else From 4dfbcaaa897fae2f2bc095471ba7d84f6a7a7a84 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 18 Mar 2021 22:04:28 -0600 Subject: [PATCH 141/219] backing out removal of fatmlndfrc from clm_varctl.F90 --- bld/CLMBuildNamelist.pm | 22 +++----- .../namelist_definition_ctsm.xml | 2 +- cime_config/buildnml | 6 +-- src/cpl/mct/lnd_set_decomp_and_domain.F90 | 51 +++---------------- src/main/clm_varctl.F90 | 3 ++ src/main/controlMod.F90 | 8 ++- 6 files changed, 26 insertions(+), 66 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index a345965611..83128f7357 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1781,19 +1781,15 @@ sub setup_logic_lnd_frac { $log->fatal_error("Can NOT set both -lnd_frac option (set via LND_DOMAIN_PATH/LND_DOMAIN_FILE " . "env variables) AND fatmlndfrac on namelist"); } - if ($opts->{$var} ne 'UNSET') { - my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac ); - } + my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac ); } - if ($opts->{$var} ne 'UNSET') { - # Get the fraction file - if (defined $nl->get_value('fatmlndfrc')) { - # do nothing - use value provided by config_grid.xml and clm.cpl7.template - } else { - $log->fatal_error("fatmlndfrc was NOT sent into CLM build-namelist."); - } + # Get the fraction file + if (defined $nl->get_value('fatmlndfrc')) { + # do nothing - use value provided by config_grid.xml and clm.cpl7.template + } else { + $log->fatal_error("fatmlndfrc was NOT sent into CLM build-namelist."); } } @@ -3937,10 +3933,6 @@ sub write_output_files { cnprecision_inparm clm_glacier_behavior crop irrigation_inparm surfacealbedo_inparm water_tracers_inparm); - if ($opts->{'lnd_frac'} ne 'UNSET') { - push @groups, "clm_lndfrac"; - } - #@groups = qw(clm_inparm clm_canopyhydrology_inparm clm_soilhydrology_inparm # finidat_consistency_checks dynpft_consistency_checks); # Eventually only list namelists that are actually used when CN on diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 2d7e4a5d82..9543fbcf6f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -62,7 +62,7 @@ Component name to use in history and restart files type="char*256" category="datasets" input_pathname="abs" - group="clm_lndfrac" + group="clm_inparm" valid_values="" > Full pathname of land fraction data file. diff --git a/cime_config/buildnml b/cime_config/buildnml index 1771e4bf2a..f60206a01d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -61,7 +61,6 @@ def buildnml(case, caseroot, compname): run_reftod = case.get_value("RUN_REFTOD") glc_nec = case.get_value("GLC_NEC") mask = case.get_value("MASK_GRID") - driver = case.get_value("COMP_INTERFACE").lower() # ----------------------------------------------------- # Set ctsmconf @@ -153,10 +152,7 @@ def buildnml(case, caseroot, compname): inputdata_file = os.path.join(caseroot,"Buildconf","ctsm.input_data_list") - if (driver == 'mct'): - lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) - else: - lndfrac_file = 'UNSET' + lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file) config_cache_file = os.path.join(caseroot,"Buildconf", compname+"conf","config_cache.xml") diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 index 59d4f51bfe..0e1dbb9477 100644 --- a/src/cpl/mct/lnd_set_decomp_and_domain.F90 +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -1,10 +1,8 @@ module lnd_set_decomp_and_domain use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl - use shr_log_mod , only : errMsg => shr_log_errMsg - use spmdMod , only : masterproc, mpicom + use spmdMod , only : masterproc use clm_varctl , only : iulog - use abortutils , only : endrun use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none @@ -28,52 +26,28 @@ subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) ! Initialize ldecomp and ldomain data types - use shr_nl_mod , only: shr_nl_find_group_name use clm_varpar , only: nlevsoi - use clm_varctl , only: use_soil_moisture_streams + use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams use decompInitMod , only: decompInit_lnd, decompInit_lnd3D use decompMod , only: bounds_type, get_proc_bounds use domainMod , only: ldomain, domain_init, domain_check - use spmdMod , only: MPI_CHARACTER ! input/output variables logical, intent(out) :: noland integer, intent(out) :: ni, nj ! global grid sizes ! local variables - character(len=CL) :: fatmlndfrc = ' ' ! lnd frac file on atm grid - integer ,pointer :: amask(:) ! global land mask - integer :: begg, endg ! processor bounds - type(bounds_type) :: bounds ! bounds - integer :: unitn - integer :: ierr + integer ,pointer :: amask(:) ! global land mask + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds ! bounds character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' !----------------------------------------------------------------------- ! Read in global land grid and land mask (amask)- needed to set decomposition ! global memory for amask is allocate in surfrd_get_glomask - must be deallocated below - namelist /clm_lndfrac/ fatmlndfrc - if (masterproc) then - open( newunit=unitn, file='lnd_in', status='old' ) - call shr_nl_find_group_name(unitn, 'clm_lndfrac', status=ierr) - if (ierr == 0) then - read(unitn, clm_lndfrac, iostat=ierr) - if (ierr /= 0) then - call endrun(msg='ERROR reading clm_lndfrac namelist'//errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg='ERROR finding clm_lndfrac namelist'//errMsg(sourcefile, __LINE__)) - end if - close(unitn) - if (fatmlndfrc == ' ') then - write(iulog,*) 'fatmlndfrc not set, setting frac/mask to 1' - else - write(iulog,*) 'Land frac data = ',trim(fatmlndfrc) - write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) - end if - end if - call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ierr) + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + endif ! Get global mask, ni and nj call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) @@ -214,8 +188,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) use shr_log_mod , only : errMsg => shr_log_errMsg use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim_size, ncd_inqdid, ncd_inqdlen - use clm_varctl , only : single_column, scmlat, scmlon - use shr_scam_mod , only : shr_scam_getCloseLatLon use pio ! input/output variables @@ -239,10 +211,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) character(len=16) :: vname ! temporary character(len=256) :: locfn ! local file name integer :: n ! indices - integer :: closelatidx - integer :: closelonidx - real(r8) :: closelat - real(r8) :: closelon character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name !----------------------------------------------------------------------- @@ -319,11 +287,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(sourcefile, __LINE__)) end if - if (single_column) then - call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & - closelat, closelon, closelatidx, closelonidx) - end if - call ncd_pio_closefile(ncid) end subroutine surfrd_get_grid diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index e8c210e11c..796fa086fa 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -94,6 +94,9 @@ module clm_varctl character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name + character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid + ! only needed for LILAC and MCT drivers + !---------------------------------------------------------- ! Flag to read ndep rather than obtain it from coupler !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index d1d3715f08..ec22fff5c7 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -140,7 +140,7 @@ subroutine control_init(dtime) ! CLM namelist settings namelist /clm_inparm/ & - finidat, nrevsn, & + fatmlndfrc, finidat, nrevsn, & finidat_interp_dest, & use_init_interp, compname @@ -649,6 +649,7 @@ subroutine control_spmd() call mpi_bcast (finidat_interp_source, len(finidat_interp_source), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (finidat_interp_dest, len(finidat_interp_dest), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsurdat, len(fsurdat), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) @@ -891,6 +892,11 @@ subroutine control_print () else write(iulog,*) ' surface data = ',trim(fsurdat) end if + if (fatmlndfrc == ' ') then + write(iulog,*) ' fatmlndfrc not set, setting frac/mask to 1' + else + write(iulog,*) ' land frac data = ',trim(fatmlndfrc) + end if write(iulog,*) ' Number of ACTIVE PFTS (0 means input pft data NOT collapsed to n_dom_pfts) =', n_dom_pfts write(iulog,*) ' Number of ACTIVE LANDUNITS (0 means input landunit data NOT collapsed to n_dom_landunits) =', n_dom_landunits write(iulog,*) ' Collapse urban landunits; done before collapsing all landunits to n_dom_landunits; .false. means do nothing i.e. keep all the urban landunits, though n_dom_landunits may still remove them =', collapse_urban From 16785fdb489a29a12a553acfa1e8f62154796880 Mon Sep 17 00:00:00 2001 From: negin513 Date: Thu, 18 Mar 2021 22:26:32 -0600 Subject: [PATCH 142/219] adding the files for WRF-CTSM to work with lakes. --- doc/source/lilac/specific-atm-models/wrf.rst | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index f1118973e9..3d2ace80c9 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -37,9 +37,9 @@ Clone WRF and CTSM Repositories Clone the WRF repository and checkout ``develop`` branch:: - git clone https://github.com/wrf-model/WRF.git WRF-CTSM + git clone https://github.com/negin513/WRF-1.git WRF-CTSM cd WRF-CTSM - git checkout develop + git checkout wrf_ctsm_pr2 Clone the CTSM repository:: @@ -322,10 +322,18 @@ The following is the recommended CTSM options to run WRF:: In ``ctsm.cfg`` you should specify CTSM domain file, surface dataset and finidat file. For this example (US domain), you can use the following settings:: - lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc - fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc + lnd_domain_file = /glade/work/slevis/git_wrf/ctsm_domain/domain.lnd.wrf2clm_lnd_noneg_wrf2clm_ocn_noneg.201117.nc + fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c210119.nc finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc +File ``user_nl_ctsm`` allows you to override individual CTSM namelist variables +and set any extra namelist items you would like to appear in your ``lnd_in``. +For this example, we recommend adding the following options in +``user_nl_ctsm``:: + + use_init_interp = .true. + init_interp_fill_missing_with_natveg = .true. + Run the script ``make_runtime_inputs`` to create ``lnd_in`` and ``clm.input_data_list``:: @@ -333,8 +341,8 @@ Run the script ``make_runtime_inputs`` to create ``lnd_in`` and Modify ``lilac_in`` as needed. For this example, you can use the following options:: - atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + atm_mesh_filename = '/glade/scratch/negins/wrf_ctsm_files/wrf2ctsm_land_conus_ESMFMesh_c20201110.nc' + lnd_mesh_filename = '/glade/scratch/negins/wrf_ctsm_files/wrf2ctsm_land_conus_ESMFMesh_c20201110.nc' Run ``download_input_data`` script to download any of CTSM's standard input From 5508d28cb8bbfd610e1b70ff552b205462417f28 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Mar 2021 11:20:25 -0600 Subject: [PATCH 143/219] bug fix for setting single_column flag --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index d084674598..861598e0d5 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -453,6 +453,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(iulog,'(a,3(f10.5,2x))')' single column mode scol_lon/scol_lat/scol_frac is ',& scol_lon,scol_lat,scol_frac end if + else + single_column = .false. end if !---------------------------------------------------------------------------- From c325a32f7051cc6f794082fde348b116c6f9e35a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Mar 2021 11:34:22 -0600 Subject: [PATCH 144/219] updated the Externals needed for this PR --- Externals.cfg | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 617adb644f..bde774bba3 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -33,25 +33,26 @@ repo_url = https://github.com/nmizukami/mizuRoute hash = 34723c2 required = True +# Note that this is a hash off of cime master that is required [cime] local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.37_a02 +hash = 0cd2268d5 required = True [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -hash = c4acaa8 +tag = v0.2.0 required = True [cdeps] local_path = components/cdeps protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git -hash = 1f02a73 +tag = v0.1.0 required = True [doc-builder] From 3cddb0c6fc5f34e7dcc85da92b2b02d1f22f42ca Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Mar 2021 16:20:29 -0600 Subject: [PATCH 145/219] run_sys_tests: Add --retry option to create_newcase This defaults to 1 for izumi, 0 for other machines. It can be overridden with a new --retry flag to run_sys_tests --- python/ctsm/machine.py | 34 +++++++++++++-------- python/ctsm/machine_defaults.py | 7 +++++ python/ctsm/run_sys_tests.py | 29 ++++++++++++++---- python/ctsm/test/test_unit_machine.py | 33 +++++++++++++------- python/ctsm/test/test_unit_run_sys_tests.py | 7 +++-- 5 files changed, 78 insertions(+), 32 deletions(-) diff --git a/python/ctsm/machine.py b/python/ctsm/machine.py index 6065f54716..67613053a9 100644 --- a/python/ctsm/machine.py +++ b/python/ctsm/machine.py @@ -23,11 +23,12 @@ # user of the machine object to check for that possibility if need be. # # Similar notes apply to baseline_dir. -Machine = namedtuple('Machine', ['name', # str - 'scratch_dir', # str - 'baseline_dir', # str - 'account', # str or None - 'job_launcher']) # subclass of JobLauncherBase +Machine = namedtuple('Machine', ['name', # str + 'scratch_dir', # str + 'baseline_dir', # str + 'account', # str or None + 'create_test_retry', # int + 'job_launcher']) # subclass of JobLauncherBase def create_machine(machine_name, defaults, job_launcher_type=None, scratch_dir=None, account=None, @@ -78,6 +79,7 @@ def create_machine(machine_name, defaults, job_launcher_type=None, mach_defaults = defaults.get(machine_name) baseline_dir = None + create_test_retry = 0 if mach_defaults is not None: if job_launcher_type is None: job_launcher_type = mach_defaults.job_launcher_type @@ -93,6 +95,10 @@ def create_machine(machine_name, defaults, job_launcher_type=None, # generation and comparison, or making a link in some temporary location that # points to the standard baselines). baseline_dir = mach_defaults.baseline_dir + # We also don't provide a way to override the default create_test_retry in the + # machine object: this will always give the default value for this machine, and + # other mechanisms will be given for overriding this in a particular case. + create_test_retry = mach_defaults.create_test_retry if account is None and mach_defaults.account_required and not allow_missing_entries: raise RuntimeError("Could not find an account code") else: @@ -142,21 +148,23 @@ def create_machine(machine_name, defaults, job_launcher_type=None, scratch_dir=scratch_dir, baseline_dir=baseline_dir, account=account, + create_test_retry=create_test_retry, job_launcher=job_launcher) -def get_possibly_overridden_baseline_dir(machine, baseline_dir=None): - """Get the baseline directory to use here, or None +def get_possibly_overridden_mach_value(machine, varname, value=None): + """Get the value to use for the given machine variable - If baseline_dir is provided (not None), use that. Otherwise use the baseline directory - from machine (which may be None). + If value is provided (not None), use that. Otherwise use the value of the given + variable from the provided machine object. Args: machine (Machine) - baseline_dir (str or None): gives the overriding baseline directory to use + varname (str): name of variable to get from the machine object + value: if not None, use this instead of fetching from the machine object """ - if baseline_dir is not None: - return baseline_dir - return machine.baseline_dir + if value is not None: + return value + return getattr(machine, varname) def _get_account(): account = get_project() diff --git a/python/ctsm/machine_defaults.py b/python/ctsm/machine_defaults.py index 78b6062f50..637845d7eb 100644 --- a/python/ctsm/machine_defaults.py +++ b/python/ctsm/machine_defaults.py @@ -12,6 +12,7 @@ 'scratch_dir', 'baseline_dir', 'account_required', + 'create_test_retry', 'job_launcher_defaults']) # job_launcher_type: one of the JOB_LAUNCHERs defined in job_launcher_factory # scratch_dir: str @@ -21,6 +22,7 @@ # have 0, 1 or multiple job_launcher_defaults. (It can be useful to have defaults even # for the non-default job launcher for this machine, in case the user chooses a # non-default launcher.) +# create_test_retry: int: Default number of times to retry a create_test job on this machine # account_required: bool: whether an account number is required on this machine (not # really a default, but used for error-checking) @@ -40,6 +42,7 @@ scratch_dir=os.path.join(os.path.sep, 'glade', 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'glade', 'p', 'cgd', 'tss', 'ctsm_baselines'), account_required=True, + create_test_retry=0, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='regular', @@ -56,6 +59,7 @@ scratch_dir=os.path.join(os.path.sep, 'scratch', 'cluster', get_user()), baseline_dir=os.path.join(os.path.sep, 'fs', 'cgd', 'csm', 'ccsm_baselines'), account_required=False, + create_test_retry=0, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='medium', @@ -68,6 +72,9 @@ scratch_dir=os.path.join(os.path.sep, 'scratch', 'cluster', get_user()), baseline_dir=os.path.join(os.path.sep, 'fs', 'cgd', 'csm', 'ccsm_baselines'), account_required=False, + # jobs on izumi experience a high frequency of failures, often at the very end of + # the job; so we'll automatically retry a failed job once before giving up on it + create_test_retry=1, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='medium', diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 7d5d0a2e94..2299eb472e 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -10,7 +10,7 @@ from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.machine_utils import get_machine_name -from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir +from ctsm.machine import create_machine, get_possibly_overridden_mach_value from ctsm.machine_defaults import MACHINE_DEFAULTS from ctsm.os_utils import make_link from ctsm.path_utils import path_to_ctsm_root @@ -72,6 +72,7 @@ def main(cime_path): compare_name=args.compare, generate_name=args.generate, baseline_root=args.baseline_root, walltime=args.walltime, queue=args.queue, + retry=args.retry, extra_create_test_args=args.extra_create_test_args) def run_sys_tests(machine, cime_path, @@ -85,6 +86,7 @@ def run_sys_tests(machine, cime_path, compare_name=None, generate_name=None, baseline_root=None, walltime=None, queue=None, + retry=None, extra_create_test_args=''): """Implementation of run_sys_tests command @@ -119,6 +121,8 @@ def run_sys_tests(machine, cime_path, determine it automatically) queue (str): queue to use for each test (if not provided, the test suite will determine it automatically) + retry (int): retry value to pass to create_test (if not provided, will use the default + for this machine) extra_create_test_args (str): any extra arguments to create_test, as a single, space-delimited string testlist: list of strings giving test names to run @@ -137,17 +141,22 @@ def run_sys_tests(machine, cime_path, if not (skip_testroot_creation or rerun_existing_failures): _make_testroot(testroot, testid_base, dry_run) print("Testroot: {}\n".format(testroot)) + retry_final = get_possibly_overridden_mach_value(machine, + varname='create_test_retry', + value=retry) if not skip_git_status: - _record_git_status(testroot, dry_run) + _record_git_status(testroot, retry_final, dry_run) - baseline_root_final = get_possibly_overridden_baseline_dir(machine, - baseline_dir=baseline_root) + baseline_root_final = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=baseline_root) create_test_args = _get_create_test_args(compare_name=compare_name, generate_name=generate_name, baseline_root=baseline_root_final, account=machine.account, walltime=walltime, queue=queue, + retry=retry_final, rerun_existing_failures=rerun_existing_failures, extra_create_test_args=extra_create_test_args) if suite_name: @@ -298,6 +307,11 @@ def _commandline_args(): help='Queue to which tests are submitted.\n' 'If not provided, uses machine default.') + parser.add_argument('--retry', + help='Argument to create_test: Number of times to retry failed tests.\n' + 'Default for this machine: {}'.format( + default_machine.create_test_retry)) + parser.add_argument('--extra-create-test-args', default='', help='String giving extra arguments to pass to create_test\n' '(To allow the argument parsing to accept this, enclose the string\n' @@ -396,11 +410,13 @@ def _make_testroot(testroot, testid_base, dry_run): os.makedirs(testroot) make_link(testroot, _get_testdir_name(testid_base)) -def _record_git_status(testroot, dry_run): +def _record_git_status(testroot, retry, dry_run): """Record git status and related information to stdout and a file""" output = '' ctsm_root = path_to_ctsm_root() + output += "create_test --retry: {}\n\n".format(retry) + current_hash = subprocess.check_output(['git', 'show', '--no-patch', '--format=format:%h (%an, %ad) %s\n', 'HEAD'], cwd=ctsm_root, @@ -440,7 +456,7 @@ def _record_git_status(testroot, dry_run): git_status_file.write(output) def _get_create_test_args(compare_name, generate_name, baseline_root, - account, walltime, queue, + account, walltime, queue, retry, rerun_existing_failures, extra_create_test_args): args = [] @@ -456,6 +472,7 @@ def _get_create_test_args(compare_name, generate_name, baseline_root, args.extend(['--walltime', walltime]) if queue: args.extend(['--queue', queue]) + args.extend(['--retry', str(retry)]) if rerun_existing_failures: # In addition to --use-existing, we also need --allow-baseline-overwrite in this # case; otherwise, create_test throws an error saying that the baseline diff --git a/python/ctsm/test/test_unit_machine.py b/python/ctsm/test/test_unit_machine.py index 2712ffafc7..65cd73620e 100755 --- a/python/ctsm/test/test_unit_machine.py +++ b/python/ctsm/test/test_unit_machine.py @@ -9,7 +9,7 @@ from ctsm import add_cime_to_path # pylint: disable=unused-import from ctsm import unit_testing -from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir +from ctsm.machine import create_machine, get_possibly_overridden_mach_value from ctsm.machine_utils import get_user from ctsm.machine_defaults import MACHINE_DEFAULTS, MachineDefaults, QsubDefaults from ctsm.joblauncher.job_launcher_no_batch import JobLauncherNoBatch @@ -23,7 +23,8 @@ class TestCreateMachine(unittest.TestCase): """Tests of create_machine""" - def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account): + def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account, + create_test_retry=0): """Asserts that the basic machine info is as expected. This does NOT dive down into the job launcher""" @@ -31,6 +32,7 @@ def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account): self.assertEqual(machine.scratch_dir, scratch_dir) self.assertEqual(machine.baseline_dir, baseline_dir) self.assertEqual(machine.account, account) + self.assertEqual(machine.create_test_retry, create_test_retry) def assertNoBatchInfo(self, machine, nice_level=None): """Asserts that the machine's launcher is of type JobLauncherNoBatch""" @@ -62,6 +64,7 @@ def create_defaults(default_job_launcher=JOB_LAUNCHER_QSUB): scratch_dir=os.path.join(os.path.sep, 'glade', 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), account_required=True, + create_test_retry=2, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='regular', @@ -130,7 +133,8 @@ def test_knownMachine_defaults(self): 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), - account='a123') + account='a123', + create_test_retry=2) self.assertQsubInfo(machine=machine, queue='regular', walltime='06:00:00', @@ -152,7 +156,8 @@ def test_knownMachine_argsExplicit(self): name='cheyenne', scratch_dir='/custom/path/to/scratch', baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), - account='a123') + account='a123', + create_test_retry=2) self.assertQsubInfo(machine=machine, queue='custom_queue', walltime='9:87:65', @@ -161,29 +166,35 @@ def test_knownMachine_argsExplicit(self): extra_args='--custom args') # ------------------------------------------------------------------------ - # Tests of get_possibly_overridden_baseline_dir + # Tests of get_possibly_overridden_mach_value # ------------------------------------------------------------------------ def test_baselineDir_overridden(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is provided""" + """Tests get_possibly_overridden_mach_value when baseline_dir is provided""" defaults = self.create_defaults() machine = create_machine('cheyenne', defaults, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir='mypath') + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value='mypath') self.assertEqual(baseline_dir, 'mypath') def test_baselineDir_default(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is not provided""" + """Tests get_possibly_overridden_mach_value when baseline_dir is not provided""" defaults = self.create_defaults() machine = create_machine('cheyenne', defaults, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir=None) + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=None) self.assertEqual(baseline_dir, os.path.join(os.path.sep, 'my', 'baselines')) def test_baselineDir_noDefault(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is not provided + """Tests get_possibly_overridden_mach_value when baseline_dir is not provided and there is no default""" machine = create_machine('unknown_test_machine', MACHINE_DEFAULTS, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir=None) + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=None) self.assertIsNone(baseline_dir) if __name__ == '__main__': diff --git a/python/ctsm/test/test_unit_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py index 316fd40a2d..78ab02a648 100755 --- a/python/ctsm/test/test_unit_run_sys_tests.py +++ b/python/ctsm/test/test_unit_run_sys_tests.py @@ -100,8 +100,8 @@ def test_createTestCommand_testnames(self): (1) The use of a testlist argument (2) The standard arguments to create_test (the path to create_test, the arguments - --test-id and --output-root, the absence of --compare and --generate, and (on this - unknown machine) the absence of --baseline-root) + --test-id, --output-root and --retry, the absence of --compare and --generate, and + (on this unknown machine) the absence of --baseline-root) (3) That a cs.status.fails file was created """ @@ -119,6 +119,7 @@ def test_createTestCommand_testnames(self): six.assertRegex(self, command, r'--test-id +{}\s'.format(self._expected_testid())) expected_testroot_path = os.path.join(self._scratch, self._expected_testroot()) six.assertRegex(self, command, r'--output-root +{}\s'.format(expected_testroot_path)) + six.assertRegex(self, command, r'--retry +0(\s|$)') six.assertRegex(self, command, r'test1 +test2(\s|$)') assertNotRegex(self, command, r'--compare\s') assertNotRegex(self, command, r'--generate\s') @@ -151,6 +152,7 @@ def test_createTestCommand_testfileAndExtraArgs(self): baseline_root='myblroot', walltime='3:45:67', queue='runqueue', + retry=5, extra_create_test_args='--some extra --createtest args') all_commands = machine.job_launcher.get_commands() @@ -166,6 +168,7 @@ def test_createTestCommand_testfileAndExtraArgs(self): six.assertRegex(self, command, r'--walltime +3:45:67(\s|$)') six.assertRegex(self, command, r'--queue +runqueue(\s|$)') six.assertRegex(self, command, r'--project +myaccount(\s|$)') + six.assertRegex(self, command, r'--retry +5(\s|$)') six.assertRegex(self, command, r'--some +extra +--createtest +args(\s|$)') expected_cs_status = os.path.join(expected_testroot, From 793ca464314ba41d633f28afde66c5c5a9df87ed Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Mar 2021 16:43:10 -0600 Subject: [PATCH 146/219] Fix pylint errors These were pre-existing errors. I'm thinking they're showing up now because I have a new version of pylint. --- python/ctsm/lilac_build_ctsm.py | 4 ++-- python/ctsm/lilac_download_input_data.py | 4 ++-- python/ctsm/lilac_make_runtime_inputs.py | 4 ++-- python/ctsm/machine.py | 2 +- python/ctsm/run_sys_tests.py | 6 +++--- python/ctsm/utils.py | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index c44ad6831e..888008897a 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -473,8 +473,8 @@ def _check_and_transform_os(os_type): 'cnl': 'CNL'} try: os_type_transformed = transforms[os_type] - except KeyError: - raise ValueError("Unknown OS: {}".format(os_type)) + except KeyError as exc: + raise ValueError("Unknown OS: {}".format(os_type)) from exc return os_type_transformed def _get_case_dir(build_dir): diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py index 1e0c240d25..dffc78150a 100644 --- a/python/ctsm/lilac_download_input_data.py +++ b/python/ctsm/lilac_download_input_data.py @@ -5,10 +5,10 @@ import os import re -from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args - from CIME.case import Case # pylint: disable=import-error +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args + logger = logging.getLogger(__name__) # ======================================================================== diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index 5b9a4e1f76..2119c0e225 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -8,12 +8,12 @@ from configparser import ConfigParser from configparser import NoSectionError, NoOptionError +from CIME.buildnml import create_namelist_infile # pylint: disable=import-error + from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.path_utils import path_to_ctsm_root from ctsm.utils import abort -from CIME.buildnml import create_namelist_infile # pylint: disable=import-error - logger = logging.getLogger(__name__) # ======================================================================== diff --git a/python/ctsm/machine.py b/python/ctsm/machine.py index 67613053a9..36e5c61788 100644 --- a/python/ctsm/machine.py +++ b/python/ctsm/machine.py @@ -3,9 +3,9 @@ import logging from collections import namedtuple +from CIME.utils import get_project # pylint: disable=import-error from ctsm.joblauncher.job_launcher_factory import \ create_job_launcher, JOB_LAUNCHER_NOBATCH -from CIME.utils import get_project # pylint: disable=import-error logger = logging.getLogger(__name__) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 2299eb472e..8bfe006cae 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -8,6 +8,9 @@ import subprocess from datetime import datetime +from CIME.test_utils import get_tests_from_xml # pylint: disable=import-error +from CIME.cs_status_creator import create_cs_status # pylint: disable=import-error + from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.machine_utils import get_machine_name from ctsm.machine import create_machine, get_possibly_overridden_mach_value @@ -16,9 +19,6 @@ from ctsm.path_utils import path_to_ctsm_root from ctsm.joblauncher.job_launcher_factory import JOB_LAUNCHER_NOBATCH -from CIME.test_utils import get_tests_from_xml # pylint: disable=import-error -from CIME.cs_status_creator import create_cs_status # pylint: disable=import-error - logger = logging.getLogger(__name__) # Number of initial characters from the compiler name to use in a testid diff --git a/python/ctsm/utils.py b/python/ctsm/utils.py index 09a08ff9af..44cce0cccf 100644 --- a/python/ctsm/utils.py +++ b/python/ctsm/utils.py @@ -3,6 +3,7 @@ import logging import sys import string +import pdb logger = logging.getLogger(__name__) @@ -12,7 +13,6 @@ def abort(errmsg): No traceback is given, but if the logging level is DEBUG, then we'll enter pdb """ if logger.isEnabledFor(logging.DEBUG): - import pdb pdb.set_trace() sys.exit('ERROR: {}'.format(errmsg)) From 853dc06861ea382ec34482d7f81e169f6d9249c0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 19 Mar 2021 16:50:26 -0600 Subject: [PATCH 147/219] Give type of retry argument --- python/ctsm/run_sys_tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 8bfe006cae..f72d1863cf 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -307,7 +307,7 @@ def _commandline_args(): help='Queue to which tests are submitted.\n' 'If not provided, uses machine default.') - parser.add_argument('--retry', + parser.add_argument('--retry', type=int, help='Argument to create_test: Number of times to retry failed tests.\n' 'Default for this machine: {}'.format( default_machine.create_test_retry)) From 3ac4305770eed954c4aab192840007a6e76f02db Mon Sep 17 00:00:00 2001 From: negin513 Date: Fri, 19 Mar 2021 22:59:43 -0600 Subject: [PATCH 148/219] pointing to wrf/develop in WRF-CTSM docs --- doc/source/lilac/specific-atm-models/wrf.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index 3d2ace80c9..d34dd66d0b 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -37,9 +37,9 @@ Clone WRF and CTSM Repositories Clone the WRF repository and checkout ``develop`` branch:: - git clone https://github.com/negin513/WRF-1.git WRF-CTSM + git clone https://github.com/wrf-model/WRF.git WRF-CTSM cd WRF-CTSM - git checkout wrf_ctsm_pr2 + git checkout develop Clone the CTSM repository:: From b8b4e703dc78095c6e53930c67a890b48f211bdf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Mar 2021 19:00:31 -0600 Subject: [PATCH 149/219] reintroduced nag fixes that were mistakenly deleted as part of this PR --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 861598e0d5..89874d332e 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -283,11 +283,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(iulog,'(a )')' atm component = '//trim(atm_model) write(iulog,'(a )')' rof component = '//trim(rof_model) write(iulog,'(a )')' glc component = '//trim(glc_model) - write(iulog,'(a,l )')' atm_prognostic = ',atm_prognostic - write(iulog,'(a,l )')' rof_prognostic = ',rof_prognostic - write(iulog,'(a,l )')' glc_present = ',glc_present + write(iulog,'(a,L1 )')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,L1 )')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,L1 )')' glc_present = ',glc_present if (glc_present) then - write(iulog,'(a,l)')' cism_evolve = ',cism_evolve + write(iulog,'(a,L1)')' cism_evolve = ',cism_evolve end if write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num From 6b3599b613913724558787e18c721d0f6c1bfb89 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 20 Mar 2021 19:03:57 -0600 Subject: [PATCH 150/219] reintroduced nag fixes that were mistakenly deleted as part of this PR --- src/cpl/nuopc/lnd_import_export.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index e84d267e1f..c5f56a3fbd 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -218,11 +218,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. if (masterproc) then - write(iulog,'(a,l)') 'flds_co2a= ',flds_co2a - write(iulog,'(a,l)') 'flds_co2b= ',flds_co2b - write(iulog,'(a,l)') 'flds_co2c= ',flds_co2c - write(iulog,'(a,l)') 'sending co2 to atm = ',send_co2_to_atm - write(iulog,'(a,l)') 'receiving co2 from atm = ',recv_co2_fr_atm + write(iulog,'(a,L1)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,L1)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,L1)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,L1)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,L1)') 'receiving co2 from atm = ',recv_co2_fr_atm end if end if From b85a4910a3e1374bd536500231eb0505210b6962 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 25 Mar 2021 11:50:36 -0600 Subject: [PATCH 151/219] Go back to L2 for logical display like before, and line write statements up, remove unneeded declaration of esmf_calander as this caused a problem on NAG on izumi --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 9 ++++----- src/cpl/nuopc/lnd_import_export.F90 | 10 +++++----- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 89874d332e..465421712b 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -283,11 +283,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(iulog,'(a )')' atm component = '//trim(atm_model) write(iulog,'(a )')' rof component = '//trim(rof_model) write(iulog,'(a )')' glc component = '//trim(glc_model) - write(iulog,'(a,L1 )')' atm_prognostic = ',atm_prognostic - write(iulog,'(a,L1 )')' rof_prognostic = ',rof_prognostic - write(iulog,'(a,L1 )')' glc_present = ',glc_present + write(iulog,'(a,L2)')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,L2)')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,L2)')' glc_present = ',glc_present if (glc_present) then - write(iulog,'(a,L1)')' cism_evolve = ',cism_evolve + write(iulog,'(a,L2)')' cism_evolve = ',cism_evolve end if write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num @@ -333,7 +333,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type integer :: ref_ymd ! reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (sec) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index c5f56a3fbd..170212db03 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -218,11 +218,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. if (masterproc) then - write(iulog,'(a,L1)') 'flds_co2a= ',flds_co2a - write(iulog,'(a,L1)') 'flds_co2b= ',flds_co2b - write(iulog,'(a,L1)') 'flds_co2c= ',flds_co2c - write(iulog,'(a,L1)') 'sending co2 to atm = ',send_co2_to_atm - write(iulog,'(a,L1)') 'receiving co2 from atm = ',recv_co2_fr_atm + write(iulog,'(a,L2)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,L2)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,L2)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,L2)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,L2)') 'receiving co2 from atm = ',recv_co2_fr_atm end if end if From 70e8d43118e140baf08518d13bd91ab380ade12f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Mar 2021 20:08:55 -0600 Subject: [PATCH 152/219] updates to cime and cdeps --- Externals.cfg | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index bde774bba3..bdcc2415b7 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -33,12 +33,12 @@ repo_url = https://github.com/nmizukami/mizuRoute hash = 34723c2 required = True -# Note that this is a hash off of cime master that is required +# Note that this is a hash off of cime master that is required [cime] local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -hash = 0cd2268d5 +hash = 4d16c5b91 required = True [cmeps] @@ -52,7 +52,7 @@ required = True local_path = components/cdeps protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git -tag = v0.1.0 +tag = v0.3.0 required = True [doc-builder] @@ -64,4 +64,3 @@ required = False [externals_description] schema_version = 1.0.0 - From e8f3f9cc03334a1aedb91aaee4441877763d806a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Mar 2021 21:20:04 -0600 Subject: [PATCH 153/219] work around for accessing component attribute scol_spval --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index 89874d332e..39b00133b5 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -396,12 +396,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scol_lat - call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_spval call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: there is a problem retrieving scol_spval from the driver - for now + ! hard-wire scol_spval - this needs to be fixed + scol_spval = -999._r8 + ! call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) scol_spval + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then single_column = (trim(single_column_lnd_domainfile) /= 'UNSET') From 2fa1a36998ec5670803f568f4b7cbffc0ab93f85 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Mar 2021 21:23:57 -0600 Subject: [PATCH 154/219] introduction of branch in cime for single column bug fixes --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index bdcc2415b7..33fab29a0e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -33,12 +33,12 @@ repo_url = https://github.com/nmizukami/mizuRoute hash = 34723c2 required = True -# Note that this is a hash off of cime master that is required +# Note that this a branch mvertens/scol_bugfix - needs a PR to master [cime] local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -hash = 4d16c5b91 +hash = ce458952e required = True [cmeps] From 5d0c1eb0fc60c73b3d343da90668786806113e43 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Mar 2021 13:31:19 -0600 Subject: [PATCH 155/219] Add izumi_pgi nuopc tests to expected fail, because of ESMF build issue --- cime_config/testdefs/ExpectedTestFails.xml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 1147fb7bc3..73e0b564e6 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -88,6 +88,20 @@ + + + FAIL + ESMCI/cime#3496 + + + + + + FAIL + ESMCI/cime#3496 + + + FAIL From 56e44598e4869ea437b06b142ad557f2842080a3 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Mar 2021 16:32:59 -0600 Subject: [PATCH 156/219] Add nuopc tests Resolves ESCOMP/CTSM#1312 --- cime_config/testdefs/testlist_clm.xml | 114 +++++++++++++++++++++++--- 1 file changed, 104 insertions(+), 10 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index c7371650a0..f4a74134c2 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -139,6 +139,16 @@ + + + + + + + + + + @@ -164,6 +174,15 @@ + + + + + + + + + @@ -190,6 +209,15 @@ + + + + + + + + + @@ -470,6 +498,15 @@ + + + + + + + + + @@ -583,6 +620,16 @@ + + + + + + + + + + @@ -988,6 +1035,16 @@ + + + + + + + + + + @@ -1220,6 +1277,15 @@ + + + + + + + + + @@ -1490,6 +1556,16 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + + @@ -1516,6 +1592,15 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + @@ -1554,6 +1639,16 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + + @@ -1929,6 +2024,15 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + @@ -2380,16 +2484,6 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - - - - - - - - - - From 0ec6051a22ee78fa980984ea6c68af7e2ce5191f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Mar 2021 16:58:38 -0600 Subject: [PATCH 157/219] Point to a cime tag rather than a hash --- Externals.cfg | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 33fab29a0e..ad3651d1e2 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -33,12 +33,11 @@ repo_url = https://github.com/nmizukami/mizuRoute hash = 34723c2 required = True -# Note that this a branch mvertens/scol_bugfix - needs a PR to master [cime] local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -hash = ce458952e +tag = cime5.8.39 required = True [cmeps] From f9772679c5dcf4a507c45fc15319a1d547ec5e3a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 27 Mar 2021 10:05:22 -0600 Subject: [PATCH 158/219] fixed call to get localpecount --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index a9402b6517..fc370905c1 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -739,6 +739,11 @@ subroutine ModelAdvance(gcomp, rc) ! Reset share log units !-------------------------------- + call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !$ call omp_set_num_threads(localPeCount) call shr_file_getLogUnit (shrlogunit) @@ -755,11 +760,6 @@ subroutine ModelAdvance(gcomp, rc) ! Query the Component for its clock, importState and exportState and vm !-------------------------------- - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From ac0d391dc5c3b740bd5e0b0c5fd978bb7d735dea Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 27 Mar 2021 13:53:40 -0600 Subject: [PATCH 159/219] cmeps branch that fixes nag tests --- Externals.cfg | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index ad3651d1e2..32ed2a3802 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -40,11 +40,12 @@ repo_url = https://github.com/ESMCI/cime tag = cime5.8.39 required = True +# cmeps branch mvertens/cesm_bugfix which has a PR to master [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -tag = v0.2.0 +hash = b437148 required = True [cdeps] From fe910f4958235dd9c35cde36343db228c40417e1 Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 27 Mar 2021 14:11:35 -0600 Subject: [PATCH 160/219] updated cmeps to new tag on master --- Externals.cfg | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 32ed2a3802..6f5fa903a3 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -40,12 +40,11 @@ repo_url = https://github.com/ESMCI/cime tag = cime5.8.39 required = True -# cmeps branch mvertens/cesm_bugfix which has a PR to master [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -hash = b437148 +tag = v0.5.0 required = True [cdeps] From ec4a4d8b2d5f8d3bc6f246691b7c9419ce889cef Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 29 Mar 2021 15:08:06 -0600 Subject: [PATCH 161/219] Add comments about new variables added --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index fc370905c1..bea9ed37d8 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -171,7 +171,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lmpicom integer :: ierr integer :: n - integer :: localpet + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) integer :: compid ! component id integer :: shrlogunit ! original log unit character(len=CL) :: cvalue @@ -328,7 +328,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! Virtual machine, description of parallel procesors being used (both MPI and OpenMP) type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: refTime ! Ref time @@ -342,8 +342,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: curr_ymd ! Start date (YYYYMMDD) integer :: curr_tod ! Start time of day (sec) integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: localPet - integer :: localpecount + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) + integer :: localPeCount ! Number of local Processors real(r8) :: nextsw_cday ! calday from clock of next radiation computation character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) character(len=CL) :: calendar ! calendar type name @@ -352,9 +352,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! original log unit type(bounds_type) :: bounds ! bounds - integer :: n, ni, nj + integer :: n, ni, nj ! Indices character(len=CL) :: cvalue ! config data - character(len=CL) :: meshfile_mask + character(len=CL) :: meshfile_mask ! filename of mesh file with land mask character(len=CL) :: ctitle ! case description title character(len=CL) :: caseid ! case identifier name real(r8) :: scol_lat ! single-column latitude @@ -362,14 +362,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(r8) :: scol_area ! single-column area real(r8) :: scol_frac ! single-column frac integer :: scol_mask ! single-column mask - real(r8) :: scol_spval - character(len=CL) :: single_column_lnd_domainfile - type(ESMF_Field) :: lfield - character(CL) ,pointer :: lfieldnamelist(:) => null() - integer :: fieldCount - integer :: rank - real(r8), pointer :: fldptr1d(:) - real(r8), pointer :: fldptr2d(:,:) + real(r8) :: scol_spval ! single-column special value to indicate it isn't set + character(len=CL) :: single_column_lnd_domainfile ! domain filename to use for single-column mode (i.e. SCAM) + type(ESMF_Field) :: lfield ! Land field read in + character(CL) ,pointer :: lfieldnamelist(:) => null() ! Land field namelist item sent with land field + integer :: fieldCount ! Number of fields on export state + integer :: rank ! Rank of field (1D or 2D) + real(r8), pointer :: fldptr1d(:) ! 1D field pointer + real(r8), pointer :: fldptr2d(:,:) ! 2D field pointer character(len=CL) :: model_version ! Model version character(len=CL) :: hostname ! hostname of machine running on character(len=CL) :: username ! user running the model @@ -704,8 +704,8 @@ subroutine ModelAdvance(gcomp, rc) integer :: tod_sync ! Sync current time of day (sec) integer :: dtime ! time step increment (sec) integer :: nstep ! time step index - integer :: localPet - integer :: localpecount + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) + integer :: localPeCount ! Number of local Processors logical :: rstwr ! .true. ==> write restart file before returning logical :: nlend ! .true. ==> last time-step logical :: dosend ! true => send data back to driver From 21e6ec93af788497d73f66da6b4179967b895fe3 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 16:00:54 -0600 Subject: [PATCH 162/219] Point to CDEPS branch with fixed meshfile names --- Externals.cfg | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 6f5fa903a3..a712dc2f70 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -50,8 +50,9 @@ required = True [cdeps] local_path = components/cdeps protocol = git -repo_url = https://github.com/ESCOMP/CDEPS.git -tag = v0.3.0 +repo_url = https://github.com/ekluzek/CDEPS.git +branch = cdf5files +#tag = v0.3.0 required = True [doc-builder] From f3a46685fa4bd4e5964a776c593ff4ed3824feda Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 16:23:49 -0600 Subject: [PATCH 163/219] Add two expected fails --- cime_config/testdefs/ExpectedTestFails.xml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 73e0b564e6..73fb8deafc 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -102,6 +102,20 @@ + + + FAIL + #1317 + + + + + + FAIL + #1317 + + + FAIL From 456ca81efb9a5ac11c8a4f3fb4a7a33b47881ab2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 22:09:25 -0600 Subject: [PATCH 164/219] Point to latest CDEPS version --- Externals.cfg | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index a712dc2f70..23e4b8d54f 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -50,9 +50,8 @@ required = True [cdeps] local_path = components/cdeps protocol = git -repo_url = https://github.com/ekluzek/CDEPS.git -branch = cdf5files -#tag = v0.3.0 +repo_url = https://github.com/ESCOMP/CDEPS.git +tag = v0.5.0 required = True [doc-builder] From c06a97d637a1e8237e9aa4f3baea093c03e11760 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 22:10:42 -0600 Subject: [PATCH 165/219] Change CAM tests from 12 step back to 9 step, just to match the CAM version of the tests, and set ROF_NCPL to ATM_NCPL as is done in the CAM tests --- cime_config/testdefs/testlist_clm.xml | 30 +++++++++---------- .../clm/clm50cam6LndTuningMode/shell_commands | 1 + .../clm/waccmx_offline/shell_commands | 1 + 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index f4a74134c2..626b0dc689 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -55,7 +55,7 @@ - + @@ -191,7 +191,7 @@ - + @@ -200,7 +200,7 @@ - + @@ -209,7 +209,7 @@ - + @@ -330,7 +330,7 @@ - + @@ -1062,13 +1062,13 @@ - + - + @@ -1414,17 +1414,17 @@ - + - + - + @@ -1433,7 +1433,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1442,7 +1442,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1471,7 +1471,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1480,7 +1480,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands index 19326795bb..0ed374e279 100644 --- a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands @@ -1,4 +1,5 @@ #!/bin/bash ./xmlchange LND_TUNING_MODE="clm5_0_cam6.0" +./xmlchange ROF_NCPL='$ATM_NCPL' diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index e7d88b5afa..25f39d374e 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,4 +1,5 @@ ./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" ./xmlchange CLM_BLDNML_OPTS="-megan -drydep" --append ./xmlchange RUN_STARTDATE=1979-01-01 +./xmlchange ./xmlchange ROF_NCPL='$ATM_NCPL' From e2722833301c6059a99ddb4540723f1eadb95680 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 22:25:30 -0600 Subject: [PATCH 166/219] These are fields that are not optional, so remove the unneeded checks around them --- src/cpl/nuopc/lnd_import_export.F90 | 58 +++++++++++------------------ 1 file changed, 21 insertions(+), 37 deletions(-) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 170212db03..77ced85cfa 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -541,26 +541,18 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & if (ChkErr(rc,__LINE__,u_FILE_u)) return ! optional atm input fields - if (fldchk(importState, Faxa_bcph)) then - ! 1 = bcphidry, 2 = bcphodry, 3 = bcphiwet - call state_getimport_2d(importState, Faxa_bcph, atm2lnd_inst%forc_aer_grc(begg:,1:3), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(importState, Faxa_ocph)) then - ! 4 = ocphidry, 5 = ocphodry, 6 = ocphiwet - call state_getimport_2d(importState, Faxa_ocph, atm2lnd_inst%forc_aer_grc(begg:,4:6), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(importState, Faxa_dstwet)) then - ! 7 = dstwet1, 9 = dstwet2, 11 = dstwet3, 13 = dstwet4 - call state_getimport_2d(importState, Faxa_dstwet, atm2lnd_inst%forc_aer_grc(begg:,7:13:2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(importState, Faxa_dstdry)) then - ! 8 = dstdry1, 10 = dstdry2, 12 = dstdry3, 14 = dstdry4 - call state_getimport_2d(importState, Faxa_dstdry, atm2lnd_inst%forc_aer_grc(begg:,8:14:2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! 1 = bcphidry, 2 = bcphodry, 3 = bcphiwet + call state_getimport_2d(importState, Faxa_bcph, atm2lnd_inst%forc_aer_grc(begg:,1:3), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 4 = ocphidry, 5 = ocphodry, 6 = ocphiwet + call state_getimport_2d(importState, Faxa_ocph, atm2lnd_inst%forc_aer_grc(begg:,4:6), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 7 = dstwet1, 9 = dstwet2, 11 = dstwet3, 13 = dstwet4 + call state_getimport_2d(importState, Faxa_dstwet, atm2lnd_inst%forc_aer_grc(begg:,7:13:2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! 8 = dstdry1, 10 = dstdry2, 12 = dstdry3, 14 = dstdry4 + call state_getimport_2d(importState, Faxa_dstdry, atm2lnd_inst%forc_aer_grc(begg:,8:14:2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fldchk(importState, Sa_methane)) then call state_getimport_1d(importState, Sa_methane, atm2lnd_inst%forc_pch4_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -778,28 +770,20 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & if (ChkErr(rc,__LINE__,u_FILE_u)) return ! optional fields - if (fldchk(exportState, Fall_flxdst)) then - call state_setexport_2d(exportState, Fall_flxdst, lnd2atm_inst%flxdst_grc(begg:,1:4), & - minus= .true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call state_setexport_2d(exportState, Fall_flxdst, lnd2atm_inst%flxdst_grc(begg:,1:4), & + minus= .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fldchk(exportState, Fall_methane)) then call state_setexport_1d(exportState, Fall_methane, lnd2atm_inst%ch4_surf_flux_tot_grc(begg:), & minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (fldchk(exportState, Sl_u10)) then - call state_setexport_1d(exportState, Sl_u10, lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(exportState, Sl_ram1)) then - call state_setexport_1d(exportState, Sl_ram1, lnd2atm_inst%ram1_grc(begg:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(exportState, Sl_fv)) then - call state_setexport_1d(exportState, Sl_fv, lnd2atm_inst%fv_grc(begg:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call state_setexport_1d(exportState, Sl_u10, lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_ram1, lnd2atm_inst%ram1_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_fv, lnd2atm_inst%fv_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fldchk(exportState, Sl_soilw)) then call state_setexport_1d(exportState, Sl_soilw, waterlnd2atmbulk_inst%h2osoi_vol_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 1f9f71b5e4019d6b94139de044939d90bcec535e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Mar 2021 23:27:15 -0600 Subject: [PATCH 167/219] Add some more comments on what the code is doing --- src/cpl/nuopc/lnd_comp_nuopc.F90 | 24 ++++++++++++++---------- src/cpl/nuopc/lnd_import_export.F90 | 2 +- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index bea9ed37d8..b1a7eabcfc 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -40,18 +40,18 @@ module lnd_comp_nuopc private ! except ! Module public routines - public :: SetServices - public :: SetVM + public :: SetServices ! Setup the pointers to the function calls for the different models phases (initialize, run, finalize) + public :: SetVM ! Set the virtual machine description of the paralell model (both MPI and OpenMP) ! Module private routines - private :: InitializeP0 - private :: InitializeAdvertise - private :: InitializeRealize - private :: ModelSetRunClock - private :: ModelAdvance - private :: ModelFinalize - private :: clm_orbital_init - private :: clm_orbital_update + private :: InitializeP0 ! Phase zero of initialization + private :: InitializeAdvertise ! Advertise the fields that can be passed + private :: InitializeRealize ! Realize the list of fields that will be exchanged + private :: ModelSetRunClock ! Set the run clock + private :: ModelAdvance ! Advance the model + private :: ModelFinalize ! Finalize the model + private :: clm_orbital_init ! Initialize the orbital information + private :: clm_orbital_update ! Update the orbital information !-------------------------------------------------------------------------- ! Private module data @@ -94,6 +94,7 @@ module lnd_comp_nuopc !=============================================================================== subroutine SetServices(gcomp, rc) + ! Setup the pointers to the function calls for the different models phases (initialize, run, finalize) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -142,6 +143,7 @@ end subroutine SetServices !=============================================================================== subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + ! Phase zero initialization ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -160,6 +162,7 @@ end subroutine InitializeP0 !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + ! Advertise the fields that can be exchanged ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -311,6 +314,7 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + ! Realize the list of fields that will be exchanged !$ use omp_lib, only : omp_set_num_threads use ESMF , only : ESMF_VM, ESMF_VMGet use clm_instMod , only : lnd2atm_inst, lnd2glc_inst, water_inst diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 77ced85cfa..03bd4d49d7 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -1,5 +1,5 @@ module lnd_import_export - + ! CTSM import and export fields exchanged with the coupler use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError From d6fed4dbcb568eb9969f9602a538696f7351ad07 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 01:00:12 -0600 Subject: [PATCH 168/219] Fix xmlchange error --- .../testdefs/testmods_dirs/clm/waccmx_offline/shell_commands | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index 25f39d374e..5e9068895c 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,5 +1,5 @@ ./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" ./xmlchange CLM_BLDNML_OPTS="-megan -drydep" --append ./xmlchange RUN_STARTDATE=1979-01-01 -./xmlchange ./xmlchange ROF_NCPL='$ATM_NCPL' +./xmlchange ROF_NCPL='$ATM_NCPL' From 32413581da6cdd0eacff800e14fafe5e748e5af1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 01:15:29 -0600 Subject: [PATCH 169/219] Start the change files --- doc/ChangeLog | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 115 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 0457cbf22a..94fd098f1a 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,118 @@ =============================================================== +Tag name: ctsm5.1.dev030 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed Mar 31 01:05:50 MDT 2021 +One-line Summary: New single column functionality for the NUOPC cap + +Purpose and description of changes +---------------------------------- + + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + +CIME Issues fixed (include issue #): + +Known bugs introduced in this tag (include issue #): + +Known bugs found since the previous tag (include issue #): + + +Notes of particular relevance for users +--------------------------------------- +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Caveats for users (e.g., need to interpolate initial conditions): + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + +Changes made to namelist defaults (e.g., changed parameter values): + +Changes to the datasets (e.g., parameter, surface or initial files): + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + +Changes to tests or testing: + + +Testing summary: regular +---------------- + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - + + PTCLM testing (tools/shared/PTCLM/test): (if cime or cime_config are changed) + (PTCLM is being deprecated, so we only expect this to be done on occasion) + + cheyenne - + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No + (List of fields change though) + + +Other details +------------- + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime, CDEPS, CMEPS + cime to cime5.8.39 + CDEPS to v0.5.0 + CMEPS to v0.5.0 + +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + #1309 -- New single column functionality for NUOPC/CMEPS + #1310 -- run_sys_tests: add --retry option on izumi + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev029 Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) Date: Thu Mar 18 21:21:21 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 7b4a2b02a9..a381c74c10 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev030 erik 03/31/2021 New single column functionality for the NUOPC cap ctsm5.1.dev029 mvertens 03/18/2021 Rework domain initialization for nuopc ctsm5.1.dev028 swensosc 03/17/2021 Change limitation of top layer evaporation/sublimation ctsm5.1.dev027 sacks 03/15/2021 Update cime and other externals; includes switch to pio2 From 3d7e555f8d616c98494a38b7612079055864922b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 01:17:48 -0600 Subject: [PATCH 170/219] Allow a 2000-2025 range for landuse timeseries as part of #1302 --- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 9543fbcf6f..ebec522bc9 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2003,7 +2003,7 @@ CLM datasets exist for years: 1000 (for testing), 1850, and 2000 +"constant,1000-1002,1000-1004,850-1850,1850-1855,1850-2000,1850-2005,1850-2100,1980-2015,2000-2025,2000-2100"> Range of years to simulate transitory datasets for (such as dynamic: land-use datasets, aerosol-deposition, Nitrogen deposition rates etc.) Constant means simulation will be held at a constant year given in sim_year. A sim_year_range of 1000-1002 or 1000-1004 corresponds to data used for testing only, NOT corresponding to any real datasets. From c62b0b79e3504a3dee0d7bae8382714db54d0b67 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 02:06:47 -0600 Subject: [PATCH 171/219] Add --hires option to output maps in 64bit-offset form fixing #1183 --- tools/mkmapdata/mkmapdata.sh | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/tools/mkmapdata/mkmapdata.sh b/tools/mkmapdata/mkmapdata.sh index 9c5ef63db4..0ff7e805b8 100755 --- a/tools/mkmapdata/mkmapdata.sh +++ b/tools/mkmapdata/mkmapdata.sh @@ -14,6 +14,7 @@ # -t Output type, supported values are [regional, global] # -r Output resolution # -b use batch mode (not default) +# -i High resolution mode (Only used with -f) # -l list mapping files required (so can use check_input_data to get them) # -d debug usage -- display mkmapdata that will be run but don't execute them # -v verbose usage -- log more information on what is happening @@ -68,6 +69,8 @@ usage() { echo " you need to have a separate batch script for a supported machine" echo " that calls this script interactively - you cannot submit this" echo " script directly to the batch system" + echo "[-i|--hires]" + echo " Output maps are high resolution and large file support should be used" echo "[-l|--list]" echo " List mapping files required (use check_input_data to get them)" echo " also writes data to $outfilelist" @@ -137,6 +140,7 @@ list="no" outgrid="" gridfile="default" fast="no" +netcdfout="none" while [ $# -gt 0 ]; do case $1 in @@ -152,6 +156,9 @@ while [ $# -gt 0 ]; do --fast) fast="YES" ;; + -i|--hires) + netcdfout="64bit_offset" + ;; -l|--list) debug="YES" list="YES" @@ -202,12 +209,11 @@ if [ "$gridfile" != "default" ]; then exit 1 fi - # For now, make some assumptions about user-specified grids -- - # that they are SCRIP format, and small enough to not require - # large file support for the output mapping file. In the future, - # we may want to provide command-line options to allow the user to - # override these defaults. - DST_LRGFIL="none" + # For now, maked the assumption about user-specified grids -- + # that they are SCRIP format. In the future we may want to + # provide a command-line options to allow the user to + # override that default. + DST_LRGFIL=$netcdfout DST_TYPE="SCRIP" else if [ "$res" = "default" ]; then From 07a1ae1415f5e6533c64c6e3752db288ab782669 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 10:45:05 -0600 Subject: [PATCH 172/219] Move tests to aux_clm section --- cime_config/testdefs/ExpectedTestFails.xml | 56 +++++++++++----------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 73fb8deafc..36b4961313 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,6 +37,34 @@ + + + FAIL + #1317 + + + + + + FAIL + #1317 + + + + + + FAIL + ESMCI/cime#3496 + + + + + + FAIL + ESMCI/cime#3496 + + + @@ -88,34 +116,6 @@ - - - FAIL - ESMCI/cime#3496 - - - - - - FAIL - ESMCI/cime#3496 - - - - - - FAIL - #1317 - - - - - - FAIL - #1317 - - - FAIL From 0b6c08c6d8a191df21ae9ecd57b5cd1e072970d7 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 11:15:56 -0600 Subject: [PATCH 173/219] Add note about the failing DAE test --- cime_config/testdefs/ExpectedTestFails.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 36b4961313..5935e209ec 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,6 +37,13 @@ + + + FAIL + ESCOMP/CMEPS#175 + + + FAIL From 84960af183e0fd93c32013ad1129b0b372947d3f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 15:43:28 -0600 Subject: [PATCH 174/219] Add USUMB CLM_USRDAT tests to expected fails --- cime_config/testdefs/ExpectedTestFails.xml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 5935e209ec..3f79c30c55 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -44,6 +44,20 @@ + + + FAIL + ESMCI/cime#3905 + + + + + + FAIL + ESMCI/cime#3905 + + + FAIL From 1c11c434a09dcc5b2086b8f61b11c79715be190a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 15:46:14 -0600 Subject: [PATCH 175/219] Add a CLM_USRDAT USUMB test for NUOPC --- cime_config/testdefs/testlist_clm.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 626b0dc689..26040b60c9 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1678,6 +1678,16 @@ + + + + + + + + + + From 9bee7f55d699bed66067faa303ae26a729eb873b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Mar 2021 16:46:18 -0600 Subject: [PATCH 176/219] Update chagnelog file --- doc/ChangeLog | 51 +++++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 94fd098f1a..43d90bff93 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,12 +1,24 @@ =============================================================== Tag name: ctsm5.1.dev030 -Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) -Date: Wed Mar 31 01:05:50 MDT 2021 +Originator(s): mvertens / erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed Mar 31 16:46:04 MDT 2021 One-line Summary: New single column functionality for the NUOPC cap Purpose and description of changes ---------------------------------- +Implemented new nuopc/cmeps single column functionality. + +In config/cesm/config_files.xml - single point domains are only used +for mct/cpl7. For cmeps single point meshes are now generated on the +fly and component domains files are no longer needed. +env_run.xml variables PTS_LAT, PTS_LON and PTS_DOMAINFILE are used +to determine if there is a single point or single column run. +If PTS_LAT and PTS_LON are not -999 and PTS_DOMAINFILE is UNSET, +then you have a single point run and the exact values of PTS_LAT +and PTS_LON are used. If PTS_LAT and PTS_LON are not -999 and +PTS_DOMAINFILE is not UNSET, then then the cmeps driver will recognize the nearest neighbor +values of PTS_LAT and PTS_LON in PTS_DOMAINFILE as the single column lat and lon to use. Significant changes to scientifically-supported configurations @@ -30,25 +42,18 @@ Bugs fixed or introduced ------------------------ Issues fixed (include CTSM Issue #): - -CIME Issues fixed (include issue #): + Fixes #1312 -- Add NUOPC tests + Fixes #1302 -- Setup to allow landuse.timeseries file for high resolution cases for 2000-2025 + Fixes #1183 -- mkmapdata needs input option for large file support, current defaults unsuitable for high res grids. Known bugs introduced in this tag (include issue #): Known bugs found since the previous tag (include issue #): - + #1317 -- MPI timeout for some izumi_nag tests reading in datm forcing files in NUOPC cap + #1314 -- Send unset value for scol_lat/lon from driver Notes of particular relevance for users --------------------------------------- -[Remove any lines that don't apply. Remove entire section if nothing applies.] - -Caveats for users (e.g., need to interpolate initial conditions): - -Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): - -Changes made to namelist defaults (e.g., changed parameter values): - -Changes to the datasets (e.g., parameter, surface or initial files): Notes of particular relevance for developers: --------------------------------------------- @@ -56,8 +61,11 @@ NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the [Remove any lines that don't apply. Remove entire section if nothing applies.] Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Nine step tests changed so that they have ROF run at same frequency as ATM (like the similar CAM tests) + as these will fail with NUOPC since it doesn't allow you to end not on an even time-step for all components. + One of these tests changed to a CAM type test from decStart -Changes to tests or testing: +Changes to tests or testing: Add more NUOPC tests to test list Testing summary: regular @@ -66,27 +74,22 @@ Testing summary: regular build-namelist tests (if CLMBuildNamelist.pm has changed): - cheyenne - + cheyenne - PASS tools-tests (test/tools) (if tools have been changed): - cheyenne - - - PTCLM testing (tools/shared/PTCLM/test): (if cime or cime_config are changed) - (PTCLM is being deprecated, so we only expect this to be done on occasion) - - cheyenne - + cheyenne - OK python testing (if python code has changed; see instructions in python/README.md; document testing done): - (any machine) - + cheyenne -- FAIL regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): cheyenne ---- OK izumi ------- OK - any other testing (give details below): + any other testing (give details below): Ran full izumi test list for nuopc driver (failed tests appear above) If the tag used for baseline comparisons was NOT the previous tag, note that here: From 610b99ba8be773eb0ba7b03d5c1d3a861f342eae Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 31 Mar 2021 21:03:41 -0600 Subject: [PATCH 177/219] Use python3 in more shebang lines This is needed to run the python unit tests on cheyenne without explicitly pointing to python3. There are still more shebang instances throughout CTSM that I have not yet changed, because I'm not positive if they should be changed yet. (buildnml and buildlib should probably be changed in conjunction with others through CESM, and I'm not sure about the usage of the contrib tools.) --- python/Makefile | 2 +- python/README.md | 2 +- python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py | 2 +- python/ctsm/test/test_sys_lilac_build_ctsm.py | 2 +- python/ctsm/test/test_unit_lilac_build_ctsm.py | 2 +- python/ctsm/test/test_unit_lilac_make_runtime_inputs.py | 2 +- python/ctsm/test/test_unit_machine.py | 2 +- python/ctsm/test/test_unit_path_utils.py | 2 +- python/ctsm/test/test_unit_run_sys_tests.py | 2 +- python/ctsm/test/test_unit_utils.py | 2 +- python/run_ctsm_py_tests | 2 +- run_sys_tests | 2 +- 12 files changed, 12 insertions(+), 12 deletions(-) mode change 100644 => 100755 python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py diff --git a/python/Makefile b/python/Makefile index 470d32b9d4..6c7e1ab32c 100644 --- a/python/Makefile +++ b/python/Makefile @@ -8,7 +8,7 @@ debug = not-set ifneq ($(python), not-set) PYTHON=$(python) else - PYTHON=python + PYTHON=python3 endif ifneq ($(debug), not-set) diff --git a/python/README.md b/python/README.md index c1cd00e4aa..57a3179bac 100644 --- a/python/README.md +++ b/python/README.md @@ -14,7 +14,7 @@ thing, but support different options: You can specify a few arguments to this: - - python version: `make python=python3 test` + - python version: `make python=python3.9 test` (defaults to `python3`; you should expect errors if trying to run with python2) - verbose: `make verbose=true test` - debug: `make debug=true test` diff --git a/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py old mode 100644 new mode 100755 index c407c62904..53bb6dc07d --- a/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py +++ b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for job_launcher_no_batch """ diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py index 74121ba90d..5a44688171 100755 --- a/python/ctsm/test/test_sys_lilac_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """System tests for lilac_build_ctsm diff --git a/python/ctsm/test/test_unit_lilac_build_ctsm.py b/python/ctsm/test/test_unit_lilac_build_ctsm.py index 677de63da4..3c1a600326 100755 --- a/python/ctsm/test/test_unit_lilac_build_ctsm.py +++ b/python/ctsm/test/test_unit_lilac_build_ctsm.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for lilac_build_ctsm """ diff --git a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py index 7c94089269..e6b602b3d7 100755 --- a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py +++ b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for lilac_make_runtime_inputs """ diff --git a/python/ctsm/test/test_unit_machine.py b/python/ctsm/test/test_unit_machine.py index 65cd73620e..6a2f7ac172 100755 --- a/python/ctsm/test/test_unit_machine.py +++ b/python/ctsm/test/test_unit_machine.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for machine """ diff --git a/python/ctsm/test/test_unit_path_utils.py b/python/ctsm/test/test_unit_path_utils.py index 9d4d1a78ff..9fc996aa2c 100755 --- a/python/ctsm/test/test_unit_path_utils.py +++ b/python/ctsm/test/test_unit_path_utils.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for path_utils """ diff --git a/python/ctsm/test/test_unit_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py index 78ab02a648..8a53081a5b 100755 --- a/python/ctsm/test/test_unit_run_sys_tests.py +++ b/python/ctsm/test/test_unit_run_sys_tests.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for run_sys_tests """ diff --git a/python/ctsm/test/test_unit_utils.py b/python/ctsm/test/test_unit_utils.py index 34449aa93c..4a3fbbbb15 100755 --- a/python/ctsm/test/test_unit_utils.py +++ b/python/ctsm/test/test_unit_utils.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for utils """ diff --git a/python/run_ctsm_py_tests b/python/run_ctsm_py_tests index ef56f74740..a3da6fdb1f 100755 --- a/python/run_ctsm_py_tests +++ b/python/run_ctsm_py_tests @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Driver for running the unit tests of the python code We use this rather than simply relying on 'python -m unittest discover' so we can do some diff --git a/run_sys_tests b/run_sys_tests index bccf6f00e1..48e6c71370 100755 --- a/run_sys_tests +++ b/run_sys_tests @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Driver for running CTSM system tests""" import os From c6ce0b8b44cfca25cd4f29a9728e366cae5d6c80 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 1 Apr 2021 15:37:41 -0600 Subject: [PATCH 178/219] threading for cmeps driver --- src/biogeochem/CNVegetationFacade.F90 | 2 ++ src/cpl/nuopc/lnd_comp_nuopc.F90 | 36 ++++++++++++++++----------- src/main/initSubgridMod.F90 | 4 +-- 3 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 9ef32b4563..3068278559 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -1127,7 +1127,9 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & DA_nstep = get_nstep_since_startup_or_lastDA_restart_or_pause() if (DA_nstep <= skip_steps )then if (masterproc) then +!$OMP CRITICAL write(iulog,*) '--WARNING-- skipping CN balance check for first timesteps after startup or data assimilation' +!$OMP END CRITICAL end if else diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index b1a7eabcfc..7a74ca1f3a 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -78,6 +78,8 @@ module lnd_comp_nuopc logical :: scol_valid ! if single_column, does point have a mask of zero + integer :: nthrds ! Number of threads per task in this component + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -476,13 +478,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call memmon_dump_fort('memmon.out','lnd_comp_nuopc_InitializeRealize:start::',lbnum) endif #endif - - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !$ call omp_set_num_threads(localPeCount) + !---------------------------------------------------------------------------- + ! Initialize component threading + !---------------------------------------------------------------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + + !$ call omp_set_num_threads(nthrds) !---------------------- ! Consistency check on namelist filename @@ -739,17 +752,12 @@ subroutine ModelAdvance(gcomp, rc) RETURN end if + !$ call omp_set_num_threads(nthrds) + !-------------------------------- ! Reset share log units !-------------------------------- - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !$ call omp_set_num_threads(localPeCount) - call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (iulog) diff --git a/src/main/initSubgridMod.F90 b/src/main/initSubgridMod.F90 index 43851c337b..5c7e2bd3b1 100644 --- a/src/main/initSubgridMod.F90 +++ b/src/main/initSubgridMod.F90 @@ -167,7 +167,7 @@ subroutine clm_ptrs_check(bounds) integer :: ltype ! landunit type logical :: error ! error flag !------------------------------------------------------------------------------ - +!$OMP CRITICAL associate( & begg => bounds%begg, & endg => bounds%endg, & @@ -325,7 +325,7 @@ subroutine clm_ptrs_check(bounds) if (masterproc) write(iulog,*) ' ' end associate - +!$OMP END CRITICAL end subroutine clm_ptrs_check !----------------------------------------------------------------------- From 3e6d711a5f94c3c503bf3c6d63c4deeb2ae7ba82 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 1 Apr 2021 16:42:59 -0600 Subject: [PATCH 179/219] Tweak the fixes for writes within threaded regions - initSubgridMod: clm_ptrs_check: these writes seem unnecessary and misleading (because, if there were an error on some tasks but not the master task, you would see messages both about "OK" and failures), so I'm simply removing the write statements - CNVegetationFacade: BalanceCheck: using OMP MASTER because this only needs to be written from one thread --- src/biogeochem/CNVegetationFacade.F90 | 4 +- src/main/initSubgridMod.F90 | 68 +++++++++++++-------------- 2 files changed, 35 insertions(+), 37 deletions(-) diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 3068278559..98995626b0 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -1127,9 +1127,9 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & DA_nstep = get_nstep_since_startup_or_lastDA_restart_or_pause() if (DA_nstep <= skip_steps )then if (masterproc) then -!$OMP CRITICAL +!$OMP MASTER write(iulog,*) '--WARNING-- skipping CN balance check for first timesteps after startup or data assimilation' -!$OMP END CRITICAL +!$OMP END MASTER end if else diff --git a/src/main/initSubgridMod.F90 b/src/main/initSubgridMod.F90 index 5c7e2bd3b1..a0a68e0d28 100644 --- a/src/main/initSubgridMod.F90 +++ b/src/main/initSubgridMod.F90 @@ -151,7 +151,7 @@ end subroutine clm_ptrs_compdown subroutine clm_ptrs_check(bounds) ! ! !DESCRIPTION: - ! Checks and writes out a summary of subgrid data + ! Checks subgrid data ! ! !USES use clm_varcon, only : ispval @@ -167,7 +167,7 @@ subroutine clm_ptrs_check(bounds) integer :: ltype ! landunit type logical :: error ! error flag !------------------------------------------------------------------------------ -!$OMP CRITICAL + associate( & begg => bounds%begg, & endg => bounds%endg, & @@ -179,9 +179,6 @@ subroutine clm_ptrs_check(bounds) endp => bounds%endp & ) - if (masterproc) write(iulog,*) ' ' - if (masterproc) write(iulog,*) '---clm_ptrs_check:' - !--- check index ranges --- error = .false. do g = begg, endg @@ -193,10 +190,10 @@ subroutine clm_ptrs_check(bounds) end do end do if (error) then - write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: g index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) end if - if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK' error = .false. if (minval(lun%gridcell(begl:endl)) < begg .or. maxval(lun%gridcell(begl:endl)) > endg) error=.true. @@ -205,10 +202,10 @@ subroutine clm_ptrs_check(bounds) if (minval(lun%patchi(begl:endl)) < begp .or. maxval(lun%patchi(begl:endl)) > endp) error=.true. if (minval(lun%patchf(begl:endl)) < begp .or. maxval(lun%patchf(begl:endl)) > endp) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: l index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK' error = .false. if (minval(col%gridcell(begc:endc)) < begg .or. maxval(col%gridcell(begc:endc)) > endg) error=.true. @@ -216,20 +213,20 @@ subroutine clm_ptrs_check(bounds) if (minval(col%patchi(begc:endc)) < begp .or. maxval(col%patchi(begc:endc)) > endp) error=.true. if (minval(col%patchf(begc:endc)) < begp .or. maxval(col%patchf(begc:endc)) > endp) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: c index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK' error = .false. if (minval(patch%gridcell(begp:endp)) < begg .or. maxval(patch%gridcell(begp:endp)) > endg) error=.true. if (minval(patch%landunit(begp:endp)) < begl .or. maxval(patch%landunit(begp:endp)) > endl) error=.true. if (minval(patch%column(begp:endp)) < begc .or. maxval(patch%column(begp:endp)) > endc) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: p index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK' !--- check that indices in arrays are monotonically increasing --- error = .false. @@ -244,11 +241,11 @@ subroutine clm_ptrs_check(bounds) if (lun%patchi(l) < lun%patchi(l-1)) error = .true. if (lun%patchf(l) < lun%patchf(l-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR' - call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=l, clmlevel=namel, & + msg = 'clm_ptrs_check: l mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK' error = .false. do c=begc+1,endc @@ -263,11 +260,11 @@ subroutine clm_ptrs_check(bounds) if (col%patchi(c) < col%patchi(c-1)) error = .true. if (col%patchf(c) < col%patchf(c-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR' - call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=c, clmlevel=namec, & + msg = 'clm_ptrs_check: c mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK' error = .false. do p=begp+1,endp @@ -281,11 +278,11 @@ subroutine clm_ptrs_check(bounds) if (patch%landunit(p) < patch%landunit(p-1)) error = .true. if (patch%column (p) < patch%column (p-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR' - call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=p, clmlevel=namep, & + msg = 'clm_ptrs_check: p mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK' !--- check that the tree is internally consistent --- error = .false. @@ -298,34 +295,35 @@ subroutine clm_ptrs_check(bounds) if (lun%itype(l) /= ltype) error = .true. if (lun%gridcell(l) /= g) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=l, clmlevel=namel, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif do c = lun%coli(l),lun%colf(l) if (col%gridcell(c) /= g) error = .true. if (col%landunit(c) /= l) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=c, clmlevel=namec, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif do p = col%patchi(c),col%patchf(c) if (patch%gridcell(p) /= g) error = .true. if (patch%landunit(p) /= l) error = .true. if (patch%column(p) /= c) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=p, clmlevel=namep, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo ! p enddo ! c end if ! l /= ispval enddo ! ltype enddo ! g - if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK' - if (masterproc) write(iulog,*) ' ' end associate -!$OMP END CRITICAL + end subroutine clm_ptrs_check !----------------------------------------------------------------------- From 88661a5d69b56b8525a98e0ff71f7caa63b72a9a Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 2 Apr 2021 17:20:02 -0600 Subject: [PATCH 180/219] Default glacier_region_behavior depends on CISM_USE_ANTARCTICA --- bld/CLMBuildNamelist.pm | 6 +++++- bld/namelist_files/namelist_defaults_ctsm.xml | 10 ++++++++-- cime_config/buildnml | 16 ++++++++++++++-- 3 files changed, 27 insertions(+), 5 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 83128f7357..89e4772d8b 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -167,6 +167,7 @@ OPTIONS (Note: buildnml copies the file for use by the driver) -glc_nec Glacier number of elevation classes [0 | 3 | 5 | 10 | 36] (default is 0) (standard option with land-ice model is 10) + -glc_use_antarctica Set defaults appropriate for runs that include Antarctica -help [or -h] Print usage to STDOUT. -light_res Resolution of lightning dataset to use for CN fire (360x720 or 94x192) -ignore_ic_date Ignore the date on the initial condition files @@ -253,6 +254,7 @@ sub process_commandline { clm_demand => "null", help => 0, glc_nec => "default", + glc_use_antarctica => 0, light_res => "default", lnd_tuning_mode => "default", lnd_frac => undef, @@ -297,6 +299,7 @@ sub process_commandline { "note!" => \$opts{'note'}, "megan!" => \$opts{'megan'}, "glc_nec=i" => \$opts{'glc_nec'}, + "glc_use_antarctica!" => \$opts{'glc_use_antarctica'}, "light_res=s" => \$opts{'light_res'}, "d:s" => \$opts{'dir'}, "h|help" => \$opts{'help'}, @@ -1917,7 +1920,8 @@ sub setup_logic_glacier { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glc_snow_persistence_max_days'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'albice'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_behavior'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_behavior', + 'glc_use_antarctica'=>$nl_flags->{'glc_use_antarctica'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_melt_behavior'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_ice_runoff_behavior'); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3ccbe89a0e..c372b03771 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -442,8 +442,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). Mountain glaciers: single_at_atm_topo Greenland - inside CISM grid but outside Greenland itself: virtual Greenland itself: virtual - Antarctica: multiple --> -'single_at_atm_topo','virtual','virtual','multiple' + Antarctica: multiple + + If CISM is running over Antarctica, then we change the Antarctica + behavior to virtual. Note that the Greenland behavior is always + virtual, even if Greenland isn't included in this run. +--> +'single_at_atm_topo','virtual','virtual','multiple' +'single_at_atm_topo','virtual','virtual','virtual' From 1873d41b6054a38efeeb2f8c4d8139538ec89b63 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Apr 2021 07:51:39 -0600 Subject: [PATCH 199/219] Update ChangeLog --- doc/ChangeLog | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 94 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 43d90bff93..d5dc6cb048 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,97 @@ =============================================================== +Tag name: ctsm5.1.dev031 +Originator(s): jedwards (Jim Edwards), sacks (Bill Sacks) +Date: Sat Apr 10 07:33:49 MDT 2021 +One-line Summary: Update externals and fixes for nuopc threading + +Purpose and description of changes +---------------------------------- + +(1) Some fixes for threading with the nuopc/cmeps driver. (However, + threading with nuopc/cmeps still doesn't work completely: see + https://github.com/ESCOMP/CTSM/issues/1331.) + +(2) Updates externals to versions needed for these nuopc threading changes + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +Known bugs introduced in this tag (include issue #): +- https://github.com/ESCOMP/CTSM/issues/1331 Some runs with NUOPC driver + with multiple threads can hang + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: +- Temporarily changed + SMS_D_Ln9_P480x3_Vnuopc.f19_g17.IHistClm50Sp.cheyenne_intel.clm-waccmx_offline + to use a 480x1 layout so that it will pass reliably (see + https://github.com/ESCOMP/CTSM/issues/1331) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: YES (but very limited) + + Summarize any changes to answers, i.e., + - what code configurations: NUOPC driver with CISM + - what platforms/compilers: cheyenne_intel; maybe others + - nature of change (roundoff; larger than roundoff/same climate; new climate): roundoff + + For an unknown reason, the new externals lead to small differences + in global sums in the CMEPS driver/mediator. For what we assume is + the same reason, lnd -> glc fields can change by roundoff (probably + due to the global renormalization). + + The only test in the aux_clm test suite where this shows up is + ERS_Ly3_P72x2_Vnuopc.f10_f10_mg37.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Inspection of cpl hist files + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- cism: cism2_1_75 -> cism_1_78 +- rtm: rtm1_0_75 -> rtm1_0_76 +- mosart: mosart1_0_41 -> mosart1_0_42 +- cime: cime5.8.39 -> cime5.8.42 +- cmeps: v0.5.0 -> v0.9.0 +- cdeps: v0.5.0 -> v0.6.0 + +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1319 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev030 Originator(s): mvertens / erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Wed Mar 31 16:46:04 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index a381c74c10..bd5f0f7823 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev031 jedwards 04/10/2021 Update externals and fixes for nuopc threading ctsm5.1.dev030 erik 03/31/2021 New single column functionality for the NUOPC cap ctsm5.1.dev029 mvertens 03/18/2021 Rework domain initialization for nuopc ctsm5.1.dev028 swensosc 03/17/2021 Change limitation of top layer evaporation/sublimation From f988226d3450228829cdcc0a207312c87d333b70 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Apr 2021 09:55:00 -0600 Subject: [PATCH 200/219] Update ChangeLog --- doc/ChangeLog | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 86 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index d5dc6cb048..7596e9581c 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,89 @@ =============================================================== +Tag name: ctsm5.1.dev032 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Sat Apr 10 09:47:25 MDT 2021 +One-line Summary: Fix bugs in co2 from atmosphere + +Purpose and description of changes +---------------------------------- + +ctsm5.1.dev002 introduced bugs when receiving co2 from the atmosphere, +both for mct and nuopc: +- For mct, with spatially-varying co2 from atmosphere, all grid cells on + a given processor were given the co2 value from the last grid cell on + that processor +- For nuopc, co2 from atmosphere was ignored and overridden with a + constant co2 value + +This tag fixes both of those bugs. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[X] clm5_0 + +[X] ctsm5_0-nwp + +[X] clm4_5 + + +Bugs fixed or introduced +------------------------ +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1327 (When using co2 from atmosphere with mct, it + looks like values are taken just from the last gridcell on each proc) + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: Cases where CTSM receives CO2 from atmosphere + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + potentially new climate + + Answer changes due to fixing these issues: + - For mct, with spatially-varying co2 from atmosphere, all grid cells on + a given processor were given the co2 value from the last grid cell on + that processor + - For nuopc, co2 from atmosphere was ignored and overridden with a + constant co2 value + + In the test suite, this leads to changes in: + - ERP_D_Ld10_P36x2_Vnuopc.f10_f10_mg37.IHistClm51BgcCrop.cheyenne_intel.clm-ciso_decStart + - ERS_Ly3_P72x2_Vnuopc.f10_f10_mg37.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput + - SMS_D_Ln9_P480x1_Vnuopc.f19_g17.IHistClm50Sp.cheyenne_intel.clm-waccmx_offline + + But more widespread changes are expected - including for mct - if + coupled runs can generate spatially-varying co2 from atm + +Other details +------------- +Pull Requests that document the changes (include PR ids): +- Merges the first part of the changes in + https://github.com/ESCOMP/CTSM/pull/1330 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev031 Originator(s): jedwards (Jim Edwards), sacks (Bill Sacks) Date: Sat Apr 10 07:33:49 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index bd5f0f7823..3b353b92d3 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev032 mvertens 04/10/2021 Fix bugs in co2 from atmosphere ctsm5.1.dev031 jedwards 04/10/2021 Update externals and fixes for nuopc threading ctsm5.1.dev030 erik 03/31/2021 New single column functionality for the NUOPC cap ctsm5.1.dev029 mvertens 03/18/2021 Rework domain initialization for nuopc From 0081aabe0bc1cd587ce8d3a4238a4d3061a4c777 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Apr 2021 11:24:41 -0600 Subject: [PATCH 201/219] Remove nextsw_cday from clm_time_manager It was being set there but was never being used from there, so it was confusing to have this unnecessary set_nextsw_cday subroutine. --- src/cpl/lilac/lnd_comp_esmf.F90 | 2 +- src/cpl/mct/lnd_comp_mct.F90 | 3 +-- src/cpl/nuopc/lnd_comp_nuopc.F90 | 3 +-- src/utils/clm_time_manager.F90 | 22 ---------------------- 4 files changed, 3 insertions(+), 27 deletions(-) diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index c72c7cfceb..7d227a4134 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -32,7 +32,7 @@ module lnd_comp_esmf use clm_varctl , only : nsrStartup, nsrContinue use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_time_manager , only : set_timemgr_init, advance_timestep - use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday use clm_initializeMod , only : initialize1, initialize2 diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 8bea7a8e4b..f94a3544dc 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -273,7 +273,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) use clm_instMod , only : water_inst, lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst use clm_driver , only : clm_drv use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size - use clm_time_manager, only : advance_timestep, set_nextsw_cday,update_rad_dtime + use clm_time_manager, only : advance_timestep, update_rad_dtime use decompMod , only : get_proc_bounds use abortutils , only : endrun use clm_varctl , only : iulog @@ -357,7 +357,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - call set_nextsw_cday( nextsw_cday ) dtime = get_step_size() ! Handle pause/resume signals from coupler diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index be7c7133b7..19c7748297 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -26,7 +26,7 @@ module lnd_comp_nuopc use clm_varctl , only : single_column, clm_varctl_set, iulog use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch use clm_time_manager , only : set_timemgr_init, advance_timestep - use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday use clm_initializeMod , only : initialize1, initialize2 @@ -770,7 +770,6 @@ subroutine ModelAdvance(gcomp, rc) call State_GetScalar(importState, & flds_scalar_index_nextsw_cday, nextsw_cday, & flds_scalar_name, flds_scalar_num, rc) - call set_nextsw_cday( nextsw_cday ) ! Get proc bounds call get_proc_bounds(bounds) diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index 9ad956ebc8..3980ddc775 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -43,7 +43,6 @@ module clm_time_manager get_rest_date, &! return the date from the restart file get_local_timestep_time, &! return the local time for the input longitude to the nearest time-step get_local_time, &! return the local time for the input longitude - set_nextsw_cday, &! set the next radiation calendar day is_first_step, &! return true on first step of initial run is_first_restart_step, &! return true on first step of restart or branch run is_first_step_of_this_run_segment, &! return true on first step of any run segment (initial, restart or branch run) @@ -108,10 +107,6 @@ module clm_time_manager logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run logical, save :: tm_perp_calendar = .false. ! true when using perpetual calendar logical, save :: timemgr_set = .false. ! true when timemgr initialized - ! - ! Next short-wave radiation calendar day - ! - real(r8) :: nextsw_cday = uninit_r8 ! calday from clock of next radiation computation ! ! The time-step number of startup or last Data Assimulation (DA) restart or pause @@ -1417,21 +1412,6 @@ logical function is_near_local_noon( londeg, deltasec ) !--------------------------------------------------------------------------------- end function is_near_local_noon - !========================================================================================= - - subroutine set_nextsw_cday( nextsw_cday_in ) - - ! Set the next radiation calendar day, so that radiation step can be calculated - ! - ! Arguments - real(r8), intent(IN) :: nextsw_cday_in ! input calday of next radiation computation - - character(len=*), parameter :: sub = 'clm::set_nextsw_cday' - - nextsw_cday = nextsw_cday_in - - end subroutine set_nextsw_cday - !========================================================================================= function is_beg_curr_day() @@ -1800,8 +1780,6 @@ subroutine timemgr_reset() tm_perp_calendar = .false. timemgr_set = .false. - nextsw_cday = uninit_r8 - ! ------------------------------------------------------------------------ ! Reset other module-level variables to some reasonable default, to ensure that they ! don't carry over any state from one unit test to the next. From e4b727699765ac0c5b3d1ab37cdb9ea91e8d35f7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Apr 2021 11:29:51 -0600 Subject: [PATCH 202/219] Point to a cime branch tag Same as cime5.8.42 but with the changes from https://github.com/ESMCI/cime/pull/3914 cherry-picked in --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 12d6f8df6c..8fdff0ac4b 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -37,7 +37,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = cime5.8.42 +tag = branch_tags/cime5.8.42_a01 required = True [cmeps] From a97e2110fc3e89b94bb25211cc35ea33e9c11566 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Apr 2021 16:53:26 -0600 Subject: [PATCH 203/219] Update ChangeLog --- doc/ChangeLog | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 65 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 7596e9581c..f178eee325 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,68 @@ =============================================================== +Tag name: ctsm5.1.dev033 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Sat Apr 10 16:42:06 MDT 2021 +One-line Summary: Remove unnecessary settings of nextsw_cday + +Purpose and description of changes +---------------------------------- + +Remove setting of nextsw_cday in initialization: this hasn't been needed +ever since we stopped calculating albedos in initialization. + +Also remove nextsw_cday from clm_time_manager: this was being set but +was never referenced from here: instead, nextsw_cday was being passed as +an argument to clm_drv. + +Also, updates cime to a branch tag where I have fixed the --retry option +to create_test. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +CIME Issues fixed (include issue #): +- ESMCI/cime#3912 (create_test --retry fails if the test is doing + baseline generation) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- cime: cime5.8.42 -> branch_tags/cime5.8.42_a01 + +Pull Requests that document the changes (include PR ids): +- Second part of https://github.com/ESCOMP/CTSM/pull/1330 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev032 Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) Date: Sat Apr 10 09:47:25 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 3b353b92d3..604005f609 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev033 mvertens 04/10/2021 Remove unnecessary settings of nextsw_cday ctsm5.1.dev032 mvertens 04/10/2021 Fix bugs in co2 from atmosphere ctsm5.1.dev031 jedwards 04/10/2021 Update externals and fixes for nuopc threading ctsm5.1.dev030 erik 03/31/2021 New single column functionality for the NUOPC cap From 916c11d607016b911f0b8e98def636cfeae5b2b7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Apr 2021 11:14:50 -0400 Subject: [PATCH 204/219] Bypass grid-level water mass check when fates hydro is active --- src/biogeophys/BalanceCheckMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index c94a4095ac..baf393d61d 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -11,6 +11,7 @@ module BalanceCheckMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varctl , only : iulog + use clm_varctl , only : use_fates_planthydro use clm_varcon , only : namep, namec, nameg use clm_varpar , only : nlevsoi use GetGlobalValuesMod , only : GetGlobalIndex @@ -723,7 +724,7 @@ subroutine BalanceCheck( bounds, & errh2o_max_val = maxval(abs(errh2o_grc(bounds%begg:bounds%endg))) - if (errh2o_max_val > h2o_warning_thresh) then + if (errh2o_max_val > h2o_warning_thresh .and. .not.use_fates_planthydro) then indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg - 1 write(iulog,*)'WARNING: grid cell-level water balance error ',& From 5a606c754bd67f119caf4bfbdef776a8a53439ce Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Apr 2021 14:35:48 -0400 Subject: [PATCH 205/219] Added comment at fates-hydro grid-check that indicates temporary fix still needs to be addressed. --- src/biogeophys/BalanceCheckMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index baf393d61d..eaf2eec447 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -724,6 +724,8 @@ subroutine BalanceCheck( bounds, & errh2o_max_val = maxval(abs(errh2o_grc(bounds%begg:bounds%endg))) + ! BUG(rgk, 2021-04-13, ESCOMP/CTSM#1314) Temporarily bypassing gridcell-level check with use_fates_planthydro until issue 1314 is resolved + if (errh2o_max_val > h2o_warning_thresh .and. .not.use_fates_planthydro) then indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg - 1 From 09da58acf3a6ed12b6787269be7043a862bb9a31 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Apr 2021 15:44:22 -0600 Subject: [PATCH 206/219] Added plant water storage to restarts --- src/biogeophys/WaterDiagnosticType.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 0006ecc20d..5bc18ff4e6 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -294,7 +294,7 @@ subroutine Restart(this, bounds, ncid, flag) ! Read/Write module information to/from restart file. ! ! !USES: - use clm_varcon , only : nameg + use clm_varcon , only : nameg, namec use ncdio_pio , only : file_desc_t, ncd_double use restUtilMod ! @@ -329,6 +329,15 @@ subroutine Restart(this, bounds, ncid, flag) units='kg/kg', & interpinic_flag='interp', readvar=readvar, data=this%qaf_lun) + + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('TOTAL_PLANT_STORED_H2O'), & + xtype=ncd_double, dim1name=namec, & + long_name=this%info%lname('total plant stored water (for fates hydro)'), & + units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%total_plant_stored_h2o_col) + + end subroutine Restart !----------------------------------------------------------------------- From adb68078792ab600faee9a18c33f037b7ab8bb91 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Apr 2021 15:48:16 -0600 Subject: [PATCH 207/219] Added comment in testdefs about current fates hydro tests --- cime_config/testdefs/testlist_clm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index c775ea4b8d..f7f2e3391e 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2321,7 +2321,7 @@ - + @@ -2332,7 +2332,7 @@ - + From c2ca2a9669301c271b34798fd81322ed532f9b1e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Apr 2021 13:41:31 -0400 Subject: [PATCH 208/219] Added an if-clause to restarting with plant-stored-water --- src/biogeophys/WaterDiagnosticType.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 5bc18ff4e6..9f27d89287 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -296,6 +296,7 @@ subroutine Restart(this, bounds, ncid, flag) ! !USES: use clm_varcon , only : nameg, namec use ncdio_pio , only : file_desc_t, ncd_double + use clm_varctl , only : use_fates_planthydro use restUtilMod ! ! !ARGUMENTS: @@ -329,14 +330,14 @@ subroutine Restart(this, bounds, ncid, flag) units='kg/kg', & interpinic_flag='interp', readvar=readvar, data=this%qaf_lun) - - call restartvar(ncid=ncid, flag=flag, & - varname=this%info%fname('TOTAL_PLANT_STORED_H2O'), & - xtype=ncd_double, dim1name=namec, & - long_name=this%info%lname('total plant stored water (for fates hydro)'), & - units='kg/m2', & - interpinic_flag='interp', readvar=readvar, data=this%total_plant_stored_h2o_col) - + if(use_fates_planthydro) then + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('TOTAL_PLANT_STORED_H2O'), & + xtype=ncd_double, dim1name=namec, & + long_name=this%info%lname('total plant stored water (for fates hydro)'), & + units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%total_plant_stored_h2o_col) + end if end subroutine Restart From a945c27286c29c300af63bf9ac02bcccb8f2f721 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 15 Apr 2021 13:43:11 -0400 Subject: [PATCH 209/219] Updated white-space issue that was driving me nuts --- src/biogeophys/WaterDiagnosticType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 9f27d89287..d3ef72849f 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -296,7 +296,7 @@ subroutine Restart(this, bounds, ncid, flag) ! !USES: use clm_varcon , only : nameg, namec use ncdio_pio , only : file_desc_t, ncd_double - use clm_varctl , only : use_fates_planthydro + use clm_varctl , only : use_fates_planthydro use restUtilMod ! ! !ARGUMENTS: From 3e40761147733e8f32a2f21fd3c81020d502e59e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Apr 2021 00:48:24 -0600 Subject: [PATCH 210/219] Turn reseed_dead_plants on for AD spinup mode fixes #1307 --- bld/CLMBuildNamelist.pm | 6 ++++++ bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++++ 2 files changed, 10 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4eaaa0b485..863491b9f7 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1102,6 +1102,12 @@ sub setup_cmdl_spinup { $nl_flags->{'bgc_spinup'} = "off"; $val = $defaults->get_value($var); } + # For AD spinup mode by default reseed dead plants + if ( $nl_flags->{$var} ne "off" ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, + $defaults, $nl, "reseed_dead_plants", clm_accelerated_spinup=>$nl_flags->{$var}, + use_cn=>$nl_flags->{'use_cn'} ); + } } else { if ( defined($nl->get_value("spinup_state")) ) { $log->fatal_error("spinup_state is accelerated (=1 or 2) which is for a BGC mode of CN or BGC," . diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index d16bd788b2..564b1b6956 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -57,6 +57,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 1 0 + +.true. +.false. + .false. From 620d9b2dbb303433af3dc79b5535ed3db52b9da2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Apr 2021 01:01:13 -0600 Subject: [PATCH 211/219] Remove KO comments and commented out code --- src/biogeochem/CNPhenologyMod.F90 | 12 ------------ src/main/pftconMod.F90 | 8 -------- 2 files changed, 20 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 9e8f46365c..e81883ea91 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -674,9 +674,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) -!KO season_decid_temperate => pftcon%season_decid_temperate , & ! Input: binary flag for seasonal-deciduous temperate leaf habit (0 or 1) -!KO t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] @@ -881,15 +879,6 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday end if -!KO !separate into Arctic boreal and lower latitudes -!KO if (onset_gdd(p) > crit_onset_gdd .and. abs(grc%latdeg(g))<45.0_r8) then -!KO onset_thresh=1.0_r8 -!KO else if (onset_gddflag(p) == 1.0_r8 .and. soila10(p) > SHR_CONST_TKFRZ .and. & -!KO t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & -!KO dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then -!KO onset_thresh=1.0_r8 -!KO end if -!KO if ( onset_thresh_depends_on_veg ) then ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, @@ -906,7 +895,6 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! set onset_flag if critical growing degree-day sum is exceeded if (onset_gdd(p) > crit_onset_gdd) onset_thresh = 1.0_r8 end if -!KO ! If onset is being triggered if (onset_thresh == 1.0_r8) then onset_flag(p) = 1.0_r8 diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 999b56f15a..3645a6f63a 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -210,9 +210,7 @@ module pftconMod real(r8), allocatable :: evergreen (:) ! binary flag for evergreen leaf habit (0 or 1) real(r8), allocatable :: stress_decid (:) ! binary flag for stress-deciduous leaf habit (0 or 1) real(r8), allocatable :: season_decid (:) ! binary flag for seasonal-deciduous leaf habit (0 or 1) -!KO real(r8), allocatable :: season_decid_temperate(:) ! binary flag for seasonal-deciduous temperate leaf habit (0 or 1) -!KO real(r8), allocatable :: pconv (:) ! proportion of deadstem to conversion flux real(r8), allocatable :: pprod10 (:) ! proportion of deadstem to 10-yr product pool real(r8), allocatable :: pprod100 (:) ! proportion of deadstem to 100-yr product pool @@ -427,9 +425,7 @@ subroutine InitAllocate (this) allocate( this%evergreen (0:mxpft) ) allocate( this%stress_decid (0:mxpft) ) allocate( this%season_decid (0:mxpft) ) -!KO allocate( this%season_decid_temperate (0:mxpft) ) -!KO allocate( this%dwood (0:mxpft) ) allocate( this%root_density (0:mxpft) ) allocate( this%root_radius (0:mxpft) ) @@ -771,10 +767,8 @@ subroutine InitRead(this) call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) -!KO call ncd_io('season_decid_temperate', this%season_decid_temperate, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) -!KO call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1427,9 +1421,7 @@ subroutine Clean(this) deallocate( this%evergreen) deallocate( this%stress_decid) deallocate( this%season_decid) -!KO deallocate( this%season_decid_temperate) -!KO deallocate( this%dwood) deallocate( this%root_density) deallocate( this%root_radius) From 9684ec30525ec4ff282d345230440275a0f0afac Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 16 Apr 2021 14:39:17 -0600 Subject: [PATCH 212/219] Need backwards compatibility for init_interp attribute --- src/init_interp/initInterp.F90 | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/src/init_interp/initInterp.F90 b/src/init_interp/initInterp.F90 index 65eb46d3ca..343f1b9ea8 100644 --- a/src/init_interp/initInterp.F90 +++ b/src/init_interp/initInterp.F90 @@ -210,6 +210,7 @@ subroutine initInterp (filei, fileo, bounds, glc_behavior) integer :: npftsi, ncolsi, nlunsi, ngrcsi integer :: npftso, ncolso, nlunso, ngrcso logical :: glc_elevclasses_same + logical :: att_found integer , allocatable, target :: pftindx(:) integer , allocatable, target :: colindx(:) integer , allocatable, target :: lunindx(:) @@ -292,9 +293,25 @@ subroutine initInterp (filei, fileo, bounds, glc_behavior) status = pio_get_att(ncidi, pio_global, & 'ilun_crop', & subgrid_special_indices%ilun_crop) - status = pio_get_att(ncidi, pio_global, & - 'ilun_landice', & - subgrid_special_indices%ilun_landice) + + ! BACKWARDS_COMPATIBILITY(wjs, 2021-04-16) ilun_landice_multiple_elevation_classes has + ! been renamed to ilun_landice. For now we need to handle both possibilities for the + ! sake of old initial conditions files. There is a chance that we had ilun_landice + ! alongside ilun_landice_multiple_elevation_classes on really old initial conditions + ! files; in that case, we want to use ilun_landice_multiple_elevation_classes. Once we + ! can rely on all initial conditions files having the new behavior, we can remove this + ! check_att call and just assume there is an ilun_landice attribute. + call check_att(ncidi, pio_global, 'ilun_landice_multiple_elevation_classes', att_found) + if (att_found) then + status = pio_get_att(ncidi, pio_global, & + 'ilun_landice_multiple_elevation_classes', & + subgrid_special_indices%ilun_landice) + else + status = pio_get_att(ncidi, pio_global, & + 'ilun_landice', & + subgrid_special_indices%ilun_landice) + end if + status = pio_get_att(ncidi, pio_global, & 'created_glacier_mec_landunits', & created_glacier_mec_landunits) From e10dc0545f86516dd440ad86588657243f74a3bf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 16 Apr 2021 15:08:21 -0600 Subject: [PATCH 213/219] Remove some dead code Resolves ESCOMP/CTSM#1333 --- src/cpl/utils/lnd_import_export_utils.F90 | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/cpl/utils/lnd_import_export_utils.F90 b/src/cpl/utils/lnd_import_export_utils.F90 index 2f0c3939e7..032cb19b6f 100644 --- a/src/cpl/utils/lnd_import_export_utils.F90 +++ b/src/cpl/utils/lnd_import_export_utils.F90 @@ -84,15 +84,6 @@ subroutine derive_quantities( bounds, atm2lnd_inst, wateratm2lndbulk_inst, & call QSat(forc_t, forc_pbot, qsat_kg_kg) - ! modify specific humidity if precip occurs - if (1==2) then - if ((forc_rainc(g) + forc_rainl(g)) > 0._r8) then - forc_q = 0.95_r8 * qsat_kg_kg - !forc_q = qsat_kg_kg - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q - endif - endif - wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat_kg_kg) end do From e9d49621a25fdd3516a01172fd4dd5da26b367a8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 16 Apr 2021 16:45:50 -0600 Subject: [PATCH 214/219] Add history file metadata on each variable's l2g_scale_type Adds a landunit_mask attribute Resolves ESCOMP/CTSM#1343 --- src/main/histFileMod.F90 | 155 +++++++++++++++++++++++++------------- src/main/ncdio_pio.F90.in | 12 ++- 2 files changed, 111 insertions(+), 56 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 988076f757..6a9100edfc 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -172,6 +172,7 @@ module histFileMod private :: pointer_index ! Track data pointer indices private :: max_nFields ! The max number of fields on any tape private :: avgflag_valid ! Whether a given avgflag is a valid option + private :: add_landunit_mask_metadata ! Add landunit_mask metadata for the given history field ! ! !PRIVATE TYPES: ! Constants @@ -2429,7 +2430,7 @@ subroutine htape_timeconst3D(t, & character(len=max_chars) :: long_name ! variable long name character(len=max_namlen):: varname ! variable name character(len=max_namlen):: units ! variable units - character(len=scale_type_strlen) :: l2g_scale_type ! scale type for subgrid averaging of landunits to grid cells + integer :: varid ! variable id ! real(r8), pointer :: histi(:,:) ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -2443,13 +2444,35 @@ subroutine htape_timeconst3D(t, & 'BSW ', & 'HKSAT ' & /) + ! Scale type for subgrid averaging of landunits to grid cells + ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are + ! currently constant in space, except for urban points, so their scale type + ! doesn't matter at the moment as long as it excludes urban points. I am using + ! 'nonurb' so that the values are output everywhere where the fields are + ! constant (i.e., everywhere except urban points). For the other fields, I am + ! using 'veg' to be consistent with the l2g_scale_type that is now used for many + ! of the 3-d time-variant fields; in theory, though, one might want versions of + ! these variables output for different landunits. + character(len=scale_type_strlen) :: l2g_scale_type(nflds) = [ & + 'nonurb', & ! ZSOI + 'nonurb', & ! DZSOI + 'veg ', & ! WATSAT + 'veg ', & ! SUCSAT + 'veg ', & ! BSW + 'veg ' & ! HKSAT + ] real(r8), pointer :: histil(:,:) ! temporary real(r8), pointer :: histol(:,:) integer, parameter :: nfldsl = 2 character(len=*),parameter :: varnamesl(nfldsl) = (/ & 'ZLAKE ', & 'DZLAKE' & - /) + /) + ! Scale type for subgrid averaging of landunits to grid cells, for lake fields + character(len=scale_type_strlen) :: l2g_scale_typel(nfldsl) = [ & + 'lake', & ! ZLAKE + 'lake' & ! DZLAKE + ] !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(watsat_col) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) @@ -2486,12 +2509,16 @@ subroutine htape_timeconst3D(t, & if (ldomain%isgrid2d) then call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levgrnd', & - long_name=long_name, units=units, missing_value=spval, fill_value=spval) + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) else call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & - dim1name=grlnd, dim2name='levgrnd', & - long_name=long_name, units=units, missing_value=spval, fill_value=spval) + dim1name=grlnd, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) end if + + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type(ifld)) else call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levgrnd', & @@ -2520,30 +2547,6 @@ subroutine htape_timeconst3D(t, & do ifld = 1,nflds - ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are - ! currently constant in space, except for urban points, so their scale type - ! doesn't matter at the moment as long as it excludes urban points. I am using - ! 'nonurb' so that the values are output everywhere where the fields are - ! constant (i.e., everywhere except urban points). For the other fields, I am - ! using 'veg' to be consistent with the l2g_scale_type that is now used for many - ! of the 3-d time-variant fields; in theory, though, one might want versions of - ! these variables output for different landunits. - - ! Field indices MUST match varnames array order above! - if (ifld == 1) then ! ZSOI - l2g_scale_type = 'nonurb' - else if (ifld == 2) then ! DZSOI - l2g_scale_type = 'nonurb' - else if (ifld == 3) then ! WATSAT - l2g_scale_type = 'veg' - else if (ifld == 4) then ! SUCSAT - l2g_scale_type = 'veg' - else if (ifld == 5) then ! BSW - l2g_scale_type = 'veg' - else if (ifld == 6) then ! HKSAT - l2g_scale_type = 'veg' - end if - histi(:,:) = spval do lev = 1,nlevgrnd do c = bounds%begc,bounds%endc @@ -2563,7 +2566,7 @@ subroutine htape_timeconst3D(t, & call c2g(bounds, nlevgrnd, & histi(bounds%begc:bounds%endc, :), & histo(bounds%begg:bounds%endg, :), & - c2l_scale_type='unity', l2g_scale_type=l2g_scale_type) + c2l_scale_type='unity', l2g_scale_type=l2g_scale_type(ifld)) if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & @@ -2597,12 +2600,16 @@ subroutine htape_timeconst3D(t, & if (ldomain%isgrid2d) then call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec,& dim1name='lon', dim2name='lat', dim3name='levlak', & - long_name=long_name, units=units, missing_value=spval, fill_value=spval) + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) else call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & - dim1name=grlnd, dim2name='levlak', & - long_name=long_name, units=units, missing_value=spval, fill_value=spval) + dim1name=grlnd, dim2name='levlak', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) end if + + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_typel(ifld)) else call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levlak', & @@ -2646,7 +2653,7 @@ subroutine htape_timeconst3D(t, & call c2g(bounds, nlevlak, & histil(bounds%begc:bounds%endc, :), & histol(bounds%begg:bounds%endg, :), & - c2l_scale_type='unity', l2g_scale_type='lake') + c2l_scale_type='unity', l2g_scale_type=l2g_scale_typel(ifld)) if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & data=histol, ncid=nfid(t), flag='write') @@ -3116,6 +3123,7 @@ subroutine hfields_write(t, mode) integer :: nt ! time index integer :: ier ! error status integer :: numdims ! number of dimensions + integer :: varid ! variable id character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=max_chars) :: long_name! long name character(len=max_chars) :: units ! units @@ -3124,6 +3132,7 @@ subroutine hfields_write(t, mode) character(len=hist_dim_name_length) :: type1d ! field 1d type character(len=hist_dim_name_length) :: type1d_out ! history output 1d type character(len=hist_dim_name_length) :: type2d ! history output 2d type + character(len=scale_type_strlen) :: l2g_scale_type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -3147,21 +3156,22 @@ subroutine hfields_write(t, mode) ! Set history field variables - varname = tape(t)%hlist(f)%field%name - long_name = tape(t)%hlist(f)%field%long_name - units = tape(t)%hlist(f)%field%units - avgflag = tape(t)%hlist(f)%avgflag - type1d = tape(t)%hlist(f)%field%type1d - type1d_out = tape(t)%hlist(f)%field%type1d_out - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d - beg1d_out = tape(t)%hlist(f)%field%beg1d_out - end1d_out = tape(t)%hlist(f)%field%end1d_out - num1d_out = tape(t)%hlist(f)%field%num1d_out - type2d = tape(t)%hlist(f)%field%type2d - numdims = tape(t)%hlist(f)%field%numdims - num2d = tape(t)%hlist(f)%field%num2d - nt = tape(t)%ntimes + varname = tape(t)%hlist(f)%field%name + long_name = tape(t)%hlist(f)%field%long_name + units = tape(t)%hlist(f)%field%units + avgflag = tape(t)%hlist(f)%avgflag + type1d = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + num1d_out = tape(t)%hlist(f)%field%num1d_out + type2d = tape(t)%hlist(f)%field%type2d + numdims = tape(t)%hlist(f)%field%numdims + num2d = tape(t)%hlist(f)%field%num2d + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + nt = tape(t)%ntimes if (mode == 'define') then @@ -3196,27 +3206,35 @@ subroutine hfields_write(t, mode) call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name='time', & long_name=long_name, units=units, cell_method=avgstr, & - missing_value=spval, fill_value=spval) + missing_value=spval, fill_value=spval, & + varid=varid) else call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=type2d, dim3name='time', & long_name=long_name, units=units, cell_method=avgstr, & - missing_value=spval, fill_value=spval) + missing_value=spval, fill_value=spval, & + varid=varid) end if else if (numdims == 1) then call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=dim2name, dim3name='time', & long_name=long_name, units=units, cell_method=avgstr, & - missing_value=spval, fill_value=spval) + missing_value=spval, fill_value=spval, & + varid=varid) else call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & dim1name=dim1name, dim2name=dim2name, dim3name=type2d, dim4name='time', & long_name=long_name, units=units, cell_method=avgstr, & - missing_value=spval, fill_value=spval) + missing_value=spval, fill_value=spval, & + varid=varid) end if endif + if (type1d_out == nameg .or. type1d_out == grlnd) then + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type) + end if + else if (mode == 'write') then ! Determine output buffer @@ -5556,5 +5574,36 @@ function avgflag_valid(avgflag, blank_valid) result(valid) end function avgflag_valid + !----------------------------------------------------------------------- + subroutine add_landunit_mask_metadata(ncid, varid, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Add landunit_mask metadata for the given history field + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(in) :: varid ! netcdf var id + character(len=*) , intent(in) :: l2g_scale_type ! l2g_scale_type for this variable + ! + ! !LOCAL VARIABLES: + character(len=:), allocatable :: landunit_mask_string + + character(len=*), parameter :: subname = 'add_landunit_mask_metadata' + !----------------------------------------------------------------------- + + if (l2g_scale_type == 'unity') then + ! TODO(wjs, 2021-04-16) Once we consistently set l2g_scale_type for all variables, + ! and have stopped using other mechanisms (particularly the setting of variables to + ! spval everywhere) then we can stop setting this to 'unknown': we can instead set + ! this to something like 'all', with reasonable confidence that the field truly + ! applies over all landunits. + landunit_mask_string = 'unknown' + else + landunit_mask_string = l2g_scale_type + end if + + call ncd_putatt(ncid, varid, 'landunit_mask', landunit_mask_string) + + end subroutine add_landunit_mask_metadata end module histFileMod diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in index 4b7b75c82e..b321dc04bc 100644 --- a/src/main/ncdio_pio.F90.in +++ b/src/main/ncdio_pio.F90.in @@ -1212,7 +1212,8 @@ contains dim1name, dim2name, dim3name, dim4name, dim5name, & long_name, units, cell_method, missing_value, fill_value, & imissing_value, ifill_value, switchdim, comment, & - flag_meanings, flag_values, nvalid_range ) + flag_meanings, flag_values, nvalid_range, & + varid) ! ! !DESCRIPTION: ! Define a netcdf variable @@ -1238,12 +1239,13 @@ contains logical , intent(in), optional :: switchdim ! true=> permute dim1 and dim2 for output integer , intent(in), optional :: flag_values(:) ! attribute for int integer , intent(in), optional :: nvalid_range(2) ! attribute for int + integer , intent(out), optional :: varid ! returned var id ! ! !LOCAL VARIABLES: integer :: n ! indices integer :: ndims ! dimension counter integer :: dimid(5) ! dimension ids - integer :: varid ! variable id + integer :: l_varid ! local variable id integer :: itmp ! temporary character(len=256) :: str ! temporary character(len=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name @@ -1276,13 +1278,17 @@ contains end do end if - call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & + call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,l_varid, & long_name=long_name, units=units, cell_method=cell_method, & missing_value=missing_value, fill_value=fill_value, & imissing_value=imissing_value, ifill_value=ifill_value, & comment=comment, flag_meanings=flag_meanings, & flag_values=flag_values, nvalid_range=nvalid_range ) + if (present(varid)) then + varid = l_varid + end if + end subroutine ncd_defvar_bygrid !------------------------------------------------------------------------ From 8dbd8b5a47a1770358535448a7f4cb2b2a3f9eb0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 19 Apr 2021 00:34:19 -0600 Subject: [PATCH 215/219] Set upper_soil_layer with a function call at initialization so that it will work for different soil depths --- src/biogeochem/CNSharedParamsMod.F90 | 21 ++++++++++++++++++++- src/biogeophys/TemperatureType.F90 | 4 +++- src/main/clm_initializeMod.F90 | 2 ++ src/main/clm_instMod.F90 | 8 +++++++- src/main/initVerticalMod.F90 | 11 +---------- 5 files changed, 33 insertions(+), 13 deletions(-) diff --git a/src/biogeochem/CNSharedParamsMod.F90 b/src/biogeochem/CNSharedParamsMod.F90 index 8a4eafc99a..c7e05358a9 100644 --- a/src/biogeochem/CNSharedParamsMod.F90 +++ b/src/biogeochem/CNSharedParamsMod.F90 @@ -24,8 +24,20 @@ module CNSharedParamsMod type(CNParamsShareType), protected :: CNParamsShareInst + ! Public subroutines + public :: CNParamsReadShared + public :: CNParamsSetSoilDepth + public :: CNParamsReadShared_namelist + + ! Public data + logical, public :: use_fun = .false. ! Use the FUN2.0 model integer, public :: nlev_soildecomp_standard = 5 + integer, public :: upper_soil_layer = -1 ! Upper soil layer to use for 10-day average in CNPhenology + + ! Private subroutines and data + + private :: CNParamsReadShared_netcdf character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -36,7 +48,7 @@ module CNSharedParamsMod !----------------------------------------------------------------------- subroutine CNParamsReadShared(ncid, namelist_file) - use ncdio_pio , only : file_desc_t + use ncdio_pio , only : file_desc_t type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id character(len=*), intent(in) :: namelist_file @@ -46,6 +58,13 @@ subroutine CNParamsReadShared(ncid, namelist_file) end subroutine CNParamsReadShared + !----------------------------------------------------------------------- + + subroutine CNParamsSetSoilDepth( ) + use initVerticalMod, only : find_soil_layer_containing_depth + ! Set the soil depth needed for CNPhenology + call find_soil_layer_containing_depth ( 0.12_r8, upper_soil_layer ) + end subroutine CNParamsSetSoilDepth !----------------------------------------------------------------------- subroutine CNParamsReadShared_netcdf(ncid) ! diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 174db59818..a5210c219e 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -1329,6 +1329,7 @@ subroutine UpdateAccVars (this, bounds) use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + use CNSharedParamsMod, only : upper_soil_layer ! ! !ARGUMENTS: class(temperature_type) :: this @@ -1460,9 +1461,10 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) + if ( upper_soil_layer /= 3 ) call endrun( "abort not 3" ) do p = begp,endp c = patch%column(p) - rbufslp(p) = this%t_soisno_col(c,3) + rbufslp(p) = this%t_soisno_col(c,upper_soil_layer) end do call update_accum_field ('SOIL10', rbufslp, nstep) call extract_accum_field ('SOIL10', this%soila10_patch, nstep) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index eef3168b38..196f09b3d4 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -153,6 +153,7 @@ subroutine initialize2(ni,nj) use controlMod , only : NLFilename use clm_instMod , only : clm_fates use BalanceCheckMod , only : BalanceCheckInit + use CNSharedParamsMod , only : CNParamsSetSoilDepth use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method use FATESFireFactoryMod , only : scalar_lightning ! @@ -355,6 +356,7 @@ subroutine initialize2(ni,nj) ! Initialize instances of all derived types as well as time constant variables call clm_instInit(bounds_proc) + call CNParamsSetSoilDepth() ! Initialize SNICAR optical and aging parameters call SnowOptics_init( ) ! SNICAR optical parameters: call SnowAge_init( ) ! SNICAR aging parameters: diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index ae42966634..35f2851c0b 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -193,6 +193,7 @@ subroutine clm_instInit(bounds) use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use initVerticalMod , only : initVertical + use SnowHydrologyMod , only : InitSnowLayers use accumulMod , only : print_accum_fields use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve use decompMod , only : get_proc_bounds @@ -263,10 +264,15 @@ subroutine clm_instInit(bounds) call initVertical(bounds, & glc_behavior, & - snow_depth_col(begc:endc), & urbanparams_inst%thick_wall(begl:endl), & urbanparams_inst%thick_roof(begl:endl)) + !----------------------------------------------- + ! Set cold-start values for snow levels, snow layers and snow interfaces + !----------------------------------------------- + + call InitSnowLayers(bounds, snow_depth_col(bounds%begc:bounds%endc)) + ! Initialize clm->drv and drv->clm data structures call atm2lnd_inst%Init( bounds, NLFilename ) diff --git a/src/main/initVerticalMod.F90 b/src/main/initVerticalMod.F90 index 58bf29afce..f7a962579c 100644 --- a/src/main/initVerticalMod.F90 +++ b/src/main/initVerticalMod.F90 @@ -28,7 +28,6 @@ module initVerticalMod use GridcellType , only : grc use ColumnType , only : col use glcBehaviorMod , only : glc_behavior_type - use SnowHydrologyMod , only : InitSnowLayers use abortUtils , only : endrun use ncdio_pio ! @@ -54,13 +53,12 @@ module initVerticalMod contains !------------------------------------------------------------------------ - subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof) + subroutine initVertical(bounds, glc_behavior, thick_wall, thick_roof) use clm_varcon, only : zmin_bedrock ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds type(glc_behavior_type), intent(in) :: glc_behavior - real(r8) , intent(in) :: snow_depth(bounds%begc:) real(r8) , intent(in) :: thick_wall(bounds%begl:) real(r8) , intent(in) :: thick_roof(bounds%begl:) ! @@ -118,7 +116,6 @@ subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof begc = bounds%begc; endc= bounds%endc begl = bounds%begl; endl= bounds%endl - SHR_ASSERT_ALL_FL((ubound(snow_depth) == (/endc/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(thick_wall) == (/endl/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(thick_roof) == (/endl/)), sourcefile, __LINE__) @@ -651,12 +648,6 @@ subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof end do end do - !----------------------------------------------- - ! Set cold-start values for snow levels, snow layers and snow interfaces - !----------------------------------------------- - - call InitSnowLayers(bounds, snow_depth(bounds%begc:bounds%endc)) - !----------------------------------------------- ! Read in topographic index and slope !----------------------------------------------- From 0164f445e744726c393a3ea60be9322411fcb7e6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 19 Apr 2021 01:29:02 -0600 Subject: [PATCH 216/219] Add some comments and formatting, also remove hard-coded check that the upper_soil_layer was exactly 3 as ERS_Ly5_P144x1.f10_f10_mg37.IHistClm51BgcCrop.cheyenne_intel.clm-cropMonthOutput passes and with identical answers to previously --- src/biogeochem/CNSharedParamsMod.F90 | 12 ++++--- src/biogeophys/TemperatureType.F90 | 6 ++-- src/biogeophys/WaterDiagnosticBulkType.F90 | 39 ++++++++++++---------- 3 files changed, 32 insertions(+), 25 deletions(-) diff --git a/src/biogeochem/CNSharedParamsMod.F90 b/src/biogeochem/CNSharedParamsMod.F90 index c7e05358a9..f38a7debb5 100644 --- a/src/biogeochem/CNSharedParamsMod.F90 +++ b/src/biogeochem/CNSharedParamsMod.F90 @@ -2,6 +2,8 @@ module CNSharedParamsMod !----------------------------------------------------------------------- ! + ! Parameters that are shared by the Carbon Nitrogen Biogeochemistry modules + ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 implicit none @@ -25,9 +27,9 @@ module CNSharedParamsMod type(CNParamsShareType), protected :: CNParamsShareInst ! Public subroutines - public :: CNParamsReadShared - public :: CNParamsSetSoilDepth - public :: CNParamsReadShared_namelist + public :: CNParamsReadShared ! Read in CN shared parameters + public :: CNParamsSetSoilDepth ! Set the soil depth needed for CNPhenology + public :: CNParamsReadShared_namelist ! Read in CN shared namelist items ! Public data @@ -37,7 +39,7 @@ module CNSharedParamsMod ! Private subroutines and data - private :: CNParamsReadShared_netcdf + private :: CNParamsReadShared_netcdf ! Read shared parameters from NetCDF file character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -62,7 +64,7 @@ end subroutine CNParamsReadShared subroutine CNParamsSetSoilDepth( ) use initVerticalMod, only : find_soil_layer_containing_depth - ! Set the soil depth needed for CNPhenology + ! Set the soil depth needed for CNPhenology call find_soil_layer_containing_depth ( 0.12_r8, upper_soil_layer ) end subroutine CNParamsSetSoilDepth !----------------------------------------------------------------------- diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index a5210c219e..19738e3374 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -467,7 +467,7 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) this%soila10_patch(begp:endp) = spval call hist_addfld1d (fname='SOIL10', units='K', & - avgflag='A', long_name='10-day running mean of 3rd layer soil', & + avgflag='A', long_name='10-day running mean of 12cm layer soil', & ptr_patch=this%soila10_patch, default='inactive') this%t_a5min_patch(begp:endp) = spval @@ -1461,7 +1461,9 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) - if ( upper_soil_layer /= 3 ) call endrun( "abort not 3" ) + ! Accumulate and extract SOIL10, for a sepcific soil layer + !(acumulates SOIL10 as 10-day running mean) + do p = begp,endp c = patch%column(p) rbufslp(p) = this%t_soisno_col(c,upper_soil_layer) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 589776b4f0..e0203deb74 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -38,7 +38,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) - real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg + real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg (m) real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] @@ -79,17 +79,20 @@ module WaterDiagnosticBulkType contains - procedure, public :: InitBulk - procedure, public :: RestartBulk - procedure, public :: Summary - procedure, public :: ResetBulkFilter - procedure, public :: ResetBulk + ! Public interfaces + procedure, public :: InitBulk ! Initiatlization of bulk water diagnostics + procedure, public :: RestartBulk ! Restart bulk water diagnostics + procedure, public :: Summary ! Compute end of time-step summaries of terms + procedure, public :: ResetBulkFilter ! Reset the filter for bulk water + procedure, public :: ResetBulk ! Reset bulk water characteristics + procedure, public :: InitAccBuffer ! Initialize accumulation buffers + procedure, public :: InitAccVars ! Initialize accumulation variables + procedure, public :: UpdateAccVars ! Update accumulation variables + + ! Private subroutines procedure, private :: InitBulkAllocate procedure, private :: InitBulkHistory procedure, private :: InitBulkCold - procedure, public :: InitAccBuffer - procedure, public :: InitAccVars - procedure, public :: UpdateAccVars procedure, private :: RestartBackcompatIssue783 end type waterdiagnosticbulk_type @@ -521,7 +524,8 @@ subroutine InitBulkHistory(this, bounds) end subroutine InitBulkHistory !----------------------------------------------------------------------- - subroutine InitAccBuffer (this, bounds) + + subroutine InitAccBuffer (this, bounds) ! ! !DESCRIPTION: ! Initialize accumulation buffer for all required module accumulated fields @@ -542,11 +546,11 @@ subroutine InitAccBuffer (this, bounds) desc='5-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & subgrid_type='column', numlev=1, init_value=0._r8) - end subroutine InitAccBuffer !----------------------------------------------------------------------- - subroutine InitAccVars (this, bounds) + + subroutine InitAccVars (this, bounds) ! !DESCRIPTION: ! Initialize module variables that are associated with ! time accumulated fields. This routine is called for both an initial run @@ -581,8 +585,11 @@ subroutine InitAccVars (this, bounds) end subroutine InitAccVars -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine UpdateAccVars (this, bounds) + ! + ! Update the accumulation variuables ! ! USES use clm_time_manager, only : get_nstep @@ -603,16 +610,12 @@ subroutine UpdateAccVars (this, bounds) ! Allocate needed dynamic memory for single level patch field - - ! Accumulate and extract snow 10 day + ! Accumulate and extract 5 day average of snow depth call update_accum_field ('SNOW_5D', this%snow_depth_col, nstep) call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) - - end subroutine UpdateAccVars - !----------------------------------------------------------------------- subroutine InitBulkCold(this, bounds, & From 8ec39e826c1e9ea08eb739b763e2fb39ec2ef816 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 19 Apr 2021 15:21:40 -0600 Subject: [PATCH 217/219] Add reference to issue --- src/main/histFileMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 6a9100edfc..3587e920cb 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -5592,11 +5592,11 @@ subroutine add_landunit_mask_metadata(ncid, varid, l2g_scale_type) !----------------------------------------------------------------------- if (l2g_scale_type == 'unity') then - ! TODO(wjs, 2021-04-16) Once we consistently set l2g_scale_type for all variables, - ! and have stopped using other mechanisms (particularly the setting of variables to - ! spval everywhere) then we can stop setting this to 'unknown': we can instead set - ! this to something like 'all', with reasonable confidence that the field truly - ! applies over all landunits. + ! BUG(wjs, 2021-04-19, ESCOMP/CTSM#1347) Once we consistently set l2g_scale_type + ! for all variables, and have stopped using other mechanisms (particularly the + ! setting of variables to spval everywhere) then we can stop setting this to + ! 'unknown': we can instead set this to something like 'all', with reasonable + ! confidence that the field truly applies over all landunits. landunit_mask_string = 'unknown' else landunit_mask_string = l2g_scale_type From f78d4cf1332aebf5a4a430350999b3bb86d95cdc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 19 Apr 2021 16:02:38 -0600 Subject: [PATCH 218/219] Update change files --- doc/ChangeLog | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 117 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index f178eee325..8ab8b9e889 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,120 @@ =============================================================== +Tag name: ctsm5.1.dev034 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Mon Apr 19 16:02:29 MDT 2021 +One-line Summary: Bring in Arctic changes to LUNA from Leah Birch + +Purpose and description of changes +---------------------------------- + +This is @lmbirch89 branch from #947 with the exception that Kattge is used in place of +Leuning in LUNA. Also the startup initial values in the luna bug fix branch #961 is +used in place of the updated values by @lmbirch89. The LUNA bug fixes have already come +in, so these are some changes to improve arctic plants. + +We have addressed the issues in phenology and photosynthesis in the high latitudes. +Development was focused on PFT specific differences and we used observations to inform +model development. GPP is improved now such that the tundra is realistically less +productive than the boreal forest. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[x] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + Fixes #807 -- Revisit PFT optical properties per Majasalmi and Bright (2019) + Fixes #1307 -- Turn on reseed_dead_plants when you start AD spinup mode + +Known bugs introduced in this tag (include issue #): + #1346 -- Use of floating point flag onset_thresh is confusing in CNPhenologyMod + +Notes of particular relevance for users +--------------------------------------- + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + New namelist items: onset_thresh_depends_on_veg and min_crtical_dayl_depends_on_lat + +Changes made to namelist defaults (e.g., changed parameter values): + reseed_dead_plants turned on when AD spinup mode turned on + onset_thresh_depends_on_veg and min_crtical_dayl_depends_on_lat turned on for clm5_1 physics + +Changes to the datasets (e.g., parameter, surface or initial files): + New parameter file (same as start used in PPE work) also has additional fields on it + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + As noted in #1346 some of the logic in CNPhenology in CNSeasonDecidPhenology is a bit confusing. + The soil layer used was put in CNSharedParameters and needed it's own subroutine to prevent circular dependencies. + There are new accumulator variables added that area always turned on even when not needed. Doing this + in a reasonable manner (without having lots of CNPhenology logic spilled into base types) would require + a refactoring of a better way to figure this out. + +Testing summary: regular +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: Yes for clm5_1 physics + + Summarize any changes to answers, i.e., + - what code configurations: clm5_1 + - what platforms/compilers: all + - nature of change: new climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + oleson -- clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_1850AD + + URL for LMWG diagnostics output used to validate new climate: + http://webext.cgd.ucar.edu/I1850/clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_1850AD/ + + +Other details +------------- +Pull Requests that document the changes (include PR ids): #990 +(https://github.com/ESCOMP/ctsm/pull) + + #990 -- Arctic changes branch with Kattge in place of Leuning in LUNA + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev033 Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) Date: Sat Apr 10 16:42:06 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 604005f609..08eef1df26 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev034 erik 04/19/2021 Bring in Arctic changes to LUNA from Leah Birch ctsm5.1.dev033 mvertens 04/10/2021 Remove unnecessary settings of nextsw_cday ctsm5.1.dev032 mvertens 04/10/2021 Fix bugs in co2 from atmosphere ctsm5.1.dev031 jedwards 04/10/2021 Update externals and fixes for nuopc threading From a5b2e16a4f93d980695557ece55cacf346e302f6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 20 Apr 2021 11:10:57 -0600 Subject: [PATCH 219/219] Update ChangeLog --- doc/ChangeLog | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 106 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8ab8b9e889..62f7b7e16e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,109 @@ =============================================================== +Tag name: ctsm5.1.dev035 +Originator(s): sacks (Bill Sacks) +Date: Tue Apr 20 10:45:25 MDT 2021 +One-line Summary: Misc bfb enhancements and fixes + +Purpose and description of changes +---------------------------------- + +(1) If CISM is running over Antarctica, use virtual glacier columns over + Antarctica + +(2) Remove "mec" from some glacier/ice variable names (it is misleading + to have "mec" in variable names when the ice landunit can actually + have multiple columns *or* a single column) (ESCOMP/CTSM#1294) + +(3) Add history file metadata on each variable's l2g_scale_type (adds a + landunit_mask attribute) (ESCOMP/CTSM#1343) + +(4) Use python3 in more shebang lines - needed to run python unit tests + on cheyenne + +(5) New compset naming for IG compsets (ESCOMP/CTSM#1289) + +(6) Remove calculation of fun_cost_fix that is overwritten + (ESCOMP/CTSM#1115) + +(7) Bypass grid-level water mass check when fates hydro is active + (ESCOMP/CTSM#1334) + +(8) Remove some dead code (ESCOMP/CTSM#1333) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1115 (overwrite fun_cost_fix) +- Resolves ESCOMP/CTSM#1289 (After updating to cism2_1_76 or later, + change compsets involving CISM) +- Resolves ESCOMP/CTSM#1294 (Replace istice_mec with istice) +- Resolves ESCOMP/CTSM#1333 (Remove some dead code) +- Resolves ESCOMP/CTSM#1343 (Add landunit_mask (formerly l2g_scale_type) + metadata to history file) + +Notes of particular relevance for users +--------------------------------------- +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): +- Renamed maxpatch_glcmec to maxpatch_glc + +Substantial timing or memory changes: +- Increase in land initialization time in the PFS test + (PFS_Ld20.f09_g17.I2000Clm50BgcCrop.cheyenne_intel); this is probably + due to machine variability because I don't think any of the changes in + this tag would have any significant impact on model initialization + time. + + +Testing summary: +---------------- + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - ok (tests pass, namelists differ as expected) + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - pass (ran 'make test' on cheyenne and 'make all' on my Mac) + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- ok + izumi ------- ok + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- + +Pull Requests that document the changes (include PR ids): +- One small piece is documented in https://github.com/ESCOMP/CTSM/pull/1334 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev034 Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Mon Apr 19 16:02:29 MDT 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index 08eef1df26..1816a557a9 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev035 sacks 04/20/2021 Misc bfb enhancements and fixes ctsm5.1.dev034 erik 04/19/2021 Bring in Arctic changes to LUNA from Leah Birch ctsm5.1.dev033 mvertens 04/10/2021 Remove unnecessary settings of nextsw_cday ctsm5.1.dev032 mvertens 04/10/2021 Fix bugs in co2 from atmosphere