Commit 419dbcc2 authored by Heng Xiao's avatar Heng Xiao
Browse files

bug fixes in several places:

     (1) dyn_em/module_big_step_utilities_em.F
         moist_old now initialized before used in theta_to_thetam
     (2) dyn_em/module_initialize_les.F
         turned off USER_DEFINED_ETA_LEVELS by default
     (3) external/RSL_LITE/module_dm.F
         the calculation of "locbuf" size in wrf_patch_to_global_generic when calling just_patch_*s
     (4) frame/module_statistics.F
         further cleaning up
parent 6db1397e
......@@ -6280,26 +6280,20 @@ SUBROUTINE theta_to_thetam ( t_1 , moist_old , &
INTEGER :: i , j , k
! First time step, there is no OLD moisture.
IF ( ( itimestep .EQ. 1 ) .AND. ( rk_step .EQ. 1 ) ) THEN
IF ( rk_step .EQ. 1 ) THEN
DO j = jts , MIN(jte,jde-1)
DO k = kts , kte-1
DO i = its , MIN(ite,ide-1)
! We need to initialize moist_old here for the first RK step at every time step
! (not just the first time step). It should be OK. Later in the first RK step rk_update_scalar
! would do the same assignment to moist_old. - Heng Xiao 10-08-2015
moist_old(i,k,j) = moist(i,k,j)
END DO
END DO
END DO
END IF
! First RK loop, this info is from the physics packages. It is modified immediately after the
! call to the physics schemes, and the remains constant for the remainder of the RK loops.
IF ( rk_step .EQ. 1 ) THEN
DO j = jts , MIN(jte,jde-1)
DO k = kts , kte-1
DO i = its , MIN(ite,ide-1)
t_tendf(i,k,j) = (1. + (R_v/R_d) * moist_old(i,k,j))*t_tendf(i,k,j) + (R_v/R_d)*(t_1(i,k,j)+T0)*moist_tend(i,k,j)
t_tendf(i,k,j) = (1. + (R_v/R_d) * moist_old(i,k,j))*t_tendf(i,k,j) &
+ (R_v/R_d)*(t_1(i,k,j)+T0)*moist_tend(i,k,j)
h_diabatic(i,k,j) = (1. + (R_v/R_d) * moist_old(i,k,j))*h_diabatic(i,k,j)
END DO
END DO
......
!IDEAL:MODEL_LAYER:INITIALIZATION
#define USER_DEFINED_VERTICAL_GRID
!#define USER_DEFINED_VERTICAL_GRID
!#define LESFIX
!
......
......@@ -2858,19 +2858,19 @@ END
Patch(3,1) = ps3 ; Patch(3,2) = pe3
IF ( typesize .EQ. RWORDSIZE ) THEN
CALL just_patch_r ( buf , locbuf , size(locbuf), &
CALL just_patch_r ( buf , locbuf , size(locbuf)*RWORDSIZE/typesize, &
PS1, PE1, PS2, PE2, PS3, PE3 , &
MS1, ME1, MS2, ME2, MS3, ME3 )
ELSE IF ( typesize .EQ. IWORDSIZE ) THEN
CALL just_patch_i ( buf , locbuf , size(locbuf), &
CALL just_patch_i ( buf , locbuf , size(locbuf)*RWORDSIZE/typesize, &
PS1, PE1, PS2, PE2, PS3, PE3 , &
MS1, ME1, MS2, ME2, MS3, ME3 )
ELSE IF ( typesize .EQ. DWORDSIZE ) THEN
CALL just_patch_d ( buf , locbuf , size(locbuf), &
CALL just_patch_d ( buf , locbuf , size(locbuf)*RWORDSIZE/typesize, &
PS1, PE1, PS2, PE2, PS3, PE3 , &
MS1, ME1, MS2, ME2, MS3, ME3 )
ELSE IF ( typesize .EQ. LWORDSIZE ) THEN
CALL just_patch_l ( buf , locbuf , size(locbuf), &
CALL just_patch_l ( buf , locbuf , size(locbuf)*RWORDSIZE/typesize, &
PS1, PE1, PS2, PE2, PS3, PE3 , &
MS1, ME1, MS2, ME2, MS3, ME3 )
ENDIF
......
......@@ -314,7 +314,7 @@ MODULE module_statistics
DO k = 1, nzm
zs(k) = 0.5 * ( grid%phb(ips,k,jps) + grid%phb(ips,k+1,jps) ) / g
ENDDO
DO k = 1, nz
DO k = 1, nzm
press(k) = grid%pb(ips,k,jps)
ENDDO
press(:) = 0.01 * press(:) ! Pa ==> mb
......@@ -1263,7 +1263,8 @@ MODULE module_statistics
INTEGER, DIMENSION(nx,ny) :: topind
REAL, DIMENSION(nx,ny) :: cwp, cwpl, cwpm, cwph, lwp, iwp
REAL :: cwpmax
REAL, DIMENSION(nzm) :: tzp1, tzp2, tzp3, tzp4, tzp5
nbuffer = nzsh*nbufzsh + nzm*nbufzs + nbufs
factor_xy = 1. / REAL(nx*ny)
factor_n = 1. / REAL(nsubdomains)
......@@ -1303,9 +1304,10 @@ MODULE module_statistics
DO i = 0, nx ! 0 for U
! eta ==> zs
khunt = 0
tzp1=zs_eta(i,1:nzm,j)
DO k = 1, nzm
! S
CALL find_indices( zs(k), zs_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp1, nzm, &
km1s(i,k,j), k00s(i,k,j), kp1s(i,k,j), kp2s(i,k,j), khunt )
ENDDO
ENDDO
......@@ -1318,21 +1320,26 @@ MODULE module_statistics
khunt3 = 0
khunt4 = 0
khunt5 = 0
tzp1=zw_eta(i,1:nzm,j)
tzp2=zu_eta(i,1:nzm,j)
tzp3=zv_eta(i,1:nzm,j)
tzp4=zuw_eta(i,1:nzm,j)
tzp5=zvw_eta(i,1:nzm,j)
DO k = 1, nzm
! W
CALL find_indices( zs(k), zw_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp1, nzm, &
km1w(i,k,j), k00w(i,k,j), kp1w(i,k,j), kp2w(i,k,j), khunt1 )
! U
CALL find_indices( zs(k), zu_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp2, nzm, &
km1u(i,k,j), k00u(i,k,j), kp1u(i,k,j), kp2u(i,k,j), khunt2 )
! V
CALL find_indices( zs(k), zv_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp3, nzm, &
km1v(i,k,j), k00v(i,k,j), kp1v(i,k,j), kp2v(i,k,j), khunt3 )
! UW
CALL find_indices( zs(k), zuw_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp4, nzm, &
km1uw(i,k,j), k00uw(i,k,j), kp1uw(i,k,j), kp2uw(i,k,j), khunt4 )
! VW
CALL find_indices( zs(k), zvw_eta(i,1:nzm,j), nzm, &
CALL find_indices( zs(k), tzp5, nzm, &
km1vw(i,k,j), k00vw(i,k,j), kp1vw(i,k,j), kp2vw(i,k,j), khunt5 )
ENDDO
ENDDO
......@@ -1374,9 +1381,10 @@ MODULE module_statistics
DO j = 0, ny ! VW
DO i = 0, nx ! UW
khunt = 0
tzp1=zs_eta(i,1:nzm,j)
DO k = 1, nzm ! The k loop has to be the most inner loop for find_indices
! S ==> W
CALL find_indices( zw_eta(i,k,j), zs_eta(i,1:nzm,j), nzm, &
CALL find_indices( zw_eta(i,k,j), tzp1, nzm, &
km1s2w(i,k,j), k00s2w(i,k,j), kp1s2w(i,k,j), kp2s2w(i,k,j), khunt )
ENDDO
ENDDO
......@@ -1611,8 +1619,9 @@ MODULE module_statistics
DO j = 0, ny ! 0 for V
DO i = 0, nx ! 0 for U
khunt = 0
tzp1=zs_eta(i,1:nzm,j)
DO k = 1, nzsh ! The k loop has to be the most inner loop for find_indices
CALL find_indices( zsh(k), zs_eta(i,1:nzm,j), nzm, km1, k00, kp1, kp2, khunt )
CALL find_indices( zsh(k), tzp1, nzm, km1, k00, kp1, kp2, khunt )
mweight0(i,k,j) = mono_cubic_interp( zsh(k), km1, k00, kp1, kp2, &
zs_eta(i,km1,j), zs_eta(i,k00,j), zs_eta(i,kp1,j), zs_eta(i,kp2,j), &
rhom_eta(i,km1,j), rhom_eta(i,k00,j), rhom_eta(i,kp1,j), rhom_eta(i,kp2,j) )
......@@ -1644,15 +1653,17 @@ MODULE module_statistics
DO i = 1, nx
khunt1 = 0
khunt2 = 0
tzp1=zu_eta(i,1:nzm,j)
tzp2=zv_eta(i,1:nzm,j)
DO k = 1, nzsh ! The k loop has to be the most inner loop for find_indices
! U
CALL find_indices( zsh(k), zu_eta(i,1:nzm,j), nzm, km1, k00, kp1, kp2, khunt1 )
CALL find_indices( zsh(k), tzp1, nzm, km1, k00, kp1, kp2, khunt1 )
u0(k) = u0(k) + mono_cubic_interp( zsh(k), km1, k00, kp1, kp2, &
zu_eta(i,km1,j), zu_eta(i,k00,j), zu_eta(i,kp1,j), zu_eta(i,kp2,j), &
u_eta(i,km1,j), u_eta(i,k00,j), u_eta(i,kp1,j), u_eta(i,kp2,j) ) &
* 0.5 * ( mweight0(i-1,k,j) + mweight0(i,k,j) )
! V
CALL find_indices( zsh(k), zv_eta(i,1:nzm,j), nzm, km1, k00, kp1, kp2, khunt2 )
CALL find_indices( zsh(k), tzp2, nzm, km1, k00, kp1, kp2, khunt2 )
v0(k) = v0(k) + mono_cubic_interp( zsh(k), km1, k00, kp1, kp2, &
zv_eta(i,km1,j), zv_eta(i,k00,j), zv_eta(i,kp1,j), zv_eta(i,kp2,j), &
v_eta(i,km1,j), v_eta(i,k00,j), v_eta(i,kp1,j), v_eta(i,kp2,j) ) &
......@@ -3024,14 +3035,17 @@ MODULE module_statistics
khunt2 = 0
khunt3 = 0
khunt4 = 0
tzp1=zs_eta(i-1,1:nzm,j)
tzp2=zs_eta(i,1:nzm,j)
tzp3=zs_eta(i,1:nzm,j-1)
DO k = 1, nzm ! k loop inside for find_indices
! - u_eta dps_eta/dx
! Unit conversion from hPa to Pa later
CALL find_indices(zu_eta(i,k,j), zs_eta(i-1,1:nzm,j), nzm, km1, k00, kp1, kp2,khunt1)
CALL find_indices(zu_eta(i,k,j), tzp1, nzm, km1, k00, kp1, kp2,khunt1)
ppm1 = mono_cubic_interp( zu_eta(i,k,j), km1, k00, kp1, kp2, &
zs_eta(i-1,km1,j), zs_eta(i-1,k00,j), zs_eta(i-1,kp1,j), zs_eta(i-1,kp2,j), &
ps_eta(i-1,km1,j), ps_eta(i-1,k00,j), ps_eta(i-1,kp1,j), ps_eta(i-1,kp2,j) )
CALL find_indices(zu_eta(i,k,j), zs_eta(i,1:nzm,j), nzm, km1, k00, kp1, kp2, khunt2)
CALL find_indices(zu_eta(i,k,j), tzp2, nzm, km1, k00, kp1, kp2, khunt2)
pp00 = mono_cubic_interp( zu_eta(i,k,j), km1, k00, kp1, kp2, &
zs_eta(i,km1,j), zs_eta(i,k00,j), zs_eta(i,kp1,j), zs_eta(i,kp2,j), &
ps_eta(i,km1,j), ps_eta(i,k00,j), ps_eta(i,kp1,j), ps_eta(i,kp2,j) )
......@@ -3039,11 +3053,11 @@ MODULE module_statistics
! - v_eta dps_eta/dy
! Unit conversion from hPa to Pa later
CALL find_indices(zv_eta(i,k,j), zs_eta(i,1:nzm,j-1), nzm, km1, k00, kp1, kp2,khunt3)
CALL find_indices(zv_eta(i,k,j), tzp3, nzm, km1, k00, kp1, kp2,khunt3)
ppm1 = mono_cubic_interp( zv_eta(i,k,j), km1, k00, kp1, kp2, &
zs_eta(i,km1,j-1), zs_eta(i,k00,j-1), zs_eta(i,kp1,j-1), zs_eta(i,kp2,j-1), &
ps_eta(i,km1,j-1), ps_eta(i,k00,j-1), ps_eta(i,kp1,j-1), ps_eta(i,kp2,j-1) )
CALL find_indices(zv_eta(i,k,j), zs_eta(i,1:nzm,j), nzm, km1, k00, kp1, kp2, khunt4)
CALL find_indices(zv_eta(i,k,j), tzp2, nzm, km1, k00, kp1, kp2, khunt4)
pp00 = mono_cubic_interp( zv_eta(i,k,j), km1, k00, kp1, kp2, &
zs_eta(i,km1,j), zs_eta(i,k00,j), zs_eta(i,kp1,j), zs_eta(i,kp2,j), &
ps_eta(i,km1,j), ps_eta(i,k00,j), ps_eta(i,kp1,j), ps_eta(i,kp2,j) )
......@@ -3870,7 +3884,7 @@ MODULE module_statistics
IMPLICIT NONE
INTEGER :: l
REAL :: coef
coef = 1.0D0 / REAL(nstatsteps)
coef = 1.0E0 / REAL(nstatsteps)
DO l = 1, hbuf_length*nzm
hbuf(l) = hbuf(l) * coef
ENDDO
......@@ -4070,8 +4084,8 @@ MODULE module_statistics
DATA ntape/55/
aver = 1.0D0 / REAL(nstatsteps)
factor = 1.0D0 / REAL(nx*ny)
aver = 1.0E0 / REAL(nstatsteps)
factor = 1.0E0 / REAL(nx*ny)
IF (dompi) THEN
! average condavg_factor across domains. This will sum the weighting of all of the
......@@ -4132,7 +4146,7 @@ MODULE module_statistics
! Get statistics buffer from different processes, add them together and average
IF (dompi) THEN
coef = 1.0D0 / REAL(nsubdomains)
coef = 1.0E0 / REAL(nsubdomains)
tmp1(1) = w_max
tmp1(2) = u_max
......@@ -4244,9 +4258,10 @@ MODULE module_statistics
deltas_real4(1) = dx
deltas_real4(2) = dy
deltas_real4(3) = 1. ! dz, & ! write 1 instead of dz
adz_real4(1:nzm) = zs(1:nzm) ! adz, & there is not adz(1:nzm)
z_real4(1:nz) = zs(1:nz) ! Vertical height for output
pres_real4(1:nzm) = press(1:nzm) ! initial hydrostatic pressure level
adz_real4(1:nzm)=zs(1:nzm)
pres_real4(1:nzm)=press(1:nzm)
! there is no zs(nz) only zs(1:nzm)
z_real4(1:nzm)=zs(1:nzm)
! 1D time series
! Index number corresponds to npar in stat2nc.f
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment