From ef3389253f68024c8a3c30cfb6a69df249ac75e5 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 15 Dec 2021 15:52:48 +0000 Subject: [PATCH] Enforce tracer column mass conservation using a vertically-integrated equation that accounts for varying air density. --- physics/samfdeepcnv.f | 28 ++++++++++++++++++++-------- physics/samfshalcnv.f | 28 ++++++++++++++++++++-------- physics/satmedmfvdifq.F | 32 ++++++++++++++++++++------------ 3 files changed, 60 insertions(+), 28 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 2f34041c2..3801e684f 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -2975,11 +2975,12 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & tsump(i) = 0. rtnp(i) = 1. enddo - do k = 1,km + do k = 1,km1 do i = 1,im if(cnvflg(i) .and. k <= ktcon(i)) then - if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + q1(i,k) - if(q1(i,k) > 0.) tsump(i) = tsump(i) + q1(i,k) + tem = q1(i,k) * delp(i,k) / grav + if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(q1(i,k) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -2994,7 +2995,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - do k = 1,km + do k = 1,km1 do i = 1,im if(cnvflg(i) .and. k <= ktcon(i)) then if(rtnp(i) < 0.) then @@ -3011,6 +3012,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo ! if (.not.hwrf_samfdeep) then + indx = ntk - 2 do n = 1, ntr ! do k = 1, km @@ -3033,11 +3035,21 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & tsump(i) = 0. rtnp(i) = 1. enddo - do k = 1,km + do k = 1,km1 do i = 1,im if(cnvflg(i) .and. k <= ktcon(i)) then - if(ctr(i,k,n) < 0.) tsumn(i) = tsumn(i) + ctr(i,k,n) - if(ctr(i,k,n) > 0.) tsump(i) = tsump(i) + ctr(i,k,n) + if(n == indx) then + if(k > 1) then + dz = zi(i,k) - zi(i,k-1) + else + dz = zi(i,k) + endif + tem = ctr(i,k,n) * dz + else + tem = ctr(i,k,n) * delp(i,k) / grav + endif + if(ctr(i,k,n) < 0.) tsumn(i) = tsumn(i) + tem + if(ctr(i,k,n) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -3052,7 +3064,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - do k = 1,km + do k = 1,km1 do i = 1,im if(cnvflg(i) .and. k <= ktcon(i)) then if(rtnp(i) < 0.) then diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 846fb30c1..0e11ed49c 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -1922,12 +1922,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & tsump(i) = 0. rtnp(i) = 1. enddo - do k = 1,km + do k = 1,km1 do i = 1,im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then - if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + q1(i,k) - if(q1(i,k) > 0.) tsump(i) = tsump(i) + q1(i,k) + tem = q1(i,k) * delp(i,k) / grav + if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(q1(i,k) > 0.) tsump(i) = tsump(i) + tem endif endif enddo @@ -1943,7 +1944,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - do k = 1,km + do k = 1,km1 do i = 1,im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then @@ -1963,6 +1964,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! if (.not.hwrf_samfshal) then ! + indx = ntk - 2 do n = 1, ntr ! do k = 1, km @@ -1985,12 +1987,22 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & tsump(i) = 0. rtnp(i) = 1. enddo - do k = 1,km + do k = 1,km1 do i = 1,im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then - if(ctr(i,k,n) < 0.) tsumn(i) = tsumn(i) + ctr(i,k,n) - if(ctr(i,k,n) > 0.) tsump(i) = tsump(i) + ctr(i,k,n) + if(n == indx) then + if(k > 1) then + dz = zi(i,k) - zi(i,k-1) + else + dz = zi(i,k) + endif + tem = ctr(i,k,n) * dz + else + tem = ctr(i,k,n) * delp(i,k) / grav + endif + if(ctr(i,k,n) < 0.) tsumn(i) = tsumn(i) + tem + if(ctr(i,k,n) > 0.) tsump(i) = tsump(i) + tem endif endif enddo @@ -2006,7 +2018,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif endif enddo - do k = 1,km + do k = 1,km1 do i = 1,im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 6e0c1bd80..be54675b0 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1515,8 +1515,10 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & endif if((pcnvflg(i) .or. scuflg(i)) .and. & (k >= kbx .and. k <= kmx)) then - if(f1(i,k) < 0.) tsumn(i) = tsumn(i) + f1(i,k) - if(f1(i,k) > 0.) tsump(i) = tsump(i) + f1(i,k) + dz = zi(i,k+1) - zi(i,k) + tem = f1(i,k) * dz + if(f1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(f1(i,k) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -1569,8 +1571,10 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & enddo do k = 1,km do i = 1,im - if(f1(i,k) < 0.) tsumn(i) = tsumn(i) + f1(i,k) - if(f1(i,k) > 0.) tsump(i) = tsump(i) + f1(i,k) + dz = zi(i,k+1) - zi(i,k) + tem = f1(i,k) * dz + if(f1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(f1(i,k) > 0.) tsump(i) = tsump(i) + tem enddo enddo do i = 1,im @@ -1760,8 +1764,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & endif if((pcnvflg(i) .or. scuflg(i)) .and. & (k >= kbx .and. k <= kmx)) then - if(f2(i,k) < 0.) tsumn(i) = tsumn(i) + f2(i,k) - if(f2(i,k) > 0.) tsump(i) = tsump(i) + f2(i,k) + tem = f2(i,k) * del(i,k) / grav + if(f2(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(f2(i,k) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -1815,8 +1820,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & enddo do k = 1,km do i = 1,im - if(f2(i,k) < 0.) tsumn(i) = tsumn(i) + f2(i,k) - if(f2(i,k) > 0.) tsump(i) = tsump(i) + f2(i,k) + tem = f2(i,k) * del(i,k) / grav + if(f2(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(f2(i,k) > 0.) tsump(i) = tsump(i) + tem enddo enddo do i = 1,im @@ -1943,8 +1949,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & endif if((pcnvflg(i) .or. scuflg(i)) .and. & (k >= kbx .and. k <= kmx)) then - if(f2(i,k+is) < 0.) tsumn(i) = tsumn(i) + f2(i,k+is) - if(f2(i,k+is) > 0.) tsump(i) = tsump(i) + f2(i,k+is) + tem = f2(i,k+is) * del(i,k) / grav + if(f2(i,k+is) < 0.) tsumn(i) = tsumn(i) + tem + if(f2(i,k+is) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -1998,8 +2005,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw,ntiw,ntke, & enddo do k = 1,km do i = 1,im - if(f2(i,k+is) < 0.) tsumn(i) = tsumn(i) + f2(i,k+is) - if(f2(i,k+is) > 0.) tsump(i) = tsump(i) + f2(i,k+is) + tem = f2(i,k+is) * del(i,k) / grav + if(f2(i,k+is) < 0.) tsumn(i) = tsumn(i) + tem + if(f2(i,k+is) > 0.) tsump(i) = tsump(i) + tem enddo enddo do i = 1,im