From f963d52ea4bce3ae356f034d8d0e9cd4780c228a Mon Sep 17 00:00:00 2001 From: "Joseph.Mouallem" Date: Wed, 4 Oct 2023 13:48:20 -0400 Subject: [PATCH] fix gz dimension to remap v --- model/fv_mapz.F90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/model/fv_mapz.F90 b/model/fv_mapz.F90 index bdaac733c..8952d23f8 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -155,7 +155,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & real, dimension(is:ie,km+1):: pe1, pe2, pk1, pk2, pn2, phis real, dimension(isd:ied,jsd:jed,km):: pe4 real, dimension(is:ie+1,km+1):: pe0, pe3 - real, dimension(is:ie):: gz, cvm + real, dimension(is:ie+1):: gz, cvm real, dimension(isd:ied,jsd:jed,km):: qnl, qni real rcp, rg, rrg, bkh, dtmp, k1k, dlnp, tpe @@ -220,7 +220,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & do k=1,km #ifdef MOIST_CAPPA call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + ice_wat, snowwat, graupel, q, gz(is:ie), cvm(is:ie)) do i=is,ie q_con(i,j,k) = gz(i) cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) @@ -272,7 +272,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & enddo #ifdef MOIST_CAPPA call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + ice_wat, snowwat, graupel, q, gz(is:ie), cvm(is:ie)) do i=is,ie q_con(i,j,k) = gz(i) cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) @@ -366,7 +366,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & km, pe2, te, & is, ie, j, isd, ied, jsd, jed, akap, T_VAR=1, conserv=.true.) else - call map_scalar(km, peln(is,1,j), te, gz, & + call map_scalar(km, peln(is,1,j), te, gz(is:ie), & km, pn2, te, & is, ie, j, isd, ied, jsd, jed, 1, abs(kord_tm), cp_air*t_min) endif @@ -374,13 +374,13 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & else if ( kord_tm<0 ) then ! Map t using logp - call map_scalar(km, peln(is,1,j), pt, gz, & + call map_scalar(km, peln(is,1,j), pt, gz(is:ie), & km, pn2, pt, & is, ie, j, isd, ied, jsd, jed, & 1, abs(kord_tm), t_min) else ! Map pt using pe - call map1_ppm (km, pe1, pt, gz, & + call map1_ppm (km, pe1, pt, gz(is:ie), & km, pe2, pt, & is, ie, j, isd, ied, jsd, jed, & 1, abs(kord_tm)) @@ -423,7 +423,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & -2, abs(kord_wz)) endif ! Remap delz for hybrid sigma-p coordinate - call map1_ppm (km, pe1, delz, gz, & ! works + call map1_ppm (km, pe1, delz, gz(is:ie), & ! works km, pe2, delz, & is, ie, j, is, ie, js, je, & 1, abs(kord_tm)) @@ -527,8 +527,8 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & ! Note: pt at this stage is T_v or T_m , unless kord_tm > 0 do k=1,km #ifdef MOIST_CAPPA - call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + call moist_cv(is,ie+1,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & + ice_wat, snowwat, graupel, q, gz(is:ie+1), cvm(is:ie+1)) if ( kord_tm < 0 ) then do i=is,ie q_con(i,j,k) = gz(i) @@ -613,7 +613,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & enddo enddo - call map1_ppm( km, pe0(is:ie,:), u, gz, & + call map1_ppm( km, pe0(is:ie,:), u, gz(is:ie), & km, pe3(is:ie,:), u, & is, ie, j, isd, ied, jsd, jed+1, & -1, kord_mt) @@ -634,7 +634,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & enddo enddo - call map1_ppm (km, pe0, v, gz, & + call map1_ppm (km, pe0, v, gz(is:ie+1), & km, pe3, v, is, ie+1, & j, isd, ied+1, jsd, jed, -1, kord_mt) @@ -660,7 +660,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & do k=km,1,-1 #ifdef MOIST_CAPPA call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + ice_wat, snowwat, graupel, q, gz(is:ie), cvm(is:ie)) do i=is,ie q_con(i,j,k) = gz(i) cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) @@ -759,7 +759,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & do k=1,km #ifdef USE_COND call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + ice_wat, snowwat, graupel, q, gz(is:ie), cvm(is:ie)) do i=is,ie ! KE using 3D winds: q_con(i,j,k) = gz(i) @@ -870,7 +870,7 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk, & else #ifdef USE_COND call moist_cv(is,ie,isd,ied,jsd,jed, km, j, k, nwat, sphum, liq_wat, rainwat, & - ice_wat, snowwat, graupel, q, gz, cvm) + ice_wat, snowwat, graupel, q, gz(is:ie), cvm(is:ie)) do i=is,ie pt(i,j,k) = (pt(i,j,k)+dtmp/cvm(i)*pkz(i,j,k))/((1.+r_vir*q(i,j,k,sphum))*(1.-gz(i))) enddo