From 77f4fbad9311ad406c6486ad0912069de3085f07 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 14 Nov 2019 13:40:59 -0700 Subject: [PATCH 1/5] implement FA scheme water loading option if nwat =4 --- model/fv_sg.F90 | 72 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/model/fv_sg.F90 b/model/fv_sg.F90 index 594e54873..0aa3edd8e 100644 --- a/model/fv_sg.F90 +++ b/model/fv_sg.F90 @@ -299,6 +299,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat==4 ) then do i=is,ie +#ifndef ccpp q_liq = q0(i,k,liq_wat) + q0(i,k,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,k,sphum)+q_liq))*cp_air*vicpqd(q0(i,k,:)) + q0(i,k,sphum)*cp_vapor + q_liq*c_liq @@ -306,6 +307,20 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & #else cpm(i) = (1.-(q0(i,k,sphum)+q_liq))*cp_air + q0(i,k,sphum)*cp_vapor + q_liq*c_liq cvm(i) = (1.-(q0(i,k,sphum)+q_liq))*cv_air + q0(i,k,sphum)*cv_vap + q_liq*c_liq +#endif + +#else + q_liq = q0(i,k,liq_wat) + q0(i,k,rainwat) + q_sol = q0(i,k,ice_wat) +#ifdef MULTI_GASES + cpm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cp_air*vicpqd(q0(i,k,:)) + q0(i,k,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cv_air*vicvqd(q0(i,k,:)) + q0(i,k,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#else + cpm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cp_air + q0(i,k,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cv_air + q0(i,k,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#endif + + #endif enddo elseif ( nwat==5 ) then @@ -382,7 +397,11 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==4 ) then do k=1,kbot do i=is,ie +#ifndef ccpp qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) +#else + qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) + q0(i,k,ice_wat) +#endif enddo enddo elseif ( nwat==5 ) then @@ -451,7 +470,12 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==3 ) then ! AM3/AM4 qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) elseif ( nwat==4 ) then ! K_warm_rain scheme with fake ice +#ifndef ccpp qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) +#else + qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) + & + q0(i,km1,rainwat) +#endif elseif ( nwat==5 ) then ! K_warm_rain scheme with fake ice qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) + & q0(i,km1,snowwat) + q0(i,km1,rainwat) @@ -572,6 +596,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat == 4 ) then do i=is,ie +#ifndef ccpp q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq @@ -579,6 +604,19 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & #else cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq cvm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cv_air + q0(i,kk,sphum)*cv_vap + q_liq*c_liq +#endif +#else + q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) + q_sol = q0(i,kk,ice_wat) +#ifdef MULTI_GASES + cpm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cv_air*vicvqd(q0(i,kk,:)) + q0(i,kk,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#else + cpm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cp_air + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cv_air + q0(i,kk,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#endif + + #endif enddo elseif ( nwat == 5 ) then @@ -850,6 +888,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat==4 ) then do i=is,ie +#ifndef CCPP q_liq = q0(i,k,liq_wat) + q0(i,k,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,k,sphum)+q_liq))*cp_air*vicpqd(q0(i,k,:)) + q0(i,k,sphum)*cp_vapor + q_liq*c_liq @@ -857,6 +896,18 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & #else cpm(i) = (1.-(q0(i,k,sphum)+q_liq))*cp_air + q0(i,k,sphum)*cp_vapor + q_liq*c_liq cvm(i) = (1.-(q0(i,k,sphum)+q_liq))*cv_air + q0(i,k,sphum)*cv_vap + q_liq*c_liq +#endif +#else + q_liq = q0(i,k,liq_wat) + q0(i,k,rainwat) + q_sol = q0(i,k,ice_wat) +#ifdef MULTI_GASES + cpm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cp_air*vicpqd(q0(i,k,:)) + q0(i,k,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cv_air*vicvqd(q0(i,k,:)) + q0(i,k,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#else + cpm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cp_air + q0(i,k,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,k,sphum)+q_liq+q_sol))*cv_air + q0(i,k,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#endif + #endif enddo elseif ( nwat==5 ) then @@ -933,7 +984,11 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==4 ) then do k=1,kbot do i=is,ie +#ifndef ccpp qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) +#else + qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) + q0(i,k,ice_wat) +#endif enddo enddo elseif ( nwat==5 ) then @@ -998,7 +1053,11 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==3 ) then ! AM3/AM4 qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) elseif ( nwat==4 ) then ! K_warm_rain scheme with fake ice +#ifndef ccpp qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) +#else + qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) + q0(i,km1,ice_wat) +#endif elseif ( nwat==5 ) then qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) + & q0(i,km1,snowwat) + q0(i,km1,rainwat) @@ -1118,6 +1177,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat == 4 ) then do i=is,ie +#ifndef ccpp q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq @@ -1125,6 +1185,18 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & #else cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq cvm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cv_air + q0(i,kk,sphum)*cv_vap + q_liq*c_liq +#endif +#else + q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) + q_sol = q0(i,kk,ice_wat) +#ifdef MULTI_GASES + cpm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cv_air*vicvqd(q0(i,kk,:)) + q0(i,kk,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#else + cpm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cp_air + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq + q_sol*c_ice + cvm(i) = (1.-(q0(i,kk,sphum)+q_liq+q_sol))*cv_air + q0(i,kk,sphum)*cv_vap + q_liq*c_liq + q_sol*c_ice +#endif + #endif enddo elseif ( nwat == 5 ) then From f8a257a922a9047e98c176affec054e2a4d9c6a9 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 14 Nov 2019 19:12:39 -0700 Subject: [PATCH 2/5] use upper-case CCPP --- model/fv_sg.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/model/fv_sg.F90 b/model/fv_sg.F90 index 0aa3edd8e..a88cfdfe1 100644 --- a/model/fv_sg.F90 +++ b/model/fv_sg.F90 @@ -299,7 +299,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat==4 ) then do i=is,ie -#ifndef ccpp +#ifndef CCPP q_liq = q0(i,k,liq_wat) + q0(i,k,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,k,sphum)+q_liq))*cp_air*vicpqd(q0(i,k,:)) + q0(i,k,sphum)*cp_vapor + q_liq*c_liq @@ -397,7 +397,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==4 ) then do k=1,kbot do i=is,ie -#ifndef ccpp +#ifndef CCPP qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) #else qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) + q0(i,k,ice_wat) @@ -470,7 +470,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==3 ) then ! AM3/AM4 qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) elseif ( nwat==4 ) then ! K_warm_rain scheme with fake ice -#ifndef ccpp +#ifndef CCPP qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) #else qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) + & @@ -596,7 +596,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat == 4 ) then do i=is,ie -#ifndef ccpp +#ifndef CCPP q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq @@ -984,7 +984,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==4 ) then do k=1,kbot do i=is,ie -#ifndef ccpp +#ifndef CCPP qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) #else qcon(i,k) = q0(i,k,liq_wat) + q0(i,k,rainwat) + q0(i,k,ice_wat) @@ -1053,7 +1053,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & elseif ( nwat==3 ) then ! AM3/AM4 qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,ice_wat) elseif ( nwat==4 ) then ! K_warm_rain scheme with fake ice -#ifndef ccpp +#ifndef CCPP qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) #else qcon(i,km1) = q0(i,km1,liq_wat) + q0(i,km1,rainwat) + q0(i,km1,ice_wat) @@ -1177,7 +1177,7 @@ subroutine fv_subgrid_z( isd, ied, jsd, jed, is, ie, js, je, km, nq, dt, & enddo elseif ( nwat == 4 ) then do i=is,ie -#ifndef ccpp +#ifndef CCPP q_liq = q0(i,kk,liq_wat) + q0(i,kk,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(q0(i,kk,sphum)+q_liq))*cp_air*vicpqd(q0(i,kk,:)) + q0(i,kk,sphum)*cp_vapor + q_liq*c_liq From 8805acd93152bb76d5c4d0900f314631f549fbe2 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 19 Nov 2019 14:16:22 -0700 Subject: [PATCH 3/5] From Chunxi: The file fv_mapz.F90 also needs to be modified (K_warm) --- model/fv_mapz.F90 | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/model/fv_mapz.F90 b/model/fv_mapz.F90 index 4994538b9..0e49f9fe1 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -3465,12 +3465,26 @@ subroutine moist_cv(is,ie, isd,ied, jsd,jed, km, j, k, nwat, sphum, liq_wat, rai enddo case(4) ! K_warm_rain with fake ice do i=is,ie +#ifndef CCPP qv(i) = q(i,j,k,sphum) qd(i) = q(i,j,k,liq_wat) + q(i,j,k,rainwat) #ifdef MULTI_GASES cvm(i) = (1.-(qv(i)+qd(i)))*cv_air*vicvqd(q(i,j,k,1:num_gas)) + qv(i)*cv_vap + qd(i)*c_liq #else cvm(i) = (1.-(qv(i)+qd(i)))*cv_air + qv(i)*cv_vap + qd(i)*c_liq +#endif +#else +#else + qv(i) = q(i,j,k,sphum) + ql(i) = q(i,j,k,liq_wat) + q(i,j,k,rainwat) + qs(i) = q(i,j,k,ice_wat) + qd(i) = ql(i) + qs(i) +#ifdef MULTI_GASES + cpm(i) = (1.-(qv(i)+qd(i)))*cp_air*vicpqd(q(i,j,k,:)) + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice +#else + cpm(i) = (1.-(qv(i)+qd(i)))*cp_air + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice +#endif + #endif enddo case(5) @@ -3574,12 +3588,26 @@ subroutine moist_cp(is,ie, isd,ied, jsd,jed, km, j, k, nwat, sphum, liq_wat, rai enddo case(4) ! K_warm_rain scheme with fake ice do i=is,ie +#ifndef CCPP qv(i) = q(i,j,k,sphum) qd(i) = q(i,j,k,liq_wat) + q(i,j,k,rainwat) #ifdef MULTI_GASES cpm(i) = (1.-(qv(i)+qd(i)))*cp_air*vicpqd(q(i,j,k,:)) + qv(i)*cp_vapor + qd(i)*c_liq #else cpm(i) = (1.-(qv(i)+qd(i)))*cp_air + qv(i)*cp_vapor + qd(i)*c_liq +#endif +#else + qv(i) = q(i,j,k,sphum) + ql(i) = q(i,j,k,liq_wat) + q(i,j,k,rainwat) + qs(i) = q(i,j,k,ice_wat) + qd(i) = ql(i) + qs(i) +#ifdef MULTI_GASES + cpm(i) = (1.-(qv(i)+qd(i)))*cp_air*vicpqd(q(i,j,k,:)) + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice +#else + cpm(i) = (1.-(qv(i)+qd(i)))*cp_air + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice +#endif + + #endif enddo case(5) From 98c58ad3d0444859aae54c31bc2b86ba30b4a9ac Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 19 Nov 2019 14:35:10 -0700 Subject: [PATCH 4/5] bug fix --- model/fv_mapz.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/model/fv_mapz.F90 b/model/fv_mapz.F90 index 0e49f9fe1..e89b7927c 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -3473,7 +3473,6 @@ subroutine moist_cv(is,ie, isd,ied, jsd,jed, km, j, k, nwat, sphum, liq_wat, rai #else cvm(i) = (1.-(qv(i)+qd(i)))*cv_air + qv(i)*cv_vap + qd(i)*c_liq #endif -#else #else qv(i) = q(i,j,k,sphum) ql(i) = q(i,j,k,liq_wat) + q(i,j,k,rainwat) From b280b373b421fcb9d84bd1196a40ec56fcf279ff Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 19 Nov 2019 14:53:57 -0700 Subject: [PATCH 5/5] bug fix --- model/fv_mapz.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model/fv_mapz.F90 b/model/fv_mapz.F90 index e89b7927c..2c72074a1 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -3479,9 +3479,9 @@ subroutine moist_cv(is,ie, isd,ied, jsd,jed, km, j, k, nwat, sphum, liq_wat, rai qs(i) = q(i,j,k,ice_wat) qd(i) = ql(i) + qs(i) #ifdef MULTI_GASES - cpm(i) = (1.-(qv(i)+qd(i)))*cp_air*vicpqd(q(i,j,k,:)) + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice + cvm(i) = (1.-(qv(i)+qd(i)))*cv_air*vicvqd(q(i,j,k,1:num_gas)) + qv(i)*cv_vap + ql(i)*c_liq + qs(i)*c_ice #else - cpm(i) = (1.-(qv(i)+qd(i)))*cp_air + qv(i)*cp_vapor + ql(i)*c_liq + qs(i)*c_ice + cvm(i) = (1.-(qv(i)+qd(i)))*cv_air + qv(i)*cv_vap + ql(i)*c_liq + qs(i)*c_ice #endif #endif