From 9a1474fec8356457feecdbdea2c7f707c77e0115 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Fri, 7 May 2021 17:12:28 +0200 Subject: [PATCH 01/37] add DOM mass balance code module --- src/riverroute/DommasbMod.F90 | 51 +++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100755 src/riverroute/DommasbMod.F90 diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 new file mode 100755 index 0000000..ede41f1 --- /dev/null +++ b/src/riverroute/DommasbMod.F90 @@ -0,0 +1,51 @@ +MODULE DOMmassbMod + !Description: core code of Dissolved Organic Matter mass balance utilizing river routing models + !Developed by Dev Narayanappa 05/03/2021 + !This module is currently made interact with MOSART routing model + ! USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI + use shr_sys_mod , only : shr_sys_abort + use RunoffMod , only : TRunoff, Tdom + + implicit none + + public hillslopeRoutingDOM + public subnetworkRoutingDOM + public mainchannelRoutingDOM + !-------------------------------------------------------------------- + + ! ! PUBLIC MEMBER FUNCTIONS: + contains + + !---------------------------------------------------------------------- + subroutine hillslopeRoutingDOM(iunit,nt,theDeltaT) + ! ! DESCRIPTION: solve the ODEs with Euler algorithm for hillslope routing + implicit none + integer, intent(in) :: iunit, nt + real(r8), intent(in) :: theDeltaT + ! assume no chemical reaction in the water hence sink term is zero implies domH ~= domHout + Tdom%domH(iunit,nt) = Tdom%domH(iunit,nt) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,nt) + TdomH%domSource) * theDeltaT/TRunoff%wh(iunit,nt) + end subroutine hillslopeRoutingDOM + + subroutine subnetworkRoutingDOM(iunit,nt,theDeltaT) + ! solve the ODEs with Euler algorithm for subnetwork routing + implicit none + integer, intent(in) :: iunit,nt + real(r8), intent(in) :: theDeltaT + Tdom%domT(iunit,nt) = Tdom%domT(iunit,nt) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,nt) - TRunoff%etout(iunit,nt) * Tdom%domT(iunit,nt)) * theDeltaT/TRunoff%wt(iunit,nt) + !upstream interaction + !Tdom%domR(iunit,nt) = Tdom%domR(iunit,nt) + (TRunoff%erin(iunit,nt) * Tdom%domT(iunit,nt) - TRunoff%erout(iunit,nt) * Tdom%domR(iunit,nt)) *theDeltaT/TRunoff%wr(iunit,nt) + end subroutine subnetworkRoutingDOM + + subroutine mainchannelRoutingDOM(iunit,nt,theDeltaT) + ! solve the ODE with Euler algorithm for main-channel routing + implicit none + integer, intent(in) :: iunit, nt + real(r8), intent(in) :: theDeltaT + real(r8),intent(in) :: erintemp + erintemp = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) + Tdom%dom(iunit,nt) = Tdom%dom(iunit,nt) + ( (erintemp*domT(iunit,nt) + TRunoff%eroutUp(iunit,nt)*Tdom%domTUp(iunit,nt)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,nt))*theDeltaT/TRunoff%wr(iunit,nt) + end subroutine mainchannelRoutingDOM +!------------------------------------------------------------------------- +end MODULE DOMmassbMod From 02ebfba5c9c048a2e4ff356cccbf2b586c5ea0b7 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Sat, 8 May 2021 17:14:42 +0200 Subject: [PATCH 02/37] call DOM module --- src/riverroute/MOSART_physics_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index a2d327f..eae7f16 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -14,11 +14,12 @@ MODULE MOSART_physics_mod use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort use RtmVar , only : iulog, barrier_timers, nt_rtm, rtm_tracers - use RunoffMod , only : Tctl, TUnit, TRunoff, TPara, rtmCTL + use RunoffMod , only : Tctl, TUnit, TRunoff, TPara, rtmCTL,Tdom use RunoffMod , only : SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp use RtmSpmd , only : masterproc, mpicom_rof use perf_mod , only: t_startf, t_stopf use mct_mod + use DommasbMod implicit none private @@ -63,6 +64,7 @@ subroutine Euler TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) + call hillslopeRoutingDOM(iunit,nt,Tctl%DeltaT) endif end do endif @@ -101,6 +103,7 @@ subroutine Euler TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) + call subnetworkRoutingDOM(iunit,nt,localDeltaT) end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) endif From bdb1e455a2298a37ba679ab1500e5051ec3710c2 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Sat, 8 May 2021 18:49:39 +0200 Subject: [PATCH 03/37] Declare a type for DOM variables --- src/riverroute/RunoffMod.F90 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 5e6ae89..370f6a3 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -269,13 +269,33 @@ module RunoffMod real(r8), pointer :: c_nr(:) ! coefficient to adjust the manning's roughness of channels real(r8), pointer :: c_nh(:) ! coefficient to adjust the manning's roughness of overland flow across hillslopes real(r8), pointer :: c_twid(:) ! coefficient to adjust the width of sub-reach channel - end type Tparameter - + end type Tparameter + + ! DOM status and flux variables + public :: Domflux + type Domflux + !dom source generated from CLM soil carbon + real(r8), pointer :: domSource(:,:) ! dom production from soil organic matter (mgC/L/day) + !hillslope + real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (mgC/L) + !sub-network + real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (mgC/L) + !main channel upstream interactions + real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (mgC/L) + !out flow from the outlet + real(r8), pointer :: dom(:,:) ! dom outflow from main channel to ocean (mgC/L) + !history fields + real(r8), pointer :: doc(:) ! dissolved organic carbon (mgC/L) from dom + real(r8), pointer :: don(:) ! dissolved organic nitrogen (mgN/L) from dom + real(r8), pointer :: domTUp(:,:) ! outflow sum of upstream gridcells,instantaneous (mgC/L) + end type Domflux + !== Hongyi type (Tcontrol) , public :: Tctl type (Tspatialunit), public :: TUnit type (TstatusFlux) , public :: TRunoff type (Tparameter) , public :: TPara + type (Domflux) , public :: Tdom !== Hongyi type (runoff_flow) , public :: rtmCTL From f0e77affe19a199ef6fb576c4d2275733df7de9b Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Sat, 8 May 2021 19:23:18 +0200 Subject: [PATCH 04/37] Declare dom variables --- src/riverroute/RtmMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 494a2b6..9228191 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -2544,6 +2544,18 @@ subroutine MOSART_init allocate (TPara%c_twid(begr:endr)) TPara%c_twid = 1.0_r8 + !Initialize dom flux variables + allocate (domSource(begr:endr,nt_rtm)) + Tdom%domSource = 0._r8 + allocate (Tdom%domH(begr:endr,nt_rtm)) + Tdom%domH = 0._r8 + allocate (Tdom%domT(begr:endr,nt_rtm)) + Tdom%domT = 0._r8 + allocate (Tdom%domR(begr:endr,nt_rtm)) + Tdom%domR = 0._r8 + allocate (Tdom%dom(begr:endr,nt_rtm)) + Tdom%dom = 0._r8 + call pio_freedecomp(ncid, iodesc_dbl) call pio_freedecomp(ncid, iodesc_int) call pio_closefile(ncid) From 3b0d992cfd7fe49646958fcde189fc6869cc643c Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Sun, 16 May 2021 18:38:49 +0200 Subject: [PATCH 05/37] add DOC/DON variables to output --- src/riverroute/RtmHistFlds.F90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 8550930..3f9acc3 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -9,7 +9,7 @@ module RtmHistFlds ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use RunoffMod , only : rtmCTL + use RunoffMod , only : rtmCTL,Tdom use RtmHistFile , only : RtmHistAddfld, RtmHistPrintflds use RtmVar , only : nt_rtm, rtm_tracers @@ -130,6 +130,14 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='Actual irrigation (if limited by river storage)', & ptr_rof=rtmCTL%qirrig_actual, default='inactive') + call RtmHistAddfld (fname='DOC'//'_'//trim(rtm_tracers(3)), units='mgC/L', & + avgflag='A', long_name='Dissolved Organic Carbon: '//trim(rtm_tracers(3)), & + ptr_rof=Tdom%doc, default='active') + + call RtmHistAddfld (fname='DON'//'_'//trim(rtm_tracers(4)), units='mgC/L', & + avgflag='A', long_name='Dissolved Organic Nitrogen: '//trim(rtm_tracers(4)), & + ptr_rof=Tdom%don, default='active') + ! Print masterlist of history fields call RtmHistPrintflds() @@ -152,6 +160,9 @@ subroutine RtmHistFldsSet() rtmCTL%runofflnd_nt1(:) = rtmCTL%runofflnd(:,1) rtmCTL%runofflnd_nt2(:) = rtmCTL%runofflnd(:,2) + Tdom%doc(:) = Tdom%dom(:,3) + Tdom%don(:) = Tdom%dom(:,4) + rtmCTL%runoffocn_nt1(:) = rtmCTL%runoffocn(:,1) rtmCTL%runoffocn_nt2(:) = rtmCTL%runoffocn(:,2) From dc541fb49d568c19378a1ab5457a800550e42db2 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Fri, 21 May 2021 23:12:17 +0200 Subject: [PATCH 06/37] add DOC, DON as tracer index --- src/riverroute/RtmVar.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/riverroute/RtmVar.F90 b/src/riverroute/RtmVar.F90 index 744cf01..5384f06 100644 --- a/src/riverroute/RtmVar.F90 +++ b/src/riverroute/RtmVar.F90 @@ -8,8 +8,8 @@ module RtmVar implicit none !TODO - nt_rtm and rtm_tracers need to be removed and set by access to the index array - integer, parameter, public :: nt_rtm = 2 ! number of tracers - character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE'/) + integer, parameter, public :: nt_rtm = 4 ! number of tracers + character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE','DOC','DON'/) ! Constants integer, parameter, private :: iundef = -9999999 From bd2272d77c3107a4ff185652ed92dac175cf311b Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Mon, 24 May 2021 11:30:00 +0200 Subject: [PATCH 07/37] add DOM mass balance subroutines --- src/riverroute/DommasbMod.F90 | 19 ++++++++++--------- src/riverroute/MOSART_physics_mod.F90 | 8 +++++++- src/riverroute/RtmHistFlds.F90 | 10 +++++----- src/riverroute/RtmMod.F90 | 18 +++++++++++++++--- src/riverroute/RunoffMod.F90 | 16 ++++++++++++++-- 5 files changed, 51 insertions(+), 20 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index ede41f1..6705da9 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -1,4 +1,4 @@ -MODULE DOMmassbMod +MODULE DommasbMod !Description: core code of Dissolved Organic Matter mass balance utilizing river routing models !Developed by Dev Narayanappa 05/03/2021 !This module is currently made interact with MOSART routing model @@ -25,7 +25,7 @@ subroutine hillslopeRoutingDOM(iunit,nt,theDeltaT) integer, intent(in) :: iunit, nt real(r8), intent(in) :: theDeltaT ! assume no chemical reaction in the water hence sink term is zero implies domH ~= domHout - Tdom%domH(iunit,nt) = Tdom%domH(iunit,nt) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,nt) + TdomH%domSource) * theDeltaT/TRunoff%wh(iunit,nt) + Tdom%domH(iunit,nt) = Tdom%domH(iunit,nt) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,nt) + Tdom%domSource(iunit,nt)) * theDeltaT/TRunoff%wh(iunit,nt) end subroutine hillslopeRoutingDOM subroutine subnetworkRoutingDOM(iunit,nt,theDeltaT) @@ -34,18 +34,19 @@ subroutine subnetworkRoutingDOM(iunit,nt,theDeltaT) integer, intent(in) :: iunit,nt real(r8), intent(in) :: theDeltaT Tdom%domT(iunit,nt) = Tdom%domT(iunit,nt) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,nt) - TRunoff%etout(iunit,nt) * Tdom%domT(iunit,nt)) * theDeltaT/TRunoff%wt(iunit,nt) - !upstream interaction - !Tdom%domR(iunit,nt) = Tdom%domR(iunit,nt) + (TRunoff%erin(iunit,nt) * Tdom%domT(iunit,nt) - TRunoff%erout(iunit,nt) * Tdom%domR(iunit,nt)) *theDeltaT/TRunoff%wr(iunit,nt) end subroutine subnetworkRoutingDOM subroutine mainchannelRoutingDOM(iunit,nt,theDeltaT) ! solve the ODE with Euler algorithm for main-channel routing implicit none integer, intent(in) :: iunit, nt - real(r8), intent(in) :: theDeltaT - real(r8),intent(in) :: erintemp - erintemp = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) - Tdom%dom(iunit,nt) = Tdom%dom(iunit,nt) + ( (erintemp*domT(iunit,nt) + TRunoff%eroutUp(iunit,nt)*Tdom%domTUp(iunit,nt)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,nt))*theDeltaT/TRunoff%wr(iunit,nt) + real(r8), intent(in) :: theDeltaT + real(r8) :: mainchinT, mainchinUp + real(r8) :: mainchout + mainchinT = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) !input to main channel from Tributaries + mainchinUp = TRunoff%eroutUp(iunit,nt) !inflow to main channel from Upstream grid cells of main channel + mainchout = TRunoff%flow(iunit,nt) ! flow to the outlet of the reach in the main channel + Tdom%domR(iunit,nt) = Tdom%domR(iunit,nt) + ( (mainchinT*Tdom%domT(iunit,nt) + mainchinUp*Tdom%domRout(iunit,nt)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,nt))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- -end MODULE DOMmassbMod +end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index eae7f16..dab4a88 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -16,6 +16,7 @@ MODULE MOSART_physics_mod use RtmVar , only : iulog, barrier_timers, nt_rtm, rtm_tracers use RunoffMod , only : Tctl, TUnit, TRunoff, TPara, rtmCTL,Tdom use RunoffMod , only : SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp + use RunoffMod , only : SMatP_domRUp, avsrc_domRUp, avdst_domRUp use RtmSpmd , only : masterproc, mpicom_rof use perf_mod , only: t_startf, t_stopf use mct_mod @@ -136,16 +137,20 @@ subroutine Euler #else !--- copy erout into avsrc_eroutUp --- call mct_avect_zero(avsrc_eroutUp) + call mct_avect_zero(avsrc_eroutUp) cnt = 0 do iunit = rtmCTL%begr,rtmCTL%endr cnt = cnt + 1 do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) + avsrc_domRUp%rAttr(nt,cnt) = Tdom%domR(iunit,nt) enddo enddo call mct_avect_zero(avdst_eroutUp) + call mct_avect_zero(avdst_domRUp) call mct_sMat_avMult(avsrc_eroutUp, sMatP_eroutUp, avdst_eroutUp) + call mct_sMat_avMult(avsrc_domRUp, sMatP_domRUp, avdst_domRUp) !--- add mapped eroutUp to TRunoff --- cnt = 0 @@ -160,7 +165,7 @@ subroutine Euler TRunoff%eroutup_avg = TRunoff%eroutup_avg + TRunoff%eroutUp TRunoff%erlat_avg = TRunoff%erlat_avg + TRunoff%erlateral - + Tdom%domRout = Tdom%domRout + Tdom%domRUp !------------------ ! channel routing !------------------ @@ -175,6 +180,7 @@ subroutine Euler do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT + call mainchannelRoutingDOM(iunit,nt,localDeltaT) ! check for negative channel storage ! if(TRunoff%wr(iunit,1) < -1.e-10) then ! write(iulog,*) 'Negative channel storage! ', iunit, TRunoff%wr(iunit,1) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 3f9acc3..e2e3a53 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -9,7 +9,7 @@ module RtmHistFlds ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use RunoffMod , only : rtmCTL,Tdom + use RunoffMod , only : rtmCTL, Tdom use RtmHistFile , only : RtmHistAddfld, RtmHistPrintflds use RtmVar , only : nt_rtm, rtm_tracers @@ -132,11 +132,11 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='DOC'//'_'//trim(rtm_tracers(3)), units='mgC/L', & avgflag='A', long_name='Dissolved Organic Carbon: '//trim(rtm_tracers(3)), & - ptr_rof=Tdom%doc, default='active') + ptr_rof=rtmCTL%dom_nt3, default='active') call RtmHistAddfld (fname='DON'//'_'//trim(rtm_tracers(4)), units='mgC/L', & avgflag='A', long_name='Dissolved Organic Nitrogen: '//trim(rtm_tracers(4)), & - ptr_rof=Tdom%don, default='active') + ptr_rof=rtmCTL%dom_nt4, default='active') ! Print masterlist of history fields @@ -160,8 +160,8 @@ subroutine RtmHistFldsSet() rtmCTL%runofflnd_nt1(:) = rtmCTL%runofflnd(:,1) rtmCTL%runofflnd_nt2(:) = rtmCTL%runofflnd(:,2) - Tdom%doc(:) = Tdom%dom(:,3) - Tdom%don(:) = Tdom%dom(:,4) + rtmCTL%dom_nt3(:) = Tdom%domR(:,3) + rtmCTL%dom_nt4(:) = Tdom%domR(:,4) rtmCTL%runoffocn_nt1(:) = rtmCTL%runoffocn(:,1) rtmCTL%runoffocn_nt2(:) = rtmCTL%runoffocn(:,2) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 9228191..980a844 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -24,7 +24,7 @@ module RtmMod barrier_timers use RtmFileUtils , only : getfil, getavu, relavu use RtmTimeManager , only : timemgr_init, get_nstep, get_curr_date - use RtmHistFlds , only : RtmHistFldsInit, RtmHistFldsSet + use RtmHistFlds , only : RtmHistFldsInit, RtmHistFldsSet use RtmHistFile , only : RtmHistUpdateHbuf, RtmHistHtapesWrapup, RtmHistHtapesBuild, & rtmhist_ndens, rtmhist_mfilt, rtmhist_nhtfrq, & rtmhist_avgflag_pertape, rtmhist_avgflag_pertape, & @@ -37,7 +37,8 @@ module RtmMod gsmap_r, & SMatP_dnstrm, avsrc_dnstrm, avdst_dnstrm, & SMatP_direct, avsrc_direct, avdst_direct, & - SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp + SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp, & + Tdom use MOSART_physics_mod, only : Euler use MOSART_physics_mod, only : updatestate_hillslope, updatestate_subnetwork, & updatestate_mainchannel @@ -1821,6 +1822,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%qsur(nr,nt) = TRunoff%qsur(nr,nt) / rtmCTL%area(nr) TRunoff%qsub(nr,nt) = TRunoff%qsub(nr,nt) / rtmCTL%area(nr) TRunoff%qgwl(nr,nt) = TRunoff%qgwl(nr,nt) / rtmCTL%area(nr) + Tdom%domSource(nr,nt) = 1000._r8 enddo enddo @@ -2545,7 +2547,7 @@ subroutine MOSART_init TPara%c_twid = 1.0_r8 !Initialize dom flux variables - allocate (domSource(begr:endr,nt_rtm)) + allocate (Tdom%domSource(begr:endr,nt_rtm)) Tdom%domSource = 0._r8 allocate (Tdom%domH(begr:endr,nt_rtm)) Tdom%domH = 0._r8 @@ -2553,8 +2555,18 @@ subroutine MOSART_init Tdom%domT = 0._r8 allocate (Tdom%domR(begr:endr,nt_rtm)) Tdom%domR = 0._r8 + allocate (Tdom%domRout(begr:endr,nt_rtm)) + Tdom%domRout = 0._r8 + allocate (Tdom%domRin(begr:endr,nt_rtm)) + Tdom%domRin = 0._r8 + allocate (Tdom%domRUp(begr:endr,nt_rtm)) + Tdom%domRUp = 0._r8 allocate (Tdom%dom(begr:endr,nt_rtm)) Tdom%dom = 0._r8 + !allocate (Tdom%doc(begr:endr)) + !Tdom%doc = 0._r8 + !allocate (Tdom%don(begr:endr)) + !Tdom%don = 0._r8 call pio_freedecomp(ncid, iodesc_dbl) call pio_freedecomp(ncid, iodesc_int) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 370f6a3..59ba4c2 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -30,6 +30,10 @@ module RunoffMod type(mct_sMatP),public :: sMatP_eroutUp ! sparse matrix plus for eroutUp calc type(mct_avect),public :: avsrc_eroutUp ! src avect for SM mult eroutUp calc type(mct_avect),public :: avdst_eroutUp ! dst avect for SM mult eroutUp calc + type(mct_sMatP),public :: sMatP_domRUp ! sparse matrix plus for domRoutUp calc + type(mct_avect),public :: avsrc_domRUp ! src avect for SM mult domRoutUp calc + type(mct_avect),public :: avdst_domRUp ! dst avect for SM mult domRoutUp calc + public :: runoff_flow type runoff_flow @@ -61,7 +65,7 @@ module RunoffMod real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) real(r8), pointer :: fthresh(:) ! RTM water flood threshold - + real(r8), pointer :: domlnd(:,:) ! dom amsked for land (mgC/L) ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) real(r8), pointer :: wt(:,:) ! MOSART sub-network water storage (m3) @@ -103,6 +107,8 @@ module RunoffMod real(r8), pointer :: qsub_nt2(:) real(r8), pointer :: qgwl_nt1(:) real(r8), pointer :: qgwl_nt2(:) + real(r8), pointer :: dom_nt3(:) + real(r8), pointer :: dom_nt4(:) end type runoff_flow @@ -282,12 +288,14 @@ module RunoffMod real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (mgC/L) !main channel upstream interactions real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (mgC/L) + real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (mgC/L) + real(r8), pointer :: domRout(:,:) ! flow from upstream grids (mgC/L) + real(r8), pointer :: domRin(:,:) ! flow to downstream grid cells (mgC/L) !out flow from the outlet real(r8), pointer :: dom(:,:) ! dom outflow from main channel to ocean (mgC/L) !history fields real(r8), pointer :: doc(:) ! dissolved organic carbon (mgC/L) from dom real(r8), pointer :: don(:) ! dissolved organic nitrogen (mgN/L) from dom - real(r8), pointer :: domTUp(:,:) ! outflow sum of upstream gridcells,instantaneous (mgC/L) end type Domflux !== Hongyi @@ -313,6 +321,7 @@ subroutine RunoffInit(begr, endr, numr) allocate(rtmCTL%runoff(begr:endr,nt_rtm), & rtmCTL%dvolrdt(begr:endr,nt_rtm), & rtmCTL%runofflnd(begr:endr,nt_rtm), & + rtmCTL%domlnd(begr:endr,nt_rtm), & rtmCTL%dvolrdtlnd(begr:endr,nt_rtm), & rtmCTL%runoffocn(begr:endr,nt_rtm), & rtmCTL%dvolrdtocn(begr:endr,nt_rtm), & @@ -358,6 +367,8 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%qgwl(begr:endr,nt_rtm), & rtmCTL%qirrig(begr:endr), & rtmCTL%qirrig_actual(begr:endr), & + rtmCTL%dom_nt3(begr:endr), & + rtmCTL%dom_nt4(begr:endr), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -366,6 +377,7 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runoff(:,:) = 0._r8 rtmCTL%runofflnd(:,:) = spval + rtmCTL%domlnd(:,:) = spval rtmCTL%runoffocn(:,:) = spval rtmCTL%runofftot(:,:) = spval rtmCTL%dvolrdt(:,:) = 0._r8 From bfd5fc24af3ec27045384e7a3fca8925b81d5d2f Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Mon, 24 May 2021 15:44:24 +0200 Subject: [PATCH 08/37] include if condition to avoid division by zero --- src/riverroute/MOSART_physics_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index dab4a88..029c94b 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -65,7 +65,9 @@ subroutine Euler TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) - call hillslopeRoutingDOM(iunit,nt,Tctl%DeltaT) + if (wh(iunit,nt)> 0._r8 ) then + call hillslopeRoutingDOM(iunit,nt,Tctl%DeltaT) + endif !wh endif end do endif From 10892024d718ace9f9e1552a4fec196d8960765f Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Mon, 24 May 2021 16:02:28 +0200 Subject: [PATCH 09/37] correction to include Type for wh --- src/riverroute/MOSART_physics_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 029c94b..48b2314 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -65,7 +65,7 @@ subroutine Euler TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) - if (wh(iunit,nt)> 0._r8 ) then + if (TRunoff%wh(iunit, nt) > 0._r8 ) then call hillslopeRoutingDOM(iunit,nt,Tctl%DeltaT) endif !wh endif From 22196b05bdde241966465989111385fe17a6b543 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Thu, 3 Jun 2021 22:05:31 +0200 Subject: [PATCH 10/37] update domRUp variable --- src/riverroute/RtmMod.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 980a844..b811571 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -38,6 +38,7 @@ module RtmMod SMatP_dnstrm, avsrc_dnstrm, avdst_dnstrm, & SMatP_direct, avsrc_direct, avdst_direct, & SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp, & + sMatP_domRUp, avsrc_domRUp, avdst_domRUp, & Tdom use MOSART_physics_mod, only : Euler use MOSART_physics_mod, only : updatestate_hillslope, updatestate_subnetwork, & @@ -2670,6 +2671,7 @@ subroutine MOSART_init enddo call mct_sMatP_Init(sMatP_eroutUp, sMat, gsMap_r, gsMap_r, 0, mpicom_rof, ROFID) + call mct_sMatP_Init(sMatP_domRUp, sMat, gsMap_r, gsMap_r, 0, mpicom_rof, ROFID) elseif (smat_option == 'Xonly' .or. smat_option == 'Yonly') then ! root initialization @@ -2711,6 +2713,7 @@ subroutine MOSART_init call mct_avect_clean(avtmp) call mct_sMatP_Init(sMatP_eroutUp, sMat, gsMap_r, gsMap_r, smat_option, 0, mpicom_rof, ROFID) + call mct_sMatP_Init(sMatP_domRUp, sMat, gsMap_r, gsMap_r, smat_option, 0, mpicom_rof, ROFID) else @@ -2727,8 +2730,11 @@ subroutine MOSART_init if ( masterproc ) write(iulog,*) trim(subname),' MOSART initialize avect ',trim(rList) call mct_aVect_init(avsrc_eroutUp,rList=rList,lsize=rtmCTL%lnumr) call mct_aVect_init(avdst_eroutUp,rList=rList,lsize=rtmCTL%lnumr) + call mct_aVect_init(avsrc_domRUp,rList=rList,lsize=rtmCTL%lnumr) + call mct_aVect_init(avdst_domRUp,rList=rList,lsize=rtmCTL%lnumr) lsize = mct_smat_gNumEl(sMatP_eroutUp%Matrix,mpicom_rof) + lsize = mct_smat_gNumEl(sMatP_domRUp%Matrix,mpicom_rof) if (masterproc) write(iulog,*) subname," Done initializing SmatP_eroutUp, nElements = ",lsize ! keep only sMatP @@ -2750,6 +2756,7 @@ subroutine MOSART_init cnt = cnt + 1 avdst_eroutUp%rAttr(1,cnt) = rtmCTL%area(nr) Tunit%areatotal2(nr) = avdst_eroutUp%rAttr(1,cnt) + avdst_domRUp%rAttr(1,cnt) = rtmCTL%area(nr) enddo tcnt = 0 @@ -2762,14 +2769,19 @@ subroutine MOSART_init ! copy avdst to avsrc for next downstream step cnt = 0 call mct_avect_zero(avsrc_eroutUp) + call mct_avect_zero(avsrc_domRUp) do nr = rtmCTL%begr,rtmCTL%endr cnt = cnt + 1 avsrc_eroutUp%rAttr(1,cnt) = avdst_eroutUp%rAttr(1,cnt) + avsrc_domRUp%rAttr(1.cnt) = avdst_domRUp%rAttr(1,cnt) enddo call mct_avect_zero(avdst_eroutUp) + call mct_avect_zero(avdst_domRUp) call mct_sMat_avMult(avsrc_eroutUp, sMatP_eroutUp, avdst_eroutUp) + call mct_sMat_avMult(avsrc_domRUp, sMatP_domRUp, avdst_domRUp) + ! add avdst to areatot and compute new global sum cnt = 0 From 22fa84c1c419b2d51d8bae3cac76c754fc62920c Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Thu, 3 Jun 2021 22:12:23 +0200 Subject: [PATCH 11/37] comma addition b/w 1 and cnt --- src/riverroute/RtmMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index b811571..2dfec8d 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -2770,10 +2770,11 @@ subroutine MOSART_init cnt = 0 call mct_avect_zero(avsrc_eroutUp) call mct_avect_zero(avsrc_domRUp) + do nr = rtmCTL%begr,rtmCTL%endr cnt = cnt + 1 avsrc_eroutUp%rAttr(1,cnt) = avdst_eroutUp%rAttr(1,cnt) - avsrc_domRUp%rAttr(1.cnt) = avdst_domRUp%rAttr(1,cnt) + avsrc_domRUp%rAttr(1,cnt) = avdst_domRUp%rAttr(1,cnt) enddo call mct_avect_zero(avdst_eroutUp) From 2233bbfc78acae44065a5799f77477b6f6c89968 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Mon, 7 Jun 2021 21:14:34 +0200 Subject: [PATCH 12/37] correction to eroutUp --- src/riverroute/MOSART_physics_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 48b2314..b4ea41b 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -106,7 +106,9 @@ subroutine Euler TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) - call subnetworkRoutingDOM(iunit,nt,localDeltaT) + if (TRunoff%wt(iunit,nt) > 0._r8) then + call subnetworkRoutingDOM(iunit,nt,localDeltaT) + endif !wt end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) endif From 691552d25076b67090f91f6046e8a219ab3ef102 Mon Sep 17 00:00:00 2001 From: Devaraju Narayanappa Date: Mon, 7 Jun 2021 21:16:04 +0200 Subject: [PATCH 13/37] add file pycache --- cime_config/__pycache__/buildnmlcpython-39.pyc | Bin 0 -> 4937 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 cime_config/__pycache__/buildnmlcpython-39.pyc diff --git a/cime_config/__pycache__/buildnmlcpython-39.pyc b/cime_config/__pycache__/buildnmlcpython-39.pyc new file mode 100644 index 0000000000000000000000000000000000000000..9f8c2af505e4d8474d28cacf24e0074d92cd7efe GIT binary patch literal 4937 zcmZ`-PjlPG6$d~N1i}B5EXj`3z)9SgPAoaG^WT$3k?2$ziE=4<(qJZqA?{Lw3Qg7Dj&$ivKS6!Sp&y|4b}+qkddf_vA0QX^w+m2K?Uon<@4bEd_U+r< z_kMs=sTdM|ueguy{pnRn`X^`3{t93|#y|WsZbY&qA```vEm=GjOA*hUm80^$dYmV@ z6WP+JMwF4n-lGMg9?9RxG`FuG7onja8)(ZD?F4!}S?QVCo`++$a!A?jc(Vw@N)IV@p;18%DnFkJYogI%Rg|NrmVH76$ z?I7^NmYm2}aZ^{EkmA{xy7VdaDdRptsL_W*+KXCBGAA6Rwx2m}yMEt=)zZ*mAq6)a zMLmtXnEht()?$ud;`3m@+l>j=yBSM%-qkh$5D>Vl55t@z9v8^MeI@)ip6Bl?k7V{xXkLJ3QBW^{G6Z!IR7p@T zf+~}r#Kl;NjkwfT=cGv`()J6-y0{nPa$Gr4PUJ^&xK3Vz9@olot!pg8WppKThqTeQM8u z21eiqMR@%hyspMoaz*I>owO!3|JUHJ3jSZ@b?`p;H^3|GqUduC_7??TCQE3qis)XC zt8)^Mu>TSC-xTfZ&*d;H=<@Rip*$_n$u$<&ULishGs7q3dlF~d>6?>;o6z$C~xP#n48 zp2<&d$OjO1h}-WY*C1bTgO1;$p%}!x*9-hUaoPVc4uc`GgWEq8oz&n1=J_O(alOvUopnp-`MsfM)iNix);8=f+RI%lAG(7>Hon?*4=6LY znd67UfJInQSydy~QL=3}y1+pKpO}a9=+(9EctD!Hq8?I*S^CQIdb_iVhe7uFmpIF4Us#?p=t`}EP(+|K5Xei3 z&b{C{IjQr|+dQ~gFfA>O^l9ed3d|G%nr3k^i9bs0XORB*^QE2##6{WCUNE3bgaTnX z`y+p;7li|x1cRm1R39#-tFyG!a|hH;r?Ip%ay^2nCJp-;P!+z20YZkGR95Bc*-NR* zxU>b?$d@$(Elt_TuDZM+R~18U=IW5wq1jXn@P@2q|GKO}YQO@X3fC2Xv};fFoGw@M zRhcbg)LxE{o&DzVEaEQ^+&U0k444gURF0%?WYktbaMaeEpn&2gs-RR*`AFH%0X4}f z$ew6|&jUlr;hji1);I-hHq|N+{UirWRmk*!`$#b^q_sKI$`Jzqy>y~Z^h~0Y@`9KJlv&XT)+vDP@^yP&~DYLJ~zyzccms0y*eIEg%#l<6KQqC+%#|98n zo>bvgMaW7(V!&an3hy~8nXNl-#sgjVKc*h-$m8q+SwjY=}e2G(i(6}11RwiWOmZXG-Prv)tEF- z=iS7-=i=sn#Z?2gQzkP}9WiLeGeB9KJC;T7??2sOlr>H5>Qb|(S z>aOrt8g>pF(JFS(W5BE;n)aSFDqQ*mjH*D{czyf zNC(r*E9$05b7o>ZJ+w*b%xN9}rOJeaJQPKCch#Eznl^?9y5F)7fQ< zY1PiG3-{8hi4IStNuG;s_BQw99d5oXst>9vk2Sl&Mfx=KR^v=*vOQ;qdP(X+7G!pl z+xbj%5{BVq`WSxB0n3**k#$!_+5LVs!e3*DyL;# zUdS2wS#X9rn^Tdy%c_bzzwkummEegAnI@~bX4+E`y>iW5S~GZm_A89k#2pITI0oc8N)O5x4x_=Lf)FZibn z38z@;Fm9=pXZ!;WFvKAc1Kw&57=QN{KC~3J&1t^$&j!b^2afC8{gL1ME1E;`0YQX@ zIp7oBP8ICd#iU@Pxb|#2-LhS7&E`6V>}yAo!^UKMlE?ywDA0rULpKt8JJFoskoqLu zCT?nRK`CQ#u{{(W ROV6*mVyHUR@9LT^{|6t3iE#h` literal 0 HcmV?d00001 From fbf614d25082c20110fbc1ca77892c01a9e877fd Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Fri, 18 Nov 2022 11:36:56 +0100 Subject: [PATCH 14/37] add doc tracer to mosart in new array first step --- src/cpl/nuopc/rof_import_export.F90 | 20 ++++++++++-- src/riverroute/DommasbMod.F90 | 22 ++++++------- src/riverroute/MOSART_physics_mod.F90 | 26 +++++++++------ src/riverroute/RtmMod.F90 | 47 +++++++++++++++------------ src/riverroute/RtmVar.F90 | 6 ++-- src/riverroute/RunoffMod.F90 | 46 ++++++++++++++------------ 6 files changed, 99 insertions(+), 68 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 30fe4fb..6827fc5 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -11,7 +11,7 @@ module rof_import_export use shr_sys_mod , only : shr_sys_abort use nuopc_shr_methods , only : chkerr use RunoffMod , only : rtmCTL, TRunoff, TUnit - use RtmVar , only : iulog, nt_rtm, rtm_tracers + use RtmVar , only : iulog, nt_rtm, rtm_tracers,nt_rtm_dom,rtm_tracers_dom use RtmSpmd , only : masterproc, mpicom_rof use RtmTimeManager , only : get_nstep use nuopc_shr_methods , only : chkerr @@ -110,6 +110,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, do_rtmflood, rc) call fldlist_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') + call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofdoc') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') @@ -242,9 +243,9 @@ subroutine import_fields( gcomp, rc ) ! Local variables type(ESMF_State) :: importState - integer :: n,nt + integer :: n,nt,ntdom integer :: begr, endr - integer :: nliq, nfrz + integer :: nliq, nfrz, ndoc character(len=*), parameter :: subname='(rof_import_export:import_fields)' !--------------------------------------------------------------------------- @@ -267,6 +268,15 @@ subroutine import_fields( gcomp, rc ) call shr_sys_abort() endif + ndoc = 0 + do ntdom = 1,nt_rtm_dom + if (trim(rtm_tracers_dom()) == 'DOC') ndoc = ntdom + enddo + if (ndoc == 0) then + write(iulog,*) trim(subname),': ERROR in rtm_tracers_dom DOC ',ndoc,rtm_tracers_dom + call shr_sys_abort() + endif + begr = rtmCTL%begr endr = rtmCTL%endr @@ -277,6 +287,10 @@ subroutine import_fields( gcomp, rc ) do_area_correction=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Flrl_rofdoc', begr, endr, rtmCTL%area, output=rtmCTL%domsur(:,ndoc), & + do_area_correction=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'Flrl_rofsub', begr, endr, rtmCTL%area, output=rtmCTL%qsub(:,nliq), & do_area_correction=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 6705da9..4db5d64 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -6,7 +6,7 @@ MODULE DommasbMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort - use RunoffMod , only : TRunoff, Tdom + use RunoffMod , only : TRunoff, Tdom, rtmCTL implicit none @@ -19,34 +19,32 @@ MODULE DommasbMod contains !---------------------------------------------------------------------- - subroutine hillslopeRoutingDOM(iunit,nt,theDeltaT) + subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) ! ! DESCRIPTION: solve the ODEs with Euler algorithm for hillslope routing implicit none - integer, intent(in) :: iunit, nt + integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT ! assume no chemical reaction in the water hence sink term is zero implies domH ~= domHout - Tdom%domH(iunit,nt) = Tdom%domH(iunit,nt) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,nt) + Tdom%domSource(iunit,nt)) * theDeltaT/TRunoff%wh(iunit,nt) + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/TRunoff%wh(iunit,nt) end subroutine hillslopeRoutingDOM - subroutine subnetworkRoutingDOM(iunit,nt,theDeltaT) + subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODEs with Euler algorithm for subnetwork routing implicit none - integer, intent(in) :: iunit,nt + integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domT(iunit,nt) = Tdom%domT(iunit,nt) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,nt) - TRunoff%etout(iunit,nt) * Tdom%domT(iunit,nt)) * theDeltaT/TRunoff%wt(iunit,nt) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) - TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) end subroutine subnetworkRoutingDOM - subroutine mainchannelRoutingDOM(iunit,nt,theDeltaT) + subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODE with Euler algorithm for main-channel routing implicit none - integer, intent(in) :: iunit, nt + integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT real(r8) :: mainchinT, mainchinUp - real(r8) :: mainchout mainchinT = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) !input to main channel from Tributaries mainchinUp = TRunoff%eroutUp(iunit,nt) !inflow to main channel from Upstream grid cells of main channel - mainchout = TRunoff%flow(iunit,nt) ! flow to the outlet of the reach in the main channel - Tdom%domR(iunit,nt) = Tdom%domR(iunit,nt) + ( (mainchinT*Tdom%domT(iunit,nt) + mainchinUp*Tdom%domRout(iunit,nt)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,nt))*theDeltaT/TRunoff%wr(iunit,nt) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRout(iunit,ntdom)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index b4ea41b..6d45b5f 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -13,7 +13,7 @@ MODULE MOSART_physics_mod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort - use RtmVar , only : iulog, barrier_timers, nt_rtm, rtm_tracers + use RtmVar , only : iulog, barrier_timers, nt_rtm, rtm_tracers, nt_rtm_dom, rtm_tracers_dom use RunoffMod , only : Tctl, TUnit, TRunoff, TPara, rtmCTL,Tdom use RunoffMod , only : SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp use RunoffMod , only : SMatP_domRUp, avsrc_domRUp, avdst_domRUp @@ -26,7 +26,7 @@ MODULE MOSART_physics_mod private real(r8), parameter :: TINYVALUE = 1.0e-14_r8 ! double precision variable has a significance of about 16 decimal digits - integer :: nt ! loop indices + integer :: nt, ntdom ! loop indices real(r8), parameter :: SLOPE1def = 0.1_r8 ! here give it a small value in order to avoid the abrupt change of hydraulic radidus etc. real(r8) :: sinatanSLOPE1defr ! 1.0/sin(atan(slope1)) @@ -65,9 +65,11 @@ subroutine Euler TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) - if (TRunoff%wh(iunit, nt) > 0._r8 ) then - call hillslopeRoutingDOM(iunit,nt,Tctl%DeltaT) - endif !wh + if (TRunoff%wh(iunit, nt) > 0._r8 .and. nt==1) then ! if LIQ tracer and there is water + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) + end do + endif endif end do endif @@ -106,9 +108,11 @@ subroutine Euler TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) - if (TRunoff%wt(iunit,nt) > 0._r8) then - call subnetworkRoutingDOM(iunit,nt,localDeltaT) - endif !wt + if (TRunoff%wt(iunit,nt) > 0._r8 .and. nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) + end do + endif end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) endif @@ -147,8 +151,10 @@ subroutine Euler cnt = cnt + 1 do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) - avsrc_domRUp%rAttr(nt,cnt) = Tdom%domR(iunit,nt) enddo + do ntdom = 1,nt_rtm_dom + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom) + end do enddo call mct_avect_zero(avdst_eroutUp) call mct_avect_zero(avdst_domRUp) @@ -184,7 +190,7 @@ subroutine Euler do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT - call mainchannelRoutingDOM(iunit,nt,localDeltaT) + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) ! check for negative channel storage ! if(TRunoff%wr(iunit,1) < -1.e-10) then ! write(iulog,*) 'Negative channel storage! ', iunit, TRunoff%wr(iunit,1) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index a33cedf..5679acc 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -12,7 +12,7 @@ module RtmMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush use shr_const_mod , only : SHR_CONST_PI, SHR_CONST_CDAY - use RtmVar , only : nt_rtm, rtm_tracers + use RtmVar , only : nt_rtm, rtm_tracers, nt_rtm_dom, rtm_tracers_dom use RtmSpmd , only : masterproc, npes, iam, mpicom_rof, ROFID, mastertask, & MPI_REAL8,MPI_INTEGER,MPI_CHARACTER,MPI_LOGICAL,MPI_MAX use RtmVar , only : re, spval, rtmlon, rtmlat, iulog, ice_runoff, & @@ -138,7 +138,7 @@ subroutine Rtmini(flood_active) real(r8) :: edgee ! East edge of the direction file real(r8) :: edges ! South edge of the direction file real(r8) :: edgew ! West edge of the direction file - integer :: i,j,k,n,ng,g,n2,nt,nn ! loop indices + integer :: i,j,k,n,ng,g,n2,nt,nn,ntdom ! loop indices integer :: i1,j1,i2,j2 integer :: im1,ip1,jm1,jp1,ir,jr,nr ! neighbor indices real(r8) :: deg2rad ! pi/180 @@ -353,6 +353,14 @@ subroutine Rtmini(flood_active) write(iulog,*)'MOSART tracers = ',nt_rtm,trim(rtm_trstr) end if + rtm_trstr = trim(rtm_tracers_dom(1)) + do n = 2,nt_rtm_dom + rtm_trstr = trim(rtm_trstr)//':'//trim(rtm_tracers_dom(n)) + enddo + if (masterproc) then + write(iulog,*)'MOSART tracers dom = ',nt_rtm_dom,trim(rtm_trstr) + end if + !------------------------------------------------------- ! Read input data (river direction file) !------------------------------------------------------- @@ -1391,7 +1399,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) ! ! !LOCAL VARIABLES: !EOP - integer :: i, j, n, nr, ns, nt, n2, nf ! indices + integer :: i, j, n, nr, ns, nt, ntdom, n2, nf ! indices real(r8) :: budget_terms(30,nt_rtm) ! BUDGET terms ! BUDGET terms 1-10 are for volumes (m3) ! BUDGET terms 11-30 are for flows (m3/s) @@ -1494,6 +1502,12 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%qgwl(nr,nt) = rtmCTL%qgwl(nr,nt) enddo enddo + + do nr = rtmCTL%begr,rtmCTL%endr + do ntdom = 1,nt_rtm_dom + TRunoff%surdom(nr,nt) = rtmCTL%surdom(nr,ntdom) + enddo + enddo !----------------------------------- ! Compute irrigation flux based on demand from clm @@ -1814,7 +1828,6 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%qsur(nr,nt) = TRunoff%qsur(nr,nt) / rtmCTL%area(nr) TRunoff%qsub(nr,nt) = TRunoff%qsub(nr,nt) / rtmCTL%area(nr) TRunoff%qgwl(nr,nt) = TRunoff%qgwl(nr,nt) / rtmCTL%area(nr) - Tdom%domSource(nr,nt) = 1000._r8 enddo enddo @@ -2101,7 +2114,7 @@ subroutine RtmFloodInit(frivinp, begr, endr, fthresh, evel ) real(r8) , pointer :: rslope(:) real(r8) , pointer :: max_volr(:) integer, pointer :: compdof(:) ! computational degrees of freedom for pio - integer :: nt,n,cnt ! indices + integer :: nt,ntdom,n,cnt ! indices logical :: readvar ! read variable in or not integer :: ier ! status variable integer :: dids(2) ! variable dimension ids @@ -2198,7 +2211,7 @@ subroutine MOSART_init integer :: dids(2) ! variable dimension ids integer :: dsizes(2) ! variable dimension lengths integer :: ier ! error code - integer :: begr, endr, iunit, nn, n, cnt, nr, nt + integer :: begr, endr, iunit, nn, n, cnt, nr, nt, ntdom integer :: numDT_r, numDT_t integer :: lsize, gsize integer :: igrow, igcol, iwgt @@ -2542,26 +2555,20 @@ subroutine MOSART_init TPara%c_twid = 1.0_r8 !Initialize dom flux variables - allocate (Tdom%domSource(begr:endr,nt_rtm)) - Tdom%domSource = 0._r8 - allocate (Tdom%domH(begr:endr,nt_rtm)) + allocate (Tdom%domH(begr:endr,nt_rtm_dom)) Tdom%domH = 0._r8 - allocate (Tdom%domT(begr:endr,nt_rtm)) + allocate (Tdom%domT(begr:endr,nt_rtm_dom)) Tdom%domT = 0._r8 - allocate (Tdom%domR(begr:endr,nt_rtm)) + allocate (Tdom%domR(begr:endr,nt_rtm_dom)) Tdom%domR = 0._r8 - allocate (Tdom%domRout(begr:endr,nt_rtm)) + allocate (Tdom%domRout(begr:endr,nt_rtm_dom)) Tdom%domRout = 0._r8 - allocate (Tdom%domRin(begr:endr,nt_rtm)) + allocate (Tdom%domRin(begr:endr,nt_rtm_dom)) Tdom%domRin = 0._r8 - allocate (Tdom%domRUp(begr:endr,nt_rtm)) + allocate (Tdom%domRUp(begr:endr,nt_rtm_dom)) Tdom%domRUp = 0._r8 - allocate (Tdom%dom(begr:endr,nt_rtm)) - Tdom%dom = 0._r8 - !allocate (Tdom%doc(begr:endr)) - !Tdom%doc = 0._r8 - !allocate (Tdom%don(begr:endr)) - !Tdom%don = 0._r8 + allocate (Tdom%domsur(begr:endr,nt_rtm_dom)) + Tdom%domsur = 0._r8 call pio_freedecomp(ncid, iodesc_dbl) call pio_freedecomp(ncid, iodesc_int) diff --git a/src/riverroute/RtmVar.F90 b/src/riverroute/RtmVar.F90 index 5384f06..13b2416 100644 --- a/src/riverroute/RtmVar.F90 +++ b/src/riverroute/RtmVar.F90 @@ -8,8 +8,10 @@ module RtmVar implicit none !TODO - nt_rtm and rtm_tracers need to be removed and set by access to the index array - integer, parameter, public :: nt_rtm = 4 ! number of tracers - character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE','DOC','DON'/) + integer, parameter, public :: nt_rtm = 2 ! number of tracers + character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE'/) + integer, parameter, public :: nt_rtm_dom = 2 ! number of tracers + character(len=3), parameter, public :: rtm_tracers_dom(nt_rtm_dom) = (/'DOC','DON'/) ! Constants integer, parameter, private :: iundef = -9999999 diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 046a8f0..eec09a0 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -59,15 +59,17 @@ module RunoffMod ! - local real(r8), pointer :: runofflnd(:,:) ! runoff masked for land (m3 H2O/s) real(r8), pointer :: runoffocn(:,:) ! runoff masked for ocn (m3 H2O/s) + real(r8), pointer :: runoffocndom(:,:)! DOM runoff masked for ocn (gC/s) + real(r8), pointer :: runofflnddom(:,:)! DOM runoff masked for lnd (gC/s) real(r8), pointer :: runofftot(:,:) ! total runoff masked for ocn (m3 H2O/s) real(r8), pointer :: dvolrdt(:,:) ! RTM change in storage (mm/s) real(r8), pointer :: dvolrdtlnd(:,:) ! dvolrdt masked for land (mm/s) real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) + real(r8), pointer :: dommas(:,:) ! RTM DOM storage (gC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold - real(r8), pointer :: domlnd(:,:) ! dom amsked for land (mgC/L) ! - restarts - real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) + real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m3) real(r8), pointer :: wt(:,:) ! MOSART sub-network water storage (m3) real(r8), pointer :: wr(:,:) ! MOSART main channel water storage (m3) real(r8), pointer :: erout(:,:) ! MOSART flow out of the main channel, instantaneous (m3/s) @@ -76,6 +78,7 @@ module RunoffMod real(r8), pointer :: qsur(:,:) ! coupler surface forcing [m3/s] real(r8), pointer :: qsub(:,:) ! coupler subsurface forcing [m3/s] real(r8), pointer :: qgwl(:,:) ! coupler glacier/wetland/lake forcing [m3/s] + real(r8), pointer :: domsur(:,:) ! dom amsked for land (gC/s) ! - outputs real(r8), pointer :: flood(:) ! coupler return flood water sent back to clm [m3/s] @@ -107,8 +110,10 @@ module RunoffMod real(r8), pointer :: qsub_nt2(:) real(r8), pointer :: qgwl_nt1(:) real(r8), pointer :: qgwl_nt2(:) - real(r8), pointer :: dom_nt3(:) - real(r8), pointer :: dom_nt4(:) + real(r8), pointer :: domsur_ntdom1(:) + real(r8), pointer :: dommas_ntdom1(:) + real(r8), pointer :: runoffocndom_ntdom1(:) + real(r8), pointer :: runofflnddom_ntdom1(:) end type runoff_flow @@ -281,22 +286,16 @@ module RunoffMod ! DOM status and flux variables public :: Domflux type Domflux - !dom source generated from CLM soil carbon - real(r8), pointer :: domSource(:,:) ! dom production from soil organic matter (mgC/L/day) + real(r8), pointer :: domsur(:,:) ! flow to downstream grid cells (gC/s) !hillslope - real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (mgC/L) + real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (gC/m3) !sub-network - real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (mgC/L) + real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (gC/m3) !main channel upstream interactions - real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (mgC/L) - real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (mgC/L) - real(r8), pointer :: domRout(:,:) ! flow from upstream grids (mgC/L) - real(r8), pointer :: domRin(:,:) ! flow to downstream grid cells (mgC/L) - !out flow from the outlet - real(r8), pointer :: dom(:,:) ! dom outflow from main channel to ocean (mgC/L) - !history fields - real(r8), pointer :: doc(:) ! dissolved organic carbon (mgC/L) from dom - real(r8), pointer :: don(:) ! dissolved organic nitrogen (mgN/L) from dom + real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (gC/m3) + real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (gC/m3) + real(r8), pointer :: domRout(:,:) ! flow from upstream grids (gC/m3) + real(r8), pointer :: domRin(:,:) ! flow to downstream grid cells (gC/m3) end type Domflux !== Hongyi @@ -322,7 +321,6 @@ subroutine RunoffInit(begr, endr, numr) allocate(rtmCTL%runoff(begr:endr,nt_rtm), & rtmCTL%dvolrdt(begr:endr,nt_rtm), & rtmCTL%runofflnd(begr:endr,nt_rtm), & - rtmCTL%domlnd(begr:endr,nt_rtm), & rtmCTL%dvolrdtlnd(begr:endr,nt_rtm), & rtmCTL%runoffocn(begr:endr,nt_rtm), & rtmCTL%dvolrdtocn(begr:endr,nt_rtm), & @@ -368,8 +366,10 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%qgwl(begr:endr,nt_rtm), & rtmCTL%qirrig(begr:endr), & rtmCTL%qirrig_actual(begr:endr), & - rtmCTL%dom_nt3(begr:endr), & - rtmCTL%dom_nt4(begr:endr), & + rtmCTL%runofflnddom(begr:endr,nt_rtm_dom), & + rtmCTL%runoffocndom(begr:endr,nt_rtm_dom), & + rtmCTL%domsur(begr:endr,nt_rtm_dom), & + rtmCTL%dommas(begr:endr,nt_rtm_dom), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -378,7 +378,6 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runoff(:,:) = 0._r8 rtmCTL%runofflnd(:,:) = spval - rtmCTL%domlnd(:,:) = spval rtmCTL%runoffocn(:,:) = spval rtmCTL%runofftot(:,:) = spval rtmCTL%dvolrdt(:,:) = 0._r8 @@ -395,6 +394,11 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%qsub(:,:) = 0._r8 rtmCTL%qgwl(:,:) = 0._r8 + rtmCTL%runofflnddom(:,:)=spval + rtmCTL%runoffocndom(:,:)=spval + rtmCTL%domsur(:,:) =0._r8 + rtmCTL%dommas(:,:) =0._r8 + end subroutine RunoffInit end module RunoffMod From d4d9c2b19cead11ae677b07e1f6da04a290ac008 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Thu, 5 Jan 2023 11:30:13 +0100 Subject: [PATCH 15/37] changes to mosart for DOC --- src/cpl/nuopc/rof_import_export.F90 | 6 +++--- src/riverroute/DommasbMod.F90 | 4 ++-- src/riverroute/MOSART_physics_mod.F90 | 11 ++++++++-- src/riverroute/RtmHistFlds.F90 | 30 ++++++++++++++++++--------- src/riverroute/RtmMod.F90 | 28 ++++++++++++++++++++++--- src/riverroute/RunoffMod.F90 | 10 ++++++--- 6 files changed, 66 insertions(+), 23 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 6827fc5..0ad5ae2 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -243,7 +243,7 @@ subroutine import_fields( gcomp, rc ) ! Local variables type(ESMF_State) :: importState - integer :: n,nt,ntdom + integer :: n,nt,nt integer :: begr, endr integer :: nliq, nfrz, ndoc character(len=*), parameter :: subname='(rof_import_export:import_fields)' @@ -269,8 +269,8 @@ subroutine import_fields( gcomp, rc ) endif ndoc = 0 - do ntdom = 1,nt_rtm_dom - if (trim(rtm_tracers_dom()) == 'DOC') ndoc = ntdom + do nt = 1,nt_rtm_dom + if (trim(rtm_tracers_dom()) == 'DOC') ndoc = nt enddo if (ndoc == 0) then write(iulog,*) trim(subname),': ERROR in rtm_tracers_dom DOC ',ndoc,rtm_tracers_dom diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 4db5d64..d8e2cf6 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -6,7 +6,7 @@ MODULE DommasbMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort - use RunoffMod , only : TRunoff, Tdom, rtmCTL + use RunoffMod , only : TRunoff, Tdom implicit none @@ -44,7 +44,7 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) real(r8) :: mainchinT, mainchinUp mainchinT = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) !input to main channel from Tributaries mainchinUp = TRunoff%eroutUp(iunit,nt) !inflow to main channel from Upstream grid cells of main channel - Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRout(iunit,ntdom)) - TRunoff%flow(iunit,nt) * Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRout(iunit,ntdom)) - TRunoff%flow(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 6d45b5f..d2997f6 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -145,7 +145,7 @@ subroutine Euler #else !--- copy erout into avsrc_eroutUp --- call mct_avect_zero(avsrc_eroutUp) - call mct_avect_zero(avsrc_eroutUp) + call mct_avect_zero(avsrc_domRUp) cnt = 0 do iunit = rtmCTL%begr,rtmCTL%endr cnt = cnt + 1 @@ -169,6 +169,9 @@ subroutine Euler do nt = 1,nt_rtm TRunoff%eroutUp(iunit,nt) = avdst_eroutUp%rAttr(nt,cnt) enddo + do ntdom = 1,nt_rtm_dom + Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt) + end do enddo #endif call t_stopf('mosartr_SMeroutUp') @@ -190,7 +193,11 @@ subroutine Euler do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + end do + end if ! check for negative channel storage ! if(TRunoff%wr(iunit,1) < -1.e-10) then ! write(iulog,*) 'Negative channel storage! ', iunit, TRunoff%wr(iunit,1) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index e2e3a53..c778a31 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -11,7 +11,7 @@ module RtmHistFlds use shr_kind_mod , only : r8 => shr_kind_r8 use RunoffMod , only : rtmCTL, Tdom use RtmHistFile , only : RtmHistAddfld, RtmHistPrintflds - use RtmVar , only : nt_rtm, rtm_tracers + use RtmVar , only : nt_rtm, rtm_tracers, nt_rtm_dom, rtm_tracers_dom implicit none ! @@ -130,13 +130,21 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='Actual irrigation (if limited by river storage)', & ptr_rof=rtmCTL%qirrig_actual, default='inactive') - call RtmHistAddfld (fname='DOC'//'_'//trim(rtm_tracers(3)), units='mgC/L', & - avgflag='A', long_name='Dissolved Organic Carbon: '//trim(rtm_tracers(3)), & - ptr_rof=rtmCTL%dom_nt3, default='active') + call RtmHistAddfld (fname='RIVER_DISCHARGE_OVER_LAND'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + avgflag='A', long_name='MOSART DOM basin flow: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%runofflnddom_nt1, default='active') - call RtmHistAddfld (fname='DON'//'_'//trim(rtm_tracers(4)), units='mgC/L', & - avgflag='A', long_name='Dissolved Organic Nitrogen: '//trim(rtm_tracers(4)), & - ptr_rof=rtmCTL%dom_nt4, default='active') + call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + avgflag='A', long_name='MOSART DOM discharge into ocean: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%runoffocndom_nt1, default='active') + + call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + avgflag='A', long_name='MOSART input surface DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domsur_nt1, default='active') + + call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='gC', & + avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%dommas_nt1, default='active') ! Print masterlist of history fields @@ -160,9 +168,6 @@ subroutine RtmHistFldsSet() rtmCTL%runofflnd_nt1(:) = rtmCTL%runofflnd(:,1) rtmCTL%runofflnd_nt2(:) = rtmCTL%runofflnd(:,2) - rtmCTL%dom_nt3(:) = Tdom%domR(:,3) - rtmCTL%dom_nt4(:) = Tdom%domR(:,4) - rtmCTL%runoffocn_nt1(:) = rtmCTL%runoffocn(:,1) rtmCTL%runoffocn_nt2(:) = rtmCTL%runoffocn(:,2) @@ -191,6 +196,11 @@ subroutine RtmHistFldsSet() rtmCTL%qgwl_nt1(:) = rtmCTL%qgwl(:,1) rtmCTL%qgwl_nt2(:) = rtmCTL%qgwl(:,2) + rtmCTL%domsur_ntdom1(:) = rtmCTL%domsur(:,1) + rtmCTL%dommas_ntdom1(:) = rtmCTL%dommas(:,1) + rtmCTL%runoffocndom_ntdom1(:) = rtmCTL%runoffocndom(:,1) + rtmCTL%runofflnddom_ntdom1(:) = rtmCTL%runofflnddom(:,1) + end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 5679acc..ec6f08a 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1399,7 +1399,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) ! ! !LOCAL VARIABLES: !EOP - integer :: i, j, n, nr, ns, nt, ntdom, n2, nf ! indices + integer :: i, j, n, nr, ns, nt, n2, nf, ntdom! indices real(r8) :: budget_terms(30,nt_rtm) ! BUDGET terms ! BUDGET terms 1-10 are for volumes (m3) ! BUDGET terms 11-30 are for flows (m3/s) @@ -1504,8 +1504,8 @@ subroutine Rtmrun(rstwr,nlend,rdate) enddo do nr = rtmCTL%begr,rtmCTL%endr - do ntdom = 1,nt_rtm_dom - TRunoff%surdom(nr,nt) = rtmCTL%surdom(nr,ntdom) + do nt = 1,nt_rtm_dom + Tdom%domsur(nr,nt) = rtmCTL%domsur(nr,nt) enddo enddo @@ -1912,6 +1912,14 @@ subroutine Rtmrun(rstwr,nlend,rdate) volr_init = rtmCTL%volr(nr,nt) rtmCTL%volr(nr,nt) = (TRunoff%wt(nr,nt) + TRunoff%wr(nr,nt) + & TRunoff%wh(nr,nt)*rtmCTL%area(nr)) + if (nt==1) then + do ntdom = 1,nt_rtm_dom + rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*Tdom%domH(nr,ntdom)*rtmCTL%area(nr) + & + TRunoff%wt(nr,nt)*Tdom%domt(nr,ntdom) + & + TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom) + enddo + end if + rtmCTL%dvolrdt(nr,nt) = (rtmCTL%volr(nr,nt) - volr_init) / delt_coupling rtmCTL%runoff(nr,nt) = flow(nr,nt) @@ -1919,10 +1927,24 @@ subroutine Rtmrun(rstwr,nlend,rdate) if (rtmCTL%mask(nr) == 1) then rtmCTL%runofflnd(nr,nt) = rtmCTL%runoff(nr,nt) rtmCTL%dvolrdtlnd(nr,nt)= rtmCTL%dvolrdt(nr,nt) + + if (nt==1) then + do ntdom = 1,nt_rtm_dom + rtmCTL%runofflnddom(nr,ntdom)=rtmCTL%runoff(nr,nt) * Tdom%domR(nr,ntdom) + enddo + end if + elseif (rtmCTL%mask(nr) >= 2) then rtmCTL%runoffocn(nr,nt) = rtmCTL%runoff(nr,nt) rtmCTL%runofftot(nr,nt) = rtmCTL%runofftot(nr,nt) + rtmCTL%runoff(nr,nt) rtmCTL%dvolrdtocn(nr,nt)= rtmCTL%dvolrdt(nr,nt) + + if (nt==1) then + do ntdom = 1,nt_rtm_dom + rtmCTL%runoffocndom(nr,ntdom)=rtmCTL%runoff(nr,nt) * Tdom%domR(nr,ntdom) + enddo + end if + endif enddo enddo diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index eec09a0..500c5f8 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -69,7 +69,7 @@ module RunoffMod real(r8), pointer :: dommas(:,:) ! RTM DOM storage (gC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold ! - restarts - real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m3) + real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) real(r8), pointer :: wt(:,:) ! MOSART sub-network water storage (m3) real(r8), pointer :: wr(:,:) ! MOSART main channel water storage (m3) real(r8), pointer :: erout(:,:) ! MOSART flow out of the main channel, instantaneous (m3/s) @@ -368,8 +368,12 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%qirrig_actual(begr:endr), & rtmCTL%runofflnddom(begr:endr,nt_rtm_dom), & rtmCTL%runoffocndom(begr:endr,nt_rtm_dom), & - rtmCTL%domsur(begr:endr,nt_rtm_dom), & - rtmCTL%dommas(begr:endr,nt_rtm_dom), & + rtmCTL%domsur(begr:endr,nt_rtm_dom), & + rtmCTL%dommas(begr:endr,nt_rtm_dom), & + rtmCTL%runofflnddom_ntdom1(begr:endr), & + rtmCTL%runoffocndom_ntdom1(begr:endr), & + rtmCTL%domsur_ntdom1(begr:endr), & + rtmCTL%dommas_ntdom1(begr:endr), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' From ae92015639eb68a71d05bd468e079f4dc34f2e6d Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Thu, 5 Jan 2023 14:37:03 +0100 Subject: [PATCH 16/37] removed domRout and domRin --- src/riverroute/DommasbMod.F90 | 2 +- src/riverroute/MOSART_physics_mod.F90 | 1 - src/riverroute/RtmMod.F90 | 4 ---- src/riverroute/RunoffMod.F90 | 8 +++----- 4 files changed, 4 insertions(+), 11 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index d8e2cf6..cc4c656 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -44,7 +44,7 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) real(r8) :: mainchinT, mainchinUp mainchinT = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) !input to main channel from Tributaries mainchinUp = TRunoff%eroutUp(iunit,nt) !inflow to main channel from Upstream grid cells of main channel - Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRout(iunit,ntdom)) - TRunoff%flow(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRUp(iunit,ntdom)) - TRunoff%flow(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index d2997f6..a9b0416 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -178,7 +178,6 @@ subroutine Euler TRunoff%eroutup_avg = TRunoff%eroutup_avg + TRunoff%eroutUp TRunoff%erlat_avg = TRunoff%erlat_avg + TRunoff%erlateral - Tdom%domRout = Tdom%domRout + Tdom%domRUp !------------------ ! channel routing !------------------ diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index ec6f08a..e3d113d 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -2583,10 +2583,6 @@ subroutine MOSART_init Tdom%domT = 0._r8 allocate (Tdom%domR(begr:endr,nt_rtm_dom)) Tdom%domR = 0._r8 - allocate (Tdom%domRout(begr:endr,nt_rtm_dom)) - Tdom%domRout = 0._r8 - allocate (Tdom%domRin(begr:endr,nt_rtm_dom)) - Tdom%domRin = 0._r8 allocate (Tdom%domRUp(begr:endr,nt_rtm_dom)) Tdom%domRUp = 0._r8 allocate (Tdom%domsur(begr:endr,nt_rtm_dom)) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 500c5f8..4b01889 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -30,9 +30,9 @@ module RunoffMod type(mct_sMatP),public :: sMatP_eroutUp ! sparse matrix plus for eroutUp calc type(mct_avect),public :: avsrc_eroutUp ! src avect for SM mult eroutUp calc type(mct_avect),public :: avdst_eroutUp ! dst avect for SM mult eroutUp calc - type(mct_sMatP),public :: sMatP_domRUp ! sparse matrix plus for domRoutUp calc - type(mct_avect),public :: avsrc_domRUp ! src avect for SM mult domRoutUp calc - type(mct_avect),public :: avdst_domRUp ! dst avect for SM mult domRoutUp calc + type(mct_sMatP),public :: sMatP_domRUp ! sparse matrix plus for domRUp calc + type(mct_avect),public :: avsrc_domRUp ! src avect for SM mult domRUp calc + type(mct_avect),public :: avdst_domRUp ! dst avect for SM mult domRUp calc public :: runoff_flow @@ -294,8 +294,6 @@ module RunoffMod !main channel upstream interactions real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (gC/m3) real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (gC/m3) - real(r8), pointer :: domRout(:,:) ! flow from upstream grids (gC/m3) - real(r8), pointer :: domRin(:,:) ! flow to downstream grid cells (gC/m3) end type Domflux !== Hongyi From 68e31f05d9e0ffd41181e8e062ee6828e5dd5518 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Fri, 6 Jan 2023 18:08:10 +0100 Subject: [PATCH 17/37] corrections to the code, typos and mistakes --- src/cpl/nuopc/rof_import_export.F90 | 7 +++++-- src/riverroute/RtmHistFlds.F90 | 8 ++++---- src/riverroute/RunoffMod.F90 | 2 +- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 0ad5ae2..68231d5 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -243,7 +243,7 @@ subroutine import_fields( gcomp, rc ) ! Local variables type(ESMF_State) :: importState - integer :: n,nt,nt + integer :: n,nt integer :: begr, endr integer :: nliq, nfrz, ndoc character(len=*), parameter :: subname='(rof_import_export:import_fields)' @@ -270,7 +270,7 @@ subroutine import_fields( gcomp, rc ) ndoc = 0 do nt = 1,nt_rtm_dom - if (trim(rtm_tracers_dom()) == 'DOC') ndoc = nt + if (trim(rtm_tracers_dom(nt)) == 'DOC') ndoc = nt enddo if (ndoc == 0) then write(iulog,*) trim(subname),': ERROR in rtm_tracers_dom DOC ',ndoc,rtm_tracers_dom @@ -622,6 +622,9 @@ subroutine state_getimport(state, fldname, begr, endr, area, output, do_area_cor end if do g = begr,endr output(g) = fldptr(g-begr+1) * area(g)*0.001_r8 + if (fldname=='Flrl_rofdoc') then + output(g) = output(g)*1000._r8 + end if end do ! check for nans diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index c778a31..4b8549a 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -132,19 +132,19 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='RIVER_DISCHARGE_OVER_LAND'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & avgflag='A', long_name='MOSART DOM basin flow: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%runofflnddom_nt1, default='active') + ptr_rof=rtmCTL%runofflnddom_ntdom1, default='active') call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & avgflag='A', long_name='MOSART DOM discharge into ocean: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%runoffocndom_nt1, default='active') + ptr_rof=rtmCTL%runoffocndom_ntdom1, default='active') call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & avgflag='A', long_name='MOSART input surface DOM: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%domsur_nt1, default='active') + ptr_rof=rtmCTL%domsur_ntdom1, default='active') call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='gC', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%dommas_nt1, default='active') + ptr_rof=rtmCTL%dommas_ntdom1, default='active') ! Print masterlist of history fields diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 4b01889..6d4f669 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -10,7 +10,7 @@ module RunoffMod ! ! !USES: use shr_kind_mod, only : r8 => shr_kind_r8 - use RtmVar , only : iulog, spval, nt_rtm + use RtmVar , only : iulog, spval, nt_rtm,nt_rtm_dom use mct_mod ! !PUBLIC TYPES: From 3c18a69fde694e471a2352f1716811468df39eb3 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Tue, 10 Jan 2023 13:32:35 +0100 Subject: [PATCH 18/37] changes to units , kg instead of g and corrections --- src/riverroute/RtmHistFlds.F90 | 8 ++++---- src/riverroute/RtmMod.F90 | 4 ++-- src/riverroute/RunoffMod.F90 | 18 +++++++++--------- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 4b8549a..bd52224 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -130,19 +130,19 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='Actual irrigation (if limited by river storage)', & ptr_rof=rtmCTL%qirrig_actual, default='inactive') - call RtmHistAddfld (fname='RIVER_DISCHARGE_OVER_LAND'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + call RtmHistAddfld (fname='RIVER_DISCHARGE_OVER_LAND'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM basin flow: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%runofflnddom_ntdom1, default='active') - call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM discharge into ocean: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%runoffocndom_ntdom1, default='active') - call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers_dom(1)), units='gC/s', & + call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART input surface DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domsur_ntdom1, default='active') - call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='gC', & + call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index e3d113d..902c8dc 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1911,10 +1911,10 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr volr_init = rtmCTL%volr(nr,nt) rtmCTL%volr(nr,nt) = (TRunoff%wt(nr,nt) + TRunoff%wr(nr,nt) + & - TRunoff%wh(nr,nt)*rtmCTL%area(nr)) + TRunoff%wh(nr,nt)*rtmCTL%area(nr)) ! why times area ? wouldn t that become m^5 if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*Tdom%domH(nr,ntdom)*rtmCTL%area(nr) + & + rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*Tdom%domH(nr,ntdom) + & TRunoff%wt(nr,nt)*Tdom%domt(nr,ntdom) + & TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom) enddo diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 6d4f669..a452c07 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -59,14 +59,14 @@ module RunoffMod ! - local real(r8), pointer :: runofflnd(:,:) ! runoff masked for land (m3 H2O/s) real(r8), pointer :: runoffocn(:,:) ! runoff masked for ocn (m3 H2O/s) - real(r8), pointer :: runoffocndom(:,:)! DOM runoff masked for ocn (gC/s) - real(r8), pointer :: runofflnddom(:,:)! DOM runoff masked for lnd (gC/s) + real(r8), pointer :: runoffocndom(:,:)! DOM runoff masked for ocn (kgC/s) + real(r8), pointer :: runofflnddom(:,:)! DOM runoff masked for lnd (kgC/s) real(r8), pointer :: runofftot(:,:) ! total runoff masked for ocn (m3 H2O/s) real(r8), pointer :: dvolrdt(:,:) ! RTM change in storage (mm/s) real(r8), pointer :: dvolrdtlnd(:,:) ! dvolrdt masked for land (mm/s) real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) - real(r8), pointer :: dommas(:,:) ! RTM DOM storage (gC) + real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) @@ -78,7 +78,7 @@ module RunoffMod real(r8), pointer :: qsur(:,:) ! coupler surface forcing [m3/s] real(r8), pointer :: qsub(:,:) ! coupler subsurface forcing [m3/s] real(r8), pointer :: qgwl(:,:) ! coupler glacier/wetland/lake forcing [m3/s] - real(r8), pointer :: domsur(:,:) ! dom amsked for land (gC/s) + real(r8), pointer :: domsur(:,:) ! dom amsked for land (kgC/s) ! - outputs real(r8), pointer :: flood(:) ! coupler return flood water sent back to clm [m3/s] @@ -286,14 +286,14 @@ module RunoffMod ! DOM status and flux variables public :: Domflux type Domflux - real(r8), pointer :: domsur(:,:) ! flow to downstream grid cells (gC/s) + real(r8), pointer :: domsur(:,:) ! flow to downstream grid cells (kgC/s) !hillslope - real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (gC/m3) + real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (kgC/m3) !sub-network - real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (gC/m3) + real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (kgC/m3) !main channel upstream interactions - real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (gC/m3) - real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (gC/m3) + real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (kgC/m3) + real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (kgC/m3) end type Domflux !== Hongyi From 9b245f7b575d047d3677c2642c39040d38ac7b7a Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Tue, 10 Jan 2023 13:57:43 +0100 Subject: [PATCH 19/37] comments added --- src/cpl/nuopc/rof_import_export.F90 | 2 +- src/riverroute/RtmMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 68231d5..ae754ae 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -623,7 +623,7 @@ subroutine state_getimport(state, fldname, begr, endr, area, output, do_area_cor do g = begr,endr output(g) = fldptr(g-begr+1) * area(g)*0.001_r8 if (fldname=='Flrl_rofdoc') then - output(g) = output(g)*1000._r8 + output(g) = output(g)*1000._r8 ! to keep in kg/s end if end do diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 902c8dc..e17beac 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1911,7 +1911,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr volr_init = rtmCTL%volr(nr,nt) rtmCTL%volr(nr,nt) = (TRunoff%wt(nr,nt) + TRunoff%wr(nr,nt) + & - TRunoff%wh(nr,nt)*rtmCTL%area(nr)) ! why times area ? wouldn t that become m^5 + TRunoff%wh(nr,nt)*rtmCTL%area(nr)) ! why times area for wh only ? wouldn t that become m^5 if (nt==1) then do ntdom = 1,nt_rtm_dom rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*Tdom%domH(nr,ntdom) + & From 4d1e1c49ce04059c44de4570c100d37deeefbea7 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Thu, 12 Jan 2023 11:02:13 +0100 Subject: [PATCH 20/37] add output concentrations of DOM, corrections of units --- src/riverroute/DommasbMod.F90 | 6 +++--- src/riverroute/MOSART_physics_mod.F90 | 26 +++++++++++++------------- src/riverroute/RtmHistFlds.F90 | 15 +++++++++++++++ src/riverroute/RtmMod.F90 | 9 ++++++--- src/riverroute/RunoffMod.F90 | 15 +++++++++++++++ 5 files changed, 52 insertions(+), 19 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index cc4c656..4eec3c7 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -19,13 +19,13 @@ MODULE DommasbMod contains !---------------------------------------------------------------------- - subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) + subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT,Darea,Dfrac) ! ! DESCRIPTION: solve the ODEs with Euler algorithm for hillslope routing implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT + real(r8), intent(in) :: theDeltaT, Darea, Dfrac ! assume no chemical reaction in the water hence sink term is zero implies domH ~= domHout - Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (-TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/TRunoff%wh(iunit,nt) + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (-TRunoff%ehout(iunit,nt) * Darea * Dfrac * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/(TRunoff%wh(iunit,nt)*Darea*Dfrac) end subroutine hillslopeRoutingDOM subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index a9b0416..6694bf9 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -67,7 +67,7 @@ subroutine Euler TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) if (TRunoff%wh(iunit, nt) > 0._r8 .and. nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) + call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT,TUnit%area(iunit),TUnit%frac(iunit)) end do endif endif @@ -151,10 +151,10 @@ subroutine Euler cnt = cnt + 1 do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) + do ntdom = 1,nt_rtm_dom + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*TRunoff%erout(iunit,nt) ! we want to sum the mass of dom not the concentration + end do enddo - do ntdom = 1,nt_rtm_dom - avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom) - end do enddo call mct_avect_zero(avdst_eroutUp) call mct_avect_zero(avdst_domRUp) @@ -168,10 +168,10 @@ subroutine Euler cnt = cnt + 1 do nt = 1,nt_rtm TRunoff%eroutUp(iunit,nt) = avdst_eroutUp%rAttr(nt,cnt) + do ntdom = 1,nt_rtm_dom + Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt)*avdst_eroutUp%rAttr(nt,cnt) ! convert DOM back to concentrations + end do enddo - do ntdom = 1,nt_rtm_dom - Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt) - end do enddo #endif call t_stopf('mosartr_SMeroutUp') @@ -192,17 +192,17 @@ subroutine Euler do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT - if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) - end do - end if ! check for negative channel storage ! if(TRunoff%wr(iunit,1) < -1.e-10) then ! write(iulog,*) 'Negative channel storage! ', iunit, TRunoff%wr(iunit,1) ! call shr_sys_abort('mosart: negative channel storage') ! end if call UpdateState_mainchannel(iunit,nt) + if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + end do + end if temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral end do temp_erout = temp_erout / TUnit%numDT_r(iunit) @@ -453,7 +453,7 @@ end subroutine updateState_mainchannel !----------------------------------------------------------------------- function CRVRMAN(slp_, n_, rr_) result(v_) - ! Function for calculating channel velocity according to Manning's equation. + ! Function for calculating channel velocity according to Manning's equation.vt implicit none real(r8), intent(in) :: slp_, n_, rr_ ! slope, manning's roughness coeff., hydraulic radius real(r8) :: v_ ! v_ is discharge diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index bd52224..27deeae 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -146,6 +146,18 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') + call RtmHistAddfld (fname='HILLS_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domH_ntdom1, default='active') + + call RtmHistAddfld (fname='SUBN_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domT_ntdom1, default='active') + + call RtmHistAddfld (fname='MAINC_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domR_ntdom1, default='active') + ! Print masterlist of history fields call RtmHistPrintflds() @@ -200,6 +212,9 @@ subroutine RtmHistFldsSet() rtmCTL%dommas_ntdom1(:) = rtmCTL%dommas(:,1) rtmCTL%runoffocndom_ntdom1(:) = rtmCTL%runoffocndom(:,1) rtmCTL%runofflnddom_ntdom1(:) = rtmCTL%runofflnddom(:,1) + rtmCTL%domH_ntdom1(:) = rtmCTL%domH(:,1) + rtmCTL%domT_ntdom1(:) = rtmCTL%domT(:,1) + rtmCTL%domR_ntdom1(:) = rtmCTL%domR(:,1) end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index e17beac..4df281a 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1911,12 +1911,15 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr volr_init = rtmCTL%volr(nr,nt) rtmCTL%volr(nr,nt) = (TRunoff%wt(nr,nt) + TRunoff%wr(nr,nt) + & - TRunoff%wh(nr,nt)*rtmCTL%area(nr)) ! why times area for wh only ? wouldn t that become m^5 + TRunoff%wh(nr,nt)*rtmCTL%area(nr)) if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*Tdom%domH(nr,ntdom) + & - TRunoff%wt(nr,nt)*Tdom%domt(nr,ntdom) + & + rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & + TRunoff%wt(nr,nt)*Tdom%domT(nr,ntdom) + & TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom) + rtmCTL%domH(nr,ntdom)=Tdom%domH(nr,ntdom) + rtmCTL%domT(nr,ntdom)=Tdom%domT(nr,ntdom) + rtmCTL%domR(nr,ntdom)=Tdom%domR(nr,ntdom) enddo end if diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index a452c07..1a0d27b 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -67,6 +67,9 @@ module RunoffMod real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domH(:,:) ! RTM DOM storage (kgC/m3) + real(r8), pointer :: domT(:,:) ! RTM DOM storage (kgC/m3) + real(r8), pointer :: domR(:,:) ! RTM DOM storage (kgC/m3) real(r8), pointer :: fthresh(:) ! RTM water flood threshold ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) @@ -114,6 +117,9 @@ module RunoffMod real(r8), pointer :: dommas_ntdom1(:) real(r8), pointer :: runoffocndom_ntdom1(:) real(r8), pointer :: runofflnddom_ntdom1(:) + real(r8), pointer :: domH_ntdom1(:) + real(r8), pointer :: domT_ntdom1(:) + real(r8), pointer :: domR_ntdom1(:) end type runoff_flow @@ -372,6 +378,12 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runoffocndom_ntdom1(begr:endr), & rtmCTL%domsur_ntdom1(begr:endr), & rtmCTL%dommas_ntdom1(begr:endr), & + rtmCTL%domH_ntdom1(begr:endr), & + rtmCTL%domH(begr:endr,nt_rtm_dom), & + rtmCTL%domT_ntdom1(begr:endr), & + rtmCTL%domT(begr:endr,nt_rtm_dom), & + rtmCTL%domR_ntdom1(begr:endr), & + rtmCTL%domR(begr:endr,nt_rtm_dom), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -400,6 +412,9 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runoffocndom(:,:)=spval rtmCTL%domsur(:,:) =0._r8 rtmCTL%dommas(:,:) =0._r8 + rtmCTL%domH(:,:) =0._r8 + rtmCTL%domT(:,:) =0._r8 + rtmCTL%domR(:,:) =0._r8 end subroutine RunoffInit From 06827d49968cc37c0c496c5d3d95ce62465dc9f5 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Mon, 16 Jan 2023 18:05:44 +0100 Subject: [PATCH 21/37] sign corrections and fixes --- src/riverroute/DommasbMod.F90 | 15 ++++++++------- src/riverroute/MOSART_physics_mod.F90 | 9 +++++---- src/riverroute/RtmHistFlds.F90 | 8 ++++---- src/riverroute/RtmMod.F90 | 10 ++-------- src/riverroute/RunoffMod.F90 | 2 +- 5 files changed, 20 insertions(+), 24 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 4eec3c7..4e5d093 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -7,6 +7,7 @@ MODULE DommasbMod use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort use RunoffMod , only : TRunoff, Tdom + use RtmVar , only : iulog implicit none @@ -24,27 +25,27 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT,Darea,Dfrac) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT, Darea, Dfrac - ! assume no chemical reaction in the water hence sink term is zero implies domH ~= domHout - Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (-TRunoff%ehout(iunit,nt) * Darea * Dfrac * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/(TRunoff%wh(iunit,nt)*Darea*Dfrac) + ! assume no chemical reaction in the water hence sink term is zero implies domsur = domR*flow + ! ehout is negative + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (TRunoff%ehout(iunit,nt) * Darea * Dfrac * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/(TRunoff%wh(iunit,nt)*Darea*Dfrac) end subroutine hillslopeRoutingDOM subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODEs with Euler algorithm for subnetwork routing + ! etin is positive and etout is negative implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) - TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) end subroutine subnetworkRoutingDOM subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODE with Euler algorithm for main-channel routing + ! erout is negative, while erlateral and erin are positive implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - real(r8) :: mainchinT, mainchinUp - mainchinT = TRunoff%etout(iunit,nt) - TRunoff%erlateral(iunit,nt) !input to main channel from Tributaries - mainchinUp = TRunoff%eroutUp(iunit,nt) !inflow to main channel from Upstream grid cells of main channel - Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + ( (mainchinT*Tdom%domT(iunit,ntdom) + mainchinUp*Tdom%domRUp(iunit,ntdom)) - TRunoff%flow(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + TRunoff%erin(iunit,nt)*Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 6694bf9..4d31cce 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -133,6 +133,7 @@ subroutine Euler call t_startf('mosartr_SMeroutUp') TRunoff%eroutUp = 0._r8 + Tdom%domRUp = 0._r8 #ifdef NO_MCT do iunit=rtmCTL%begr,rtmCTL%endr do k=1,TUnit%nUp(iunit) @@ -152,7 +153,7 @@ subroutine Euler do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) do ntdom = 1,nt_rtm_dom - avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*TRunoff%erout(iunit,nt) ! we want to sum the mass of dom not the concentration + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration end do enddo enddo @@ -169,7 +170,7 @@ subroutine Euler do nt = 1,nt_rtm TRunoff%eroutUp(iunit,nt) = avdst_eroutUp%rAttr(nt,cnt) do ntdom = 1,nt_rtm_dom - Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt)*avdst_eroutUp%rAttr(nt,cnt) ! convert DOM back to concentrations + Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt)/TRunoff%eroutUp(iunit,nt) !kg/s / m3/s convert DOM back to concentrations end do enddo enddo @@ -198,7 +199,7 @@ subroutine Euler ! call shr_sys_abort('mosart: negative channel storage') ! end if call UpdateState_mainchannel(iunit,nt) - if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then + if (nt==1) then do ntdom=1,nt_rtm_dom ! loop over DOM tracers call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) end do @@ -220,7 +221,7 @@ subroutine Euler ! check for negative channel storage if (negchan < -1.e-10) then write(iulog,*) 'Warning: Negative channel storage found! ',negchan -! call shr_sys_abort('mosart: negative channel storage') + call shr_sys_abort('mosart: negative channel storage') endif TRunoff%flow = TRunoff%flow / Tctl%DLevelH2R TRunoff%erout_prev = TRunoff%erout_prev / Tctl%DLevelH2R diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 27deeae..b7bef5a 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -142,19 +142,19 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART input surface DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domsur_ntdom1, default='active') - call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m2', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') - call RtmHistAddfld (fname='HILLS_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + call RtmHistAddfld (fname='CONC_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domH_ntdom1, default='active') - call RtmHistAddfld (fname='SUBN_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + call RtmHistAddfld (fname='CONC_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domT_ntdom1, default='active') - call RtmHistAddfld (fname='MAINC_CONC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + call RtmHistAddfld (fname='CONC_MAINC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domR_ntdom1, default='active') diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 4df281a..c0d167c 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1914,9 +1914,9 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%wh(nr,nt)*rtmCTL%area(nr)) if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%dommas(nr,ntdom)=TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & + rtmCTL%dommas(nr,ntdom)=(TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & TRunoff%wt(nr,nt)*Tdom%domT(nr,ntdom) + & - TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom) + TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom))/rtmCTL%area(nr) rtmCTL%domH(nr,ntdom)=Tdom%domH(nr,ntdom) rtmCTL%domT(nr,ntdom)=Tdom%domT(nr,ntdom) rtmCTL%domR(nr,ntdom)=Tdom%domR(nr,ntdom) @@ -2778,7 +2778,6 @@ subroutine MOSART_init cnt = cnt + 1 avdst_eroutUp%rAttr(1,cnt) = rtmCTL%area(nr) Tunit%areatotal2(nr) = avdst_eroutUp%rAttr(1,cnt) - avdst_domRUp%rAttr(1,cnt) = rtmCTL%area(nr) enddo tcnt = 0 @@ -2791,19 +2790,14 @@ subroutine MOSART_init ! copy avdst to avsrc for next downstream step cnt = 0 call mct_avect_zero(avsrc_eroutUp) - call mct_avect_zero(avsrc_domRUp) do nr = rtmCTL%begr,rtmCTL%endr cnt = cnt + 1 avsrc_eroutUp%rAttr(1,cnt) = avdst_eroutUp%rAttr(1,cnt) - avsrc_domRUp%rAttr(1,cnt) = avdst_domRUp%rAttr(1,cnt) enddo call mct_avect_zero(avdst_eroutUp) - call mct_avect_zero(avdst_domRUp) - call mct_sMat_avMult(avsrc_eroutUp, sMatP_eroutUp, avdst_eroutUp) - call mct_sMat_avMult(avsrc_domRUp, sMatP_domRUp, avdst_domRUp) ! add avdst to areatot and compute new global sum diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 1a0d27b..607c91e 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -66,7 +66,7 @@ module RunoffMod real(r8), pointer :: dvolrdtlnd(:,:) ! dvolrdt masked for land (mm/s) real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) - real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC/m2) real(r8), pointer :: domH(:,:) ! RTM DOM storage (kgC/m3) real(r8), pointer :: domT(:,:) ! RTM DOM storage (kgC/m3) real(r8), pointer :: domR(:,:) ! RTM DOM storage (kgC/m3) From 012395320e573ed3ff1fc0133c6568f24588108f Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Fri, 20 Jan 2023 10:17:25 +0100 Subject: [PATCH 22/37] various fixes --- src/cpl/nuopc/rof_import_export.F90 | 3 --- src/riverroute/DommasbMod.F90 | 2 +- src/riverroute/MOSART_physics_mod.F90 | 26 +++++++++++++------------- src/riverroute/RtmHistFlds.F90 | 15 +++++++++++++++ src/riverroute/RtmMod.F90 | 3 +++ src/riverroute/RunoffMod.F90 | 19 +++++++++++++++++-- 6 files changed, 49 insertions(+), 19 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index ae754ae..8c594cc 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -622,9 +622,6 @@ subroutine state_getimport(state, fldname, begr, endr, area, output, do_area_cor end if do g = begr,endr output(g) = fldptr(g-begr+1) * area(g)*0.001_r8 - if (fldname=='Flrl_rofdoc') then - output(g) = output(g)*1000._r8 ! to keep in kg/s - end if end do ! check for nans diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 4e5d093..26038dd 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -45,7 +45,7 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + TRunoff%erin(iunit,nt)*Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 4d31cce..ab87b32 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -108,13 +108,13 @@ subroutine Euler TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) - if (TRunoff%wt(iunit,nt) > 0._r8 .and. nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) - end do - endif end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) + if (TRunoff%wt(iunit,nt) > 0._r8 .and. nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) + end do + endif endif end do ! iunit endif ! euler_calc @@ -153,7 +153,7 @@ subroutine Euler do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) do ntdom = 1,nt_rtm_dom - avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*-1._r8*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration end do enddo enddo @@ -161,7 +161,7 @@ subroutine Euler call mct_avect_zero(avdst_domRUp) call mct_sMat_avMult(avsrc_eroutUp, sMatP_eroutUp, avdst_eroutUp) - call mct_sMat_avMult(avsrc_domRUp, sMatP_domRUp, avdst_domRUp) + call mct_sMat_avMult(avsrc_domRUp, sMatP_eroutUp, avdst_domRUp) !--- add mapped eroutUp to TRunoff --- cnt = 0 @@ -170,7 +170,7 @@ subroutine Euler do nt = 1,nt_rtm TRunoff%eroutUp(iunit,nt) = avdst_eroutUp%rAttr(nt,cnt) do ntdom = 1,nt_rtm_dom - Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt)/TRunoff%eroutUp(iunit,nt) !kg/s / m3/s convert DOM back to concentrations + Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt) end do enddo enddo @@ -199,16 +199,16 @@ subroutine Euler ! call shr_sys_abort('mosart: negative channel storage') ! end if call UpdateState_mainchannel(iunit,nt) - if (nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) - end do - end if temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral end do temp_erout = temp_erout / TUnit%numDT_r(iunit) TRunoff%erout(iunit,nt) = temp_erout TRunoff%flow(iunit,nt) = TRunoff%flow(iunit,nt) - TRunoff%erout(iunit,nt) + if (nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + end do + end if endif end do ! iunit endif ! euler_calc diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index b7bef5a..a76c8b9 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -158,6 +158,18 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domR_ntdom1, default='active') + call RtmHistAddfld (fname='CONC_UPSTREAM'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domRUp_ntdom1, default='active') + + call RtmHistAddfld (fname='ERIN'//'_'//trim(rtm_tracers(1)), units='m3/s', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%erin_nt1, default='active') + + call RtmHistAddfld (fname='ERLATERAL'//'_'//trim(rtm_tracers(1)), units='m3/s', & + avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%erlateral_nt1, default='active') + ! Print masterlist of history fields call RtmHistPrintflds() @@ -215,6 +227,9 @@ subroutine RtmHistFldsSet() rtmCTL%domH_ntdom1(:) = rtmCTL%domH(:,1) rtmCTL%domT_ntdom1(:) = rtmCTL%domT(:,1) rtmCTL%domR_ntdom1(:) = rtmCTL%domR(:,1) + rtmCTL%domRUp_ntdom1(:) = rtmCTL%domRUp(:,1) + rtmCTL%erin_nt1(:) = rtmCTL%erin(:,1) + rtmCTL%erlateral_nt1(:) = rtmCTL%erlateral(:,1) end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index c0d167c..a8f4139 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1920,7 +1920,10 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%domH(nr,ntdom)=Tdom%domH(nr,ntdom) rtmCTL%domT(nr,ntdom)=Tdom%domT(nr,ntdom) rtmCTL%domR(nr,ntdom)=Tdom%domR(nr,ntdom) + rtmCTL%domRUp(nr,ntdom)=Tdom%domRUp(nr,ntdom) enddo + rtmCTL%erin(nr,nt)=TRunoff%erin(nr,nt) + rtmCTL%erlateral(nr,nt)=TRunoff%erlateral(nr,nt) end if rtmCTL%dvolrdt(nr,nt) = (rtmCTL%volr(nr,nt) - volr_init) / delt_coupling diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 607c91e..f99d4e9 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -70,6 +70,9 @@ module RunoffMod real(r8), pointer :: domH(:,:) ! RTM DOM storage (kgC/m3) real(r8), pointer :: domT(:,:) ! RTM DOM storage (kgC/m3) real(r8), pointer :: domR(:,:) ! RTM DOM storage (kgC/m3) + real(r8), pointer :: domRUp(:,:) ! RTM DOM storage (kgC/m3) + real(r8), pointer :: erin(:,:) ! MOSART flow in main channel from upstream gridcells (m3/s) + real(r8), pointer :: erlateral(:,:) ! MOSART flow in main channel from tributaries (m3/s) real(r8), pointer :: fthresh(:) ! RTM water flood threshold ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) @@ -81,7 +84,7 @@ module RunoffMod real(r8), pointer :: qsur(:,:) ! coupler surface forcing [m3/s] real(r8), pointer :: qsub(:,:) ! coupler subsurface forcing [m3/s] real(r8), pointer :: qgwl(:,:) ! coupler glacier/wetland/lake forcing [m3/s] - real(r8), pointer :: domsur(:,:) ! dom amsked for land (kgC/s) + real(r8), pointer :: domsur(:,:) ! dom masked for land (kgC/s) ! - outputs real(r8), pointer :: flood(:) ! coupler return flood water sent back to clm [m3/s] @@ -120,6 +123,9 @@ module RunoffMod real(r8), pointer :: domH_ntdom1(:) real(r8), pointer :: domT_ntdom1(:) real(r8), pointer :: domR_ntdom1(:) + real(r8), pointer :: domRUp_ntdom1(:) + real(r8), pointer :: erin_nt1(:) + real(r8), pointer :: erlateral_nt1(:) end type runoff_flow @@ -292,7 +298,7 @@ module RunoffMod ! DOM status and flux variables public :: Domflux type Domflux - real(r8), pointer :: domsur(:,:) ! flow to downstream grid cells (kgC/s) + real(r8), pointer :: domsur(:,:) ! flow from land (kgC/s) !hillslope real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (kgC/m3) !sub-network @@ -384,6 +390,12 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domT(begr:endr,nt_rtm_dom), & rtmCTL%domR_ntdom1(begr:endr), & rtmCTL%domR(begr:endr,nt_rtm_dom), & + rtmCTL%domRUp_ntdom1(begr:endr), & + rtmCTL%domRUp(begr:endr,nt_rtm_dom), & + rtmCTL%erin_nt1(begr:endr), & + rtmCTL%erin(begr:endr,nt_rtm), & + rtmCTL%erlateral_nt1(begr:endr), & + rtmCTL%erlateral(begr:endr,nt_rtm), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -415,6 +427,9 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domH(:,:) =0._r8 rtmCTL%domT(:,:) =0._r8 rtmCTL%domR(:,:) =0._r8 + rtmCTL%domRUp(:,:) =0._r8 + rtmCTL%erin(:,:) =0._r8 + rtmCTL%erlateral(:,:) =0._r8 end subroutine RunoffInit From bf848615b4c9b12f345cfd6de1037bf8f34a4a02 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Fri, 20 Jan 2023 15:42:08 +0100 Subject: [PATCH 23/37] testing --- src/riverroute/MOSART_physics_mod.F90 | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index ab87b32..0e3c754 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -152,16 +152,17 @@ subroutine Euler cnt = cnt + 1 do nt = 1,nt_rtm avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) - do ntdom = 1,nt_rtm_dom - avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*-1._r8*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration - end do + if (nt==1) then + do ntdom = 1,nt_rtm_dom + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*-1._r8*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration + end do + endif enddo enddo call mct_avect_zero(avdst_eroutUp) call mct_avect_zero(avdst_domRUp) - call mct_sMat_avMult(avsrc_eroutUp, sMatP_eroutUp, avdst_eroutUp) - call mct_sMat_avMult(avsrc_domRUp, sMatP_eroutUp, avdst_domRUp) + call mct_sMat_avMult(avsrc_domRUp, sMatP_domRUp, avdst_domRUp) !--- add mapped eroutUp to TRunoff --- cnt = 0 @@ -169,9 +170,11 @@ subroutine Euler cnt = cnt + 1 do nt = 1,nt_rtm TRunoff%eroutUp(iunit,nt) = avdst_eroutUp%rAttr(nt,cnt) - do ntdom = 1,nt_rtm_dom - Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt) - end do + if (nt==1) then + do ntdom = 1,nt_rtm_dom + Tdom%domRUp(iunit,ntdom) = avdst_domRUp%rAttr(ntdom,cnt) + end do + endif enddo enddo #endif @@ -204,7 +207,7 @@ subroutine Euler temp_erout = temp_erout / TUnit%numDT_r(iunit) TRunoff%erout(iunit,nt) = temp_erout TRunoff%flow(iunit,nt) = TRunoff%flow(iunit,nt) - TRunoff%erout(iunit,nt) - if (nt==1) then + if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then do ntdom=1,nt_rtm_dom ! loop over DOM tracers call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) end do From 1b8ca3b7ec748afa6913e55ed531662fb79ed808 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Mon, 23 Jan 2023 14:08:49 +0100 Subject: [PATCH 24/37] add surface and subsurface DOM --- src/cpl/nuopc/rof_import_export.F90 | 9 +++++++-- src/riverroute/DommasbMod.F90 | 2 +- src/riverroute/RtmMod.F90 | 3 +++ src/riverroute/RunoffMod.F90 | 10 ++++++++-- 4 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 8c594cc..285c9ef 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -110,7 +110,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, do_rtmflood, rc) call fldlist_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') - call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofdoc') + call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_subdoc') + call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_surfdoc') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub') call fldlist_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') @@ -287,7 +288,11 @@ subroutine import_fields( gcomp, rc ) do_area_correction=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Flrl_rofdoc', begr, endr, rtmCTL%area, output=rtmCTL%domsur(:,ndoc), & + call state_getimport(importState, 'Flrl_surfdoc', begr, endr, rtmCTL%area, output=rtmCTL%domsur(:,ndoc), & + do_area_correction=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Flrl_subdoc', begr, endr, rtmCTL%area, output=rtmCTL%domsub(:,ndoc), & do_area_correction=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 26038dd..a383e6f 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -36,7 +36,7 @@ subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom) + TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) end subroutine subnetworkRoutingDOM subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index a8f4139..76f811e 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1506,6 +1506,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr do nt = 1,nt_rtm_dom Tdom%domsur(nr,nt) = rtmCTL%domsur(nr,nt) + Tdom%domsub(nr,nt) = rtmCTL%domsub(nr,nt) enddo enddo @@ -2593,6 +2594,8 @@ subroutine MOSART_init Tdom%domRUp = 0._r8 allocate (Tdom%domsur(begr:endr,nt_rtm_dom)) Tdom%domsur = 0._r8 + allocate (Tdom%domsub(begr:endr,nt_rtm_dom)) + Tdom%domsub = 0._r8 call pio_freedecomp(ncid, iodesc_dbl) call pio_freedecomp(ncid, iodesc_int) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index f99d4e9..bafc3eb 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -84,7 +84,8 @@ module RunoffMod real(r8), pointer :: qsur(:,:) ! coupler surface forcing [m3/s] real(r8), pointer :: qsub(:,:) ! coupler subsurface forcing [m3/s] real(r8), pointer :: qgwl(:,:) ! coupler glacier/wetland/lake forcing [m3/s] - real(r8), pointer :: domsur(:,:) ! dom masked for land (kgC/s) + real(r8), pointer :: domsur(:,:) ! surface dom masked for land (kgC/s) + real(r8), pointer :: domsub(:,:) ! subsurface dom masked for land (kgC/s) ! - outputs real(r8), pointer :: flood(:) ! coupler return flood water sent back to clm [m3/s] @@ -117,6 +118,7 @@ module RunoffMod real(r8), pointer :: qgwl_nt1(:) real(r8), pointer :: qgwl_nt2(:) real(r8), pointer :: domsur_ntdom1(:) + real(r8), pointer :: domsub_ntdom1(:) real(r8), pointer :: dommas_ntdom1(:) real(r8), pointer :: runoffocndom_ntdom1(:) real(r8), pointer :: runofflnddom_ntdom1(:) @@ -298,7 +300,8 @@ module RunoffMod ! DOM status and flux variables public :: Domflux type Domflux - real(r8), pointer :: domsur(:,:) ! flow from land (kgC/s) + real(r8), pointer :: domsur(:,:) ! surface DOM flow from land (kgC/s) + real(r8), pointer :: domsub(:,:) ! subsurface DOM flow from land (kgC/s) !hillslope real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (kgC/m3) !sub-network @@ -379,10 +382,12 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runofflnddom(begr:endr,nt_rtm_dom), & rtmCTL%runoffocndom(begr:endr,nt_rtm_dom), & rtmCTL%domsur(begr:endr,nt_rtm_dom), & + rtmCTL%domsub(begr:endr,nt_rtm_dom), & rtmCTL%dommas(begr:endr,nt_rtm_dom), & rtmCTL%runofflnddom_ntdom1(begr:endr), & rtmCTL%runoffocndom_ntdom1(begr:endr), & rtmCTL%domsur_ntdom1(begr:endr), & + rtmCTL%domsub_ntdom1(begr:endr), & rtmCTL%dommas_ntdom1(begr:endr), & rtmCTL%domH_ntdom1(begr:endr), & rtmCTL%domH(begr:endr,nt_rtm_dom), & @@ -423,6 +428,7 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runofflnddom(:,:)=spval rtmCTL%runoffocndom(:,:)=spval rtmCTL%domsur(:,:) =0._r8 + rtmCTL%domsub(:,:) =0._r8 rtmCTL%dommas(:,:) =0._r8 rtmCTL%domH(:,:) =0._r8 rtmCTL%domT(:,:) =0._r8 From ba0506b0db207dccfc95f7d2ab888f5bbc1c750f Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Tue, 31 Jan 2023 12:59:08 +0100 Subject: [PATCH 25/37] PRINT --- src/riverroute/RtmHistFlds.F90 | 9 ++++-- src/riverroute/RtmMod.F90 | 6 +++- src/riverroute/RtmRestFile.F90 | 55 ++++++++++++++++++++++++++++++++-- 3 files changed, 65 insertions(+), 5 deletions(-) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index a76c8b9..cb587c1 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -100,7 +100,7 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART input surface runoff: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%qsur_nt1, default='inactive') + ptr_rof=rtmCTL%qsur_nt1, default='active') call RtmHistAddfld (fname='QSUR'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART input surface runoff: '//trim(rtm_tracers(2)), & @@ -108,7 +108,7 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='QSUB'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART input subsurface runoff: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%qsub_nt1, default='inactive') + ptr_rof=rtmCTL%qsub_nt1, default='active') call RtmHistAddfld (fname='QSUB'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART input subsurface runoff: '//trim(rtm_tracers(2)), & @@ -142,6 +142,10 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART input surface DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domsur_ntdom1, default='active') + call RtmHistAddfld (fname='QSUB'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & + avgflag='A', long_name='MOSART input subsurface DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domsub_ntdom1, default='active') + call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m2', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') @@ -221,6 +225,7 @@ subroutine RtmHistFldsSet() rtmCTL%qgwl_nt2(:) = rtmCTL%qgwl(:,2) rtmCTL%domsur_ntdom1(:) = rtmCTL%domsur(:,1) + rtmCTL%domsub_ntdom1(:) = rtmCTL%domsub(:,1) rtmCTL%dommas_ntdom1(:) = rtmCTL%dommas(:,1) rtmCTL%runoffocndom_ntdom1(:) = rtmCTL%runoffocndom(:,1) rtmCTL%runofflnddom_ntdom1(:) = rtmCTL%runofflnddom(:,1) diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 76f811e..1889c19 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1507,7 +1507,11 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nt = 1,nt_rtm_dom Tdom%domsur(nr,nt) = rtmCTL%domsur(nr,nt) Tdom%domsub(nr,nt) = rtmCTL%domsub(nr,nt) - enddo + write(iulog,*) 'MOSART CHECK',nr,nr,Tdom%domsur(nr,nt),Tdom%domsub(nr,nt) + if (Tdom%domsur(nr,nt)>140000) then + write(iulog,*) 'MOSART FUCK' + endif + enddo enddo !----------------------------------- diff --git a/src/riverroute/RtmRestFile.F90 b/src/riverroute/RtmRestFile.F90 index 19c593c..2017d17 100644 --- a/src/riverroute/RtmRestFile.F90 +++ b/src/riverroute/RtmRestFile.F90 @@ -17,7 +17,7 @@ module RtmRestFile finidat_rtm, nrevsn_rtm, spval, & nsrContinue, nsrBranch, nsrStartup, & ctitle, version, username, hostname, conventions, source, & - nt_rtm, nt_rtm, rtm_tracers + nt_rtm, nt_rtm, rtm_tracers, nt_rtm_dom use RtmHistFile , only : RtmHistRestart use RtmFileUtils , only : relavu, getavu, opnfil, getfil use RtmTimeManager, only : timemgr_restart, get_nstep, get_curr_date, is_last_step @@ -373,7 +373,7 @@ subroutine RtmRestart(ncid, flag) character(len=*) , intent(in) :: flag ! 'read' or 'write' ! LOCAL VARIABLES: logical :: readvar ! determine if variable is on initial file - integer :: nt,nv,n ! indices + integer :: nt,ntdom,nv,n ! indices real(r8) , pointer :: dfld(:) ! temporary array character(len=32) :: vname,uname character(len=255) :: lname @@ -421,6 +421,7 @@ subroutine RtmRestart(ncid, flag) write(iulog,*) 'Rtm ERROR: illegal nv value a ',nv call shr_sys_abort() endif + if (flag == 'define') then call ncd_defvar(ncid=ncid, varname=trim(vname), & @@ -440,6 +441,49 @@ subroutine RtmRestart(ncid, flag) enddo enddo + + + do nv = 8,10 + do ntdom = 1,nt_rtm_dom + if (nv == 8) then + vname = 'RTM_DOMH_'//trim(rtm_tracers(ntdom)) + lname = 'DOM storage at hillslope in cell' + uname = 'kg/m3' + dfld => rtmCTL%domH(:,ntdom) + elseif (nv == 9) then + vname = 'RTM_DOMT_'//trim(rtm_tracers(ntdom)) + lname = 'DOM storage in tributary channels in cell' + uname = 'kg/m3' + dfld => rtmCTL%domT(:,ntdom) + elseif (nv == 10) then + vname = 'RTM_DOMR_'//trim(rtm_tracers(ntdom)) + lname = 'DOM storage in main channel in cell' + uname = 'kg/m3' + dfld => rtmCTL%domR(:,ntdom) + else + write(iulog,*) 'Rtm ERROR: illegal nv value a ',nv + call shr_sys_abort() + endif + + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname=trim(vname), & + xtype=ncd_double, dim1name='rtmlon', dim2name='rtmlat', & + long_name=trim(lname), units=trim(uname), fill_value=spval) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname=trim(vname), data=dfld, dim1name='allrof', & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (nsrest == nsrContinue) then + call shr_sys_abort() + else + dfld = 0._r8 + end if + end if + end if + + enddo + enddo if (flag == 'read') then do n = rtmCTL%begr,rtmCTL%endr @@ -451,6 +495,13 @@ subroutine RtmRestart(ncid, flag) if (abs(rtmCTL%wt(n,nt)) > 1.e30) rtmCTL%wt(n,nt) = 0. if (abs(rtmCTL%wr(n,nt)) > 1.e30) rtmCTL%wr(n,nt) = 0. if (abs(rtmCTL%erout(n,nt)) > 1.e30) rtmCTL%erout(n,nt) = 0. + if (nt==1) then + do ntdom = 1,nt_rtm_dom + if (abs(rtmCTL%domH(n,ntdom)) > 1.e30) rtmCTL%domH(n,ntdom) = 0. + if (abs(rtmCTL%domT(n,ntdom)) > 1.e30) rtmCTL%domT(n,ntdom) = 0. + if (abs(rtmCTL%domR(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. + end do + endif end do if (rtmCTL%mask(n) == 1) then do nt = 1,nt_rtm From 03c7f899e570f340bf0eaa712da5a9b37e86b6ba Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Wed, 1 Feb 2023 13:18:15 +0100 Subject: [PATCH 26/37] unit changes --- src/riverroute/RtmHistFlds.F90 | 8 ++++---- src/riverroute/RtmMod.F90 | 18 +++++++----------- 2 files changed, 11 insertions(+), 15 deletions(-) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index cb587c1..3d35cc1 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -72,7 +72,7 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers(1)), units='m3', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%volr_nt1, default='inactive') + ptr_rof=rtmCTL%volr_nt1, default='active') call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers(2)), units='m3', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers(2)), & @@ -124,11 +124,11 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='QIRRIG_FROM_COUPLER', units='m3/s', & avgflag='A', long_name='Amount of water used for irrigation (total flux received from coupler)', & - ptr_rof=rtmCTL%qirrig, default='inactive') + ptr_rof=rtmCTL%qirrig, default='active') call RtmHistAddfld (fname='QIRRIG_ACTUAL', units='m3/s', & avgflag='A', long_name='Actual irrigation (if limited by river storage)', & - ptr_rof=rtmCTL%qirrig_actual, default='inactive') + ptr_rof=rtmCTL%qirrig_actual, default='active') call RtmHistAddfld (fname='RIVER_DISCHARGE_OVER_LAND'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM basin flow: '//trim(rtm_tracers_dom(1)), & @@ -146,7 +146,7 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART input subsurface DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domsub_ntdom1, default='active') - call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m2', & + call RtmHistAddfld (fname='STORAGE'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 1889c19..ca24ee3 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1501,17 +1501,10 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%qsub(nr,nt) = rtmCTL%qsub(nr,nt) TRunoff%qgwl(nr,nt) = rtmCTL%qgwl(nr,nt) enddo + do nt = 1,nt_rtm_dom + Tdom%domsur(nr,nt) = rtmCTL%domsur(nr,nt) + Tdom%domsub(nr,nt) = rtmCTL%domsub(nr,nt) enddo - - do nr = rtmCTL%begr,rtmCTL%endr - do nt = 1,nt_rtm_dom - Tdom%domsur(nr,nt) = rtmCTL%domsur(nr,nt) - Tdom%domsub(nr,nt) = rtmCTL%domsub(nr,nt) - write(iulog,*) 'MOSART CHECK',nr,nr,Tdom%domsur(nr,nt),Tdom%domsub(nr,nt) - if (Tdom%domsur(nr,nt)>140000) then - write(iulog,*) 'MOSART FUCK' - endif - enddo enddo !----------------------------------- @@ -1833,6 +1826,9 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%qsur(nr,nt) = TRunoff%qsur(nr,nt) / rtmCTL%area(nr) TRunoff%qsub(nr,nt) = TRunoff%qsub(nr,nt) / rtmCTL%area(nr) TRunoff%qgwl(nr,nt) = TRunoff%qgwl(nr,nt) / rtmCTL%area(nr) + if (nt==1) then + !write(iulog,*) 'MOSART CHECK',Tdom%domsur(nr,1),TRunoff%qsur(nr,1),Tdom%domsub(nr,1),TRunoff%qsub(nr,1) + endif enddo enddo @@ -1921,7 +1917,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) do ntdom = 1,nt_rtm_dom rtmCTL%dommas(nr,ntdom)=(TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & TRunoff%wt(nr,nt)*Tdom%domT(nr,ntdom) + & - TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom))/rtmCTL%area(nr) + TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom)) rtmCTL%domH(nr,ntdom)=Tdom%domH(nr,ntdom) rtmCTL%domT(nr,ntdom)=Tdom%domT(nr,ntdom) rtmCTL%domR(nr,ntdom)=Tdom%domR(nr,ntdom) From 6439c7b2ccde48d5c2baeaec7e50029392ce3aab Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Thu, 2 Feb 2023 10:51:57 +0100 Subject: [PATCH 27/37] correct mass balance equations --- src/riverroute/DommasbMod.F90 | 18 ++++++------ src/riverroute/MOSART_physics_mod.F90 | 42 ++++++++++++++++++--------- src/riverroute/RtmMod.F90 | 23 ++++++++++----- src/riverroute/RtmRestFile.F90 | 10 +++++-- 4 files changed, 61 insertions(+), 32 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index a383e6f..12d970b 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -20,32 +20,32 @@ MODULE DommasbMod contains !---------------------------------------------------------------------- - subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT,Darea,Dfrac) + subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwh) ! ! DESCRIPTION: solve the ODEs with Euler algorithm for hillslope routing implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT, Darea, Dfrac + real(r8), intent(in) :: theDeltaT,Pwh ! assume no chemical reaction in the water hence sink term is zero implies domsur = domR*flow ! ehout is negative - Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (TRunoff%ehout(iunit,nt) * Darea * Dfrac * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/(TRunoff%wh(iunit,nt)*Darea*Dfrac) + Tdom%domH(iunit,ntdom) = (Tdom%domH(iunit,ntdom)*Pwh + TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/TRunoff%wh(iunit,nt) end subroutine hillslopeRoutingDOM - subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) + subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwt) ! solve the ODEs with Euler algorithm for subnetwork routing ! etin is positive and etout is negative implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT - Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom) + TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) + real(r8), intent(in) :: theDeltaT,Pwt + Tdom%domT(iunit,ntdom) = (Tdom%domT(iunit,ntdom)*Pwt + Tdom%domsub(iunit,ntdom) + TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) end subroutine subnetworkRoutingDOM - subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) + subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwr) ! solve the ODE with Euler algorithm for main-channel routing ! erout is negative, while erlateral and erin are positive implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT - Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + real(r8), intent(in) :: theDeltaT,Pwr + Tdom%domR(iunit,ntdom) = (Tdom%domR(iunit,ntdom)*Pwr + TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 0e3c754..8d8ff6d 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -49,7 +49,7 @@ subroutine Euler implicit none integer :: iunit, m, k, unitUp, cnt, ier !local index - real(r8) :: temp_erout, localDeltaT + real(r8) :: temp_erout, localDeltaT,Pwh,Pwt,Pwr real(r8) :: negchan !------------------ @@ -61,13 +61,21 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then + write(iulog,*) 'wh before',TRunoff%wh(iunit,nt) + Pwh=TRunoff%wh(iunit,nt) call hillslopeRouting(iunit,nt,Tctl%DeltaT) TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) - if (TRunoff%wh(iunit, nt) > 0._r8 .and. nt==1) then ! if LIQ tracer and there is water + if (nt==1) then ! if LIQ tracer do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT,TUnit%area(iunit),TUnit%frac(iunit)) + write(iulog,*) 'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'domH',Tdom%domH(iunit,ntdom),'time',Tctl%DeltaT + call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT,Pwh) + Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) + write(iulog,*) 'after domH',Tdom%domH(iunit,ntdom), 'iunit',iunit + if (Tdom%domH(iunit,ntdom)>0.3 .or. TRunoff%wh(iunit,nt)<0._r8) then + write(iulog,*) 'SHIT' + end if end do endif endif @@ -104,17 +112,21 @@ subroutine Euler if(TUnit%mask(iunit) > 0) then localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_t(iunit) do k=1,TUnit%numDT_t(iunit) + Pwt=TRunoff%wt(iunit,nt) call subnetworkRouting(iunit,nt,localDeltaT) TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) + if (nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT,Pwt) + if (Tdom%domT(iunit,ntdom) >0.3 .or. TRunoff%wt(iunit,nt)<0._r8) then + write(iulog,*) 'SHIT',Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt) + end if + end do + endif end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) - if (TRunoff%wt(iunit,nt) > 0._r8 .and. nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) - end do - endif endif end do ! iunit endif ! euler_calc @@ -194,6 +206,7 @@ subroutine Euler localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_r(iunit) temp_erout = 0._r8 do k=1,TUnit%numDT_r(iunit) + Pwr=TRunoff%wr(iunit,nt) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT ! check for negative channel storage @@ -202,16 +215,19 @@ subroutine Euler ! call shr_sys_abort('mosart: negative channel storage') ! end if call UpdateState_mainchannel(iunit,nt) + if (nt==1) then + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT,Pwr) + if (Tdom%domR(iunit,ntdom) >0.3 .or. TRunoff%wr(iunit,nt)<0._r8) then + write(iulog,*) 'SHIT',Tdom%domR(iunit,ntdom),TRunoff%wr(iunit,nt) + end if + end do + end if temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral end do temp_erout = temp_erout / TUnit%numDT_r(iunit) TRunoff%erout(iunit,nt) = temp_erout TRunoff%flow(iunit,nt) = TRunoff%flow(iunit,nt) - TRunoff%erout(iunit,nt) - if (TRunoff%wr(iunit,nt) > 0._r8 .and. nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) - end do - end if endif end do ! iunit endif ! euler_calc diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index ca24ee3..0ca92d8 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1327,6 +1327,11 @@ subroutine Rtmini(flood_active) TRunoff%wt = rtmCTL%wt TRunoff%wr = rtmCTL%wr TRunoff%erout= rtmCTL%erout + Tdom%domH = rtmCTL%domH + Tdom%domT = rtmCTL%domT + Tdom%domR = rtmCTL%domR + Tdom%domRUp = rtmCTL%domRUp + write(iulog,*) 'UPDATED MARIUS' else ! do nt = 1,nt_rtm ! do nr = rtmCTL%begr,rtmCTL%endr @@ -1821,14 +1826,16 @@ subroutine Rtmrun(rstwr,nlend,rdate) call t_stopf('mosartr_budget') ! endif - do nt = 1,nt_rtm + do nr = rtmCTL%begr,rtmCTL%endr + do nt = 1,nt_rtm TRunoff%qsur(nr,nt) = TRunoff%qsur(nr,nt) / rtmCTL%area(nr) TRunoff%qsub(nr,nt) = TRunoff%qsub(nr,nt) / rtmCTL%area(nr) TRunoff%qgwl(nr,nt) = TRunoff%qgwl(nr,nt) / rtmCTL%area(nr) - if (nt==1) then - !write(iulog,*) 'MOSART CHECK',Tdom%domsur(nr,1),TRunoff%qsur(nr,1),Tdom%domsub(nr,1),TRunoff%qsub(nr,1) - endif + enddo + do nt = 1,nt_rtm_dom + Tdom%domsur(nr,nt) = Tdom%domsur(nr,nt) / rtmCTL%area(nr) + Tdom%domsub(nr,nt) = Tdom%domsub(nr,nt) / rtmCTL%area(nr) enddo enddo @@ -1907,6 +1914,10 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%wt = TRunoff%wt rtmCTL%wr = TRunoff%wr rtmCTL%erout = TRunoff%erout + rtmCTL%domH = Tdom%domH + rtmCTL%domT = Tdom%domT + rtmCTL%domR = Tdom%domR + rtmCTL%domRUp = Tdom%domRUp do nt = 1,nt_rtm do nr = rtmCTL%begr,rtmCTL%endr @@ -1918,10 +1929,6 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%dommas(nr,ntdom)=(TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & TRunoff%wt(nr,nt)*Tdom%domT(nr,ntdom) + & TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom)) - rtmCTL%domH(nr,ntdom)=Tdom%domH(nr,ntdom) - rtmCTL%domT(nr,ntdom)=Tdom%domT(nr,ntdom) - rtmCTL%domR(nr,ntdom)=Tdom%domR(nr,ntdom) - rtmCTL%domRUp(nr,ntdom)=Tdom%domRUp(nr,ntdom) enddo rtmCTL%erin(nr,nt)=TRunoff%erin(nr,nt) rtmCTL%erlateral(nr,nt)=TRunoff%erlateral(nr,nt) diff --git a/src/riverroute/RtmRestFile.F90 b/src/riverroute/RtmRestFile.F90 index 2017d17..c9b1e2b 100644 --- a/src/riverroute/RtmRestFile.F90 +++ b/src/riverroute/RtmRestFile.F90 @@ -443,7 +443,7 @@ subroutine RtmRestart(ncid, flag) enddo - do nv = 8,10 + do nv = 8,11 do ntdom = 1,nt_rtm_dom if (nv == 8) then vname = 'RTM_DOMH_'//trim(rtm_tracers(ntdom)) @@ -457,9 +457,14 @@ subroutine RtmRestart(ncid, flag) dfld => rtmCTL%domT(:,ntdom) elseif (nv == 10) then vname = 'RTM_DOMR_'//trim(rtm_tracers(ntdom)) - lname = 'DOM storage in main channel in cell' + lname = 'DOM storage in main channel in cell' uname = 'kg/m3' dfld => rtmCTL%domR(:,ntdom) + elseif (nv == 11) then + vname = 'RTM_DOMRUP_'//trim(rtm_tracers(ntdom)) + lname = 'DOM storage in upstream main channels' + uname = 'kg/m3' + dfld => rtmCTL%domRUp(:,ntdom) else write(iulog,*) 'Rtm ERROR: illegal nv value a ',nv call shr_sys_abort() @@ -500,6 +505,7 @@ subroutine RtmRestart(ncid, flag) if (abs(rtmCTL%domH(n,ntdom)) > 1.e30) rtmCTL%domH(n,ntdom) = 0. if (abs(rtmCTL%domT(n,ntdom)) > 1.e30) rtmCTL%domT(n,ntdom) = 0. if (abs(rtmCTL%domR(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. + if (abs(rtmCTL%domRUp(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. end do endif end do From 9ce0d686a172931f06ca75d06c9c7670cd518cea Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Wed, 15 Feb 2023 09:43:14 +0100 Subject: [PATCH 28/37] various changes --- src/riverroute/DommasbMod.F90 | 20 +++---- src/riverroute/MOSART_physics_mod.F90 | 85 +++++++++++++++++++-------- src/riverroute/RtmHistFlds.F90 | 7 +-- src/riverroute/RtmRestFile.F90 | 2 +- src/riverroute/RtmVar.F90 | 4 +- src/riverroute/RunoffMod.F90 | 2 - 6 files changed, 73 insertions(+), 47 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 12d970b..3642e23 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -1,6 +1,6 @@ MODULE DommasbMod !Description: core code of Dissolved Organic Matter mass balance utilizing river routing models - !Developed by Dev Narayanappa 05/03/2021 + !Developed by Marius Lambert 02-02-2023 !This module is currently made interact with MOSART routing model ! USES: use shr_kind_mod , only : r8 => shr_kind_r8 @@ -20,32 +20,32 @@ MODULE DommasbMod contains !---------------------------------------------------------------------- - subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwh) + subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) ! ! DESCRIPTION: solve the ODEs with Euler algorithm for hillslope routing implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT,Pwh + real(r8), intent(in) :: theDeltaT ! assume no chemical reaction in the water hence sink term is zero implies domsur = domR*flow ! ehout is negative - Tdom%domH(iunit,ntdom) = (Tdom%domH(iunit,ntdom)*Pwh + TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT/TRunoff%wh(iunit,nt) + Tdom%domH(iunit,ntdom) = (Tdom%domH(iunit,ntdom)*max(0._r8,TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * theDeltaT) + (TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT)/TRunoff%wh(iunit,nt) end subroutine hillslopeRoutingDOM - subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwt) + subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT,temp_ehout) ! solve the ODEs with Euler algorithm for subnetwork routing ! etin is positive and etout is negative implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT,Pwt - Tdom%domT(iunit,ntdom) = (Tdom%domT(iunit,ntdom)*Pwt + Tdom%domsub(iunit,ntdom) + TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT/TRunoff%wt(iunit,nt) + real(r8), intent(in) :: theDeltaT,temp_ehout + Tdom%domT(iunit,ntdom) = (Tdom%domT(iunit,ntdom)*max(0._r8,TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * theDeltaT) + (Tdom%domsub(iunit,ntdom) + temp_ehout * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT)/TRunoff%wt(iunit,nt) end subroutine subnetworkRoutingDOM - subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT,Pwr) + subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODE with Euler algorithm for main-channel routing ! erout is negative, while erlateral and erin are positive implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT,Pwr - Tdom%domR(iunit,ntdom) = (Tdom%domR(iunit,ntdom)*Pwr + TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT/TRunoff%wr(iunit,nt) + real(r8), intent(in) :: theDeltaT + Tdom%domR(iunit,ntdom) = (Tdom%domR(iunit,ntdom)*max(0._r8,TRunoff%wr(iunit,nt) - TRunoff%dwr(iunit,nt) * theDeltaT) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT)/TRunoff%wr(iunit,nt) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 8d8ff6d..25aefae 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -49,7 +49,7 @@ subroutine Euler implicit none integer :: iunit, m, k, unitUp, cnt, ier !local index - real(r8) :: temp_erout, localDeltaT,Pwh,Pwt,Pwr + real(r8) :: temp_erout, localDeltaT,temp_ehout real(r8) :: negchan !------------------ @@ -61,23 +61,33 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then - write(iulog,*) 'wh before',TRunoff%wh(iunit,nt) - Pwh=TRunoff%wh(iunit,nt) call hillslopeRouting(iunit,nt,Tctl%DeltaT) TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) - if (nt==1) then ! if LIQ tracer + !----------------------------------------------------------------------------------------------------------------- + if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers - write(iulog,*) 'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'domH',Tdom%domH(iunit,ntdom),'time',Tctl%DeltaT - call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT,Pwh) - Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) - write(iulog,*) 'after domH',Tdom%domH(iunit,ntdom), 'iunit',iunit - if (Tdom%domH(iunit,ntdom)>0.3 .or. TRunoff%wh(iunit,nt)<0._r8) then - write(iulog,*) 'SHIT' - end if - end do + Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + if (TRunoff%wh(iunit,nt)>0._r8) then + call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) + if (Tdom%domH(iunit,ntdom) > 0.3_r8) then + !write(iulog,*) 'HILL EXCESS',iunit,'domH',Tdom%domH(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'dwh',TRunoff%dwh(iunit,nt) + !The excess should be moved to a variable, this happens because we start from negative water... + Tdom%domH(iunit,ntdom)=min(0.3,Tdom%domH(iunit,ntdom)) + else if (Tdom%domH(iunit,ntdom) < 0._r8) then + !can happen if more water leaves (ehout), than there was water in the hillslope (wh), becase negative water before or incoming water is directy sent out ? + Tdom%domH(iunit,ntdom)=0._r8 + !write(iulog,*) 'SHIT HILL',iunit,'domH',Tdom%domH(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'dwh',TRunoff%dwh(iunit,nt) + endif + else if (Tdom%domsur(iunit,ntdom)>1.e-30) then + write(iulog,*) 'HILL EXCESS',iunit,TRunoff%wh(iunit,nt),Tdom%domsur(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 + !here also the excess should be sent back to ctsm + endif + enddo endif + !-------------------------------------------------------------------------------------------------------------------------- endif end do endif @@ -111,20 +121,32 @@ subroutine Euler do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_t(iunit) + temp_ehout = - TRunoff%ehout(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) !needed to multiply with domH in subnetwork do k=1,TUnit%numDT_t(iunit) - Pwt=TRunoff%wt(iunit,nt) call subnetworkRouting(iunit,nt,localDeltaT) TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) - if (nt==1) then + !---------------------------------------------------------------------------------------------------- + if (nt==1) then ! if liq tracer do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT,Pwt) - if (Tdom%domT(iunit,ntdom) >0.3 .or. TRunoff%wt(iunit,nt)<0._r8) then - write(iulog,*) 'SHIT',Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt) - end if - end do + if (TRunoff%wt(iunit,nt)>0._r8) then + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT,temp_ehout) + if (Tdom%domT(iunit,ntdom) > 0.3) then + !write(iulog,*) 'SUBN EXCESS',iunit,nt,'domT',Tdom%domT(iunit,ntdom),'domH',Tdom%domH(iunit,ntdom),'domsub',Tdom%domsub(iunit,ntdom),'wt',TRunoff%wt(iunit,nt),'etin',TRunoff%etin(iunit,nt),'etout',TRunoff%etout(iunit,nt),'dwt',TRunoff%dwt(iunit,nt),'time',localDeltaT + !The excess should be moved to a variable, this happens because we start from negative water... + Tdom%domT(iunit,ntdom)=min(0.3,Tdom%domT(iunit,ntdom)) + else if (Tdom%domT(iunit,ntdom)< 0._r8) then + Tdom%domT(iunit,ntdom)=0._r8 + !write(iulog,*) 'SHIT SUBN',iunit,nt,'domT',Tdom%domT(iunit,ntdom) + end if + else if ((Tdom%domsub(iunit,ntdom)+TRunoff%etin(iunit,nt)*Tdom%domH(iunit,ntdom))>1.e-30) then !if liq tracer but there is negative water + !write(iulog,*) 'SUBN EXCESS', TRunoff%wt(iunit,nt),Tdom%domsub(iunit,ntdom),TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom),'iunit',iunit + Tdom%domT(iunit,ntdom)=0._r8 + endif + enddo endif + !----------------------------------------------------------------------------------------------------- end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) endif @@ -206,7 +228,6 @@ subroutine Euler localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_r(iunit) temp_erout = 0._r8 do k=1,TUnit%numDT_r(iunit) - Pwr=TRunoff%wr(iunit,nt) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT ! check for negative channel storage @@ -215,15 +236,27 @@ subroutine Euler ! call shr_sys_abort('mosart: negative channel storage') ! end if call UpdateState_mainchannel(iunit,nt) + temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral + !----------------------------------------------------------------------------------------------------------- if (nt==1) then do ntdom=1,nt_rtm_dom ! loop over DOM tracers - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT,Pwr) - if (Tdom%domR(iunit,ntdom) >0.3 .or. TRunoff%wr(iunit,nt)<0._r8) then - write(iulog,*) 'SHIT',Tdom%domR(iunit,ntdom),TRunoff%wr(iunit,nt) + if (TRunoff%wr(iunit,nt)>0._r8) then + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + if (Tdom%domR(iunit,ntdom) > 0.3) then + Tdom%domR(iunit,ntdom)=min(0.3,Tdom%domR(iunit,ntdom)) + !DOM should be added to a variable and sent back to ctsm + !write(iulog,*) 'SHIT MAIN','domRUp',Tdom%domRUp(iunit,ntdom),'wr',TRunoff%wr(iunit,nt),'erlateral',TRunoff%erlateral(iunit,nt),'eroutUp',TRunoff%eroutUp(iunit,nt),'dwr',TRunoff%dwr(iunit,nt),'domT',Tdom%domT(iunit,ntdom),'domR',Tdom%domR(iunit,ntdom),'time',localDeltaT + else if (Tdom%domR(iunit,ntdom) < 0._r8) then + !write(iulog,*) 'SHIT MAIN',iunit,'domR',Tdom%domR(iunit,ntdom) + Tdom%domR(iunit,ntdom)=0._r8 end if - end do - end if - temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral + else if ((TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom))>1.e-30) then + !write(iulog,*) 'SHIT MAIN EXCESS', TRunoff%wr(iunit,nt),Tdom%domRUp(iunit,ntdom),TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom),'iunit',iunit + Tdom%domR(iunit,ntdom)=0._r8 + endif + enddo + endif + !---------------------------------------------------------------------------------------------------------------- end do temp_erout = temp_erout / TUnit%numDT_r(iunit) TRunoff%erout(iunit,nt) = temp_erout diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 3d35cc1..cab33d1 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -52,7 +52,7 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART river discharge into ocean: '//trim(rtm_tracers(2)), & - ptr_rof=rtmCTL%runoffocn_nt2, default='inactive') + ptr_rof=rtmCTL%runoffocn_nt2, default='active') call RtmHistAddfld (fname='TOTAL_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART total discharge into ocean: '//trim(rtm_tracers(1)), & @@ -162,10 +162,6 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domR_ntdom1, default='active') - call RtmHistAddfld (fname='CONC_UPSTREAM'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%domRUp_ntdom1, default='active') - call RtmHistAddfld (fname='ERIN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%erin_nt1, default='active') @@ -232,7 +228,6 @@ subroutine RtmHistFldsSet() rtmCTL%domH_ntdom1(:) = rtmCTL%domH(:,1) rtmCTL%domT_ntdom1(:) = rtmCTL%domT(:,1) rtmCTL%domR_ntdom1(:) = rtmCTL%domR(:,1) - rtmCTL%domRUp_ntdom1(:) = rtmCTL%domRUp(:,1) rtmCTL%erin_nt1(:) = rtmCTL%erin(:,1) rtmCTL%erlateral_nt1(:) = rtmCTL%erlateral(:,1) diff --git a/src/riverroute/RtmRestFile.F90 b/src/riverroute/RtmRestFile.F90 index c9b1e2b..37d0bcb 100644 --- a/src/riverroute/RtmRestFile.F90 +++ b/src/riverroute/RtmRestFile.F90 @@ -505,7 +505,7 @@ subroutine RtmRestart(ncid, flag) if (abs(rtmCTL%domH(n,ntdom)) > 1.e30) rtmCTL%domH(n,ntdom) = 0. if (abs(rtmCTL%domT(n,ntdom)) > 1.e30) rtmCTL%domT(n,ntdom) = 0. if (abs(rtmCTL%domR(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. - if (abs(rtmCTL%domRUp(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. + if (abs(rtmCTL%domRUp(n,ntdom)) > 1.e30) rtmCTL%domRUp(n,ntdom) = 0. end do endif end do diff --git a/src/riverroute/RtmVar.F90 b/src/riverroute/RtmVar.F90 index 13b2416..b1ec37a 100644 --- a/src/riverroute/RtmVar.F90 +++ b/src/riverroute/RtmVar.F90 @@ -10,8 +10,8 @@ module RtmVar !TODO - nt_rtm and rtm_tracers need to be removed and set by access to the index array integer, parameter, public :: nt_rtm = 2 ! number of tracers character(len=3), parameter, public :: rtm_tracers(nt_rtm) = (/'LIQ','ICE'/) - integer, parameter, public :: nt_rtm_dom = 2 ! number of tracers - character(len=3), parameter, public :: rtm_tracers_dom(nt_rtm_dom) = (/'DOC','DON'/) + integer, parameter, public :: nt_rtm_dom = 1 ! number of tracers + character(len=3), parameter, public :: rtm_tracers_dom(nt_rtm_dom) = (/'DOC'/) !DON? ! Constants integer, parameter, private :: iundef = -9999999 diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index bafc3eb..6c8acba 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -125,7 +125,6 @@ module RunoffMod real(r8), pointer :: domH_ntdom1(:) real(r8), pointer :: domT_ntdom1(:) real(r8), pointer :: domR_ntdom1(:) - real(r8), pointer :: domRUp_ntdom1(:) real(r8), pointer :: erin_nt1(:) real(r8), pointer :: erlateral_nt1(:) @@ -395,7 +394,6 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domT(begr:endr,nt_rtm_dom), & rtmCTL%domR_ntdom1(begr:endr), & rtmCTL%domR(begr:endr,nt_rtm_dom), & - rtmCTL%domRUp_ntdom1(begr:endr), & rtmCTL%domRUp(begr:endr,nt_rtm_dom), & rtmCTL%erin_nt1(begr:endr), & rtmCTL%erin(begr:endr,nt_rtm), & From f7653d99f7292c8245561117cfc7af477dc5f3cd Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Mon, 13 Mar 2023 10:44:38 +0100 Subject: [PATCH 29/37] still too much going out of subn --- src/riverroute/DommasbMod.F90 | 21 ++-- src/riverroute/MOSART_physics_mod.F90 | 162 +++++++++++++++++--------- src/riverroute/RtmHistFlds.F90 | 52 ++++++--- src/riverroute/RtmMod.F90 | 59 ++++++++-- src/riverroute/RtmRestFile.F90 | 14 +-- src/riverroute/RunoffMod.F90 | 67 +++++++---- 6 files changed, 250 insertions(+), 125 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 3642e23..23d2706 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -6,7 +6,7 @@ MODULE DommasbMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_const_mod , only : SHR_CONST_REARTH, SHR_CONST_PI use shr_sys_mod , only : shr_sys_abort - use RunoffMod , only : TRunoff, Tdom + use RunoffMod , only : TRunoff, Tdom, TUnit use RtmVar , only : iulog implicit none @@ -25,27 +25,28 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - ! assume no chemical reaction in the water hence sink term is zero implies domsur = domR*flow - ! ehout is negative - Tdom%domH(iunit,ntdom) = (Tdom%domH(iunit,ntdom)*max(0._r8,TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * theDeltaT) + (TRunoff%ehout(iunit,nt) * Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom)) * theDeltaT)/TRunoff%wh(iunit,nt) + Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%ehout(iunit,nt) * (Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * theDeltaT)/(max(0._r8,TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*theDeltaT)+TRunoff%qsur(iunit,nt)*theDeltaT),-TRunoff%ehout(iunit,nt) * 0.3_r8))) + Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) end subroutine hillslopeRoutingDOM - subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT,temp_ehout) + subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODEs with Euler algorithm for subnetwork routing - ! etin is positive and etout is negative implicit none integer, intent(in) :: iunit, nt, ntdom - real(r8), intent(in) :: theDeltaT,temp_ehout - Tdom%domT(iunit,ntdom) = (Tdom%domT(iunit,ntdom)*max(0._r8,TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * theDeltaT) + (Tdom%domsub(iunit,ntdom) + temp_ehout * Tdom%domH(iunit,ntdom) + TRunoff%etout(iunit,nt) * Tdom%domT(iunit,ntdom)) * theDeltaT)/TRunoff%wt(iunit,nt) + real(r8), intent(in) :: theDeltaT + Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%etout(iunit,nt) * (Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * theDeltaT)/(max(0._r8,TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*theDeltaT)+TRunoff%etin(iunit,nt)*theDeltaT),-TRunoff%etout(iunit,nt) *0.3_r8))) + Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) end subroutine subnetworkRoutingDOM subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) ! solve the ODE with Euler algorithm for main-channel routing - ! erout is negative, while erlateral and erin are positive implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domR(iunit,ntdom) = (Tdom%domR(iunit,ntdom)*max(0._r8,TRunoff%wr(iunit,nt) - TRunoff%dwr(iunit,nt) * theDeltaT) + (TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom) + TRunoff%erout(iunit,nt)*Tdom%domR(iunit,ntdom))*theDeltaT)/TRunoff%wr(iunit,nt) + real(r8) :: temp_gwl + temp_gwl = TRunoff%qgwl(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) + Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%erout(iunit,nt) * (Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom)) * theDeltaT)/(max(0._r8,TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*theDeltaT)+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt)+temp_gwl)*theDeltaT),-TRunoff%erout(iunit,nt)*0.3_r8))) + Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 25aefae..02e140a 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -49,8 +49,9 @@ subroutine Euler implicit none integer :: iunit, m, k, unitUp, cnt, ier !local index - real(r8) :: temp_erout, localDeltaT,temp_ehout + real(r8) :: temp_erout, localDeltaT real(r8) :: negchan + real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom) !------------------ ! hillslope @@ -68,23 +69,39 @@ subroutine Euler !----------------------------------------------------------------------------------------------------------------- if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers - Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units - if (TRunoff%wh(iunit,nt)>0._r8) then - call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) - if (Tdom%domH(iunit,ntdom) > 0.3_r8) then - !write(iulog,*) 'HILL EXCESS',iunit,'domH',Tdom%domH(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'dwh',TRunoff%dwh(iunit,nt) - !The excess should be moved to a variable, this happens because we start from negative water... - Tdom%domH(iunit,ntdom)=min(0.3,Tdom%domH(iunit,ntdom)) - else if (Tdom%domH(iunit,ntdom) < 0._r8) then - !can happen if more water leaves (ehout), than there was water in the hillslope (wh), becase negative water before or incoming water is directy sent out ? - Tdom%domH(iunit,ntdom)=0._r8 - !write(iulog,*) 'SHIT HILL',iunit,'domH',Tdom%domH(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'qsur',TRunoff%qsur(iunit,nt),'dwh',TRunoff%dwh(iunit,nt) + Tdom%domHout(iunit,ntdom)=0._r8 + if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then + write(iulog,*)'Concentration ERROR qsur',Tdom%domsur(iunit,ntdom),TRunoff%qsur(iunit,nt) + endif + if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then + if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT < 0._r8 .and. Tdom%domsur(iunit,ntdom)>0._r8) then + Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)-(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt) + Tdom%domsur(iunit,ntdom)=max(0._r8,Tdom%domsur(iunit,ntdom)+(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)) endif - else if (Tdom%domsur(iunit,ntdom)>1.e-30) then - write(iulog,*) 'HILL EXCESS',iunit,TRunoff%wh(iunit,nt),Tdom%domsur(iunit,ntdom) - Tdom%domH(iunit,ntdom)=0._r8 - !here also the excess should be sent back to ctsm + call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) + else if (Tdom%domsur(iunit,ntdom)>0._r8) then + Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT + endif + !write(iulog,*) 'HILL',iunit,'domH',Tdom%domH(iunit,ntdom),'domHout',Tdom%domHout(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'qsur',TRunoff%qsur(iunit,nt),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'domRest',Tdom%domRest(iunit,ntdom),'dwh',TRunoff%dwh(iunit,nt) + if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8 .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then + Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domH(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 + endif + if (Tdom%domH(iunit,ntdom) < 1.e-50_r8) then + Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domH(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 + !write(iulog,*)'Concentration 1111',iunit,'domH',Tdom%domH(iunit,ntdom),'wh',TRunoff%wh(iunit,nt) + endif + if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8 .or. Tdom%domH(iunit,ntdom)< 0._r8) then + write(iulog,*)'Concentration in hill is too high or too low ',iunit,'domH',Tdom%domH(iunit,ntdom),'wh',TRunoff%wh(iunit,nt) + !call shr_sys_abort('Concentration in hill is too high or too low') + endif + if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then + Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)*Tctl%DeltaT + Tdom%domsub(iunit,ntdom)=max(0._r8,Tdom%domsub(iunit,ntdom)-(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)) endif + Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units enddo endif !-------------------------------------------------------------------------------------------------------------------------- @@ -93,14 +110,14 @@ subroutine Euler endif end do call t_stopf('mosartr_hillslope') - TRunoff%flow = 0._r8 + Tdom%domRoutflow = 0._r8 + Tdom%domToutLat2 = 0._r8 TRunoff%erout_prev = 0._r8 TRunoff%eroutup_avg = 0._r8 TRunoff%erlat_avg = 0._r8 negchan = 9999.0_r8 do m=1,Tctl%DLevelH2R - !--- accumulate/average erout at prior timestep (used in eroutUp calc) for budget analysis do nt=1,nt_rtm if (TUnit%euler_calc(nt)) then @@ -116,39 +133,58 @@ subroutine Euler call t_startf('mosartr_subnetwork') TRunoff%erlateral(:,:) = 0._r8 + Tdom%domToutLat(:,:) = 0._r8 do nt=1,nt_rtm if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then + Rest_T(:) = 0._r8 localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_t(iunit) - temp_ehout = - TRunoff%ehout(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) !needed to multiply with domH in subnetwork do k=1,TUnit%numDT_t(iunit) call subnetworkRouting(iunit,nt,localDeltaT) TRunoff%wt(iunit,nt) = TRunoff%wt(iunit,nt) + TRunoff%dwt(iunit,nt) * localDeltaT call UpdateState_subnetwork(iunit,nt) TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt)-TRunoff%etout(iunit,nt) !---------------------------------------------------------------------------------------------------- - if (nt==1) then ! if liq tracer - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - if (TRunoff%wt(iunit,nt)>0._r8) then - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT,temp_ehout) - if (Tdom%domT(iunit,ntdom) > 0.3) then - !write(iulog,*) 'SUBN EXCESS',iunit,nt,'domT',Tdom%domT(iunit,ntdom),'domH',Tdom%domH(iunit,ntdom),'domsub',Tdom%domsub(iunit,ntdom),'wt',TRunoff%wt(iunit,nt),'etin',TRunoff%etin(iunit,nt),'etout',TRunoff%etout(iunit,nt),'dwt',TRunoff%dwt(iunit,nt),'time',localDeltaT - !The excess should be moved to a variable, this happens because we start from negative water... - Tdom%domT(iunit,ntdom)=min(0.3,Tdom%domT(iunit,ntdom)) - else if (Tdom%domT(iunit,ntdom)< 0._r8) then - Tdom%domT(iunit,ntdom)=0._r8 - !write(iulog,*) 'SHIT SUBN',iunit,nt,'domT',Tdom%domT(iunit,ntdom) - end if - else if ((Tdom%domsub(iunit,ntdom)+TRunoff%etin(iunit,nt)*Tdom%domH(iunit,ntdom))>1.e-30) then !if liq tracer but there is negative water - !write(iulog,*) 'SUBN EXCESS', TRunoff%wt(iunit,nt),Tdom%domsub(iunit,ntdom),TRunoff%etin(iunit,nt) * Tdom%domH(iunit,ntdom),'iunit',iunit - Tdom%domT(iunit,ntdom)=0._r8 - endif - enddo + if (nt==1) then ! if LIQ tracer and there is water + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT+TRunoff%etin(iunit,nt)*localDeltaT>0._r8) then + !if (TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * localDeltaT < -1.e-10*TRunoff%dwt(iunit,nt) .and. Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)>0._r8) then + ! write(iulog,*) 'SUBN SHIT0 need to add conditions',iunit,Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt),TRunoff%dwt(iunit,nt),localDeltaT,(TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * localDeltaT) + !endif + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) + Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) + else if ((Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))>0._r8) then + Rest_T(ntdom)= Rest_T(ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))*localDeltaT + endif + if (TRunoff%wt(iunit,nt)<0._r8) then + write(iulog,*) 'SUBN SHIT1' + endif + !write(iulog,*) 'SUBN',iunit,'domT',Tdom%domT(iunit,ntdom),'areafrac',TUnit%area(iunit) * TUnit%frac(iunit),'etin',TRunoff%etin(iunit,nt),'domTout',Tdom%domTout(iunit,ntdom),'domHout',Tdom%domHout(iunit,ntdom),'domsub',Tdom%domsub(iunit,ntdom),'qsub',TRunoff%qsub(iunit,nt),'wt',TRunoff%wt(iunit,nt),'etout',TRunoff%etout(iunit,nt),'domRest',Tdom%domRest(iunit,ntdom),'dwt',TRunoff%dwt(iunit,nt) + if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8 .and. Tdom%domT(iunit,ntdom) < 1.e-10*(Tdom%domTout(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then + Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) + Tdom%domT(iunit,ntdom)=0._r8 + endif + if (Tdom%domT(iunit,ntdom) < 1.e-50_r8) then + Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) + Tdom%domT(iunit,ntdom)=0._r8 + endif + if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8 .or. Tdom%domT(iunit,ntdom) <0._r8) then + write(iulog,*)' Concentration in subn is too high or too low ',Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt) + !call shr_sys_abort('Concentration in subn is too high or too low') + endif + enddo endif !----------------------------------------------------------------------------------------------------- end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) + if (nt==1) then + do ntdom=1,nt_rtm_dom + Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) / TUnit%numDT_t(iunit) + Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) + Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_T(ntdom) + enddo + endif endif end do ! iunit endif ! euler_calc @@ -188,7 +224,7 @@ subroutine Euler avsrc_eroutUp%rAttr(nt,cnt) = TRunoff%erout(iunit,nt) if (nt==1) then do ntdom = 1,nt_rtm_dom - avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domR(iunit,ntdom)*-1._r8*TRunoff%erout(iunit,nt) !kg/m3 * m3/s we want to sum the mass of dom not the concentration + avsrc_domRUp%rAttr(ntdom,cnt) = Tdom%domRout(iunit,ntdom) end do endif enddo @@ -227,6 +263,8 @@ subroutine Euler if(TUnit%mask(iunit) > 0) then localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_r(iunit) temp_erout = 0._r8 + temp_eroutdom(:) = 0._r8 + Rest_R(:) = 0._r8 do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT @@ -237,30 +275,38 @@ subroutine Euler ! end if call UpdateState_mainchannel(iunit,nt) temp_erout = temp_erout + TRunoff%erout(iunit,nt) ! erout here might be inflow to some downstream subbasin, so treat it differently than erlateral - !----------------------------------------------------------------------------------------------------------- - if (nt==1) then - do ntdom=1,nt_rtm_dom ! loop over DOM tracers - if (TRunoff%wr(iunit,nt)>0._r8) then - call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) - if (Tdom%domR(iunit,ntdom) > 0.3) then - Tdom%domR(iunit,ntdom)=min(0.3,Tdom%domR(iunit,ntdom)) - !DOM should be added to a variable and sent back to ctsm - !write(iulog,*) 'SHIT MAIN','domRUp',Tdom%domRUp(iunit,ntdom),'wr',TRunoff%wr(iunit,nt),'erlateral',TRunoff%erlateral(iunit,nt),'eroutUp',TRunoff%eroutUp(iunit,nt),'dwr',TRunoff%dwr(iunit,nt),'domT',Tdom%domT(iunit,ntdom),'domR',Tdom%domR(iunit,ntdom),'time',localDeltaT - else if (Tdom%domR(iunit,ntdom) < 0._r8) then - !write(iulog,*) 'SHIT MAIN',iunit,'domR',Tdom%domR(iunit,ntdom) - Tdom%domR(iunit,ntdom)=0._r8 - end if - else if ((TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom) + Tdom%domRUp(iunit,ntdom))>1.e-30) then - !write(iulog,*) 'SHIT MAIN EXCESS', TRunoff%wr(iunit,nt),Tdom%domRUp(iunit,ntdom),TRunoff%erlateral(iunit,nt)*Tdom%domT(iunit,ntdom),'iunit',iunit - Tdom%domR(iunit,ntdom)=0._r8 - endif - enddo - endif - !---------------------------------------------------------------------------------------------------------------- + !----------------------------------------------------------------------------------------------------------- + if (nt==1) then ! if LIQ tracer and there is water + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + if (TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*localDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt))*localDeltaT>0._r8) then + call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) + temp_eroutdom(ntdom) = temp_eroutdom(ntdom) + Tdom%domRout(iunit,ntdom) + else if ((Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))>0._r8) then + Rest_R(ntdom)= Rest_R(ntdom)+(Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))*localDeltaT + endif + if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .and. Tdom%domR(iunit,ntdom) < 1.e-10*(Tdom%domRout(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom)+Tdom%domRUp(iunit,ntdom))) then + Rest_R(ntdom)=Rest_R(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domR(iunit,ntdom)=0._r8 + endif + if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .or. Tdom%domR(iunit,ntdom) <0._r8) then + write(iulog,*)' Concentration in main is too high or too low ',Tdom%domR(iunit,ntdom),TRunoff%wr(iunit,nt) + !call shr_sys_abort('Concentration in main is too high or too low') + endif + enddo + endif + !---------------------------------------------------------------------------------------------------------------- end do temp_erout = temp_erout / TUnit%numDT_r(iunit) TRunoff%erout(iunit,nt) = temp_erout TRunoff%flow(iunit,nt) = TRunoff%flow(iunit,nt) - TRunoff%erout(iunit,nt) + if (nt==1) then ! if LIQ tracer and there is water + do ntdom=1,nt_rtm_dom ! loop over DOM tracers + temp_eroutdom(ntdom) = temp_eroutdom(ntdom) / TUnit%numDT_r(iunit) + Tdom%domRout(iunit,ntdom) = temp_eroutdom(ntdom) + Tdom%domRoutFlow(iunit,ntdom) = Tdom%domRoutFlow(iunit,ntdom) + Tdom%domRout(iunit,ntdom) + Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_R(ntdom) + enddo + endif endif end do ! iunit endif ! euler_calc @@ -275,6 +321,8 @@ subroutine Euler write(iulog,*) 'Warning: Negative channel storage found! ',negchan call shr_sys_abort('mosart: negative channel storage') endif + Tdom%domRoutFlow = Tdom%domRoutFlow / Tctl%DLevelH2R + Tdom%domToutLat2 = Tdom%domToutLat2 / Tctl%DLevelH2R TRunoff%flow = TRunoff%flow / Tctl%DLevelH2R TRunoff%erout_prev = TRunoff%erout_prev / Tctl%DLevelH2R TRunoff%eroutup_avg = TRunoff%eroutup_avg / Tctl%DLevelH2R diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index cab33d1..5242e0c 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -48,11 +48,11 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART river discharge into ocean: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%runoffocn_nt1, default='inactive') + ptr_rof=rtmCTL%runoffocn_nt1, default='active') call RtmHistAddfld (fname='RIVER_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART river discharge into ocean: '//trim(rtm_tracers(2)), & - ptr_rof=rtmCTL%runoffocn_nt2, default='active') + ptr_rof=rtmCTL%runoffocn_nt2, default='inactive') call RtmHistAddfld (fname='TOTAL_DISCHARGE_TO_OCEAN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART total discharge into ocean: '//trim(rtm_tracers(1)), & @@ -150,25 +150,41 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART storage: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%dommas_ntdom1, default='active') - call RtmHistAddfld (fname='CONC_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + call RtmHistAddfld (fname='MASS_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domH_ntdom1, default='active') - call RtmHistAddfld (fname='CONC_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + call RtmHistAddfld (fname='MASS_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domT_ntdom1, default='active') - call RtmHistAddfld (fname='CONC_MAINC'//'_'//trim(rtm_tracers_dom(1)), units='kgC/m3', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers_dom(1)), & + call RtmHistAddfld (fname='MASS_MAINC'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domR_ntdom1, default='active') - call RtmHistAddfld (fname='ERIN'//'_'//trim(rtm_tracers(1)), units='m3/s', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%erin_nt1, default='active') + call RtmHistAddfld (fname='MASS_REST'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domRest_ntdom1, default='active') + + call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domHout_ntdom1, default='active') - call RtmHistAddfld (fname='ERLATERAL'//'_'//trim(rtm_tracers(1)), units='m3/s', & - avgflag='A', long_name='MOSART DOM concentration: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%erlateral_nt1, default='active') + call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domTout_ntdom1, default='active') + + call RtmHistAddfld (fname='MASS_HILLS'//'_'//trim(rtm_tracers(1)), units='m', & + avgflag='A', long_name='MOSART WATER: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%wh_nt1, default='active') + + call RtmHistAddfld (fname='MASS_SUBN'//'_'//trim(rtm_tracers(1)), units='m3', & + avgflag='A', long_name='MOSART WATER: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%wt_nt1, default='active') + + call RtmHistAddfld (fname='MASS_MAINC'//'_'//trim(rtm_tracers(1)), units='m3', & + avgflag='A', long_name='MOSART WATER: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%wr_nt1, default='active') ! Print masterlist of history fields @@ -228,8 +244,12 @@ subroutine RtmHistFldsSet() rtmCTL%domH_ntdom1(:) = rtmCTL%domH(:,1) rtmCTL%domT_ntdom1(:) = rtmCTL%domT(:,1) rtmCTL%domR_ntdom1(:) = rtmCTL%domR(:,1) - rtmCTL%erin_nt1(:) = rtmCTL%erin(:,1) - rtmCTL%erlateral_nt1(:) = rtmCTL%erlateral(:,1) + rtmCTL%domRest_ntdom1(:) = rtmCTL%domRest(:,1) + rtmCTL%domHout_ntdom1(:) = rtmCTL%domHout(:,1) + rtmCTL%domTout_ntdom1(:) = rtmCTL%domTout(:,1) + rtmCTL%wr_nt1(:) = rtmCTL%wr(:,1) + rtmCTL%wt_nt1(:) = rtmCTL%wt(:,1) + rtmCTL%wh_nt1(:) = rtmCTL%wh(:,1) end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 0ca92d8..5d9761a 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -84,6 +84,9 @@ module RtmMod !local (gdc) real(r8), save, pointer :: evel(:,:) ! effective tracer velocity (m/s) real(r8), save, pointer :: flow(:,:) ! mosart flow (m3/s) + real(r8), save, pointer :: flowdom(:,:) ! mosart flow (kg/s) + real(r8), save, pointer :: Houtdom(:,:) ! mosart flow (kg/s) + real(r8), save, pointer :: Toutdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: erout_prev(:,:) ! erout previous timestep (m3/s) real(r8), save, pointer :: eroutup_avg(:,:)! eroutup average over coupling period (m3/s) real(r8), save, pointer :: erlat_avg(:,:) ! erlateral average over coupling period (m3/s) @@ -930,6 +933,9 @@ subroutine Rtmini(flood_active) allocate (evel (rtmCTL%begr:rtmCTL%endr,nt_rtm), & flow (rtmCTL%begr:rtmCTL%endr,nt_rtm), & + flowdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & + Houtdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & + Toutdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erout_prev(rtmCTL%begr:rtmCTL%endr,nt_rtm), & eroutup_avg(rtmCTL%begr:rtmCTL%endr,nt_rtm), & erlat_avg(rtmCTL%begr:rtmCTL%endr,nt_rtm), & @@ -939,6 +945,9 @@ subroutine Rtmini(flood_active) call shr_sys_abort(subname//' Allocationt ERROR flow') end if flow(:,:) = 0._r8 + flowdom(:,:) = 0._r8 + Houtdom(:,:) = 0._r8 + Toutdom(:,:) = 0._r8 erout_prev(:,:) = 0._r8 eroutup_avg(:,:) = 0._r8 erlat_avg(:,:) = 0._r8 @@ -1330,7 +1339,7 @@ subroutine Rtmini(flood_active) Tdom%domH = rtmCTL%domH Tdom%domT = rtmCTL%domT Tdom%domR = rtmCTL%domR - Tdom%domRUp = rtmCTL%domRUp + Tdom%domRout = rtmCTL%domRout write(iulog,*) 'UPDATED MARIUS' else ! do nt = 1,nt_rtm @@ -1461,6 +1470,9 @@ subroutine Rtmrun(rstwr,nlend,rdate) budget_terms = 0._r8 flow = 0._r8 + flowdom = 0._r8 + Houtdom = 0._r8 + Toutdom = 0._r8 erout_prev = 0._r8 eroutup_avg = 0._r8 erlat_avg = 0._r8 @@ -1892,6 +1904,13 @@ subroutine Rtmrun(rstwr,nlend,rdate) erout_prev(nr,nt) = erout_prev(nr,nt) + TRunoff%erout_prev(nr,nt) eroutup_avg(nr,nt) = eroutup_avg(nr,nt) + TRunoff%eroutup_avg(nr,nt) erlat_avg(nr,nt) = erlat_avg(nr,nt) + TRunoff%erlat_avg(nr,nt) + if (nt==1) then + do ntdom = 1,nt_rtm_dom + flowdom(nr,ntdom) = flowdom(nr,ntdom) + Tdom%domRoutFlow(nr,ntdom) + Houtdom(nr,ntdom) = Houtdom(nr,ntdom) + Tdom%domHout(nr,ntdom) + Toutdom(nr,ntdom) = Toutdom(nr,ntdom) + Tdom%domToutLat2(nr,ntdom) + enddo + endif enddo enddo @@ -1902,6 +1921,9 @@ subroutine Rtmrun(rstwr,nlend,rdate) !----------------------------------- flow = flow / float(nsub) + flowdom = flowdom / float(nsub) + Houtdom = Houtdom / float(nsub) + Toutdom = Toutdom / float(nsub) erout_prev = erout_prev / float(nsub) eroutup_avg = eroutup_avg / float(nsub) erlat_avg = erlat_avg / float(nsub) @@ -1914,10 +1936,10 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%wt = TRunoff%wt rtmCTL%wr = TRunoff%wr rtmCTL%erout = TRunoff%erout - rtmCTL%domH = Tdom%domH rtmCTL%domT = Tdom%domT rtmCTL%domR = Tdom%domR - rtmCTL%domRUp = Tdom%domRUp + rtmCTL%domRout = Tdom%domRout + rtmCTL%domRest = Tdom%domRest do nt = 1,nt_rtm do nr = rtmCTL%begr,rtmCTL%endr @@ -1926,17 +1948,16 @@ subroutine Rtmrun(rstwr,nlend,rdate) TRunoff%wh(nr,nt)*rtmCTL%area(nr)) if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%dommas(nr,ntdom)=(TRunoff%wh(nr,nt)*rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & - TRunoff%wt(nr,nt)*Tdom%domT(nr,ntdom) + & - TRunoff%wr(nr,nt)*Tdom%domR(nr,ntdom)) + rtmCTL%domH(nr,ntdom) = Tdom%domH(nr,ntdom) * rtmCTL%area(nr) + rtmCTL%dommas(nr,ntdom)=(rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & + Tdom%domT(nr,ntdom) + & + Tdom%domR(nr,ntdom)) enddo - rtmCTL%erin(nr,nt)=TRunoff%erin(nr,nt) - rtmCTL%erlateral(nr,nt)=TRunoff%erlateral(nr,nt) end if rtmCTL%dvolrdt(nr,nt) = (rtmCTL%volr(nr,nt) - volr_init) / delt_coupling rtmCTL%runoff(nr,nt) = flow(nr,nt) - + rtmCTL%runofftot(nr,nt) = rtmCTL%direct(nr,nt) if (rtmCTL%mask(nr) == 1) then rtmCTL%runofflnd(nr,nt) = rtmCTL%runoff(nr,nt) @@ -1944,7 +1965,9 @@ subroutine Rtmrun(rstwr,nlend,rdate) if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%runofflnddom(nr,ntdom)=rtmCTL%runoff(nr,nt) * Tdom%domR(nr,ntdom) + rtmCTL%runofflnddom(nr,ntdom)=flowdom(nr,ntdom) + rtmCTL%domHout(nr,ntdom)=Houtdom(nr,ntdom) + rtmCTL%domTout(nr,ntdom)=Toutdom(nr,ntdom) enddo end if @@ -1955,7 +1978,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) if (nt==1) then do ntdom = 1,nt_rtm_dom - rtmCTL%runoffocndom(nr,ntdom)=rtmCTL%runoff(nr,nt) * Tdom%domR(nr,ntdom) + rtmCTL%runoffocndom(nr,ntdom)=flowdom(nr,ntdom) enddo end if @@ -2593,12 +2616,26 @@ subroutine MOSART_init !Initialize dom flux variables allocate (Tdom%domH(begr:endr,nt_rtm_dom)) Tdom%domH = 0._r8 + allocate (Tdom%domHout(begr:endr,nt_rtm_dom)) + Tdom%domHout = 0._r8 allocate (Tdom%domT(begr:endr,nt_rtm_dom)) Tdom%domT = 0._r8 + allocate (Tdom%domTout(begr:endr,nt_rtm_dom)) + Tdom%domTout = 0._r8 + allocate (Tdom%domToutLat(begr:endr,nt_rtm_dom)) + Tdom%domToutLat = 0._r8 + allocate (Tdom%domToutLat2(begr:endr,nt_rtm_dom)) + Tdom%domToutLat2 = 0._r8 allocate (Tdom%domR(begr:endr,nt_rtm_dom)) Tdom%domR = 0._r8 + allocate (Tdom%domRout(begr:endr,nt_rtm_dom)) + Tdom%domRout = 0._r8 + allocate (Tdom%domRoutFlow(begr:endr,nt_rtm_dom)) + Tdom%domRoutFlow = 0._r8 allocate (Tdom%domRUp(begr:endr,nt_rtm_dom)) Tdom%domRUp = 0._r8 + allocate (Tdom%domRest(begr:endr,nt_rtm_dom)) + Tdom%domRest = 0._r8 allocate (Tdom%domsur(begr:endr,nt_rtm_dom)) Tdom%domsur = 0._r8 allocate (Tdom%domsub(begr:endr,nt_rtm_dom)) diff --git a/src/riverroute/RtmRestFile.F90 b/src/riverroute/RtmRestFile.F90 index 37d0bcb..a0c8e58 100644 --- a/src/riverroute/RtmRestFile.F90 +++ b/src/riverroute/RtmRestFile.F90 @@ -448,23 +448,23 @@ subroutine RtmRestart(ncid, flag) if (nv == 8) then vname = 'RTM_DOMH_'//trim(rtm_tracers(ntdom)) lname = 'DOM storage at hillslope in cell' - uname = 'kg/m3' + uname = 'kg' dfld => rtmCTL%domH(:,ntdom) elseif (nv == 9) then vname = 'RTM_DOMT_'//trim(rtm_tracers(ntdom)) lname = 'DOM storage in tributary channels in cell' - uname = 'kg/m3' + uname = 'kg' dfld => rtmCTL%domT(:,ntdom) elseif (nv == 10) then vname = 'RTM_DOMR_'//trim(rtm_tracers(ntdom)) lname = 'DOM storage in main channel in cell' - uname = 'kg/m3' + uname = 'kg' dfld => rtmCTL%domR(:,ntdom) elseif (nv == 11) then - vname = 'RTM_DOMRUP_'//trim(rtm_tracers(ntdom)) + vname = 'RTM_DOMROUT_'//trim(rtm_tracers(ntdom)) lname = 'DOM storage in upstream main channels' - uname = 'kg/m3' - dfld => rtmCTL%domRUp(:,ntdom) + uname = 'kg/s' + dfld => rtmCTL%domRout(:,ntdom) else write(iulog,*) 'Rtm ERROR: illegal nv value a ',nv call shr_sys_abort() @@ -505,7 +505,7 @@ subroutine RtmRestart(ncid, flag) if (abs(rtmCTL%domH(n,ntdom)) > 1.e30) rtmCTL%domH(n,ntdom) = 0. if (abs(rtmCTL%domT(n,ntdom)) > 1.e30) rtmCTL%domT(n,ntdom) = 0. if (abs(rtmCTL%domR(n,ntdom)) > 1.e30) rtmCTL%domR(n,ntdom) = 0. - if (abs(rtmCTL%domRUp(n,ntdom)) > 1.e30) rtmCTL%domRUp(n,ntdom) = 0. + if (abs(rtmCTL%domRout(n,ntdom)) > 1.e30) rtmCTL%domRout(n,ntdom) = 0. end do endif end do diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 6c8acba..2de3a50 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -66,13 +66,15 @@ module RunoffMod real(r8), pointer :: dvolrdtlnd(:,:) ! dvolrdt masked for land (mm/s) real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RTM storage (m3) - real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC/m2) - real(r8), pointer :: domH(:,:) ! RTM DOM storage (kgC/m3) - real(r8), pointer :: domT(:,:) ! RTM DOM storage (kgC/m3) - real(r8), pointer :: domR(:,:) ! RTM DOM storage (kgC/m3) - real(r8), pointer :: domRUp(:,:) ! RTM DOM storage (kgC/m3) - real(r8), pointer :: erin(:,:) ! MOSART flow in main channel from upstream gridcells (m3/s) - real(r8), pointer :: erlateral(:,:) ! MOSART flow in main channel from tributaries (m3/s) + real(r8), pointer :: dommas(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domH(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domT(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domR(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domTout(:,:) ! RTM DOM storage (kgC/s) + real(r8), pointer :: domHout(:,:) ! RTM DOM storage (kgC/s) + real(r8), pointer :: domRoutFlow(:,:) ! RTM DOM storage (kgC/s) + real(r8), pointer :: domRout(:,:) ! RTM DOM storage (kgC/s) + real(r8), pointer :: domRest(:,:) ! RTM DOM storage (kgC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) @@ -117,6 +119,7 @@ module RunoffMod real(r8), pointer :: qsub_nt2(:) real(r8), pointer :: qgwl_nt1(:) real(r8), pointer :: qgwl_nt2(:) + real(r8), pointer :: domRest_ntdom1(:) real(r8), pointer :: domsur_ntdom1(:) real(r8), pointer :: domsub_ntdom1(:) real(r8), pointer :: dommas_ntdom1(:) @@ -124,9 +127,12 @@ module RunoffMod real(r8), pointer :: runofflnddom_ntdom1(:) real(r8), pointer :: domH_ntdom1(:) real(r8), pointer :: domT_ntdom1(:) + real(r8), pointer :: domHout_ntdom1(:) + real(r8), pointer :: domTout_ntdom1(:) real(r8), pointer :: domR_ntdom1(:) - real(r8), pointer :: erin_nt1(:) - real(r8), pointer :: erlateral_nt1(:) + real(r8), pointer :: wh_nt1(:) + real(r8), pointer :: wt_nt1(:) + real(r8), pointer :: wr_nt1(:) end type runoff_flow @@ -302,12 +308,19 @@ module RunoffMod real(r8), pointer :: domsur(:,:) ! surface DOM flow from land (kgC/s) real(r8), pointer :: domsub(:,:) ! subsurface DOM flow from land (kgC/s) !hillslope - real(r8), pointer :: domH(:,:) ! dissolved organic matter generated from hillslope (kgC/m3) + real(r8), pointer :: domH(:,:) ! dissolved organic matter in hillslope (kgC) + real(r8), pointer :: domHout(:,:) ! dissolved organic matter generated from hillslope (kgC/s) !sub-network - real(r8), pointer :: domT(:,:) ! dom discharge from sub-network into main reach (kgC/m3) + real(r8), pointer :: domT(:,:) ! dom mass in sub-network (kgC) + real(r8), pointer :: domTout(:,:) ! dom discharge from sub-network into main reach (kgC/s) + real(r8), pointer :: domToutLat(:,:) + real(r8), pointer :: domToutLat2(:,:) !main channel upstream interactions - real(r8), pointer :: domR(:,:) ! dom discharge from outlfow into downstream links (kgC/m3) + real(r8), pointer :: domR(:,:) ! dom mass in main channel (kgC) + real(r8), pointer :: domRout(:,:) ! dom discharge from main channel into downstream gridcells (kgC/s) + real(r8), pointer :: domRoutFlow(:,:) real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (kgC/m3) + real(r8), pointer :: domRest(:,:) ! excess DOM in mosart (kgC) end type Domflux !== Hongyi @@ -372,6 +385,9 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%wh(begr:endr,nt_rtm), & rtmCTL%wt(begr:endr,nt_rtm), & rtmCTL%wr(begr:endr,nt_rtm), & + rtmCTL%wh_nt1(begr:endr), & + rtmCTL%wt_nt1(begr:endr), & + rtmCTL%wr_nt1(begr:endr), & rtmCTL%erout(begr:endr,nt_rtm), & rtmCTL%qsur(begr:endr,nt_rtm), & rtmCTL%qsub(begr:endr,nt_rtm), & @@ -388,17 +404,19 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domsur_ntdom1(begr:endr), & rtmCTL%domsub_ntdom1(begr:endr), & rtmCTL%dommas_ntdom1(begr:endr), & + rtmCTL%domRest_ntdom1(begr:endr), & + rtmCTL%domRest(begr:endr,nt_rtm_dom), & rtmCTL%domH_ntdom1(begr:endr), & rtmCTL%domH(begr:endr,nt_rtm_dom), & rtmCTL%domT_ntdom1(begr:endr), & rtmCTL%domT(begr:endr,nt_rtm_dom), & + rtmCTL%domHout_ntdom1(begr:endr), & + rtmCTL%domHout(begr:endr,nt_rtm_dom), & + rtmCTL%domTout_ntdom1(begr:endr), & + rtmCTL%domTout(begr:endr,nt_rtm_dom), & rtmCTL%domR_ntdom1(begr:endr), & rtmCTL%domR(begr:endr,nt_rtm_dom), & - rtmCTL%domRUp(begr:endr,nt_rtm_dom), & - rtmCTL%erin_nt1(begr:endr), & - rtmCTL%erin(begr:endr,nt_rtm), & - rtmCTL%erlateral_nt1(begr:endr), & - rtmCTL%erlateral(begr:endr,nt_rtm), & + rtmCTL%domRout(begr:endr,nt_rtm), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -427,13 +445,14 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%runoffocndom(:,:)=spval rtmCTL%domsur(:,:) =0._r8 rtmCTL%domsub(:,:) =0._r8 - rtmCTL%dommas(:,:) =0._r8 - rtmCTL%domH(:,:) =0._r8 - rtmCTL%domT(:,:) =0._r8 - rtmCTL%domR(:,:) =0._r8 - rtmCTL%domRUp(:,:) =0._r8 - rtmCTL%erin(:,:) =0._r8 - rtmCTL%erlateral(:,:) =0._r8 + !rtmCTL%dommas(:,:) =0._r8 + !rtmCTL%domH(:,:) =0._r8 + !rtmCTL%domT(:,:) =0._r8 + !rtmCTL%domR(:,:) =0._r8 + rtmCTL%domTout(:,:) =0._r8 + rtmCTL%domHout(:,:) =0._r8 + rtmCTL%domRoutFlow(:,:) =0._r8 + rtmCTL%domRest(:,:) =0._r8 end subroutine RunoffInit From d1fc84454c303a7f2c99f8d0b630bb63069982a2 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Sat, 18 Mar 2023 08:56:48 +0100 Subject: [PATCH 30/37] various changes but one error --- src/riverroute/MOSART_physics_mod.F90 | 16 +++++++++------- src/riverroute/RtmHistFlds.F90 | 10 ++++++++++ src/riverroute/RtmMod.F90 | 17 ++++++++++++++--- src/riverroute/RunoffMod.F90 | 14 +++++++++++++- 4 files changed, 46 insertions(+), 11 deletions(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 02e140a..434c5ec 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -100,8 +100,8 @@ subroutine Euler Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)*Tctl%DeltaT Tdom%domsub(iunit,ntdom)=max(0._r8,Tdom%domsub(iunit,ntdom)-(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)) endif - Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units - Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domsub(iunit,ntdom) = 0._r8 !Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domHout(iunit,ntdom) = TRunoff%etin(iunit,nt)*0.1_r8 !Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units enddo endif !-------------------------------------------------------------------------------------------------------------------------- @@ -113,6 +113,7 @@ subroutine Euler TRunoff%flow = 0._r8 Tdom%domRoutflow = 0._r8 Tdom%domToutLat2 = 0._r8 + TRunoff%erlateral2 = 0._r8 TRunoff%erout_prev = 0._r8 TRunoff%eroutup_avg = 0._r8 TRunoff%erlat_avg = 0._r8 @@ -175,15 +176,15 @@ subroutine Euler endif enddo endif - !----------------------------------------------------------------------------------------------------- end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) + TRunoff%erlateral2(iunit,nt) = TRunoff%erlateral2(iunit,nt) + TRunoff%erlateral(iunit,nt) if (nt==1) then - do ntdom=1,nt_rtm_dom + do ntdom=1,nt_rtm_dom Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) / TUnit%numDT_t(iunit) - Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) + Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_T(ntdom) - enddo + end do endif endif end do ! iunit @@ -199,7 +200,7 @@ subroutine Euler call t_startf('mosartr_SMeroutUp_barrier') call mpi_barrier(mpicom_rof,ier) call t_stopf('mosartr_SMeroutUp_barrier') - endif + endif call t_startf('mosartr_SMeroutUp') TRunoff%eroutUp = 0._r8 @@ -323,6 +324,7 @@ subroutine Euler endif Tdom%domRoutFlow = Tdom%domRoutFlow / Tctl%DLevelH2R Tdom%domToutLat2 = Tdom%domToutLat2 / Tctl%DLevelH2R + TRunoff%erlateral2= TRunoff%erlateral2/ Tctl%DLevelH2R TRunoff%flow = TRunoff%flow / Tctl%DLevelH2R TRunoff%erout_prev = TRunoff%erout_prev / Tctl%DLevelH2R TRunoff%eroutup_avg = TRunoff%eroutup_avg / Tctl%DLevelH2R diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 5242e0c..8187c7e 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -169,6 +169,14 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domHout_ntdom1, default='active') + + call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers(1)), units='m3/s', & + avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%erlateral2_nt1, default='active') + + call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers(1)), units='m3/s', & + avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%etin_nt1, default='active') call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & @@ -250,6 +258,8 @@ subroutine RtmHistFldsSet() rtmCTL%wr_nt1(:) = rtmCTL%wr(:,1) rtmCTL%wt_nt1(:) = rtmCTL%wt(:,1) rtmCTL%wh_nt1(:) = rtmCTL%wh(:,1) + rtmCTL%etin_nt1(:) = rtmCTL%etin(:,1) + rtmCTL%erlateral2_nt1(:) = rtmCTL%erlateral2(:,1) end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 5d9761a..e2a0d51 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -84,6 +84,8 @@ module RtmMod !local (gdc) real(r8), save, pointer :: evel(:,:) ! effective tracer velocity (m/s) real(r8), save, pointer :: flow(:,:) ! mosart flow (m3/s) + real(r8), save, pointer :: erlateral2(:,:) ! mosart flow (m3/s) + real(r8), save, pointer :: etin(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: flowdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: Houtdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: Toutdom(:,:) ! mosart flow (kg/s) @@ -934,6 +936,8 @@ subroutine Rtmini(flood_active) allocate (evel (rtmCTL%begr:rtmCTL%endr,nt_rtm), & flow (rtmCTL%begr:rtmCTL%endr,nt_rtm), & flowdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & + erlateral2 (rtmCTL%begr:rtmCTL%endr,nt_rtm), & + etin (rtmCTL%begr:rtmCTL%endr,nt_rtm), & Houtdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & Toutdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erout_prev(rtmCTL%begr:rtmCTL%endr,nt_rtm), & @@ -945,6 +949,8 @@ subroutine Rtmini(flood_active) call shr_sys_abort(subname//' Allocationt ERROR flow') end if flow(:,:) = 0._r8 + erlateral2(:,:) = 0._r8 + etin(:,:) = 0._r8 flowdom(:,:) = 0._r8 Houtdom(:,:) = 0._r8 Toutdom(:,:) = 0._r8 @@ -1470,6 +1476,8 @@ subroutine Rtmrun(rstwr,nlend,rdate) budget_terms = 0._r8 flow = 0._r8 + erlateral2 = 0._r8 + etin = 0._r8 flowdom = 0._r8 Houtdom = 0._r8 Toutdom = 0._r8 @@ -1901,6 +1909,8 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nt = 1,nt_rtm do nr = rtmCTL%begr,rtmCTL%endr flow(nr,nt) = flow(nr,nt) + TRunoff%flow(nr,nt) + etin(nr,nt) = etin(nr,nt) + TRunoff%etin(nr,nt) + erlateral2(nr,nt)= erlateral2(nr,nt) + TRunoff%erlateral2(nr,nt) erout_prev(nr,nt) = erout_prev(nr,nt) + TRunoff%erout_prev(nr,nt) eroutup_avg(nr,nt) = eroutup_avg(nr,nt) + TRunoff%eroutup_avg(nr,nt) erlat_avg(nr,nt) = erlat_avg(nr,nt) + TRunoff%erlat_avg(nr,nt) @@ -1919,7 +1929,8 @@ subroutine Rtmrun(rstwr,nlend,rdate) !----------------------------------- ! average flow over subcycling !----------------------------------- - + erlateral2 = erlateral2 / float(nsub) + etin = etin / float(nsub) flow = flow / float(nsub) flowdom = flowdom / float(nsub) Houtdom = Houtdom / float(nsub) @@ -1954,7 +1965,6 @@ subroutine Rtmrun(rstwr,nlend,rdate) Tdom%domR(nr,ntdom)) enddo end if - rtmCTL%dvolrdt(nr,nt) = (rtmCTL%volr(nr,nt) - volr_init) / delt_coupling rtmCTL%runoff(nr,nt) = flow(nr,nt) @@ -1962,7 +1972,8 @@ subroutine Rtmrun(rstwr,nlend,rdate) if (rtmCTL%mask(nr) == 1) then rtmCTL%runofflnd(nr,nt) = rtmCTL%runoff(nr,nt) rtmCTL%dvolrdtlnd(nr,nt)= rtmCTL%dvolrdt(nr,nt) - + rtmCTL%erlateral2(nr,nt)=erlateral2(nr,nt) + rtmCTL%etin(nr,nt)=etin(nr,nt) if (nt==1) then do ntdom = 1,nt_rtm_dom rtmCTL%runofflnddom(nr,ntdom)=flowdom(nr,ntdom) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index 2de3a50..f7ff57d 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -76,6 +76,9 @@ module RunoffMod real(r8), pointer :: domRout(:,:) ! RTM DOM storage (kgC/s) real(r8), pointer :: domRest(:,:) ! RTM DOM storage (kgC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold + real(r8), pointer :: etin(:,:) + real(r8), pointer :: erlateral2(:,:) + ! - restarts real(r8), pointer :: wh(:,:) ! MOSART hillslope surface water storage (m) real(r8), pointer :: wt(:,:) ! MOSART sub-network water storage (m3) @@ -133,6 +136,8 @@ module RunoffMod real(r8), pointer :: wh_nt1(:) real(r8), pointer :: wt_nt1(:) real(r8), pointer :: wr_nt1(:) + real(r8), pointer :: etin_nt1(:) + real(r8), pointer :: erlateral2_nt1(:) end type runoff_flow @@ -272,6 +277,7 @@ module RunoffMod !! exchange fluxes real(r8), pointer :: erlg(:,:) ! evaporation, [m/s] real(r8), pointer :: erlateral(:,:) ! lateral flow from hillslope, including surface and subsurface runoff generation components, [m3/s] + real(r8), pointer :: erlateral2(:,:) ! lateral flow from hillslope, including surface and subsurface runoff generation components, [m3/s] real(r8), pointer :: erin(:,:) ! inflow from upstream links, [m3/s] real(r8), pointer :: erout(:,:) ! outflow into downstream links, [m3/s] real(r8), pointer :: erout_prev(:,:) ! outflow into downstream links from previous timestep, [m3/s] @@ -416,7 +422,11 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domTout(begr:endr,nt_rtm_dom), & rtmCTL%domR_ntdom1(begr:endr), & rtmCTL%domR(begr:endr,nt_rtm_dom), & - rtmCTL%domRout(begr:endr,nt_rtm), & + rtmCTL%domRout(begr:endr,nt_rtm_dom), & + rtmCTL%erlateral2(begr:endr,nt_rtm), & + rtmCTL%erlateral2_nt1(begr:endr), & + rtmCTL%etin(begr:endr,nt_rtm), & + rtmCTL%etin_nt1(begr:endr), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -450,6 +460,8 @@ subroutine RunoffInit(begr, endr, numr) !rtmCTL%domT(:,:) =0._r8 !rtmCTL%domR(:,:) =0._r8 rtmCTL%domTout(:,:) =0._r8 + rtmCTL%erlateral2(:,:) =0._r8 + rtmCTL%etin(:,:) =0._r8 rtmCTL%domHout(:,:) =0._r8 rtmCTL%domRoutFlow(:,:) =0._r8 rtmCTL%domRest(:,:) =0._r8 From c38038cc4dc2fa81109642adff4d7bc4135bce36 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Mon, 20 Mar 2023 12:40:30 +0100 Subject: [PATCH 31/37] changes --- src/riverroute/MOSART_physics_mod.F90 | 15 +++++++-------- src/riverroute/RtmMod.F90 | 9 ++++++--- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 434c5ec..9120444 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -61,7 +61,7 @@ subroutine Euler do nt=1,nt_rtm if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr - if(TUnit%mask(iunit) > 0) then + if (TUnit%mask(iunit) > 0) then call hillslopeRouting(iunit,nt,Tctl%DeltaT) TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) @@ -136,7 +136,7 @@ subroutine Euler TRunoff%erlateral(:,:) = 0._r8 Tdom%domToutLat(:,:) = 0._r8 do nt=1,nt_rtm - if (TUnit%euler_calc(nt)) then + if (TUnit%mask(iunit) > 0) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then Rest_T(:) = 0._r8 @@ -179,13 +179,12 @@ subroutine Euler end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) TRunoff%erlateral2(iunit,nt) = TRunoff%erlateral2(iunit,nt) + TRunoff%erlateral(iunit,nt) - if (nt==1) then - do ntdom=1,nt_rtm_dom + if (nt==1) then ! if LIQ tracer and there is water + do ntdom=1,nt_rtm_dom Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) / TUnit%numDT_t(iunit) Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_T(ntdom) - end do - endif + end do + end if endif end do ! iunit endif ! euler_calc @@ -322,9 +321,9 @@ subroutine Euler write(iulog,*) 'Warning: Negative channel storage found! ',negchan call shr_sys_abort('mosart: negative channel storage') endif + TRunoff%erlateral2= TRunoff%erlateral2/ Tctl%DLevelH2R Tdom%domRoutFlow = Tdom%domRoutFlow / Tctl%DLevelH2R Tdom%domToutLat2 = Tdom%domToutLat2 / Tctl%DLevelH2R - TRunoff%erlateral2= TRunoff%erlateral2/ Tctl%DLevelH2R TRunoff%flow = TRunoff%flow / Tctl%DLevelH2R TRunoff%erout_prev = TRunoff%erout_prev / Tctl%DLevelH2R TRunoff%eroutup_avg = TRunoff%eroutup_avg / Tctl%DLevelH2R diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index e2a0d51..4adf496 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -84,7 +84,7 @@ module RtmMod !local (gdc) real(r8), save, pointer :: evel(:,:) ! effective tracer velocity (m/s) real(r8), save, pointer :: flow(:,:) ! mosart flow (m3/s) - real(r8), save, pointer :: erlateral2(:,:) ! mosart flow (m3/s) + real(r8), save, pointer :: erlateral2(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: etin(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: flowdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: Houtdom(:,:) ! mosart flow (kg/s) @@ -937,7 +937,7 @@ subroutine Rtmini(flood_active) flow (rtmCTL%begr:rtmCTL%endr,nt_rtm), & flowdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erlateral2 (rtmCTL%begr:rtmCTL%endr,nt_rtm), & - etin (rtmCTL%begr:rtmCTL%endr,nt_rtm), & + etin (rtmCTL%begr:rtmCTL%endr,nt_rtm), & Houtdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & Toutdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erout_prev(rtmCTL%begr:rtmCTL%endr,nt_rtm), & @@ -1910,7 +1910,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr flow(nr,nt) = flow(nr,nt) + TRunoff%flow(nr,nt) etin(nr,nt) = etin(nr,nt) + TRunoff%etin(nr,nt) - erlateral2(nr,nt)= erlateral2(nr,nt) + TRunoff%erlateral2(nr,nt) + erlateral2(nr,nt) = erlateral2(nr,nt) + TRunoff%erlateral2(nr,nt) erout_prev(nr,nt) = erout_prev(nr,nt) + TRunoff%erout_prev(nr,nt) eroutup_avg(nr,nt) = eroutup_avg(nr,nt) + TRunoff%eroutup_avg(nr,nt) erlat_avg(nr,nt) = erlat_avg(nr,nt) + TRunoff%erlat_avg(nr,nt) @@ -2597,6 +2597,9 @@ subroutine MOSART_init allocate (TRunoff%erlateral(begr:endr,nt_rtm)) TRunoff%erlateral = 0._r8 + allocate (TRunoff%erlateral2(begr:endr,nt_rtm)) + TRunoff%erlateral2 = 0._r8 + allocate (TRunoff%erin(begr:endr,nt_rtm)) TRunoff%erin = 0._r8 From 475c98ec1ba690d6d676b16f44c0bd4568725192 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Wed, 29 Mar 2023 11:21:49 +0200 Subject: [PATCH 32/37] changes made it worse --- src/riverroute/MOSART_physics_mod.F90 | 36 +++++++++++++-------------- src/riverroute/RtmMod.F90 | 1 + 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 9120444..ea58f56 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -51,7 +51,7 @@ subroutine Euler integer :: iunit, m, k, unitUp, cnt, ier !local index real(r8) :: temp_erout, localDeltaT real(r8) :: negchan - real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom) + real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom),Rest_H(nt_rtm_dom) !------------------ ! hillslope @@ -62,6 +62,7 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if (TUnit%mask(iunit) > 0) then + Rest_H(:) = 0._r8 call hillslopeRouting(iunit,nt,Tctl%DeltaT) TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) @@ -75,33 +76,33 @@ subroutine Euler endif if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT < 0._r8 .and. Tdom%domsur(iunit,ntdom)>0._r8) then - Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)-(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt) - Tdom%domsur(iunit,ntdom)=max(0._r8,Tdom%domsur(iunit,ntdom)+(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)) + Rest_H(ntdom)= Rest_H(ntdom)-(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt) + Tdom%domsur(iunit,ntdom)=max(0._r8,Tdom%domsur(iunit,ntdom)+((TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt))/Tctl%DeltaT) endif call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) else if (Tdom%domsur(iunit,ntdom)>0._r8) then - Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT + Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT endif - !write(iulog,*) 'HILL',iunit,'domH',Tdom%domH(iunit,ntdom),'domHout',Tdom%domHout(iunit,ntdom),'domsur',Tdom%domsur(iunit,ntdom),'qsur',TRunoff%qsur(iunit,nt),'wh',TRunoff%wh(iunit,nt),'ehout',TRunoff%ehout(iunit,nt),'domRest',Tdom%domRest(iunit,ntdom),'dwh',TRunoff%dwh(iunit,nt) - if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8 .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then - Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domH(iunit,ntdom) + ! here some checks to make sure the DOM is not at too hugh or low concentrations + if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8) ! .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then + Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 endif if (Tdom%domH(iunit,ntdom) < 1.e-50_r8) then - Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+Tdom%domH(iunit,ntdom) + Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 - !write(iulog,*)'Concentration 1111',iunit,'domH',Tdom%domH(iunit,ntdom),'wh',TRunoff%wh(iunit,nt) endif if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8 .or. Tdom%domH(iunit,ntdom)< 0._r8) then write(iulog,*)'Concentration in hill is too high or too low ',iunit,'domH',Tdom%domH(iunit,ntdom),'wh',TRunoff%wh(iunit,nt) !call shr_sys_abort('Concentration in hill is too high or too low') endif if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then - Tdom%domRest(iunit,ntdom)=Tdom%domRest(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)*Tctl%DeltaT + Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)*Tctl%DeltaT Tdom%domsub(iunit,ntdom)=max(0._r8,Tdom%domsub(iunit,ntdom)-(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)) endif - Tdom%domsub(iunit,ntdom) = 0._r8 !Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units - Tdom%domHout(iunit,ntdom) = TRunoff%etin(iunit,nt)*0.1_r8 !Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_H(ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units enddo endif !-------------------------------------------------------------------------------------------------------------------------- @@ -136,7 +137,7 @@ subroutine Euler TRunoff%erlateral(:,:) = 0._r8 Tdom%domToutLat(:,:) = 0._r8 do nt=1,nt_rtm - if (TUnit%mask(iunit) > 0) then + if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then Rest_T(:) = 0._r8 @@ -150,18 +151,14 @@ subroutine Euler if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT+TRunoff%etin(iunit,nt)*localDeltaT>0._r8) then - !if (TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * localDeltaT < -1.e-10*TRunoff%dwt(iunit,nt) .and. Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)>0._r8) then - ! write(iulog,*) 'SUBN SHIT0 need to add conditions',iunit,Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt),TRunoff%dwt(iunit,nt),localDeltaT,(TRunoff%wt(iunit,nt) - TRunoff%dwt(iunit,nt) * localDeltaT) - !endif call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) else if ((Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))>0._r8) then Rest_T(ntdom)= Rest_T(ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))*localDeltaT endif if (TRunoff%wt(iunit,nt)<0._r8) then - write(iulog,*) 'SUBN SHIT1' + write(iulog,*) 'Concentration error wt<0' endif - !write(iulog,*) 'SUBN',iunit,'domT',Tdom%domT(iunit,ntdom),'areafrac',TUnit%area(iunit) * TUnit%frac(iunit),'etin',TRunoff%etin(iunit,nt),'domTout',Tdom%domTout(iunit,ntdom),'domHout',Tdom%domHout(iunit,ntdom),'domsub',Tdom%domsub(iunit,ntdom),'qsub',TRunoff%qsub(iunit,nt),'wt',TRunoff%wt(iunit,nt),'etout',TRunoff%etout(iunit,nt),'domRest',Tdom%domRest(iunit,ntdom),'dwt',TRunoff%dwt(iunit,nt) if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8 .and. Tdom%domT(iunit,ntdom) < 1.e-10*(Tdom%domTout(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) Tdom%domT(iunit,ntdom)=0._r8 @@ -183,6 +180,7 @@ subroutine Euler do ntdom=1,nt_rtm_dom Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) / TUnit%numDT_t(iunit) Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) + Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_T(ntdom) end do end if endif @@ -555,7 +553,7 @@ end subroutine updateState_mainchannel !----------------------------------------------------------------------- function CRVRMAN(slp_, n_, rr_) result(v_) - ! Function for calculating channel velocity according to Manning's equation.vt + ! Function for calculating channel velocity according to Manning's equation. implicit none real(r8), intent(in) :: slp_, n_, rr_ ! slope, manning's roughness coeff., hydraulic radius real(r8) :: v_ ! v_ is discharge diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 4adf496..24b532d 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1949,6 +1949,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%erout = TRunoff%erout rtmCTL%domT = Tdom%domT rtmCTL%domR = Tdom%domR + rtmCTL%domH = Tdom%domH rtmCTL%domRout = Tdom%domRout rtmCTL%domRest = Tdom%domRest From bdf66e29e12afb9c2394e0775f86ce454ec44981 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Wed, 19 Apr 2023 11:40:34 +0200 Subject: [PATCH 33/37] corrections and description --- src/riverroute/DommasbMod.F90 | 25 ++++++++++-- src/riverroute/MOSART_physics_mod.F90 | 58 +++++++++++++-------------- src/riverroute/RtmMod.F90 | 1 - 3 files changed, 51 insertions(+), 33 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 23d2706..b3c2f75 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -25,7 +25,15 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%ehout(iunit,nt) * (Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * theDeltaT)/(max(0._r8,TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*theDeltaT)+TRunoff%qsur(iunit,nt)*theDeltaT),-TRunoff%ehout(iunit,nt) * 0.3_r8))) + !domsur (kg/m2*s) ,domH (kg/m2), ehout (m/s), domHout (kg/m2*s), qsur (m/s), wh (m) + Tdom%domHout(iunit,ntdom) = -TRunoff%ehout(iunit,nt) * (Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * theDeltaT)/(TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*theDeltaT+TRunoff%qsur(iunit,nt)*theDeltaT) + !we dont want a too high out + Tdom%domHout(iunit,ntdom) = min(-TRunoff%ehout(iunit,nt) * 0.3_r8, Tdom%domHout(iunit,ntdom)) + !cannot be more be less than 0, lower boundary + Tdom%domHout(iunit,ntdom) = max(0._r8,Tdom%domHout(iunit,ntdom)) + !cannot be more than available carbon, upper boundary + Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,Tdom%domHout(iunit,ntdom)) + Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) end subroutine hillslopeRoutingDOM @@ -34,7 +42,12 @@ subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT - Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%etout(iunit,nt) * (Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * theDeltaT)/(max(0._r8,TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*theDeltaT)+TRunoff%etin(iunit,nt)*theDeltaT),-TRunoff%etout(iunit,nt) *0.3_r8))) + Tdom%domTout(iunit,ntdom) = -TRunoff%etout(iunit,nt) * (Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * theDeltaT)/(TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*theDeltaT+TRunoff%etin(iunit,nt)*theDeltaT) + Tdom%domTout(iunit,ntdom) = min(-TRunoff%etout(iunit,nt) *0.3_r8,Tdom%domTout(iunit,ntdom)) + Tdom%domTout(iunit,ntdom) = max(0._r8,Tdom%domTout(iunit,ntdom)) + Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) + + Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) end subroutine subnetworkRoutingDOM @@ -45,7 +58,13 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) real(r8), intent(in) :: theDeltaT real(r8) :: temp_gwl temp_gwl = TRunoff%qgwl(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) - Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,max(0._r8,min(-TRunoff%erout(iunit,nt) * (Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom)) * theDeltaT)/(max(0._r8,TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*theDeltaT)+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt)+temp_gwl)*theDeltaT),-TRunoff%erout(iunit,nt)*0.3_r8))) + + Tdom%domRout(iunit,ntdom) = -TRunoff%erout(iunit,nt) * (Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom)) * theDeltaT)/(TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*theDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt)+temp_gwl)*theDeltaT) + Tdom%domRout(iunit,ntdom) = min(-TRunoff%erout(iunit,nt) *0.3_r8,Tdom%domRout(iunit,ntdom)) + Tdom%domRout(iunit,ntdom) = max(0._r8,Tdom%domRout(iunit,ntdom)) + Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domRout(iunit,ntdom)) + + Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index ea58f56..22bb642 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -71,34 +71,29 @@ subroutine Euler if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers Tdom%domHout(iunit,ntdom)=0._r8 - if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then - write(iulog,*)'Concentration ERROR qsur',Tdom%domsur(iunit,ntdom),TRunoff%qsur(iunit,nt) - endif + !if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then + ! write(iulog,*)'Concentration ERROR qsur',Tdom%domsur(iunit,ntdom),TRunoff%qsur(iunit,nt) + !endif if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then - if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT < 0._r8 .and. Tdom%domsur(iunit,ntdom)>0._r8) then - Rest_H(ntdom)= Rest_H(ntdom)-(TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt) - Tdom%domsur(iunit,ntdom)=max(0._r8,Tdom%domsur(iunit,ntdom)+((TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT)*Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt))/Tctl%DeltaT) + if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT < 0._r8) then + Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 endif call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) else if (Tdom%domsur(iunit,ntdom)>0._r8) then Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT endif - ! here some checks to make sure the DOM is not at too hugh or low concentrations - if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8) ! .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then + ! here some checks to make sure the DOM is not at too high or low concentrations + if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8) then ! .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 endif if (Tdom%domH(iunit,ntdom) < 1.e-50_r8) then - Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 endif - if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8 .or. Tdom%domH(iunit,ntdom)< 0._r8) then - write(iulog,*)'Concentration in hill is too high or too low ',iunit,'domH',Tdom%domH(iunit,ntdom),'wh',TRunoff%wh(iunit,nt) - !call shr_sys_abort('Concentration in hill is too high or too low') - endif if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then - Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)*Tctl%DeltaT - Tdom%domsub(iunit,ntdom)=max(0._r8,Tdom%domsub(iunit,ntdom)-(Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)-0.3_r8)*TRunoff%qsub(iunit,nt)) + Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)-0.3_r8*TRunoff%qsub(iunit,nt))*Tctl%DeltaT + Tdom%domsub(iunit,ntdom)=max(0._r8,0.3_r8*TRunoff%qsub(iunit,nt)) endif Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units @@ -151,15 +146,16 @@ subroutine Euler if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT+TRunoff%etin(iunit,nt)*localDeltaT>0._r8) then - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) - Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) + if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT < 0._r8) then + Rest_T(ntdom)= Rest_T(ntdom)+Tdom%domT(iunit,ntdom) + Tdom%domT(iunit,ntdom)=0._r8 + endif + call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) + Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) else if ((Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))>0._r8) then Rest_T(ntdom)= Rest_T(ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))*localDeltaT endif - if (TRunoff%wt(iunit,nt)<0._r8) then - write(iulog,*) 'Concentration error wt<0' - endif - if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8 .and. Tdom%domT(iunit,ntdom) < 1.e-10*(Tdom%domTout(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then + if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8) then Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) Tdom%domT(iunit,ntdom)=0._r8 endif @@ -167,10 +163,6 @@ subroutine Euler Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) Tdom%domT(iunit,ntdom)=0._r8 endif - if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8 .or. Tdom%domT(iunit,ntdom) <0._r8) then - write(iulog,*)' Concentration in subn is too high or too low ',Tdom%domT(iunit,ntdom),TRunoff%wt(iunit,nt) - !call shr_sys_abort('Concentration in subn is too high or too low') - endif enddo endif end do ! numDT_t @@ -277,19 +269,27 @@ subroutine Euler if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers if (TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*localDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt))*localDeltaT>0._r8) then + if (TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*localDeltaT < 0._r8) then + Rest_R(ntdom)= Rest_T(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domR(iunit,ntdom)=0._r8 + endif call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) temp_eroutdom(ntdom) = temp_eroutdom(ntdom) + Tdom%domRout(iunit,ntdom) else if ((Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))>0._r8) then Rest_R(ntdom)= Rest_R(ntdom)+(Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))*localDeltaT endif - if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .and. Tdom%domR(iunit,ntdom) < 1.e-10*(Tdom%domRout(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom)+Tdom%domRUp(iunit,ntdom))) then + if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8) then !.and. Tdom%domR(iunit,ntdom) < 1.e-10*(Tdom%domRout(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom)+Tdom%domRUp(iunit,ntdom))) then Rest_R(ntdom)=Rest_R(ntdom)+Tdom%domR(iunit,ntdom) Tdom%domR(iunit,ntdom)=0._r8 endif - if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .or. Tdom%domR(iunit,ntdom) <0._r8) then - write(iulog,*)' Concentration in main is too high or too low ',Tdom%domR(iunit,ntdom),TRunoff%wr(iunit,nt) + if (Tdom%domR(iunit,ntdom) < 1.e-50_r8) then + Rest_R(ntdom)=Rest_R(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domR(iunit,ntdom)=0._r8 + endif + !if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .or. Tdom%domR(iunit,ntdom) <0._r8) then + ! write(iulog,*)' Concentration in main is too high or too low ',Tdom%domR(iunit,ntdom),TRunoff%wr(iunit,nt) !call shr_sys_abort('Concentration in main is too high or too low') - endif + !endif enddo endif !---------------------------------------------------------------------------------------------------------------- diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 24b532d..4adf496 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -1949,7 +1949,6 @@ subroutine Rtmrun(rstwr,nlend,rdate) rtmCTL%erout = TRunoff%erout rtmCTL%domT = Tdom%domT rtmCTL%domR = Tdom%domR - rtmCTL%domH = Tdom%domH rtmCTL%domRout = Tdom%domRout rtmCTL%domRest = Tdom%domRest From 7fa46ae22bca8b75f32c95ff6510cbc7318603e6 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Tue, 2 May 2023 11:18:18 +0200 Subject: [PATCH 34/37] commented out a bunch of boundaries --- src/riverroute/DommasbMod.F90 | 20 +++++++++++--------- src/riverroute/MOSART_physics_mod.F90 | 2 +- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index b3c2f75..f5916ba 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -28,13 +28,14 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) !domsur (kg/m2*s) ,domH (kg/m2), ehout (m/s), domHout (kg/m2*s), qsur (m/s), wh (m) Tdom%domHout(iunit,ntdom) = -TRunoff%ehout(iunit,nt) * (Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * theDeltaT)/(TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*theDeltaT+TRunoff%qsur(iunit,nt)*theDeltaT) !we dont want a too high out - Tdom%domHout(iunit,ntdom) = min(-TRunoff%ehout(iunit,nt) * 0.3_r8, Tdom%domHout(iunit,ntdom)) + !Tdom%domHout(iunit,ntdom) = min(-TRunoff%ehout(iunit,nt) * 0.3_r8, Tdom%domHout(iunit,ntdom)) !cannot be more be less than 0, lower boundary - Tdom%domHout(iunit,ntdom) = max(0._r8,Tdom%domHout(iunit,ntdom)) + !Tdom%domHout(iunit,ntdom) = max(0._r8,Tdom%domHout(iunit,ntdom)) !cannot be more than available carbon, upper boundary - Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,Tdom%domHout(iunit,ntdom)) + !Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,Tdom%domHout(iunit,ntdom)) Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) + end subroutine hillslopeRoutingDOM subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) @@ -43,12 +44,13 @@ subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT Tdom%domTout(iunit,ntdom) = -TRunoff%etout(iunit,nt) * (Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * theDeltaT)/(TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*theDeltaT+TRunoff%etin(iunit,nt)*theDeltaT) - Tdom%domTout(iunit,ntdom) = min(-TRunoff%etout(iunit,nt) *0.3_r8,Tdom%domTout(iunit,ntdom)) - Tdom%domTout(iunit,ntdom) = max(0._r8,Tdom%domTout(iunit,ntdom)) - Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) + !Tdom%domTout(iunit,ntdom) = min(-TRunoff%etout(iunit,nt) *0.3_r8,Tdom%domTout(iunit,ntdom)) + !Tdom%domTout(iunit,ntdom) = max(0._r8,Tdom%domTout(iunit,ntdom)) + !Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) + end subroutine subnetworkRoutingDOM subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) @@ -60,9 +62,9 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) temp_gwl = TRunoff%qgwl(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) Tdom%domRout(iunit,ntdom) = -TRunoff%erout(iunit,nt) * (Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom)) * theDeltaT)/(TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*theDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt)+temp_gwl)*theDeltaT) - Tdom%domRout(iunit,ntdom) = min(-TRunoff%erout(iunit,nt) *0.3_r8,Tdom%domRout(iunit,ntdom)) - Tdom%domRout(iunit,ntdom) = max(0._r8,Tdom%domRout(iunit,ntdom)) - Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domRout(iunit,ntdom)) + !Tdom%domRout(iunit,ntdom) = min(-TRunoff%erout(iunit,nt) *0.3_r8,Tdom%domRout(iunit,ntdom)) + !Tdom%domRout(iunit,ntdom) = max(0._r8,Tdom%domRout(iunit,ntdom)) + !Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domRout(iunit,ntdom)) Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 22bb642..30b8c94 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -97,7 +97,7 @@ subroutine Euler endif Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units - Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_H(ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_H(ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2 --> kg enddo endif !-------------------------------------------------------------------------------------------------------------------------- From dae8a26838513910263eb288d39e0b84cd9e2497 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Wed, 3 May 2023 09:10:39 +0200 Subject: [PATCH 35/37] remove the last boundary statement of DOC mass balance --- src/riverroute/DommasbMod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index f5916ba..539ac69 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -34,7 +34,8 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) !cannot be more than available carbon, upper boundary !Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,Tdom%domHout(iunit,ntdom)) - Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) + !Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT end subroutine hillslopeRoutingDOM @@ -49,7 +50,8 @@ subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) !Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) - Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) + !Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT end subroutine subnetworkRoutingDOM @@ -67,7 +69,8 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) !Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domRout(iunit,ntdom)) - Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) + !Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- end MODULE DommasbMod From bbd2aa7b28f0bf394d3b3261b58f616fc54e0edd Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Mon, 12 Jun 2023 12:54:06 +0200 Subject: [PATCH 36/37] added text --- src/cpl/nuopc/rof_import_export.F90 | 4 ++-- src/riverroute/DommasbMod.F90 | 17 +++++++++------- src/riverroute/MOSART_physics_mod.F90 | 28 +++++++++++++-------------- src/riverroute/RtmHistFlds.F90 | 20 +++++++++---------- 4 files changed, 36 insertions(+), 33 deletions(-) diff --git a/src/cpl/nuopc/rof_import_export.F90 b/src/cpl/nuopc/rof_import_export.F90 index 285c9ef..408c814 100644 --- a/src/cpl/nuopc/rof_import_export.F90 +++ b/src/cpl/nuopc/rof_import_export.F90 @@ -246,7 +246,7 @@ subroutine import_fields( gcomp, rc ) type(ESMF_State) :: importState integer :: n,nt integer :: begr, endr - integer :: nliq, nfrz, ndoc + integer :: nliq, nfrz, ndoc ! ndoc is carbon tracer, ndon can be added for nitrogen later character(len=*), parameter :: subname='(rof_import_export:import_fields)' !--------------------------------------------------------------------------- @@ -271,7 +271,7 @@ subroutine import_fields( gcomp, rc ) ndoc = 0 do nt = 1,nt_rtm_dom - if (trim(rtm_tracers_dom(nt)) == 'DOC') ndoc = nt + if (trim(rtm_tracers_dom(nt)) == 'DOC') ndoc = nt ! DOC is currently the only tracer in DOM enddo if (ndoc == 0) then write(iulog,*) trim(subname),': ERROR in rtm_tracers_dom DOC ',ndoc,rtm_tracers_dom diff --git a/src/riverroute/DommasbMod.F90 b/src/riverroute/DommasbMod.F90 index 539ac69..ac2fcee 100755 --- a/src/riverroute/DommasbMod.F90 +++ b/src/riverroute/DommasbMod.F90 @@ -27,14 +27,15 @@ subroutine hillslopeRoutingDOM(iunit,nt,ntdom,theDeltaT) real(r8), intent(in) :: theDeltaT !domsur (kg/m2*s) ,domH (kg/m2), ehout (m/s), domHout (kg/m2*s), qsur (m/s), wh (m) Tdom%domHout(iunit,ntdom) = -TRunoff%ehout(iunit,nt) * (Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * theDeltaT)/(TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*theDeltaT+TRunoff%qsur(iunit,nt)*theDeltaT) + !we dont want a too high out !Tdom%domHout(iunit,ntdom) = min(-TRunoff%ehout(iunit,nt) * 0.3_r8, Tdom%domHout(iunit,ntdom)) - !cannot be more be less than 0, lower boundary + !cannot be less than 0, lower boundary !Tdom%domHout(iunit,ntdom) = max(0._r8,Tdom%domHout(iunit,ntdom)) !cannot be more than available carbon, upper boundary !Tdom%domHout(iunit,ntdom) = min((Tdom%domH(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*theDeltaT)/theDeltaT,Tdom%domHout(iunit,ntdom)) - !Tdom%domH(iunit,ntdom) = max(0._r8,Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT) + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom))* theDeltaT end subroutine hillslopeRoutingDOM @@ -44,13 +45,15 @@ subroutine subnetworkRoutingDOM(iunit,nt,ntdom,theDeltaT) implicit none integer, intent(in) :: iunit, nt, ntdom real(r8), intent(in) :: theDeltaT + ! domTout (kg/s), etout (m3/s), domT (kg), domsub (kg/s), domHout (kg/s), wt (m3), dwt (m3/s), etin (m3/s) + Tdom%domTout(iunit,ntdom) = -TRunoff%etout(iunit,nt) * (Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * theDeltaT)/(TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*theDeltaT+TRunoff%etin(iunit,nt)*theDeltaT) + !Tdom%domTout(iunit,ntdom) = min(-TRunoff%etout(iunit,nt) *0.3_r8,Tdom%domTout(iunit,ntdom)) !Tdom%domTout(iunit,ntdom) = max(0._r8,Tdom%domTout(iunit,ntdom)) - !Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) - - + !Tdom%domTout(iunit,ntdom) = min((Tdom%domT(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domTout(iunit,ntdom)) !Tdom%domT(iunit,ntdom) = max(0._r8,Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * theDeltaT end subroutine subnetworkRoutingDOM @@ -64,12 +67,12 @@ subroutine mainchannelRoutingDOM(iunit,nt,ntdom,theDeltaT) temp_gwl = TRunoff%qgwl(iunit,nt) * TUnit%area(iunit) * TUnit%frac(iunit) Tdom%domRout(iunit,ntdom) = -TRunoff%erout(iunit,nt) * (Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom)) * theDeltaT)/(TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*theDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt)+temp_gwl)*theDeltaT) + !Tdom%domRout(iunit,ntdom) = min(-TRunoff%erout(iunit,nt) *0.3_r8,Tdom%domRout(iunit,ntdom)) !Tdom%domRout(iunit,ntdom) = max(0._r8,Tdom%domRout(iunit,ntdom)) !Tdom%domRout(iunit,ntdom) = min((Tdom%domR(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom))* theDeltaT)/theDeltaT,Tdom%domRout(iunit,ntdom)) - - !Tdom%domR(iunit,ntdom) = max(0._r8,Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT) + Tdom%domR(iunit,ntdom) = Tdom%domR(iunit,ntdom) + (Tdom%domRUp(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRout(iunit,ntdom)) * theDeltaT end subroutine mainchannelRoutingDOM !------------------------------------------------------------------------- diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index 30b8c94..bd3e549 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -16,7 +16,7 @@ MODULE MOSART_physics_mod use RtmVar , only : iulog, barrier_timers, nt_rtm, rtm_tracers, nt_rtm_dom, rtm_tracers_dom use RunoffMod , only : Tctl, TUnit, TRunoff, TPara, rtmCTL,Tdom use RunoffMod , only : SMatP_eroutUp, avsrc_eroutUp, avdst_eroutUp - use RunoffMod , only : SMatP_domRUp, avsrc_domRUp, avdst_domRUp + use RunoffMod , only : SMatP_domRUp, avsrc_domRUp, avdst_domRUp ! Matrix to calculate the DOC coming from all upstream gridcells use RtmSpmd , only : masterproc, mpicom_rof use perf_mod , only: t_startf, t_stopf use mct_mod @@ -51,7 +51,7 @@ subroutine Euler integer :: iunit, m, k, unitUp, cnt, ier !local index real(r8) :: temp_erout, localDeltaT real(r8) :: negchan - real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom),Rest_H(nt_rtm_dom) + real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom),Rest_H(nt_rtm_dom) ! Rest DOC for when water becomes or has been negative it is negligible, and may not be necessary !------------------ ! hillslope @@ -62,20 +62,20 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if (TUnit%mask(iunit) > 0) then - Rest_H(:) = 0._r8 call hillslopeRouting(iunit,nt,Tctl%DeltaT) TRunoff%wh(iunit,nt) = TRunoff%wh(iunit,nt) + TRunoff%dwh(iunit,nt) * Tctl%DeltaT call UpdateState_hillslope(iunit,nt) TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) !----------------------------------------------------------------------------------------------------------------- - if (nt==1) then ! if LIQ tracer and there is water + if (nt==1) then ! if LIQ tracer + Rest_H(:) = 0._r8 do ntdom=1,nt_rtm_dom ! loop over DOM tracers - Tdom%domHout(iunit,ntdom)=0._r8 - !if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then + Tdom%domHout(iunit,ntdom)=0._r8 ! initialize flux to 0 + !if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then this was a check for the surface doc concentration ! write(iulog,*)'Concentration ERROR qsur',Tdom%domsur(iunit,ntdom),TRunoff%qsur(iunit,nt) !endif - if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then - if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT < 0._r8) then + if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then ! if the water entering and present in the hillslope is greater than 0 + if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT <= 0._r8) then Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 endif @@ -91,11 +91,11 @@ subroutine Euler if (Tdom%domH(iunit,ntdom) < 1.e-50_r8) then Tdom%domH(iunit,ntdom)=0._r8 endif - if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then - Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)-0.3_r8*TRunoff%qsub(iunit,nt))*Tctl%DeltaT - Tdom%domsub(iunit,ntdom)=max(0._r8,0.3_r8*TRunoff%qsub(iunit,nt)) - endif - Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units + !if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then this was a check for the subsurface DOC concentratrion + ! Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)-0.3_r8*TRunoff%qsub(iunit,nt))*Tctl%DeltaT + ! Tdom%domsub(iunit,ntdom)=max(0._r8,0.3_r8*TRunoff%qsub(iunit,nt)) + !endif + Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2s --> kg/s Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_H(ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2 --> kg enddo @@ -135,7 +135,7 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then - Rest_T(:) = 0._r8 + Rest_T(:) = 0._r8 ! we need to add another rest variable because it has only one dimension localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_t(iunit) do k=1,TUnit%numDT_t(iunit) call subnetworkRouting(iunit,nt,localDeltaT) diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 8187c7e..3983ade 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -116,11 +116,11 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='QGWL'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART input GWL runoff: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%qgwl_nt1, default='inactive') + ptr_rof=rtmCTL%qgwl_nt1, default='active') call RtmHistAddfld (fname='QGWL'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART input GWL runoff: '//trim(rtm_tracers(2)), & - ptr_rof=rtmCTL%qgwl_nt2, default='inactive') + ptr_rof=rtmCTL%qgwl_nt2, default='active') call RtmHistAddfld (fname='QIRRIG_FROM_COUPLER', units='m3/s', & avgflag='A', long_name='Amount of water used for irrigation (total flux received from coupler)', & @@ -165,23 +165,23 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='MASS_REST'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domRest_ntdom1, default='active') - + ! added DOC out of Hills call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domHout_ntdom1, default='active') - + ! added DOC out of Subn + call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domTout_ntdom1, default='active') + ! added water out of Subn call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%erlateral2_nt1, default='active') - + ! added water out of Hills call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%etin_nt1, default='active') - - call RtmHistAddfld (fname='OUT_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & - avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%domTout_ntdom1, default='active') - + call RtmHistAddfld (fname='MASS_HILLS'//'_'//trim(rtm_tracers(1)), units='m', & avgflag='A', long_name='MOSART WATER: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%wh_nt1, default='active') From b2debee9ec560979356dd835a860508efd990218 Mon Sep 17 00:00:00 2001 From: Marius Lambert Date: Tue, 20 Jun 2023 14:21:30 +0200 Subject: [PATCH 37/37] starting to remove equations from dommas in hill and subn --- src/riverroute/MOSART_physics_mod.F90 | 105 ++++++++++++++------------ src/riverroute/RtmHistFlds.F90 | 29 +++++-- src/riverroute/RtmMod.F90 | 39 +++++++--- src/riverroute/RunoffMod.F90 | 40 ++++++---- 4 files changed, 129 insertions(+), 84 deletions(-) diff --git a/src/riverroute/MOSART_physics_mod.F90 b/src/riverroute/MOSART_physics_mod.F90 index bd3e549..8b1af83 100644 --- a/src/riverroute/MOSART_physics_mod.F90 +++ b/src/riverroute/MOSART_physics_mod.F90 @@ -26,7 +26,7 @@ MODULE MOSART_physics_mod private real(r8), parameter :: TINYVALUE = 1.0e-14_r8 ! double precision variable has a significance of about 16 decimal digits - integer :: nt, ntdom ! loop indices + integer :: nt, ntdom ! loop indices real(r8), parameter :: SLOPE1def = 0.1_r8 ! here give it a small value in order to avoid the abrupt change of hydraulic radidus etc. real(r8) :: sinatanSLOPE1defr ! 1.0/sin(atan(slope1)) @@ -51,12 +51,17 @@ subroutine Euler integer :: iunit, m, k, unitUp, cnt, ier !local index real(r8) :: temp_erout, localDeltaT real(r8) :: negchan - real(r8) :: temp_eroutdom(nt_rtm_dom),Rest_R(nt_rtm_dom),Rest_T(nt_rtm_dom),Rest_H(nt_rtm_dom) ! Rest DOC for when water becomes or has been negative it is negligible, and may not be necessary - + real(r8) :: temp_eroutdom(nt_rtm_dom) + real(r8) :: liqsub(rtmCTL%begr:rtmCTL%endr,nt_rtm),concsub(rtmCTL%begr:rtmCTL%endr,nt_rtm_dom) + real(r8) :: liqhill(rtmCTL%begr:rtmCTL%endr,nt_rtm),conchill(rtmCTL%begr:rtmCTL%endr,nt_rtm_dom) !------------------ ! hillslope !------------------ - + liqsub(:,:)=0._r8 + concsub(:,:)=0._r8 + liqhill(:,:)=0._r8 + conchill(:,:)=0._r8 + call t_startf('mosartr_hillslope') do nt=1,nt_rtm if (TUnit%euler_calc(nt)) then @@ -68,36 +73,35 @@ subroutine Euler TRunoff%etin(iunit,nt) = (-TRunoff%ehout(iunit,nt) + TRunoff%qsub(iunit,nt)) * TUnit%area(iunit) * TUnit%frac(iunit) !----------------------------------------------------------------------------------------------------------------- if (nt==1) then ! if LIQ tracer - Rest_H(:) = 0._r8 do ntdom=1,nt_rtm_dom ! loop over DOM tracers - Tdom%domHout(iunit,ntdom)=0._r8 ! initialize flux to 0 - !if (Tdom%domsur(iunit,ntdom)/TRunoff%qsur(iunit,nt)> 0.30001_r8) then this was a check for the surface doc concentration - ! write(iulog,*)'Concentration ERROR qsur',Tdom%domsur(iunit,ntdom),TRunoff%qsur(iunit,nt) - !endif - if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT>0._r8) then ! if the water entering and present in the hillslope is greater than 0 - if (TRunoff%wh(iunit,nt) - TRunoff%dwh(iunit,nt) * Tctl%DeltaT <= 0._r8) then - Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) + liqhill(iunit,nt)=TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT+TRunoff%qsur(iunit,nt)*Tctl%DeltaT + conchill(iunit,ntdom)=(Tdom%domH(iunit,ntdom) + Tdom%domsur(iunit,ntdom) * Tctl%DeltaT)/liqhill(iunit,nt) + if (liqhill(iunit,nt)>0._r8 .and. conchill(iunit,ntdom)<=0.3_r8 .and. conchill(iunit,ntdom)>0._r8) then + if (TRunoff%wh(iunit,nt)-TRunoff%dwh(iunit,nt)*Tctl%DeltaT < 0._r8) then + Tdom%domResthill(iunit,ntdom) = Tdom%domResthill(iunit,ntdom) + Tdom%domH(iunit,ntdom) Tdom%domH(iunit,ntdom)=0._r8 - endif - call hillslopeRoutingDOM(iunit,nt,ntdom,Tctl%DeltaT) + endif + Tdom%domHout(iunit,ntdom) = -TRunoff%ehout(iunit,nt) * conchill(iunit,ntdom) + Tdom%domH(iunit,ntdom) = Tdom%domH(iunit,ntdom) + (Tdom%domsur(iunit,ntdom) - Tdom%domHout(iunit,ntdom)) * Tctl%DeltaT else if (Tdom%domsur(iunit,ntdom)>0._r8) then - Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT + Tdom%domResthill(iunit,ntdom)= Tdom%domResthill(iunit,ntdom)+Tdom%domsur(iunit,ntdom)*Tctl%DeltaT endif - ! here some checks to make sure the DOM is not at too high or low concentrations - if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.30001_r8) then ! .and. Tdom%domH(iunit,ntdom) < 1.e-10_r8*(Tdom%domsur(iunit,ntdom)+Tdom%domHout(iunit,ntdom))) then - Rest_H(ntdom)= Rest_H(ntdom)+Tdom%domH(iunit,ntdom) - Tdom%domH(iunit,ntdom)=0._r8 + if (TRunoff%wh(iunit,nt)< 0._r8) then + Tdom%domResthill(iunit,ntdom)= Tdom%domResthill(iunit,ntdom)+Tdom%domH(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 endif - if (Tdom%domH(iunit,ntdom) < 1.e-50_r8) then - Tdom%domH(iunit,ntdom)=0._r8 + if (Tdom%domH(iunit,ntdom) < 0._r8) then + Tdom%domResthill(iunit,ntdom)= Tdom%domResthill(iunit,ntdom)+Tdom%domH(iunit,ntdom) + Tdom%domH(iunit,ntdom)=0._r8 + endif + ! here some checks to make sure the DOM is not at too high or low concentrations + if (Tdom%domH(iunit,ntdom)/TRunoff%wh(iunit,nt) > 0.3_r8 .and. TRunoff%wh(iunit,nt) >= 0._r8) then + Tdom%domResthill(iunit,ntdom)= Tdom%domResthill(iunit,ntdom)+Tdom%domH(iunit,ntdom)-0.3*TRunoff%wh(iunit,nt) + Tdom%domH(iunit,ntdom)=0.3*TRunoff%wh(iunit,nt) endif - !if (Tdom%domsub(iunit,ntdom)/TRunoff%qsub(iunit,nt)> 0.30001_r8) then this was a check for the subsurface DOC concentratrion - ! Rest_H(ntdom)= Rest_H(ntdom)+(Tdom%domsub(iunit,ntdom)-0.3_r8*TRunoff%qsub(iunit,nt))*Tctl%DeltaT - ! Tdom%domsub(iunit,ntdom)=max(0._r8,0.3_r8*TRunoff%qsub(iunit,nt)) - !endif Tdom%domsub(iunit,ntdom) = Tdom%domsub(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2s --> kg/s - Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units - Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_H(ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2 --> kg + Tdom%domHout(iunit,ntdom) = Tdom%domHout(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2s --> kg/s + Tdom%domResthill(iunit,ntdom) = Tdom%domResthill(iunit,ntdom) * TUnit%area(iunit) * TUnit%frac(iunit) ! readjust to correct units kg/m2 --> kg enddo endif !-------------------------------------------------------------------------------------------------------------------------- @@ -135,7 +139,6 @@ subroutine Euler if (TUnit%euler_calc(nt)) then do iunit=rtmCTL%begr,rtmCTL%endr if(TUnit%mask(iunit) > 0) then - Rest_T(:) = 0._r8 ! we need to add another rest variable because it has only one dimension localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_t(iunit) do k=1,TUnit%numDT_t(iunit) call subnetworkRouting(iunit,nt,localDeltaT) @@ -145,34 +148,40 @@ subroutine Euler !---------------------------------------------------------------------------------------------------- if (nt==1) then ! if LIQ tracer and there is water do ntdom=1,nt_rtm_dom ! loop over DOM tracers - if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT+TRunoff%etin(iunit,nt)*localDeltaT>0._r8) then - if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT < 0._r8) then - Rest_T(ntdom)= Rest_T(ntdom)+Tdom%domT(iunit,ntdom) + liqsub(iunit,nt)=TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT+TRunoff%etin(iunit,nt)*localDeltaT + concsub(iunit,ntdom)=(Tdom%domT(iunit,ntdom) + (Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom)) * localDeltaT)/liqsub(iunit,nt) + if (liqsub(iunit,nt) > 0._r8 .and. concsub(iunit,ntdom)<=0.3_r8 .and. concsub(iunit,ntdom)>0._r8) then + if (TRunoff%wt(iunit,nt)-TRunoff%dwt(iunit,nt)*localDeltaT< 0._r8) then + Tdom%domRestsubn(iunit,ntdom) = Tdom%domRestsubn(iunit,ntdom) + Tdom%domT(iunit,ntdom) Tdom%domT(iunit,ntdom)=0._r8 endif - call subnetworkRoutingDOM(iunit,nt,ntdom,localDeltaT) - Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) + Tdom%domTout(iunit,ntdom) = -TRunoff%etout(iunit,nt)*concsub(iunit,ntdom) + Tdom%domT(iunit,ntdom) = Tdom%domT(iunit,ntdom) + ( Tdom%domsub(iunit,ntdom) + Tdom%domHout(iunit,ntdom) - Tdom%domTout(iunit,ntdom) ) * localDeltaT else if ((Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))>0._r8) then - Rest_T(ntdom)= Rest_T(ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))*localDeltaT + Tdom%domRestsubn(iunit,ntdom)= Tdom%domRestsubn(iunit,ntdom)+(Tdom%domsub(iunit,ntdom)+Tdom%domHout(iunit,ntdom))*localDeltaT endif - if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.30001_r8) then - Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) - Tdom%domT(iunit,ntdom)=0._r8 + if (TRunoff%wt(iunit,nt) < 0._r8) then + Tdom%domRestsubn(iunit,ntdom)= Tdom%domRestsubn(iunit,ntdom)+Tdom%domT(iunit,ntdom) + Tdom%domT(iunit,ntdom)=0._r8 endif - if (Tdom%domT(iunit,ntdom) < 1.e-50_r8) then - Rest_T(ntdom)=Rest_T(ntdom)+Tdom%domT(iunit,ntdom) - Tdom%domT(iunit,ntdom)=0._r8 + if (Tdom%domT(iunit,ntdom) < 0._r8) then + Tdom%domRestsubn(iunit,ntdom)=Tdom%domRestsubn(iunit,ntdom)+Tdom%domT(iunit,ntdom) + Tdom%domT(iunit,ntdom)=0._r8 endif + if (Tdom%domT(iunit,ntdom)/TRunoff%wt(iunit,nt) > 0.3_r8 .and. TRunoff%wt(iunit,nt) >= 0._r8) then + Tdom%domRestsubn(iunit,ntdom)=Tdom%domRestsubn(iunit,ntdom)+Tdom%domT(iunit,ntdom)-0.3*TRunoff%wt(iunit,nt) + Tdom%domT(iunit,ntdom)=0.3*TRunoff%wt(iunit,nt) + endif + Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) + Tdom%domTout(iunit,ntdom) enddo endif end do ! numDT_t TRunoff%erlateral(iunit,nt) = TRunoff%erlateral(iunit,nt) / TUnit%numDT_t(iunit) TRunoff%erlateral2(iunit,nt) = TRunoff%erlateral2(iunit,nt) + TRunoff%erlateral(iunit,nt) - if (nt==1) then ! if LIQ tracer and there is water - do ntdom=1,nt_rtm_dom + if (nt==1) then ! if LIQ tracer + do ntdom=1,nt_rtm_dom ! loop over DOM tracers Tdom%domToutLat(iunit,ntdom) = Tdom%domToutLat(iunit,ntdom) / TUnit%numDT_t(iunit) Tdom%domToutLat2(iunit,ntdom) = Tdom%domToutLat2(iunit,ntdom) + Tdom%domToutLat(iunit,ntdom) - Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_T(ntdom) end do end if endif @@ -254,7 +263,6 @@ subroutine Euler localDeltaT = Tctl%DeltaT/Tctl%DLevelH2R/TUnit%numDT_r(iunit) temp_erout = 0._r8 temp_eroutdom(:) = 0._r8 - Rest_R(:) = 0._r8 do k=1,TUnit%numDT_r(iunit) call mainchannelRouting(iunit,nt,localDeltaT) TRunoff%wr(iunit,nt) = TRunoff%wr(iunit,nt) + TRunoff%dwr(iunit,nt) * localDeltaT @@ -270,20 +278,20 @@ subroutine Euler do ntdom=1,nt_rtm_dom ! loop over DOM tracers if (TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*localDeltaT+(TRunoff%erlateral(iunit,nt)+TRunoff%erin(iunit,nt))*localDeltaT>0._r8) then if (TRunoff%wr(iunit,nt)-TRunoff%dwr(iunit,nt)*localDeltaT < 0._r8) then - Rest_R(ntdom)= Rest_T(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domRestmain(iunit,ntdom)= Tdom%domRestmain(iunit,ntdom)+Tdom%domR(iunit,ntdom) Tdom%domR(iunit,ntdom)=0._r8 endif call mainchannelRoutingDOM(iunit,nt,ntdom,localDeltaT) temp_eroutdom(ntdom) = temp_eroutdom(ntdom) + Tdom%domRout(iunit,ntdom) else if ((Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))>0._r8) then - Rest_R(ntdom)= Rest_R(ntdom)+(Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))*localDeltaT + Tdom%domRestmain(iunit,ntdom)= Tdom%domRestmain(iunit,ntdom)+(Tdom%domRUp(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom))*localDeltaT endif if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8) then !.and. Tdom%domR(iunit,ntdom) < 1.e-10*(Tdom%domRout(iunit,ntdom)+Tdom%domToutLat(iunit,ntdom)+Tdom%domRUp(iunit,ntdom))) then - Rest_R(ntdom)=Rest_R(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domRestmain(iunit,ntdom)=Tdom%domRestmain(iunit,ntdom)+Tdom%domR(iunit,ntdom) Tdom%domR(iunit,ntdom)=0._r8 endif if (Tdom%domR(iunit,ntdom) < 1.e-50_r8) then - Rest_R(ntdom)=Rest_R(ntdom)+Tdom%domR(iunit,ntdom) + Tdom%domRestmain(iunit,ntdom)=Tdom%domRestmain(iunit,ntdom)+Tdom%domR(iunit,ntdom) Tdom%domR(iunit,ntdom)=0._r8 endif !if (Tdom%domR(iunit,ntdom)/TRunoff%wr(iunit,nt) > 0.30001_r8 .or. Tdom%domR(iunit,ntdom) <0._r8) then @@ -302,7 +310,6 @@ subroutine Euler temp_eroutdom(ntdom) = temp_eroutdom(ntdom) / TUnit%numDT_r(iunit) Tdom%domRout(iunit,ntdom) = temp_eroutdom(ntdom) Tdom%domRoutFlow(iunit,ntdom) = Tdom%domRoutFlow(iunit,ntdom) + Tdom%domRout(iunit,ntdom) - Tdom%domRest(iunit,ntdom) = Tdom%domRest(iunit,ntdom) + Rest_R(ntdom) enddo endif endif diff --git a/src/riverroute/RtmHistFlds.F90 b/src/riverroute/RtmHistFlds.F90 index 3983ade..c373317 100644 --- a/src/riverroute/RtmHistFlds.F90 +++ b/src/riverroute/RtmHistFlds.F90 @@ -80,11 +80,11 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='STORAGE_MCH', units='m3', & avgflag='A', long_name='MOSART main channelstorage', & - ptr_rof=rtmCTL%volr_mch, default='inactive') + ptr_rof=rtmCTL%volr_mch, default='active') call RtmHistAddfld (fname='DVOLRDT_LND'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART land change in storage: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%dvolrdtlnd_nt1, default='inactive') + ptr_rof=rtmCTL%dvolrdtlnd_nt1, default='active') call RtmHistAddfld (fname='DVOLRDT_LND'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART land change in storage: '//trim(rtm_tracers(2)), & @@ -92,7 +92,7 @@ subroutine RtmHistFldsInit() call RtmHistAddfld (fname='DVOLRDT_OCN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART ocean change of storage: '//trim(rtm_tracers(1)), & - ptr_rof=rtmCTL%dvolrdtocn_nt1, default='inactive') + ptr_rof=rtmCTL%dvolrdtocn_nt1, default='active') call RtmHistAddfld (fname='DVOLRDT_OCN'//'_'//trim(rtm_tracers(2)), units='m3/s', & avgflag='A', long_name='MOSART ocean change of storage: '//trim(rtm_tracers(2)), & @@ -162,9 +162,15 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & ptr_rof=rtmCTL%domR_ntdom1, default='active') - call RtmHistAddfld (fname='MASS_REST'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + call RtmHistAddfld (fname='MASS_REST_HILL'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & - ptr_rof=rtmCTL%domRest_ntdom1, default='active') + ptr_rof=rtmCTL%domResthill_ntdom1, default='active') + call RtmHistAddfld (fname='MASS_REST_SUBN'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domRestsubn_ntdom1, default='active') + call RtmHistAddfld (fname='MASS_REST_MAIN'//'_'//trim(rtm_tracers_dom(1)), units='kgC', & + avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & + ptr_rof=rtmCTL%domRestmain_ntdom1, default='active') ! added DOC out of Hills call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers_dom(1)), units='kgC/s', & avgflag='A', long_name='MOSART DOM: '//trim(rtm_tracers_dom(1)), & @@ -178,11 +184,15 @@ subroutine RtmHistFldsInit() avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%erlateral2_nt1, default='active') ! added water out of Hills - call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers(1)), units='m3/s', & + call RtmHistAddfld (fname='IN_SUBN'//'_'//trim(rtm_tracers(1)), units='m3/s', & avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%etin_nt1, default='active') + + call RtmHistAddfld (fname='OUT_HILLS'//'_'//trim(rtm_tracers(1)), units='m3/s', & + avgflag='A', long_name='MOSART water: '//trim(rtm_tracers(1)), & + ptr_rof=rtmCTL%ehout_nt1, default='active') - call RtmHistAddfld (fname='MASS_HILLS'//'_'//trim(rtm_tracers(1)), units='m', & + call RtmHistAddfld (fname='MASS_HILLS'//'_'//trim(rtm_tracers(1)), units='m3', & avgflag='A', long_name='MOSART WATER: '//trim(rtm_tracers(1)), & ptr_rof=rtmCTL%wh_nt1, default='active') @@ -252,13 +262,16 @@ subroutine RtmHistFldsSet() rtmCTL%domH_ntdom1(:) = rtmCTL%domH(:,1) rtmCTL%domT_ntdom1(:) = rtmCTL%domT(:,1) rtmCTL%domR_ntdom1(:) = rtmCTL%domR(:,1) - rtmCTL%domRest_ntdom1(:) = rtmCTL%domRest(:,1) + rtmCTL%domResthill_ntdom1(:) = rtmCTL%domResthill(:,1) + rtmCTL%domRestsubn_ntdom1(:) = rtmCTL%domRestsubn(:,1) + rtmCTL%domRestmain_ntdom1(:) = rtmCTL%domRestmain(:,1) rtmCTL%domHout_ntdom1(:) = rtmCTL%domHout(:,1) rtmCTL%domTout_ntdom1(:) = rtmCTL%domTout(:,1) rtmCTL%wr_nt1(:) = rtmCTL%wr(:,1) rtmCTL%wt_nt1(:) = rtmCTL%wt(:,1) rtmCTL%wh_nt1(:) = rtmCTL%wh(:,1) rtmCTL%etin_nt1(:) = rtmCTL%etin(:,1) + rtmCTL%ehout_nt1(:) = rtmCTL%ehout(:,1) rtmCTL%erlateral2_nt1(:) = rtmCTL%erlateral2(:,1) end subroutine RtmHistFldsSet diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 4adf496..8925f06 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -86,6 +86,7 @@ module RtmMod real(r8), save, pointer :: flow(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: erlateral2(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: etin(:,:) ! mosart flow (m3/s) + real(r8), save, pointer :: ehout(:,:) ! mosart flow (m3/s) real(r8), save, pointer :: flowdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: Houtdom(:,:) ! mosart flow (kg/s) real(r8), save, pointer :: Toutdom(:,:) ! mosart flow (kg/s) @@ -938,6 +939,7 @@ subroutine Rtmini(flood_active) flowdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erlateral2 (rtmCTL%begr:rtmCTL%endr,nt_rtm), & etin (rtmCTL%begr:rtmCTL%endr,nt_rtm), & + ehout (rtmCTL%begr:rtmCTL%endr,nt_rtm), & Houtdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & Toutdom (rtmCTL%begr:rtmCTL%endr,nt_rtm_dom), & erout_prev(rtmCTL%begr:rtmCTL%endr,nt_rtm), & @@ -951,6 +953,7 @@ subroutine Rtmini(flood_active) flow(:,:) = 0._r8 erlateral2(:,:) = 0._r8 etin(:,:) = 0._r8 + ehout(:,:) = 0._r8 flowdom(:,:) = 0._r8 Houtdom(:,:) = 0._r8 Toutdom(:,:) = 0._r8 @@ -1478,6 +1481,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) flow = 0._r8 erlateral2 = 0._r8 etin = 0._r8 + ehout = 0._r8 flowdom = 0._r8 Houtdom = 0._r8 Toutdom = 0._r8 @@ -1910,6 +1914,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) do nr = rtmCTL%begr,rtmCTL%endr flow(nr,nt) = flow(nr,nt) + TRunoff%flow(nr,nt) etin(nr,nt) = etin(nr,nt) + TRunoff%etin(nr,nt) + ehout(nr,nt) = ehout(nr,nt) - TRunoff%ehout(nr,nt)*rtmCTL%area(nr) erlateral2(nr,nt) = erlateral2(nr,nt) + TRunoff%erlateral2(nr,nt) erout_prev(nr,nt) = erout_prev(nr,nt) + TRunoff%erout_prev(nr,nt) eroutup_avg(nr,nt) = eroutup_avg(nr,nt) + TRunoff%eroutup_avg(nr,nt) @@ -1931,6 +1936,7 @@ subroutine Rtmrun(rstwr,nlend,rdate) !----------------------------------- erlateral2 = erlateral2 / float(nsub) etin = etin / float(nsub) + ehout = ehout / float(nsub) flow = flow / float(nsub) flowdom = flowdom / float(nsub) Houtdom = Houtdom / float(nsub) @@ -1942,47 +1948,52 @@ subroutine Rtmrun(rstwr,nlend,rdate) !----------------------------------- ! update states when subsycling completed !----------------------------------- - - rtmCTL%wh = TRunoff%wh rtmCTL%wt = TRunoff%wt rtmCTL%wr = TRunoff%wr rtmCTL%erout = TRunoff%erout rtmCTL%domT = Tdom%domT rtmCTL%domR = Tdom%domR rtmCTL%domRout = Tdom%domRout - rtmCTL%domRest = Tdom%domRest + rtmCTL%domResthill = Tdom%domResthill + rtmCTL%domRestsubn = Tdom%domRestsubn + rtmCTL%domRestmain = Tdom%domRestmain do nt = 1,nt_rtm - do nr = rtmCTL%begr,rtmCTL%endr + do nr = rtmCTL%begr,rtmCTL%endr ! both ocean, land and outlet volr_init = rtmCTL%volr(nr,nt) rtmCTL%volr(nr,nt) = (TRunoff%wt(nr,nt) + TRunoff%wr(nr,nt) + & TRunoff%wh(nr,nt)*rtmCTL%area(nr)) + rtmCTL%wh = TRunoff%wh*rtmCTL%area(nr) if (nt==1) then do ntdom = 1,nt_rtm_dom rtmCTL%domH(nr,ntdom) = Tdom%domH(nr,ntdom) * rtmCTL%area(nr) rtmCTL%dommas(nr,ntdom)=(rtmCTL%area(nr)*Tdom%domH(nr,ntdom) + & Tdom%domT(nr,ntdom) + & Tdom%domR(nr,ntdom)) + rtmCTL%domHout(nr,ntdom)=Houtdom(nr,ntdom) + rtmCTL%domTout(nr,ntdom)=Toutdom(nr,ntdom) enddo end if rtmCTL%dvolrdt(nr,nt) = (rtmCTL%volr(nr,nt) - volr_init) / delt_coupling rtmCTL%runoff(nr,nt) = flow(nr,nt) rtmCTL%runofftot(nr,nt) = rtmCTL%direct(nr,nt) - if (rtmCTL%mask(nr) == 1) then + + rtmCTL%erlateral2(nr,nt)=erlateral2(nr,nt) + rtmCTL%etin(nr,nt)=etin(nr,nt) + rtmCTL%ehout(nr,nt)=ehout(nr,nt) + + if (rtmCTL%mask(nr) == 1) then ! over land rtmCTL%runofflnd(nr,nt) = rtmCTL%runoff(nr,nt) rtmCTL%dvolrdtlnd(nr,nt)= rtmCTL%dvolrdt(nr,nt) - rtmCTL%erlateral2(nr,nt)=erlateral2(nr,nt) - rtmCTL%etin(nr,nt)=etin(nr,nt) + if (nt==1) then do ntdom = 1,nt_rtm_dom rtmCTL%runofflnddom(nr,ntdom)=flowdom(nr,ntdom) - rtmCTL%domHout(nr,ntdom)=Houtdom(nr,ntdom) - rtmCTL%domTout(nr,ntdom)=Toutdom(nr,ntdom) enddo end if - elseif (rtmCTL%mask(nr) >= 2) then + elseif (rtmCTL%mask(nr) >= 2) then ! ocean and outlet rtmCTL%runoffocn(nr,nt) = rtmCTL%runoff(nr,nt) rtmCTL%runofftot(nr,nt) = rtmCTL%runofftot(nr,nt) + rtmCTL%runoff(nr,nt) rtmCTL%dvolrdtocn(nr,nt)= rtmCTL%dvolrdt(nr,nt) @@ -2648,8 +2659,12 @@ subroutine MOSART_init Tdom%domRoutFlow = 0._r8 allocate (Tdom%domRUp(begr:endr,nt_rtm_dom)) Tdom%domRUp = 0._r8 - allocate (Tdom%domRest(begr:endr,nt_rtm_dom)) - Tdom%domRest = 0._r8 + allocate (Tdom%domResthill(begr:endr,nt_rtm_dom)) + Tdom%domResthill = 0._r8 + allocate (Tdom%domRestsubn(begr:endr,nt_rtm_dom)) + Tdom%domRestsubn = 0._r8 + allocate (Tdom%domRestmain(begr:endr,nt_rtm_dom)) + Tdom%domRestmain = 0._r8 allocate (Tdom%domsur(begr:endr,nt_rtm_dom)) Tdom%domsur = 0._r8 allocate (Tdom%domsub(begr:endr,nt_rtm_dom)) diff --git a/src/riverroute/RunoffMod.F90 b/src/riverroute/RunoffMod.F90 index f7ff57d..1a5909a 100644 --- a/src/riverroute/RunoffMod.F90 +++ b/src/riverroute/RunoffMod.F90 @@ -74,9 +74,12 @@ module RunoffMod real(r8), pointer :: domHout(:,:) ! RTM DOM storage (kgC/s) real(r8), pointer :: domRoutFlow(:,:) ! RTM DOM storage (kgC/s) real(r8), pointer :: domRout(:,:) ! RTM DOM storage (kgC/s) - real(r8), pointer :: domRest(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domResthill(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domRestsubn(:,:) ! RTM DOM storage (kgC) + real(r8), pointer :: domRestmain(:,:) ! RTM DOM storage (kgC) real(r8), pointer :: fthresh(:) ! RTM water flood threshold - real(r8), pointer :: etin(:,:) + real(r8), pointer :: etin(:,:) + real(r8), pointer :: ehout(:,:) real(r8), pointer :: erlateral2(:,:) ! - restarts @@ -122,7 +125,9 @@ module RunoffMod real(r8), pointer :: qsub_nt2(:) real(r8), pointer :: qgwl_nt1(:) real(r8), pointer :: qgwl_nt2(:) - real(r8), pointer :: domRest_ntdom1(:) + real(r8), pointer :: domResthill_ntdom1(:) + real(r8), pointer :: domRestsubn_ntdom1(:) + real(r8), pointer :: domRestmain_ntdom1(:) real(r8), pointer :: domsur_ntdom1(:) real(r8), pointer :: domsub_ntdom1(:) real(r8), pointer :: dommas_ntdom1(:) @@ -130,13 +135,14 @@ module RunoffMod real(r8), pointer :: runofflnddom_ntdom1(:) real(r8), pointer :: domH_ntdom1(:) real(r8), pointer :: domT_ntdom1(:) + real(r8), pointer :: domR_ntdom1(:) real(r8), pointer :: domHout_ntdom1(:) real(r8), pointer :: domTout_ntdom1(:) - real(r8), pointer :: domR_ntdom1(:) real(r8), pointer :: wh_nt1(:) real(r8), pointer :: wt_nt1(:) real(r8), pointer :: wr_nt1(:) real(r8), pointer :: etin_nt1(:) + real(r8), pointer :: ehout_nt1(:) real(r8), pointer :: erlateral2_nt1(:) end type runoff_flow @@ -326,7 +332,9 @@ module RunoffMod real(r8), pointer :: domRout(:,:) ! dom discharge from main channel into downstream gridcells (kgC/s) real(r8), pointer :: domRoutFlow(:,:) real(r8), pointer :: domRUp(:,:) ! outflow sum of upstream gridcells (kgC/m3) - real(r8), pointer :: domRest(:,:) ! excess DOM in mosart (kgC) + real(r8), pointer :: domResthill(:,:) ! excess DOM in mosart (kgC) + real(r8), pointer :: domRestsubn(:,:) ! excess DOM in mosart (kgC) + real(r8), pointer :: domRestmain(:,:) ! excess DOM in mosart (kgC) end type Domflux !== Hongyi @@ -410,8 +418,12 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%domsur_ntdom1(begr:endr), & rtmCTL%domsub_ntdom1(begr:endr), & rtmCTL%dommas_ntdom1(begr:endr), & - rtmCTL%domRest_ntdom1(begr:endr), & - rtmCTL%domRest(begr:endr,nt_rtm_dom), & + rtmCTL%domResthill_ntdom1(begr:endr), & + rtmCTL%domResthill(begr:endr,nt_rtm_dom), & + rtmCTL%domRestsubn_ntdom1(begr:endr), & + rtmCTL%domRestsubn(begr:endr,nt_rtm_dom), & + rtmCTL%domRestmain_ntdom1(begr:endr), & + rtmCTL%domRestmain(begr:endr,nt_rtm_dom), & rtmCTL%domH_ntdom1(begr:endr), & rtmCTL%domH(begr:endr,nt_rtm_dom), & rtmCTL%domT_ntdom1(begr:endr), & @@ -427,6 +439,8 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%erlateral2_nt1(begr:endr), & rtmCTL%etin(begr:endr,nt_rtm), & rtmCTL%etin_nt1(begr:endr), & + rtmCTL%ehout(begr:endr,nt_rtm), & + rtmCTL%ehout_nt1(begr:endr), & stat=ier) if (ier /= 0) then write(iulog,*)'Rtmini ERROR allocation of runoff local arrays' @@ -450,21 +464,17 @@ subroutine RunoffInit(begr, endr, numr) rtmCTL%qsur(:,:) = 0._r8 rtmCTL%qsub(:,:) = 0._r8 rtmCTL%qgwl(:,:) = 0._r8 + rtmCTL%erlateral2(:,:) =0._r8 + rtmCTL%etin(:,:) =0._r8 + rtmCTL%ehout(:,:) =0._r8 rtmCTL%runofflnddom(:,:)=spval rtmCTL%runoffocndom(:,:)=spval rtmCTL%domsur(:,:) =0._r8 rtmCTL%domsub(:,:) =0._r8 - !rtmCTL%dommas(:,:) =0._r8 - !rtmCTL%domH(:,:) =0._r8 - !rtmCTL%domT(:,:) =0._r8 - !rtmCTL%domR(:,:) =0._r8 rtmCTL%domTout(:,:) =0._r8 - rtmCTL%erlateral2(:,:) =0._r8 - rtmCTL%etin(:,:) =0._r8 rtmCTL%domHout(:,:) =0._r8 - rtmCTL%domRoutFlow(:,:) =0._r8 - rtmCTL%domRest(:,:) =0._r8 + end subroutine RunoffInit