Skip to content

Commit 2ba70f3

Browse files
rsarthurrsarthur
committed
Added rhoavg calculation to cal_titau subroutines.
1 parent 2036c2a commit 2ba70f3

File tree

1 file changed

+21
-18
lines changed

1 file changed

+21
-18
lines changed

‎dyn_em/module_diffusion_em.F‎

Lines changed: 21 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -5505,7 +5505,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, &
55055505
:: i, j, k, ktf, i_start, i_end, j_start, j_end
55065506
55075507
REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) &
5508-
:: xkxavg
5508+
:: xkxavg, rhoavg
55095509
55105510
! End declarations.
55115511
!-----------------------------------------------------------------------
@@ -5538,10 +5538,11 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, &
55385538
DO j = j_start, j_end
55395539
DO k = kts, ktf
55405540
DO i = i_start, i_end
5541-
xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + &
5541+
rhoavg(i,k,j) = 0.25 * ( rho(i-1,k,j ) + rho(i,k,j ) + &
5542+
rho(i-1,k,j-1) + rho(i,k,j-1) )
5543+
xkxavg(i,k,j) = rhoavg(i,k,j) * &
5544+
0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + &
55425545
xkx(i-1,k,j-1) + xkx(i,k,j-1) )
5543-
xkxavg(i,k,j) = xkxavg(i,k,j) * .25 * ( rho(i-1,k,j ) + rho(i,k,j ) + &
5544-
rho(i-1,k,j-1) + rho(i,k,j-1) )
55455546
END DO
55465547
END DO
55475548
END DO
@@ -5554,7 +5555,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, &
55545555
DO k = kts, ktf
55555556
DO i = i_start, i_end
55565557
5557-
titau(i,k,j) = rho(i,k,j) * mtau(i,k,j)
5558+
titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j)
55585559
55595560
END DO
55605561
END DO
@@ -5568,7 +5569,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, &
55685569
DO k = kts, ktf
55695570
DO i = i_start, i_end
55705571
titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
5571-
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j)
5572+
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j)
55725573
55735574
END DO
55745575
END DO
@@ -5650,7 +5651,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, &
56505651
:: i, j, k, ktf, i_start, i_end, j_start, j_end
56515652
56525653
REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) &
5653-
:: xkxavg
5654+
:: xkxavg, rhoavg
56545655
56555656
! End declarations.
56565657
!-----------------------------------------------------------------------
@@ -5683,10 +5684,11 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, &
56835684
DO j = j_start, j_end
56845685
DO k = kts+1, ktf
56855686
DO i = i_start, i_end
5686-
xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + &
5687+
rhoavg(i,k,j) = 0.5 * ( fnm(k) * ( rho(i-1,k ,j) + rho(i,k ,j) ) + &
5688+
fnp(k) * ( rho(i-1,k-1,j) + rho(i,k-1,j) ) )
5689+
xkxavg(i,k,j) = rhoavg(i,k,j) * &
5690+
0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + &
56875691
fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) )
5688-
xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i-1,k ,j) + rho(i,k ,j) ) + &
5689-
fnp(k) * ( rho(i-1,k-1,j) + rho(i,k-1,j) ) )
56905692
END DO
56915693
END DO
56925694
END DO
@@ -5696,7 +5698,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, &
56965698
DO j = j_start, j_end
56975699
DO k = kts+1, ktf
56985700
DO i = i_start, i_end
5699-
titau(i,k,j) = rho(i,k,j) * mtau(i,k,j)
5701+
titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j)
57005702
ENDDO
57015703
ENDDO
57025704
ENDDO
@@ -5710,7 +5712,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, &
57105712
DO i = i_start, i_end
57115713
57125714
titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
5713-
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j)
5715+
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j)
57145716
57155717
ENDDO
57165718
ENDDO
@@ -5799,7 +5801,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, &
57995801
:: i, j, k, ktf, i_start, i_end, j_start, j_end
58005802
58015803
REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) &
5802-
:: xkxavg
5804+
:: xkxavg, rhoavg
58035805
58045806
! End declarations.
58055807
!-----------------------------------------------------------------------
@@ -5832,10 +5834,11 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, &
58325834
DO j = j_start, j_end
58335835
DO k = kts+1, ktf
58345836
DO i = i_start, i_end
5835-
xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + &
5837+
rhoavg(i,k,j) = 0.5 * ( fnm(k) * ( rho(i,k ,j) + rho(i,k ,j-1) ) + &
5838+
fnp(k) * ( rho(i,k-1,j) + rho(i,k-1,j-1) ) )
5839+
xkxavg(i,k,j) = rhoavg(i,k,j) * &
5840+
0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + &
58365841
fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) )
5837-
xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i,k ,j) + rho(i,k ,j-1) ) + &
5838-
fnp(k) * ( rho(i,k-1,j) + rho(i,k-1,j-1) ) )
58395842
END DO
58405843
END DO
58415844
END DO
@@ -5846,7 +5849,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, &
58465849
DO k = kts+1, ktf
58475850
DO i = i_start, i_end
58485851
5849-
titau(i,k,j) = rho(i,k,j) * mtau(i,k,j)
5852+
titau(i,k,j) = rhoavg(i,k,j) * mtau(i,k,j)
58505853
58515854
END DO
58525855
END DO
@@ -5861,7 +5864,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, &
58615864
DO i = i_start, i_end
58625865
58635866
titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
5864-
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j)
5867+
mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rhoavg(i,k,j)
58655868
58665869
END DO
58675870
END DO

0 commit comments

Comments
 (0)