From 2ba70f34652878d822b018c5554b06b14e106513 Mon Sep 17 00:00:00 2001 From: Robert Arthur Date: Thu, 4 Feb 2021 17:41:18 -0800 Subject: [PATCH 1/3] Added rhoavg calculation to cal_titau subroutines. --- dyn_em/module_diffusion_em.F | 39 +++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index 0c98282352..45bc7a5e8f 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -5505,7 +5505,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & :: i, j, k, ktf, i_start, i_end, j_start, j_end REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg + :: xkxavg, rhoavg ! End declarations. !----------------------------------------------------------------------- @@ -5538,10 +5538,11 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & DO j = j_start, j_end DO k = kts, ktf DO i = i_start, i_end - xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + & + rhoavg(i,k,j) = 0.25 * ( rho(i-1,k,j ) + rho(i,k,j ) + & + rho(i-1,k,j-1) + rho(i,k,j-1) ) + xkxavg(i,k,j) = rhoavg(i,k,j) * & + 0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + & xkx(i-1,k,j-1) + xkx(i,k,j-1) ) - xkxavg(i,k,j) = xkxavg(i,k,j) * .25 * ( rho(i-1,k,j ) + rho(i,k,j ) + & - rho(i-1,k,j-1) + rho(i,k,j-1) ) END DO END DO END DO @@ -5554,7 +5555,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & DO k = kts, ktf DO i = i_start, i_end - titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) + titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j) END DO END DO @@ -5568,7 +5569,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & DO k = kts, ktf DO i = i_start, i_end titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j) END DO END DO @@ -5650,7 +5651,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & :: i, j, k, ktf, i_start, i_end, j_start, j_end REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg + :: xkxavg, rhoavg ! End declarations. !----------------------------------------------------------------------- @@ -5683,10 +5684,11 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + & + rhoavg(i,k,j) = 0.5 * ( fnm(k) * ( rho(i-1,k ,j) + rho(i,k ,j) ) + & + fnp(k) * ( rho(i-1,k-1,j) + rho(i,k-1,j) ) ) + xkxavg(i,k,j) = rhoavg(i,k,j) * & + 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + & fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) ) - xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i-1,k ,j) + rho(i,k ,j) ) + & - fnp(k) * ( rho(i-1,k-1,j) + rho(i,k-1,j) ) ) END DO END DO END DO @@ -5696,7 +5698,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) + titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j) ENDDO ENDDO ENDDO @@ -5710,7 +5712,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & DO i = i_start, i_end titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j) ENDDO ENDDO @@ -5799,7 +5801,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & :: i, j, k, ktf, i_start, i_end, j_start, j_end REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg + :: xkxavg, rhoavg ! End declarations. !----------------------------------------------------------------------- @@ -5832,10 +5834,11 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + & + rhoavg(i,k,j) = 0.5 * ( fnm(k) * ( rho(i,k ,j) + rho(i,k ,j-1) ) + & + fnp(k) * ( rho(i,k-1,j) + rho(i,k-1,j-1) ) ) + xkxavg(i,k,j) = rhoavg(i,k,j) * & + 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + & fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) ) - xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i,k ,j) + rho(i,k ,j-1) ) + & - fnp(k) * ( rho(i,k-1,j) + rho(i,k-1,j-1) ) ) END DO END DO END DO @@ -5846,7 +5849,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & DO k = kts+1, ktf DO i = i_start, i_end - titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) + titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j) END DO END DO @@ -5861,7 +5864,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & DO i = i_start, i_end titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j) END DO END DO From 9f87a57aea53216f99c984385b57bbc9c1f5dbd5 Mon Sep 17 00:00:00 2001 From: Robert Arthur Date: Fri, 5 Feb 2021 10:32:15 -0800 Subject: [PATCH 2/3] Added rho to HALO_EM_A and PERIOD_BDY_EM_A. --- Registry/Registry.EM_COMMON | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index aa8c9b3651..8ea728e6d4 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -3165,7 +3165,7 @@ halo HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,qv_diabatic,qc_diabatic,msftx,m halo HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar,tracer halo HALO_EM_INIT_6 dyn_em 48:om_tmp,om_s,om_u,om_v,om_depth,om_tini,om_sini,om_lat,om_lon,om_ml halo HALO_EM_VINTERP_UV_1 dyn_em 48:pd_gc,pb,pmaxw,ptrop,pmaxwnn,ptropnn -halo HALO_EM_A dyn_em 8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut +halo HALO_EM_A dyn_em 8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut,rho halo HALO_EM_PHYS_A dyn_em 4:u_2,v_2 halo HALO_EM_PHYS_PBL dyn_em 4:rublten,rvblten halo HALO_EM_PHYS_CU dyn_em 4:rucuten,rvcuten @@ -3279,7 +3279,7 @@ period PERIOD_BDY_EM_TKE_OLD dyn_em 4:tke_1 period PERIOD_BDY_EM_E dyn_em 2:u_2,v_2,ht period PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2 -period PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al +period PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al,rho period PERIOD_BDY_EM_A1 dyn_em 3:rdzw,rdz,z,zx,zy,ustm,ust period PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,rucuten,rvcuten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2,rho,gamu,gamv,xkmv_meso period PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten From 1d392d02d564a237c711864f401d8746ff14b8af Mon Sep 17 00:00:00 2001 From: Robert Arthur Date: Fri, 5 Feb 2021 11:18:30 -0800 Subject: [PATCH 3/3] Added new call to set_physical_bc3d for rho, after HALO_EM_A and PERIOD_BDY_EM_A in solve_em. --- dyn_em/solve_em.F | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 6e31ee1ab5..856ecaf131 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -671,6 +671,13 @@ SUBROUTINE solve_em ( grid , config_flags & grid%i_start(ij), grid%i_end(ij), & grid%j_start(ij), grid%j_end(ij), & k_start, k_end ) + CALL set_physical_bc3d( grid%rho, 'p', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) CALL set_physical_bc3d( grid%al, 'p', config_flags, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, &