diff --git a/src/common/aux/gradient_m_phy.F90 b/src/common/aux/gradient_m_phy.F90 index ed8d0d2ad4c5fcdf859d9543bc3290ca70c3412f..7cd6eb087ebc978dd29c8398640de5689cb78ab1 100644 --- a/src/common/aux/gradient_m_phy.F90 +++ b/src/common/aux/gradient_m_phy.F90 @@ -69,7 +69,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PY ! vari REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux ! side ! -INTEGER :: IKT,IKTB,IKTE,IIB,IJB,IIE,IJE +INTEGER :: IKT,IKTB,IKTE,IIB,IJB,IIE,IJE,IKA,IKU INTEGER :: JI,JJ,JK !------------------------------------------------------------------------------- ! @@ -83,17 +83,21 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT +IKA=D%NKA +IKU=D%NKU +! DO JK=IKTB,IKTE DO JJ=IJB,IJE DO JI=IIB,IIE - PGZ_M_W(JI,JJ,JK) = (PY(JI,JJ,JK)-PY(JI,JJ,JK-D%NKL )) / PDZZ(JI,JJ,JK) + PGZ_M_W(JI,JJ,JK) = (PY(JI,JJ,JK)-PY(JI,JJ,JK-IKL )) / PDZZ(JI,JJ,JK) ENDDO ENDDO ENDDO !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE) -PGZ_M_W(IIB:IIE,IJB:IJE,D%NKU)= (PY(IIB:IIE,IJB:IJE,D%NKU)-PY(IIB:IIE,IJB:IJE,D%NKU-D%NKL)) & - / PDZZ(IIB:IIE,IJB:IJE,D%NKU) -PGZ_M_W(IIB:IIE,IJB:IJE,D%NKA)= PGZ_M_W(IIB:IIE,IJB:IJE,D%NKU) ! -999. +PGZ_M_W(IIB:IIE,IJB:IJE,IKU)= (PY(IIB:IIE,IJB:IJE,IKU)-PY(IIB:IIE,IJB:IJE,IKU-IKL)) & + / PDZZ(IIB:IIE,IJB:IJE,IKU) +PGZ_M_W(IIB:IIE,IJB:IJE,IKA)= PGZ_M_W(IIB:IIE,IJB:IJE,IKU) ! -999. !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE) ! !------------------------------------------------------------------------------- @@ -178,7 +182,7 @@ LOGICAL, INTENT(IN) :: OFLAT REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGX_M_M ! result mass point REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, ZWORK6, ZMXF_PDXX ! -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! !* 0.2 declaration of local variables @@ -197,6 +201,7 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! CALL MXF_PHY(D,PDXX,ZMXF_PDXX) CALL MXM_PHY(D,PA,ZWORK1) @@ -205,19 +210,19 @@ CALL DXF_PHY(D,ZWORK1,ZWORK2) IF (.NOT. OFLAT) THEN CALL DZM_PHY(D,PA,ZWORK3) CALL MXF_PHY(D,PDZX,ZWORK4) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK5(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) * ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) & - / PDZZ(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK5(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * ZWORK4(IIB:IIE,IJB:IJE,1:IKT) & + / PDZZ(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK5,ZWORK6) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGX_M_M(IIB:IIE,IJB:IJE,1:D%NKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) - ZWORK6(IIB:IIE,IJB:IJE,1:D%NKT)) & - / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGX_M_M(IIB:IIE,IJB:IJE,1:IKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:IKT) - ZWORK6(IIB:IIE,IJB:IJE,1:IKT)) & + / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGX_M_M(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGX_M_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZMXF_PDXX(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF ! !---------------------------------------------------------------------------- @@ -301,7 +306,7 @@ LOGICAL, INTENT(IN) :: OFLAT REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_M_M ! result mass point REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, ZMYF_PDYY ! -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! !* 0.2 declaration of local variables @@ -327,19 +332,19 @@ IF (.NOT. OFLAT) THEN ! CALL DZM_PHY(D,PA,ZWORK3) CALL MYF_PHY(D,PDZY,ZWORK4) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK5(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) * ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) & - / PDZZ(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK5(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) * ZWORK3(IIB:IIE,IJB:IJE,1:IKT) & + / PDZZ(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK5,ZWORK4) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGY_M_M(IIB:IIE,IJB:IJE,1:D%NKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT)-ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT)) & - /ZMYF_PDYY(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGY_M_M(IIB:IIE,IJB:IJE,1:IKT)= (ZWORK2(IIB:IIE,IJB:IJE,1:IKT)-ZWORK4(IIB:IIE,IJB:IJE,1:IKT)) & + /ZMYF_PDYY(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGY_M_M(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT)/ZMYF_PDYY(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGY_M_M(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT)/ZMYF_PDYY(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ENDIF ! !---------------------------------------------------------------------------- @@ -430,7 +435,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGX_M_U ! result at flux ! side REAL, DIMENSION(D%NIT*D%NJT*D%NKT) :: ZGX_M_U REAL, DIMENSION(D%NIT,D%NJT,D%NKT):: ZY, ZDXX,ZDZZ,ZDZX -INTEGER IIU,IKU,JI,JK +INTEGER IIU,IKU,JI,JK,IKL, IKA, IKU ! INTEGER :: JJK,IJU INTEGER :: JIJK,JIJKOR,JIJKEND @@ -447,6 +452,9 @@ IF (LHOOK) CALL DR_HOOK('GX_M_U',0,ZHOOK_HANDLE) IIU=D%NIT IJU=D%NJT IKU=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU IF (.NOT. OFLAT) THEN JIJKOR = 1 + JPHEXT + IIU*IJU*(JPVEXT_TURB+1 - 1) JIJKEND = IIU*IJU*(IKU-JPVEXT_TURB) @@ -455,10 +463,10 @@ IF (.NOT. OFLAT) THEN DO JIJK=JIJKOR , JIJKEND ! indexation JI_1JK = JIJK - 1 - JIJK_1 = JIJK - IIU*IJU*D%NKL - JI_1JK_1 = JIJK - 1 - IIU*IJU*D%NKL - JIJKP1 = JIJK + IIU*IJU*D%NKL - JI_1JKP1 = JIJK - 1 + IIU*IJU*D%NKL + JIJK_1 = JIJK - IIU*IJU*IKL + JI_1JK_1 = JIJK - 1 - IIU*IJU*IKL + JIJKP1 = JIJK + IIU*IJU*IKL + JI_1JKP1 = JIJK - 1 + IIU*IJU*IKL ! ZGX_M_U(JIJK)= & ( PY(JIJK)-PY(JI_1JK) & @@ -478,8 +486,8 @@ CALL D1D_TO_3D(D,PDZX,ZDZX) CALL D1D_TO_3D(D,PY,ZY) ! DO JI=1+JPHEXT,IIU - PGX_M_U(JI,:,D%NKU)= ( ZY(JI,:,D%NKU)-ZY(JI-1,:,D%NKU) ) / ZDXX(JI,:,D%NKU) - PGX_M_U(JI,:,D%NKA)= -999. + PGX_M_U(JI,:,IKU)= ( ZY(JI,:,IKU)-ZY(JI-1,:,IKU) ) / ZDXX(JI,:,IKU) + PGX_M_U(JI,:,IKA)= -999. END DO ! PGX_M_U(1,:,:)=PGX_M_U(IIU-2*JPHEXT+1,:,:) @@ -579,7 +587,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_M_V ! result at flux ! side !REAL, DIMENSION(D%NIT*D%NJT*D%NKT) :: ZGY_M_V !REAL, DIMENSION(D%NIT,D%NJT,D%NKT):: ZY, ZDYY,ZDZZ,ZDZY -INTEGER IJU,IKU,JI,JJ,JK +INTEGER IJU,IKU,JI,JJ,JK,IKL, IKA, IKU ! !------------------------------------------------------------------------------- ! @@ -590,25 +598,28 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('GY_M_V',0,ZHOOK_HANDLE) IJU=D%NJT IKU=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU IF (.NOT. OFLAT) THEN ! PGY_M_V = ( DYM(PY) - MZF ( MYM( DZM(PY) /PDZZ ) * PDZY ) )/PDYY DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB DO JJ=1+JPHEXT,IJU PGY_M_V(:,JJ,JK)= & ( PY(:,JJ,JK)-PY(:,JJ-1,JK) & - -( (PY(:,JJ,JK)-PY(:,JJ,JK-D%NKL)) / PDZZ(:,JJ,JK) & - +(PY(:,JJ-1,JK)-PY(:,JJ-D%NKL,JK-D%NKL)) / PDZZ(:,JJ-1,JK) & + -( (PY(:,JJ,JK)-PY(:,JJ,JK-IKL)) / PDZZ(:,JJ,JK) & + +(PY(:,JJ-1,JK)-PY(:,JJ-IKL,JK-IKL)) / PDZZ(:,JJ-1,JK) & ) * PDZY(:,JJ,JK)* 0.25 & - -( (PY(:,JJ,JK+D%NKL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+D%NKL) & - +(PY(:,JJ-1,JK+D%NKL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+D%NKL) & - ) * PDZY(:,JJ,JK+D%NKL)* 0.25 & + -( (PY(:,JJ,JK+IKL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+IKL) & + +(PY(:,JJ-1,JK+IKL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+IKL) & + ) * PDZY(:,JJ,JK+IKL)* 0.25 & ) / PDYY(:,JJ,JK) END DO END DO ! DO JJ=1+JPHEXT,IJU - PGY_M_V(:,JJ,D%NKU)= ( PY(:,JJ,D%NKU)-PY(:,JJ-1,D%NKU) ) / PDYY(:,JJ,D%NKU) - PGY_M_V(:,JJ,D%NKA)= -999. + PGY_M_V(:,JJ,IKU)= ( PY(:,JJ,IKU)-PY(:,JJ-1,IKU) ) / PDYY(:,JJ,IKU) + PGY_M_V(:,JJ,IKA)= -999. END DO ! PGY_M_V(:,1,:)=PGY_M_V(:,IJU-2*JPHEXT+1,:) diff --git a/src/common/aux/gradient_u_phy.F90 b/src/common/aux/gradient_u_phy.F90 index a5937536bf71932b74e05091ec1677cd8419324d..75ce7dac018135d5b6b71ec34f536bada3f6f0c3 100644 --- a/src/common/aux/gradient_u_phy.F90 +++ b/src/common/aux/gradient_u_phy.F90 @@ -85,14 +85,15 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! CALL DZM_PHY(D,PA,PA_WORK) CALL MXM_PHY(D,PDZZ,PDZZ_WORK) ! -!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) -PGZ_U_UW(IIB:IIE,IJB:IJE,1:D%NKT)= PA_WORK(IIB:IIE,IJB:IJE,1:D%NKT) & - / PDZZ_WORK(IIB:IIE,IJB:IJE,1:D%NKT) -!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) +!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) +PGZ_U_UW(IIB:IIE,IJB:IJE,1:IKT)= PA_WORK(IIB:IIE,IJB:IJE,1:IKT) & + / PDZZ_WORK(IIB:IIE,IJB:IJE,1:IKT) +!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ! !---------------------------------------------------------------------------- ! @@ -176,7 +177,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZX ! metric coefficient REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PGX_U_M ! result mass point ! REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4 -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! !* 0.2 declaration of local variables @@ -195,28 +196,29 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! CALL DXF_PHY(D,PA,ZWORK1) CALL MXF_PHY(D,PDXX,ZWORK2) IF (.NOT. OFLAT) THEN CALL DZM_PHY(D,PA,ZWORK3) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) * PDZX(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * PDZX(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK3,ZWORK4) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) / PDZZ(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK4(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) / PDZZ(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK4,ZWORK3) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGX_U_M(IIB:IIE,IJB:IJE,1:D%NKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) - ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT)) & - / ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGX_U_M(IIB:IIE,IJB:IJE,1:IKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:IKT) - ZWORK3(IIB:IIE,IJB:IJE,1:IKT)) & + / ZWORK2(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGX_U_M(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) / ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGX_U_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT) / ZWORK2(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF ! !---------------------------------------------------------------------------- diff --git a/src/common/aux/gradient_v_phy.F90 b/src/common/aux/gradient_v_phy.F90 index 392653606b17a93aa6dc4e408b2c5a957dcfed12..66ec0b4ca7708bd3dffd385752e336a49910f9d6 100644 --- a/src/common/aux/gradient_v_phy.F90 +++ b/src/common/aux/gradient_v_phy.F90 @@ -71,7 +71,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(OUT) :: PGZ_V_VW ! result UW point REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PA_WORK, PDZZ_WORK ! INTEGER :: JI,JJ,JK -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT ! !* 0.2 declaration of local variables ! @@ -79,6 +79,7 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! !---------------------------------------------------------------------------- ! @@ -88,10 +89,10 @@ IJB=D%NJBC CALL DZM_PHY(D,PA,PA_WORK) CALL MYM_PHY(D,PDZZ,PDZZ_WORK) ! -!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) -PGZ_V_VW(IIB:IIE,IJB:IJE,1:D%NKT)= PA_WORK(IIB:IIE,IJB:IJE,1:D%NKT) & - / PDZZ_WORK(IIB:IIE,IJB:IJE,1:D%NKT) -!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) +!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) +PGZ_V_VW(IIB:IIE,IJB:IJE,1:IKT)= PA_WORK(IIB:IIE,IJB:IJE,1:IKT) & + / PDZZ_WORK(IIB:IIE,IJB:IJE,1:IKT) +!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) !---------------------------------------------------------------------------- ! END SUBROUTINE GZ_V_VW_PHY @@ -172,7 +173,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZY ! metric coefficient REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: PGY_V_M ! result mass point ! REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4 -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! !* 0.2 declaration of local variables @@ -184,6 +185,7 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! !---------------------------------------------------------------------------- ! @@ -195,22 +197,22 @@ CALL MYF_PHY(D,PDYY,ZWORK2) ! IF (.NOT. OFLAT) THEN CALL DZM_PHY(D,PA,ZWORK3) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) * PDZY(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK3(IIB:IIE,IJB:IJE,1:IKT) * PDZY(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK3,ZWORK4) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK4(IIB:IIE,IJB:IJE,1:D%NKT) / PDZZ(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZWORK4(IIB:IIE,IJB:IJE,1:IKT) = ZWORK4(IIB:IIE,IJB:IJE,1:IKT) / PDZZ(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK4,ZWORK3) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGY_V_M(IIB:IIE,IJB:IJE,1:D%NKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) - ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT)) & - / ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGY_V_M(IIB:IIE,IJB:IJE,1:IKT) = ( ZWORK1(IIB:IIE,IJB:IJE,1:IKT) - ZWORK3(IIB:IIE,IJB:IJE,1:IKT)) & + / ZWORK2(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGY_V_M(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) / ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGY_V_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT) / ZWORK2(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF ! !---------------------------------------------------------------------------- diff --git a/src/common/aux/gradient_w_phy.F90 b/src/common/aux/gradient_w_phy.F90 index e4e3dcf93c9c45fad2944b8087ac5dbc3ed794f0..0377f0991ceffd5f90533f5af1091b9bc653dc36 100644 --- a/src/common/aux/gradient_w_phy.F90 +++ b/src/common/aux/gradient_w_phy.F90 @@ -67,7 +67,7 @@ LOGICAL, INTENT(IN) :: OFLAT ! REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGX_W_UW ! result UW point REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5 -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! ! @@ -86,11 +86,12 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT CALL MZM_PHY(D,PDXX,ZWORK1) CALL DXM_PHY(D,PA,ZWORK2) -!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) -ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) / ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) -!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) +!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) +ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZWORK1(IIB:IIE,IJB:IJE,1:IKT) +!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ! IF (.NOT. OFLAT) THEN CALL MZF_PHY(D,PA,ZWORK2) @@ -98,11 +99,11 @@ IF (.NOT. OFLAT) THEN CALL DZM_PHY(D,ZWORK4,ZWORK5) ! CALL MXM_PHY(D,PDZZ,ZWORK2) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGX_W_UW(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) & - - ZWORK5(IIB:IIE,IJB:IJE,1:D%NKT)*PDZX(IIB:IIE,IJB:IJE,1:D%NKT) & - / (ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT)*ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT)) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGX_W_UW(IIB:IIE,IJB:IJE,1:IKT)= ZWORK3(IIB:IIE,IJB:IJE,1:IKT) & + - ZWORK5(IIB:IIE,IJB:IJE,1:IKT)*PDZX(IIB:IIE,IJB:IJE,1:IKT) & + / (ZWORK1(IIB:IIE,IJB:IJE,1:IKT)*ZWORK2(IIB:IIE,IJB:IJE,1:IKT)) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE PGX_W_UW = ZWORK3 END IF @@ -178,7 +179,7 @@ LOGICAL, INTENT(IN) :: OFLAT ! REAL, DIMENSION(D%NIT,D%NJT,D%NKT),INTENT(OUT) :: PGY_W_VW ! result UW point REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5 -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! !* 0.2 declaration of local variables @@ -204,11 +205,12 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT CALL MZM_PHY(D,PDYY,ZWORK1) CALL DYM_PHY(D,PA,ZWORK2) -!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) -ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) = ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) / ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT) -!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) +!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) +ZWORK3(IIB:IIE,IJB:IJE,1:IKT) = ZWORK2(IIB:IIE,IJB:IJE,1:IKT) / ZWORK1(IIB:IIE,IJB:IJE,1:IKT) +!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ! IF (.NOT. OFLAT) THEN CALL MZF_PHY(D,PA,ZWORK2) @@ -216,11 +218,11 @@ IF (.NOT. OFLAT) THEN CALL DZM_PHY(D,ZWORK4,ZWORK5) ! CALL MYM_PHY(D,PDZZ,ZWORK2) - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PGY_W_VW(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK3(IIB:IIE,IJB:IJE,1:D%NKT) & - - ZWORK5(IIB:IIE,IJB:IJE,1:D%NKT)*PDZY(IIB:IIE,IJB:IJE,1:D%NKT) & - / (ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT)*ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT)) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PGY_W_VW(IIB:IIE,IJB:IJE,1:IKT)= ZWORK3(IIB:IIE,IJB:IJE,1:IKT) & + - ZWORK5(IIB:IIE,IJB:IJE,1:IKT)*PDZY(IIB:IIE,IJB:IJE,1:IKT) & + / (ZWORK1(IIB:IIE,IJB:IJE,1:IKT)*ZWORK2(IIB:IIE,IJB:IJE,1:IKT)) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE PGY_W_VW = ZWORK3 END IF @@ -292,7 +294,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PDZZ ! metric coefficient REAL, DIMENSION(D%NIT,D%NJT,D%NKT) , INTENT(OUT):: PGZ_W_M ! result mass point ! REAL, DIMENSION(D%NIT,D%NJT,D%NKT) :: ZWORK1, ZWORK2 -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT INTEGER :: JI,JJ,JK ! ! @@ -311,11 +313,12 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT CALL DZF_PHY(D,PA,ZWORK1) CALL MZF_PHY(D,PDZZ,ZWORK2) -!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) -PGZ_W_M(IIB:IIE,IJB:IJE,1:D%NKT)= ZWORK1(IIB:IIE,IJB:IJE,1:D%NKT)/ZWORK2(IIB:IIE,IJB:IJE,1:D%NKT) -!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) +!$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) +PGZ_W_M(IIB:IIE,IJB:IJE,1:IKT)= ZWORK1(IIB:IIE,IJB:IJE,1:IKT)/ZWORK2(IIB:IIE,IJB:IJE,1:IKT) +!$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ! !---------------------------------------------------------------------------- ! diff --git a/src/common/aux/shuman_phy.F90 b/src/common/aux/shuman_phy.F90 index f7d599102ddb0e874015c7ca654e4abdb23138df..112da4864b78e285820b35b5d9d0776cbc387db8 100644 --- a/src/common/aux/shuman_phy.F90 +++ b/src/common/aux/shuman_phy.F90 @@ -377,7 +377,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localizati !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK,JIJ,IIJB,IIJE ! Loop index +INTEGER :: JK,JIJ,IIJB,IIJE,IKT ! Loop index +INTEGER :: IKL,IKA,IKU ! !------------------------------------------------------------------------------- ! @@ -388,14 +389,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MZM',0,ZHOOK_HANDLE) IIJB = D%NIJB IIJE = D%NIJE -DO JK=2,D%NKT-1 +IKT=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU +DO JK=2,IKT-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PMZM(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK-D%NKL) ) + PMZM(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK-IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) -PMZM(IIJB:IIJE,D%NKA) = -999. -PMZM(IIJB:IIJE,D%NKU) = 0.5*( PA(IIJB:IIJE,D%NKU)+PA(IIJB:IIJE,D%NKU-D%NKL) ) +PMZM(IIJB:IIJE,IKA) = -999. +PMZM(IIJB:IIJE,IKU) = 0.5*( PA(IIJB:IIJE,IKU)+PA(IIJB:IIJE,IKU-IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -464,7 +469,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZM ! result at flux !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK,JIJ,IIJB,IIJE ! Loop index +INTEGER :: JK,JIJ,IIJB,IIJE,IKT ! Loop index +INTEGER :: IKL, IKA, IKU ! !------------------------------------------------------------------------------- ! @@ -475,14 +481,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('DZM',0,ZHOOK_HANDLE) IIJB = D%NIJB IIJE = D%NIJE -DO JK=2,D%NKT-1 +IKT=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU +DO JK=2,IKT-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PDZM(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK) - PA(IIJB:IIJE,JK-D%NKL) + PDZM(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK) - PA(IIJB:IIJE,JK-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) -PDZM(IIJB:IIJE,D%NKA) = -999. -PDZM(IIJB:IIJE,D%NKU) = PA(IIJB:IIJE,D%NKU) - PA(IIJB:IIJE,D%NKU-D%NKL) +PDZM(IIJB:IIJE,IKA) = -999. +PDZM(IIJB:IIJE,IKU) = PA(IIJB:IIJE,IKU) - PA(IIJB:IIJE,IKU-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- @@ -863,7 +873,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZF ! result at mass localizati !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK,JIJ,IIJB,IIJE ! Loop index +INTEGER :: JK,JIJ,IIJB,IIJE,IKT ! Loop index +INTEGER :: IKL, IKA, IKU ! !------------------------------------------------------------------------------- ! @@ -874,14 +885,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MZF',0,ZHOOK_HANDLE) IIJB = D%NIJB IIJE = D%NIJE -DO JK=2,D%NKT-1 +IKT=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU +DO JK=2,IKT-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PMZF(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+D%NKL) ) + PMZF(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) -PMZF(IIJB:IIJE,D%NKU) = -999. -PMZF(IIJB:IIJE,D%NKA) = 0.5*( PA(IIJB:IIJE,D%NKA)+PA(IIJB:IIJE,D%NKA+D%NKL) ) +PMZF(IIJB:IIJE,IKU) = -999. +PMZF(IIJB:IIJE,IKA) = 0.5*( PA(IIJB:IIJE,IKA)+PA(IIJB:IIJE,IKA+IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- @@ -948,7 +963,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZF ! result at mass localizati !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK,JIJ,IIJB,IIJE ! Loop index +INTEGER :: JK,JIJ,IIJB,IIJE,IKT ! Loop index +INTEGER :: IKL, IKA, IKU ! !------------------------------------------------------------------------------- ! @@ -959,14 +975,18 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('DZF',0,ZHOOK_HANDLE) IIJB = D%NIJB IIJE = D%NIJE -DO JK=2,D%NKT-1 +IKT=D%NKT +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU +DO JK=2,IKT-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PDZF(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK+D%NKL) - PA(IIJB:IIJE,JK) + PDZF(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK+IKL) - PA(IIJB:IIJE,JK) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) -PDZF(IIJB:IIJE,D%NKA) = PA(IIJB:IIJE,D%NKA+D%NKL) - PA(IIJB:IIJE,D%NKA) -PDZF(IIJB:IIJE,D%NKU) = -999. +PDZF(IIJB:IIJE,IKA) = PA(IIJB:IIJE,IKA+IKL) - PA(IIJB:IIJE,IKA) +PDZF(IIJB:IIJE,IKU) = -999. !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- diff --git a/src/common/micro/condensation.F90 b/src/common/micro/condensation.F90 index 8748c8ef9fd0c1c444d5ad338dd8d49c090a30e3..8b46541123e578150e769d33e4a467814ecd8bd4 100644 --- a/src/common/micro/condensation.F90 +++ b/src/common/micro/condensation.F90 @@ -159,7 +159,8 @@ REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PICE_CLD_WGT ! !* 0.2 Declarations of local variables : ! -INTEGER :: JIJ, JK, JKP, JKM ! loop index +INTEGER :: JIJ, JK, JKP, JKM ! loop index +INTEGER :: IKTB, IKTE, IKB, IKE, IKL, IIJB, IIJE REAL, DIMENSION(D%NIJT,D%NKT) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio REAL, DIMENSION(D%NIJT,D%NKT) :: ZL ! length scale INTEGER, DIMENSION(D%NIJT) :: ITPL ! top levels of troposphere @@ -217,6 +218,14 @@ REAL, DIMENSION(-22:11),PARAMETER :: ZSRC_1D =(/ & ! IF (LHOOK) CALL DR_HOOK('CONDENSATION',0,ZHOOK_HANDLE) ! +IKTB=D%NKTB +IKTE=D%NKTE +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +IIJB=D%NIJB +IIJE=D%NIJE +! PCLDFR(:,:) = 0. ! Initialize values PSIGRC(:,:) = 0. ! Initialize values ZPRIFACT = 1. ! Initialize value @@ -240,8 +249,8 @@ IF(OCND2)ZPRIFACT = 0. ! !------------------------------------------------------------------------------- ! store total water mixing ratio -DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE +DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE ZRT(JIJ,JK) = PRV_IN(JIJ,JK) + PRC_IN(JIJ,JK) + PRI_IN(JIJ,JK)*ZPRIFACT END DO END DO @@ -252,8 +261,8 @@ IF(PRESENT(PLV) .AND. PRESENT(PLS)) THEN ZLV(:,:)=PLV(:,:) ZLS(:,:)=PLS(:,:) ELSE - DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE + DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE ! latent heat of vaporisation/sublimation ZLV(JIJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( PT(JIJ,JK) - CST%XTT ) ZLS(JIJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( PT(JIJ,JK) - CST%XTT ) @@ -263,8 +272,8 @@ ENDIF IF(PRESENT(PCPH)) THEN ZCPD(:,:)=PCPH(:,:) ELSE - DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE + DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE ZCPD(JIJ,JK) = CST%XCPD + CST%XCPV*PRV_IN(JIJ,JK) + CST%XCL*PRC_IN(JIJ,JK) + CST%XCI*PRI_IN(JIJ,JK) + & #if defined(REPRO48) || defined(REPRO55) #else @@ -276,8 +285,8 @@ ELSE ENDIF ! Preliminary calculations needed for computing the "turbulent part" of Sigma_s IF ( .NOT. OSIGMAS ) THEN - DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE + DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE ! store temperature at saturation ZTLK(JIJ,JK) = PT(JIJ,JK) - ZLV(JIJ,JK)*PRC_IN(JIJ,JK)/ZCPD(JIJ,JK) & - ZLS(JIJ,JK)*PRI_IN(JIJ,JK)/ZCPD(JIJ,JK)*ZPRIFACT @@ -285,16 +294,16 @@ IF ( .NOT. OSIGMAS ) THEN END DO ! Determine tropopause/inversion height from minimum temperature #ifdef REPRO48 - ITPL(:) = D%NIJB+1 + ITPL(:) = IIJB+1 !I (Sébastien Riette) don't understand why tropopause level is set !with the index of the second physical point on the horizontal (i.e. 2+JPHEXT)!!! !I assume it is a bug... #else - ITPL(:) = D%NKB+D%NKL + ITPL(:) = IKB+IKL #endif ZTMIN(:) = 400. - DO JK = D%NKTB+1,D%NKTE-1 - DO JIJ=D%NIJB,D%NIJE + DO JK = IKTB+1,IKTE-1 + DO JIJ=IIJB,IIJE IF ( PT(JIJ,JK) < ZTMIN(JIJ) ) THEN ZTMIN(JIJ) = PT(JIJ,JK) ITPL(JIJ) = JK @@ -302,37 +311,37 @@ IF ( .NOT. OSIGMAS ) THEN END DO END DO ! Set the mixing length scale - ZL(:,D%NKB) = 20. - DO JK = D%NKB+D%NKL,D%NKE,D%NKL - DO JIJ=D%NIJB,D%NIJE + ZL(:,IKB) = 20. + DO JK = IKB+IKL,IKE,IKL + DO JIJ=IIJB,IIJE ! free troposphere ZL(JIJ,JK) = ZL0 - ZZZ = PZZ(JIJ,JK) - PZZ(JIJ,D%NKB) + ZZZ = PZZ(JIJ,JK) - PZZ(JIJ,IKB) JKP = ITPL(JIJ) ! approximate length for boundary-layer IF ( ZL0 > ZZZ ) ZL(JIJ,JK) = ZZZ ! gradual decrease of length-scale near and above tropopause - IF ( ZZZ > 0.9*(PZZ(JIJ,JKP)-PZZ(JIJ,D%NKB)) ) & - ZL(JIJ,JK) = .6 * ZL(JIJ,JK-D%NKL) + IF ( ZZZ > 0.9*(PZZ(JIJ,JKP)-PZZ(JIJ,IKB)) ) & + ZL(JIJ,JK) = .6 * ZL(JIJ,JK-IKL) END DO END DO END IF !------------------------------------------------------------------------------- ! -DO JK=D%NKTB,D%NKTE - JKP=MAX(MIN(JK+D%NKL,D%NKTE),D%NKTB) - JKM=MAX(MIN(JK-D%NKL,D%NKTE),D%NKTB) +DO JK=IKTB,IKTE + JKP=MAX(MIN(JK+IKL,IKTE),IKTB) + JKM=MAX(MIN(JK-IKL,IKTE),IKTB) IF (OCND2) THEN - DO JIJ = D%NIJB, D%NIJE - ZDZ(JIJ) = PZZ(JIJ,JKP) - PZZ(JIJ,JKP-D%NKL) + DO JIJ = IIJB, IIJE + ZDZ(JIJ) = PZZ(JIJ,JKP) - PZZ(JIJ,JKP-IKL) ENDDO CALL ICECLOUD(D,PPABS(:,JK),PZZ(:,JK),ZDZ(:), & & PT(:,JK),PRV_IN(:,JK),1.,-1., & - & ZCLDINI(:),PIFR(D%NIJB,JK),PICLDFR(:,JK), & + & ZCLDINI(:),PIFR(IIJB,JK),PICLDFR(:,JK), & & PSSIO(:,JK),PSSIU(:,JK),ZARDUM2(:),ZARDUM(:)) ! latent heats ! saturated water vapor mixing ratio over liquid water and ice - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ESATW_T(JIJ)=ESATW(PT(JIJ,JK)) ZPV(JIJ) = MIN(ESATW_T(JIJ), .99*PPABS(JIJ,JK)) ZPIV(JIJ) = MIN(ESATI(PT(JIJ,JK)), .99*PPABS(JIJ,JK)) @@ -340,7 +349,7 @@ DO JK=D%NKTB,D%NKTE ELSE ! latent heats ! saturated water vapor mixing ratio over liquid water and ice - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ZPV(JIJ) = MIN(EXP( CST%XALPW - CST%XBETAW / PT(JIJ,JK) - CST%XGAMW * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK)) ZPIV(JIJ) = MIN(EXP( CST%XALPI - CST%XBETAI / PT(JIJ,JK) - CST%XGAMI * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK)) END DO @@ -348,16 +357,16 @@ DO JK=D%NKTB,D%NKTE !Ice fraction ZFRAC(:) = 0. IF (OUSERI .AND. .NOT.OCND2) THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE IF (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK) > 1.E-20) THEN ZFRAC(JIJ) = PRI_IN(JIJ,JK) / (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK)) ENDIF END DO - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization ENDDO ENDIF - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ZQSL(JIJ) = CST%XRD / CST%XRV * ZPV(JIJ) / ( PPABS(JIJ,JK) - ZPV(JIJ) ) ZQSI(JIJ) = CST%XRD / CST%XRV * ZPIV(JIJ) / ( PPABS(JIJ,JK) - ZPIV(JIJ) ) @@ -376,10 +385,10 @@ DO JK=D%NKTB,D%NKTE ! switch to take either present computed value of SIGMAS ! or that of Meso-NH turbulence scheme IF ( OSIGMAS ) THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE IF (PSIGQSAT(JIJ)/=0.) THEN ZDZFACT = 1. - IF(LHGT_QS .AND. JK+1 <= D%NKTE)THEN + IF(LHGT_QS .AND. JK+1 <= IKTE)THEN ZDZFACT= MAX(ICEP%XFRMIN(23),MIN(ICEP%XFRMIN(24),(PZZ(JIJ,JK) - PZZ(JIJ,JK+1))/ZDZREF)) ELSEIF(LHGT_QS)THEN ZDZFACT= MAX(ICEP%XFRMIN(23),MIN(ICEP%XFRMIN(24),((PZZ(JIJ,JK-1) - PZZ(JIJ,JK)))*0.8/ZDZREF)) @@ -398,7 +407,7 @@ DO JK=D%NKTB,D%NKTE END IF END DO ELSE - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ! parameterize Sigma_s with first_order closure DZZ = PZZ(JIJ,JKP) - PZZ(JIJ,JKM) ZDRW = ZRT(JIJ,JKP) - ZRT(JIJ,JKM) @@ -413,14 +422,14 @@ DO JK=D%NKTB,D%NKTE ZSIG_CONV * ZSIG_CONV ) ) END DO END IF - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ZSIGMA(JIJ)= MAX( 1.E-10, ZSIGMA(JIJ) ) ! normalized saturation deficit ZQ1(JIJ) = ZSBAR(JIJ)/ZSIGMA(JIJ) END DO IF(HCONDENS == 'GAUS') THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ! Gaussian Probability Density Function around ZQ1 ! Computation of ZG and ZGAM(=erf(ZG)) ZGCOND = -ZQ1(JIJ)/SQRT(2.) @@ -439,7 +448,7 @@ DO JK=D%NKTB,D%NKTE END DO !Computation warm/cold Cloud Fraction and content in high water content part IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE IF(1-ZFRAC(JIJ) > 1.E-20)THEN ZAUTC = (ZSBAR(JIJ) - ICEP%XCRIAUTC/(PRHODREF(JIJ,JK)*(1-ZFRAC(JIJ))))/ZSIGMA(JIJ) ZGAUTC = -ZAUTC/SQRT(2.) @@ -457,7 +466,7 @@ DO JK=D%NKTB,D%NKTE ENDIF IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE IF(ZFRAC(JIJ) > 1.E-20)THEN ZCRIAUTI=MIN(ICEP%XCRIAUTI,10**(ICEP%XACRIAUTI*(PT(JIJ,JK)-CST%XTT)+ICEP%XBCRIAUTI)) ZAUTI = (ZSBAR(JIJ) - ZCRIAUTI/ZFRAC(JIJ))/ZSIGMA(JIJ) @@ -476,7 +485,7 @@ DO JK=D%NKTB,D%NKTE ENDIF ELSEIF(HCONDENS == 'CB02')THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE !Total condensate IF (ZQ1(JIJ) > 0. .AND. ZQ1(JIJ) <= 2) THEN ZCOND(JIJ) = MIN(EXP(-1.)+.66*ZQ1(JIJ)+.086*ZQ1(JIJ)**2, 2.) ! We use the MIN function for continuity @@ -513,7 +522,7 @@ DO JK=D%NKTB,D%NKTE END IF !HCONDENS IF(.NOT. OCND2) THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE PRC_OUT(JIJ,JK) = (1.-ZFRAC(JIJ)) * ZCOND(JIJ) ! liquid condensate PRI_OUT(JIJ,JK) = ZFRAC(JIJ) * ZCOND(JIJ) ! solid condensate PT(JIJ,JK) = PT(JIJ,JK) + ((PRC_OUT(JIJ,JK)-PRC_IN(JIJ,JK))*ZLV(JIJ,JK) + & @@ -522,7 +531,7 @@ DO JK=D%NKTB,D%NKTE PRV_OUT(JIJ,JK) = ZRT(JIJ,JK) - PRC_OUT(JIJ,JK) - PRI_OUT(JIJ,JK)*ZPRIFACT END DO ELSE - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE PRC_OUT(JIJ,JK) = (1.-ZFRAC(JIJ)) * ZCOND(JIJ) ! liquid condensate ZLWINC = PRC_OUT(JIJ,JK) - PRC_IN(JIJ,JK) ! @@ -551,7 +560,7 @@ DO JK=D%NKTB,D%NKTE PWCLDFR(JIJ,JK) = PCLDFR(JIJ,JK) ZDUM1 = MIN(1.0,20.* PRC_OUT(JIJ,JK)*SQRT(ZDZ(JIJ))/ZQSL(JIJ)) ! cloud liquid water factor ZDUM3 = MAX(0.,PICLDFR(JIJ,JK)-PWCLDFR(JIJ,JK)) ! pure ice cloud part - IF (JK==D%NKTB) THEN + IF (JK==IKTB) THEN ZDUM4 = PRI_IN(JIJ,JK) ELSE ZDUM4 = PRI_IN(JIJ,JK) + PRS(JIJ,JK)*0.5 + PRG(JIJ,JK)*0.25 @@ -573,7 +582,7 @@ DO JK=D%NKTB,D%NKTE END DO END IF ! End OCND2 IF(HLAMBDA3=='CB')THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ! s r_c/ sig_s^2 ! PSIGRC(JIJ,JK) = PCLDFR(JIJ,JK) ! use simple Gaussian relation ! diff --git a/src/common/micro/ice_adjust.F90 b/src/common/micro/ice_adjust.F90 index 77108bd2cf9d97431ebe5b65c484741067a89f48..03020cfe18d9cf9802729e09d06bdc10fbfa3f7d 100644 --- a/src/common/micro/ice_adjust.F90 +++ b/src/common/micro/ice_adjust.F90 @@ -225,6 +225,7 @@ REAL :: ZCRIAUT, & ! Autoconversion thresholds ! INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment INTEGER :: JIJ, JK +INTEGER :: IKTB, IKTE, IIJB, IIJE ! REAL, DIMENSION(D%NIJT,D%NKT) :: ZSIGS, ZSRCS REAL, DIMENSION(D%NIJT) :: ZSIGQSAT @@ -237,6 +238,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE ! IF (LHOOK) CALL DR_HOOK('ICE_ADJUST',0,ZHOOK_HANDLE) ! +IKTB=D%NKTB +IKTE=D%NKTE +IIJB=D%NIJB +IIJE=D%NIJE +! ITERMAX=1 ! IF(BUCONF%LBUDGET_TH) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), TRIM(HBUNAME), PTHS(:, :)*PRHODJ(:, :)) @@ -256,8 +262,8 @@ DO JITER =1,ITERMAX !* 2.3 compute the latent heat of vaporization Lv(T*) at t+1 ! and the latent heat of sublimation Ls(T*) at t+1 ! - DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE + DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE IF (JITER==1) ZT(JIJ,JK) = PTH(JIJ,JK) * PEXN(JIJ,JK) ZLV(JIJ,JK) = CST%XLVTT + ( CST%XCPV - CST%XCL ) * ( ZT(JIJ,JK) -CST%XTT ) ZLS(JIJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( ZT(JIJ,JK) -CST%XTT ) @@ -279,8 +285,8 @@ ENDDO ! end of the iterative loop ! ------------------------------------------------- ! ! -DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE +DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE ! !* 5.0 compute the variation of mixing ratio ! @@ -315,7 +321,7 @@ DO JK=D%NKTB,D%NKTE !* 5.2 compute the cloud fraction PCLDFR ! IF ( .NOT. OSUBG_COND ) THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE IF (PRCS(JIJ,JK) + PRIS(JIJ,JK) > 1.E-12 / PTSTEP) THEN PCLDFR(JIJ,JK) = 1. ELSE @@ -326,7 +332,7 @@ DO JK=D%NKTB,D%NKTE END IF ENDDO ELSE !OSUBG_COND case - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE !We limit PRC_MF+PRI_MF to PRVS*PTSTEP to avoid negative humidity ZW1=PRC_MF(JIJ,JK)/PTSTEP ZW2=PRI_MF(JIJ,JK)/PTSTEP @@ -398,7 +404,7 @@ DO JK=D%NKTB,D%NKTE ! IF(PRESENT(POUT_RV) .OR. PRESENT(POUT_RC) .OR. & &PRESENT(POUT_RI) .OR. PRESENT(POUT_TH)) THEN - DO JIJ=D%NIJB,D%NIJE + DO JIJ=IIJB,IIJE ZW1=PRC_MF(JIJ,JK) ZW2=PRI_MF(JIJ,JK) IF(ZW1+ZW2>ZRV(JIJ,JK)) THEN @@ -444,8 +450,8 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRC_OUT ! Cloud water m.r. to adju REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRI_OUT ! Cloud ice m.r. to adjust in output ! !* 2.4 compute the specific heat for moist air (Cph) at t+1 -DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE +DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE SELECT CASE(KRR) CASE(7) ZCPH(JIJ,JK) = CST%XCPD + CST%XCPV * PRV_IN(JIJ,JK) & diff --git a/src/common/micro/mode_ice4_rainfr_vert.F90 b/src/common/micro/mode_ice4_rainfr_vert.F90 index 2519e10fc86ed6379dbeae52e54090d36c259f77..e432813b1424aad05eb1261d89cce1eb707da6fe 100644 --- a/src/common/micro/mode_ice4_rainfr_vert.F90 +++ b/src/common/micro/mode_ice4_rainfr_vert.F90 @@ -42,6 +42,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRS !Snow field REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRG !Graupel field REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRH !Hail field ! +INTEGER :: IKB, IKE, IKL, IIE, IIB, IJB, IJE !* 0.2 declaration of local variables ! REAL(KIND=JPRB) :: ZHOOK_HANDLE @@ -51,11 +52,19 @@ LOGICAL :: MASK !------------------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('ICE4_RAINFR_VERT',0,ZHOOK_HANDLE) ! +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +IIB=D%NIB +IIE=D%NIE +IJB=D%NJB +IJE=D%NJE +! !------------------------------------------------------------------------------- -DO JI = D%NIB,D%NIE - DO JJ = D%NJB, D%NJE - PPRFR(JI,JJ,D%NKE)=0. - DO JK=D%NKE-D%NKL, D%NKB, -D%NKL +DO JI = IIB,IIE + DO JJ = IJB, IJE + PPRFR(JI,JJ,IKE)=0. + DO JK=IKE-IKL, IKB, -IKL IF(PRESENT(PRH)) THEN MASK=PRR(JI,JJ,JK) .GT. ICED%XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. ICED%XRTMIN(5) & .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. ICED%XRTMIN(7) @@ -64,7 +73,7 @@ DO JI = D%NIB,D%NIE .OR. PRG(JI,JJ,JK) .GT. ICED%XRTMIN(6) END IF IF (MASK) THEN - PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+D%NKL)) + PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+IKL)) IF (PPRFR(JI,JJ,JK)==0) THEN PPRFR(JI,JJ,JK)=1. END IF diff --git a/src/common/micro/mode_ice4_sedimentation_split.F90 b/src/common/micro/mode_ice4_sedimentation_split.F90 index d2f06a7ba8a98c5b4614e7631859be2630800632..2c078a26e9c7aa7c5441c9d090ba6c5bfe317add 100644 --- a/src/common/micro/mode_ice4_sedimentation_split.F90 +++ b/src/common/micro/mode_ice4_sedimentation_split.F90 @@ -144,14 +144,14 @@ IF (GSEDIC) THEN ZCONC3D(:,:,:)= ICED%XCONC_LAND ZCONC_TMP(:,:)= ICED%XCONC_LAND IF (GPRESENT_PSEA) THEN - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZCONC_TMP(JI,JJ)=PSEA(JI,JJ)*ICED%XCONC_SEA+(1.-PSEA(JI,JJ))*ICED%XCONC_LAND ENDDO ENDDO - DO JK=D%NKTB, D%NKTE - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JK=IKTB, IKTE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZLBC(JI,JJ,JK) = PSEA(JI,JJ)*ICED%XLBC(2)+(1.-PSEA(JI,JJ))*ICED%XLBC(1) ZFSEDC(JI,JJ,JK) = (PSEA(JI,JJ)*ICEP%XFSEDC(2)+(1.-PSEA(JI,JJ))*ICEP%XFSEDC(1)) ZFSEDC(JI,JJ,JK) = MAX(MIN(ICEP%XFSEDC(1),ICEP%XFSEDC(2)),ZFSEDC(JI,JJ,JK)) @@ -175,9 +175,9 @@ ENDIF ! the precipitating fields are larger than a minimal value only !!! ! For optimization we consider each variable separately ! -DO JK=D%NKTB, D%NKTE - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE +DO JK=IKTB, IKTE + DO JJ = IJB, IJE + DO JI = IIB, IIE ! External tendecies IF (GSEDIC) THEN ZPRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)-PRCT(JI,JJ,JK)*ZINVTSTEP @@ -320,9 +320,18 @@ REAL, DIMENSION(D%NIT, D%NJT) :: ZMAX_TSTEP ! Maximum CFL in column REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN REAL, DIMENSION(D%NIT, D%NJT) :: ZREMAINT ! Remaining time until the timestep end REAL, DIMENSION(D%NIT, D%NJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes +INTEGER :: IKTB, IKTE, IKB, IKL, IIE, IIB, IJB, IJE REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE) ! +IKTB=D%NKTB +IKTE=D%NKTE +IKB=D%NKB +IKL=D%NKL +IIB=D%NIB +IIE=D%NIE +IJB=D%NJB +IJE=D%NJE !------------------------------------------------------------------------------- IF (KSPE<2 .OR. KSPE>7) CALL PRINT_MSG(NVERB_FATAL,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)') ! @@ -336,13 +345,13 @@ PINPRX(:,:) = 0. ZINVTSTEP=1./PTSTEP ZRSMIN(:) = ICED%XRTMIN(:) * ZINVTSTEP ZREMAINT(:,:) = 0. -ZREMAINT(D%NIB:D%NIE,D%NJB:D%NJE) = PTSTEP +ZREMAINT(IIB:IIE,IJB:IJE) = PTSTEP ! DO WHILE (ANY(ZREMAINT>0.)) ISEDIM = 0 - DO JK = D%NKTB,D%NKTE - DO JJ = D%NJB,D%NJE - DO JI = D%NIB,D%NIE + DO JK = IKTB,IKTE + DO JJ = IJB,IJE + DO JI = IIB,IIE IF( (PRXT (JI,JJ,JK)>ICED%XRTMIN(KSPE) .OR. & PPRXS(JI,JJ,JK)>ZRSMIN(KSPE)) .AND. & ZREMAINT(JI,JJ)>0. ) THEN @@ -467,17 +476,17 @@ DO WHILE (ANY(ZREMAINT>0.)) ENDIF ENDDO - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZREMAINT(JI,JJ) = ZREMAINT(JI,JJ) - ZMAX_TSTEP(JI,JJ) - PINPRX(JI,JJ) = PINPRX(JI,JJ) + ZWSED(JI,JJ,D%NKB) / CST%XRHOLW * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP) + PINPRX(JI,JJ) = PINPRX(JI,JJ) + ZWSED(JI,JJ,IKB) / CST%XRHOLW * (ZMAX_TSTEP(JI,JJ) * ZINVTSTEP) ENDDO ENDDO - DO JK = D%NKTB , D%NKTE - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE - ZMRCHANGE = ZMAX_TSTEP(JI,JJ) * POORHODZ(JI,JJ,JK)*(ZWSED(JI,JJ,JK+D%NKL)-ZWSED(JI,JJ,JK)) + DO JK = IKTB , IKTE + DO JJ = IJB, IJE + DO JI = IIB, IIE + ZMRCHANGE = ZMAX_TSTEP(JI,JJ) * POORHODZ(JI,JJ,JK)*(ZWSED(JI,JJ,JK+IKL)-ZWSED(JI,JJ,JK)) PRXT(JI,JJ,JK) = PRXT(JI,JJ,JK) + ZMRCHANGE + PPRXS(JI,JJ,JK) * ZMAX_TSTEP(JI,JJ) PRXS(JI,JJ,JK) = PRXS(JI,JJ,JK) + ZMRCHANGE * ZINVTSTEP IF (GPRESENT_PFPR) THEN diff --git a/src/common/micro/mode_ice4_sedimentation_stat.F90 b/src/common/micro/mode_ice4_sedimentation_stat.F90 index 1da68847dd22e34e17551a9cf95ded4096462d76..8ce021921b69a85407daac8e17573e69afd669ca 100644 --- a/src/common/micro/mode_ice4_sedimentation_stat.F90 +++ b/src/common/micro/mode_ice4_sedimentation_stat.F90 @@ -89,7 +89,7 @@ REAL, DIMENSION(D%NIT,D%NJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upp !* 0.2 declaration of local variables ! LOGICAL :: LLSEA_AND_TOWN -INTEGER :: JRR, JI, JJ, JK +INTEGER :: JRR, JI, JJ, JK, IKB, IKE,IKL, IIE, IIB, IJB, IJE INTEGER :: ISHIFT, IK, IKPLUS REAL :: ZQP, ZP1, ZINVTSTEP, ZGAC, ZGC, ZGAC2, ZGC2, ZRAYDEFO REAL, DIMENSION(D%NIT) :: ZWSEDW1, ZWSEDW2 ! sedimentation speed @@ -111,10 +111,19 @@ FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP)=MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWS !------------------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE) +! +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +IIB=D%NIB +IIE=D%NIE +IJB=D%NJB +IJE=D%NJE +! IF ( PRESENT( PFPR ) ) THEN !Set to 0. to avoid undefined values (in files) - PFPR(:, :, : D%NKTB, :) = 0. - PFPR(:, :, D%NKTE :, :) = 0. + PFPR(:, :, : IKTB, :) = 0. + PFPR(:, :, IKTE :, :) = 0. END IF !------------------------------------------------------------------------------- @@ -142,10 +151,10 @@ DO JRR=2,KRR ENDDO ! calculation sedimentation flux -DO JK = D%NKE , D%NKB, -1*D%NKL +DO JK = IKE , IKB, -1*IKL - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZTSORHODZ(JI,JJ) =PTSTEP/(PRHODREF(JI,JJ,JK)*PDZZ(JI,JJ,JK)) ENDDO ENDDO @@ -203,8 +212,8 @@ DO JK = D%NKE , D%NKB, -1*D%NKL ENDDO ENDIF - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,2)-ZSED(JI,JJ,IK,2))*ZINVTSTEP PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,3)-ZSED(JI,JJ,IK,3))*ZINVTSTEP PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK)+ZTSORHODZ(JI,JJ)*(ZSED(JI,JJ,IKPLUS,4)-ZSED(JI,JJ,IK,4))*ZINVTSTEP @@ -216,9 +225,9 @@ DO JK = D%NKE , D%NKB, -1*D%NKL ENDDO ENDDO - IF (JK==D%NKB) THEN - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + IF (JK==IKB) THEN + DO JJ = IJB, IJE + DO JI = IIB, IIE IF(OSEDIC) PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/CST%XRHOLW PINPRR(JI,JJ) = ZSED(JI,JJ,IK,3)/CST%XRHOLW PINPRI(JI,JJ) = ZSED(JI,JJ,IK,4)/CST%XRHOLW @@ -254,8 +263,8 @@ CONTAINS !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:CLOUD',0,ZHOOK_HANDLE) - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE !estimation of q' taking into account incoming ZWSED from previous vertical level ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ) IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN @@ -316,8 +325,8 @@ CONTAINS !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:PRISTINE_ICE',0,ZHOOK_HANDLE) ! ******* for pristine ice - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ) IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN !calculation of w @@ -365,8 +374,8 @@ CONTAINS !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:SNOW',0,ZHOOK_HANDLE) ! ******* for snow - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ) IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN !calculation of w @@ -416,8 +425,8 @@ CONTAINS !!IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT:OTHER_SPECIES',0,ZHOOK_HANDLE) ! for all but cloud and pristine ice : - DO JJ = D%NJB, D%NJE - DO JI = D%NIB, D%NIE + DO JJ = IJB, IJE + DO JI = IIB, IIE ZQP=ZSED(JI,JJ,IKPLUS,JRR)*ZTSORHODZ(JI,JJ) IF ((PRXT(JI,JJ) > ICED%XRTMIN(JRR)) .OR. (ZQP > ICED%XRTMIN(JRR))) THEN !calculation of w diff --git a/src/common/micro/mode_icecloud.F90 b/src/common/micro/mode_icecloud.F90 index edfab2c0d93f535f6f8e5efe07216c2efb76ff5d..e05effa6e2f66def26ffba530cc9601c3348b921 100644 --- a/src/common/micro/mode_icecloud.F90 +++ b/src/common/micro/mode_icecloud.F90 @@ -75,11 +75,14 @@ REAL, INTENT(OUT) :: RSI(D%NIJT) REAL :: ZSIGMAX,ZSIGMAY,ZSIGMAZ,ZXDIST,ZYDIST,& & ZRSW,ZRHW,ZRHIN,ZDRHDZ,ZZ,ZRHDIST,ZRHLIM, & & ZRHDIF,ZWCLD,ZI2W,ZRHLIMICE,ZRHLIMINV,ZA,ZRHI,ZR -INTEGER :: JIJ +INTEGER :: JIJ, IIJB, IIJE REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('ICECLOUD',0,ZHOOK_HANDLE) - +! +IIJB=D%NIJB +IIJE=D%NIJE +! ZSIGMAX=3.E-4 ! assumed rh variation in x axis direction ZSIGMAY=ZSIGMAX ! assumed rh variation in y axis direction ZSIGMAZ=1.E-2 @@ -92,7 +95,7 @@ ZXDIST=2500. ! due to stronger vertical velocities. ZYDIST=ZXDIST ! gridsize in y axis (m) -DO JIJ = D%NIJB, D%NIJE +DO JIJ = IIJB, IIJE ZR = MAX(0.,PR(JIJ)*PTSTEP) SIFRC(JIJ) = 0. ZA = ZR*PP(JIJ)/(XEPSILO + ZR) diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90 index 7c46fcaafc8148351fe478297a544494318a8d05..01d3e54f76e880ee7667730f6317cb5f2c2d4eb7 100644 --- a/src/common/micro/rain_ice.F90 +++ b/src/common/micro/rain_ice.F90 @@ -287,6 +287,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air pr REAL(KIND=JPRB) :: ZHOOK_HANDLE ! INTEGER :: JIJ, JK +INTEGER :: IKTB, IKTE, IKB, IIJB, IIJE INTEGER :: ISTIJ, ISTK ! !Arrays for nucleation call outisde of ODMICRO points @@ -434,6 +435,11 @@ LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D !------------------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE) ! +IKTB=D%NKTB +IKTE=D%NKTE +IKB=D%NKB +IIJB=D%NIJB +IIJE=D%NIJE !------------------------------------------------------------------------------- ! IF(OCND2) THEN @@ -456,8 +462,8 @@ ZINV_TSTEP=1./PTSTEP GEXT_TEND=.TRUE. ! ! LSFACT and LVFACT without exner -DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE +DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE IF (KRR==7) THEN ZRICE=PRIT(JIJ,JK)+PRST(JIJ,JK)+PRGT(JIJ,JK)+PRHT(JIJ,JK) ELSE @@ -472,13 +478,13 @@ ENDDO ! !Compute lambda_snow parameter !ZT en KELVIN -DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE +DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE ZLBDAS(JIJ,JK)=1000. END DO END DO -DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE +DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE IF (PARAMI%LSNOW_T) THEN IF (PRST(JIJ,JK)>ICED%XRTMIN(5)) THEN IF(ZT(JIJ,JK)>CST%XTT-10.0) THEN @@ -516,8 +522,8 @@ IF(.NOT. PARAMI%LSEDIM_AFTER) THEN IF(HSEDIM=='STAT') THEN IF(KRR==7) THEN - DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE + DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP @@ -536,8 +542,8 @@ IF(.NOT. PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR) ELSE - DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE + DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP @@ -555,7 +561,7 @@ IF(.NOT. PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PFPR=PFPR) ENDIF - PINPRS(D%NIJB:D%NIJE) = PINPRS(D%NIJB:D%NIJE) + ZINPRI(D%NIJB:D%NIJE) + PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE) !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables ELSEIF(HSEDIM=='SPLI') THEN IF(KRR==7) THEN @@ -575,7 +581,7 @@ IF(.NOT. PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PFPR=PFPR) ENDIF - PINPRS(D%NIJB:D%NIJE) = PINPRS(D%NIJB:D%NIJE) + ZINPRI(D%NIJB:D%NIJE) + PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE) !We correct negativities with conservation !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used. ! It is initialized with the m.r. at T and is modified by two tendencies: @@ -626,7 +632,7 @@ IF(.NOT. PARAMI%LSEDIM_AFTER) THEN ENDIF ! -DO JK = D%NKTB,D%NKTE +DO JK = IKTB,IKTE !Backup of T variables ZWR(:,JK,IRV)=PRVT(:,JK) ZWR(:,JK,IRC)=PRCT(:,JK) @@ -704,7 +710,7 @@ ENDIF ! optimization by looking for locations where ! the microphysical fields are larger than a minimal value only !!! ! -IF (KSIZE /= COUNT(ODMICRO(D%NIJB:D%NIJE,D%NKTB:D%NKTE))) THEN +IF (KSIZE /= COUNT(ODMICRO(IIJB:IIJE,IKTB:IKTE))) THEN CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'RAIN_ICE : KSIZE /= COUNT(ODMICRO)') ENDIF @@ -727,8 +733,8 @@ IF (KSIZE > 0) THEN ! starting indexes : IC=0 - ISTK=D%NKTB - ISTIJ=D%NIJB + ISTK=IKTB + ISTIJ=IIJB DO JMICRO=1,KSIZE,KPROMA @@ -738,9 +744,9 @@ IF (KSIZE > 0) THEN ! -------- ! Setup packing parameters - OUTER_LOOP: DO JK = ISTK, D%NKTE + OUTER_LOOP: DO JK = ISTK, IKTE IF (ANY(ODMICRO(:,JK))) THEN - DO JIJ = ISTIJ, D%NIJE + DO JIJ = ISTIJ, IIJE IF (ODMICRO(JIJ,JK)) THEN IC=IC+1 ! Initialization of variables in packed format : @@ -789,14 +795,14 @@ IF (KSIZE > 0) THEN IF (IC==IMICRO) THEN ! the end of the chunk has been reached, then reset the starting index : ISTIJ=JIJ+1 - IF (ISTIJ <= D%NIJE) THEN + IF (ISTIJ <= IIJE) THEN ISTK=JK ELSE ! end of line, restart from 1 and increment upper loop ISTK=JK+1 - IF (ISTK > D%NKTE) THEN + IF (ISTK > IKTE) THEN ! end of line, restart from 1 - ISTK=D%NKTB + ISTK=IKTB ENDIF ENDIF IC=0 @@ -806,7 +812,7 @@ IF (KSIZE > 0) THEN ENDDO ENDIF ! restart inner loop on JIJ : - ISTIJ=D%NIJB + ISTIJ=IIJB ENDDO OUTER_LOOP IF (GEXT_TEND) THEN @@ -1124,8 +1130,8 @@ PCIT(:,:)=ZCITOUT(:,:) ! ---------------------------------------------------------------- ! LLW3D(:,:)=.FALSE. -DO JK=D%NKTB,D%NKTE - DO JIJ=D%NIJB,D%NIJE +DO JK=IKTB,IKTE + DO JIJ=IIJB,IIJE IF (.NOT. ODMICRO(JIJ, JK)) THEN LLW3D(JIJ, JK)=.TRUE. ZW3D(JIJ, JK)=ZZ_LSFACT(JIJ, JK)/PEXN(JIJ, JK) @@ -1148,8 +1154,8 @@ CALL ICE4_NUCLEATION(CST, PARAMI, ICEP, ICED, D%NIJT*D%NKT, LLW3D(:,:), & ! !*** 7.1 total tendencies limited by available species ! -DO JK = D%NKTB, D%NKTE - DO CONCURRENT (JIJ=D%NIJB:D%NIJE) +DO JK = IKTB, IKTE + DO CONCURRENT (JIJ=IIJB:IIJE) !LV/LS ZZ_LSFACT(JIJ,JK)=ZZ_LSFACT(JIJ,JK)/PEXNREF(JIJ,JK) ZZ_LVFACT(JIJ,JK)=ZZ_LVFACT(JIJ,JK)/PEXNREF(JIJ,JK) @@ -1194,8 +1200,8 @@ ENDDO IF(BUCONF%LBU_ENABLE) THEN IF (BUCONF%LBUDGET_TH) THEN ZZ_DIFF(:,:)=0. - DO JK = D%NKTB, D%NKTE - DO JIJ = D%NIJB, D%NIJE + DO JK = IKTB, IKTE + DO JIJ = IIJB, IIJE ZZ_DIFF(JIJ, JK) = ZZ_LSFACT(JIJ, JK) - ZZ_LVFACT(JIJ, JK) ENDDO ENDDO @@ -1205,8 +1211,8 @@ IF(BUCONF%LBU_ENABLE) THEN DO JL=1, KSIZE ZW(I1TOT(JL), I2TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP END DO - DO JK = D%NKTB, D%NKTE - DO JIJ = D%NIJB, D%NIJE + DO JK = IKTB, IKTE + DO JIJ = IIJB, IIJE ZW(JIJ,JK)=ZW(JIJ,JK)+ZZ_RVHENI(JIJ,JK) ENDDO ENDDO @@ -1605,8 +1611,8 @@ IF(PARAMI%LSEDIM_AFTER) THEN IF(HSEDIM=='STAT') THEN IF (KRR==7) THEN - DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE + DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP @@ -1625,8 +1631,8 @@ IF(PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR) ELSE - DO JK = D%NKTB,D%NKTE - DO JIJ = D%NIJB,D%NIJE + DO JK = IKTB,IKTE + DO JIJ = IIJB,IIJE ZRCT(JIJ,JK)=PRCS(JIJ,JK)*PTSTEP ZRRT(JIJ,JK)=PRRS(JIJ,JK)*PTSTEP ZRIT(JIJ,JK)=PRIS(JIJ,JK)*PTSTEP @@ -1644,7 +1650,7 @@ IF(PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PFPR=PFPR) ENDIF - PINPRS(D%NIJB:D%NIJE) = PINPRS(D%NIJB:D%NIJE) + ZINPRI(D%NIJB:D%NIJE) + PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE) !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables ELSEIF(HSEDIM=='SPLI') THEN !SR: It *seems* that we must have two separate calls for ifort @@ -1665,7 +1671,7 @@ IF(PARAMI%LSEDIM_AFTER) THEN &PSEA=PSEA, PTOWN=PTOWN, & &PFPR=PFPR) ENDIF - PINPRS(D%NIJB:D%NIJE) = PINPRS(D%NIJB:D%NIJE) + ZINPRI(D%NIJB:D%NIJE) + PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE) !We correct negativities with conservation !SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used. ! It is initialized with the m.r. at T and is modified by two tendencies: @@ -1713,9 +1719,9 @@ IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation PINDEP(:)=0. !DEC$ IVDEP - DO JIJ = D%NIJB, D%NIJE - PINDEP(JIJ) = PARAMI%XVDEPOSC * PRCT(JIJ, D%NKB) * PRHODREF(JIJ, D%NKB) / CST%XRHOLW - PRCS(JIJ, D%NKB) = PRCS(JIJ, D%NKB) - PARAMI%XVDEPOSC * PRCT(JIJ, D%NKB) / PDZZ(JIJ, D%NKB) + DO JIJ = IIJB, IIJE + PINDEP(JIJ) = PARAMI%XVDEPOSC * PRCT(JIJ, IKB) * PRHODREF(JIJ, IKB) / CST%XRHOLW + PRCS(JIJ, IKB) = PRCS(JIJ, IKB) - PARAMI%XVDEPOSC * PRCT(JIJ, IKB) / PDZZ(JIJ, IKB) PINPRC(JIJ) = PINPRC(JIJ) + PINDEP(JIJ) ENDDO @@ -1746,8 +1752,8 @@ CONTAINS IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE) ! !We correct negativities with conservation - DO JK = D%NKTB, D%NKTE - DO JIJ = D%NIJB, D%NIJE + DO JK = IKTB, IKTE + DO JIJ = IIJB, IIJE ! 1) deal with negative values for mixing ratio, except for vapor ZW =PRC(JIJ,JK)-MAX(PRC(JIJ,JK), 0.) PRV(JIJ,JK)=PRV(JIJ,JK)+ZW diff --git a/src/common/turb/mode_bl89.F90 b/src/common/turb/mode_bl89.F90 index ce9a0898fb4f41c345e4fe938a85a11a3c437ef9..8291ef9a6f90dcbcfc0cb455f7a70865324c9839 100644 --- a/src/common/turb/mode_bl89.F90 +++ b/src/common/turb/mode_bl89.F90 @@ -87,8 +87,7 @@ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! CPROGRAM is the program !* 0.2 Declaration of local variables ! ------------------------------ ! -INTEGER :: IKB,IKE -INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain +INTEGER :: IKT,IKB,IKA,IKU REAL, DIMENSION(D%NIJT,D%NKT) :: ZVPT ! Virtual Potential Temp at half levels REAL, DIMENSION(D%NIJT,D%NKT) :: ZDELTVPT @@ -107,6 +106,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZSQRT_TKE REAL, DIMENSION(D%NIJT,D%NKT) :: PLMDN ! INTEGER :: IIJB, IIJE +INTEGER :: IKTB, IKTE, IKE,IKL INTEGER :: JIJ ! horizontal loop counter INTEGER :: JK,JKK ! loop counters INTEGER :: JRR ! moist loop counter @@ -122,8 +122,16 @@ Z2SQRT2=2.*SQRT(2.) ! ZRVORD = CST%XRV / CST%XRD ! -IIJB = D%NIJB -IIJE = D%NIJE +IIJB=D%NIJB +IIJE=D%NIJE +IKTB=D%NKTB +IKTE=D%NKTE +IKT=D%NKT +IKB=D%NKB +IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL !------------------------------------------------------------------------------- ! !* 1. pack the horizontal dimensions into one @@ -133,22 +141,22 @@ IIJE = D%NIJE ! 2D array => 3D array ! IF (OOCEAN) THEN - DO JK=1,D%NKT + DO JK=1,IKT DO JIJ=IIJB,IIJE ZG_O_THVREF(JIJ,JK) = CST%XG * CST%XALPHAOC END DO END DO ELSE !Atmosphere case - DO JK=1,D%NKT + DO JK=1,IKT DO JIJ=IIJB,IIJE ZG_O_THVREF(JIJ,JK) = CST%XG / PTHVREF(JIJ,JK) END DO END DO END IF ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZSQRT_TKE(IIJB:IIJE,1:D%NKT) = SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZSQRT_TKE(IIJB:IIJE,1:IKT) = SQRT(PTKEM(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !ZBL89EXP is defined here because (and not in ini_cturb) because CSTURB%XCED is defined in read_exseg (depending on BL89/RM17) ZBL89EXP = LOG(16.)/(4.*LOG(CST%XKARMAN)+LOG(CSTURB%XCED)-3.*LOG(CSTURB%XCMFS)) @@ -159,18 +167,18 @@ ZUSRBL89 = 1./ZBL89EXP ! ----------------------------------------------- ! IF(KRR /= 0) THEN - ZSUM(IIJB:IIJE,1:D%NKT) = 0. + ZSUM(IIJB:IIJE,1:IKT) = 0. DO JRR=1,KRR - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZSUM(IIJB:IIJE,1:D%NKT) = ZSUM(IIJB:IIJE,1:D%NKT)+PRM(IIJB:IIJE,1:D%NKT,JRR) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZSUM(IIJB:IIJE,1:IKT) = ZSUM(IIJB:IIJE,1:IKT)+PRM(IIJB:IIJE,1:IKT,JRR) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDDO - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZVPT(IIJB:IIJE,1:D%NKT)=PTHLM(IIJB:IIJE,1:D%NKT) * ( 1. + ZRVORD*PRM(IIJB:IIJE,1:D%NKT,1) ) & - / ( 1. + ZSUM(IIJB:IIJE,1:D%NKT) ) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZVPT(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT) * ( 1. + ZRVORD*PRM(IIJB:IIJE,1:IKT,1) ) & + / ( 1. + ZSUM(IIJB:IIJE,1:IKT) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - ZVPT(IIJB:IIJE,1:D%NKT)=PTHLM(IIJB:IIJE,1:D%NKT) + ZVPT(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT) END IF ! !!!!!!!!!!!! @@ -184,21 +192,21 @@ END IF !but algorithm must remain the same. !!!!!!!!!!!! ! -DO JK=D%NKTB,D%NKTE +DO JK=IKTB,IKTE DO JIJ=IIJB,IIJE - ZDELTVPT(JIJ,JK) = ZVPT(JIJ,JK) - ZVPT(JIJ,JK-D%NKL) - ZHLVPT(JIJ,JK) = 0.5 * ( ZVPT(JIJ,JK) + ZVPT(JIJ,JK-D%NKL) ) + ZDELTVPT(JIJ,JK) = ZVPT(JIJ,JK) - ZVPT(JIJ,JK-IKL) + ZHLVPT(JIJ,JK) = 0.5 * ( ZVPT(JIJ,JK) + ZVPT(JIJ,JK-IKL) ) END DO END DO ! DO JIJ=IIJB,IIJE - ZDELTVPT(JIJ,D%NKU) = ZVPT(JIJ,D%NKU) - ZVPT(JIJ,D%NKU-D%NKL) - ZDELTVPT(JIJ,D%NKA) = 0. - ZHLVPT(JIJ,D%NKU) = 0.5 * ( ZVPT(JIJ,D%NKU) + ZVPT(JIJ,D%NKU-D%NKL) ) - ZHLVPT(JIJ,D%NKA) = ZVPT(JIJ,D%NKA) + ZDELTVPT(JIJ,IKU) = ZVPT(JIJ,IKU) - ZVPT(JIJ,IKU-IKL) + ZDELTVPT(JIJ,IKA) = 0. + ZHLVPT(JIJ,IKU) = 0.5 * ( ZVPT(JIJ,IKU) + ZVPT(JIJ,IKU-IKL) ) + ZHLVPT(JIJ,IKA) = ZVPT(JIJ,IKA) END DO ! -DO JK=1,D%NKT +DO JK=1,IKT DO JIJ=IIJB,IIJE IF(ABS(ZDELTVPT(JIJ,JK))<CSTURB%XLINF) THEN ZDELTVPT(JIJ,JK)=CSTURB%XLINF @@ -211,7 +219,7 @@ END DO !* 3. loop on model levels ! -------------------- ! -DO JK=D%NKTB,D%NKTE +DO JK=IKTB,IKTE ! !------------------------------------------------------------------------------- ! @@ -220,7 +228,7 @@ DO JK=D%NKTB,D%NKTE ZINTE(IIJB:IIJE)=PTKEM(IIJB:IIJE,JK) ZLWORK=0. ZTESTM=1. - DO JKK=JK,D%NKB,-D%NKL + DO JKK=JK,IKB,-IKL IF(ZTESTM > 0.) THEN ZTESTM=0. DO JIJ=IIJB,IIJE @@ -258,7 +266,7 @@ DO JK=D%NKTB,D%NKTE ! ----------------------------------------------- ! DO JIJ=IIJB,IIJE - PLMDN(JIJ,JK)=MIN(ZLWORK(JIJ),0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+D%NKL))-PZZ(JIJ,D%NKB)) + PLMDN(JIJ,JK)=MIN(ZLWORK(JIJ),0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))-PZZ(JIJ,IKB)) END DO ! !------------------------------------------------------------------------------- @@ -270,7 +278,7 @@ DO JK=D%NKTB,D%NKTE ZLWORK(IIJB:IIJE)=0. ZTESTM=1. ! - DO JKK=JK+D%NKL,D%NKE,D%NKL + DO JKK=JK+IKL,IKE,IKL IF(ZTESTM > 0.) THEN ZTESTM=0. DO JIJ=IIJB,IIJE @@ -284,11 +292,11 @@ DO JK=D%NKTB,D%NKTE ZTESTM=ZTESTM+ZTEST0 ZLWORK1=PDZZ(JIJ,JKK) !--------- SHEAR + STABILITY ----------- - ZLWORK2= ( - ZG_O_THVREF(JIJ,JK) *(ZVPT(JIJ,JKK-D%NKL) - ZVPT(JIJ,JK) ) & + ZLWORK2= ( - ZG_O_THVREF(JIJ,JK) *(ZVPT(JIJ,JKK-IKL) - ZVPT(JIJ,JK) ) & - CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) & + SQRT (ABS( & (CSTURB%XRM17*PSHEAR(JIJ,JKK)*ZSQRT_TKE(JIJ,JK) & - + ( ZG_O_THVREF(JIJ,JK) * (ZVPT(JIJ,JKK-D%NKL) - ZVPT(JIJ,JK))) )**2 & + + ( ZG_O_THVREF(JIJ,JK) * (ZVPT(JIJ,JKK-IKL) - ZVPT(JIJ,JK))) )**2 & + 2. * ZINTE(JIJ) * & #ifdef REPRO48 ZG_O_THVREF(JIJ,JK)* ZDELTVPT(JIJ,JKK)/PDZZ(JIJ,JKK)))) / & @@ -332,9 +340,9 @@ END DO !* 9. boundaries ! ---------- ! -PLM(IIJB:IIJE,D%NKA)=PLM(IIJB:IIJE,D%NKB) -PLM(IIJB:IIJE,D%NKE)=PLM(IIJB:IIJE,D%NKE-D%NKL) -PLM(IIJB:IIJE,D%NKU)=PLM(IIJB:IIJE,D%NKE-D%NKL) +PLM(IIJB:IIJE,IKA)=PLM(IIJB:IIJE,IKB) +PLM(IIJB:IIJE,IKE)=PLM(IIJB:IIJE,IKE-IKL) +PLM(IIJB:IIJE,IKU)=PLM(IIJB:IIJE,IKE-IKL) ! !------------------------------------------------------------------------------- ! diff --git a/src/common/turb/mode_bl_depth_diag.F90 b/src/common/turb/mode_bl_depth_diag.F90 index b054c0b8bc267e47bc08de629017abc0bc453a62..2e817e7cc1924ad6cf1032be9a0b60ef6a162b4c 100644 --- a/src/common/turb/mode_bl_depth_diag.F90 +++ b/src/common/turb/mode_bl_depth_diag.F90 @@ -67,7 +67,7 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: BL_DEPTH_DIAG3D ! 0.2 declaration of local variables ! INTEGER :: JIJ,JK ! loop counters -INTEGER :: IKB,IKE,IIJB,IIJE ! index value for the Beginning +INTEGER :: IKB,IKE,IIJB,IIJE,IKL REAL :: ZFLX ! flux at top of BL ! !---------------------------------------------------------------------------- @@ -76,6 +76,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',0,ZHOOK_HANDLE) IKB=D%NKTB IKE=D%NKTE +IKL=D%NKL IIJE=D%NIJE IIJB=D%NIJB ! @@ -84,14 +85,14 @@ BL_DEPTH_DIAG3D(:) = 0. DO JIJ=IIJB,IIJE IF (PSURF(JIJ)==0.) CYCLE - DO JK=IKB,IKE,D%NKL - IF (PZZ(JIJ,JK-D%NKL)<=PZS(JIJ)) CYCLE + DO JK=IKB,IKE,IKL + IF (PZZ(JIJ,JK-IKL)<=PZS(JIJ)) CYCLE ZFLX = PSURF(JIJ) * PFTOP_O_FSURF - IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-D%NKL)-ZFLX) <= 0. ) THEN - BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-D%NKL) - PZS(JIJ)) & - + (PZZ (JIJ,JK) - PZZ (JIJ,JK-D%NKL)) & - * (ZFLX - PFLUX(JIJ,JK-D%NKL) ) & - / (PFLUX(JIJ,JK) - PFLUX(JIJ,JK-D%NKL) ) + IF ( (PFLUX(JIJ,JK)-ZFLX)*(PFLUX(JIJ,JK-IKL)-ZFLX) <= 0. ) THEN + BL_DEPTH_DIAG3D(JIJ) = (PZZ (JIJ,JK-IKL) - PZS(JIJ)) & + + (PZZ (JIJ,JK) - PZZ (JIJ,JK-IKL)) & + * (ZFLX - PFLUX(JIJ,JK-IKL) ) & + / (PFLUX(JIJ,JK) - PFLUX(JIJ,JK-IKL) ) EXIT END IF END DO @@ -126,12 +127,14 @@ REAL, DIMENSION(1,1,D%NKT) :: ZFLUX REAL, DIMENSION(1,1,D%NKT) :: ZZZ REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG ! +INTEGER :: IKT REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',0,ZHOOK_HANDLE) +IKT=D%NKT ZSURF = PSURF ZZS = PZS -ZFLUX(1,1,1:D%NKT) = PFLUX(1:D%NKT) -ZZZ (1,1,1:D%NKT) = PZZ (1:D%NKT) +ZFLUX(1,1,1:IKT) = PFLUX(1:IKT) +ZZZ (1,1,1:IKT) = PZZ (1:IKT) ! CALL BL_DEPTH_DIAG_3D(D,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF,ZBL_DEPTH_DIAG) ! diff --git a/src/common/turb/mode_compute_bl89_ml.F90 b/src/common/turb/mode_compute_bl89_ml.F90 index 714e9a41c0bc6c615bdc99995ab18a1ef9a44471..ce14d0b567d93ef8328e932da3a6bfeeefcde264 100644 --- a/src/common/turb/mode_compute_bl89_ml.F90 +++ b/src/common/turb/mode_compute_bl89_ml.F90 @@ -80,7 +80,9 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZDELTVPT,ZHLVPT INTEGER :: J1D !horizontal loop counter INTEGER :: JKK !loop counters -INTEGER :: JI, JK +INTEGER :: JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT,IKB,IKA,IKE,IKL REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization !------------------------------------------------------------------------------------- ! @@ -89,22 +91,30 @@ REAL :: ZTEST,ZTEST0,ZTESTM !test for vectorization REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('COMPUTE_BL89_ML',0,ZHOOK_HANDLE) ! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKA=D%NKA +IKE=D%NKE +IKL=D%NKL +! CALL DZM_MF(D, PVPT(:,:), ZDELTVPT(:,:)) -ZDELTVPT(D%NIJB:D%NIJE,D%NKA)=0. -!$mnh_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -WHERE (ABS(ZDELTVPT(D%NIJB:D%NIJE,1:D%NKT))<CSTURB%XLINF) - ZDELTVPT(D%NIJB:D%NIJE,1:D%NKT)=CSTURB%XLINF +ZDELTVPT(IIJB:IIJE,IKA)=0. +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE (ABS(ZDELTVPT(IIJB:IIJE,1:IKT))<CSTURB%XLINF) + ZDELTVPT(IIJB:IIJE,1:IKT)=CSTURB%XLINF END WHERE -!$mnh_end_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL MZM_MF(D, PVPT(:,:), ZHLVPT(:,:)) ! !We consider that gradient between mass levels KKB and KKB+KKL is the same as !the gradient between flux level KKB and mass level KKB -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZDELTVPT(D%NIJB:D%NIJE,D%NKB)=PDZZ2D(D%NIJB:D%NIJE,D%NKB)*ZDELTVPT(D%NIJB:D%NIJE,D%NKB+D%NKL)/PDZZ2D(D%NIJB:D%NIJE,D%NKB+D%NKL) -ZHLVPT(D%NIJB:D%NIJE,D%NKB)=PVPT(D%NIJB:D%NIJE,D%NKB)-ZDELTVPT(D%NIJB:D%NIJE,D%NKB)*0.5 -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZDELTVPT(IIJB:IIJE,IKB)=PDZZ2D(IIJB:IIJE,IKB)*ZDELTVPT(IIJB:IIJE,IKB+IKL)/PDZZ2D(IIJB:IIJE,IKB+IKL) +ZHLVPT(IIJB:IIJE,IKB)=PVPT(IIJB:IIJE,IKB)-ZDELTVPT(IIJB:IIJE,IKB)*0.5 +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! ! @@ -113,15 +123,15 @@ ZHLVPT(D%NIJB:D%NIJE,D%NKB)=PVPT(D%NIJB:D%NIJE,D%NKB)-ZDELTVPT(D%NIJB:D%NIJE,D%N ! IF (OUPORDN.EQV..TRUE.) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZINTE(D%NIJB:D%NIJE)=PTKEM_DEP(D%NIJB:D%NIJE) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZINTE(IIJB:IIJE)=PTKEM_DEP(IIJB:IIJE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) PLWORK=0. ZTESTM=1. IF(OFLUX)THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZVPT_DEP(D%NIJB:D%NIJE)=ZHLVPT(D%NIJB:D%NIJE,KK) ! departure point is on flux level - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZVPT_DEP(IIJB:IIJE)=ZHLVPT(IIJB:IIJE,KK) ! departure point is on flux level + !$mnh_end_expand_array(JIJ=IIJB:IIJE) !We must compute what happens between flux level KK and mass level KK DO J1D=D%NIJB,D%NIJE ZTEST0=0.5+SIGN(0.5,ZINTE(J1D)) ! test if there's energy to consume @@ -151,12 +161,12 @@ IF (OUPORDN.EQV..TRUE.) THEN ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D) ENDDO ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZVPT_DEP(D%NIJB:D%NIJE)=PVPT(D%NIJB:D%NIJE,KK) ! departure point is on mass level - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZVPT_DEP(IIJB:IIJE)=PVPT(IIJB:IIJE,KK) ! departure point is on mass level + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF - DO JKK=KK+D%NKL,D%NKE,D%NKL + DO JKK=KK+IKL,IKE,IKL IF(ZTESTM > 0.) THEN ZTESTM=0 DO J1D=D%NIJB,D%NIJE @@ -169,11 +179,11 @@ IF (OUPORDN.EQV..TRUE.) THEN ZLWORK1(J1D)=PDZZ2D(J1D,JKK) !ZLWORK2 jump of the last reached level ZLWORK2(J1D)= ( - PG_O_THVREF(J1D) * & - ( PVPT(J1D,JKK-D%NKL) - ZVPT_DEP(J1D) ) & + ( PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D) ) & - CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) & + SQRT (ABS( & (CSTURB%XRM17*PSHEAR(J1D,JKK)*sqrt(abs(PTKEM_DEP(J1D))) + & - PG_O_THVREF(J1D) * (PVPT(J1D,JKK-D%NKL) - ZVPT_DEP(J1D)) )**2 & + PG_O_THVREF(J1D) * (PVPT(J1D,JKK-IKL) - ZVPT_DEP(J1D)) )**2 & + 2. * ZINTE(J1D) * PG_O_THVREF(J1D) & * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) )) ) / & ( PG_O_THVREF(J1D) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) ) @@ -192,12 +202,12 @@ ENDIF IF (OUPORDN.EQV..FALSE.) THEN IF(OFLUX) CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length') - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZINTE(D%NIJB:D%NIJE)=PTKEM_DEP(D%NIJB:D%NIJE) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZINTE(IIJB:IIJE)=PTKEM_DEP(IIJB:IIJE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) PLWORK=0. ZTESTM=1. - DO JKK=KK,D%NKB,-D%NKL + DO JKK=KK,IKB,-IKL IF(ZTESTM > 0.) THEN ZTESTM=0 DO J1D=D%NIJB,D%NIJE diff --git a/src/common/turb/mode_compute_function_thermo_mf.F90 b/src/common/turb/mode_compute_function_thermo_mf.F90 index c8d183033ccf6aa5c12a9c57999d18639a387e8f..fdb54d89b93374cc3fb1e4e25bd5fc3eb3c23060 100644 --- a/src/common/turb/mode_compute_function_thermo_mf.F90 +++ b/src/common/turb/mode_compute_function_thermo_mf.F90 @@ -92,12 +92,19 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ZATHETA_I, & ! ZLVOCP,ZLSOCP -INTEGER :: JRR, JI, JK +INTEGER :: JRR, JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKTB,IKTE REAL(KIND=JPRB) :: ZHOOK_HANDLE ! !------------------------------------------------------------------------------- ! IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',0,ZHOOK_HANDLE) +! +IIJE=D%NIJE +IIJB=D%NIJB +IKTB=D%NKTB +IKTE=D%NKTE ! ZEPS = CST%XMV / CST%XMD @@ -107,140 +114,140 @@ IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',0,ZHOOK_HANDLE) ZCP=CST%XCPD IF (KRR > 0) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) - ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + CST%XCPV * PR(D%NIJB:D%NIJE,D%NKTB:D%NKTE,1) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) + ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCPV * PR(IIJB:IIJE,IKTB:IKTE,1) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ENDIF DO JRR = 2,1+KRRL ! loop on the liquid components - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) - ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + CST%XCL * PR(D%NIJB:D%NIJE,D%NKTB:D%NKTE,JRR) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) + ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCL * PR(IIJB:IIJE,IKTB:IKTE,JRR) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) END DO DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) - ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + CST%XCI * PR(D%NIJB:D%NIJE,D%NKTB:D%NKTE,JRR) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) + ZCP(IIJB:IIJE,IKTB:IKTE) = ZCP(IIJB:IIJE,IKTB:IKTE) + CST%XCI * PR(IIJB:IIJE,IKTB:IKTE,JRR) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) END DO !* Temperature ! -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) -PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = PTH(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * PEXN(D%NIJB:D%NIJE,D%NKTB:D%NKTE) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) +PT(IIJB:IIJE,IKTB:IKTE) = PTH(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ! ! !! Liquid water ! IF ( KRRL >= 1 ) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ! !* Lv/Cph ! - ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)-CST%XTT) ) / & - & ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + ZLVOCP(IIJB:IIJE,IKTB:IKTE) = (CST%XLVTT + (CST%XCPV-CST%XCL) * (PT(IIJB:IIJE,IKTB:IKTE)-CST%XTT) ) / & + & ZCP(IIJB:IIJE,IKTB:IKTE) ! !* Saturation vapor pressure with respect to water ! - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = EXP(CST%XALPW - CST%XBETAW/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - & - &CST%XGAMW*ALOG( PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) ) + ZE(IIJB:IIJE,IKTB:IKTE) = EXP(CST%XALPW - CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - & + &CST%XGAMW*ALOG( PT(IIJB:IIJE,IKTB:IKTE) ) ) ! !* Saturation mixing ratio with respect to water ! - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZEPS / & - & ( PPABS(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) + ZE(IIJB:IIJE,IKTB:IKTE) = ZE(IIJB:IIJE,IKTB:IKTE) * ZEPS / & + & ( PPABS(IIJB:IIJE,IKTB:IKTE) - ZE(IIJB:IIJE,IKTB:IKTE) ) ! !* Compute the saturation mixing ratio derivative (rvs') ! - ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (CST%XBETAW/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - CST%XGAMW) / PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)& - * ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ( 1. + ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) / ZEPS ) + ZDEDT(IIJB:IIJE,IKTB:IKTE) = (CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMW) / PT(IIJB:IIJE,IKTB:IKTE)& + * ZE(IIJB:IIJE,IKTB:IKTE) * ( 1. + ZE(IIJB:IIJE,IKTB:IKTE) / ZEPS ) ! !* Compute Amoist and Atheta ! IF (OSTATNW) THEN - ZAMOIST_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= 1.0/( 1.0 + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE)) - ZATHETA_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= ZAMOIST_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * PEXN(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & - * ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + ZAMOIST_W(IIJB:IIJE,IKTB:IKTE)= 1.0/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE)) + ZATHETA_W(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) & + * ZDEDT(IIJB:IIJE,IKTB:IKTE) ELSE - ZAMOIST_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= 0.5/( 1.0 + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) - ZATHETA_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= ZAMOIST_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * PEXN(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * & - ( ( ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - PR(D%NIJB:D%NIJE,D%NKTB:D%NKTE,1) ) * ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) / & - ( 1. + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) * & + ZAMOIST_W(IIJB:IIJE,IKTB:IKTE)= 0.5/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) ) + ZATHETA_W(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) * & + ( ( ZE(IIJB:IIJE,IKTB:IKTE) - PR(IIJB:IIJE,IKTB:IKTE,1) ) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) / & + ( 1. + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLVOCP(IIJB:IIJE,IKTB:IKTE) ) * & ( & - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * (1. + ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE)/ZEPS) & - * ( -2.*CST%XBETAW/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + CST%XGAMW ) / PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)**2& - +ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * (1. + 2. * ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE)/ZEPS) & - * ( CST%XBETAW/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - CST%XGAMW ) / PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & + ZE(IIJB:IIJE,IKTB:IKTE) * (1. + ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) & + * ( -2.*CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) + CST%XGAMW ) / PT(IIJB:IIJE,IKTB:IKTE)**2& + +ZDEDT(IIJB:IIJE,IKTB:IKTE) * (1. + 2. * ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) & + * ( CST%XBETAW/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMW ) / PT(IIJB:IIJE,IKTB:IKTE) & ) & - - ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & + - ZDEDT(IIJB:IIJE,IKTB:IKTE) & ) END IF - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ! !! Solid water ! IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ! !* Ls/Cph ! - ZLSOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)-CST%XTT) ) / & - & ZCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + ZLSOCP(IIJB:IIJE,IKTB:IKTE) = (CST%XLSTT + (CST%XCPV-CST%XCI) * (PT(IIJB:IIJE,IKTB:IKTE)-CST%XTT) ) / & + & ZCP(IIJB:IIJE,IKTB:IKTE) ! !* Saturation vapor pressure with respect to ice ! - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = EXP(CST%XALPI - CST%XBETAI/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - & - &CST%XGAMI*ALOG( PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) ) + ZE(IIJB:IIJE,IKTB:IKTE) = EXP(CST%XALPI - CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) - & + &CST%XGAMI*ALOG( PT(IIJB:IIJE,IKTB:IKTE) ) ) ! !* Saturation mixing ratio with respect to ice ! - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZEPS / & - & ( PPABS(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) + ZE(IIJB:IIJE,IKTB:IKTE) = ZE(IIJB:IIJE,IKTB:IKTE) * ZEPS / & + & ( PPABS(IIJB:IIJE,IKTB:IKTE) - ZE(IIJB:IIJE,IKTB:IKTE) ) ! !* Compute the saturation mixing ratio derivative (rvs') ! - ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (CST%XBETAI/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)-CST%XGAMI) /PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)& - * ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ( 1. + ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) / ZEPS ) + ZDEDT(IIJB:IIJE,IKTB:IKTE) = (CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE)-CST%XGAMI) /PT(IIJB:IIJE,IKTB:IKTE)& + * ZE(IIJB:IIJE,IKTB:IKTE) * ( 1. + ZE(IIJB:IIJE,IKTB:IKTE) / ZEPS ) ! !* Compute Amoist and Atheta ! IF (OSTATNW) THEN - ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= 1.0/( 1.0 + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) *ZLVOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE)) - ZATHETA_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * PEXN(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & - * ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)= 1.0/( 1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) *ZLVOCP(IIJB:IIJE,IKTB:IKTE)) + ZATHETA_I(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_I(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) & + * ZDEDT(IIJB:IIJE,IKTB:IKTE) ELSE - ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= 0.5/(1.0 + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZLSOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE)) - ZATHETA_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)= ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * PEXN(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * & - ( ( ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - PR(D%NIJB:D%NIJE,D%NKTB:D%NKTE,1) ) * ZLSOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) / & - ( 1. + ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * ZLSOCP(D%NIJB:D%NIJE,D%NKTB:D%NKTE) ) * & + ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)= 0.5/(1.0 + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLSOCP(IIJB:IIJE,IKTB:IKTE)) + ZATHETA_I(IIJB:IIJE,IKTB:IKTE)= ZAMOIST_I(IIJB:IIJE,IKTB:IKTE) * PEXN(IIJB:IIJE,IKTB:IKTE) * & + ( ( ZE(IIJB:IIJE,IKTB:IKTE) - PR(IIJB:IIJE,IKTB:IKTE,1) ) * ZLSOCP(IIJB:IIJE,IKTB:IKTE) / & + ( 1. + ZDEDT(IIJB:IIJE,IKTB:IKTE) * ZLSOCP(IIJB:IIJE,IKTB:IKTE) ) * & ( & - ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * (1. + ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE)/ZEPS) & - * ( -2.*CST%XBETAI/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) + CST%XGAMI ) / PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE)**2 & - +ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) * (1. + 2. * ZE(D%NIJB:D%NIJE,D%NKTB:D%NKTE)/ZEPS) & - * ( CST%XBETAI/PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - CST%XGAMI ) / PT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & + ZE(IIJB:IIJE,IKTB:IKTE) * (1. + ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) & + * ( -2.*CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) + CST%XGAMI ) / PT(IIJB:IIJE,IKTB:IKTE)**2 & + +ZDEDT(IIJB:IIJE,IKTB:IKTE) * (1. + 2. * ZE(IIJB:IIJE,IKTB:IKTE)/ZEPS) & + * ( CST%XBETAI/PT(IIJB:IIJE,IKTB:IKTE) - CST%XGAMI ) / PT(IIJB:IIJE,IKTB:IKTE) & ) & - - ZDEDT(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & + - ZDEDT(IIJB:IIJE,IKTB:IKTE) & ) END IF - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ELSE - ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)=0. - ZATHETA_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE)=0. + ZAMOIST_I(IIJB:IIJE,IKTB:IKTE)=0. + ZATHETA_I(IIJB:IIJE,IKTB:IKTE)=0. ENDIF - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) - PAMOIST(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (1.0-PFRAC_ICE(D%NIJB:D%NIJE,D%NKTB:D%NKTE))*ZAMOIST_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & - +PFRAC_ICE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) *ZAMOIST_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - PATHETA(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = (1.0-PFRAC_ICE(D%NIJB:D%NIJE,D%NKTB:D%NKTE))*ZATHETA_W(D%NIJB:D%NIJE,D%NKTB:D%NKTE) & - +PFRAC_ICE(D%NIJB:D%NIJE,D%NKTB:D%NKTE) *ZATHETA_I(D%NIJB:D%NIJE,D%NKTB:D%NKTE) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=D%NKTB:D%NKTE) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) + PAMOIST(IIJB:IIJE,IKTB:IKTE) = (1.0-PFRAC_ICE(IIJB:IIJE,IKTB:IKTE))*ZAMOIST_W(IIJB:IIJE,IKTB:IKTE) & + +PFRAC_ICE(IIJB:IIJE,IKTB:IKTE) *ZAMOIST_I(IIJB:IIJE,IKTB:IKTE) + PATHETA(IIJB:IIJE,IKTB:IKTE) = (1.0-PFRAC_ICE(IIJB:IIJE,IKTB:IKTE))*ZATHETA_W(IIJB:IIJE,IKTB:IKTE) & + +PFRAC_ICE(IIJB:IIJE,IKTB:IKTE) *ZATHETA_I(IIJB:IIJE,IKTB:IKTE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) ! ELSE - PAMOIST(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = 0. - PATHETA(D%NIJB:D%NIJE,D%NKTB:D%NKTE) = 0. + PAMOIST(IIJB:IIJE,IKTB:IKTE) = 0. + PATHETA(IIJB:IIJE,IKTB:IKTE) = 0. ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_FUNCTION_THERMO_MF',1,ZHOOK_HANDLE) END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF diff --git a/src/common/turb/mode_compute_mf_cloud_bigaus.F90 b/src/common/turb/mode_compute_mf_cloud_bigaus.F90 index 9117475143f5f7e09bdcdcda2ae065b4b9225b81..a34c6e46f1d6db259eda3aa9062aeac8b481be3f 100644 --- a/src/common/turb/mode_compute_mf_cloud_bigaus.F90 +++ b/src/common/turb/mode_compute_mf_cloud_bigaus.F90 @@ -91,16 +91,27 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZGRAD_Z_RT, & ! & ZSIGMF ! and sqrt(variance) REAL, DIMENSION(D%NIJT) :: ZOMEGA_UP_M ! REAL, DIMENSION(D%NIJT,D%NKT) :: ZW1 ! working array -INTEGER :: JI, JK ! loop control +INTEGER :: JIJ, JK ! loop control REAL, DIMENSION(D%NIJT,D%NKT) :: ZEMF_M, ZTHV_UP_M, & ! & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points & ZFRAC_ICE_UP_M ! REAL, DIMENSION(D%NIJT,D%NKT) :: ZCOND ! condensate REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZGAM ! used for integration +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT,IKB,IKA,IKU,IKE,IKL REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKA=D%NKA +IKU=D%NKU +IKE=D%NKE +IKL=D%NKL +! !Computation is done on mass points !---------------------------------------------------------------------------- ! @@ -121,72 +132,72 @@ CALL MZF_MF(D, PFRAC_ICE_UP(:,:), ZFRAC_ICE_UP_M(:,:)) !computation of omega star up ZOMEGA_UP_M(:)=0. -DO JK=D%NKB,D%NKE-D%NKL,D%NKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) +DO JK=IKB,IKE-IKL,IKL + !$mnh_expand_array(JIJ=IIJB:IIJE) !Vertical integration over the entire column but only buoyant points are used - !ZOMEGA_UP_M(D%NIJB:D%NIJE)=ZOMEGA_UP_M(D%NIJB:D%NIJE) + & - ! ZEMF_M(D%NIJB:D%NIJE,JK) * & - ! MAX(0.,(ZTHV_UP_M(D%NIJB:D%NIJE,JK)-PTHVM(D%NIJB:D%NIJE,JK))) * & - ! (PZZ(D%NIJB:D%NIJE,JK+KKL)-PZZ(D%NIJB:D%NIJE,JK)) / & - ! (PTHM(D%NIJB:D%NIJE,JK) * PRHODREF(D%NIJB:D%NIJE,JK)) + !ZOMEGA_UP_M(IIJB:IIJE)=ZOMEGA_UP_M(IIJB:IIJE) + & + ! ZEMF_M(IIJB:IIJE,JK) * & + ! MAX(0.,(ZTHV_UP_M(IIJB:IIJE,JK)-PTHVM(IIJB:IIJE,JK))) * & + ! (PZZ(IIJB:IIJE,JK+KKL)-PZZ(IIJB:IIJE,JK)) / & + ! (PTHM(IIJB:IIJE,JK) * PRHODREF(IIJB:IIJE,JK)) !Vertical integration over the entire column - ZOMEGA_UP_M(D%NIJB:D%NIJE)=ZOMEGA_UP_M(D%NIJB:D%NIJE) + & - ZEMF_M(D%NIJB:D%NIJE,JK) * & - (ZTHV_UP_M(D%NIJB:D%NIJE,JK)-PTHVM(D%NIJB:D%NIJE,JK)) * & - (PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK)) / & - (PTHM(D%NIJB:D%NIJE,JK) * PRHODREF(D%NIJB:D%NIJE,JK)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + ZOMEGA_UP_M(IIJB:IIJE)=ZOMEGA_UP_M(IIJB:IIJE) + & + ZEMF_M(IIJB:IIJE,JK) * & + (ZTHV_UP_M(IIJB:IIJE,JK)-PTHVM(IIJB:IIJE,JK)) * & + (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) / & + (PTHM(IIJB:IIJE,JK) * PRHODREF(IIJB:IIJE,JK)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZOMEGA_UP_M(D%NIJB:D%NIJE)=MAX(ZOMEGA_UP_M(D%NIJB:D%NIJE), 1.E-20) -ZOMEGA_UP_M(D%NIJB:D%NIJE)=(CST%XG*ZOMEGA_UP_M(D%NIJB:D%NIJE))**(1./3.) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZOMEGA_UP_M(IIJB:IIJE)=MAX(ZOMEGA_UP_M(IIJB:IIJE), 1.E-20) +ZOMEGA_UP_M(IIJB:IIJE)=(CST%XG*ZOMEGA_UP_M(IIJB:IIJE))**(1./3.) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) !computation of alpha up -DO JK=D%NKA,D%NKU,D%NKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZALPHA_UP_M(D%NIJB:D%NIJE,JK)=ZEMF_M(D%NIJB:D%NIJE,JK)/(PARAMMF%XALPHA_MF*PRHODREF(D%NIJB:D%NIJE,JK)*ZOMEGA_UP_M(D%NIJB:D%NIJE)) - ZALPHA_UP_M(D%NIJB:D%NIJE,JK)=MAX(0., MIN(ZALPHA_UP_M(D%NIJB:D%NIJE,JK), 1.)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=IKA,IKU,IKL + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZALPHA_UP_M(IIJB:IIJE,JK)=ZEMF_M(IIJB:IIJE,JK)/(PARAMMF%XALPHA_MF*PRHODREF(IIJB:IIJE,JK)*ZOMEGA_UP_M(IIJB:IIJE)) + ZALPHA_UP_M(IIJB:IIJE,JK)=MAX(0., MIN(ZALPHA_UP_M(IIJB:IIJE,JK), 1.)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO !computation of sigma of the distribution -DO JK=D%NKA,D%NKU,D%NKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZSIGMF(D%NIJB:D%NIJE,JK)=ZEMF_M(D%NIJB:D%NIJE,JK) * & - (ZRT_UP_M(D%NIJB:D%NIJE,JK) - PRTM(D%NIJB:D%NIJE,JK)) * & - PDEPTH(D%NIJB:D%NIJE) * ZGRAD_Z_RT(D%NIJB:D%NIJE,JK) / & - (PARAMMF%XSIGMA_MF * ZOMEGA_UP_M(D%NIJB:D%NIJE) * PRHODREF(D%NIJB:D%NIJE,JK)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=IKA,IKU,IKL + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZSIGMF(IIJB:IIJE,JK)=ZEMF_M(IIJB:IIJE,JK) * & + (ZRT_UP_M(IIJB:IIJE,JK) - PRTM(IIJB:IIJE,JK)) * & + PDEPTH(IIJB:IIJE) * ZGRAD_Z_RT(IIJB:IIJE,JK) / & + (PARAMMF%XSIGMA_MF * ZOMEGA_UP_M(IIJB:IIJE) * PRHODREF(IIJB:IIJE,JK)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZSIGMF(D%NIJB:D%NIJE,1:D%NKT)=SQRT(MAX(ABS(ZSIGMF(D%NIJB:D%NIJE,1:D%NKT)), 1.E-40)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZSIGMF(IIJB:IIJE,1:IKT)=SQRT(MAX(ABS(ZSIGMF(IIJB:IIJE,1:IKT)), 1.E-40)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !* 2. PDF integration ! ------------------------------------------------ ! -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !The mean of the distribution is ZRT_UP !Computation of ZA and ZGAM (=efrc(ZA)) coefficient -ZA(D%NIJB:D%NIJE,1:D%NKT)=(ZRSAT_UP_M(D%NIJB:D%NIJE,1:D%NKT)-ZRT_UP_M(D%NIJB:D%NIJE,1:D%NKT))/& - &(sqrt(2.)*ZSIGMF(D%NIJB:D%NIJE,1:D%NKT)) +ZA(IIJB:IIJE,1:IKT)=(ZRSAT_UP_M(IIJB:IIJE,1:IKT)-ZRT_UP_M(IIJB:IIJE,1:IKT))/& + &(sqrt(2.)*ZSIGMF(IIJB:IIJE,1:IKT)) !Approximation of erf function -ZGAM(D%NIJB:D%NIJE,1:D%NKT)=1-SIGN(1., ZA(D%NIJB:D%NIJE,1:D%NKT))*SQRT(1-EXP(-4*ZA(D%NIJB:D%NIJE,1:D%NKT)**2/CST%XPI)) +ZGAM(IIJB:IIJE,1:IKT)=1-SIGN(1., ZA(IIJB:IIJE,1:IKT))*SQRT(1-EXP(-4*ZA(IIJB:IIJE,1:IKT)**2/CST%XPI)) !computation of cloud fraction -PCF_MF(D%NIJB:D%NIJE,1:D%NKT)=MAX( 0., MIN(1.,0.5*ZGAM(D%NIJB:D%NIJE,1:D%NKT) * ZALPHA_UP_M(D%NIJB:D%NIJE,1:D%NKT))) +PCF_MF(IIJB:IIJE,1:IKT)=MAX( 0., MIN(1.,0.5*ZGAM(IIJB:IIJE,1:IKT) * ZALPHA_UP_M(IIJB:IIJE,1:IKT))) !computation of condensate, then PRC and PRI -ZCOND(D%NIJB:D%NIJE,1:D%NKT)=(EXP(-ZA(D%NIJB:D%NIJE,1:D%NKT)**2)-& - &ZA(D%NIJB:D%NIJE,1:D%NKT)*SQRT(CST%XPI)*ZGAM(D%NIJB:D%NIJE,1:D%NKT))* & - &ZSIGMF(D%NIJB:D%NIJE,1:D%NKT)/SQRT(2.*CST%XPI) * ZALPHA_UP_M(D%NIJB:D%NIJE,1:D%NKT) -ZCOND(D%NIJB:D%NIJE,1:D%NKT)=MAX(ZCOND(D%NIJB:D%NIJE,1:D%NKT), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative -PRC_MF(D%NIJB:D%NIJE,1:D%NKT)=(1.-ZFRAC_ICE_UP_M(D%NIJB:D%NIJE,1:D%NKT)) * ZCOND(D%NIJB:D%NIJE,1:D%NKT) -PRI_MF(D%NIJB:D%NIJE,1:D%NKT)=( ZFRAC_ICE_UP_M(D%NIJB:D%NIJE,1:D%NKT)) * ZCOND(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +ZCOND(IIJB:IIJE,1:IKT)=(EXP(-ZA(IIJB:IIJE,1:IKT)**2)-& + &ZA(IIJB:IIJE,1:IKT)*SQRT(CST%XPI)*ZGAM(IIJB:IIJE,1:IKT))* & + &ZSIGMF(IIJB:IIJE,1:IKT)/SQRT(2.*CST%XPI) * ZALPHA_UP_M(IIJB:IIJE,1:IKT) +ZCOND(IIJB:IIJE,1:IKT)=MAX(ZCOND(IIJB:IIJE,1:IKT), 0.) !due to approximation of ZGAM value, ZCOND could be slightly negative +PRC_MF(IIJB:IIJE,1:IKT)=(1.-ZFRAC_ICE_UP_M(IIJB:IIJE,1:IKT)) * ZCOND(IIJB:IIJE,1:IKT) +PRI_MF(IIJB:IIJE,1:IKT)=( ZFRAC_ICE_UP_M(IIJB:IIJE,1:IKT)) * ZCOND(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_BIGAUS',1,ZHOOK_HANDLE) diff --git a/src/common/turb/mode_compute_mf_cloud_direct.F90 b/src/common/turb/mode_compute_mf_cloud_direct.F90 index b7c86d94cdad5651d66381085baa6316ca15b1b7..0a2f7def90c89240af5bbafc63c904dc4d1e975e 100644 --- a/src/common/turb/mode_compute_mf_cloud_direct.F90 +++ b/src/common/turb/mode_compute_mf_cloud_direct.F90 @@ -72,13 +72,16 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PCF_MF ! and cloud frac ! !* 0.1 Declaration of local variables ! -INTEGER :: JI,JK, JK0 +INTEGER :: JI,JK, JK0, IKB,IKE,IKL REAL(KIND=JPRB) :: ZHOOK_HANDLE ! !* 0.2 Initialisation ! IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_DIRECT',0,ZHOOK_HANDLE) ! +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL !* 1. COMPUTATION OF SUBGRID CLOUD ! ---------------------------- @@ -91,19 +94,19 @@ PCF_MF(:,:)=0. DO JI=D%NIJB,D%NIJE #ifdef REPRO48 - JK0=KKLCL(JI)-D%NKL ! first mass level with cloud - JK0=MAX(JK0, MIN(D%NKB,D%NKE)) !protection if KKL=1 - JK0=MIN(JK0, MAX(D%NKB,D%NKE)) !protection if KKL=-1 - DO JK=JK0,D%NKE-D%NKL,D%NKL + JK0=KKLCL(JI)-IKL ! first mass level with cloud + JK0=MAX(JK0, MIN(IKB,IKE)) !protection if KKL=1 + JK0=MIN(JK0, MAX(IKB,IKE)) !protection if KKL=-1 + DO JK=JK0,IKE-IKL,IKL #else - DO JK=KKLCL(JI),D%NKE-D%NKL,D%NKL + DO JK=KKLCL(JI),IKE-IKL,IKL #endif PCF_MF(JI,JK ) = MAX( 0., MIN(1.,PARAMMF%XKCF_MF *0.5* ( & - & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+D%NKL) ) )) + & PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+IKL) ) )) PRC_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) & - + PFRAC_UP(JI,JK+D%NKL)*PRC_UP(JI,JK+D%NKL) ) + + PFRAC_UP(JI,JK+IKL)*PRC_UP(JI,JK+IKL) ) PRI_MF(JI,JK) = 0.5* PARAMMF%XKCF_MF * ( PFRAC_UP(JI,JK)*PRI_UP(JI,JK) & - + PFRAC_UP(JI,JK+D%NKL)*PRI_UP(JI,JK+D%NKL) ) + + PFRAC_UP(JI,JK+IKL)*PRI_UP(JI,JK+IKL) ) END DO END DO diff --git a/src/common/turb/mode_compute_mf_cloud_stat.F90 b/src/common/turb/mode_compute_mf_cloud_stat.F90 index 81cdabbb396eff7fb774a1e4dcb939645cdb7ec6..3c562015e63667859aa1862c251baf0493e0e948 100644 --- a/src/common/turb/mode_compute_mf_cloud_stat.F90 +++ b/src/common/turb/mode_compute_mf_cloud_stat.F90 @@ -97,13 +97,19 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZFLXZ,ZFLXZ2,ZFLXZ3 REAL, DIMENSION(D%NIJT,D%NKT) :: ZT REAL, DIMENSION(D%NIJT,D%NKT) :: ZAMOIST, ZATHETA REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK,ZWK2 -INTEGER :: JI, JK +INTEGER :: JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT REAL(KIND=JPRB) :: ZHOOK_HANDLE ! !* 0.2 initialisation ! IF (LHOOK) CALL DR_HOOK('COMPUTE_MF_CLOUD_STAT',0,ZHOOK_HANDLE) ! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +! !---------------------------------------------------------------------------- ! !* 1. COMPUTE SIGMA_MF (saturation deviation variance) @@ -124,27 +130,27 @@ IF (KRRL > 0) THEN CALL MZM_MF(D, PTHLM(:,:), ZFLXZ(:,:)) CALL GZ_M_W_MF(D, PTHLM(:,:), PDZZ(:,:), ZWK(:,:)) IF (OSTATNW) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ(D%NIJB:D%NIJE,1:D%NKT) = -2 * CSTURB%XCTV* PARAMMF%XTAUSIGMF * PEMF(D%NIJB:D%NIJE,1:D%NKT)* & - & (PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ(D%NIJB:D%NIJE,1:D%NKT)) * ZWK(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = -2 * CSTURB%XCTV* PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* & + & (PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * ZWK(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ(D%NIJB:D%NIJE,1:D%NKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(D%NIJB:D%NIJE,1:D%NKT)* & - & (PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ(D%NIJB:D%NIJE,1:D%NKT)) * ZWK(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* & + & (PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * ZWK(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Avoid negative values - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ(D%NIJB:D%NIJE,1:D%NKT) = MAX(0.,ZFLXZ(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0.,ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_MF(D, ZFLXZ(:,:), PSIGMF(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PSIGMF(D%NIJB:D%NIJE,1:D%NKT) = PSIGMF(D%NIJB:D%NIJE,1:D%NKT) * ZATHETA(D%NIJB:D%NIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) * ZATHETA(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! @@ -156,50 +162,50 @@ IF (KRRL > 0) THEN CALL MZM_MF(D, PRTM(:,:), ZFLXZ2(:,:)) CALL GZ_M_W_MF(D, PRTM(:,:), PDZZ(:,:), ZWK2(:,:)) IF (OSTATNW) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT) = -2 * CSTURB%XCTV * PARAMMF%XTAUSIGMF * PEMF(D%NIJB:D%NIJE,1:D%NKT)* & - & (PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT)) * ZWK2(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ2(IIJB:IIJE,1:IKT) = -2 * CSTURB%XCTV * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* & + & (PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * ZWK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(D%NIJB:D%NIJE,1:D%NKT)* & - & (PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT)) * ZWK2(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ2(IIJB:IIJE,1:IKT) = -2 * PARAMMF%XTAUSIGMF * PEMF(IIJB:IIJE,1:IKT)* & + & (PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * ZWK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Avoid negative values - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT) = MAX(0.,ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ2(IIJB:IIJE,1:IKT) = MAX(0.,ZFLXZ2(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_MF(D, ZFLXZ2(:,:), ZWK2(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PSIGMF(D%NIJB:D%NIJE,1:D%NKT) = PSIGMF(D%NIJB:D%NIJE,1:D%NKT) + ZAMOIST(D%NIJB:D%NIJE,1:D%NKT) **2 *ZWK2(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) + ZAMOIST(IIJB:IIJE,1:IKT) **2 *ZWK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (OSTATNW) THEN !wc Now including convection covariance contribution in case of OSTATNW=TRUE ! ! 1.2.2 contribution from <Rnp Thl> - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZFLXZ3(D%NIJB:D%NIJE,1:D%NKT) = - CSTURB%XCTV * PARAMMF%XTAUSIGMF * & - (PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ2(D%NIJB:D%NIJE,1:D%NKT)) * & - ZWK(D%NIJB:D%NIJE,1:D%NKT) + & - PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-ZFLXZ(D%NIJB:D%NIJE,1:D%NKT)) * & - ZWK2(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ3(IIJB:IIJE,1:IKT) = - CSTURB%XCTV * PARAMMF%XTAUSIGMF * & + (PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-ZFLXZ2(IIJB:IIJE,1:IKT)) * & + ZWK(IIJB:IIJE,1:IKT) + & + PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-ZFLXZ(IIJB:IIJE,1:IKT)) * & + ZWK2(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_MF(D, ZFLXZ3, ZFLXZ) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PSIGMF(D%NIJB:D%NIJE,1:D%NKT) = PSIGMF(D%NIJB:D%NIJE,1:D%NKT) - & - MIN(0.,2.*ZAMOIST(D%NIJB:D%NIJE,1:D%NKT)*ZATHETA(D%NIJB:D%NIJE,1:D%NKT)*& - &ZFLXZ(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGMF(IIJB:IIJE,1:IKT) = PSIGMF(IIJB:IIJE,1:IKT) - & + MIN(0.,2.*ZAMOIST(IIJB:IIJE,1:IKT)*ZATHETA(IIJB:IIJE,1:IKT)*& + &ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! ! 1.3 Vertical part of Sigma_s ! - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PSIGMF(D%NIJB:D%NIJE,1:D%NKT) = SQRT( MAX (PSIGMF(D%NIJB:D%NIJE,1:D%NKT) , 0.) ) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGMF(IIJB:IIJE,1:IKT) = SQRT( MAX (PSIGMF(IIJB:IIJE,1:IKT) , 0.) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE PSIGMF(:,:) = 0. END IF diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90 index baf52171f96f89a9d1977906b4664d9a5b15fa48..adbb47b8da432fedaa6b361c98a81aabfca18c77 100644 --- a/src/common/turb/mode_compute_updraft.F90 +++ b/src/common/turb/mode_compute_updraft.F90 @@ -171,7 +171,7 @@ REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2,ZMIX3_CLD,ZMIX2_CLD REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground -INTEGER :: JK,JI,JSV ! loop counters +INTEGER :: JK,JIJ,JSV ! loop counters LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL,GTESTETL ! Test if the ascent continue, if LCL or ETL is reached @@ -232,10 +232,18 @@ REAL, DIMENSION(D%NIJT) :: ZDZ_STOP,& ! Exact Height of the LCL above ZTHV_PLUS_HALF ! Thv at flux point(kk+kkl) REAL :: ZDZ ! Delta Z used in computations INTEGER :: JKLIM - +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT,IKB,IKE,IKL ! IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +! ! Thresholds for the perturbation of ! theta_l and r_t at the first level of the updraft ZTMAX=2.0 @@ -255,9 +263,9 @@ ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed IF (OENTR_DETR) THEN ! Initialisation of intersesting Level :LCL,ETL,CTL - KKLCL(:)=D%NKE - KKETL(:)=D%NKE - KKCTL(:)=D%NKE + KKLCL(:)=IKE + KKETL(:)=IKE + KKCTL(:)=IKE ! ! Initialisation @@ -279,9 +287,9 @@ IF (OENTR_DETR) THEN PBUO_INTEG=0. PFRAC_ICE_UP(:,:)=0. - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PRSAT_UP(D%NIJB:D%NIJE,1:D%NKT)=PRVM(D%NIJB:D%NIJE,1:D%NKT) ! should be initialised correctly but is (normaly) not used - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !cloud/dry air mixture cloud content ZRC_MIX = 0. @@ -303,24 +311,24 @@ DO JSV=1,KSV END DO ! ! Initialisation of updraft characteristics -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)=ZTHLM_F(D%NIJB:D%NIJE,1:D%NKT) -PRT_UP(D%NIJB:D%NIJE,1:D%NKT)=ZRTM_F(D%NIJB:D%NIJE,1:D%NKT) -PU_UP(D%NIJB:D%NIJE,1:D%NKT)=ZUM_F(D%NIJB:D%NIJE,1:D%NKT) -PV_UP(D%NIJB:D%NIJE,1:D%NKT)=ZVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT,JSV=1:KSV) -PSV_UP(D%NIJB:D%NIJE,1:D%NKT,:)=ZSVM_F(D%NIJB:D%NIJE,1:D%NKT,:) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT,JSV=1:KSV) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT) +PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT) +PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT) +PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV) +PSV_UP(IIJB:IIJE,1:IKT,:)=ZSVM_F(IIJB:IIJE,1:IKT,:) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV) ! Computation or initialisation of updraft characteristics at the KKB level ! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PTHL_UP(D%NIJB:D%NIJE,D%NKB)= ZTHLM_F(D%NIJB:D%NIJE,D%NKB)+ & - & MAX(0.,MIN(ZTMAX,(PSFTH(D%NIJB:D%NIJE)/SQRT(ZTKEM_F(D%NIJB:D%NIJE,D%NKB)))* PARAMMF%XALP_PERT)) -PRT_UP(D%NIJB:D%NIJE,D%NKB) = ZRTM_F(D%NIJB:D%NIJE,D%NKB)+ & - & MAX(0.,MIN(ZRMAX,(PSFRV(D%NIJB:D%NIJE)/SQRT(ZTKEM_F(D%NIJB:D%NIJE,D%NKB)))* PARAMMF%XALP_PERT)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PTHL_UP(IIJB:IIJE,IKB)= ZTHLM_F(IIJB:IIJE,IKB)+ & + & MAX(0.,MIN(ZTMAX,(PSFTH(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT)) +PRT_UP(IIJB:IIJE,IKB) = ZRTM_F(IIJB:IIJE,IKB)+ & + & MAX(0.,MIN(ZRMAX,(PSFRV(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))* PARAMMF%XALP_PERT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) IF (OENTR_DETR) THEN CALL MZM_MF(D, PTHM (:,:), ZTHM_F (:,:)) @@ -328,102 +336,102 @@ IF (OENTR_DETR) THEN CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F (:,:)) CALL MZM_MF(D, PRVM(:,:), ZRVM_F (:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! thetav at mass and flux levels - ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT)=ZTHM_F(D%NIJB:D%NIJE,1:D%NKT)* & - &((1.+ZRVORD*ZRVM_F(D%NIJB:D%NIJE,1:D%NKT))/(1.+ZRTM_F(D%NIJB:D%NIJE,1:D%NKT))) - ZTHVM(D%NIJB:D%NIJE,1:D%NKT)=PTHM(D%NIJB:D%NIJE,1:D%NKT)* & - &((1.+ZRVORD*PRVM(D%NIJB:D%NIJE,1:D%NKT))/(1.+PRTM(D%NIJB:D%NIJE,1:D%NKT))) + ZTHVM_F(IIJB:IIJE,1:IKT)=ZTHM_F(IIJB:IIJE,1:IKT)* & + &((1.+ZRVORD*ZRVM_F(IIJB:IIJE,1:IKT))/(1.+ZRTM_F(IIJB:IIJE,1:IKT))) + ZTHVM(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)* & + &((1.+ZRVORD*PRVM(IIJB:IIJE,1:IKT))/(1.+PRTM(IIJB:IIJE,1:IKT))) - PTHV_UP(D%NIJB:D%NIJE,1:D%NKT)=ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + PTHV_UP(IIJB:IIJE,1:IKT)=ZTHVM_F(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZW_UP2(:,:)=0. - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZW_UP2(D%NIJB:D%NIJE,D%NKB) = MAX(0.0001,(2./3.)*ZTKEM_F(D%NIJB:D%NIJE,D%NKB)) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(IIJB:IIJE,IKB)) ! Computation of non conservative variable for the KKB level of the updraft ! (all or nothing ajustement) - PRC_UP(:,D%NKB)=0. - PRI_UP(:,D%NKB)=0. - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) - CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), & - PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), & - PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., & + PRC_UP(:,IKB)=0. + PRI_UP(:,IKB)=0. + !$mnh_end_expand_array(JIJ=IIJB:IIJE) + CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), & + PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), & + PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., & PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE) - !$mnh_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) ! compute updraft thevav and buoyancy term at KKB level - PTHV_UP(D%NIJB:D%NIJE,D%NKB) = ZTH_UP(D%NIJB:D%NIJE,D%NKB)*& - & ((1+ZRVORD*PRV_UP(D%NIJB:D%NIJE,D%NKB))/(1+PRT_UP(D%NIJB:D%NIJE,D%NKB))) + PTHV_UP(IIJB:IIJE,IKB) = ZTH_UP(IIJB:IIJE,IKB)*& + & ((1+ZRVORD*PRV_UP(IIJB:IIJE,IKB))/(1+PRT_UP(IIJB:IIJE,IKB))) ! compute mean rsat in updraft - PRSAT_UP(D%NIJB:D%NIJE,D%NKB) = ZRSATW(D%NIJB:D%NIJE)*(1-PFRAC_ICE_UP(D%NIJB:D%NIJE,D%NKB)) + & - & ZRSATI(D%NIJB:D%NIJE)*PFRAC_ICE_UP(D%NIJB:D%NIJE,D%NKB) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + PRSAT_UP(IIJB:IIJE,IKB) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,IKB)) + & + & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,IKB) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Closure assumption for mass flux at KKB level ! - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZG_O_THVREF(D%NIJB:D%NIJE,1:D%NKT)=CST%XG/ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! compute L_up GLMIX=.TRUE. - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZTKEM_F(D%NIJB:D%NIJE,D%NKB)=0. - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZTKEM_F(IIJB:IIJE,IKB)=0. + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF(TURB%CTURBLEN=='RM17') THEN CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK) CALL MZF_MF(D, ZWK, ZDUDZ) CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK) CALL MZF_MF(D, ZWK, ZDVDZ) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZSHEAR(D%NIJB:D%NIJE,1:D%NKT) = SQRT(ZDUDZ(D%NIJB:D%NIJE,1:D%NKT)**2 + ZDVDZ(D%NIJB:D%NIJE,1:D%NKT)**2) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)**2 + ZDVDZ(IIJB:IIJE,1:IKT)**2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE ZSHEAR = 0. !no shear in bl89 mixing length END IF ! #ifdef REPRO48 - CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),& - &ZG_O_THVREF(:,D%NKB),ZTHVM,D%NKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) + CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),& + &ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) #else - CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),& - &ZG_O_THVREF(:,D%NKB),ZTHVM,D%NKB,GLMIX,.FALSE.,ZSHEAR,ZLUP) + CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),& + &ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.FALSE.,ZSHEAR,ZLUP) #endif - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - ZLUP(D%NIJB:D%NIJE)=MAX(ZLUP(D%NIJB:D%NIJE),1.E-10) + !$mnh_expand_where(JIJ=IIJB:IIJE) + ZLUP(IIJB:IIJE)=MAX(ZLUP(IIJB:IIJE),1.E-10) ! Compute Buoyancy flux at the ground - ZWTHVSURF(D%NIJB:D%NIJE) = (ZTHVM_F(D%NIJB:D%NIJE,D%NKB)/ZTHM_F(D%NIJB:D%NIJE,D%NKB))*PSFTH(D%NIJB:D%NIJE)+ & - (0.61*ZTHM_F(D%NIJB:D%NIJE,D%NKB))*PSFRV(D%NIJB:D%NIJE) + ZWTHVSURF(IIJB:IIJE) = (ZTHVM_F(IIJB:IIJE,IKB)/ZTHM_F(IIJB:IIJE,IKB))*PSFTH(IIJB:IIJE)+ & + (0.61*ZTHM_F(IIJB:IIJE,IKB))*PSFRV(IIJB:IIJE) ! Mass flux at KKB level (updraft triggered if PSFTH>0.) IF (PARAMMF%LGZ) THEN IF(PDX==0. .OR. PDY==0.) THEN CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'COMPUTE_UPDRAFT', 'PDX or PDY is NULL with option LGZ!') ENDIF - ZSURF(D%NIJB:D%NIJE)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(D%NIJB:D%NIJE)) + ZSURF(IIJB:IIJE)=TANH(PARAMMF%XGZ*SQRT(PDX*PDY)/ZLUP(IIJB:IIJE)) ELSE - ZSURF(D%NIJB:D%NIJE)=1. + ZSURF(IIJB:IIJE)=1. END IF - WHERE (ZWTHVSURF(D%NIJB:D%NIJE)>0.) - PEMF(D%NIJB:D%NIJE,D%NKB) = PARAMMF%XCMF * ZSURF(D%NIJB:D%NIJE) * ZRHO_F(D%NIJB:D%NIJE,D%NKB) * & - ((ZG_O_THVREF(D%NIJB:D%NIJE,D%NKB))*ZWTHVSURF(D%NIJB:D%NIJE)*ZLUP(D%NIJB:D%NIJE))**(1./3.) - PFRAC_UP(D%NIJB:D%NIJE,D%NKB)=MIN(PEMF(D%NIJB:D%NIJE,D%NKB)/(SQRT(ZW_UP2(D%NIJB:D%NIJE,D%NKB))*ZRHO_F(D%NIJB:D%NIJE,D%NKB)), & + WHERE (ZWTHVSURF(IIJB:IIJE)>0.) + PEMF(IIJB:IIJE,IKB) = PARAMMF%XCMF * ZSURF(IIJB:IIJE) * ZRHO_F(IIJB:IIJE,IKB) * & + ((ZG_O_THVREF(IIJB:IIJE,IKB))*ZWTHVSURF(IIJB:IIJE)*ZLUP(IIJB:IIJE))**(1./3.) + PFRAC_UP(IIJB:IIJE,IKB)=MIN(PEMF(IIJB:IIJE,IKB)/(SQRT(ZW_UP2(IIJB:IIJE,IKB))*ZRHO_F(IIJB:IIJE,IKB)), & &PARAMMF%XFRAC_UP_MAX) - ZW_UP2(D%NIJB:D%NIJE,D%NKB)=(PEMF(D%NIJB:D%NIJE,D%NKB)/(PFRAC_UP(D%NIJB:D%NIJE,D%NKB)*ZRHO_F(D%NIJB:D%NIJE,D%NKB)))**2 - GTEST(D%NIJB:D%NIJE)=.TRUE. + ZW_UP2(IIJB:IIJE,IKB)=(PEMF(IIJB:IIJE,IKB)/(PFRAC_UP(IIJB:IIJE,IKB)*ZRHO_F(IIJB:IIJE,IKB)))**2 + GTEST(IIJB:IIJE)=.TRUE. ELSEWHERE - PEMF(D%NIJB:D%NIJE,D%NKB) =0. - GTEST(D%NIJB:D%NIJE)=.FALSE. + PEMF(IIJB:IIJE,IKB) =0. + GTEST(IIJB:IIJE)=.FALSE. ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GTEST(D%NIJB:D%NIJE)=PEMF(D%NIJB:D%NIJE,D%NKB+D%NKL)>0. - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + GTEST(IIJB:IIJE)=PEMF(IIJB:IIJE,IKB+IKL)>0. + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF !-------------------------------------------------------------------------- @@ -439,10 +447,10 @@ GTESTETL(:)=.FALSE. ! Loop on vertical level -DO JK=D%NKB,D%NKE-D%NKL,D%NKL +DO JK=IKB,IKE-IKL,IKL ! IF the updraft top is reached for all column, stop the loop on levels - ITEST=COUNT(GTEST(D%NIJB:D%NIJE)) + ITEST=COUNT(GTEST(IIJB:IIJE)) IF (ITEST==0) CYCLE ! Computation of entrainment and detrainment with KF90 @@ -450,23 +458,23 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! to find the LCL (check if JK is LCL or not) - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE ((PRC_UP(D%NIJB:D%NIJE,JK)+PRI_UP(D%NIJB:D%NIJE,JK)>0.).AND.(.NOT.(GTESTLCL(D%NIJB:D%NIJE)))) - KKLCL(D%NIJB:D%NIJE) = JK - GTESTLCL(D%NIJB:D%NIJE)=.TRUE. + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE ((PRC_UP(IIJB:IIJE,JK)+PRI_UP(IIJB:IIJE,JK)>0.).AND.(.NOT.(GTESTLCL(IIJB:IIJE)))) + KKLCL(IIJB:IIJE) = JK + GTESTLCL(IIJB:IIJE)=.TRUE. ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ! COMPUTE PENTR and PDETR at mass level JK IF (OENTR_DETR) THEN - IF(JK/=D%NKB) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZRC_MIX(D%NIJB:D%NIJE,JK) = ZRC_MIX(D%NIJB:D%NIJE,JK-D%NKL) ! guess of Rc of mixture - ZRI_MIX(D%NIJB:D%NIJE,JK) = ZRI_MIX(D%NIJB:D%NIJE,JK-D%NKL) ! guess of Ri of mixture - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + IF(JK/=IKB) THEN + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZRC_MIX(IIJB:IIJE,JK) = ZRC_MIX(IIJB:IIJE,JK-IKL) ! guess of Rc of mixture + ZRI_MIX(IIJB:IIJE,JK) = ZRI_MIX(IIJB:IIJE,JK-IKL) ! guess of Ri of mixture + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF - CALL COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF, JK,D%NKB,D%NKE,D%NKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),& - PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+D%NKL),& + CALL COMPUTE_ENTR_DETR(D, CST, NEB, PARAMMF, JK,IKB,IKE,IKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),& + PRHODREF(:,JK),ZPRES_F(:,JK),ZPRES_F(:,JK+IKL),& PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), & PTHLM(:,:),PRTM(:,:),ZW_UP2(:,:),ZTH_UP(:,JK), & PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), & @@ -475,194 +483,194 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL PENTR(:,JK),PDETR(:,JK),ZENTR_CLD(:,JK),ZDETR_CLD(:,JK),& ZBUO_INTEG_DRY(:,JK), ZBUO_INTEG_CLD(:,JK), & ZPART_DRY(:) ) - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - PBUO_INTEG(D%NIJB:D%NIJE,JK)=ZBUO_INTEG_DRY(D%NIJB:D%NIJE,JK)+ZBUO_INTEG_CLD(D%NIJB:D%NIJE,JK) + !$mnh_expand_where(JIJ=IIJB:IIJE) + PBUO_INTEG(IIJB:IIJE,JK)=ZBUO_INTEG_DRY(IIJB:IIJE,JK)+ZBUO_INTEG_CLD(IIJB:IIJE,JK) - IF (JK==D%NKB) THEN - PDETR(D%NIJB:D%NIJE,JK)=0. - ZDETR_CLD(D%NIJB:D%NIJE,JK)=0. + IF (JK==IKB) THEN + PDETR(IIJB:IIJE,JK)=0. + ZDETR_CLD(IIJB:IIJE,JK)=0. ENDIF ! Computation of updraft characteristics at level JK+KKL - WHERE(GTEST(D%NIJB:D%NIJE)) - ZMIX1(D%NIJB:D%NIJE)=0.5*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - &(PENTR(D%NIJB:D%NIJE,JK)-PDETR(D%NIJB:D%NIJE,JK)) - PEMF(D%NIJB:D%NIJE,JK+D%NKL)=PEMF(D%NIJB:D%NIJE,JK)*EXP(2*ZMIX1(D%NIJB:D%NIJE)) + WHERE(GTEST(IIJB:IIJE)) + ZMIX1(IIJB:IIJE)=0.5*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + &(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK)) + PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(2*ZMIX1(IIJB:IIJE)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ELSE !OENTR_DETR - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GTEST(D%NIJB:D%NIJE) = (PEMF(D%NIJB:D%NIJE,JK+D%NKL)>0.) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + GTEST(IIJB:IIJE) = (PEMF(IIJB:IIJE,JK+IKL)>0.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF !OENTR_DETR ! stop the updraft if MF becomes negative - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE (GTEST(D%NIJB:D%NIJE).AND.(PEMF(D%NIJB:D%NIJE,JK+D%NKL)<=0.)) - PEMF(D%NIJB:D%NIJE,JK+D%NKL)=0. - KKCTL(D%NIJB:D%NIJE) = JK+D%NKL - GTEST(D%NIJB:D%NIJE)=.FALSE. - PFRAC_ICE_UP(D%NIJB:D%NIJE,JK+D%NKL)=PFRAC_ICE_UP(D%NIJB:D%NIJE,JK) - PRSAT_UP(D%NIJB:D%NIJE,JK+D%NKL)=PRSAT_UP(D%NIJB:D%NIJE,JK) + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE (GTEST(IIJB:IIJE).AND.(PEMF(IIJB:IIJE,JK+IKL)<=0.)) + PEMF(IIJB:IIJE,JK+IKL)=0. + KKCTL(IIJB:IIJE) = JK+IKL + GTEST(IIJB:IIJE)=.FALSE. + PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)=PFRAC_ICE_UP(IIJB:IIJE,JK) + PRSAT_UP(IIJB:IIJE,JK+IKL)=PRSAT_UP(IIJB:IIJE,JK) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ! If the updraft did not stop, compute cons updraft characteritics at jk+KKL DO JI=D%NIJB,D%NIJE IF(GTEST(JI)) THEN - ZMIX2(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*PENTR(JI,JK) !& - ZMIX3_CLD(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZDETR_CLD(JI,JK) !& - ZMIX2_CLD(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZENTR_CLD(JI,JK) + ZMIX2(JI) = (PZZ(JI,JK+IKL)-PZZ(JI,JK))*PENTR(JI,JK) !& + ZMIX3_CLD(JI) = (PZZ(JI,JK+IKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZDETR_CLD(JI,JK) !& + ZMIX2_CLD(JI) = (PZZ(JI,JK+IKL)-PZZ(JI,JK))*(1.-ZPART_DRY(JI))*ZENTR_CLD(JI,JK) #ifdef REPRO48 - PTHL_UP(JI,JK+D%NKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) & + PTHL_UP(JI,JK+IKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) & /(1.+0.5*ZMIX2(JI)) - PRT_UP(JI,JK+D%NKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & + PRT_UP(JI,JK+IKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & /(1.+0.5*ZMIX2(JI)) #else - PTHL_UP(JI,JK+D%NKL)=PTHL_UP(JI,JK)*EXP(-ZMIX2(JI)) + PTHLM(JI,JK)*(1-EXP(-ZMIX2(JI))) - PRT_UP(JI,JK+D%NKL) =PRT_UP (JI,JK)*EXP(-ZMIX2(JI)) + PRTM(JI,JK)*(1-EXP(-ZMIX2(JI))) + PTHL_UP(JI,JK+IKL)=PTHL_UP(JI,JK)*EXP(-ZMIX2(JI)) + PTHLM(JI,JK)*(1-EXP(-ZMIX2(JI))) + PRT_UP(JI,JK+IKL) =PRT_UP (JI,JK)*EXP(-ZMIX2(JI)) + PRTM(JI,JK)*(1-EXP(-ZMIX2(JI))) #endif ENDIF ENDDO IF(OMIXUV) THEN - IF(JK/=D%NKB) THEN - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(GTEST(D%NIJB:D%NIJE)) - PU_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PU_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PUM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PUM(D%NIJB:D%NIJE,JK+D%NKL)-PUM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)+& - (PUM(D%NIJB:D%NIJE,JK)-PUM(D%NIJB:D%NIJE,JK-D%NKL))/PDZZ(D%NIJB:D%NIJE,JK)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) - PV_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PV_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PVM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PVM(D%NIJB:D%NIJE,JK+D%NKL)-PVM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)+& - (PVM(D%NIJB:D%NIJE,JK)-PVM(D%NIJB:D%NIJE,JK-D%NKL))/PDZZ(D%NIJB:D%NIJE,JK)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + IF(JK/=IKB) THEN + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(GTEST(IIJB:IIJE)) + PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+& + (PUM(IIJB:IIJE,JK)-PUM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) + PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+& + (PVM(IIJB:IIJE,JK)-PVM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ELSE - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(GTEST(D%NIJB:D%NIJE)) - PU_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PU_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PUM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PUM(D%NIJB:D%NIJE,JK+D%NKL)-PUM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) - PV_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PV_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PVM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PVM(D%NIJB:D%NIJE,JK+D%NKL)-PVM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(GTEST(IIJB:IIJE)) + PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) + PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDIF ENDIF !OMIXUV DO JSV=1,KSV IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(GTEST(D%NIJB:D%NIJE)) - PSV_UP(D%NIJB:D%NIJE,JK+D%NKL,JSV) = (PSV_UP(D%NIJB:D%NIJE,JK,JSV)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - PSVM(D%NIJB:D%NIJE,JK,JSV)*ZMIX2(D%NIJB:D%NIJE)) /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(GTEST(IIJB:IIJE)) + PSV_UP(IIJB:IIJE,JK+IKL,JSV) = (PSV_UP(IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) END DO IF (OENTR_DETR) THEN ! Compute non cons. var. at level JK+KKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZRC_UP(D%NIJB:D%NIJE)=PRC_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - ZRI_UP(D%NIJB:D%NIJE)=PRI_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) - CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), & - PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), & + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below + ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below + !$mnh_end_expand_array(JIJ=IIJB:IIJE) + CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), & + PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), & ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE., & PBUF=ZBUF(:,:), KB=D%NIJB, KE=D%NIJE) - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(GTEST(D%NIJB:D%NIJE)) - PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRC_UP(D%NIJB:D%NIJE) - PRV_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRV_UP(D%NIJB:D%NIJE) - PRI_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRI_UP(D%NIJB:D%NIJE) - PRSAT_UP(D%NIJB:D%NIJE,JK+D%NKL) = ZRSATW(D%NIJB:D%NIJE)*(1-PFRAC_ICE_UP(D%NIJB:D%NIJE,JK+D%NKL)) + & - & ZRSATI(D%NIJB:D%NIJE)*PFRAC_ICE_UP(D%NIJB:D%NIJE,JK+D%NKL) + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(GTEST(IIJB:IIJE)) + PRC_UP(IIJB:IIJE,JK+IKL)=ZRC_UP(IIJB:IIJE) + PRV_UP(IIJB:IIJE,JK+IKL)=ZRV_UP(IIJB:IIJE) + PRI_UP(IIJB:IIJE,JK+IKL)=ZRI_UP(IIJB:IIJE) + PRSAT_UP(IIJB:IIJE,JK+IKL) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)) + & + & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,JK+IKL) ENDWHERE ! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL - WHERE(GTEST(D%NIJB:D%NIJE)) - PTHV_UP(D%NIJB:D%NIJE,JK+D%NKL) = ZTH_UP(D%NIJB:D%NIJE,JK+D%NKL)* & - & ((1+ZRVORD*PRV_UP(D%NIJB:D%NIJE,JK+D%NKL))/(1+PRT_UP(D%NIJB:D%NIJE,JK+D%NKL))) - WHERE (ZBUO_INTEG_DRY(D%NIJB:D%NIJE,JK)>0.) - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL) = ZW_UP2(D%NIJB:D%NIJE,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* & - &ZBUO_INTEG_DRY(D%NIJB:D%NIJE,JK) + WHERE(GTEST(IIJB:IIJE)) + PTHV_UP(IIJB:IIJE,JK+IKL) = ZTH_UP(IIJB:IIJE,JK+IKL)* & + & ((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+IKL))/(1+PRT_UP(IIJB:IIJE,JK+IKL))) + WHERE (ZBUO_INTEG_DRY(IIJB:IIJE,JK)>0.) + ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*(PARAMMF%XABUO-PARAMMF%XBENTR*PARAMMF%XENTR_DRY)* & + &ZBUO_INTEG_DRY(IIJB:IIJE,JK) ELSEWHERE - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL) = ZW_UP2(D%NIJB:D%NIJE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(D%NIJB:D%NIJE,JK) + ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK) + 2.*PARAMMF%XABUO* ZBUO_INTEG_DRY(IIJB:IIJE,JK) ENDWHERE - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL) = ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(D%NIJB:D%NIJE)+ & - &PARAMMF%XBENTR*ZMIX2_CLD(D%NIJB:D%NIJE)))& - /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(D%NIJB:D%NIJE)+PARAMMF%XBENTR*ZMIX2_CLD(D%NIJB:D%NIJE))) & - +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(D%NIJB:D%NIJE,JK)/ & - &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(D%NIJB:D%NIJE)+PARAMMF%XBENTR*ZMIX2_CLD(D%NIJB:D%NIJE))) + ZW_UP2(IIJB:IIJE,JK+IKL) = ZW_UP2(IIJB:IIJE,JK+IKL)*(1.-(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+ & + &PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE)))& + /(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE))) & + +2.*(PARAMMF%XABUO)*ZBUO_INTEG_CLD(IIJB:IIJE,JK)/ & + &(1.+(PARAMMF%XBDETR*ZMIX3_CLD(IIJB:IIJE)+PARAMMF%XBENTR*ZMIX2_CLD(IIJB:IIJE))) ENDWHERE ! Test if the updraft has reach the ETL - WHERE (GTEST(D%NIJB:D%NIJE).AND.(PBUO_INTEG(D%NIJB:D%NIJE,JK)<=0.)) - KKETL(D%NIJB:D%NIJE) = JK+D%NKL - GTESTETL(D%NIJB:D%NIJE)=.TRUE. + WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.)) + KKETL(IIJB:IIJE) = JK+IKL + GTESTETL(IIJB:IIJE)=.TRUE. ELSEWHERE - GTESTETL(D%NIJB:D%NIJE)=.FALSE. + GTESTETL(IIJB:IIJE)=.FALSE. ENDWHERE ! Test is we have reached the top of the updraft - WHERE (GTEST(D%NIJB:D%NIJE).AND.((ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)<=0.).OR.(PEMF(D%NIJB:D%NIJE,JK+D%NKL)<=0.))) - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)=0. - PEMF(D%NIJB:D%NIJE,JK+D%NKL)=0. - GTEST(D%NIJB:D%NIJE)=.FALSE. - PTHL_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZTHLM_F(D%NIJB:D%NIJE,JK+D%NKL) - PRT_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRTM_F(D%NIJB:D%NIJE,JK+D%NKL) - PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PRI_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PRV_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PTHV_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZTHVM_F(D%NIJB:D%NIJE,JK+D%NKL) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - KKCTL(D%NIJB:D%NIJE)=JK+D%NKL + WHERE (GTEST(IIJB:IIJE).AND.((ZW_UP2(IIJB:IIJE,JK+IKL)<=0.).OR.(PEMF(IIJB:IIJE,JK+IKL)<=0.))) + ZW_UP2(IIJB:IIJE,JK+IKL)=0. + PEMF(IIJB:IIJE,JK+IKL)=0. + GTEST(IIJB:IIJE)=.FALSE. + PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHLM_F(IIJB:IIJE,JK+IKL) + PRT_UP(IIJB:IIJE,JK+IKL)=ZRTM_F(IIJB:IIJE,JK+IKL) + PRC_UP(IIJB:IIJE,JK+IKL)=0. + PRI_UP(IIJB:IIJE,JK+IKL)=0. + PRV_UP(IIJB:IIJE,JK+IKL)=0. + PTHV_UP(IIJB:IIJE,JK+IKL)=ZTHVM_F(IIJB:IIJE,JK+IKL) + PFRAC_UP(IIJB:IIJE,JK+IKL)=0. + KKCTL(IIJB:IIJE)=JK+IKL ENDWHERE ! compute frac_up at JK+KKL - WHERE (GTEST(D%NIJB:D%NIJE)) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=PEMF(D%NIJB:D%NIJE,JK+D%NKL)/& - &(SQRT(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL))*ZRHO_F(D%NIJB:D%NIJE,JK+D%NKL)) + WHERE (GTEST(IIJB:IIJE)) + PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/& + &(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL)) ENDWHERE ! Updraft fraction must be smaller than XFRAC_UP_MAX - WHERE (GTEST(D%NIJB:D%NIJE)) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)) + WHERE (GTEST(IIJB:IIJE)) + PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL)) ENDWHERE ! When cloudy and non-buoyant, updraft fraction must decrease - WHERE ((GTEST(D%NIJB:D%NIJE).AND.GTESTETL(D%NIJB:D%NIJE)).AND.GTESTLCL(D%NIJB:D%NIJE)) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=MIN(PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL),PFRAC_UP(D%NIJB:D%NIJE,JK)) + WHERE ((GTEST(IIJB:IIJE).AND.GTESTETL(IIJB:IIJE)).AND.GTESTLCL(IIJB:IIJE)) + PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PFRAC_UP(IIJB:IIJE,JK+IKL),PFRAC_UP(IIJB:IIJE,JK)) ENDWHERE ! Mass flux is updated with the new updraft fraction - IF (OENTR_DETR) PEMF(D%NIJB:D%NIJE,JK+D%NKL)=PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)*SQRT(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL))* & - &ZRHO_F(D%NIJB:D%NIJE,JK+D%NKL) - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + IF (OENTR_DETR) PEMF(IIJB:IIJE,JK+IKL)=PFRAC_UP(IIJB:IIJE,JK+IKL)*SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))* & + &ZRHO_F(IIJB:IIJE,JK+IKL) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) END IF !OENTR_DETR ENDDO IF(OENTR_DETR) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PW_UP(D%NIJB:D%NIJE,1:D%NKT)=SQRT(ZW_UP2(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PEMF(D%NIJB:D%NIJE,D%NKB) =0. - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + PEMF(IIJB:IIJE,IKB) =0. + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Limits the shallow convection scheme when cloud heigth is higher than 3000m. ! To do this, mass flux is multiplied by a coefficient decreasing linearly @@ -674,22 +682,22 @@ IF(OENTR_DETR) THEN PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) END DO - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GWORK1(D%NIJB:D%NIJE)= (GTESTLCL(D%NIJB:D%NIJE) .AND. (PDEPTH(D%NIJB:D%NIJE) > ZDEPTH_MAX1) ) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) - DO JK=1, D%NKT - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GWORK2(D%NIJB:D%NIJE,JK) = GWORK1(D%NIJB:D%NIJE) - ZCOEF(D%NIJB:D%NIJE,JK) = (1.-(PDEPTH(D%NIJB:D%NIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) - ZCOEF(D%NIJB:D%NIJE,JK)=MIN(MAX(ZCOEF(D%NIJB:D%NIJE,JK),0.),1.) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) + DO JK=1,IKT + !$mnh_expand_array(JIJ=IIJB:IIJE) + GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE) + ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) + ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO - !$mnh_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - WHERE (GWORK2(D%NIJB:D%NIJE,1:D%NKT)) - PEMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT) * ZCOEF(D%NIJB:D%NIJE,1:D%NKT) - PFRAC_UP(D%NIJB:D%NIJE,1:D%NKT) = PFRAC_UP(D%NIJB:D%NIJE,1:D%NKT) * ZCOEF(D%NIJB:D%NIJE,1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE (GWORK2(IIJB:IIJE,1:IKT)) + PEMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT) + PFRAC_UP(IIJB:IIJE,1:IKT) = PFRAC_UP(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT',1,ZHOOK_HANDLE) @@ -829,13 +837,13 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PPART_DRY ! ratio of dry part at t ! ------------------ ZCOEFFMF_CLOUD=PARAMMF%XENTR_MF * CST%XG / PARAMMF%XCRAD_MF -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZG_O_THVREF_ED(D%NIJB:D%NIJE)=CST%XG/PTHVM(D%NIJB:D%NIJE,KK) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZG_O_THVREF_ED(IIJB:IIJE)=CST%XG/PTHVM(IIJB:IIJE,KK) -ZFRAC_ICE(D%NIJB:D%NIJE)=PFRAC_ICE(D%NIJB:D%NIJE) ! to not modify fraction of ice +ZFRAC_ICE(IIJB:IIJE)=PFRAC_ICE(IIJB:IIJE) ! to not modify fraction of ice -ZPRE(D%NIJB:D%NIJE)=PPRE_MINUS_HALF(D%NIJB:D%NIJE) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +ZPRE(IIJB:IIJE)=PPRE_MINUS_HALF(IIJB:IIJE) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! 1.4 Estimation of PPART_DRY DO JI=D%NIJB,D%NIJE @@ -871,19 +879,19 @@ DO JI=D%NIJB,D%NIJE END DO ! 1.5 Gradient and flux values of thetav -!$mnh_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) IF(KK/=KKB)THEN - ZCOEFF_MINUS_HALF(D%NIJB:D%NIJE)=((PTHVM(D%NIJB:D%NIJE,KK)-PTHVM(D%NIJB:D%NIJE,KK-KKL))/PDZZ(D%NIJB:D%NIJE,KK)) - ZTHV_MINUS_HALF(D%NIJB:D%NIJE) = PTHVM(D%NIJB:D%NIJE,KK) - & - & ZCOEFF_MINUS_HALF(D%NIJB:D%NIJE)*0.5*(PZZ(D%NIJB:D%NIJE,KK+KKL)-PZZ(D%NIJB:D%NIJE,KK)) + ZCOEFF_MINUS_HALF(IIJB:IIJE)=((PTHVM(IIJB:IIJE,KK)-PTHVM(IIJB:IIJE,KK-KKL))/PDZZ(IIJB:IIJE,KK)) + ZTHV_MINUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK) - & + & ZCOEFF_MINUS_HALF(IIJB:IIJE)*0.5*(PZZ(IIJB:IIJE,KK+KKL)-PZZ(IIJB:IIJE,KK)) ELSE - ZCOEFF_MINUS_HALF(D%NIJB:D%NIJE)=0. - ZTHV_MINUS_HALF(D%NIJB:D%NIJE) = PTHVM(D%NIJB:D%NIJE,KK) + ZCOEFF_MINUS_HALF(IIJB:IIJE)=0. + ZTHV_MINUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK) ENDIF -ZCOEFF_PLUS_HALF(D%NIJB:D%NIJE) = ((PTHVM(D%NIJB:D%NIJE,KK+KKL)-PTHVM(D%NIJB:D%NIJE,KK))/PDZZ(D%NIJB:D%NIJE,KK+KKL)) -ZTHV_PLUS_HALF(D%NIJB:D%NIJE) = PTHVM(D%NIJB:D%NIJE,KK) + & - & ZCOEFF_PLUS_HALF(D%NIJB:D%NIJE)*0.5*(PZZ(D%NIJB:D%NIJE,KK+KKL)-PZZ(D%NIJB:D%NIJE,KK)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +ZCOEFF_PLUS_HALF(IIJB:IIJE) = ((PTHVM(IIJB:IIJE,KK+KKL)-PTHVM(IIJB:IIJE,KK))/PDZZ(IIJB:IIJE,KK+KKL)) +ZTHV_PLUS_HALF(IIJB:IIJE) = PTHVM(IIJB:IIJE,KK) + & + & ZCOEFF_PLUS_HALF(IIJB:IIJE)*0.5*(PZZ(IIJB:IIJE,KK+KKL)-PZZ(IIJB:IIJE,KK)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! 2 Dry part computation: ! Integral buoyancy and computation of PENTR and PDETR for dry part @@ -938,18 +946,18 @@ ENDDO ! Compute theta_v of updraft at flux level KK+KKL !MIX variables are used to avoid declaring new variables !but we are dealing with updraft and not mixture -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZRCMIX(D%NIJB:D%NIJE)=PRC_UP(D%NIJB:D%NIJE) -ZRIMIX(D%NIJB:D%NIJE)=PRI_UP(D%NIJB:D%NIJE) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZRCMIX(IIJB:IIJE)=PRC_UP(IIJB:IIJE) +ZRIMIX(IIJB:IIJE)=PRI_UP(IIJB:IIJE) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,& PPRE_PLUS_HALF,PTHL_UP,PRT_UP,& ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,& ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZTHV_UP_F2(D%NIJB:D%NIJE) = ZTHMIX(D%NIJB:D%NIJE)*(1.+ZRVORD*ZRVMIX(D%NIJB:D%NIJE))/(1.+PRT_UP(D%NIJB:D%NIJE)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZTHV_UP_F2(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+PRT_UP(IIJB:IIJE)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Integral buoyancy for cloudy part DO JI=D%NIJB,D%NIJE @@ -1027,23 +1035,23 @@ CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,& ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,& ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZTHVMIX(D%NIJB:D%NIJE) = ZTHMIX(D%NIJB:D%NIJE)*(1.+ZRVORD*ZRVMIX(D%NIJB:D%NIJE))/(1.+ZMIXRT(D%NIJB:D%NIJE)) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZTHVMIX(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+ZMIXRT(IIJB:IIJE)) ! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC -ZMIXTHL(D%NIJB:D%NIJE) = ZKIC_INIT * 0.5*(PTHLM(D%NIJB:D%NIJE,KK)+PTHLM(D%NIJB:D%NIJE,KK+KKL))+& - & (1. - ZKIC_INIT)*PTHL_UP(D%NIJB:D%NIJE) -ZMIXRT(D%NIJB:D%NIJE) = ZKIC_INIT * 0.5*(PRTM(D%NIJB:D%NIJE,KK)+PRTM(D%NIJB:D%NIJE,KK+KKL))+& - & (1. - ZKIC_INIT)*PRT_UP(D%NIJB:D%NIJE) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +ZMIXTHL(IIJB:IIJE) = ZKIC_INIT * 0.5*(PTHLM(IIJB:IIJE,KK)+PTHLM(IIJB:IIJE,KK+KKL))+& + & (1. - ZKIC_INIT)*PTHL_UP(IIJB:IIJE) +ZMIXRT(IIJB:IIJE) = ZKIC_INIT * 0.5*(PRTM(IIJB:IIJE,KK)+PRTM(IIJB:IIJE,KK+KKL))+& + & (1. - ZKIC_INIT)*PRT_UP(IIJB:IIJE) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,ZFRAC_ICE,& PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,& ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,& ZRSATW_ED, ZRSATI_ED,OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZTHVMIX_F2(D%NIJB:D%NIJE) = ZTHMIX(D%NIJB:D%NIJE)*(1.+ZRVORD*ZRVMIX(D%NIJB:D%NIJE))/(1.+ZMIXRT(D%NIJB:D%NIJE)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZTHVMIX_F2(IIJB:IIJE) = ZTHMIX(IIJB:IIJE)*(1.+ZRVORD*ZRVMIX(IIJB:IIJE))/(1.+ZMIXRT(IIJB:IIJE)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) !Computation of mean ZKIC over the cloudy part DO JI=D%NIJB,D%NIJE @@ -1086,14 +1094,14 @@ ENDDO !Calculus must be verified before activating this part, but in this state, !results on ARM case are almost identical !For this PDF, eq. (5) is also delta Me=0.5*delta Mt -!WHERE(OTEST(D%NIJB:D%NIJE)) +!WHERE(OTEST(IIJB:IIJE)) ! !Integration multiplied by 2 ! WHERE(ZKIC<0.5) -! ZEPSI(D%NIJB:D%NIJE)=8.*ZKIC(D%NIJB:D%NIJE)**3/3. -! ZDELTA(D%NIJB:D%NIJE)=1.-4.*ZKIC(D%NIJB:D%NIJE)**2+8.*ZKIC(D%NIJB:D%NIJE)**3/3. +! ZEPSI(IIJB:IIJE)=8.*ZKIC(IIJB:IIJE)**3/3. +! ZDELTA(IIJB:IIJE)=1.-4.*ZKIC(IIJB:IIJE)**2+8.*ZKIC(IIJB:IIJE)**3/3. ! ELSEWHERE -! ZEPSI(D%NIJB:D%NIJE)=5./3.-4*ZKIC(D%NIJB:D%NIJE)**2+8.*ZKIC(D%NIJB:D%NIJE)**3/3. -! ZDELTA(D%NIJB:D%NIJE)=8.*(1.-ZKIC(D%NIJB:D%NIJE))**3/3. +! ZEPSI(IIJB:IIJE)=5./3.-4*ZKIC(IIJB:IIJE)**2+8.*ZKIC(IIJB:IIJE)**3/3. +! ZDELTA(IIJB:IIJE)=8.*(1.-ZKIC(IIJB:IIJE))**3/3. ! ENDWHERE !ENDWHERE diff --git a/src/common/turb/mode_compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90 index d27917446ff250e9f940f118016fd8aa5b7d1606..069068e893918ea39c52b67485e0ad0a0079a3c1 100644 --- a/src/common/turb/mode_compute_updraft_raha.F90 +++ b/src/common/turb/mode_compute_updraft_raha.F90 @@ -157,7 +157,9 @@ REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground REAL, DIMENSION(D%NIJT) :: ZDEPTH ! Deepness limit for cloud -INTEGER :: JK,JI,JJ,JSV ! loop counters +INTEGER :: JK,JIJ,JSV ! loop counters +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGEr :: IKT,IKB,IKE,IKL LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL,GTESTETL ! Test if the ascent continue, if LCL or ETL is reached @@ -190,7 +192,14 @@ REAL, DIMENSION(D%NIJT,16) :: ZBUF REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +! ! Thresholds for the perturbation of ! theta_l and r_t at the first level of the updraft @@ -209,9 +218,9 @@ ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed ! Local variables, internal domain ! Initialisation of intersesting Level :LCL,ETL,CTL -KKLCL(:)=D%NKE -KKETL(:)=D%NKE -KKCTL(:)=D%NKE +KKLCL(:)=IKE +KKETL(:)=IKE +KKCTL(:)=IKE ! ! Initialisation @@ -236,9 +245,9 @@ ZBUO(:,:) =0. !no ice cloud coded yet PRI_UP(:,:)=0. PFRAC_ICE_UP(:,:)=0. -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PRSAT_UP(D%NIJB:D%NIJE,1:D%NKT)=PRVM(D%NIJB:D%NIJE,1:D%NKT) ! should be initialised correctly but is (normaly) not used -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Initialisation of environment variables at t-dt @@ -251,110 +260,110 @@ CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:)) !DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE -! ZSVM_F(D%NIJB:D%NIJE,KKB:IKU,JSV) = 0.5*(PSVM(D%NIJB:D%NIJE,KKB:IKU,JSV)+PSVM(D%NIJB:D%NIJE,1:IKU-1,JSV)) -! ZSVM_F(D%NIJB:D%NIJE,1,JSV) = ZSVM_F(D%NIJB:D%NIJE,KKB,JSV) +! ZSVM_F(IIJB:IIJE,KKB:IKU,JSV) = 0.5*(PSVM(IIJB:IIJE,KKB:IKU,JSV)+PSVM(IIJB:IIJE,1:IKU-1,JSV)) +! ZSVM_F(IIJB:IIJE,1,JSV) = ZSVM_F(IIJB:IIJE,KKB,JSV) !END DO ! Initialisation of updraft characteristics -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)=ZTHLM_F(D%NIJB:D%NIJE,1:D%NKT) -PRT_UP(D%NIJB:D%NIJE,1:D%NKT)=ZRTM_F(D%NIJB:D%NIJE,1:D%NKT) -PU_UP(D%NIJB:D%NIJE,1:D%NKT)=ZUM_F(D%NIJB:D%NIJE,1:D%NKT) -PV_UP(D%NIJB:D%NIJE,1:D%NKT)=ZVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT) +PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT) +PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT) +PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) PSV_UP(:,:,:)=0. !IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then -! PSV_UP(D%NIJB:D%NIJE,:,:)=ZSVM_F(D%NIJB:D%NIJE,:,:) +! PSV_UP(IIJB:IIJE,:,:)=ZSVM_F(IIJB:IIJE,:,:) !ENDIF ! Computation or initialisation of updraft characteristics at the KKB level ! thetal_up,rt_up,thetaV_up, w�,Buoyancy term and mass flux (PEMF) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PTHL_UP(D%NIJB:D%NIJE,D%NKB)= ZTHLM_F(D%NIJB:D%NIJE,D%NKB)+ & - & MAX(0.,MIN(ZTMAX,(PSFTH(D%NIJB:D%NIJE)/SQRT(ZTKEM_F(D%NIJB:D%NIJE,D%NKB)))*PARAMMF%XALP_PERT)) -PRT_UP(D%NIJB:D%NIJE,D%NKB) = ZRTM_F(D%NIJB:D%NIJE,D%NKB)+ & - & MAX(0.,MIN(ZRMAX,(PSFRV(D%NIJB:D%NIJE)/SQRT(ZTKEM_F(D%NIJB:D%NIJE,D%NKB)))*PARAMMF%XALP_PERT)) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PTHL_UP(IIJB:IIJE,IKB)= ZTHLM_F(IIJB:IIJE,IKB)+ & + & MAX(0.,MIN(ZTMAX,(PSFTH(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))*PARAMMF%XALP_PERT)) +PRT_UP(IIJB:IIJE,IKB) = ZRTM_F(IIJB:IIJE,IKB)+ & + & MAX(0.,MIN(ZRMAX,(PSFRV(IIJB:IIJE)/SQRT(ZTKEM_F(IIJB:IIJE,IKB)))*PARAMMF%XALP_PERT)) -ZQT_UP(D%NIJB:D%NIJE) = PRT_UP(D%NIJB:D%NIJE,D%NKB)/(1.+PRT_UP(D%NIJB:D%NIJE,D%NKB)) -ZTHS_UP(D%NIJB:D%NIJE,D%NKB)=PTHL_UP(D%NIJB:D%NIJE,D%NKB)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIJB:D%NIJE)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +ZQT_UP(IIJB:IIJE) = PRT_UP(IIJB:IIJE,IKB)/(1.+PRT_UP(IIJB:IIJE,IKB)) +ZTHS_UP(IIJB:IIJE,IKB)=PTHL_UP(IIJB:IIJE,IKB)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MZM_MF(D, PTHM (:,:), ZTHM_F(:,:)) CALL MZM_MF(D, PPABSM(:,:), ZPRES_F(:,:)) CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:)) CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! thetav at mass and flux levels -ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT)=ZTHM_F(D%NIJB:D%NIJE,1:D%NKT)*((1.+ZRVORD*ZRVM_F(D%NIJB:D%NIJE,1:D%NKT))/& - &(1.+ZRTM_F(D%NIJB:D%NIJE,1:D%NKT))) -ZTHVM(D%NIJB:D%NIJE,1:D%NKT)=PTHM(D%NIJB:D%NIJE,1:D%NKT)*((1.+ZRVORD*PRVM(D%NIJB:D%NIJE,1:D%NKT))/(1.+PRTM(D%NIJB:D%NIJE,1:D%NKT))) +ZTHVM_F(IIJB:IIJE,1:IKT)=ZTHM_F(IIJB:IIJE,1:IKT)*((1.+ZRVORD*ZRVM_F(IIJB:IIJE,1:IKT))/& + &(1.+ZRTM_F(IIJB:IIJE,1:IKT))) +ZTHVM(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)*((1.+ZRVORD*PRVM(IIJB:IIJE,1:IKT))/(1.+PRTM(IIJB:IIJE,1:IKT))) -PTHV_UP(D%NIJB:D%NIJE,1:D%NKT)= ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) -PRV_UP(D%NIJB:D%NIJE,1:D%NKT) = ZRVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +PTHV_UP(IIJB:IIJE,1:IKT)= ZTHVM_F(IIJB:IIJE,1:IKT) +PRV_UP(IIJB:IIJE,1:IKT) = ZRVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZW_UP2(:,:)=ZEPS -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZW_UP2(D%NIJB:D%NIJE,D%NKB) = MAX(0.0001,(1./6.)*ZTKEM_F(D%NIJB:D%NIJE,D%NKB)) -GTEST(D%NIJB:D%NIJE) = (ZW_UP2(D%NIJB:D%NIJE,D%NKB) > ZEPS) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(1./6.)*ZTKEM_F(IIJB:IIJE,IKB)) +GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,IKB) > ZEPS) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Computation of non conservative variable for the KKB level of the updraft ! (all or nothing ajustement) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PRC_UP(D%NIJB:D%NIJE,D%NKB)=0. -PRI_UP(D%NIJB:D%NIJE,D%NKB)=0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) - -CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), & - PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), & - PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& +!$mnh_expand_array(JIJ=IIJB:IIJE) +PRC_UP(IIJB:IIJE,IKB)=0. +PRI_UP(IIJB:IIJE,IKB)=0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) + +CALL TH_R_FROM_THL_RT(CST, NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), & + PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), & + PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) ! compute updraft thevav and buoyancy term at KKB level -PTHV_UP(D%NIJB:D%NIJE,D%NKB) = ZTH_UP(D%NIJB:D%NIJE,D%NKB)*((1+ZRVORD*PRV_UP(D%NIJB:D%NIJE,D%NKB))/(1+PRT_UP(D%NIJB:D%NIJE,D%NKB))) +PTHV_UP(IIJB:IIJE,IKB) = ZTH_UP(IIJB:IIJE,IKB)*((1+ZRVORD*PRV_UP(IIJB:IIJE,IKB))/(1+PRT_UP(IIJB:IIJE,IKB))) ! compute mean rsat in updraft -PRSAT_UP(D%NIJB:D%NIJE,D%NKB) = ZRSATW(D%NIJB:D%NIJE)*(1-PFRAC_ICE_UP(D%NIJB:D%NIJE,D%NKB)) + & - & ZRSATI(D%NIJB:D%NIJE)*PFRAC_ICE_UP(D%NIJB:D%NIJE,D%NKB) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +PRSAT_UP(IIJB:IIJE,IKB) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,IKB)) + & + & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,IKB) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) !Tout est commente pour tester dans un premier temps la s�paration en deux de la ! boucle verticale, une pour w et une pour PEMF -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZG_O_THVREF(D%NIJB:D%NIJE,1:D%NKT)=CST%XG/ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Definition de l'alimentation au sens de la fermeture de Hourdin et al ZALIM_STAR(:,:) = 0. ZALIM_STAR_TOT(:) = 0. ! <== Normalization of ZALIM_STAR -IALIM(:) = D%NKB ! <== Top level of the alimentation layer +IALIM(:) = IKB ! <== Top level of the alimentation layer -DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - ZZDZ(D%NIJB:D%NIJE,JK) = MAX(ZEPS,PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK)) ! <== Delta Z between two flux level - ZZZ(D%NIJB:D%NIJE,JK) = MAX(0.,0.5*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)+PZZ(D%NIJB:D%NIJE,JK)) ) ! <== Hight of mass levels - ZDTHETASDZ(D%NIJB:D%NIJE,JK) = (ZTHVM_F(D%NIJB:D%NIJE,JK)-ZTHVM_F(D%NIJB:D%NIJE,JK+D%NKL)) ! <== Delta theta_v +DO JK=IKB,IKE-IKL,IKL ! Vertical loop + !$mnh_expand_where(JIJ=IIJB:IIJE) + ZZDZ(IIJB:IIJE,JK) = MAX(ZEPS,PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) ! <== Delta Z between two flux level + ZZZ(IIJB:IIJE,JK) = MAX(0.,0.5*(PZZ(IIJB:IIJE,JK+IKL)+PZZ(IIJB:IIJE,JK)) ) ! <== Hight of mass levels + ZDTHETASDZ(IIJB:IIJE,JK) = (ZTHVM_F(IIJB:IIJE,JK)-ZTHVM_F(IIJB:IIJE,JK+IKL)) ! <== Delta theta_v - WHERE ((ZTHVM_F(D%NIJB:D%NIJE,JK+D%NKL)<ZTHVM_F(D%NIJB:D%NIJE,JK)) .AND. & - &(ZTHVM_F(D%NIJB:D%NIJE,D%NKB)>=ZTHVM_F(D%NIJB:D%NIJE,JK))) - ZALIM_STAR(D%NIJB:D%NIJE,JK) = SQRT(ZZZ(D%NIJB:D%NIJE,JK))*ZDTHETASDZ(D%NIJB:D%NIJE,JK)/ZZDZ(D%NIJB:D%NIJE,JK) - ZALIM_STAR_TOT(D%NIJB:D%NIJE) = ZALIM_STAR_TOT(D%NIJB:D%NIJE)+ZALIM_STAR(D%NIJB:D%NIJE,JK)*ZZDZ(D%NIJB:D%NIJE,JK) - IALIM(D%NIJB:D%NIJE) = JK + WHERE ((ZTHVM_F(IIJB:IIJE,JK+IKL)<ZTHVM_F(IIJB:IIJE,JK)) .AND. & + &(ZTHVM_F(IIJB:IIJE,IKB)>=ZTHVM_F(IIJB:IIJE,JK))) + ZALIM_STAR(IIJB:IIJE,JK) = SQRT(ZZZ(IIJB:IIJE,JK))*ZDTHETASDZ(IIJB:IIJE,JK)/ZZDZ(IIJB:IIJE,JK) + ZALIM_STAR_TOT(IIJB:IIJE) = ZALIM_STAR_TOT(IIJB:IIJE)+ZALIM_STAR(IIJB:IIJE,JK)*ZZDZ(IIJB:IIJE,JK) + IALIM(IIJB:IIJE) = JK ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDDO ! Normalization of ZALIM_STAR -DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE (ZALIM_STAR_TOT(D%NIJB:D%NIJE) > ZEPS) - ZALIM_STAR(D%NIJB:D%NIJE,JK) = ZALIM_STAR(D%NIJB:D%NIJE,JK)/ZALIM_STAR_TOT(D%NIJB:D%NIJE) +DO JK=IKB,IKE-IKL,IKL ! Vertical loop + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE (ZALIM_STAR_TOT(IIJB:IIJE) > ZEPS) + ZALIM_STAR(IIJB:IIJE,JK) = ZALIM_STAR(IIJB:IIJE,JK)/ZALIM_STAR_TOT(IIJB:IIJE) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDDO ZALIM_STAR_TOT(:) = 0. @@ -380,20 +389,20 @@ ZZTOP(:) = 0. ZPHI(:) = 0. -DO JK=D%NKB,D%NKE-D%NKL,D%NKL - !$mnh_expand_where(JI=D%NIJB:D%NIJE) +DO JK=IKB,IKE-IKL,IKL + !$mnh_expand_where(JIJ=IIJB:IIJE) ! IF the updraft top is reached for all column, stop the loop on levels - !ITEST=COUNT(GTEST(D%NIJB:D%NIJE)) + !ITEST=COUNT(GTEST(IIJB:IIJE)) !IF (ITEST==0) CYCLE ! Computation of entrainment and detrainment with KF90 ! parameterization in clouds and LR01 in subcloud layer ! to find the LCL (check if JK is LCL or not) - WHERE ((PRC_UP(D%NIJB:D%NIJE,JK)+PRI_UP(D%NIJB:D%NIJE,JK)>0.).AND.(.NOT.(GTESTLCL(D%NIJB:D%NIJE)))) - KKLCL(D%NIJB:D%NIJE) = JK - GTESTLCL(D%NIJB:D%NIJE)=.TRUE. + WHERE ((PRC_UP(IIJB:IIJE,JK)+PRI_UP(IIJB:IIJE,JK)>0.).AND.(.NOT.(GTESTLCL(IIJB:IIJE)))) + KKLCL(IIJB:IIJE) = JK + GTESTLCL(IIJB:IIJE)=.TRUE. ENDWHERE ! COMPUTE PENTR and PDETR at mass level JK @@ -403,221 +412,221 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Compute theta_v of updraft at flux level JK - ZRC_UP(D%NIJB:D%NIJE) = PRC_UP(D%NIJB:D%NIJE,JK) - ZRI_UP(D%NIJB:D%NIJE) = PRI_UP(D%NIJB:D%NIJE,JK) ! guess - ZRV_UP(D%NIJB:D%NIJE) = PRV_UP(D%NIJB:D%NIJE,JK) - ZBUO(D%NIJB:D%NIJE,JK) = ZG_O_THVREF(D%NIJB:D%NIJE,JK)*(PTHV_UP(D%NIJB:D%NIJE,JK) - ZTHVM_F(D%NIJB:D%NIJE,JK)) - PBUO_INTEG(D%NIJB:D%NIJE,JK) = ZBUO(D%NIJB:D%NIJE,JK)*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK)) + ZRC_UP(IIJB:IIJE) = PRC_UP(IIJB:IIJE,JK) + ZRI_UP(IIJB:IIJE) = PRI_UP(IIJB:IIJE,JK) ! guess + ZRV_UP(IIJB:IIJE) = PRV_UP(IIJB:IIJE,JK) + ZBUO(IIJB:IIJE,JK) = ZG_O_THVREF(IIJB:IIJE,JK)*(PTHV_UP(IIJB:IIJE,JK) - ZTHVM_F(IIJB:IIJE,JK)) + PBUO_INTEG(IIJB:IIJE,JK) = ZBUO(IIJB:IIJE,JK)*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) - ZDZ(D%NIJB:D%NIJE) = MAX(ZEPS,PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK)) - ZTEST(D%NIJB:D%NIJE) = PARAMMF%XA1*ZBUO(D%NIJB:D%NIJE,JK) - PARAMMF%XB*ZW_UP2(D%NIJB:D%NIJE,JK) + ZDZ(IIJB:IIJE) = MAX(ZEPS,PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK)) + ZTEST(IIJB:IIJE) = PARAMMF%XA1*ZBUO(IIJB:IIJE,JK) - PARAMMF%XB*ZW_UP2(IIJB:IIJE,JK) - ZCOE(D%NIJB:D%NIJE) = ZDZ(D%NIJB:D%NIJE) - WHERE (ZTEST(D%NIJB:D%NIJE)>0.) - ZCOE(D%NIJB:D%NIJE) = ZDZ(D%NIJB:D%NIJE)/(1.+ PARAMMF%XBETA1) + ZCOE(IIJB:IIJE) = ZDZ(IIJB:IIJE) + WHERE (ZTEST(IIJB:IIJE)>0.) + ZCOE(IIJB:IIJE) = ZDZ(IIJB:IIJE)/(1.+ PARAMMF%XBETA1) ENDWHERE ! Calcul de la vitesse - ZWCOE(D%NIJB:D%NIJE) = (1.-PARAMMF%XB*ZCOE(D%NIJB:D%NIJE))/(1.+PARAMMF%XB*ZCOE(D%NIJB:D%NIJE)) - ZBUCOE(D%NIJB:D%NIJE) = 2.*ZCOE(D%NIJB:D%NIJE)/(1.+PARAMMF%XB*ZCOE(D%NIJB:D%NIJE)) + ZWCOE(IIJB:IIJE) = (1.-PARAMMF%XB*ZCOE(IIJB:IIJE))/(1.+PARAMMF%XB*ZCOE(IIJB:IIJE)) + ZBUCOE(IIJB:IIJE) = 2.*ZCOE(IIJB:IIJE)/(1.+PARAMMF%XB*ZCOE(IIJB:IIJE)) - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL) = MAX(ZEPS,ZW_UP2(D%NIJB:D%NIJE,JK)*ZWCOE(D%NIJB:D%NIJE) + & - &PARAMMF%XA1*ZBUO(D%NIJB:D%NIJE,JK)*ZBUCOE(D%NIJB:D%NIJE)) - ZW_MAX(D%NIJB:D%NIJE) = MAX(ZW_MAX(D%NIJB:D%NIJE), SQRT(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL))) - ZWUP_MEAN(D%NIJB:D%NIJE) = MAX(ZEPS,0.5*(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)+ZW_UP2(D%NIJB:D%NIJE,JK))) + ZW_UP2(IIJB:IIJE,JK+IKL) = MAX(ZEPS,ZW_UP2(IIJB:IIJE,JK)*ZWCOE(IIJB:IIJE) + & + &PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)*ZBUCOE(IIJB:IIJE)) + ZW_MAX(IIJB:IIJE) = MAX(ZW_MAX(IIJB:IIJE), SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))) + ZWUP_MEAN(IIJB:IIJE) = MAX(ZEPS,0.5*(ZW_UP2(IIJB:IIJE,JK+IKL)+ZW_UP2(IIJB:IIJE,JK))) ! Entrainement et detrainement - PENTR(D%NIJB:D%NIJE,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))* & - &(PARAMMF%XA1*ZBUO(D%NIJB:D%NIJE,JK)/ZWUP_MEAN(D%NIJB:D%NIJE)-PARAMMF%XB)) + PENTR(IIJB:IIJE,JK) = MAX(0.,(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))* & + &(PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)/ZWUP_MEAN(IIJB:IIJE)-PARAMMF%XB)) - ZDETR_BUO(D%NIJB:D%NIJE) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(D%NIJB:D%NIJE,JK)/ & - &ZWUP_MEAN(D%NIJB:D%NIJE)) - ZDETR_RT(D%NIJB:D%NIJE) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(D%NIJB:D%NIJE,JK) - ZRTM_F(D%NIJB:D%NIJE,JK))) / & - &MAX(ZEPS,ZRTM_F(D%NIJB:D%NIJE,JK)) / ZWUP_MEAN(D%NIJB:D%NIJE)) - PDETR(D%NIJB:D%NIJE,JK) = ZDETR_RT(D%NIJB:D%NIJE)+ZDETR_BUO(D%NIJB:D%NIJE) + ZDETR_BUO(IIJB:IIJE) = MAX(0., -(PARAMMF%XBETA1/(1.+PARAMMF%XBETA1))*PARAMMF%XA1*ZBUO(IIJB:IIJE,JK)/ & + &ZWUP_MEAN(IIJB:IIJE)) + ZDETR_RT(IIJB:IIJE) = PARAMMF%XC*SQRT(MAX(0.,(PRT_UP(IIJB:IIJE,JK) - ZRTM_F(IIJB:IIJE,JK))) / & + &MAX(ZEPS,ZRTM_F(IIJB:IIJE,JK)) / ZWUP_MEAN(IIJB:IIJE)) + PDETR(IIJB:IIJE,JK) = ZDETR_RT(IIJB:IIJE)+ZDETR_BUO(IIJB:IIJE) ! If the updraft did not stop, compute cons updraft characteritics at jk+1 - WHERE(GTEST(D%NIJB:D%NIJE)) - ZZTOP(D%NIJB:D%NIJE) = MAX(ZZTOP(D%NIJB:D%NIJE),PZZ(D%NIJB:D%NIJE,JK+D%NKL)) - ZMIX2(D%NIJB:D%NIJE) = (PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*PENTR(D%NIJB:D%NIJE,JK) !& - ZMIX3(D%NIJB:D%NIJE) = (PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*PDETR(D%NIJB:D%NIJE,JK) !& + WHERE(GTEST(IIJB:IIJE)) + ZZTOP(IIJB:IIJE) = MAX(ZZTOP(IIJB:IIJE),PZZ(IIJB:IIJE,JK+IKL)) + ZMIX2(IIJB:IIJE) = (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*PENTR(IIJB:IIJE,JK) !& + ZMIX3(IIJB:IIJE) = (PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*PDETR(IIJB:IIJE,JK) !& - ZQTM(D%NIJB:D%NIJE) = PRTM(D%NIJB:D%NIJE,JK)/(1.+PRTM(D%NIJB:D%NIJE,JK)) - ZTHSM(D%NIJB:D%NIJE,JK) = PTHLM(D%NIJB:D%NIJE,JK)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(D%NIJB:D%NIJE)) - ZTHS_UP(D%NIJB:D%NIJE,JK+D%NKL)=(ZTHS_UP(D%NIJB:D%NIJE,JK)*(1.-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &ZTHSM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE))& - /(1.+0.5*ZMIX2(D%NIJB:D%NIJE)) - PRT_UP(D%NIJB:D%NIJE,JK+D%NKL)=(PRT_UP(D%NIJB:D%NIJE,JK)*(1.-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PRTM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)) & - /(1.+0.5*ZMIX2(D%NIJB:D%NIJE)) - ZQT_UP(D%NIJB:D%NIJE) = PRT_UP(D%NIJB:D%NIJE,JK+D%NKL)/(1.+PRT_UP(D%NIJB:D%NIJE,JK+D%NKL)) - PTHL_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZTHS_UP(D%NIJB:D%NIJE,JK+D%NKL)/(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIJB:D%NIJE)) + ZQTM(IIJB:IIJE) = PRTM(IIJB:IIJE,JK)/(1.+PRTM(IIJB:IIJE,JK)) + ZTHSM(IIJB:IIJE,JK) = PTHLM(IIJB:IIJE,JK)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(IIJB:IIJE)) + ZTHS_UP(IIJB:IIJE,JK+IKL)=(ZTHS_UP(IIJB:IIJE,JK)*(1.-0.5*ZMIX2(IIJB:IIJE)) + & + &ZTHSM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE))& + /(1.+0.5*ZMIX2(IIJB:IIJE)) + PRT_UP(IIJB:IIJE,JK+IKL)=(PRT_UP(IIJB:IIJE,JK)*(1.-0.5*ZMIX2(IIJB:IIJE)) + & + &PRTM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)) & + /(1.+0.5*ZMIX2(IIJB:IIJE)) + ZQT_UP(IIJB:IIJE) = PRT_UP(IIJB:IIJE,JK+IKL)/(1.+PRT_UP(IIJB:IIJE,JK+IKL)) + PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHS_UP(IIJB:IIJE,JK+IKL)/(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE)) ENDWHERE IF(OMIXUV) THEN - IF(JK/=D%NKB) THEN - WHERE(GTEST(D%NIJB:D%NIJE)) - PU_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PU_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PUM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PUM(D%NIJB:D%NIJE,JK+D%NKL)-PUM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)+& - (PUM(D%NIJB:D%NIJE,JK)-PUM(D%NIJB:D%NIJE,JK-D%NKL))/PDZZ(D%NIJB:D%NIJE,JK)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) - PV_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PV_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PVM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PVM(D%NIJB:D%NIJE,JK+D%NKL)-PVM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)+& - (PVM(D%NIJB:D%NIJE,JK)-PVM(D%NIJB:D%NIJE,JK-D%NKL))/PDZZ(D%NIJB:D%NIJE,JK)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + IF(JK/=IKB) THEN + WHERE(GTEST(IIJB:IIJE)) + PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+& + (PUM(IIJB:IIJE,JK)-PUM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) + PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)+& + (PVM(IIJB:IIJE,JK)-PVM(IIJB:IIJE,JK-IKL))/PDZZ(IIJB:IIJE,JK)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) ENDWHERE ELSE - WHERE(GTEST(D%NIJB:D%NIJE)) - PU_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PU_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PUM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PUM(D%NIJB:D%NIJE,JK+D%NKL)-PUM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) - PV_UP(D%NIJB:D%NIJE,JK+D%NKL) = (PV_UP(D%NIJB:D%NIJE,JK)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - &PVM(D%NIJB:D%NIJE,JK)*ZMIX2(D%NIJB:D%NIJE)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(D%NIJB:D%NIJE,JK+D%NKL)-PZZ(D%NIJB:D%NIJE,JK))*& - ((PVM(D%NIJB:D%NIJE,JK+D%NKL)-PVM(D%NIJB:D%NIJE,JK))/PDZZ(D%NIJB:D%NIJE,JK+D%NKL)) ) & - /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + WHERE(GTEST(IIJB:IIJE)) + PU_UP(IIJB:IIJE,JK+IKL) = (PU_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PUM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PUM(IIJB:IIJE,JK+IKL)-PUM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) + PV_UP(IIJB:IIJE,JK+IKL) = (PV_UP(IIJB:IIJE,JK)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + &PVM(IIJB:IIJE,JK)*ZMIX2(IIJB:IIJE)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(IIJB:IIJE,JK+IKL)-PZZ(IIJB:IIJE,JK))*& + ((PVM(IIJB:IIJE,JK+IKL)-PVM(IIJB:IIJE,JK))/PDZZ(IIJB:IIJE,JK+IKL)) ) & + /(1+0.5*ZMIX2(IIJB:IIJE)) ENDWHERE ENDIF ENDIF !DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE - ! WHERE(GTEST(D%NIJB:D%NIJE)) - ! PSV_UP(D%NIJB:D%NIJE,JK+KKL,JSV) = (PSV_UP(D%NIJB:D%NIJE,JK,JSV)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & - ! PSVM(D%NIJB:D%NIJE,JK,JSV)*ZMIX2(D%NIJB:D%NIJE)) /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) + ! WHERE(GTEST(IIJB:IIJE)) + ! PSV_UP(IIJB:IIJE,JK+KKL,JSV) = (PSV_UP(IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + & + ! PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE)) ! ENDWHERE !ENDDO ! Compute non cons. var. at level JK+KKL - ZRC_UP(D%NIJB:D%NIJE)=PRC_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - ZRI_UP(D%NIJB:D%NIJE)=PRI_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - ZRV_UP(D%NIJB:D%NIJE)=PRV_UP(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) - CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), & - PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), & + ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below + ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below + ZRV_UP(IIJB:IIJE)=PRV_UP(IIJB:IIJE,JK) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) + CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), & + PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), & ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(GTEST(D%NIJB:D%NIJE)) - ZT_UP(D%NIJB:D%NIJE) = ZTH_UP(D%NIJB:D%NIJE,JK+D%NKL)*PEXNM(D%NIJB:D%NIJE,JK+D%NKL) - ZCP(D%NIJB:D%NIJE) = CST%XCPD + CST%XCL * ZRC_UP(D%NIJB:D%NIJE) - ZLVOCPEXN(D%NIJB:D%NIJE)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT_UP(D%NIJB:D%NIJE)-CST%XTT) ) / & - &ZCP(D%NIJB:D%NIJE) / PEXNM(D%NIJB:D%NIJE,JK+D%NKL) - PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)=MIN(0.5E-3,ZRC_UP(D%NIJB:D%NIJE)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) - PTHL_UP(D%NIJB:D%NIJE,JK+D%NKL) = PTHL_UP(D%NIJB:D%NIJE,JK+D%NKL)+ & - & ZLVOCPEXN(D%NIJB:D%NIJE)*(ZRC_UP(D%NIJB:D%NIJE)-PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)) - PRV_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRV_UP(D%NIJB:D%NIJE) - PRI_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRI_UP(D%NIJB:D%NIJE) - PRT_UP(D%NIJB:D%NIJE,JK+D%NKL) = PRC_UP(D%NIJB:D%NIJE,JK+D%NKL) + PRV_UP(D%NIJB:D%NIJE,JK+D%NKL) - PRSAT_UP(D%NIJB:D%NIJE,JK+D%NKL) = ZRSATW(D%NIJB:D%NIJE)*(1-PFRAC_ICE_UP(D%NIJB:D%NIJE,JK+D%NKL)) + & - & ZRSATI(D%NIJB:D%NIJE)*PFRAC_ICE_UP(D%NIJB:D%NIJE,JK+D%NKL) + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(GTEST(IIJB:IIJE)) + ZT_UP(IIJB:IIJE) = ZTH_UP(IIJB:IIJE,JK+IKL)*PEXNM(IIJB:IIJE,JK+IKL) + ZCP(IIJB:IIJE) = CST%XCPD + CST%XCL * ZRC_UP(IIJB:IIJE) + ZLVOCPEXN(IIJB:IIJE)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT_UP(IIJB:IIJE)-CST%XTT) ) / & + &ZCP(IIJB:IIJE) / PEXNM(IIJB:IIJE,JK+IKL) + PRC_UP(IIJB:IIJE,JK+IKL)=MIN(0.5E-3,ZRC_UP(IIJB:IIJE)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) + PTHL_UP(IIJB:IIJE,JK+IKL) = PTHL_UP(IIJB:IIJE,JK+IKL)+ & + & ZLVOCPEXN(IIJB:IIJE)*(ZRC_UP(IIJB:IIJE)-PRC_UP(IIJB:IIJE,JK+IKL)) + PRV_UP(IIJB:IIJE,JK+IKL)=ZRV_UP(IIJB:IIJE) + PRI_UP(IIJB:IIJE,JK+IKL)=ZRI_UP(IIJB:IIJE) + PRT_UP(IIJB:IIJE,JK+IKL) = PRC_UP(IIJB:IIJE,JK+IKL) + PRV_UP(IIJB:IIJE,JK+IKL) + PRSAT_UP(IIJB:IIJE,JK+IKL) = ZRSATW(IIJB:IIJE)*(1-PFRAC_ICE_UP(IIJB:IIJE,JK+IKL)) + & + & ZRSATI(IIJB:IIJE)*PFRAC_ICE_UP(IIJB:IIJE,JK+IKL) ENDWHERE ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 - WHERE(GTEST(D%NIJB:D%NIJE)) - !PTHV_UP(D%NIJB:D%NIJE,JK+KKL) = ZTH_UP(D%NIJB:D%NIJE,JK+KKL)*((1+ZRVORD*PRV_UP(D%NIJB:D%NIJE,JK+KKL))/(1+PRT_UP(D%NIJB:D%NIJE,JK+KKL))) - PTHV_UP(D%NIJB:D%NIJE,JK+D%NKL) = ZTH_UP(D%NIJB:D%NIJE,JK+D%NKL)* & - & (1.+0.608*PRV_UP(D%NIJB:D%NIJE,JK+D%NKL) - PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)) + WHERE(GTEST(IIJB:IIJE)) + !PTHV_UP(IIJB:IIJE,JK+KKL) = ZTH_UP(IIJB:IIJE,JK+KKL)*((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+KKL))/(1+PRT_UP(IIJB:IIJE,JK+KKL))) + PTHV_UP(IIJB:IIJE,JK+IKL) = ZTH_UP(IIJB:IIJE,JK+IKL)* & + & (1.+0.608*PRV_UP(IIJB:IIJE,JK+IKL) - PRC_UP(IIJB:IIJE,JK+IKL)) ENDWHERE ! Test if the updraft has reach the ETL - GTESTETL(D%NIJB:D%NIJE)=.FALSE. - WHERE (GTEST(D%NIJB:D%NIJE).AND.(PBUO_INTEG(D%NIJB:D%NIJE,JK)<=0.)) - KKETL(D%NIJB:D%NIJE) = JK+D%NKL - GTESTETL(D%NIJB:D%NIJE)=.TRUE. + GTESTETL(IIJB:IIJE)=.FALSE. + WHERE (GTEST(IIJB:IIJE).AND.(PBUO_INTEG(IIJB:IIJE,JK)<=0.)) + KKETL(IIJB:IIJE) = JK+IKL + GTESTETL(IIJB:IIJE)=.TRUE. ENDWHERE ! Test is we have reached the top of the updraft - WHERE (GTEST(D%NIJB:D%NIJE).AND.((ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)<=ZEPS))) - ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)=ZEPS - GTEST(D%NIJB:D%NIJE)=.FALSE. - PTHL_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZTHLM_F(D%NIJB:D%NIJE,JK+D%NKL) - PRT_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZRTM_F(D%NIJB:D%NIJE,JK+D%NKL) - PRC_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PRI_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PRV_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - PTHV_UP(D%NIJB:D%NIJE,JK+D%NKL)=ZTHVM_F(D%NIJB:D%NIJE,JK+D%NKL) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=0. - KKCTL(D%NIJB:D%NIJE)=JK+D%NKL + WHERE (GTEST(IIJB:IIJE).AND.((ZW_UP2(IIJB:IIJE,JK+IKL)<=ZEPS))) + ZW_UP2(IIJB:IIJE,JK+IKL)=ZEPS + GTEST(IIJB:IIJE)=.FALSE. + PTHL_UP(IIJB:IIJE,JK+IKL)=ZTHLM_F(IIJB:IIJE,JK+IKL) + PRT_UP(IIJB:IIJE,JK+IKL)=ZRTM_F(IIJB:IIJE,JK+IKL) + PRC_UP(IIJB:IIJE,JK+IKL)=0. + PRI_UP(IIJB:IIJE,JK+IKL)=0. + PRV_UP(IIJB:IIJE,JK+IKL)=0. + PTHV_UP(IIJB:IIJE,JK+IKL)=ZTHVM_F(IIJB:IIJE,JK+IKL) + PFRAC_UP(IIJB:IIJE,JK+IKL)=0. + KKCTL(IIJB:IIJE)=JK+IKL ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDDO ! Closure assumption for mass flux at KKB+1 level (Mass flux is supposed to be 0 at KKB level !) ! Hourdin et al 2002 formulation -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZZTOP(D%NIJB:D%NIJE) = MAX(ZZTOP(D%NIJB:D%NIJE),ZEPS) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZZTOP(IIJB:IIJE) = MAX(ZZTOP(IIJB:IIJE),ZEPS) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) -DO JK=D%NKB+D%NKL,D%NKE-D%NKL,D%NKL ! Vertical loop - !$mnh_expand_where(JI=D%NIJB:D%NIJE) - WHERE(JK<=IALIM(D%NIJB:D%NIJE)) - ZALIM_STAR_TOT(D%NIJB:D%NIJE) = ZALIM_STAR_TOT(D%NIJB:D%NIJE) + ZALIM_STAR(D%NIJB:D%NIJE,JK)**2* & - & ZZDZ(D%NIJB:D%NIJE,JK)/PRHODREF(D%NIJB:D%NIJE,JK) +DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop + !$mnh_expand_where(JIJ=IIJB:IIJE) + WHERE(JK<=IALIM(IIJB:IIJE)) + ZALIM_STAR_TOT(IIJB:IIJE) = ZALIM_STAR_TOT(IIJB:IIJE) + ZALIM_STAR(IIJB:IIJE,JK)**2* & + & ZZDZ(IIJB:IIJE,JK)/PRHODREF(IIJB:IIJE,JK) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDDO -!$mnh_expand_where(JI=D%NIJB:D%NIJE) -WHERE (ZALIM_STAR_TOT(D%NIJB:D%NIJE)*ZZTOP(D%NIJB:D%NIJE) > ZEPS) - ZPHI(D%NIJB:D%NIJE) = ZW_MAX(D%NIJB:D%NIJE)/(PARAMMF%XR*ZZTOP(D%NIJB:D%NIJE)*ZALIM_STAR_TOT(D%NIJB:D%NIJE)) +!$mnh_expand_where(JIJ=IIJB:IIJE) +WHERE (ZALIM_STAR_TOT(IIJB:IIJE)*ZZTOP(IIJB:IIJE) > ZEPS) + ZPHI(IIJB:IIJE) = ZW_MAX(IIJB:IIJE)/(PARAMMF%XR*ZZTOP(IIJB:IIJE)*ZALIM_STAR_TOT(IIJB:IIJE)) ENDWHERE -GTEST(D%NIJB:D%NIJE) = .TRUE. -PEMF(D%NIJB:D%NIJE,D%NKB+D%NKL) = ZPHI(D%NIJB:D%NIJE)*ZZDZ(D%NIJB:D%NIJE,D%NKB)*ZALIM_STAR(D%NIJB:D%NIJE,D%NKB) +GTEST(IIJB:IIJE) = .TRUE. +PEMF(IIJB:IIJE,IKB+IKL) = ZPHI(IIJB:IIJE)*ZZDZ(IIJB:IIJE,IKB)*ZALIM_STAR(IIJB:IIJE,IKB) ! Updraft fraction must be smaller than XFRAC_UP_MAX -PFRAC_UP(D%NIJB:D%NIJE,D%NKB+D%NKL)=PEMF(D%NIJB:D%NIJE,D%NKB+D%NKL)/ & - &(SQRT(ZW_UP2(D%NIJB:D%NIJE,D%NKB+D%NKL))*ZRHO_F(D%NIJB:D%NIJE,D%NKB+D%NKL)) -PFRAC_UP(D%NIJB:D%NIJE,D%NKB+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIJB:D%NIJE,D%NKB+D%NKL)) -PEMF(D%NIJB:D%NIJE,D%NKB+D%NKL) = ZRHO_F(D%NIJB:D%NIJE,D%NKB+D%NKL)*PFRAC_UP(D%NIJB:D%NIJE,D%NKB+D%NKL)* & - & SQRT(ZW_UP2(D%NIJB:D%NIJE,D%NKB+D%NKL)) -!$mnh_end_expand_where(JI=D%NIJB:D%NIJE) - -DO JK=D%NKB+D%NKL,D%NKE-D%NKL,D%NKL ! Vertical loop - !$mnh_expand_where(JI=D%NIJB:D%NIJE) +PFRAC_UP(IIJB:IIJE,IKB+IKL)=PEMF(IIJB:IIJE,IKB+IKL)/ & + &(SQRT(ZW_UP2(IIJB:IIJE,IKB+IKL))*ZRHO_F(IIJB:IIJE,IKB+IKL)) +PFRAC_UP(IIJB:IIJE,IKB+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,IKB+IKL)) +PEMF(IIJB:IIJE,IKB+IKL) = ZRHO_F(IIJB:IIJE,IKB+IKL)*PFRAC_UP(IIJB:IIJE,IKB+IKL)* & + & SQRT(ZW_UP2(IIJB:IIJE,IKB+IKL)) +!$mnh_end_expand_where(JIJ=IIJB:IIJE) + +DO JK=IKB+IKL,IKE-IKL,IKL ! Vertical loop + !$mnh_expand_where(JIJ=IIJB:IIJE) - GTEST(D%NIJB:D%NIJE) = (ZW_UP2(D%NIJB:D%NIJE,JK) > ZEPS) + GTEST(IIJB:IIJE) = (ZW_UP2(IIJB:IIJE,JK) > ZEPS) - WHERE (GTEST(D%NIJB:D%NIJE)) - WHERE(JK<IALIM(D%NIJB:D%NIJE)) - PEMF(D%NIJB:D%NIJE,JK+D%NKL) = MAX(0.,PEMF(D%NIJB:D%NIJE,JK) + ZPHI(D%NIJB:D%NIJE)*ZZDZ(D%NIJB:D%NIJE,JK)* & - & (PENTR(D%NIJB:D%NIJE,JK) - PDETR(D%NIJB:D%NIJE,JK))) + WHERE (GTEST(IIJB:IIJE)) + WHERE(JK<IALIM(IIJB:IIJE)) + PEMF(IIJB:IIJE,JK+IKL) = MAX(0.,PEMF(IIJB:IIJE,JK) + ZPHI(IIJB:IIJE)*ZZDZ(IIJB:IIJE,JK)* & + & (PENTR(IIJB:IIJE,JK) - PDETR(IIJB:IIJE,JK))) ELSEWHERE - ZMIX1(D%NIJB:D%NIJE)=ZZDZ(D%NIJB:D%NIJE,JK)*(PENTR(D%NIJB:D%NIJE,JK)-PDETR(D%NIJB:D%NIJE,JK)) - PEMF(D%NIJB:D%NIJE,JK+D%NKL)=PEMF(D%NIJB:D%NIJE,JK)*EXP(ZMIX1(D%NIJB:D%NIJE)) + ZMIX1(IIJB:IIJE)=ZZDZ(IIJB:IIJE,JK)*(PENTR(IIJB:IIJE,JK)-PDETR(IIJB:IIJE,JK)) + PEMF(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK)*EXP(ZMIX1(IIJB:IIJE)) ENDWHERE ! Updraft fraction must be smaller than XFRAC_UP_MAX - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=PEMF(D%NIJB:D%NIJE,JK+D%NKL)/& - &(SQRT(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL))*ZRHO_F(D%NIJB:D%NIJE,JK+D%NKL)) - PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)) - PEMF(D%NIJB:D%NIJE,JK+D%NKL) = ZRHO_F(D%NIJB:D%NIJE,JK+D%NKL)*PFRAC_UP(D%NIJB:D%NIJE,JK+D%NKL)*& - & SQRT(ZW_UP2(D%NIJB:D%NIJE,JK+D%NKL)) + PFRAC_UP(IIJB:IIJE,JK+IKL)=PEMF(IIJB:IIJE,JK+IKL)/& + &(SQRT(ZW_UP2(IIJB:IIJE,JK+IKL))*ZRHO_F(IIJB:IIJE,JK+IKL)) + PFRAC_UP(IIJB:IIJE,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX,PFRAC_UP(IIJB:IIJE,JK+IKL)) + PEMF(IIJB:IIJE,JK+IKL) = ZRHO_F(IIJB:IIJE,JK+IKL)*PFRAC_UP(IIJB:IIJE,JK+IKL)*& + & SQRT(ZW_UP2(IIJB:IIJE,JK+IKL)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_where(JIJ=IIJB:IIJE) ENDDO -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PW_UP(D%NIJB:D%NIJE,1:D%NKT)=SQRT(ZW_UP2(D%NIJB:D%NIJE,1:D%NKT)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PEMF(D%NIJB:D%NIJE,D%NKB) =0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PEMF(IIJB:IIJE,IKB) =0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Limits the shallow convection scheme when cloud heigth is higher than 3000m. ! To do this, mass flux is multiplied by a coefficient decreasing linearly @@ -629,22 +638,22 @@ DO JI=D%NIJB,D%NIJE PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -GWORK1(D%NIJB:D%NIJE)= (GTESTLCL(D%NIJB:D%NIJE) .AND. (PDEPTH(D%NIJB:D%NIJE) > ZDEPTH_MAX1) ) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) ) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) DO JK=1,D%NKT - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GWORK2(D%NIJB:D%NIJE,JK) = GWORK1(D%NIJB:D%NIJE) - ZCOEF(D%NIJB:D%NIJE,JK) = (1.-(PDEPTH(D%NIJB:D%NIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) - ZCOEF(D%NIJB:D%NIJE,JK)=MIN(MAX(ZCOEF(D%NIJB:D%NIJE,JK),0.),1.) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE) + ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) + ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO -!$mnh_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -WHERE (GWORK2(D%NIJB:D%NIJE,1:D%NKT)) - PEMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT) * ZCOEF(D%NIJB:D%NIJE,1:D%NKT) - PFRAC_UP(D%NIJB:D%NIJE,1:D%NKT) = PFRAC_UP(D%NIJB:D%NIJE,1:D%NKT) * ZCOEF(D%NIJB:D%NIJE,1:D%NKT) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE (GWORK2(IIJB:IIJE,1:IKT)) + PEMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT) + PFRAC_UP(IIJB:IIJE,1:IKT) = PFRAC_UP(IIJB:IIJE,1:IKT) * ZCOEF(IIJB:IIJE,1:IKT) ENDWHERE -!$mnh_end_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAF_RAHA',1,ZHOOK_HANDLE) ! diff --git a/src/common/turb/mode_compute_updraft_rhcj10.F90 b/src/common/turb/mode_compute_updraft_rhcj10.F90 index c1394196f1040b34c464d30cb60ecd17de1890ca..c5f8ce0a85544db41532ccd4e519fc17d3450686 100644 --- a/src/common/turb/mode_compute_updraft_rhcj10.F90 +++ b/src/common/turb/mode_compute_updraft_rhcj10.F90 @@ -162,8 +162,9 @@ REAL, DIMENSION(D%NIJT) :: ZMIX1,ZMIX2 REAL, DIMENSION(D%NIJT) :: ZLUP ! Upward Mixing length from the ground -INTEGER :: JK,JI,JSV ! loop counters - +INTEGER :: JK,JIJ,JSV ! loop counters +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT,IKB,IKE,IKL LOGICAL, DIMENSION(D%NIJT) :: GTEST,GTESTLCL ! Test if the ascent continue, if LCL or ETL is reached LOGICAL :: GLMIX @@ -195,7 +196,14 @@ REAL, DIMENSION(D%NIJT,16) :: ZBUF ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +! ! Thresholds for the perturbation of ! theta_l and r_t at the first level of the updraft @@ -216,9 +224,9 @@ ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed ! Local variables, internal domain ! Initialisation of intersesting Level :LCL,ETL,CTL -KKLCL(:)=D%NKE -KKETL(:)=D%NKE -KKCTL(:)=D%NKE +KKLCL(:)=IKE +KKETL(:)=IKE +KKCTL(:)=IKE ! ! Initialisation @@ -242,9 +250,9 @@ ZBUO =0. !no ice cloud coded yet PRI_UP(:,:)=0. PFRAC_ICE_UP(:,:)=0. -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PRSAT_UP(D%NIJB:D%NIJE,1:D%NKT)=PRVM(D%NIJB:D%NIJE,1:D%NKT) ! should be initialised correctly but is (normaly) not used -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRSAT_UP(IIJB:IIJE,1:IKT)=PRVM(IIJB:IIJE,1:IKT) ! should be initialised correctly but is (normaly) not used +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Initialisation of environment variables at t-dt @@ -259,23 +267,23 @@ CALL MZM_MF(D, PTKEM(:,:), ZTKEM_F(:,:)) !DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE ! *** SR merge AROME/Meso-nh: following two lines come from the AROME version -! ZSVM_F(D%NIJB:D%NIJE,KKB:IKU,JSV) = 0.5*(PSVM(D%NIJB:D%NIJE,KKB:IKU,JSV)+PSVM(D%NIJB:D%NIJE,1:IKU-1,JSV)) -! ZSVM_F(D%NIJB:D%NIJE,1,JSV) = ZSVM_F(D%NIJB:D%NIJE,KKB,JSV) +! ZSVM_F(IIJB:IIJE,KKB:IKU,JSV) = 0.5*(PSVM(IIJB:IIJE,KKB:IKU,JSV)+PSVM(IIJB:IIJE,1:IKU-1,JSV)) +! ZSVM_F(IIJB:IIJE,1,JSV) = ZSVM_F(IIJB:IIJE,KKB,JSV) ! *** the following single line comes from the Meso-NH version -! ZSVM_F(D%NIJB:D%NIJE,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(D%NIJB:D%NIJE,:,JSV)) +! ZSVM_F(IIJB:IIJE,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(IIJB:IIJE,:,JSV)) !END DO ! Initialisation of updraft characteristics -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)=ZTHLM_F(D%NIJB:D%NIJE,1:D%NKT) -PRT_UP(D%NIJB:D%NIJE,1:D%NKT)=ZRTM_F(D%NIJB:D%NIJE,1:D%NKT) -PU_UP(D%NIJB:D%NIJE,1:D%NKT)=ZUM_F(D%NIJB:D%NIJE,1:D%NKT) -PV_UP(D%NIJB:D%NIJE,1:D%NKT)=ZVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PSV_UP(D%NIJB:D%NIJE,1:D%NKT,:)=0. +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTHL_UP(IIJB:IIJE,1:IKT)=ZTHLM_F(IIJB:IIJE,1:IKT) +PRT_UP(IIJB:IIJE,1:IKT)=ZRTM_F(IIJB:IIJE,1:IKT) +PU_UP(IIJB:IIJE,1:IKT)=ZUM_F(IIJB:IIJE,1:IKT) +PV_UP(IIJB:IIJE,1:IKT)=ZVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PSV_UP(IIJB:IIJE,1:IKT,:)=0. ! This updraft is not yet ready to use scalar variables !IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then -! PSV_UP(D%NIJB:D%NIJE,:,:)=ZSVM_F(D%NIJB:D%NIJE,:,:) +! PSV_UP(IIJB:IIJE,:,:)=ZSVM_F(IIJB:IIJE,:,:) !ENDIF ! Computation or initialisation of updraft characteristics at the KKB level @@ -284,8 +292,8 @@ PSV_UP(D%NIJB:D%NIJE,1:D%NKT,:)=0. DO JI=D%NIJB,D%NIJE !PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) !PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT)) - PTHL_UP(JI,D%NKB)= ZTHLM_F(JI,D%NKB) - PRT_UP(JI,D%NKB) = ZRTM_F(JI,D%NKB) + PTHL_UP(JI,IKB)= ZTHLM_F(JI,IKB) + PRT_UP(JI,IKB) = ZRTM_F(JI,IKB) !ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB)) !ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JI)) ENDDO @@ -296,95 +304,95 @@ CALL MZM_MF(D, PRHODREF(:,:), ZRHO_F(:,:)) CALL MZM_MF(D, PRVM(:,:), ZRVM_F(:,:)) ! thetav at mass and flux levels -DO JK=1,D%NKT +DO JK=1,IKT DO JI=D%NIB,D%NIJE ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK))) ENDDO ENDDO -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PTHV_UP(D%NIJB:D%NIJE,1:D%NKT)= ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) -PRV_UP(D%NIJB:D%NIJE,1:D%NKT)= ZRVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTHV_UP(IIJB:IIJE,1:IKT)= ZTHVM_F(IIJB:IIJE,1:IKT) +PRV_UP(IIJB:IIJE,1:IKT)= ZRVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZW_UP2(:,:)=ZEPS -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -!ZW_UP2(D%NIJB:D%NIJE,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(D%NIJB:D%NIJE,KKB)) -ZW_UP2(D%NIJB:D%NIJE,D%NKB) = MAX(0.0001,(2./3.)*ZTKEM_F(D%NIJB:D%NIJE,D%NKB)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +!ZW_UP2(IIJB:IIJE,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(IIJB:IIJE,KKB)) +ZW_UP2(IIJB:IIJE,IKB) = MAX(0.0001,(2./3.)*ZTKEM_F(IIJB:IIJE,IKB)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Computation of non conservative variable for the KKB level of the updraft ! (all or nothing ajustement) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PRC_UP(D%NIJB:D%NIJE,D%NKB)=0. -PRI_UP(D%NIJB:D%NIJE,D%NKB)=0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) -CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,PFRAC_ICE_UP(:,D%NKB),ZPRES_F(:,D%NKB), & - PTHL_UP(:,D%NKB),PRT_UP(:,D%NKB),ZTH_UP(:,D%NKB), & - PRV_UP(:,D%NKB),PRC_UP(:,D%NKB),PRI_UP(:,D%NKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& +!$mnh_expand_array(JIJ=IIJB:IIJE) +PRC_UP(IIJB:IIJE,IKB)=0. +PRI_UP(IIJB:IIJE,IKB)=0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) +CALL TH_R_FROM_THL_RT(CST,NEB,D%NIJT,HFRAC_ICE,PFRAC_ICE_UP(:,IKB),ZPRES_F(:,IKB), & + PTHL_UP(:,IKB),PRT_UP(:,IKB),ZTH_UP(:,IKB), & + PRV_UP(:,IKB),PRC_UP(:,IKB),PRI_UP(:,IKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) DO JI=D%NIJB,D%NIJE ! compute updraft thevav and buoyancy term at KKB level - PTHV_UP(JI,D%NKB) = ZTH_UP(JI,D%NKB)*((1+ZRVORD*PRV_UP(JI,D%NKB))/(1+PRT_UP(JI,D%NKB))) + PTHV_UP(JI,IKB) = ZTH_UP(JI,IKB)*((1+ZRVORD*PRV_UP(JI,IKB))/(1+PRT_UP(JI,IKB))) ! compute mean rsat in updraft - PRSAT_UP(JI,D%NKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,D%NKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,D%NKB) + PRSAT_UP(JI,IKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,IKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,IKB) ENDDO !Tout est commente pour tester dans un premier temps la separation en deux de la ! boucle verticale, une pour w et une pour PEMF -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZG_O_THVREF(D%NIJB:D%NIJE,1:D%NKT)=CST%XG/ZTHVM_F(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZG_O_THVREF(IIJB:IIJE,1:IKT)=CST%XG/ZTHVM_F(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Calcul de la fermeture de Julien Pergaut comme limite max de PHY -DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Vertical loop +DO JK=IKB,IKE-IKL,IKL ! Vertical loop DO JI=D%NIJB,D%NIJE - ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+D%NKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level + ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+IKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level ENDDO ENDDO ! compute L_up GLMIX=.TRUE. -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZTKEM_F(D%NIJB:D%NIJE,D%NKB)=0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZTKEM_F(IIJB:IIJE,IKB)=0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF(TURB%CTURBLEN=='RM17') THEN CALL GZ_M_W_MF(D, PUM, PDZZ, ZWK) CALL MZF_MF(D, ZWK, ZDUDZ) CALL GZ_M_W_MF(D, PVM, PDZZ, ZWK) CALL MZF_MF(D, ZWK, ZDVDZ) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZSHEAR(D%NIJB:D%NIJE,1:D%NKT) = SQRT(ZDUDZ(D%NIJB:D%NIJE,1:D%NKT)**2 + ZDVDZ(D%NIJB:D%NIJE,1:D%NKT)**2) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)**2 + ZDVDZ(IIJB:IIJE,1:IKT)**2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - ZSHEAR(D%NIJB:D%NIJE,:) = 0. !no shear in bl89 mixing length + ZSHEAR(IIJB:IIJE,:) = 0. !no shear in bl89 mixing length END IF ! -CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,D%NKB),ZG_O_THVREF(:,D%NKB), & - ZTHVM_F,D%NKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZLUP(D%NIJB:D%NIJE)=MAX(ZLUP(D%NIJB:D%NIJE),1.E-10) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +CALL COMPUTE_BL89_ML(D, CST, CSTURB, PDZZ,ZTKEM_F(:,IKB),ZG_O_THVREF(:,IKB), & + ZTHVM_F,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZLUP(IIJB:IIJE)=MAX(ZLUP(IIJB:IIJE),1.E-10) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) DO JI=D%NIJB,D%NIJE ! Compute Buoyancy flux at the ground - ZWTHVSURF = (ZTHVM_F(JI,D%NKB)/ZTHM_F(JI,D%NKB))*PSFTH(JI)+ & - (0.61*ZTHM_F(JI,D%NKB))*PSFRV(JI) + ZWTHVSURF = (ZTHVM_F(JI,IKB)/ZTHM_F(JI,IKB))*PSFTH(JI)+ & + (0.61*ZTHM_F(JI,IKB))*PSFRV(JI) ! Mass flux at KKB level (updraft triggered if PSFTH>0.) IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!! - PEMF(JI,D%NKB) = PARAMMF%XCMF * ZRHO_F(JI,D%NKB) * ((ZG_O_THVREF(JI,D%NKB))*ZWTHVSURF*ZLUP(JI))**(1./3.) - PFRAC_UP(JI,D%NKB)=MIN(PEMF(JI,D%NKB)/(SQRT(ZW_UP2(JI,D%NKB))*ZRHO_F(JI,D%NKB)),PARAMMF%XFRAC_UP_MAX) + PEMF(JI,IKB) = PARAMMF%XCMF * ZRHO_F(JI,IKB) * ((ZG_O_THVREF(JI,IKB))*ZWTHVSURF*ZLUP(JI))**(1./3.) + PFRAC_UP(JI,IKB)=MIN(PEMF(JI,IKB)/(SQRT(ZW_UP2(JI,IKB))*ZRHO_F(JI,IKB)),PARAMMF%XFRAC_UP_MAX) !PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB)) - ZW_UP2(JI,D%NKB)=(PEMF(JI,D%NKB)/(PFRAC_UP(JI,D%NKB)*ZRHO_F(JI,D%NKB)))**2 + ZW_UP2(JI,IKB)=(PEMF(JI,IKB)/(PFRAC_UP(JI,IKB)*ZRHO_F(JI,IKB)))**2 GTEST(JI)=.TRUE. ELSE - PEMF(JI,D%NKB) =0. + PEMF(JI,IKB) =0. GTEST(JI)=.FALSE. ENDIF ENDDO @@ -406,7 +414,7 @@ GTESTLCL(:)=.FALSE. ZW_MAX(:) = 0. ZZTOP(:) = 0. -DO JK=D%NKB,D%NKE-D%NKL,D%NKL +DO JK=IKB,IKE-IKL,IKL ! IF the updraft top is reached for all column, stop the loop on levels @@ -434,11 +442,11 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Compute theta_v of updraft at flux level JK - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZRC_UP(D%NIJB:D%NIJE) =PRC_UP(D%NIJB:D%NIJE,JK) ! guess - ZRI_UP(D%NIJB:D%NIJE) =PRI_UP(D%NIJB:D%NIJE,JK) ! guess - ZRV_UP(D%NIJB:D%NIJE) =PRV_UP(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZRC_UP(IIJB:IIJE) =PRC_UP(IIJB:IIJE,JK) ! guess + ZRI_UP(IIJB:IIJE) =PRI_UP(IIJB:IIJE,JK) ! guess + ZRV_UP(IIJB:IIJE) =PRV_UP(IIJB:IIJE,JK) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK),& PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),& ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& @@ -448,9 +456,9 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL IF (GTEST(JI)) THEN PTHV_UP(JI,JK) = ZTH_UP(JI,JK)*(1.+ZRVORD*ZRV_UP(JI))/(1.+PRT_UP(JI,JK)) ZBUO(JI,JK) = ZG_O_THVREF(JI,JK)*(PTHV_UP(JI,JK) - ZTHVM_F(JI,JK)) - PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK)) + PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+IKL)-PZZ(JI,JK)) - ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+D%NKL)-PZZ(JI,JK)) + ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+IKL)-PZZ(JI,JK)) ZTEST(JI) = PARAMMF%XA1*ZBUO(JI,JK) - PARAMMF%XB*ZW_UP2(JI,JK) ! Ancien calcul de la vitesse @@ -464,9 +472,9 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+PARAMMF%XB*ZCOE(JI)) ! Second Rachel bug correction (XA1 has been forgotten) - ZW_UP2(JI,JK+D%NKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + PARAMMF%XA1*ZBUO(JI,JK)*ZBUCOE(JI) ) - ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+D%NKL))) - ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+D%NKL)+ZW_UP2(JI,JK))) + ZW_UP2(JI,JK+IKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + PARAMMF%XA1*ZBUO(JI,JK)*ZBUCOE(JI) ) + ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+IKL))) + ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+IKL)+ZW_UP2(JI,JK))) ! Entrainement and detrainement @@ -477,49 +485,49 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI) ! If the updraft did not stop, compute cons updraft characteritics at jk+1 - ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+D%NKL)) - ZMIX2(JI) = (PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*PENTR(JI,JK) !& + ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+IKL)) + ZMIX2(JI) = (PZZ(JI,JK+IKL)-PZZ(JI,JK))*PENTR(JI,JK) !& !ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK)) !ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA_MF*ZQTM(JI)) !ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) & ! /(1.+0.5*ZMIX2(JI)) - PRT_UP(JI,JK+D%NKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & + PRT_UP(JI,JK+IKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) & /(1.+0.5*ZMIX2(JI)) !ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL)) !PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JI)) - PTHL_UP(JI,JK+D%NKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) & + PTHL_UP(JI,JK+IKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) & /(1.+0.5*ZMIX2(JI)) ENDIF ! GTEST ENDDO IF(OMIXUV) THEN - IF(JK/=D%NKB) THEN + IF(JK/=IKB) THEN DO JI=D%NIJB,D%NIJE IF(GTEST(JI)) THEN - PU_UP(JI,JK+D%NKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*& - ((PUM(JI,JK+D%NKL)-PUM(JI,JK))/PDZZ(JI,JK+D%NKL)+& - (PUM(JI,JK)-PUM(JI,JK-D%NKL))/PDZZ(JI,JK)) ) & + PU_UP(JI,JK+IKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+IKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+IKL)-PUM(JI,JK))/PDZZ(JI,JK+IKL)+& + (PUM(JI,JK)-PUM(JI,JK-IKL))/PDZZ(JI,JK)) ) & /(1+0.5*ZMIX2(JI)) - PV_UP(JI,JK+D%NKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*& - ((PVM(JI,JK+D%NKL)-PVM(JI,JK))/PDZZ(JI,JK+D%NKL)+& - (PVM(JI,JK)-PVM(JI,JK-D%NKL))/PDZZ(JI,JK)) ) & + PV_UP(JI,JK+IKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+IKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+IKL)-PVM(JI,JK))/PDZZ(JI,JK+IKL)+& + (PVM(JI,JK)-PVM(JI,JK-IKL))/PDZZ(JI,JK)) ) & /(1+0.5*ZMIX2(JI)) ENDIF ENDDO ELSE DO JI=D%NIJB,D%NIJE IF(GTEST(JI)) THEN - PU_UP(JI,JK+D%NKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*& - ((PUM(JI,JK+D%NKL)-PUM(JI,JK))/PDZZ(JI,JK+D%NKL)) ) & + PU_UP(JI,JK+IKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+IKL)-PZZ(JI,JK))*& + ((PUM(JI,JK+IKL)-PUM(JI,JK))/PDZZ(JI,JK+IKL)) ) & /(1+0.5*ZMIX2(JI)) - PV_UP(JI,JK+D%NKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & - 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+D%NKL)-PZZ(JI,JK))*& - ((PVM(JI,JK+D%NKL)-PVM(JI,JK))/PDZZ(JI,JK+D%NKL)) ) & + PV_UP(JI,JK+IKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ & + 0.5*PARAMMF%XPRES_UV*(PZZ(JI,JK+IKL)-PZZ(JI,JK))*& + ((PVM(JI,JK+IKL)-PVM(JI,JK))/PDZZ(JI,JK+IKL)) ) & /(1+0.5*ZMIX2(JI)) ENDIF ENDDO @@ -530,20 +538,20 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! DO JSV=1,ISV ! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE ! WHERE(GTEST) -! PSV_UP(D%NIJB:D%NIJE,JK+KKL,JSV) = (PSV_UP (D%NIJB:D%NIJE,JK,JSV)*(1-0.5*ZMIX2(D%NIJB:D%NIJE)) + & -! PSVM(D%NIJB:D%NIJE,JK,JSV)*ZMIX2(D%NIJB:D%NIJE)) /(1+0.5*ZMIX2(D%NIJB:D%NIJE)) +! PSV_UP(IIJB:IIJE,JK+KKL,JSV) = (PSV_UP (IIJB:IIJE,JK,JSV)*(1-0.5*ZMIX2(IIJB:IIJE)) + & +! PSVM(IIJB:IIJE,JK,JSV)*ZMIX2(IIJB:IIJE)) /(1+0.5*ZMIX2(IIJB:IIJE)) ! ENDWHERE ! ENDDO ! Compute non cons. var. at level JK+KKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZRC_UP(D%NIJB:D%NIJE)=PRC_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - ZRI_UP(D%NIJB:D%NIJE)=PRI_UP(D%NIJB:D%NIJE,JK) ! guess = level just below - ZRV_UP(D%NIJB:D%NIJE)=PRV_UP(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) - CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+D%NKL),ZPRES_F(:,JK+D%NKL), & - PTHL_UP(:,JK+D%NKL),PRT_UP(:,JK+D%NKL),ZTH_UP(:,JK+D%NKL), & + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZRC_UP(IIJB:IIJE)=PRC_UP(IIJB:IIJE,JK) ! guess = level just below + ZRI_UP(IIJB:IIJE)=PRI_UP(IIJB:IIJE,JK) ! guess = level just below + ZRV_UP(IIJB:IIJE)=PRV_UP(IIJB:IIJE,JK) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) + CALL TH_R_FROM_THL_RT(CST,NEB, D%NIJT, HFRAC_ICE,PFRAC_ICE_UP(:,JK+IKL),ZPRES_F(:,JK+IKL), & + PTHL_UP(:,JK+IKL),PRT_UP(:,JK+IKL),ZTH_UP(:,JK+IKL), & ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.,& PBUF=ZBUF, KB=D%NIJB, KE=D%NIJE) @@ -554,33 +562,33 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL !ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL) !PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !) !PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL)) - PRC_UP(JI,JK+D%NKL)=ZRC_UP(JI) - PRV_UP(JI,JK+D%NKL)=ZRV_UP(JI) - PRI_UP(JI,JK+D%NKL)=ZRI_UP(JI) + PRC_UP(JI,JK+IKL)=ZRC_UP(JI) + PRV_UP(JI,JK+IKL)=ZRV_UP(JI) + PRI_UP(JI,JK+IKL)=ZRI_UP(JI) !PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL) - PRSAT_UP(JI,JK+D%NKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+D%NKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+D%NKL) + PRSAT_UP(JI,JK+IKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+IKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+IKL) ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1 - !PTHV_UP(D%NIJB:D%NIJE,JK+KKL) = PTH_UP(D%NIJB:D%NIJE,JK+KKL)*((1+ZRVORD*PRV_UP(D%NIJB:D%NIJE,JK+KKL))/(1+PRT_UP(D%NIJB:D%NIJE,JK+KKL))) + !PTHV_UP(IIJB:IIJE,JK+KKL) = PTH_UP(IIJB:IIJE,JK+KKL)*((1+ZRVORD*PRV_UP(IIJB:IIJE,JK+KKL))/(1+PRT_UP(IIJB:IIJE,JK+KKL))) !PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*(1.+0.608*PRV_UP(JI,JK+KKL) - PRC_UP(JI,JK+KKL)) !! A corriger pour utiliser q et non r !!!! !ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK)) - PTHV_UP(JI,JK+D%NKL) = ZTH_UP(JI,JK+D%NKL)*((1+ZRVORD*PRV_UP(JI,JK+D%NKL))/(1+PRT_UP(JI,JK+D%NKL))) + PTHV_UP(JI,JK+IKL) = ZTH_UP(JI,JK+IKL)*((1+ZRVORD*PRV_UP(JI,JK+IKL))/(1+PRT_UP(JI,JK+IKL))) ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK)) ENDIF ENDDO DO JI=D%NIJB,D%NIJE IF(GTEST(JI)) THEN - PEMF(JI,JK+D%NKL)=PEMF(JI,JK)*EXP(ZMIX1(JI)) + PEMF(JI,JK+IKL)=PEMF(JI,JK)*EXP(ZMIX1(JI)) ENDIF ENDDO DO JI=D%NIJB,D%NIJE IF(GTEST(JI)) THEN ! Updraft fraction must be smaller than XFRAC_UP_MAX - PFRAC_UP(JI,JK+D%NKL)=MIN(PARAMMF%XFRAC_UP_MAX, & - &PEMF(JI,JK+D%NKL)/(SQRT(ZW_UP2(JI,JK+D%NKL))*ZRHO_F(JI,JK+D%NKL))) + PFRAC_UP(JI,JK+IKL)=MIN(PARAMMF%XFRAC_UP_MAX, & + &PEMF(JI,JK+IKL)/(SQRT(ZW_UP2(JI,JK+IKL))*ZRHO_F(JI,JK+IKL))) !PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL)) ENDIF ENDDO @@ -588,36 +596,36 @@ DO JK=D%NKB,D%NKE-D%NKL,D%NKL ! Test if the updraft has reach the ETL DO JI=D%NIJB,D%NIJE IF (GTEST(JI) .AND. (PBUO_INTEG(JI,JK)<=0.)) THEN - KKETL(JI) = JK+D%NKL + KKETL(JI) = JK+IKL ENDIF ENDDO ! Test is we have reached the top of the updraft DO JI=D%NIJB,D%NIJE - IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+D%NKL)<=ZEPS).OR.(PEMF(JI,JK+D%NKL)<=ZEPS))) THEN - ZW_UP2 (JI,JK+D%NKL)=ZEPS - PEMF (JI,JK+D%NKL)=0. + IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+IKL)<=ZEPS).OR.(PEMF(JI,JK+IKL)<=ZEPS))) THEN + ZW_UP2 (JI,JK+IKL)=ZEPS + PEMF (JI,JK+IKL)=0. GTEST (JI) =.FALSE. - PTHL_UP (JI,JK+D%NKL)=ZTHLM_F(JI,JK+D%NKL) - PRT_UP (JI,JK+D%NKL)=ZRTM_F(JI,JK+D%NKL) - PRC_UP (JI,JK+D%NKL)=0. - PRI_UP (JI,JK+D%NKL)=0. - PRV_UP (JI,JK+D%NKL)=ZRVM_F (JI,JK+D%NKL) - PTHV_UP (JI,JK+D%NKL)=ZTHVM_F(JI,JK+D%NKL) - PFRAC_UP (JI,JK+D%NKL)=0. - KKCTL (JI) =JK+D%NKL + PTHL_UP (JI,JK+IKL)=ZTHLM_F(JI,JK+IKL) + PRT_UP (JI,JK+IKL)=ZRTM_F(JI,JK+IKL) + PRC_UP (JI,JK+IKL)=0. + PRI_UP (JI,JK+IKL)=0. + PRV_UP (JI,JK+IKL)=ZRVM_F (JI,JK+IKL) + PTHV_UP (JI,JK+IKL)=ZTHVM_F(JI,JK+IKL) + PFRAC_UP (JI,JK+IKL)=0. + KKCTL (JI) =JK+IKL ENDIF ENDDO ENDDO ! Fin de la boucle verticale -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PW_UP(D%NIJB:D%NIJE,1:D%NKT)=SQRT(ZW_UP2(D%NIJB:D%NIJE,1:D%NKT)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PEMF(D%NIJB:D%NIJE,D%NKB) =0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PW_UP(IIJB:IIJE,1:IKT)=SQRT(ZW_UP2(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PEMF(IIJB:IIJE,IKB) =0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! Limits the shallow convection scheme when cloud heigth is higher than 3000m. ! To do this, mass flux is multiplied by a coefficient decreasing linearly @@ -629,17 +637,17 @@ DO JI=D%NIJB,D%NIJE PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) ) ENDDO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -GWORK1(D%NIJB:D%NIJE)= (GTESTLCL(D%NIJB:D%NIJE) .AND. (PDEPTH(D%NIJB:D%NIJE) > ZDEPTH_MAX1) ) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) -DO JK=1,D%NKT - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - GWORK2(D%NIJB:D%NIJE,JK) = GWORK1(D%NIJB:D%NIJE) - ZCOEF(D%NIJB:D%NIJE,JK) = (1.-(PDEPTH(D%NIJB:D%NIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) - ZCOEF(D%NIJB:D%NIJE,JK)=MIN(MAX(ZCOEF(D%NIJB:D%NIJE,JK),0.),1.) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) ) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) +DO JK=1,IKT + !$mnh_expand_array(JIJ=IIJB:IIJE) + GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE) + ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)) + ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO -DO JK=1, D%NKT +DO JK=1,IKT DO JI=D%NIJB,D%NIJE IF (GWORK2(JI,JK)) THEN PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK) diff --git a/src/common/turb/mode_emoist.F90 b/src/common/turb/mode_emoist.F90 index 99196199b866111104e3e0854dc9b87c2a02fe2a..477e6373791683a053476a0fe0b71dcbc3383f91 100644 --- a/src/common/turb/mode_emoist.F90 +++ b/src/common/turb/mode_emoist.F90 @@ -90,7 +90,7 @@ REAL,DIMENSION(D%NIT,D%NJT,D%NKT) :: & REAL :: ZDELTA ! = Rv/Rd - 1 INTEGER :: JRR ! moist loop counter INTEGER :: JI,JJ,JK ! loop counter -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT ! !--------------------------------------------------------------------------- ! @@ -105,84 +105,85 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! IF (OOCEAN) THEN IF ( KRR == 0 ) THEN ! Unsalted - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = 0. - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 0. + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = 1. ! Salted case - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 1. ! Salted case + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF ! ELSE ! IF ( KRR == 0 ) THEN ! dry case - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = 0. + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = 0. ELSE IF ( KRR == 1 ) THEN ! only vapor ZDELTA = (CST%XRV/CST%XRD) - 1. - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = ZDELTA*PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA*PTHLM(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE ! liquid water & ice present ZDELTA = (CST%XRV/CST%XRD) - 1. - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = PRM(IIB:IIE,IJB:IJE,1:IKT,1) ! IF ( KRRI>0) THEN ! rc and ri case - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,3) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,3) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) DO JRR=5,KRR - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,JRR) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ENDDO - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. + ( & ! Compute A - (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,4)) & - -ZRW(IIB:IIE,IJB:IJE,1:D%NKT) & - ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A + (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2) - PRM(IIB:IIE,IJB:IJE,1:IKT,4)) & + -ZRW(IIB:IIE,IJB:IJE,1:IKT) & + ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) ! ! Emoist = ZB + ZC * Amoist ! ZB is computed from line 1 to line 2 ! ZC is computed from line 3 to line 5 ! Amoist* 2 * SRC is computed at line 6 ! - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)*( & - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)+PRM(IIB:IIE,IJB:IJE,1:D%NKT,4)))& - / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT) * ZA(IIB:IIE,IJB:IJE,1:D%NKT) & - -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)*( & - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)+PRM(IIB:IIE,IJB:IJE,1:D%NKT,4)))& - / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - ) * PAMOIST(IIB:IIE,IJB:IJE,1:D%NKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( & + PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))& + / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) & + -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( & + PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))& + / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + ) * PAMOIST(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE DO JRR=3,KRR - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,JRR) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ENDDO - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. + ( & ! Compute ZA - (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)) & - -ZRW(IIB:IIE,IJB:IJE,1:D%NKT) & - ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute ZA + (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2)) & + -ZRW(IIB:IIE,IJB:IJE,1:IKT) & + ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) ! ! Emoist = ZB + ZC * Amoist ! ZB is computed from line 1 to line 2 ! ZC is computed from line 3 to line 5 ! Amoist* 2 * SRC is computed at line 6 ! - PEMOIST(IIB:IIE,IJB:IJE,1:D%NKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)* & - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT) * ZA(IIB:IIE,IJB:IJE,1:D%NKT) & - -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)* & - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - ) * PAMOIST(IIB:IIE,IJB:IJE,1:D%NKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + PEMOIST(IIB:IIE,IJB:IJE,1:IKT) = ZDELTA * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)* & + PRM(IIB:IIE,IJB:IJE,1:IKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) & + -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)* & + PRM(IIB:IIE,IJB:IJE,1:IKT,2)) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + ) * PAMOIST(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF END IF ! diff --git a/src/common/turb/mode_etheta.F90 b/src/common/turb/mode_etheta.F90 index 4d8c8b29d1b7b03ff93c1eba94e013f57d7fcb8d..0c03e420beea467ac2ab2fbc8d5a95a9890b87db 100644 --- a/src/common/turb/mode_etheta.F90 +++ b/src/common/turb/mode_etheta.F90 @@ -94,7 +94,7 @@ REAL,DIMENSION(D%NIT,D%NJT,D%NKT) :: & REAL :: ZDELTA ! = Rv/Rd - 1 INTEGER :: JRR ! moist loop counter INTEGER :: JI,JJ,JK ! loop counter -INTEGER :: IIB,IJB,IIE,IJE +INTEGER :: IIB,IJB,IIE,IJE,IKT ! !--------------------------------------------------------------------------- ! @@ -110,75 +110,76 @@ IIE=D%NIEC IIB=D%NIBC IJE=D%NJEC IJB=D%NJBC +IKT=D%NKT ! IF (OOCEAN) THEN ! ocean case - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PETHETA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1. + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE IF ( KRR == 0) THEN ! dry case - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PETHETA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1. + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE IF ( KRR == 1 ) THEN ! only vapor ZDELTA = (CST%XRV/CST%XRD) - 1. - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - PETHETA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. + ZDELTA*PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + PETHETA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ZDELTA*PRM(IIB:IIE,IJB:IJE,1:IKT,1) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE ! liquid water & ice present ZDELTA = (CST%XRV/CST%XRD) - 1. - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = PRM(IIB:IIE,IJB:IJE,1:IKT,1) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ! IF ( KRRI>0 ) THEN ! rc and ri case - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,3) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,3) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) DO JRR=5,KRR - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,JRR) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ENDDO - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. + ( & ! Compute A - (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,4)) & - -ZRW(IIB:IIE,IJB:IJE,1:D%NKT) & - ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A + (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2) - PRM(IIB:IIE,IJB:IJE,1:IKT,4)) & + -ZRW(IIB:IIE,IJB:IJE,1:IKT) & + ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) ! ! Etheta = ZA + ZC * Atheta ! ZC is computed from line 2 to line 5 ! - Atheta * 2. * SRC is computed at line 6 ! - PETHETA(IIB:IIE,IJB:IJE,1:D%NKT) = ZA(IIB:IIE,IJB:IJE,1:D%NKT) & - +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT) * ZA(IIB:IIE,IJB:IJE,1:D%NKT) & - -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)*( & - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)+PRM(IIB:IIE,IJB:IJE,1:D%NKT,4)))& - / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - ) * PATHETA(IIB:IIE,IJB:IJE,1:D%NKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + PETHETA(IIB:IIE,IJB:IJE,1:IKT) = ZA(IIB:IIE,IJB:IJE,1:IKT) & + +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) & + -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*( & + PRM(IIB:IIE,IJB:IJE,1:IKT,2)+PRM(IIB:IIE,IJB:IJE,1:IKT,4)))& + / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + ) * PATHETA(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ELSE DO JRR=3,KRR - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZRW(IIB:IIE,IJB:IJE,1:D%NKT) = ZRW(IIB:IIE,IJB:IJE,1:D%NKT) + PRM(IIB:IIE,IJB:IJE,1:D%NKT,JRR) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZRW(IIB:IIE,IJB:IJE,1:IKT) = ZRW(IIB:IIE,IJB:IJE,1:IKT) + PRM(IIB:IIE,IJB:IJE,1:IKT,JRR) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) ENDDO - !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) - ZA(IIB:IIE,IJB:IJE,1:D%NKT) = 1. + ( & ! Compute A - (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:D%NKT,1) - PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)) & - -ZRW(IIB:IIE,IJB:IJE,1:D%NKT) & - ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) + !$mnh_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) + ZA(IIB:IIE,IJB:IJE,1:IKT) = 1. + ( & ! Compute A + (1.+ZDELTA) * (PRM(IIB:IIE,IJB:IJE,1:IKT,1) - PRM(IIB:IIE,IJB:IJE,1:IKT,2)) & + -ZRW(IIB:IIE,IJB:IJE,1:IKT) & + ) / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) ! ! Etheta = ZA + ZC * Atheta ! ZC is computed from line 2 to line 5 ! - Atheta * 2. * SRC is computed at line 6 ! - PETHETA(IIB:IIE,IJB:IJE,1:D%NKT) = ZA(IIB:IIE,IJB:IJE,1:D%NKT) & - +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT) * ZA(IIB:IIE,IJB:IJE,1:D%NKT) -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:D%NKT) & - + PLOCPEXNM(IIB:IIE,IJB:IJE,1:D%NKT)*PRM(IIB:IIE,IJB:IJE,1:D%NKT,2)) & - / (1. + ZRW(IIB:IIE,IJB:IJE,1:D%NKT)) & - ) * PATHETA(IIB:IIE,IJB:IJE,1:D%NKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:D%NKT) - !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:D%NKT) + PETHETA(IIB:IIE,IJB:IJE,1:IKT) = ZA(IIB:IIE,IJB:IJE,1:IKT) & + +( PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT) * ZA(IIB:IIE,IJB:IJE,1:IKT) -(1.+ZDELTA) * (PTHLM(IIB:IIE,IJB:IJE,1:IKT) & + + PLOCPEXNM(IIB:IIE,IJB:IJE,1:IKT)*PRM(IIB:IIE,IJB:IJE,1:IKT,2)) & + / (1. + ZRW(IIB:IIE,IJB:IJE,1:IKT)) & + ) * PATHETA(IIB:IIE,IJB:IJE,1:IKT) * 2. * PSRCM(IIB:IIE,IJB:IJE,1:IKT) + !$mnh_end_expand_array(JI=IIB:IIE,JJ=IJB:IJE,JK=1:IKT) END IF END IF ! diff --git a/src/common/turb/mode_mf_turb.F90 b/src/common/turb/mode_mf_turb.F90 index 8483046707840ef4e4ce2fbc0b64845c07df5b90..d8ad3420190aaffe414ef9f2e96531807568fcda 100644 --- a/src/common/turb/mode_mf_turb.F90 +++ b/src/common/turb/mode_mf_turb.F90 @@ -128,7 +128,9 @@ REAL, DIMENSION(D%NIJT,D%NKT,KSV), INTENT(OUT):: PFLXZSVMF REAL, DIMENSION(D%NIJT,D%NKT) :: ZVARS INTEGER :: JSV !number of scalar variables and Loop counter -INTEGER :: JI, JK +INTEGER :: JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT REAL(KIND=JPRB) :: ZHOOK_HANDLE ! !---------------------------------------------------------------------------- @@ -138,6 +140,10 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE ! IF (LHOOK) CALL DR_HOOK('MF_TURB',0,ZHOOK_HANDLE) ! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +! PFLXZSVMF = 0. PSVDT = 0. @@ -155,19 +161,19 @@ CALL MZM_MF(D, PTHLM(:,:), PFLXZTHMF(:,:)) CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:)) CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PFLXZTHMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZTHMF(D%NIJB:D%NIJE,1:D%NKT)) -PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT)) -PFLXZTHVMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHV_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZTHVMF(D%NIJB:D%NIJE,1:D%NKT)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PFLXZTHMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHMF(IIJB:IIJE,1:IKT)) +PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT)) +PFLXZTHVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHV_UP(IIJB:IIJE,1:IKT)-PFLXZTHVMF(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (OMIXUV) THEN CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:)) CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PU_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT)) - PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PV_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT)) + PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE PFLXZUMF(:,:) = 0. PFLXZVMF(:,:) = 0. @@ -190,10 +196,10 @@ CALL TRIDIAG_MASSFLUX(D,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, & PDZZ,PRHODJ,ZVARS ) ! compute new flux and THL tendency CALL MZM_MF(D, ZVARS(:,:), PFLXZTHMF(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PFLXZTHMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZTHMF(D%NIJB:D%NIJE,1:D%NKT)) -PTHLDT(D%NIJB:D%NIJE,1:D%NKT)= (ZVARS(D%NIJB:D%NIJE,1:D%NKT)-PTHLM(D%NIJB:D%NIJE,1:D%NKT))/PTSTEP -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PFLXZTHMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHMF(IIJB:IIJE,1:IKT)) +PTHLDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PTHLM(IIJB:IIJE,1:IKT))/PTSTEP +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! 3.2 Compute the tendency for the conservative mixing ratio @@ -202,10 +208,10 @@ CALL TRIDIAG_MASSFLUX(D,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, & PDZZ,PRHODJ,ZVARS ) ! compute new flux and RT tendency CALL MZM_MF(D, ZVARS(:,:), PFLXZRMF(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT)) -PRTDT(D%NIJB:D%NIJE,1:D%NKT) = (ZVARS(D%NIJB:D%NIJE,1:D%NKT)-PRTM(D%NIJB:D%NIJE,1:D%NKT))/PTSTEP -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT)) +PRTDT(IIJB:IIJE,1:IKT) = (ZVARS(IIJB:IIJE,1:IKT)-PRTM(IIJB:IIJE,1:IKT))/PTSTEP +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (OMIXUV) THEN @@ -218,10 +224,10 @@ IF (OMIXUV) THEN PDZZ,PRHODJ,ZVARS ) ! compute new flux and U tendency CALL MZM_MF(D, ZVARS(:,:), PFLXZUMF(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PU_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT)) - PUDT(D%NIJB:D%NIJE,1:D%NKT)= (ZVARS(D%NIJB:D%NIJE,1:D%NKT)-PUM(D%NIJB:D%NIJE,1:D%NKT))/PTSTEP - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT)) + PUDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PUM(IIJB:IIJE,1:IKT))/PTSTEP + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing) @@ -232,10 +238,10 @@ IF (OMIXUV) THEN PDZZ,PRHODJ,ZVARS ) ! compute new flux and V tendency CALL MZM_MF(D, ZVARS(:,:), PFLXZVMF(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PV_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT)) - PVDT(D%NIJB:D%NIJE,1:D%NKT)= (ZVARS(D%NIJB:D%NIJE,1:D%NKT)-PVM(D%NIJB:D%NIJE,1:D%NKT))/PTSTEP - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT)) + PVDT(IIJB:IIJE,1:IKT)= (ZVARS(IIJB:IIJE,1:IKT)-PVM(IIJB:IIJE,1:IKT))/PTSTEP + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE PUDT(:,:)=0. PVDT(:,:)=0. @@ -249,10 +255,10 @@ DO JSV=1,KSV ! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP ) CALL MZM_MF(D, PSVM(:,:,JSV), PFLXZSVMF(:,:,JSV)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZSVMF(D%NIJB:D%NIJE,1:D%NKT,JSV) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*& - & (PSV_UP(D%NIJB:D%NIJE,1:D%NKT,JSV)-PFLXZSVMF(D%NIJB:D%NIJE,1:D%NKT,JSV)) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZSVMF(IIJB:IIJE,1:IKT,JSV) = PEMF(IIJB:IIJE,1:IKT)*& + & (PSV_UP(IIJB:IIJE,1:IKT,JSV)-PFLXZSVMF(IIJB:IIJE,1:IKT,JSV)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! 3.5 Compute the tendency for scalar variables ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point) @@ -261,11 +267,11 @@ DO JSV=1,KSV -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS ) ! compute new flux and Sv tendency CALL MZM_MF(D, ZVARS, PFLXZSVMF(:,:,JSV)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZSVMF(D%NIJB:D%NIJE,1:D%NKT,JSV) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*& - & (PSV_UP(D%NIJB:D%NIJE,1:D%NKT,JSV)-PFLXZSVMF(D%NIJB:D%NIJE,1:D%NKT,JSV)) - PSVDT(D%NIJB:D%NIJE,1:D%NKT,JSV)= (ZVARS(D%NIJB:D%NIJE,1:D%NKT)-PSVM(D%NIJB:D%NIJE,1:D%NKT,JSV))/PTSTEP - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZSVMF(IIJB:IIJE,1:IKT,JSV) = PEMF(IIJB:IIJE,1:IKT)*& + & (PSV_UP(IIJB:IIJE,1:IKT,JSV)-PFLXZSVMF(IIJB:IIJE,1:IKT,JSV)) + PSVDT(IIJB:IIJE,1:IKT,JSV)= (ZVARS(IIJB:IIJE,1:IKT)-PSVM(IIJB:IIJE,1:IKT,JSV))/PTSTEP + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDDO ! diff --git a/src/common/turb/mode_mf_turb_expl.F90 b/src/common/turb/mode_mf_turb_expl.F90 index 4cb55e936222fe2497c5f34ac01a30b4c32f1a21..4c65ba81b4763ef31a88ab01fd52038775449131 100644 --- a/src/common/turb/mode_mf_turb_expl.F90 +++ b/src/common/turb/mode_mf_turb_expl.F90 @@ -99,7 +99,9 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZFLXZTHSMF,ZTHS_UP,ZTHSM ! Theta S flux REAL, DIMENSION(D%NIJT,D%NKT) :: ZQT_UP,ZQTM,ZTHSDT,ZQTDT REAL, DIMENSION(D%NIJT,D%NKT) :: ZTHLM_F,ZRTM_F -INTEGER :: JK, JI ! loop counter +INTEGER :: JK, JIJ ! loop counter +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT,IKB,IKE,IKL REAL(KIND=JPRB) :: ZHOOK_HANDLE !---------------------------------------------------------------------------- @@ -108,7 +110,14 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE ! ------------- IF (LHOOK) CALL DR_HOOK('MF_TURB_EXPL',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKE=D%NKE +IKL=D%NKL +! PFLXZRMF = 0. PFLXZTHVMF = 0. PFLXZTHLMF = 0. @@ -130,31 +139,31 @@ PVDT = 0. CALL MZM_MF(D, PRTM (:,:), ZRTM_F(:,:)) CALL MZM_MF(D, PTHLM(:,:), ZTHLM_F(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZQTM(D%NIJB:D%NIJE,1:D%NKT) = ZRTM_F(D%NIJB:D%NIJE,1:D%NKT)/(1.+ZRTM_F(D%NIJB:D%NIJE,1:D%NKT)) -ZQT_UP(D%NIJB:D%NIJE,1:D%NKT) = PRT_UP(D%NIJB:D%NIJE,1:D%NKT)/(1.+PRT_UP(D%NIJB:D%NIJE,1:D%NKT)) -ZTHS_UP(D%NIJB:D%NIJE,1:D%NKT)= PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(D%NIJB:D%NIJE,1:D%NKT)) -ZTHSM(D%NIJB:D%NIJE,1:D%NKT) = ZTHLM_F(D%NIJB:D%NIJE,1:D%NKT)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(D%NIJB:D%NIJE,1:D%NKT)) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZQTM(IIJB:IIJE,1:IKT) = ZRTM_F(IIJB:IIJE,1:IKT)/(1.+ZRTM_F(IIJB:IIJE,1:IKT)) +ZQT_UP(IIJB:IIJE,1:IKT) = PRT_UP(IIJB:IIJE,1:IKT)/(1.+PRT_UP(IIJB:IIJE,1:IKT)) +ZTHS_UP(IIJB:IIJE,1:IKT)= PTHL_UP(IIJB:IIJE,1:IKT)*(1.+PARAMMF%XLAMBDA_MF*ZQT_UP(IIJB:IIJE,1:IKT)) +ZTHSM(IIJB:IIJE,1:IKT) = ZTHLM_F(IIJB:IIJE,1:IKT)*(1.+PARAMMF%XLAMBDA_MF*ZQTM(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_MF(D, PTHLM(:,:), PFLXZTHLMF(:,:)) CALL MZM_MF(D, PRTM(:,:), PFLXZRMF(:,:)) CALL MZM_MF(D, PTHVM(:,:), PFLXZTHVMF(:,:)) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -PFLXZTHLMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHL_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZTHLMF(D%NIJB:D%NIJE,1:D%NKT)) ! ThetaL -PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PRT_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZRMF(D%NIJB:D%NIJE,1:D%NKT)) ! Rt -PFLXZTHVMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PTHV_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZTHVMF(D%NIJB:D%NIJE,1:D%NKT)) ! ThetaV +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PFLXZTHLMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHL_UP(IIJB:IIJE,1:IKT)-PFLXZTHLMF(IIJB:IIJE,1:IKT)) ! ThetaL +PFLXZRMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PRT_UP(IIJB:IIJE,1:IKT)-PFLXZRMF(IIJB:IIJE,1:IKT)) ! Rt +PFLXZTHVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PTHV_UP(IIJB:IIJE,1:IKT)-PFLXZTHVMF(IIJB:IIJE,1:IKT)) ! ThetaV -ZFLXZTHSMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(ZTHS_UP(D%NIJB:D%NIJE,1:D%NKT)-ZTHSM(D%NIJB:D%NIJE,1:D%NKT)) ! Theta S flux -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +ZFLXZTHSMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(ZTHS_UP(IIJB:IIJE,1:IKT)-ZTHSM(IIJB:IIJE,1:IKT)) ! Theta S flux +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (OMIXUV) THEN CALL MZM_MF(D, PUM(:,:), PFLXZUMF(:,:)) CALL MZM_MF(D, PVM(:,:), PFLXZVMF(:,:)) - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PU_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZUMF(D%NIJB:D%NIJE,1:D%NKT)) ! U - PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT) = PEMF(D%NIJB:D%NIJE,1:D%NKT)*(PV_UP(D%NIJB:D%NIJE,1:D%NKT)-PFLXZVMF(D%NIJB:D%NIJE,1:D%NKT)) ! V - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PFLXZUMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PU_UP(IIJB:IIJE,1:IKT)-PFLXZUMF(IIJB:IIJE,1:IKT)) ! U + PFLXZVMF(IIJB:IIJE,1:IKT) = PEMF(IIJB:IIJE,1:IKT)*(PV_UP(IIJB:IIJE,1:IKT)-PFLXZVMF(IIJB:IIJE,1:IKT)) ! V + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE PFLXZUMF(:,:) = 0. PFLXZVMF(:,:) = 0. @@ -167,21 +176,21 @@ ENDIF ! (explicit formulation) ! -------------------------------------------- -DO JK=D%NKB,D%NKE-D%NKL,D%NKL +DO JK=IKB,IKE-IKL,IKL DO JI=D%NIJB,D%NIJE - !PTHLDT(JI,JK) = (PFLXZTHLMF(JI,JK ) - PFLXZTHLMF(JI,JK+D%NKL)) / PRHODJ(JI,JK) - PRTDT(JI,JK) = (PFLXZRMF(JI,JK) - PFLXZRMF(JI,JK+D%NKL)) / PRHODJ(JI,JK) + !PTHLDT(JI,JK) = (PFLXZTHLMF(JI,JK ) - PFLXZTHLMF(JI,JK+IKL)) / PRHODJ(JI,JK) + PRTDT(JI,JK) = (PFLXZRMF(JI,JK) - PFLXZRMF(JI,JK+IKL)) / PRHODJ(JI,JK) ZQTDT(JI,JK) = PRTDT(JI,JK)/(1.+ ZRTM_F(JI,JK)*ZRTM_F(JI,JK)) - ZTHSDT(JI,JK)= (ZFLXZTHSMF(JI,JK) - ZFLXZTHSMF(JI,JK+D%NKL)) / PRHODJ(JI,JK) + ZTHSDT(JI,JK)= (ZFLXZTHSMF(JI,JK) - ZFLXZTHSMF(JI,JK+IKL)) / PRHODJ(JI,JK) PTHLDT(JI,JK) = ZTHSDT(JI,JK)/(1.+PARAMMF%XLAMBDA_MF*ZQTM(JI,JK)) - ZTHLM_F(JI,JK)*PARAMMF%XLAMBDA_MF*ZQTDT(JI,JK) ENDDO END DO IF (OMIXUV) THEN - DO JK=D%NKB,D%NKE-D%NKL,D%NKL + DO JK=IKB,IKE-IKL,IKL DO JI=D%NIJB,D%NIJE - PUDT(JI,JK) = (PFLXZUMF(JI,JK) - PFLXZUMF(JI,JK+D%NKL)) / PRHODJ(JI,JK) - PVDT(JI,JK) = (PFLXZVMF(JI,JK) - PFLXZVMF(JI,JK+D%NKL)) / PRHODJ(JI,JK) + PUDT(JI,JK) = (PFLXZUMF(JI,JK) - PFLXZUMF(JI,JK+IKL)) / PRHODJ(JI,JK) + PVDT(JI,JK) = (PFLXZVMF(JI,JK) - PFLXZVMF(JI,JK+IKL)) / PRHODJ(JI,JK) ENDDO END DO ENDIF diff --git a/src/common/turb/mode_prandtl.F90 b/src/common/turb/mode_prandtl.F90 index f43bb30ab0a7f6f97c0c22cb225872566452876e..ae2612035c854057954808bcb09f0b2864a9b83d 100644 --- a/src/common/turb/mode_prandtl.F90 +++ b/src/common/turb/mode_prandtl.F90 @@ -225,7 +225,8 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ! INTEGER :: IKB ! vertical index value for the first inner mass point INTEGER :: IKE ! vertical index value for the last inner mass point -INTEGER:: JSV,JIJ,JK,IIJB,IIJE ! loop index +INTEGER:: JSV,JIJ,JK ! loop index +INTEGER :: IIJB,IIJE,IKT,IKA,IKL INTEGER :: JLOOP REAL :: ZMINVAL @@ -254,16 +255,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT +IKA=D%NKA +IKL=D%NKL ! CALL ETHETA(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN,OCOMPUTE_SRC,ZWORK1) CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZWORK2) CALL MZM_PHY(D,ZWORK1,PETHETA) CALL MZM_PHY(D,ZWORK2,PEMOIST) !$mnh_expand_array(JIJ=IIJB:IIJE) -PETHETA(IIJB:IIJE,D%NKA) = 2.*PETHETA(IIJB:IIJE,IKB) - PETHETA(IIJB:IIJE,IKB+D%NKL) -PEMOIST(IIJB:IIJE,D%NKA) = 2.*PEMOIST(IIJB:IIJE,IKB) - PEMOIST(IIJB:IIJE,IKB+D%NKL) +PETHETA(IIJB:IIJE,IKA) = 2.*PETHETA(IIJB:IIJE,IKB) - PETHETA(IIJB:IIJE,IKB+IKL) +PEMOIST(IIJB:IIJE,IKA) = 2.*PEMOIST(IIJB:IIJE,IKB) - PEMOIST(IIJB:IIJE,IKB+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !--------------------------------------------------------------------------- @@ -272,39 +274,39 @@ IF (.NOT. OHARAT) THEN ! 1.3 1D Redelsperger numbers ! IF (OOCEAN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = CST%XG * CST%XALPHAOC * PLM(IIJB:IIJE,1:D%NKT) & - * PLEPS(IIJB:IIJE,1:D%NKT) / PTKEM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = CST%XG * CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) & + * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = CST%XG / PTHVREF(IIJB:IIJE,1:D%NKT) * PLM(IIJB:IIJE,1:D%NKT) & - * PLEPS(IIJB:IIJE,1:D%NKT) / PTKEM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) & + * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! CALL MZM_PHY(D,ZWORK1,PBLL_O_E) CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZWORK1) ! IF (OOCEAN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PREDTH1(IIJB:IIJE,1:D%NKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) PREDR1(:,:) = 0. ELSE IF (KRR /= 0) THEN ! moist case CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PREDTH1(IIJB:IIJE,1:D%NKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - PREDR1(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) * PEMOIST(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + PREDR1(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE ! dry case - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PREDTH1(IIJB:IIJE,1:D%NKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - PREDR1(IIJB:IIJE,1:D%NKT) = 0. - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PREDTH1(IIJB:IIJE,1:IKT)= CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + PREDR1(IIJB:IIJE,1:IKT) = 0. + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! @@ -313,7 +315,7 @@ END IF ! ZMINVAL = (1.-1./CSTURB%XPHI_LIM) ! -DO JK=1,D%NKT +DO JK=1,IKT DO JIJ=IIJB,IIJE ZW1(JIJ,JK) = 1. ZW2(JIJ,JK) = 1. @@ -368,13 +370,13 @@ ENDDO ! For the scalar variables DO JSV=1,KSV CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PREDS1(IIJB:IIJE,1:D%NKT,JSV)=CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PREDS1(IIJB:IIJE,1:IKT,JSV)=CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO ! DO JSV=1,KSV - DO JK=1,D%NKT + DO JK=1,IKT DO JIJ=IIJB,IIJE IF(PREDS1(JIJ,JK,JSV) < 0.) THEN ZW2(JIJ,JK)=-1. @@ -394,61 +396,61 @@ ENDDO IF(HTURBDIM=='1DIM') THEN ! 1D case ! ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,1:D%NKT) = PREDTH1(IIJB:IIJE,1:D%NKT)**2 + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2 ! - PRED2R3(IIJB:IIJE,1:D%NKT) = PREDR1(IIJB:IIJE,1:D%NKT) **2 + PRED2R3(IIJB:IIJE,1:IKT) = PREDR1(IIJB:IIJE,1:IKT) **2 ! - PRED2THR3(IIJB:IIJE,1:D%NKT) = PREDTH1(IIJB:IIJE,1:D%NKT) * PREDR1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PRED2THR3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT) * PREDR1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ELSE IF (O2D) THEN ! 3D case in a 2D model ! CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PTH(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) ! IF (KRR /= 0) THEN ! moist 3D case CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PRM(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PTH(IIJB:IIJE,1:D%NKT) * ZGXMM_PRM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK4) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,1:D%NKT)= PREDTH1(IIJB:IIJE,1:D%NKT)**2+(CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - *PETHETA(IIJB:IIJE,1:D%NKT) )**2 * ZWORK2(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT)= PREDTH1(IIJB:IIJE,1:IKT)**2+(CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + *PETHETA(IIJB:IIJE,1:IKT) )**2 * ZWORK2(IIJB:IIJE,1:IKT) ! - PRED2R3(IIJB:IIJE,1:D%NKT)= PREDR1(IIJB:IIJE,1:D%NKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - * PEMOIST(IIJB:IIJE,1:D%NKT))**2 * ZWORK3(IIJB:IIJE,1:D%NKT) + PRED2R3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + * PEMOIST(IIJB:IIJE,1:IKT))**2 * ZWORK3(IIJB:IIJE,1:IKT) ! - PRED2THR3(IIJB:IIJE,1:D%NKT)= PREDR1(IIJB:IIJE,1:D%NKT) * PREDTH1(IIJB:IIJE,1:D%NKT) + CSTURB%XCTV**2 & - * PBLL_O_E(IIJB:IIJE,1:D%NKT)**2 & - * PEMOIST(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) & - * ZWORK4(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PRED2THR3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT) * PREDTH1(IIJB:IIJE,1:IKT) + CSTURB%XCTV**2 & + * PBLL_O_E(IIJB:IIJE,1:IKT)**2 & + * PEMOIST(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) & + * ZWORK4(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! - PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+D%NKL) - PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+D%NKL) - PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+D%NKL) + PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL) + PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+IKL) + PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+IKL) ! ELSE ! dry 3D case in a 2D model - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,1:D%NKT) = PREDTH1(IIJB:IIJE,1:D%NKT)**2 + CSTURB%XCTV**2 & - * PBLL_O_E(IIJB:IIJE,1:D%NKT)**2 * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+D%NKL) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2 + CSTURB%XCTV**2 & + * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL) ! - PRED2R3(IIJB:IIJE,1:D%NKT) = 0. + PRED2R3(IIJB:IIJE,1:IKT) = 0. ! - PRED2THR3(IIJB:IIJE,1:D%NKT) = 0. + PRED2THR3(IIJB:IIJE,1:IKT) = 0. ! END IF ! @@ -456,53 +458,53 @@ ELSE ! 3D case in a 3D model ! CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH) CALL GY_M_M_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZGYMM_PTH) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PTH(IIJB:IIJE,1:D%NKT)**2 + ZGYMM_PTH(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PTH(IIJB:IIJE,1:IKT)**2 + ZGYMM_PTH(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) ! IF (KRR /= 0) THEN ! moist 3D case CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM) CALL GY_M_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZGYMM_PRM) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PRM(IIJB:IIJE,1:D%NKT)**2 + ZGYMM_PRM(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT)**2 + ZGYMM_PRM(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PRM(IIJB:IIJE,1:D%NKT) * ZGXMM_PTH(IIJB:IIJE,1:D%NKT) & - + ZGYMM_PRM(IIJB:IIJE,1:D%NKT) * ZGYMM_PTH(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PRM(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT) & + + ZGYMM_PRM(IIJB:IIJE,1:IKT) * ZGYMM_PTH(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK4) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,1:D%NKT)= PREDTH1(IIJB:IIJE,1:D%NKT)**2 + ( CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - * PETHETA(IIJB:IIJE,1:D%NKT) )**2 * ZWORK2(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT)= PREDTH1(IIJB:IIJE,1:IKT)**2 + ( CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + * PETHETA(IIJB:IIJE,1:IKT) )**2 * ZWORK2(IIJB:IIJE,1:IKT) ! - PRED2R3(IIJB:IIJE,1:D%NKT)= PREDR1(IIJB:IIJE,1:D%NKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - * PEMOIST(IIJB:IIJE,1:D%NKT))**2 * ZWORK3(IIJB:IIJE,1:D%NKT) + PRED2R3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT)**2 + (CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + * PEMOIST(IIJB:IIJE,1:IKT))**2 * ZWORK3(IIJB:IIJE,1:IKT) ! - PRED2THR3(IIJB:IIJE,1:D%NKT)= PREDR1(IIJB:IIJE,1:D%NKT) * PREDTH1(IIJB:IIJE,1:D%NKT) + CSTURB%XCTV**2 & - * PBLL_O_E(IIJB:IIJE,1:D%NKT)**2 * & - PEMOIST(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) * ZWORK4(IIJB:IIJE,1:D%NKT) + PRED2THR3(IIJB:IIJE,1:IKT)= PREDR1(IIJB:IIJE,1:IKT) * PREDTH1(IIJB:IIJE,1:IKT) + CSTURB%XCTV**2 & + * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * & + PEMOIST(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! - PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+D%NKL) - PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+D%NKL) - PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+D%NKL) + PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL) + PRED2R3(IIJB:IIJE,IKB)=PRED2R3(IIJB:IIJE,IKB+IKL) + PRED2THR3(IIJB:IIJE,IKB)=PRED2THR3(IIJB:IIJE,IKB+IKL) ! ELSE ! dry 3D case in a 3D model - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2TH3(IIJB:IIJE,1:D%NKT) = PREDTH1(IIJB:IIJE,1:D%NKT)**2 + CSTURB%XCTV**2 & - * PBLL_O_E(IIJB:IIJE,1:D%NKT)**2 * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT) = PREDTH1(IIJB:IIJE,1:IKT)**2 + CSTURB%XCTV**2 & + * PBLL_O_E(IIJB:IIJE,1:IKT)**2 * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! - PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+D%NKL) + PRED2TH3(IIJB:IIJE,IKB)=PRED2TH3(IIJB:IIJE,IKB+IKL) ! - PRED2R3(IIJB:IIJE,1:D%NKT) = 0. + PRED2R3(IIJB:IIJE,1:IKT) = 0. ! - PRED2THR3(IIJB:IIJE,1:D%NKT) = 0. + PRED2THR3(IIJB:IIJE,1:IKT) = 0. ! END IF ! @@ -517,89 +519,89 @@ DO JSV=1,KSV ! IF(HTURBDIM=='1DIM') THEN ! 1D case - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2THS3(IIJB:IIJE,1:D%NKT,JSV) = PREDS1(IIJB:IIJE,1:D%NKT,JSV) * PREDTH1(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDS1(IIJB:IIJE,1:IKT,JSV) * PREDTH1(IIJB:IIJE,1:IKT) IF (KRR /= 0) THEN - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = PREDR1(IIJB:IIJE,1:D%NKT) *PREDS1(IIJB:IIJE,1:D%NKT,JSV) + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) *PREDS1(IIJB:IIJE,1:IKT,JSV) ELSE - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = 0. + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0. END IF - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ELSE IF (O2D) THEN ! 3D case in a 2D model ! IF (OOCEAN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:D%NKT) * PLEPS(IIJB:IIJE,1:D%NKT) & - / PTKEM(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) & + / PTKEM(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) IF (KRR /= 0) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZW1(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZW1(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE ZW1 = ZWORK2 END IF ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:D%NKT) * PLM(IIJB:IIJE,1:D%NKT) & - * PLEPS(IIJB:IIJE,1:D%NKT) / PTKEM(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) & + * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZW1) ! CALL GX_M_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZGXMM_PSV) CALL GX_M_M_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZGXMM_PTH) CALL GX_M_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZGXMM_PRM) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PSV(IIJB:IIJE,1:D%NKT) * ZGXMM_PTH(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PSV(IIJB:IIJE,1:D%NKT) * ZGXMM_PRM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (KRR /= 0) THEN - ZWORK1(IIJB:IIJE,1:D%NKT) = ZW1(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) ELSE - ZWORK1(IIJB:IIJE,1:D%NKT) = ZW1(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT) END IF - PRED2THS3(IIJB:IIJE,1:D%NKT,JSV) = PREDTH1(IIJB:IIJE,1:D%NKT) * PREDS1(IIJB:IIJE,1:D%NKT,JSV) + & - ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) + PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDTH1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + & + ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) ! IF (KRR /= 0) THEN - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = PREDR1(IIJB:IIJE,1:D%NKT) * PREDS1(IIJB:IIJE,1:D%NKT,JSV) + & - ZW1(IIJB:IIJE,1:D%NKT) * PEMOIST(IIJB:IIJE,1:D%NKT) * ZWORK3(IIJB:IIJE,1:D%NKT) + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + & + ZW1(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) * ZWORK3(IIJB:IIJE,1:IKT) ELSE - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = 0. + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0. END IF - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ELSE ! 3D case in a 3D model ! IF (OOCEAN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:D%NKT) * PLEPS(IIJB:IIJE,1:D%NKT) & - / PTKEM(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG *CST%XALPHAOC * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) & + / PTKEM(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) IF (KRR /= 0) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZW1(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZW1(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE ZW1 = ZWORK2 END IF ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:D%NKT) * PLM(IIJB:IIJE,1:D%NKT) & - * PLEPS(IIJB:IIJE,1:D%NKT) / PTKEM(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = (CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * PLM(IIJB:IIJE,1:IKT) & + * PLEPS(IIJB:IIJE,1:IKT) / PTKEM(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZW1) ! CALL GX_M_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZGXMM_PSV) @@ -609,36 +611,36 @@ DO JSV=1,KSV CALL GY_M_M_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZGYMM_PTH) CALL GY_M_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZGYMM_PRM) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PSV(IIJB:IIJE,1:D%NKT) * ZGXMM_PTH(IIJB:IIJE,1:D%NKT) & - + ZGYMM_PSV(IIJB:IIJE,1:D%NKT) * ZGYMM_PTH(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PTH(IIJB:IIJE,1:IKT) & + + ZGYMM_PSV(IIJB:IIJE,1:IKT) * ZGYMM_PTH(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZGXMM_PSV(IIJB:IIJE,1:D%NKT) * ZGXMM_PRM(IIJB:IIJE,1:D%NKT) & - + ZGYMM_PSV(IIJB:IIJE,1:D%NKT) * ZGYMM_PRM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZGXMM_PSV(IIJB:IIJE,1:IKT) * ZGXMM_PRM(IIJB:IIJE,1:IKT) & + + ZGYMM_PSV(IIJB:IIJE,1:IKT) * ZGYMM_PRM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) ! IF (KRR /= 0) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZW1(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - ZWORK1(IIJB:IIJE,1:D%NKT) = ZW1(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZW1(IIJB:IIJE,1:IKT) END IF - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2THS3(IIJB:IIJE,1:D%NKT,JSV) = PREDTH1(IIJB:IIJE,1:D%NKT) * PREDS1(IIJB:IIJE,1:D%NKT,JSV) + & - ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2THS3(IIJB:IIJE,1:IKT,JSV) = PREDTH1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + & + ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (KRR /= 0) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = PREDR1(IIJB:IIJE,1:D%NKT) * PREDS1(IIJB:IIJE,1:D%NKT,JSV) + & - ZW1(IIJB:IIJE,1:D%NKT) * PEMOIST(IIJB:IIJE,1:D%NKT) * ZWORK3(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = PREDR1(IIJB:IIJE,1:IKT) * PREDS1(IIJB:IIJE,1:IKT,JSV) + & + ZW1(IIJB:IIJE,1:IKT) * PEMOIST(IIJB:IIJE,1:IKT) * ZWORK3(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - PRED2RS3(IIJB:IIJE,1:D%NKT,JSV) = 0. + PRED2RS3(IIJB:IIJE,1:IKT,JSV) = 0. END IF END IF ! @@ -748,12 +750,12 @@ IIJB=D%NIJB ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZCOEF(IIJB:IIJE,1:D%NKT) = MAX(MIN(( 10.*(1.-PPHI3(IIJB:IIJE,1:D%NKT)/CSTURB%XPHI_LIM)) ,1.), 0.) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZCOEF(IIJB:IIJE,1:IKT) = MAX(MIN(( 10.*(1.-PPHI3(IIJB:IIJE,1:IKT)/CSTURB%XPHI_LIM)) ,1.), 0.) ! -PF(IIJB:IIJE,1:D%NKT) = ZCOEF(IIJB:IIJE,1:D%NKT) * PF(IIJB:IIJE,1:D%NKT) & - + (1.-ZCOEF(IIJB:IIJE,1:D%NKT)) * PF_LIM(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +PF(IIJB:IIJE,1:IKT) = ZCOEF(IIJB:IIJE,1:IKT) * PF(IIJB:IIJE,1:IKT) & + + (1.-ZCOEF(IIJB:IIJE,1:IKT)) * PF_LIM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! END SUBROUTINE SMOOTH_TURB_FUNCT !---------------------------------------------------------------------------- @@ -770,7 +772,7 @@ SUBROUTINE PHI3(D,CSTURB,PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PPHI3 ! REAL, DIMENSION(D%NIJT,D%NKT) :: ZW1, ZW2 - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE, IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',0,ZHOOK_HANDLE) @@ -778,51 +780,50 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT ! IF (HTURBDIM=='3DIM') THEN !* 3DIM case - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (OUSERV) THEN - ZW1(IIJB:IIJE,1:D%NKT) = 1. + 1.5* (PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) + & - ( 0.5 * (PREDTH1(IIJB:IIJE,1:D%NKT)**2+PREDR1(IIJB:IIJE,1:D%NKT)**2) & - + PREDTH1(IIJB:IIJE,1:D%NKT) * PREDR1(IIJB:IIJE,1:D%NKT) & + ZW1(IIJB:IIJE,1:IKT) = 1. + 1.5* (PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) + & + ( 0.5 * (PREDTH1(IIJB:IIJE,1:IKT)**2+PREDR1(IIJB:IIJE,1:IKT)**2) & + + PREDTH1(IIJB:IIJE,1:IKT) * PREDR1(IIJB:IIJE,1:IKT) & ) - ZW2(IIJB:IIJE,1:D%NKT) = 0.5 * (PRED2TH3(IIJB:IIJE,1:D%NKT)-PRED2R3(IIJB:IIJE,1:D%NKT)) + ZW2(IIJB:IIJE,1:IKT) = 0.5 * (PRED2TH3(IIJB:IIJE,1:IKT)-PRED2R3(IIJB:IIJE,1:IKT)) - PPHI3(IIJB:IIJE,1:D%NKT)= 1. - & - ( ( (1.+PREDR1(IIJB:IIJE,1:D%NKT)) * & - (PRED2THR3(IIJB:IIJE,1:D%NKT) + PRED2TH3(IIJB:IIJE,1:D%NKT)) / PREDTH1(IIJB:IIJE,1:D%NKT) & - ) + ZW2(IIJB:IIJE,1:D%NKT) & - ) / ZW1(IIJB:IIJE,1:D%NKT) + PPHI3(IIJB:IIJE,1:IKT)= 1. - & + ( ( (1.+PREDR1(IIJB:IIJE,1:IKT)) * & + (PRED2THR3(IIJB:IIJE,1:IKT) + PRED2TH3(IIJB:IIJE,1:IKT)) / PREDTH1(IIJB:IIJE,1:IKT) & + ) + ZW2(IIJB:IIJE,1:IKT) & + ) / ZW1(IIJB:IIJE,1:IKT) ELSE - ZW1(IIJB:IIJE,1:D%NKT) = 1. + 1.5* PREDTH1(IIJB:IIJE,1:D%NKT) + & - 0.5* PREDTH1(IIJB:IIJE,1:D%NKT)**2 + ZW1(IIJB:IIJE,1:IKT) = 1. + 1.5* PREDTH1(IIJB:IIJE,1:IKT) + & + 0.5* PREDTH1(IIJB:IIJE,1:IKT)**2 - ZW2(IIJB:IIJE,1:D%NKT) = 0.5* PRED2TH3(IIJB:IIJE,1:D%NKT) + ZW2(IIJB:IIJE,1:IKT) = 0.5* PRED2TH3(IIJB:IIJE,1:IKT) - PPHI3(IIJB:IIJE,1:D%NKT)= 1. - & - (PRED2TH3(IIJB:IIJE,1:D%NKT) / PREDTH1(IIJB:IIJE,1:D%NKT) + ZW2(IIJB:IIJE,1:D%NKT)) & - / ZW1(IIJB:IIJE,1:D%NKT) + PPHI3(IIJB:IIJE,1:IKT)= 1. - & + (PRED2TH3(IIJB:IIJE,1:IKT) / PREDTH1(IIJB:IIJE,1:IKT) + ZW2(IIJB:IIJE,1:IKT)) & + / ZW1(IIJB:IIJE,1:IKT) END IF - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE( PPHI3(IIJB:IIJE,1:D%NKT) <= 0. .OR. PPHI3(IIJB:IIJE,1:D%NKT) > CSTURB%XPHI_LIM ) - PPHI3(IIJB:IIJE,1:D%NKT) = CSTURB%XPHI_LIM + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE( PPHI3(IIJB:IIJE,1:IKT) <= 0. .OR. PPHI3(IIJB:IIJE,1:IKT) > CSTURB%XPHI_LIM ) + PPHI3(IIJB:IIJE,1:IKT) = CSTURB%XPHI_LIM END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ELSE !* 1DIM case - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (OUSERV) THEN - PPHI3(IIJB:IIJE,1:D%NKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) + PPHI3(IIJB:IIJE,1:IKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) ELSE - PPHI3(IIJB:IIJE,1:D%NKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:D%NKT)) + PPHI3(IIJB:IIJE,1:IKT)= 1./(1.+PREDTH1(IIJB:IIJE,1:IKT)) END IF - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! PPHI3(IIJB:IIJE,IKB-1)=PPHI3(IIJB:IIJE,IKB) @@ -853,32 +854,31 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT ! DO JSV=1,KSV - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PPSI_SV(IIJB:IIJE,1:D%NKT,JSV) = ( 1. & + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PPSI_SV(IIJB:IIJE,1:IKT,JSV) = ( 1. & - (CSTURB%XCPR3+CSTURB%XCPR5) * & - (PRED2THS(IIJB:IIJE,1:D%NKT,JSV)/PREDS1(IIJB:IIJE,1:D%NKT,JSV)-PREDTH1(IIJB:IIJE,1:D%NKT)) & + (PRED2THS(IIJB:IIJE,1:IKT,JSV)/PREDS1(IIJB:IIJE,1:IKT,JSV)-PREDTH1(IIJB:IIJE,1:IKT)) & - (CSTURB%XCPR4+CSTURB%XCPR5) * & - (PRED2RS(IIJB:IIJE,1:D%NKT,JSV)/PREDS1(IIJB:IIJE,1:D%NKT,JSV)-PREDR1(IIJB:IIJE,1:D%NKT)) & + (PRED2RS(IIJB:IIJE,1:IKT,JSV)/PREDS1(IIJB:IIJE,1:IKT,JSV)-PREDR1(IIJB:IIJE,1:IKT)) & - CSTURB%XCPR3 * & - PREDTH1(IIJB:IIJE,1:D%NKT) * PPHI3(IIJB:IIJE,1:D%NKT) & - - CSTURB%XCPR4 * PREDR1(IIJB:IIJE,1:D%NKT) * PPSI3(IIJB:IIJE,1:D%NKT) & - ) / ( 1. + CSTURB%XCPR5 * ( PREDTH1(IIJB:IIJE,1:D%NKT) + PREDR1(IIJB:IIJE,1:D%NKT) ) ) + PREDTH1(IIJB:IIJE,1:IKT) * PPHI3(IIJB:IIJE,1:IKT) & + - CSTURB%XCPR4 * PREDR1(IIJB:IIJE,1:IKT) * PPSI3(IIJB:IIJE,1:IKT) & + ) / ( 1. + CSTURB%XCPR5 * ( PREDTH1(IIJB:IIJE,1:IKT) + PREDR1(IIJB:IIJE,1:IKT) ) ) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! control of the PSI_SV positivity - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE ( (PPSI_SV(IIJB:IIJE,1:D%NKT,JSV) <=0.).AND. (PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))<=0.) - PPSI_SV(IIJB:IIJE,1:D%NKT,JSV)=CSTURB%XPHI_LIM + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE ( (PPSI_SV(IIJB:IIJE,1:IKT,JSV) <=0.).AND. (PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))<=0.) + PPSI_SV(IIJB:IIJE,1:IKT,JSV)=CSTURB%XPHI_LIM END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PPSI_SV(IIJB:IIJE,1:D%NKT,JSV) = MAX( 1.E-4, MIN(CSTURB%XPHI_LIM,PPSI_SV(IIJB:IIJE,1:D%NKT,JSV)) ) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PPSI_SV(IIJB:IIJE,1:IKT,JSV) = MAX( 1.E-4, MIN(CSTURB%XPHI_LIM,PPSI_SV(IIJB:IIJE,1:IKT,JSV)) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PPSI_SV(IIJB:IIJE,IKB-1,JSV)=PPSI_SV(IIJB:IIJE,IKB,JSV) PPSI_SV(IIJB:IIJE,IKE+1,JSV)=PPSI_SV(IIJB:IIJE,IKE,JSV) @@ -898,7 +898,7 @@ SUBROUTINE D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,H CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DTDZ_O_DDTDZ - INTEGER :: IKB, IKE,JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE,JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE) @@ -906,58 +906,57 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT ! IF (HTURBDIM=='3DIM') THEN !* 3DIM case IF (OUSERV) THEN - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM) #else - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM) #endif - PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) & - * (1. - PREDTH1(IIJB:IIJE,1:D%NKT) * (3./2.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - /((1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))))) & - + (1.+PREDR1(IIJB:IIJE,1:D%NKT))*(PRED2THR3(IIJB:IIJE,1:D%NKT)+PRED2TH3(IIJB:IIJE,1:D%NKT)) & - / (PREDTH1(IIJB:IIJE,1:D%NKT)*(1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))* & - (1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)))) & - - (1./2.*PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT) & - * (1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))) & - / ((1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))& - *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)))) + PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) & + * (1. - PREDTH1(IIJB:IIJE,1:IKT) * (3./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + /((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))) & + + (1.+PREDR1(IIJB:IIJE,1:IKT))*(PRED2THR3(IIJB:IIJE,1:IKT)+PRED2TH3(IIJB:IIJE,1:IKT)) & + / (PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))* & + (1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) & + - (1./2.*PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT) & + * (1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))) & + / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))& + *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) ELSEWHERE - PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) + PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) ENDWHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! ELSE - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM) #else - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM) #endif - PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) & - * (1. - PREDTH1(IIJB:IIJE,1:D%NKT) * (3./2.+PREDTH1(IIJB:IIJE,1:D%NKT)) & - /((1.+PREDTH1(IIJB:IIJE,1:D%NKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:D%NKT)))) & - + PRED2TH3(IIJB:IIJE,1:D%NKT) & - / (PREDTH1(IIJB:IIJE,1:D%NKT)*(1.+PREDTH1(IIJB:IIJE,1:D%NKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:D%NKT))) & - - 1./2.*PREDTH1(IIJB:IIJE,1:D%NKT) & - / ((1.+PREDTH1(IIJB:IIJE,1:D%NKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:D%NKT))) + PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) & + * (1. - PREDTH1(IIJB:IIJE,1:IKT) * (3./2.+PREDTH1(IIJB:IIJE,1:IKT)) & + /((1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT)))) & + + PRED2TH3(IIJB:IIJE,1:IKT) & + / (PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT))) & + - 1./2.*PREDTH1(IIJB:IIJE,1:IKT) & + / ((1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.+1./2.*PREDTH1(IIJB:IIJE,1:IKT))) ELSEWHERE - PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) + PD_PHI3DTDZ_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) ENDWHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! END IF ELSE !* 1DIM case -DO JK=1,D%NKT +DO JK=1,D%IKT DO JIJ=IIJB,IIJE IF ( ABS(PPHI3(JIJ,JK)-CSTURB%XPHI_LIM) < 1.E-12 ) THEN PD_PHI3DTDZ_O_DDTDZ(JIJ,JK)=PPHI3(JIJ,JK)*& @@ -992,7 +991,7 @@ SUBROUTINE D_PHI3DRDZ_O_DDRDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,H CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DRDZ_O_DDRDZ - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE) @@ -1000,51 +999,50 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT ! ! IF (HTURBDIM=='3DIM') THEN !* 3DIM case IF (OUSERV) THEN - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM) #else - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM) #endif - PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) & - * (1.-PREDR1(IIJB:IIJE,1:D%NKT)*(3./2.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - / ((1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))))) & - - PREDR1(IIJB:IIJE,1:D%NKT) & - * (PRED2THR3(IIJB:IIJE,1:D%NKT)+PRED2TH3(IIJB:IIJE,1:D%NKT)) / (PREDTH1(IIJB:IIJE,1:D%NKT) & - * (1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))*& - (1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)))) & - + PREDR1(IIJB:IIJE,1:D%NKT) * (1./2.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - / ((1.+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))& - *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)))) + PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) & + * (1.-PREDR1(IIJB:IIJE,1:IKT)*(3./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))))) & + - PREDR1(IIJB:IIJE,1:IKT) & + * (PRED2THR3(IIJB:IIJE,1:IKT)+PRED2TH3(IIJB:IIJE,1:IKT)) / (PREDTH1(IIJB:IIJE,1:IKT) & + * (1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))*& + (1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) & + + PREDR1(IIJB:IIJE,1:IKT) * (1./2.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + / ((1.+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))& + *(1.+1./2.*(PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)))) ELSEWHERE - PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) + PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) + PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) END IF ELSE !* 1DIM case - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM) #else - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM) #endif - PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) & - * (1. - PREDR1(IIJB:IIJE,1:D%NKT)*PPHI3(IIJB:IIJE,1:D%NKT)) + PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) & + * (1. - PREDR1(IIJB:IIJE,1:IKT)*PPHI3(IIJB:IIJE,1:IKT)) ELSEWHERE - PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) + PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! #ifdef REPRO48 @@ -1072,7 +1070,7 @@ SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3, LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_PHI3DTDZ2_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1080,31 +1078,30 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT ! ! IF (HTURBDIM=='3DIM') THEN ! by derivation of (phi3 dtdz) * dtdz according to dtdz we obtain: CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PDTDZ(IIJB:IIJE,1:D%NKT) & - * (PPHI3(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PDTDZ(IIJB:IIJE,1:IKT) & + * (PPHI3(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE !* 1DIM case - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)/=CSTURB%XPHI_LIM) #else - WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM) + WHERE (PPHI3(IIJB:IIJE,1:IKT)<=CSTURB%XPHI_LIM) #endif - PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT)*PDTDZ(IIJB:IIJE,1:D%NKT) & - * (2. - PREDTH1(IIJB:IIJE,1:D%NKT)*PPHI3(IIJB:IIJE,1:D%NKT)) + PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT) & + * (2. - PREDTH1(IIJB:IIJE,1:IKT)*PPHI3(IIJB:IIJE,1:IKT)) ELSEWHERE - PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) * 2. * PDTDZ(IIJB:IIJE,1:D%NKT) + PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:IKT) = PPHI3(IIJB:IIJE,1:IKT) * 2. * PDTDZ(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! #ifdef REPRO48 @@ -1129,7 +1126,7 @@ SUBROUTINE M3_WTH_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WTH2 - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE) @@ -1137,14 +1134,13 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_WTH_WTH2(IIJB:IIJE,1:D%NKT) = CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:D%NKT)& - * PETHETA(IIJB:IIJE,1:D%NKT)*0.5/CSTURB%XCTD & - * (1.+0.5*PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) / PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_WTH_WTH2(IIJB:IIJE,1:IKT) = CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:IKT)& + * PETHETA(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD & + * (1.+0.5*PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) / PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) PM3_WTH_WTH2(IIJB:IIJE,IKB-1)=PM3_WTH_WTH2(IIJB:IIJE,IKB) PM3_WTH_WTH2(IIJB:IIJE,IKE+1)=PM3_WTH_WTH2(IIJB:IIJE,IKE) ! @@ -1161,7 +1157,7 @@ SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WTH2_O_DDTDZ - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1169,16 +1165,15 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = & -(0.5*CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT)*0.5/CSTURB%XCTD/PD(IIJB:IIJE,1:D%NKT) & -- PM3_WTH_WTH2(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT)& -*(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) )& -* PBLL_O_E(IIJB:IIJE,1:D%NKT) * PETHETA(IIJB:IIJE,1:D%NKT) * CSTURB%XCTV -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = & +(0.5*CSTURB%XCSHF*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD/PD(IIJB:IIJE,1:IKT) & +- PM3_WTH_WTH2(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)& +*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) )& +* PBLL_O_E(IIJB:IIJE,1:IKT) * PETHETA(IIJB:IIJE,1:IKT) * CSTURB%XCTV +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WTH2_O_DDTDZ(IIJB:IIJE,IKE) @@ -1196,7 +1191,7 @@ SUBROUTINE M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_W2TH REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE) @@ -1204,14 +1199,14 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - +IKT=D%NKT +! CALL MZM_PHY(D,PTKE,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_WTH_W2TH(IIJB:IIJE,1:D%NKT) = CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)*1.5/ZWORK1(IIJB:IIJE,1:D%NKT) & - * (1. - 0.5*PREDR1(IIJB:IIJE,1:D%NKT)*(1.+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) ) & - / (1.+PREDTH1(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_WTH_W2TH(IIJB:IIJE,1:IKT) = CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*1.5/ZWORK1(IIJB:IIJE,1:IKT) & + * (1. - 0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) ) & + / (1.+PREDTH1(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_WTH_W2TH(IIJB:IIJE,IKB-1)=PM3_WTH_W2TH(IIJB:IIJE,IKB) PM3_WTH_W2TH(IIJB:IIJE,IKE+1)=PM3_WTH_W2TH(IIJB:IIJE,IKE) @@ -1231,7 +1226,7 @@ SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKE REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_W2TH_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array - INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1239,18 +1234,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - +IKT=D%NKT +! CALL MZM_PHY(D,PTKE,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = & - - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)*1.5/ZWORK1(IIJB:IIJE,1:D%NKT)/(1.+PREDTH1(IIJB:IIJE,1:D%NKT))**2 & - * CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) & - * (1. - 0.5*PREDR1(IIJB:IIJE,1:D%NKT)*(1.+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)* & - ( 1.+(1.+PREDTH1(IIJB:IIJE,1:D%NKT))*(1.5+PREDR1(IIJB:IIJE,1:D%NKT)+PREDTH1(IIJB:IIJE,1:D%NKT))& - /PD(IIJB:IIJE,1:D%NKT)) ) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = & + - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*1.5/ZWORK1(IIJB:IIJE,1:IKT)/(1.+PREDTH1(IIJB:IIJE,1:IKT))**2 & + * CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) & + * (1. - 0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)* & + ( 1.+(1.+PREDTH1(IIJB:IIJE,1:IKT))*(1.5+PREDR1(IIJB:IIJE,1:IKT)+PREDTH1(IIJB:IIJE,1:IKT))& + /PD(IIJB:IIJE,1:IKT)) ) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_W2TH_O_DDTDZ(IIJB:IIJE,IKE) @@ -1269,7 +1263,7 @@ SUBROUTINE M3_WTH_W2R(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_W2R REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE) @@ -1277,15 +1271,14 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - +IKT=D%NKT +! CALL MZM_PHY(D,PTKE,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_WTH_W2R(IIJB:IIJE,1:D%NKT) = & - - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - /ZWORK1(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)*PDTDZ(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_WTH_W2R(IIJB:IIJE,1:IKT) = & + - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + /ZWORK1(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_WTH_W2R(IIJB:IIJE,IKB-1)=PM3_WTH_W2R(IIJB:IIJE,IKB) PM3_WTH_W2R(IIJB:IIJE,IKE+1)=PM3_WTH_W2R(IIJB:IIJE,IKE) @@ -1305,7 +1298,7 @@ SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,P REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_W2R_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1313,17 +1306,16 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - +IKT=D%NKT +! CALL MZM_PHY(D,PTKE,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,1:D%NKT) = & -- CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT) & - /ZWORK1(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) & - * (1. - PREDTH1(IIJB:IIJE,1:D%NKT)*(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)& - +PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,1:IKT) = & +- CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*0.75*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT) & + /ZWORK1(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) & + * (1. - PREDTH1(IIJB:IIJE,1:IKT)*(1.5+PREDTH1(IIJB:IIJE,1:IKT)& + +PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_W2R_O_DDTDZ(IIJB:IIJE,IKE) @@ -1345,7 +1337,7 @@ SUBROUTINE M3_WTH_WR2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMO REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WR2 REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE) @@ -1353,18 +1345,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBETA(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT) & - /(PSQRT_TKE(IIJB:IIJE,1:D%NKT)*PTKE(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) & + /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_WTH_WR2(IIJB:IIJE,1:D%NKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)& - *0.25*PBLL_O_E(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:D%NKT)**2 & - *ZWORK2(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD*PDTDZ(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_WTH_WR2(IIJB:IIJE,1:IKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)& + *0.25*PBLL_O_E(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:IKT)**2 & + *ZWORK2(IIJB:IIJE,1:IKT)/CSTURB%XCTD*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_WTH_WR2(IIJB:IIJE,IKB-1)=PM3_WTH_WR2(IIJB:IIJE,IKB) PM3_WTH_WR2(IIJB:IIJE,IKE+1)=PM3_WTH_WR2(IIJB:IIJE,IKE) @@ -1387,7 +1379,7 @@ SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE, REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WR2_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1395,20 +1387,20 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBETA(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - /(PSQRT_TKE(IIJB:IIJE,1:D%NKT)*PTKE(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)& - *0.25*PBLL_O_E(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:D%NKT)**2 & - *ZWORK2(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD/PD(IIJB:IIJE,1:D%NKT) & - * (1. - PREDTH1(IIJB:IIJE,1:D%NKT)* & - (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,1:IKT) = - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)& + *0.25*PBLL_O_E(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PEMOIST(IIJB:IIJE,1:IKT)**2 & + *ZWORK2(IIJB:IIJE,1:IKT)/CSTURB%XCTD/PD(IIJB:IIJE,1:IKT) & + * (1. - PREDTH1(IIJB:IIJE,1:IKT)* & + (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WR2_O_DDTDZ(IIJB:IIJE,IKE) @@ -1429,7 +1421,7 @@ SUBROUTINE M3_WTH_WTHR(D,CSTURB,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOI REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_WTH_WTHR REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE) @@ -1437,19 +1429,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBETA(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - /(PSQRT_TKE(IIJB:IIJE,1:D%NKT)*PTKE(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + /(PSQRT_TKE(IIJB:IIJE,1:IKT)*PTKE(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_WTH_WTHR(IIJB:IIJE,1:D%NKT) = & - CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) & - *0.5*PLEPS(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD*(1+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_WTH_WTHR(IIJB:IIJE,1:IKT) = & + CSTURB%XCSHF*PKEFF(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) & + *0.5*PLEPS(IIJB:IIJE,1:IKT)/CSTURB%XCTD*(1+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_WTH_WTHR(IIJB:IIJE,IKB-1)=PM3_WTH_WTHR(IIJB:IIJE,IKB) PM3_WTH_WTHR(IIJB:IIJE,IKE+1)=PM3_WTH_WTHR(IIJB:IIJE,IKE) @@ -1467,7 +1458,7 @@ SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_WTH_WTHR_O_DDTDZ - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1475,14 +1466,13 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,1:D%NKT) = & - - PM3_WTH_WTHR(IIJB:IIJE,1:D%NKT) * (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))& - /PD(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = & + - PM3_WTH_WTHR(IIJB:IIJE,1:IKT) * (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))& + /PD(IIJB:IIJE,1:IKT)*CSTURB%XCTV*PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_WTH_WTHR_O_DDTDZ(IIJB:IIJE,IKE) @@ -1502,7 +1492,7 @@ SUBROUTINE M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_W2TH REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE) @@ -1510,17 +1500,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:D%NKT)*(1.+PREDR1(IIJB:IIJE,1:D%NKT))& - /PD(IIJB:IIJE,1:D%NKT))/(1.+PREDTH1(IIJB:IIJE,1:D%NKT))*PDTDZ(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))& + /PD(IIJB:IIJE,1:IKT))/(1.+PREDTH1(IIJB:IIJE,1:IKT))*PDTDZ(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_TH2_W2TH(IIJB:IIJE,1:D%NKT) = - ZWORK2(IIJB:IIJE,1:D%NKT) & - * 1.5*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)/PTKE(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_TH2_W2TH(IIJB:IIJE,1:IKT) = - ZWORK2(IIJB:IIJE,1:IKT) & + * 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)/PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_TH2_W2TH(IIJB:IIJE,IKB-1)=PM3_TH2_W2TH(IIJB:IIJE,IKB) PM3_TH2_W2TH(IIJB:IIJE,IKE+1)=PM3_TH2_W2TH(IIJB:IIJE,IKE) @@ -1540,7 +1530,7 @@ SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSER LOGICAL, INTENT(IN) :: OUSERV REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_W2TH_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1548,33 +1538,32 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - - +IKT=D%NKT +! IF (OUSERV) THEN -! D_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 1.5*PLM*PLEPS/PTKE*CSTURB%XCTV * MZF( & +! D_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM*PLEPS/PTKE*CSTURB%XCTV * MZF( & ! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) & -! / (1.+PREDTH1)**2, D%NKA, D%NKU, D%NKL) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:D%NKT)*(1.+PREDR1(IIJB:IIJE,1:D%NKT))& - / PD(IIJB:IIJE,1:D%NKT))*(1.-(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) & - * PREDTH1(IIJB:IIJE,1:D%NKT)*(1.+PREDTH1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) ) & - / (1.+PREDTH1(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +! / (1.+PREDTH1)**2, IKA, IKU, IKL) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = (1.-0.5*PREDR1(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))& + / PD(IIJB:IIJE,1:IKT))*(1.-(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) & + * PREDTH1(IIJB:IIJE,1:IKT)*(1.+PREDTH1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) ) & + / (1.+PREDTH1(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 1.5*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT) & - /PTKE(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) & + /PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = 1./(1.+PREDTH1(IIJB:IIJE,1:D%NKT))**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = 1./(1.+PREDTH1(IIJB:IIJE,1:IKT))**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 1.5*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT) & - /PTKE(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 1.5*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) & + /PTKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB) @@ -1593,7 +1582,7 @@ SUBROUTINE M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WTH2 REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE) @@ -1601,17 +1590,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (1.+0.5*PREDTH1(IIJB:IIJE,1:D%NKT) & - +1.5*PREDR1(IIJB:IIJE,1:D%NKT)+0.5*PREDR1(IIJB:IIJE,1:D%NKT)**2)/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (1.+0.5*PREDTH1(IIJB:IIJE,1:IKT) & + +1.5*PREDR1(IIJB:IIJE,1:IKT)+0.5*PREDR1(IIJB:IIJE,1:IKT)**2)/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_TH2_WTH2(IIJB:IIJE,1:D%NKT) = PLEPS(IIJB:IIJE,1:D%NKT)*0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_TH2_WTH2(IIJB:IIJE,1:IKT) = PLEPS(IIJB:IIJE,1:IKT)*0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_TH2_WTH2(IIJB:IIJE,IKB-1)=PM3_TH2_WTH2(IIJB:IIJE,IKB) PM3_TH2_WTH2(IIJB:IIJE,IKE+1)=PM3_TH2_WTH2(IIJB:IIJE,IKE) @@ -1631,7 +1620,7 @@ SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WTH2_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1639,19 +1628,19 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) & - * (0.5/PD(IIJB:IIJE,1:D%NKT) - (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))& - *(1.+0.5*PREDTH1(IIJB:IIJE,1:D%NKT)+1.5*PREDR1(IIJB:IIJE,1:D%NKT)& - +0.5*PREDR1(IIJB:IIJE,1:D%NKT)**2)/PD(IIJB:IIJE,1:D%NKT)**2) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) & + * (0.5/PD(IIJB:IIJE,1:IKT) - (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))& + *(1.+0.5*PREDTH1(IIJB:IIJE,1:IKT)+1.5*PREDR1(IIJB:IIJE,1:IKT)& + +0.5*PREDR1(IIJB:IIJE,1:IKT)**2)/PD(IIJB:IIJE,1:IKT)**2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PLEPS(IIJB:IIJE,1:D%NKT) & - *0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:D%NKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = PLEPS(IIJB:IIJE,1:IKT) & + *0.5/CSTURB%XCTD/PSQRT_TKE(IIJB:IIJE,1:IKT)*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WTH2_O_DDTDZ(IIJB:IIJE,IKE) @@ -1671,7 +1660,7 @@ SUBROUTINE M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_W2R REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE) @@ -1679,17 +1668,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT) & - /PD(IIJB:IIJE,1:D%NKT)*PDTDZ(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) & + /PD(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_TH2_W2R(IIJB:IIJE,1:D%NKT) = 0.75*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:D%NKT) & - *PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)/PTKE(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_TH2_W2R(IIJB:IIJE,1:IKT) = 0.75*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:IKT) & + *PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)/PTKE(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_TH2_W2R(IIJB:IIJE,IKB-1)=PM3_TH2_W2R(IIJB:IIJE,IKB) PM3_TH2_W2R(IIJB:IIJE,IKE+1)=PM3_TH2_W2R(IIJB:IIJE,IKE) @@ -1711,7 +1700,7 @@ SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_W2R_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1719,18 +1708,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)& - /PD(IIJB:IIJE,1:D%NKT)*PDTDZ(IIJB:IIJE,1:D%NKT)*(2.-PREDTH1(IIJB:IIJE,1:D%NKT)* & - (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)& + /PD(IIJB:IIJE,1:IKT)*PDTDZ(IIJB:IIJE,1:IKT)*(2.-PREDTH1(IIJB:IIJE,1:IKT)* & + (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,1:D%NKT) = 0.75*CSTURB%XCTV**2*PLM(IIJB:IIJE,1:D%NKT) *PLEPS(IIJB:IIJE,1:D%NKT) & - /PTKE(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.75*CSTURB%XCTV**2*PLM(IIJB:IIJE,1:IKT) *PLEPS(IIJB:IIJE,1:IKT) & + /PTKE(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_W2R_O_DDTDZ(IIJB:IIJE,IKE) @@ -1749,7 +1738,7 @@ SUBROUTINE M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2 REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WR2 REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE) @@ -1757,17 +1746,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)& - *PDTDZ(IIJB:IIJE,1:D%NKT))**2/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)& + *PDTDZ(IIJB:IIJE,1:IKT))**2/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_TH2_WR2(IIJB:IIJE,1:D%NKT) = 0.25*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:D%NKT)& - *PLEPS(IIJB:IIJE,1:D%NKT)/PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_TH2_WR2(IIJB:IIJE,1:IKT) = 0.25*CSTURB%XCTV**2*ZWORK2(IIJB:IIJE,1:IKT)& + *PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_TH2_WR2(IIJB:IIJE,IKB-1)=PM3_TH2_WR2(IIJB:IIJE,IKB) PM3_TH2_WR2(IIJB:IIJE,IKE+1)=PM3_TH2_WR2(IIJB:IIJE,IKE) @@ -1788,7 +1777,7 @@ SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WR2_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1796,18 +1785,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT))**2 & -*PDTDZ(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT)*(2.-PREDTH1(IIJB:IIJE,1:D%NKT) & -*(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT))**2 & +*PDTDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)*(2.-PREDTH1(IIJB:IIJE,1:IKT) & +*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = 0.25*CSTURB%XCTV**2*PLEPS(IIJB:IIJE,1:D%NKT) & - / PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.25*CSTURB%XCTV**2*PLEPS(IIJB:IIJE,1:IKT) & + / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WR2_O_DDTDZ(IIJB:IIJE,IKE) @@ -1827,7 +1816,7 @@ SUBROUTINE M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_TH2_WTHR REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE) @@ -1835,17 +1824,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT) & - * PDTDZ(IIJB:IIJE,1:D%NKT)*(1.+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) & + * PDTDZ(IIJB:IIJE,1:IKT)*(1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_TH2_WTHR(IIJB:IIJE,1:D%NKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:D%NKT) & - / PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_TH2_WTHR(IIJB:IIJE,1:IKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:IKT) & + / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_TH2_WTHR(IIJB:IIJE,IKB-1)=PM3_TH2_WTHR(IIJB:IIJE,IKB) PM3_TH2_WTHR(IIJB:IIJE,IKE+1)=PM3_TH2_WTHR(IIJB:IIJE,IKE) @@ -1866,7 +1855,7 @@ SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_TH2_WTHR_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1874,18 +1863,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT)* & - (1.+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) * (1. -PREDTH1(IIJB:IIJE,1:D%NKT)*& - (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT)* & + (1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) * (1. -PREDTH1(IIJB:IIJE,1:IKT)*& + (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:D%NKT) & - / PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.5*CSTURB%XCTV*PLEPS(IIJB:IIJE,1:IKT) & + / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_WTHR_O_DDTDZ(IIJB:IIJE,IKE) @@ -1903,7 +1892,7 @@ SUBROUTINE M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_WTHR REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE) @@ -1911,17 +1900,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (1.+PREDTH1(IIJB:IIJE,1:D%NKT))* & - (1.+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDTH1(IIJB:IIJE,1:IKT))* & + (1.+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_THR_WTHR(IIJB:IIJE,1:D%NKT) = 0.5*PLEPS(IIJB:IIJE,1:D%NKT)/PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD & - * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_THR_WTHR(IIJB:IIJE,1:IKT) = 0.5*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD & + * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_THR_WTHR(IIJB:IIJE,IKB-1)=PM3_THR_WTHR(IIJB:IIJE,IKB) PM3_THR_WTHR(IIJB:IIJE,IKE+1)=PM3_THR_WTHR(IIJB:IIJE,IKE) @@ -1941,7 +1930,7 @@ SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTHR_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE) @@ -1949,18 +1938,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PETHETA(IIJB:IIJE,1:D%NKT)*PBLL_O_E(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) & - *(1.+PREDR1(IIJB:IIJE,1:D%NKT))*(1.-(1.+PREDTH1(IIJB:IIJE,1:D%NKT)) & - *(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*PBLL_O_E(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) & + *(1.+PREDR1(IIJB:IIJE,1:IKT))*(1.-(1.+PREDTH1(IIJB:IIJE,1:IKT)) & + *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,1:D%NKT) = 0.5*PLEPS(IIJB:IIJE,1:D%NKT)/PSQRT_TKE(IIJB:IIJE,1:D%NKT) & - / CSTURB%XCTD * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,1:IKT) = 0.5*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT) & + / CSTURB%XCTD * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTHR_O_DDTDZ(IIJB:IIJE,IKE) @@ -1980,7 +1969,7 @@ SUBROUTINE M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_WTH2 REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE) @@ -1988,17 +1977,17 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (1.+PREDR1(IIJB:IIJE,1:D%NKT))*PBLL_O_E(IIJB:IIJE,1:D%NKT)* & - PETHETA(IIJB:IIJE,1:D%NKT)*PDRDZ(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDR1(IIJB:IIJE,1:IKT))*PBLL_O_E(IIJB:IIJE,1:IKT)* & + PETHETA(IIJB:IIJE,1:IKT)*PDRDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_THR_WTH2(IIJB:IIJE,1:D%NKT) = - 0.25*PLEPS(IIJB:IIJE,1:D%NKT) & - / PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_THR_WTH2(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT) & + / PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_THR_WTH2(IIJB:IIJE,IKB-1)=PM3_THR_WTH2(IIJB:IIJE,IKB) PM3_THR_WTH2(IIJB:IIJE,IKE+1)=PM3_THR_WTH2(IIJB:IIJE,IKE) @@ -2019,7 +2008,7 @@ SUBROUTINE D_M3_THR_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',0,ZHOOK_HANDLE) @@ -2027,19 +2016,19 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = -(1.+PREDR1(IIJB:IIJE,1:D%NKT))*(PBLL_O_E(IIJB:IIJE,1:D%NKT) & - *PETHETA(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT))**2& - *PDRDZ(IIJB:IIJE,1:D%NKT)& - *(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = -(1.+PREDR1(IIJB:IIJE,1:IKT))*(PBLL_O_E(IIJB:IIJE,1:IKT) & + *PETHETA(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT))**2& + *PDRDZ(IIJB:IIJE,1:IKT)& + *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 0.25*PLEPS(IIJB:IIJE,1:D%NKT) & - /PSQRT_TKE(IIJB:IIJE,1:D%NKT)/CSTURB%XCTD*CSTURB%XCTV**2 * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT) & + /PSQRT_TKE(IIJB:IIJE,1:IKT)/CSTURB%XCTD*CSTURB%XCTV**2 * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTH2_O_DDTDZ(IIJB:IIJE,IKE) @@ -2059,7 +2048,7 @@ SUBROUTINE D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDRDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE) @@ -2067,18 +2056,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PBLL_O_E(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT)& - *(-(1.+PREDR1(IIJB:IIJE,1:D%NKT))*PREDR1(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT)& - *(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))+(1.+2.*PREDR1(IIJB:IIJE,1:D%NKT))) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PBLL_O_E(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)& + *(-(1.+PREDR1(IIJB:IIJE,1:IKT))*PREDR1(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT)& + *(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))+(1.+2.*PREDR1(IIJB:IIJE,1:IKT))) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,1:D%NKT) = - 0.25*PLEPS(IIJB:IIJE,1:D%NKT)/PSQRT_TKE(IIJB:IIJE,1:D%NKT)& - / CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,1:IKT) = - 0.25*PLEPS(IIJB:IIJE,1:IKT)/PSQRT_TKE(IIJB:IIJE,1:IKT)& + / CSTURB%XCTD*CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKB) PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_WTH2_O_DDRDZ(IIJB:IIJE,IKE) @@ -2097,7 +2086,7 @@ SUBROUTINE M3_THR_W2TH(D,CSTURB,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,PM3_THR_W2TH) REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDRDZ REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PM3_THR_W2TH REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',0,ZHOOK_HANDLE) @@ -2105,16 +2094,16 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = (1.+PREDR1(IIJB:IIJE,1:D%NKT))*PDRDZ(IIJB:IIJE,1:D%NKT)/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = (1.+PREDR1(IIJB:IIJE,1:IKT))*PDRDZ(IIJB:IIJE,1:IKT)/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PM3_THR_W2TH(IIJB:IIJE,1:D%NKT) = - 0.75*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - / PTKE(IIJB:IIJE,1:D%NKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PM3_THR_W2TH(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PM3_THR_W2TH(IIJB:IIJE,IKB-1)=PM3_THR_W2TH(IIJB:IIJE,IKB) PM3_THR_W2TH(IIJB:IIJE,IKE+1)=PM3_THR_W2TH(IIJB:IIJE,IKE) @@ -2136,7 +2125,7 @@ SUBROUTINE D_M3_THR_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PETHETA REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDTDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',0,ZHOOK_HANDLE) @@ -2144,18 +2133,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = -PETHETA(IIJB:IIJE,1:D%NKT)*PBLL_O_E(IIJB:IIJE,1:D%NKT)*& -(1.+PREDR1(IIJB:IIJE,1:D%NKT))*PDRDZ(IIJB:IIJE,1:D%NKT)& -*(1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = -PETHETA(IIJB:IIJE,1:IKT)*PBLL_O_E(IIJB:IIJE,1:IKT)*& +(1.+PREDR1(IIJB:IIJE,1:IKT))*PDRDZ(IIJB:IIJE,1:IKT)& +*(1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 0.75*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - / PTKE(IIJB:IIJE,1:D%NKT) * CSTURB%XCTV**2 * ZWORK1(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV**2 * ZWORK1(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKB) PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_W2TH_O_DDTDZ(IIJB:IIJE,IKE) @@ -2174,7 +2163,7 @@ SUBROUTINE D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3 REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE REAL, DIMENSION(D%NIJT,D%NKT),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDRDZ REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array - INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE + INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE) @@ -2182,18 +2171,18 @@ IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE IIJB=D%NIJB - - -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = -(1.+PREDR1(IIJB:IIJE,1:D%NKT))*PREDR1(IIJB:IIJE,1:D%NKT)& -* (1.5+PREDTH1(IIJB:IIJE,1:D%NKT)+PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT)**2 & - +(1.+2.*PREDR1(IIJB:IIJE,1:D%NKT))/PD(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = -(1.+PREDR1(IIJB:IIJE,1:IKT))*PREDR1(IIJB:IIJE,1:IKT)& +* (1.5+PREDTH1(IIJB:IIJE,1:IKT)+PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT)**2 & + +(1.+2.*PREDR1(IIJB:IIJE,1:IKT))/PD(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,1:D%NKT) = - 0.75*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - / PTKE(IIJB:IIJE,1:D%NKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,1:IKT) = - 0.75*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + / PTKE(IIJB:IIJE,1:IKT) * CSTURB%XCTV * ZWORK2(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKB) PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_M3_THR_W2TH_O_DDRDZ(IIJB:IIJE,IKE) diff --git a/src/common/turb/mode_rmc01.F90 b/src/common/turb/mode_rmc01.F90 index 77d9807939a272c018d2c613f97102e113b2d021..5a980a92be0abf8fd509eba3bf3a572b9df28d89 100644 --- a/src/common/turb/mode_rmc01.F90 +++ b/src/common/turb/mode_rmc01.F90 @@ -78,7 +78,7 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PLEPS ! Dissipative length ! ------------------------------ ! INTEGER :: IKB,IKE ! first,last physical level -INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain +INTEGER :: IKTB,IKTE,IKT,IKA,IKU,IKL ! start, end of k loops in physical domain INTEGER :: JK,JIJ ! loop counter INTEGER :: IIJB,IIJE ! @@ -111,18 +111,22 @@ IKB=D%NKB IKE=D%NKE IIJB=D%NIJB IIJE=D%NIJE +IKT=D%NKT +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL ! ! altitude of mass points CALL MZF_PHY(D,PZZ,ZZZ) ! replace by height of mass points -DO JK=1,D%NKT +DO JK=1,IKT !$mnh_expand_array(JIJ=IIJB:IIJE) ZZZ(IIJB:IIJE,JK) = ZZZ(IIJB:IIJE,JK) - PZZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! fill upper level with physical value !$mnh_expand_array(JIJ=IIJB:IIJE) -ZZZ(IIJB:IIJE,D%NKU) = 2.*ZZZ(IIJB:IIJE,D%NKU-D%NKL) - ZZZ(IIJB:IIJE,D%NKU-2*D%NKL) +ZZZ(IIJB:IIJE,IKU) = 2.*ZZZ(IIJB:IIJE,IKU-IKL) - ZZZ(IIJB:IIJE,IKU-2*IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- @@ -131,7 +135,7 @@ ZZZ(IIJB:IIJE,D%NKU) = 2.*ZZZ(IIJB:IIJE,D%NKU-D%NKL) - ZZZ(IIJB:IIJE,D%NKU-2*D%N ! ------------- ! ! z/LMO -DO JK=1,D%NKT +DO JK=1,IKT !$mnh_expand_where(JIJ=IIJB:IIJE) WHERE (PLMO(IIJB:IIJE)==XUNDEF) ZZ_O_LMO(IIJB:IIJE,JK)=0. @@ -140,10 +144,10 @@ DO JK=1,D%NKT END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZZ_O_LMO(IIJB:IIJE,1:D%NKT) = MAX(ZZ_O_LMO(IIJB:IIJE,1:D%NKT),-10.) -ZZ_O_LMO(IIJB:IIJE,1:D%NKT) = MIN(ZZ_O_LMO(IIJB:IIJE,1:D%NKT), 10.) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZZ_O_LMO(IIJB:IIJE,1:IKT) = MAX(ZZ_O_LMO(IIJB:IIJE,1:IKT),-10.) +ZZ_O_LMO(IIJB:IIJE,1:IKT) = MIN(ZZ_O_LMO(IIJB:IIJE,1:IKT), 10.) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! ! MO function for stress @@ -167,13 +171,13 @@ SELECT CASE (HTURBLEN) CASE ('DELT','DEAR') CALL MXF_PHY(D,PDXX,ZWORK1) CALL MYF_PHY(D,PDYY,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZDH(IIJB:IIJE,1:D%NKT) = SQRT(ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZDH(IIJB:IIJE,1:IKT) = SQRT(ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL UPDATE_IIJU_PHY(D,ZZC) ! - DO JK=1,D%NKT + DO JK=1,IKT !$mnh_expand_array(JIJ=IIJB:IIJE) ZZC(IIJB:IIJE,JK) = 2.*MIN(ZPHIM(IIJB:IIJE,JK),1.)/CST%XKARMAN & * MAX( PDZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE) , & @@ -184,24 +188,24 @@ SELECT CASE (HTURBLEN) !* 4. factor controling the transition between SBL and free isotropic turb. (3D case) ! -------------------------------------------------------------------- ! - ZGAM(IIJB:IIJE,D%NKA) = 0. + ZGAM(IIJB:IIJE,IKA) = 0. DO JK=IKTB,IKTE !$mnh_expand_array(JIJ=IIJB:IIJE) ZGAM(IIJB:IIJE,JK) = 1. - EXP( -3.*(ZZZ(IIJB:IIJE,JK)-ZZZ(IIJB:IIJE,IKB))/(ZZC(IIJB:IIJE,JK)) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) !$mnh_expand_where(JIJ=IIJB:IIJE) - WHERE (ZGAM(IIJB:IIJE,JK-D%NKL)>ZGAM(IIJB:IIJE,JK) .OR. ZGAM(IIJB:IIJE,JK-D%NKL)>0.99 ) + WHERE (ZGAM(IIJB:IIJE,JK-IKL)>ZGAM(IIJB:IIJE,JK) .OR. ZGAM(IIJB:IIJE,JK-IKL)>0.99 ) ZGAM(IIJB:IIJE,JK) = 1. END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,D%NKU) = 1. - EXP( -3.*(ZZZ(IIJB:IIJE,D%NKU)-ZZZ(IIJB:IIJE,IKB))& - /(ZZC(IIJB:IIJE,D%NKU)) ) + ZGAM(IIJB:IIJE,IKU) = 1. - EXP( -3.*(ZZZ(IIJB:IIJE,IKU)-ZZZ(IIJB:IIJE,IKB))& + /(ZZC(IIJB:IIJE,IKU)) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) !$mnh_expand_where(JIJ=IIJB:IIJE) - WHERE (ZGAM(IIJB:IIJE,D%NKU-D%NKL)>ZGAM(IIJB:IIJE,D%NKU) .OR. ZGAM(IIJB:IIJE,D%NKU-D%NKL)>0.99 ) - ZGAM(IIJB:IIJE,D%NKU) = 1. + WHERE (ZGAM(IIJB:IIJE,IKU-IKL)>ZGAM(IIJB:IIJE,IKU) .OR. ZGAM(IIJB:IIJE,IKU-IKL)>0.99 ) + ZGAM(IIJB:IIJE,IKU) = 1. END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) ! @@ -213,8 +217,8 @@ SELECT CASE (HTURBLEN) ! CASE DEFAULT !* SBL depth is used - ZGAM(IIJB:IIJE,1:D%NKT) = 1. - ZGAM(IIJB:IIJE,D%NKA) = 0. + ZGAM(IIJB:IIJE,1:IKT) = 1. + ZGAM(IIJB:IIJE,IKA) = 0. DO JK=IKTB,IKTE !$mnh_expand_where(JIJ=IIJB:IIJE) WHERE(PSBL_DEPTH(IIJB:IIJE)>0.) @@ -222,18 +226,18 @@ SELECT CASE (HTURBLEN) END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) !$mnh_expand_where(JIJ=IIJB:IIJE) - WHERE (ZGAM(IIJB:IIJE,JK-D%NKL)>0.99 ) + WHERE (ZGAM(IIJB:IIJE,JK-IKL)>0.99 ) ZGAM(IIJB:IIJE,JK) = 1. END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) END DO !$mnh_expand_where(JIJ=IIJB:IIJE) WHERE(PSBL_DEPTH(IIJB:IIJE)>0.) - ZGAM(IIJB:IIJE,D%NKU) = TANH( (ZZZ(IIJB:IIJE,D%NKU)-ZZZ(IIJB:IIJE,IKB))/PSBL_DEPTH(IIJB:IIJE) ) + ZGAM(IIJB:IIJE,IKU) = TANH( (ZZZ(IIJB:IIJE,IKU)-ZZZ(IIJB:IIJE,IKB))/PSBL_DEPTH(IIJB:IIJE) ) END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) !$mnh_expand_where(JIJ=IIJB:IIJE) - WHERE (ZGAM(IIJB:IIJE,D%NKU-D%NKL)>0.99 ) + WHERE (ZGAM(IIJB:IIJE,IKU-IKL)>0.99 ) ZGAM(IIJB:IIJE,JK) = 1. END WHERE !$mnh_end_expand_where(JIJ=IIJB:IIJE) @@ -245,45 +249,45 @@ END SELECT !* 6. Modification of the mixing length ! --------------------------------- ! -DO JK=1,D%NKT +DO JK=1,IKT !$mnh_expand_array(JIJ=IIJB:IIJE) ZL(IIJB:IIJE,JK) = CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS & * ZZZ(IIJB:IIJE,JK)*PDIRCOSZW(IIJB:IIJE)/(ZPHIM(IIJB:IIJE,JK)**2*SQRT(ZPHIE(IIJB:IIJE,JK))) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PLK(IIJB:IIJE,1:D%NKT)=(1.-ZGAM(IIJB:IIJE,1:D%NKT))*ZL(IIJB:IIJE,1:D%NKT) & - +ZGAM(IIJB:IIJE,1:D%NKT)*PLK(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PLK(IIJB:IIJE,1:IKT)=(1.-ZGAM(IIJB:IIJE,1:IKT))*ZL(IIJB:IIJE,1:IKT) & + +ZGAM(IIJB:IIJE,1:IKT)*PLK(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! -PLK(IIJB:IIJE,D%NKA) = PLK(IIJB:IIJE,IKB) -PLK(IIJB:IIJE,D%NKU) = PLK(IIJB:IIJE,IKE) +PLK(IIJB:IIJE,IKA) = PLK(IIJB:IIJE,IKB) +PLK(IIJB:IIJE,IKU) = PLK(IIJB:IIJE,IKE) !------------------------------------------------------------------------------- ! !* 7. Modification of the dissipative length ! -------------------------------------- ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZL(IIJB:IIJE,1:D%NKT) = ZL(IIJB:IIJE,1:D%NKT) * (CSTURB%XALPSBL**(3./2.)*CST%XKARMAN*CSTURB%XCED) & +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT) * (CSTURB%XALPSBL**(3./2.)*CST%XKARMAN*CSTURB%XCED) & / (CST%XKARMAN/SQRT(CSTURB%XALPSBL)/CSTURB%XCMFS) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE (ZZ_O_LMO(IIJB:IIJE,1:D%NKT)<0.) - ZL(IIJB:IIJE,1:D%NKT) = ZL(IIJB:IIJE,1:D%NKT)/(1.-1.9*ZZ_O_LMO(IIJB:IIJE,1:D%NKT)) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE (ZZ_O_LMO(IIJB:IIJE,1:IKT)<0.) + ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT)/(1.-1.9*ZZ_O_LMO(IIJB:IIJE,1:IKT)) ELSEWHERE - ZL(IIJB:IIJE,1:D%NKT) = ZL(IIJB:IIJE,1:D%NKT)/(1.-0.3*SQRT(ZZ_O_LMO(IIJB:IIJE,1:D%NKT))) + ZL(IIJB:IIJE,1:IKT) = ZL(IIJB:IIJE,1:IKT)/(1.-0.3*SQRT(ZZ_O_LMO(IIJB:IIJE,1:IKT))) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PLEPS(IIJB:IIJE,1:D%NKT)=(1.-ZGAM(IIJB:IIJE,1:D%NKT))*ZL(IIJB:IIJE,1:D%NKT) & - +ZGAM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PLEPS(IIJB:IIJE,1:IKT)=(1.-ZGAM(IIJB:IIJE,1:IKT))*ZL(IIJB:IIJE,1:IKT) & + +ZGAM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! -PLEPS(IIJB:IIJE,D%NKA) = PLEPS(IIJB:IIJE,IKB) -PLEPS(IIJB:IIJE,D%NKU) = PLEPS(IIJB:IIJE,IKE) +PLEPS(IIJB:IIJE,IKA) = PLEPS(IIJB:IIJE,IKB) +PLEPS(IIJB:IIJE,IKU) = PLEPS(IIJB:IIJE,IKE) !------------------------------------------------------------------------------- ! IF (LHOOK) CALL DR_HOOK('RMC01',1,ZHOOK_HANDLE) diff --git a/src/common/turb/mode_sbl_depth.F90 b/src/common/turb/mode_sbl_depth.F90 index 16257531992ff99ef286d2c7247200249944ed3a..f9312586278142cdd23407ea05538d4d31f3b78c 100644 --- a/src/common/turb/mode_sbl_depth.F90 +++ b/src/common/turb/mode_sbl_depth.F90 @@ -71,7 +71,7 @@ REAL, DIMENSION(D%NIJT), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height ! ! INTEGER :: JLOOP,JIJ,JK ! loop counter -INTEGER :: IKB,IKE,IIJB,IIJE ! index value for the Beginning +INTEGER :: IKB,IKE,IIJB,IIJE,IKT ! index value for the Beginning REAL, DIMENSION(D%NIJT) :: ZQ0 ! surface buoyancy flux REAL, DIMENSION(D%NIJT) :: ZWU ! surface friction u'w' REAL, DIMENSION(D%NIJT) :: ZWV ! surface friction v'w' @@ -92,7 +92,8 @@ IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',0,ZHOOK_HANDLE) IKB=D%NKTB IKE=D%NKTE IIJE=D%NIJE -IIJB=D%NIJB +IIJB=D%NIJB +IKT=D%NKT ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZWU(IIJB:IIJE) = PFLXU(IIJB:IIJE,IKB) @@ -106,9 +107,9 @@ ZUSTAR2(IIJB:IIJE) = SQRT(ZWU(IIJB:IIJE)**2+ZWV(IIJB:IIJE)**2) ! !* BL and SBL diagnosed with friction criteria ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWIND(IIJB:IIJE,1:D%NKT)=SQRT(PFLXU(IIJB:IIJE,1:D%NKT)**2+PFLXV(IIJB:IIJE,1:D%NKT)**2) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWIND(IIJB:IIJE,1:IKT)=SQRT(PFLXU(IIJB:IIJE,1:IKT)**2+PFLXV(IIJB:IIJE,1:IKT)**2) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BL_DEPTH_DIAG(D,ZUSTAR2,PZZ(:,IKB),ZWIND,PZZ,CSTURB%XFTOP_O_FSURF,ZSBL_DYN) !$mnh_expand_array(JIJ=IIJB:IIJE) ZSBL_DYN(IIJB:IIJE) = CSTURB%XSBL_O_BL * ZSBL_DYN(IIJB:IIJE) diff --git a/src/common/turb/mode_sbl_phy.F90 b/src/common/turb/mode_sbl_phy.F90 index a45b6485a35706a1397703c31ae0b7d179c21d96..c3d8be4f0a876451e0267d88c4a3ee535dd5ac7c 100644 --- a/src/common/turb/mode_sbl_phy.F90 +++ b/src/common/turb/mode_sbl_phy.F90 @@ -58,20 +58,21 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIM ! REAL(KIND=JPRB) :: ZHOOK_HANDLE -INTEGER :: JIJ,JK,IIJB,IIJE +INTEGER :: JIJ,JK,IIJB,IIJE,IKT ! IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM',0,ZHOOK_HANDLE) ! IIJE=D%NIJE IIJB=D%NIJB +IKT=D%NKT ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE ( PZ_O_LMO(IIJB:IIJE,1:D%NKT) < 0. ) - BUSINGERPHIM(IIJB:IIJE,1:D%NKT) = (1.-15.*PZ_O_LMO(IIJB:IIJE,1:D%NKT))**(-0.25) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. ) + BUSINGERPHIM(IIJB:IIJE,1:IKT) = (1.-15.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(-0.25) ELSEWHERE - BUSINGERPHIM(IIJB:IIJE,1:D%NKT) = 1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:D%NKT) + BUSINGERPHIM(IIJB:IIJE,1:IKT) = 1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM',1,ZHOOK_HANDLE) END SUBROUTINE BUSINGER_PHIM ! @@ -88,20 +89,21 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIH ! REAL(KIND=JPRB) :: ZHOOK_HANDLE -INTEGER :: JIJ,JK,IIJB,IIJE +INTEGER :: JIJ,JK,IIJB,IIJE,IKT ! IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH',0,ZHOOK_HANDLE) ! IIJE=D%NIJE IIJB=D%NIJB +IKT=D%NKT ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE ( PZ_O_LMO(IIJB:IIJE,1:D%NKT) < 0. ) - BUSINGERPHIH(IIJB:IIJE,1:D%NKT) = 0.74 * (1.-9.*PZ_O_LMO(IIJB:IIJE,1:D%NKT))**(-0.5) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. ) + BUSINGERPHIH(IIJB:IIJE,1:IKT) = 0.74 * (1.-9.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(-0.5) ELSEWHERE - BUSINGERPHIH(IIJB:IIJE,1:D%NKT) = 0.74 + 4.7 * PZ_O_LMO(IIJB:IIJE,1:D%NKT) + BUSINGERPHIH(IIJB:IIJE,1:IKT) = 0.74 + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH',1,ZHOOK_HANDLE) END SUBROUTINE BUSINGER_PHIH ! @@ -119,21 +121,22 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PZ_O_LMO REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: BUSINGERPHIE ! REAL(KIND=JPRB) :: ZHOOK_HANDLE -INTEGER :: JIJ,JK,IIJB,IIJE +INTEGER :: JIJ,JK,IIJB,IIJE,IKT ! IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE',0,ZHOOK_HANDLE) ! IIJE=D%NIJE IIJB=D%NIJB +IKT=D%NKT ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE ( PZ_O_LMO(IIJB:IIJE,1:D%NKT) < 0. ) - BUSINGERPHIE(IIJB:IIJE,1:D%NKT)=(1.+(-PZ_O_LMO(IIJB:IIJE,1:D%NKT))**(2./3.)/CSTURB%XALPSBL)& - * (1.-15.*PZ_O_LMO(IIJB:IIJE,1:D%NKT))**(0.5) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE ( PZ_O_LMO(IIJB:IIJE,1:IKT) < 0. ) + BUSINGERPHIE(IIJB:IIJE,1:IKT)=(1.+(-PZ_O_LMO(IIJB:IIJE,1:IKT))**(2./3.)/CSTURB%XALPSBL)& + * (1.-15.*PZ_O_LMO(IIJB:IIJE,1:IKT))**(0.5) ELSEWHERE - BUSINGERPHIE(IIJB:IIJE,1:D%NKT) = 1./(1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:D%NKT))**2 + BUSINGERPHIE(IIJB:IIJE,1:IKT) = 1./(1. + 4.7 * PZ_O_LMO(IIJB:IIJE,1:IKT))**2 END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE',1,ZHOOK_HANDLE) END SUBROUTINE BUSINGER_PHIE ! @@ -153,13 +156,14 @@ SUBROUTINE LMO(D,CST,PUSTAR,PTHETA,PRV,PSFTH,PSFRV,PLMO) ! REAL, DIMENSION(D%NIJT) :: ZTHETAV, ZQ0 REAL :: ZEPS - INTEGER :: IIJB,IIJE, JIJ + INTEGER :: IIJB,IIJE, JIJ,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO',0,ZHOOK_HANDLE) ! IIJE=D%NIJE IIJB=D%NIJB + IKT=D%NKT ZEPS=(CST%XRV-CST%XRD)/CST%XRD ! !$mnh_expand_array(JIJ=IIJB:IIJE) diff --git a/src/common/turb/mode_thl_rt_from_th_r_mf.F90 b/src/common/turb/mode_thl_rt_from_th_r_mf.F90 index 055c6b5ee3c78862868a27b9a63fb61fcf28ef45..6c8aa463a23ef4eae31ab6ad909ca8ae77a90b49 100644 --- a/src/common/turb/mode_thl_rt_from_th_r_mf.F90 +++ b/src/common/turb/mode_thl_rt_from_th_r_mf.F90 @@ -78,63 +78,70 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRT ! total non precip. wate !---------------------------------------------------------------------------- REAL, DIMENSION(D%NIJT,D%NKT) :: ZCP, ZT REAL, DIMENSION(D%NIJT,D%NKT) :: ZLVOCPEXN, ZLSOCPEXN -INTEGER :: JRR, JI, JK +INTEGER :: JRR, JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT REAL(KIND=JPRB) :: ZHOOK_HANDLE !---------------------------------------------------------------------------- ! ! IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',0,ZHOOK_HANDLE) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +! +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !temperature -ZT(D%NIJB:D%NIJE,:) = PTH(D%NIJB:D%NIJE,:) * PEXN(D%NIJB:D%NIJE,:) +ZT(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) * PEXN(IIJB:IIJE,:) !Cp -ZCP(D%NIJB:D%NIJE,:)=CST%XCPD -IF (KRR > 0) ZCP(D%NIJB:D%NIJE,:) = ZCP(D%NIJB:D%NIJE,:) + CST%XCPV * PR(D%NIJB:D%NIJE,:,1) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +ZCP(IIJB:IIJE,:)=CST%XCPD +IF (KRR > 0) ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCPV * PR(IIJB:IIJE,:,1) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) DO JRR = 2,1+KRRL ! loop on the liquid components - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZCP(D%NIJB:D%NIJE,:) = ZCP(D%NIJB:D%NIJE,:) + CST%XCL * PR(D%NIJB:D%NIJE,:,JRR) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCL * PR(IIJB:IIJE,:,JRR) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - ZCP(D%NIJB:D%NIJE,:) = ZCP(D%NIJB:D%NIJE,:) + CST%XCI * PR(D%NIJB:D%NIJE,:,JRR) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCP(IIJB:IIJE,:) = ZCP(IIJB:IIJE,:) + CST%XCI * PR(IIJB:IIJE,:,JRR) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO IF ( KRRL >= 1 ) THEN IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !ZLVOCPEXN and ZLSOCPEXN - ZLVOCPEXN(D%NIJB:D%NIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(D%NIJB:D%NIJE,:)-CST%XTT) ) & - &/ ZCP(D%NIJB:D%NIJE,:) / PEXN(D%NIJB:D%NIJE,:) - ZLSOCPEXN(D%NIJB:D%NIJE,:)=(CST%XLSTT + (CST%XCPV-CST%XCI) * (ZT(D%NIJB:D%NIJE,:)-CST%XTT) ) & - &/ ZCP(D%NIJB:D%NIJE,:) / PEXN(D%NIJB:D%NIJE,:) + ZLVOCPEXN(IIJB:IIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(IIJB:IIJE,:)-CST%XTT) ) & + &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:) + ZLSOCPEXN(IIJB:IIJE,:)=(CST%XLSTT + (CST%XCPV-CST%XCI) * (ZT(IIJB:IIJE,:)-CST%XTT) ) & + &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:) ! Rnp - PRT(D%NIJB:D%NIJE,:) = PR(D%NIJB:D%NIJE,:,1) + PR(D%NIJB:D%NIJE,:,2) + PR(D%NIJB:D%NIJE,:,4) + PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1) + PR(IIJB:IIJE,:,2) + PR(IIJB:IIJE,:,4) ! Theta_l - PTHL(D%NIJB:D%NIJE,:) = PTH(D%NIJB:D%NIJE,:) - ZLVOCPEXN(D%NIJB:D%NIJE,:) * PR(D%NIJB:D%NIJE,:,2) & - - ZLSOCPEXN(D%NIJB:D%NIJE,:) * PR(D%NIJB:D%NIJE,:,4) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) - ZLVOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,2) & + - ZLSOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,4) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !ZLVOCPEXN - ZLVOCPEXN(D%NIJB:D%NIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(D%NIJB:D%NIJE,:)-CST%XTT) ) & - &/ ZCP(D%NIJB:D%NIJE,:) / PEXN(D%NIJB:D%NIJE,:) + ZLVOCPEXN(IIJB:IIJE,:)=(CST%XLVTT + (CST%XCPV-CST%XCL) * (ZT(IIJB:IIJE,:)-CST%XTT) ) & + &/ ZCP(IIJB:IIJE,:) / PEXN(IIJB:IIJE,:) ! Rnp - PRT(D%NIJB:D%NIJE,:) = PR(D%NIJB:D%NIJE,:,1) + PR(D%NIJB:D%NIJE,:,2) + PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1) + PR(IIJB:IIJE,:,2) ! Theta_l - PTHL(D%NIJB:D%NIJE,:) = PTH(D%NIJB:D%NIJE,:) - ZLVOCPEXN(D%NIJB:D%NIJE,:) * PR(D%NIJB:D%NIJE,:,2) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) - ZLVOCPEXN(IIJB:IIJE,:) * PR(IIJB:IIJE,:,2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Rnp = rv - PRT(D%NIJB:D%NIJE,:) = PR(D%NIJB:D%NIJE,:,1) + PRT(IIJB:IIJE,:) = PR(IIJB:IIJE,:,1) ! Theta_l = Theta - PTHL(D%NIJB:D%NIJE,:) = PTH(D%NIJB:D%NIJE,:) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + PTHL(IIJB:IIJE,:) = PTH(IIJB:IIJE,:) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',1,ZHOOK_HANDLE) END SUBROUTINE THL_RT_FROM_TH_R_MF diff --git a/src/common/turb/mode_tke_eps_sources.F90 b/src/common/turb/mode_tke_eps_sources.F90 index c17f91d839c6e9b5d5c9177d4991b0fdec7ca989..516d4e6896a51f3b007965a5f8cae6dae742175b 100644 --- a/src/common/turb/mode_tke_eps_sources.F90 +++ b/src/common/turb/mode_tke_eps_sources.F90 @@ -216,7 +216,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & LOGICAL,DIMENSION(D%NIJT,D%NKT) :: GTKENEG ! 3D mask .T. if TKE < CSTURB%XTKEMIN -INTEGER :: IIJB,IIJE,IKB,IKE ! Index value for the mass points of the domain +INTEGER :: IIJB,IIJE,IKB,IKE,IKT,IKA,IKL ! Index value for the mass points of the domain ! TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange INTEGER :: IINFO_ll ! return code of parallel routine @@ -236,11 +236,14 @@ IKB=D%NKB IKE=D%NKE IIJB=D%NIJB IIJE=D%NIJE +IKT=D%NKT +IKA=D%NKA +IKL=D%NKL ! ! compute the effective diffusion coefficient at the mass point -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZKEFF(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !---------------------------------------------------------------------------- ! @@ -253,9 +256,9 @@ ZKEFF(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT ! Complete the sources of TKE with the horizontal turbulent explicit transport ! IF (TURBN%CTURBDIM=='3DIM') THEN - ZTR(IIJB:IIJE,1:D%NKT)=PTRH(IIJB:IIJE,1:D%NKT) + ZTR(IIJB:IIJE,1:IKT)=PTRH(IIJB:IIJE,1:IKT) ELSE - ZTR(IIJB:IIJE,1:D%NKT)=0. + ZTR(IIJB:IIJE,1:IKT)=0. END IF ! ! @@ -270,7 +273,7 @@ IF (OOCEAN) THEN ELSE ! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB) !$mnh_expand_array(JIJ=IIJB:IIJE) - PDP(IIJB:IIJE,IKB) = PDP(IIJB:IIJE,IKB) * (1. + PDZZ(IIJB:IIJE,IKB+D%NKL)/PDZZ(IIJB:IIJE,IKB)) + PDP(IIJB:IIJE,IKB) = PDP(IIJB:IIJE,IKB) * (1. + PDZZ(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -280,13 +283,13 @@ END IF CALL MZM_PHY(D,ZKEFF,ZMWORK1) CALL MZM_PHY(D,PRHODJ,ZMWORK2) ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZFLX(IIJB:IIJE,1:D%NKT) = CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) / PLEPS(IIJB:IIJE,1:D%NKT) -ZSOURCE(IIJB:IIJE,1:D%NKT) = ( PRTKES(IIJB:IIJE,1:D%NKT) + PRTKEMS(IIJB:IIJE,1:D%NKT) ) & - / PRHODJ(IIJB:IIJE,1:D%NKT) - PTKEM(IIJB:IIJE,1:D%NKT) / PTSTEP & - + PDP(IIJB:IIJE,1:D%NKT) + PTP(IIJB:IIJE,1:D%NKT) + ZTR(IIJB:IIJE,1:D%NKT) & - - PEXPL * ZFLX(IIJB:IIJE,1:D%NKT) * PTKEM(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZFLX(IIJB:IIJE,1:IKT) = CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) +ZSOURCE(IIJB:IIJE,1:IKT) = ( PRTKES(IIJB:IIJE,1:IKT) + PRTKEMS(IIJB:IIJE,1:IKT) ) & + / PRHODJ(IIJB:IIJE,1:IKT) - PTKEM(IIJB:IIJE,1:IKT) / PTSTEP & + + PDP(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) + ZTR(IIJB:IIJE,1:IKT) & + - PEXPL * ZFLX(IIJB:IIJE,1:IKT) * PTKEM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !* 2.2 implicit vertical TKE transport ! @@ -302,10 +305,10 @@ END IF ! Compute the vector giving the elements just under the diagonal for the ! matrix inverted in TRIDIAG ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZA(IIJB:IIJE,1:D%NKT) = - PTSTEP * CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:D%NKT) & - * ZMWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZA(IIJB:IIJE,1:IKT) = - PTSTEP * CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:IKT) & + * ZMWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Compute TKE at time t+deltat: ( stored in ZRES ) ! @@ -315,10 +318,10 @@ CALL GET_HALO_PHY(D,ZRES) !* diagnose the dissipation ! IF (ODIAG_IN_RUN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PCURRENT_TKE_DISS(IIJB:IIJE,1:D%NKT) = ZFLX(IIJB:IIJE,1:D%NKT) * PTKEM(IIJB:IIJE,1:D%NKT) & - *(PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PCURRENT_TKE_DISS(IIJB:IIJE,1:IKT) = ZFLX(IIJB:IIJE,1:IKT) * PTKEM(IIJB:IIJE,1:IKT) & + *(PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL ADD2DFIELD_ll(TZFIELDDISS_ll, PCURRENT_TKE_DISS, 'TKE_EPS_SOURCES::PCURRENT_TKE_DISS' ) CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll) @@ -328,18 +331,18 @@ ENDIF ! TKE must be greater than its minimum value ! CL : Now done at the end of the time step in ADVECTION_METSV for MesoNH IF(HPROGRAM/='MESONH') THEN - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - GTKENEG(IIJB:IIJE,1:D%NKT) = ZRES(IIJB:IIJE,1:D%NKT) <= CSTURB%XTKEMIN - WHERE ( GTKENEG(IIJB:IIJE,1:D%NKT) ) - ZRES(IIJB:IIJE,1:D%NKT) = CSTURB%XTKEMIN + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + GTKENEG(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) <= CSTURB%XTKEMIN + WHERE ( GTKENEG(IIJB:IIJE,1:IKT) ) + ZRES(IIJB:IIJE,1:IKT) = CSTURB%XTKEMIN END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PTDISS(IIJB:IIJE,1:D%NKT) = - ZFLX(IIJB:IIJE,1:D%NKT)*(PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTDISS(IIJB:IIJE,1:IKT) = - ZFLX(IIJB:IIJE,1:IKT)*(PEXPL*PTKEM(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF ( TLES%LLES_CALL .OR. & (TURBN%LTURB_DIAG .AND. TPFILE%LOPENED) ) THEN @@ -347,30 +350,30 @@ IF ( TLES%LLES_CALL .OR. & ! Compute the cartesian vertical flux of TKE in ZFLX ! CALL MZM_PHY(D,ZKEFF,ZMWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZDWORK1(IIJB:IIJE,1:D%NKT) = TURBN%XIMPL * ZRES(IIJB:IIJE,1:D%NKT) + PEXPL * PTKEM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZDWORK1(IIJB:IIJE,1:IKT) = TURBN%XIMPL * ZRES(IIJB:IIJE,1:IKT) + PEXPL * PTKEM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZDWORK1,ZDWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLX(IIJB:IIJE,1:D%NKT) = - CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:D%NKT) & - * ZDWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLX(IIJB:IIJE,1:IKT) = - CSTURB%XCET * ZMWORK1(IIJB:IIJE,1:IKT) & + * ZDWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ZFLX(IIJB:IIJE,IKB) = 0. - ZFLX(IIJB:IIJE,D%NKA) = 0. + ZFLX(IIJB:IIJE,IKA) = 0. ! ! Compute the whole turbulent TRansport of TKE: ! CALL MZM_PHY(D,PRHODJ,ZMWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZMWORK2(IIJB:IIJE,1:D%NKT) = ZMWORK1(IIJB:IIJE,1:D%NKT) * ZFLX(IIJB:IIJE,1:D%NKT) & - / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZMWORK2(IIJB:IIJE,1:IKT) = ZMWORK1(IIJB:IIJE,1:IKT) * ZFLX(IIJB:IIJE,1:IKT) & + / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZF_PHY(D,ZMWORK2,ZDWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZTR(IIJB:IIJE,1:D%NKT)= ZTR(IIJB:IIJE,1:D%NKT) - ZDWORK1(IIJB:IIJE,1:D%NKT) & - /PRHODJ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZTR(IIJB:IIJE,1:IKT)= ZTR(IIJB:IIJE,1:IKT) - ZDWORK1(IIJB:IIJE,1:IKT) & + /PRHODJ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Storage in the LES configuration ! @@ -386,22 +389,22 @@ END IF ! IF (BUCONF%LBUDGET_TKE) THEN ! Dynamical production - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZMWORK1(IIJB:IIJE,1:D%NKT) = PDP(IIJB:IIJE,1:D%NKT) * PRHODJ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZMWORK1(IIJB:IIJE,1:IKT) = PDP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'DP', ZMWORK1) ! ! Thermal production - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZMWORK1(IIJB:IIJE,1:D%NKT) = PTP(IIJB:IIJE,1:D%NKT) * PRHODJ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZMWORK1(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'TP', ZMWORK1) ! ! Dissipation - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZMWORK1(IIJB:IIJE,1:D%NKT) = -CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:D%NKT))/PLEPS(IIJB:IIJE,1:D%NKT) * & - (PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT))*PRHODJ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZMWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT))/PLEPS(IIJB:IIJE,1:IKT) * & + (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT))*PRHODJ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TKE), 'DISS',ZMWORK1) END IF ! @@ -409,32 +412,32 @@ END IF ! with the removal of the advection part for MesoNH !Should be in IF LBUDGET_TKE only. Was removed out for a correct comput. of PTDIFF in case of LBUDGET_TKE=F in AROME -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 IF (BUCONF%LBUDGET_TKE) THEN -PRTKES(IIJB:IIJE,1:D%NKT) = PRTKES(IIJB:IIJE,1:D%NKT) + PDP(IIJB:IIJE,1:D%NKT) * PRHODJ(IIJB:IIJE,1:D%NKT) -PRTKES(IIJB:IIJE,1:D%NKT) = PRTKES(IIJB:IIJE,1:D%NKT) + PTP(IIJB:IIJE,1:D%NKT) * PRHODJ(IIJB:IIJE,1:D%NKT) -PRTKES(IIJB:IIJE,1:D%NKT) = PRTKES(IIJB:IIJE,1:D%NKT) - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) / PLEPS(IIJB:IIJE,1:D%NKT) * & - (PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT)) * PRHODJ(IIJB:IIJE,1:D%NKT) +PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PDP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) +PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) +PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) * & + (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) * PRHODJ(IIJB:IIJE,1:IKT) END IF #else -PRTKES(IIJB:IIJE,1:D%NKT) = PRTKES(IIJB:IIJE,1:D%NKT) + PRHODJ(IIJB:IIJE,1:D%NKT) * & - ( PDP(IIJB:IIJE,1:D%NKT) + PTP(IIJB:IIJE,1:D%NKT) & - - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) / PLEPS(IIJB:IIJE,1:D%NKT) & - * ( PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT) ) ) +PRTKES(IIJB:IIJE,1:IKT) = PRTKES(IIJB:IIJE,1:IKT) + PRHODJ(IIJB:IIJE,1:IKT) * & + ( PDP(IIJB:IIJE,1:IKT) + PTP(IIJB:IIJE,1:IKT) & + - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) & + * ( PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) ) ) #endif ! -PTDIFF(IIJB:IIJE,1:D%NKT) = ZRES(IIJB:IIJE,1:D%NKT) / PTSTEP - PRTKES(IIJB:IIJE,1:D%NKT)& - /PRHODJ(IIJB:IIJE,1:D%NKT) & - & - PDP(IIJB:IIJE,1:D%NKT)- PTP(IIJB:IIJE,1:D%NKT) - PTDISS(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +PTDIFF(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) / PTSTEP - PRTKES(IIJB:IIJE,1:IKT)& + /PRHODJ(IIJB:IIJE,1:IKT) & + & - PDP(IIJB:IIJE,1:IKT)- PTP(IIJB:IIJE,1:IKT) - PTDISS(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (BUCONF%LBUDGET_TKE) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TKE), 'TR', PRTKES) ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PRTKES(IIJB:IIJE,1:D%NKT) = ZRES(IIJB:IIJE,1:D%NKT) * PRHODJ(IIJB:IIJE,1:D%NKT) / PTSTEP & - - PRTKEMS(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRTKES(IIJB:IIJE,1:IKT) = ZRES(IIJB:IIJE,1:IKT) * PRHODJ(IIJB:IIJE,1:IKT) / PTSTEP & + - PRTKEMS(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! stores the whole turbulent transport ! @@ -445,12 +448,12 @@ IF (BUCONF%LBUDGET_TKE) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TKE), 'TR' !* 3. COMPUTE THE DISSIPATIVE HEATING ! ------------------------------- ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) + & - CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) / PLEPS(IIJB:IIJE,1:D%NKT) * & - (PEXPL*PTKEM(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT)) & - * PRHODJ(IIJB:IIJE,1:D%NKT) * PCOEF_DISS(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + & + CSTURB%XCED * SQRT(PTKEM(IIJB:IIJE,1:IKT)) / PLEPS(IIJB:IIJE,1:IKT) * & + (PEXPL*PTKEM(IIJB:IIJE,1:IKT) + TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT)) & + * PRHODJ(IIJB:IIJE,1:IKT) * PCOEF_DISS(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !---------------------------------------------------------------------------- ! !* 4. STORES SOME DIAGNOSTICS @@ -458,15 +461,15 @@ PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) + & ! IF(PRESENT(PTR)) PTR=ZTR IF(PRESENT(PDISS)) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PDISS(IIJB:IIJE,1:D%NKT) = -CSTURB%XCED * (PTKEM(IIJB:IIJE,1:D%NKT)**1.5) / PLEPS(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PDISS(IIJB:IIJE,1:IKT) = -CSTURB%XCED * (PTKEM(IIJB:IIJE,1:IKT)**1.5) / PLEPS(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF(PRESENT(PEDR)) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PEDR(IIJB:IIJE,1:D%NKT) = CSTURB%XCED * (PTKEM(IIJB:IIJE,1:D%NKT)**1.5) / PLEPS(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PEDR(IIJB:IIJE,1:IKT) = CSTURB%XCED * (PTKEM(IIJB:IIJE,1:IKT)**1.5) / PLEPS(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN diff --git a/src/common/turb/mode_tm06.F90 b/src/common/turb/mode_tm06.F90 index dd272fc060d7f711962cb721d2d58bd24ac85d4f..d5f9ea2de34a14418c499634b7f78224ac6be80d 100644 --- a/src/common/turb/mode_tm06.F90 +++ b/src/common/turb/mode_tm06.F90 @@ -74,7 +74,7 @@ REAL, DIMENSION(D%NIJT) :: ZTSTAR ! normalized temperature velocity w ! INTEGER :: JK,JIJ ! loop counter INTEGER :: IIJE,IIJB -INTEGER :: IKTB,IKTE,IKB,IKE,IKT ! vertical levels +INTEGER :: IKTB,IKTE,IKB,IKE,IKT,IKU ! vertical levels !---------------------------------------------------------------------------- ! REAL(KIND=JPRB) :: ZHOOK_HANDLE @@ -86,6 +86,7 @@ IKT=D%NKT IKE=D%NKE IIJE=D%NIJE IIJB=D%NIJB +IKU=D%NKU ! ! !* w* and T* @@ -103,9 +104,9 @@ END WHERE ! !* normalized height ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZZ_O_H(IIJB:IIJE,1:D%NKT) = XUNDEF -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZZ_O_H(IIJB:IIJE,1:IKT) = XUNDEF +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) DO JK=1,IKT !$mnh_expand_where(JIJ=IIJB:IIJE) WHERE (PBL_DEPTH(IIJB:IIJE)/=XUNDEF) @@ -116,12 +117,12 @@ END DO ! !* w'th'2 ! -PMTH2(IIJB:IIJE,1:D%NKT) = 0. -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) < 0.95 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF) - PMTH2(IIJB:IIJE,1:D%NKT) = 4.*(MAX(ZZ_O_H(IIJB:IIJE,1:D%NKT),0.))**0.4*(ZZ_O_H(IIJB:IIJE,1:D%NKT)-0.95)**2 +PMTH2(IIJB:IIJE,1:IKT) = 0. +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE(ZZ_O_H(IIJB:IIJE,1:IKT) < 0.95 .AND. ZZ_O_H(IIJB:IIJE,1:IKT)/=XUNDEF) + PMTH2(IIJB:IIJE,1:IKT) = 4.*(MAX(ZZ_O_H(IIJB:IIJE,1:IKT),0.))**0.4*(ZZ_O_H(IIJB:IIJE,1:IKT)-0.95)**2 END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) PMTH2(IIJB:IIJE,JK) = PMTH2(IIJB:IIJE,JK) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) @@ -129,19 +130,19 @@ DO JK=IKTB+1,IKTE-1 END DO !$mnh_expand_array(JIJ=IIJB:IIJE) PMTH2(IIJB:IIJE,IKE)=PMTH2(IIJB:IIJE,IKE) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) -PMTH2(IIJB:IIJE,D%NKU)=PMTH2(IIJB:IIJE,D%NKU) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) +PMTH2(IIJB:IIJE,IKU)=PMTH2(IIJB:IIJE,IKU) * ZTSTAR(IIJB:IIJE)**2*ZWSTAR(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! !* w'2th' ! -PMWTH(IIJB:IIJE,1:D%NKT) = 0. -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE(ZZ_O_H(IIJB:IIJE,1:D%NKT) <0.9 .AND. ZZ_O_H(IIJB:IIJE,1:D%NKT)/=XUNDEF) - PMWTH(IIJB:IIJE,1:D%NKT) = MAX(-7.9*(ABS(ZZ_O_H(IIJB:IIJE,1:D%NKT)-0.35))**2.9 & - * (ABS(ZZ_O_H(IIJB:IIJE,1:D%NKT)-1.))**0.58 + 0.37, 0.) +PMWTH(IIJB:IIJE,1:IKT) = 0. +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE(ZZ_O_H(IIJB:IIJE,1:IKT) <0.9 .AND. ZZ_O_H(IIJB:IIJE,1:IKT)/=XUNDEF) + PMWTH(IIJB:IIJE,1:IKT) = MAX(-7.9*(ABS(ZZ_O_H(IIJB:IIJE,1:IKT)-0.35))**2.9 & + * (ABS(ZZ_O_H(IIJB:IIJE,1:IKT)-1.))**0.58 + 0.37, 0.) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) @@ -150,7 +151,7 @@ DO JK=IKTB+1,IKTE-1 END DO !$mnh_expand_array(JIJ=IIJB:IIJE) PMWTH(IIJB:IIJE,IKE) = PMWTH(IIJB:IIJE,IKE) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) -PMWTH(IIJB:IIJE,D%NKU) = PMWTH(IIJB:IIJE,D%NKU) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) +PMWTH(IIJB:IIJE,IKU) = PMWTH(IIJB:IIJE,IKU) * ZWSTAR(IIJB:IIJE)**2*ZTSTAR(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !---------------------------------------------------------------------------- diff --git a/src/common/turb/mode_tridiag.F90 b/src/common/turb/mode_tridiag.F90 index fe9729a9067f1841a75a614be61c05721f724f03..6c15c7dc20122a834aa5487c98a185bacdaa1bcd 100644 --- a/src/common/turb/mode_tridiag.F90 +++ b/src/common/turb/mode_tridiag.F90 @@ -140,7 +140,7 @@ REAL, DIMENSION(D%NIJT) :: ZBET ! 2D work array INTEGER :: JIJ,JK ! loop counter INTEGER :: IKB,IKE ! inner vertical limits -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU,IKL! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain @@ -158,29 +158,32 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJB=D%NIJB IIJE=D%NIJE ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - & - PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+D%NKL) * & - (PVARM(IIJB:IIJE,IKB+D%NKL) - PVARM(IIJB:IIJE,IKB)) + PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * & + (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - & PEXPL / PRHODJ(IIJB:IIJE,JK) * & - ( PVARM(IIJB:IIJE,JK-D%NKL)*PA(IIJB:IIJE,JK) & - -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+D%NKL)) & - +PVARM(IIJB:IIJE,JK+D%NKL)*PA(IIJB:IIJE,JK+D%NKL) & + ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) & + -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) & + +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + & - PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-D%NKL)) + PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -193,42 +196,42 @@ IF ( PIMPL > 1.E-10 ) THEN ! going up ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZBET(IIJB:IIJE) = 1. - PIMPL * PA(IIJB:IIJE,IKB+D%NKL) / PRHODJ(IIJB:IIJE,IKB) ! bet = b(ikb) + ZBET(IIJB:IIJE) = 1. - PIMPL * PA(IIJB:IIJE,IKB+IKL) / PRHODJ(IIJB:IIJE,IKB) ! bet = b(ikb) PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! - DO JK = IKB+D%NKL,IKE-D%NKL,D%NKL + DO JK = IKB+IKL,IKE-IKL,IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) & - + PA(IIJB:IIJE,JK+D%NKL) & + + PA(IIJB:IIJE,JK+IKL) & ) / PRHODJ(IIJB:IIJE,JK) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK) & - * PVARP(IIJB:IIJE,JK-D%NKL) & + * PVARP(IIJB:IIJE,JK-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) ! special treatment for the last level - ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) & ) / PRHODJ(IIJB:IIJE,IKE) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE) & - * PVARP(IIJB:IIJE,IKE-D%NKL) & + * PVARP(IIJB:IIJE,IKE-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet ! ! going down ! !$mnh_end_expand_array(JIJ=IIJB:IIJE) - DO JK = IKE-D%NKL,IKB,-1*D%NKL + DO JK = IKE-IKL,IKB,-1*IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+D%NKL) * PVARP(IIJB:IIJE,JK+D%NKL) + PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! @@ -247,8 +250,8 @@ END IF ! ---------------------------------------- ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PVARP(IIJB:IIJE,D%NKA)=PVARP(IIJB:IIJE,IKB) -PVARP(IIJB:IIJE,D%NKU)=PVARP(IIJB:IIJE,IKE) +PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB) +PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- diff --git a/src/common/turb/mode_tridiag_massflux.F90 b/src/common/turb/mode_tridiag_massflux.F90 index 7f2311f9c2befec87c79cc4f255cad2bff049472..e58c9a3d0c258c888f280eeef7b14f65b797e634 100644 --- a/src/common/turb/mode_tridiag_massflux.F90 +++ b/src/common/turb/mode_tridiag_massflux.F90 @@ -151,7 +151,11 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM ! RHS of the equation, 3D work array REAL, DIMENSION(D%NIJT) :: ZBET ! 2D work array -INTEGER :: JK, JI ! loop counter +INTEGER :: JK, JIJ ! loop counter +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKTB,IKTE +INTEGER :: IKT,IKB,IKA,IKU,IKE +INTEGER :: IKL ! ! --------------------------------------------------------------------------- ! @@ -160,10 +164,22 @@ INTEGER :: JK, JI ! loop counter ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',0,ZHOOK_HANDLE) +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +IKB=D%NKB +IKL=D%NKL +IKA=D%NKA +IKU=D%NKU +IKE=D%NKE +IKTB=D%NKTB +IKTE=D%NKTE +! CALL MZM_MF(D, PRHODJ, ZMZM_RHODJ) -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,1:D%NKT) = ZMZM_RHODJ(D%NIJB:D%NIJE,1:D%NKT)*PDFDT(D%NIJB:D%NIJE,1:D%NKT)/PDZZ(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZRHODJ_DFDT_O_DZ(IIJB:IIJE,1:IKT) = ZMZM_RHODJ(IIJB:IIJE,1:IKT)*PDFDT(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ZA=0. ZB=0. @@ -174,38 +190,38 @@ ZY=0. !* 2. COMPUTE THE RIGHT HAND SIDE ! --------------------------- ! -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -ZY(D%NIJB:D%NIJE,D%NKB) = PRHODJ(D%NIJB:D%NIJE,D%NKB)*PVARM(D%NIJB:D%NIJE,D%NKB)/PTSTEP & - - ZMZM_RHODJ(D%NIJB:D%NIJE,D%NKB+D%NKL) * PF(D%NIJB:D%NIJE,D%NKB+D%NKL)/PDZZ(D%NIJB:D%NIJE,D%NKB+D%NKL) & - + ZMZM_RHODJ(D%NIJB:D%NIJE,D%NKB ) * PF(D%NIJB:D%NIJE,D%NKB )/PDZZ(D%NIJB:D%NIJE,D%NKB ) & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKB+D%NKL) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,D%NKB+D%NKL) & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKB+D%NKL) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,D%NKB ) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) -! -DO JK=1+D%NKTB,D%NKTE-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZY(D%NIJB:D%NIJE,JK) = PRHODJ(D%NIJB:D%NIJE,JK)*PVARM(D%NIJB:D%NIJE,JK)/PTSTEP & - - ZMZM_RHODJ(D%NIJB:D%NIJE,JK+D%NKL) * PF(D%NIJB:D%NIJE,JK+D%NKL)/PDZZ(D%NIJB:D%NIJE,JK+D%NKL) & - + ZMZM_RHODJ(D%NIJB:D%NIJE,JK ) * PF(D%NIJB:D%NIJE,JK )/PDZZ(D%NIJB:D%NIJE,JK ) & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK+D%NKL) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,JK+D%NKL) & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK+D%NKL) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,JK ) & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK ) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,JK ) & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK ) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,JK-D%NKL) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +ZY(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)*PVARM(IIJB:IIJE,IKB)/PTSTEP & + - ZMZM_RHODJ(IIJB:IIJE,IKB+IKL) * PF(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB+IKL) & + + ZMZM_RHODJ(IIJB:IIJE,IKB ) * PF(IIJB:IIJE,IKB )/PDZZ(IIJB:IIJE,IKB ) & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKB+IKL) & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKB ) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) +! +DO JK=1+IKTB,IKTE-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZY(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)*PVARM(IIJB:IIJE,JK)/PTSTEP & + - ZMZM_RHODJ(IIJB:IIJE,JK+IKL) * PF(IIJB:IIJE,JK+IKL)/PDZZ(IIJB:IIJE,JK+IKL) & + + ZMZM_RHODJ(IIJB:IIJE,JK ) * PF(IIJB:IIJE,JK )/PDZZ(IIJB:IIJE,JK ) & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK+IKL) & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK ) & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK ) & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL * PVARM(IIJB:IIJE,JK-IKL) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! -IF (D%NKE==D%NKU) THEN - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZY(D%NIJB:D%NIJE,D%NKE) = PRHODJ(D%NIJB:D%NIJE,D%NKE)*PVARM(D%NIJB:D%NIJE,D%NKE)/PTSTEP - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +IF (IKE==IKU) THEN + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZY(D%NIJB:D%NIJE,D%NKE) = PRHODJ(D%NIJB:D%NIJE,D%NKE)*PVARM(D%NIJB:D%NIJE,D%NKE)/PTSTEP & - - ZMZM_RHODJ(D%NIJB:D%NIJE,D%NKE+D%NKL) * PF(D%NIJB:D%NIJE,D%NKE+D%NKL)/PDZZ(D%NIJB:D%NIJE,D%NKE+D%NKL) & - + ZMZM_RHODJ(D%NIJB:D%NIJE,D%NKE ) * PF(D%NIJB:D%NIJE,D%NKE )/PDZZ(D%NIJB:D%NIJE,D%NKE ) & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKE ) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,D%NKE ) & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKE ) * 0.5*PIMPL * PVARM(D%NIJB:D%NIJE,D%NKE-D%NKL) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP & + - ZMZM_RHODJ(IIJB:IIJE,IKE+IKL) * PF(IIJB:IIJE,IKE+IKL)/PDZZ(IIJB:IIJE,IKE+IKL) & + + ZMZM_RHODJ(IIJB:IIJE,IKE ) * PF(IIJB:IIJE,IKE )/PDZZ(IIJB:IIJE,IKE ) & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKE ) & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL * PVARM(IIJB:IIJE,IKE-IKL) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF ! ! @@ -217,74 +233,74 @@ IF ( PIMPL > 1.E-10 ) THEN !* 3.1 arrays A, B, C ! -------------- ! - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZB(D%NIJB:D%NIJE,D%NKB) = PRHODJ(D%NIJB:D%NIJE,D%NKB)/PTSTEP & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKB+D%NKL) * 0.5*PIMPL - ZC(D%NIJB:D%NIJE,D%NKB) = ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKB+D%NKL) * 0.5*PIMPL - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZB(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)/PTSTEP & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL + ZC(IIJB:IIJE,IKB) = ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKB+IKL) * 0.5*PIMPL + !$mnh_end_expand_array(JIJ=IIJB:IIJE) - DO JK=1+D%NKTB,D%NKTE-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZA(D%NIJB:D%NIJE,JK) = - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK ) * 0.5*PIMPL - ZB(D%NIJB:D%NIJE,JK) = PRHODJ(D%NIJB:D%NIJE,JK)/PTSTEP & - + ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK+D%NKL) * 0.5*PIMPL & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK ) * 0.5*PIMPL - ZC(D%NIJB:D%NIJE,JK) = ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,JK+D%NKL) * 0.5*PIMPL - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + DO JK=1+IKTB,IKTE-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZA(IIJB:IIJE,JK) = - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL + ZB(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)/PTSTEP & + + ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK ) * 0.5*PIMPL + ZC(IIJB:IIJE,JK) = ZRHODJ_DFDT_O_DZ(IIJB:IIJE,JK+IKL) * 0.5*PIMPL + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZA(D%NIJB:D%NIJE,D%NKE) = - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKE ) * 0.5*PIMPL - ZB(D%NIJB:D%NIJE,D%NKE) = PRHODJ(D%NIJB:D%NIJE,D%NKE)/PTSTEP & - - ZRHODJ_DFDT_O_DZ(D%NIJB:D%NIJE,D%NKE ) * 0.5*PIMPL - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZA(IIJB:IIJE,IKE) = - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL + ZB(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)/PTSTEP & + - ZRHODJ_DFDT_O_DZ(IIJB:IIJE,IKE ) * 0.5*PIMPL + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !* 3.2 going up ! -------- ! - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZBET(D%NIJB:D%NIJE) = ZB(D%NIJB:D%NIJE,D%NKB) ! bet = b(D%NKB) - PVARP(D%NIJB:D%NIJE,D%NKB) = ZY(D%NIJB:D%NIJE,D%NKB) / ZBET(D%NIJB:D%NIJE) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKB) ! bet = b(IKB) + PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! - DO JK = D%NKB+D%NKL,D%NKE-D%NKL,D%NKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - ZGAM(D%NIJB:D%NIJE,JK) = ZC(D%NIJB:D%NIJE,JK-D%NKL) / ZBET(D%NIJB:D%NIJE) + DO JK = IKB+IKL,IKE-IKL,IKL + !$mnh_expand_array(JIJ=IIJB:IIJE) + ZGAM(IIJB:IIJE,JK) = ZC(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet - ZBET(D%NIJB:D%NIJE) = ZB(D%NIJB:D%NIJE,JK) - ZA(D%NIJB:D%NIJE,JK) * ZGAM(D%NIJB:D%NIJE,JK) + ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * ZGAM(IIJB:IIJE,JK) ! bet = b(k) - a(k)* gam(k) - PVARP(D%NIJB:D%NIJE,JK)= ( ZY(D%NIJB:D%NIJE,JK) - ZA(D%NIJB:D%NIJE,JK) * PVARP(D%NIJB:D%NIJE,JK-D%NKL) ) / ZBET(D%NIJB:D%NIJE) + PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * PVARP(IIJB:IIJE,JK-IKL) ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO - !$mnh_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_expand_array(JIJ=IIJB:IIJE) ! special treatment for the last level - ZGAM(D%NIJB:D%NIJE,D%NKE) = ZC(D%NIJB:D%NIJE,D%NKE-D%NKL) / ZBET(D%NIJB:D%NIJE) + ZGAM(IIJB:IIJE,IKE) = ZC(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet - ZBET(D%NIJB:D%NIJE) = ZB(D%NIJB:D%NIJE,D%NKE) - ZA(D%NIJB:D%NIJE,D%NKE) * ZGAM(D%NIJB:D%NIJE,D%NKE) + ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * ZGAM(IIJB:IIJE,IKE) ! bet = b(k) - a(k)* gam(k) - PVARP(D%NIJB:D%NIJE,D%NKE)= ( ZY(D%NIJB:D%NIJE,D%NKE) - ZA(D%NIJB:D%NIJE,D%NKE) * PVARP(D%NIJB:D%NIJE,D%NKE-D%NKL) ) / & - &ZBET(D%NIJB:D%NIJE) + PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * PVARP(IIJB:IIJE,IKE-IKL) ) / & + &ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !* 3.3 going down ! ---------- ! - DO JK = D%NKE-D%NKL,D%NKB,-D%NKL - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PVARP(D%NIJB:D%NIJE,JK) = PVARP(D%NIJB:D%NIJE,JK) - ZGAM(D%NIJB:D%NIJE,JK+D%NKL) * PVARP(D%NIJB:D%NIJE,JK+D%NKL) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + DO JK = IKE-IKL,IKB,-IKL + !$mnh_expand_array(JIJ=IIJB:IIJE) + PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! ! ELSE !!! EXPLICIT FORMULATION ! - DO JK=D%NKTB,D%NKTE - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PVARP(D%NIJB:D%NIJE,JK) = ZY(D%NIJB:D%NIJE,JK) * PTSTEP / PRHODJ(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) + DO JK=IKTB,IKTE + !$mnh_expand_array(JIJ=IIJB:IIJE) + PVARP(IIJB:IIJE,JK) = ZY(IIJB:IIJE,JK) * PTSTEP / PRHODJ(IIJB:IIJE,JK) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDDO ! END IF @@ -293,10 +309,10 @@ END IF !* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES ! ---------------------------------------- ! -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PVARP(D%NIJB:D%NIJE,D%NKA)=PVARP(D%NIJB:D%NIJE,D%NKB) -PVARP(D%NIJB:D%NIJE,D%NKU)=PVARP(D%NIJB:D%NIJE,D%NKE) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB) +PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! diff --git a/src/common/turb/mode_tridiag_thermo.F90 b/src/common/turb/mode_tridiag_thermo.F90 index 037563f686083dbba346e7a65d93e5f0c98a4f4a..fcef93a9789f5513e9b7a213a0c24796dcc516a8 100644 --- a/src/common/turb/mode_tridiag_thermo.F90 +++ b/src/common/turb/mode_tridiag_thermo.F90 @@ -152,9 +152,10 @@ REAL, DIMENSION(D%NIJT) :: ZBET ! 2D work array INTEGER :: JIJ,JK ! loop counter INTEGER :: IKB,IKE ! inner limits -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU ! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain -INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain +INTEGER :: IIJB,IIJE ! start, end of ij loops in physical domain +INTEGER :: IKL ! ! --------------------------------------------------------------------------- ! @@ -168,14 +169,17 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJB=D%NIJB IIJE=D%NIJE ! CALL MZM_PHY(D,PRHODJ,ZMZM_RHODJ) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,1:D%NKT) = ZMZM_RHODJ(IIJB:IIJE,1:D%NKT)*PDFDDTDZ(IIJB:IIJE,1:D%NKT) & - /PDZZ(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,1:IKT) = ZMZM_RHODJ(IIJB:IIJE,1:IKT)*PDFDDTDZ(IIJB:IIJE,1:IKT) & + /PDZZ(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ZA=0. ZB=0. @@ -188,30 +192,30 @@ ZY=0. ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)*PVARM(IIJB:IIJE,IKB)/PTSTEP & - - ZMZM_RHODJ(IIJB:IIJE,IKB+D%NKL) * PF(IIJB:IIJE,IKB+D%NKL)/PDZZ(IIJB:IIJE,IKB+D%NKL) & + - ZMZM_RHODJ(IIJB:IIJE,IKB+IKL) * PF(IIJB:IIJE,IKB+IKL)/PDZZ(IIJB:IIJE,IKB+IKL) & + ZMZM_RHODJ(IIJB:IIJE,IKB ) * PF(IIJB:IIJE,IKB )/PDZZ(IIJB:IIJE,IKB ) & - + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+D%NKL) * PIMPL * PVARM(IIJB:IIJE,IKB+D%NKL) & - - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+D%NKL) * PIMPL * PVARM(IIJB:IIJE,IKB ) + + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL * PVARM(IIJB:IIJE,IKB+IKL) & + - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL * PVARM(IIJB:IIJE,IKB ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)*PVARM(IIJB:IIJE,JK)/PTSTEP & - - ZMZM_RHODJ(IIJB:IIJE,JK+D%NKL) * PF(IIJB:IIJE,JK+D%NKL)/PDZZ(IIJB:IIJE,JK+D%NKL) & + - ZMZM_RHODJ(IIJB:IIJE,JK+IKL) * PF(IIJB:IIJE,JK+IKL)/PDZZ(IIJB:IIJE,JK+IKL) & + ZMZM_RHODJ(IIJB:IIJE,JK ) * PF(IIJB:IIJE,JK )/PDZZ(IIJB:IIJE,JK ) & - + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+D%NKL) * PIMPL * PVARM(IIJB:IIJE,JK+D%NKL) & - - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+D%NKL) * PIMPL * PVARM(IIJB:IIJE,JK ) & + + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL * PVARM(IIJB:IIJE,JK+IKL) & + - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL * PVARM(IIJB:IIJE,JK ) & - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK ) * PIMPL * PVARM(IIJB:IIJE,JK ) & - + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK ) * PIMPL * PVARM(IIJB:IIJE,JK-D%NKL) + + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK ) * PIMPL * PVARM(IIJB:IIJE,JK-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKE) = PRHODJ(IIJB:IIJE,IKE)*PVARM(IIJB:IIJE,IKE)/PTSTEP & - - ZMZM_RHODJ(IIJB:IIJE,IKE+D%NKL) * PF(IIJB:IIJE,IKE+D%NKL)/PDZZ(IIJB:IIJE,IKE+D%NKL) & + - ZMZM_RHODJ(IIJB:IIJE,IKE+IKL) * PF(IIJB:IIJE,IKE+IKL)/PDZZ(IIJB:IIJE,IKE+IKL) & + ZMZM_RHODJ(IIJB:IIJE,IKE ) * PF(IIJB:IIJE,IKE )/PDZZ(IIJB:IIJE,IKE ) & - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL * PVARM(IIJB:IIJE,IKE ) & - + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL * PVARM(IIJB:IIJE,IKE-D%NKL) + + ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKE ) * PIMPL * PVARM(IIJB:IIJE,IKE-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -225,17 +229,17 @@ IF ( PIMPL > 1.E-10 ) THEN ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZB(IIJB:IIJE,IKB) = PRHODJ(IIJB:IIJE,IKB)/PTSTEP & - - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+D%NKL) * PIMPL - ZC(IIJB:IIJE,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+D%NKL) * PIMPL + - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL + ZC(IIJB:IIJE,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,IKB+IKL) * PIMPL !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) ZA(IIJB:IIJE,JK) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK) * PIMPL ZB(IIJB:IIJE,JK) = PRHODJ(IIJB:IIJE,JK)/PTSTEP & - - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+D%NKL) * PIMPL & + - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL & - ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK) * PIMPL - ZC(IIJB:IIJE,JK) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+D%NKL) * PIMPL + ZC(IIJB:IIJE,JK) = ZRHODJ_DFDDTDZ_O_DZ2(IIJB:IIJE,JK+IKL) * PIMPL !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! @@ -252,24 +256,24 @@ IF ( PIMPL > 1.E-10 ) THEN !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! - DO JK = IKB+D%NKL,IKE-D%NKL,D%NKL + DO JK = IKB+IKL,IKE-IKL,IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,JK) = ZC(IIJB:IIJE,JK-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,JK) = ZC(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * ZGAM(IIJB:IIJE,JK) ! bet = b(k) - a(k)* gam(k) - PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * PVARP(IIJB:IIJE,JK-D%NKL) ) & + PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - ZA(IIJB:IIJE,JK) * PVARP(IIJB:IIJE,JK-IKL) ) & / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! special treatment for the last level !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,IKE) = ZC(IIJB:IIJE,IKE-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,IKE) = ZC(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = ZB(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * ZGAM(IIJB:IIJE,IKE) ! bet = b(k) - a(k)* gam(k) - PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * PVARP(IIJB:IIJE,IKE-D%NKL) ) & + PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - ZA(IIJB:IIJE,IKE) * PVARP(IIJB:IIJE,IKE-IKL) ) & / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -277,9 +281,9 @@ IF ( PIMPL > 1.E-10 ) THEN !* 3.3 going down ! ---------- ! - DO JK = IKE-D%NKL,IKB,-1*D%NKL + DO JK = IKE-IKL,IKB,-1*IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+D%NKL) * PVARP(IIJB:IIJE,JK+D%NKL) + PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! @@ -298,8 +302,8 @@ END IF ! ---------------------------------------- ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PVARP(IIJB:IIJE,D%NKA)=PVARP(IIJB:IIJE,IKB) -PVARP(IIJB:IIJE,D%NKU)=PVARP(IIJB:IIJE,IKE) +PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB) +PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- diff --git a/src/common/turb/mode_tridiag_tke.F90 b/src/common/turb/mode_tridiag_tke.F90 index 533664d700f8ef8d6ada008c64db3d3df505cbb8..cc761d7ad6692eee4041148e7f4c3f12a7e4f6e8 100644 --- a/src/common/turb/mode_tridiag_tke.F90 +++ b/src/common/turb/mode_tridiag_tke.F90 @@ -140,9 +140,10 @@ REAL, DIMENSION(D%NIJT) :: ZBET ! 2D work array INTEGER :: JIJ,JK ! loop counter INTEGER :: IKB,IKE ! inner vertical limits -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU ! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain +INTEGER :: IKL ! ! --------------------------------------------------------------------------- ! @@ -157,29 +158,32 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJB=D%NIJB IIJE=D%NIJE ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - & - PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+D%NKL) * & - (PVARM(IIJB:IIJE,IKB+D%NKL) - PVARM(IIJB:IIJE,IKB)) + PEXPL / PRHODJ(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * & + (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - & PEXPL / PRHODJ(IIJB:IIJE,JK) * & - ( PVARM(IIJB:IIJE,JK-D%NKL)*PA(IIJB:IIJE,JK) & - -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+D%NKL)) & - +PVARM(IIJB:IIJE,JK+D%NKL)*PA(IIJB:IIJE,JK+D%NKL) & + ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) & + -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) & + +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + & - PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-D%NKL)) + PEXPL / PRHODJ(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -192,45 +196,45 @@ IF ( PIMPL > 1.E-10 ) THEN ! going up ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZBET(IIJB:IIJE) = 1. + PIMPL * (PDIAG(IIJB:IIJE,IKB)-PA(IIJB:IIJE,IKB+D%NKL) / PRHODJ(IIJB:IIJE,IKB)) + ZBET(IIJB:IIJE) = 1. + PIMPL * (PDIAG(IIJB:IIJE,IKB)-PA(IIJB:IIJE,IKB+IKL) / PRHODJ(IIJB:IIJE,IKB)) ! bet = b(ikb) PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! - DO JK = IKB+D%NKL,IKE-D%NKL,D%NKL + DO JK = IKB+IKL,IKE-IKL,IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. + PIMPL * ( PDIAG(IIJB:IIJE,JK) - & ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) & - + PA(IIJB:IIJE,JK+D%NKL) & + + PA(IIJB:IIJE,JK+IKL) & ) / PRHODJ(IIJB:IIJE,JK) & ) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJ(IIJB:IIJE,JK) & - * PVARP(IIJB:IIJE,JK-D%NKL) & + * PVARP(IIJB:IIJE,JK-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) ! special treatment for the last level - ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. + PIMPL * ( PDIAG(IIJB:IIJE,IKE) - & ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) ) / PRHODJ(IIJB:IIJE,IKE) & ) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJ(IIJB:IIJE,IKE) & - * PVARP(IIJB:IIJE,IKE-D%NKL) & + * PVARP(IIJB:IIJE,IKE-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet ! ! going down ! !$mnh_end_expand_array(JIJ=IIJB:IIJE) - DO JK = IKE-D%NKL,IKB,-1*D%NKL + DO JK = IKE-IKL,IKB,-1*IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+D%NKL) * PVARP(IIJB:IIJE,JK+D%NKL) + PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! @@ -249,8 +253,8 @@ END IF ! ---------------------------------------- ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PVARP(IIJB:IIJE,D%NKA)=PVARP(IIJB:IIJE,IKB) -PVARP(IIJB:IIJE,D%NKU)=PVARP(IIJB:IIJE,IKE) +PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB) +PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- diff --git a/src/common/turb/mode_tridiag_wind.F90 b/src/common/turb/mode_tridiag_wind.F90 index 96b79dd53cf17106451920dceacfb5975f0a720d..0c57fc93e758dc8fd1cda909ab53842ba688765f 100644 --- a/src/common/turb/mode_tridiag_wind.F90 +++ b/src/common/turb/mode_tridiag_wind.F90 @@ -143,11 +143,12 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZY ,ZGAM ! RHS of the equation, 3D work array REAL, DIMENSION(D%NIJT) :: ZBET ! 2D work array -INTEGER :: JIJ,JK ! loop counter +INTEGER :: JIJ,JK ! loop counter INTEGER :: IKB,IKE ! inner vertical limits -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU ! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: IIJB, IIJE ! start, end of ij loops in physical domain +INTEGER :: IKL ! ! --------------------------------------------------------------------------- ! @@ -162,29 +163,32 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJB=D%NIJB IIJE=D%NIJE ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKB) = PVARM(IIJB:IIJE,IKB) + PTSTEP*PSOURCE(IIJB:IIJE,IKB) - & - PEXPL / PRHODJA(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+D%NKL) * & - (PVARM(IIJB:IIJE,IKB+D%NKL) - PVARM(IIJB:IIJE,IKB)) + PEXPL / PRHODJA(IIJB:IIJE,IKB) * PA(IIJB:IIJE,IKB+IKL) * & + (PVARM(IIJB:IIJE,IKB+IKL) - PVARM(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,JK)= PVARM(IIJB:IIJE,JK) + PTSTEP*PSOURCE(IIJB:IIJE,JK) - & PEXPL / PRHODJA(IIJB:IIJE,JK) * & - ( PVARM(IIJB:IIJE,JK-D%NKL)*PA(IIJB:IIJE,JK) & - -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+D%NKL)) & - +PVARM(IIJB:IIJE,JK+D%NKL)*PA(IIJB:IIJE,JK+D%NKL) & + ( PVARM(IIJB:IIJE,JK-IKL)*PA(IIJB:IIJE,JK) & + -PVARM(IIJB:IIJE,JK)*(PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL)) & + +PVARM(IIJB:IIJE,JK+IKL)*PA(IIJB:IIJE,JK+IKL) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZY(IIJB:IIJE,IKE)= PVARM(IIJB:IIJE,IKE) + PTSTEP*PSOURCE(IIJB:IIJE,IKE) + & - PEXPL / PRHODJA(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-D%NKL)) + PEXPL / PRHODJA(IIJB:IIJE,IKE) * PA(IIJB:IIJE,IKE) * (PVARM(IIJB:IIJE,IKE)-PVARM(IIJB:IIJE,IKE-IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -197,43 +201,43 @@ IF ( PIMPL > 1.E-10 ) THEN ! going up ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKB+D%NKL) / PRHODJA(IIJB:IIJE,IKB) & + ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKB+IKL) / PRHODJA(IIJB:IIJE,IKB) & + PCOEFS(IIJB:IIJE) * PTSTEP ) ! bet = b(ikb) PVARP(IIJB:IIJE,IKB) = ZY(IIJB:IIJE,IKB) / ZBET(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! - DO JK = IKB+D%NKL,IKE-D%NKL,D%NKL + DO JK = IKB+IKL,IKE-IKL,IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJA(IIJB:IIJE,JK-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,JK) = PIMPL * PA(IIJB:IIJE,JK) / PRHODJA(IIJB:IIJE,JK-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,JK) * (1. + ZGAM(IIJB:IIJE,JK)) & - + PA(IIJB:IIJE,JK+D%NKL) & + + PA(IIJB:IIJE,JK+IKL) & ) / PRHODJA(IIJB:IIJE,JK) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,JK)= ( ZY(IIJB:IIJE,JK) - PIMPL * PA(IIJB:IIJE,JK) / PRHODJA(IIJB:IIJE,JK) & - * PVARP(IIJB:IIJE,JK-D%NKL) & + * PVARP(IIJB:IIJE,JK-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) ! special treatment for the last level - ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJA(IIJB:IIJE,IKE-D%NKL) / ZBET(IIJB:IIJE) + ZGAM(IIJB:IIJE,IKE) = PIMPL * PA(IIJB:IIJE,IKE) / PRHODJA(IIJB:IIJE,IKE-IKL) / ZBET(IIJB:IIJE) ! gam(k) = c(k-1) / bet ZBET(IIJB:IIJE) = 1. - PIMPL * ( PA(IIJB:IIJE,IKE) * (1. + ZGAM(IIJB:IIJE,IKE)) & ) / PRHODJA(IIJB:IIJE,IKE) ! bet = b(k) - a(k)* gam(k) PVARP(IIJB:IIJE,IKE)= ( ZY(IIJB:IIJE,IKE) - PIMPL * PA(IIJB:IIJE,IKE) / PRHODJA(IIJB:IIJE,IKE) & - * PVARP(IIJB:IIJE,IKE-D%NKL) & + * PVARP(IIJB:IIJE,IKE-IKL) & ) / ZBET(IIJB:IIJE) ! res(k) = (y(k) -a(k)*res(k-1))/ bet ! ! going down ! !$mnh_end_expand_array(JIJ=IIJB:IIJE) - DO JK = IKE-D%NKL,IKB,-1*D%NKL + DO JK = IKE-IKL,IKB,-1*IKL !$mnh_expand_array(JIJ=IIJB:IIJE) - PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+D%NKL) * PVARP(IIJB:IIJE,JK+D%NKL) + PVARP(IIJB:IIJE,JK) = PVARP(IIJB:IIJE,JK) - ZGAM(IIJB:IIJE,JK+IKL) * PVARP(IIJB:IIJE,JK+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! @@ -252,8 +256,8 @@ END IF ! ---------------------------------------- ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PVARP(IIJB:IIJE,D%NKA)=PVARP(IIJB:IIJE,IKB) -PVARP(IIJB:IIJE,D%NKU)=PVARP(IIJB:IIJE,IKE) +PVARP(IIJB:IIJE,IKA)=PVARP(IIJB:IIJE,IKB) +PVARP(IIJB:IIJE,IKU)=PVARP(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- diff --git a/src/common/turb/mode_turb_ver.F90 b/src/common/turb/mode_turb_ver.F90 index f7726a4ac475080fbdebed93f1a8171af41a5e11..ddc28851ffc77d70ccf07113d61a243b2297a583 100644 --- a/src/common/turb/mode_turb_ver.F90 +++ b/src/common/turb/mode_turb_ver.F90 @@ -381,7 +381,7 @@ REAL, DIMENSION(D%NIJT,D%NKT,KSV) :: & REAL, DIMENSION(D%NIJT,D%NKT) :: ZLM ! LOGICAL :: GUSERV ! flag to use water vapor -INTEGER :: IKB,IKE,IIJE,IIJB ! index value for the Beginning +INTEGER :: IKB,IKE,IIJE,IIJB,IKT ! index value for the Beginning ! and the End of the physical domain for the mass points INTEGER :: JSV,JIJ,JK ! loop counter REAL :: ZTIME1 @@ -398,6 +398,7 @@ IF (LHOOK) CALL DR_HOOK('TURB_VER',0,ZHOOK_HANDLE) ! IKB=D%NKTB IKE=D%NKTE +IKT=D%NKT IIJE=D%NIJE IIJB=D%NIJB ! @@ -420,20 +421,20 @@ CALL PRANDTL(D,CST,CSTURB,KRR,KSV,KRRI,TURBN%LTURB_FLX, & ! Buoyancy coefficient ! IF (OOCEAN) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZBETA(IIJB:IIJE,1:D%NKT) = CST%XG*CST%XALPHAOC - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZBETA(IIJB:IIJE,1:IKT) = CST%XG*CST%XALPHAOC + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZBETA(IIJB:IIJE,1:D%NKT) = CST%XG/PTHVREF(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZBETA(IIJB:IIJE,1:IKT) = CST%XG/PTHVREF(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Square root of Tke ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZSQRT_TKE(IIJB:IIJE,1:D%NKT) = SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZSQRT_TKE(IIJB:IIJE,1:IKT) = SQRT(PTKEM(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! gradients of mean quantities at previous time-step ! @@ -445,14 +446,14 @@ IF (KRR>0) CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZDR_DZ) ! Denominator factor in 3rd order terms ! IF (.NOT. TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZD(IIJB:IIJE,1:D%NKT) = (1.+ZREDTH1(IIJB:IIJE,1:D%NKT)+ZREDR1(IIJB:IIJE,1:D%NKT)) * & - &(1.+0.5*(ZREDTH1(IIJB:IIJE,1:D%NKT)+ZREDR1(IIJB:IIJE,1:D%NKT))) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZD(IIJB:IIJE,1:IKT) = (1.+ZREDTH1(IIJB:IIJE,1:IKT)+ZREDR1(IIJB:IIJE,1:IKT)) * & + &(1.+0.5*(ZREDTH1(IIJB:IIJE,1:IKT)+ZREDR1(IIJB:IIJE,1:IKT))) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZD(IIJB:IIJE,1:D%NKT) = 1. - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZD(IIJB:IIJE,1:IKT) = 1. + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! ! Phi3 and Psi3 Prandtl numbers diff --git a/src/common/turb/mode_turb_ver_dyn_flux.F90 b/src/common/turb/mode_turb_ver_dyn_flux.F90 index 2c635afa156c770b8d79809b5d5fc2fe411eefeb..f68fc2d2377fd6263dac088a2fc9570162bf782f 100644 --- a/src/common/turb/mode_turb_ver_dyn_flux.F90 +++ b/src/common/turb/mode_turb_ver_dyn_flux.F90 @@ -321,10 +321,11 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ZWORK3,ZWORK4,& ZWORK5,ZWORK6! working var. for shuman operators (array syntax) ! -INTEGER :: IIJE,IIJB,IKB,IKE ! index value for the mass points of the domain +INTEGER :: IIJE,IIJB,IKB,IKE,IKA,IKU ! index value for the mass points of the domain INTEGER :: IKT ! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: JSV,JIJ,JK ! scalar loop counter +INTEGER :: IKL REAL, DIMENSION(D%NIJT) :: ZCOEFFLXU, & ZCOEFFLXV, ZUSLOPEM, ZVSLOPEM, & ZFLUXSFCU,ZFLUXSFCV @@ -349,6 +350,9 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJE=D%NIJE IIJB=D%NIJB ! @@ -366,13 +370,13 @@ ZDIRSINZW(IIJB:IIJE) = SQRT(1.-PDIRCOSZW(IIJB:IIJE)**2) ! With TURBN%LHARATU length scale and TKE are at half levels so remove MZM ! IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZKEFF(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZKEFF) ENDIF ! @@ -395,10 +399,10 @@ CALL MXM_PHY(D,ZKEFF,ZWORK1) CALL MXM_PHY(D,PDZZ,ZWORK2) CALL MZM_PHY(D,PRHODJ,ZWORK3) CALL MXM_PHY(D,ZWORK3,ZWORK4) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZA(IIJB:IIJE,1:D%NKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:D%NKT)* ZWORK4(IIJB:IIJE,1:D%NKT) & - / ZWORK2(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:IKT)* ZWORK4(IIJB:IIJE,1:IKT) & + / ZWORK2(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! ! Compute the source of U wind component @@ -433,7 +437,7 @@ IF (OOCEAN) THEN ! Ocean model ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZSOURCE(IIJB:IIJE,IKE) = ZWORK31D(IIJB:IIJE) & - *0.5 * ( 1. + ZWORK1(IIJB:IIJE,D%NKU) / ZWORK1(IIJB:IIJE,IKE)) + *0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKU) / ZWORK1(IIJB:IIJE,IKE)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! Zero flux at the ocean domain bottom @@ -462,7 +466,7 @@ ELSE ! Atmosphere ( ZWORK41D(IIJB:IIJE) & + ZWORK61D(IIJB:IIJE) & - ZCOEFS(IIJB:IIJE) * PUM(IIJB:IIJE,IKB) * TURBN%XIMPL & - ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,D%NKA) / ZWORK1(IIJB:IIJE,IKB) ) + ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ZSOURCE(IIJB:IIJE,IKE) = 0. @@ -477,22 +481,22 @@ CALL TRIDIAG_WIND(D,PUM,ZA,ZCOEFS,PTSTEP,PEXPL,TURBN%XIMPL, & ! CALL MXM_PHY(D,PRHODJ,ZWORK1) CALL MXM_PHY(D,ZKEFF,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK3(IIJB:IIJE,1:D%NKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT) + PEXPL*PUM(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK3(IIJB:IIJE,1:IKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PUM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK3,ZWORK4) CALL MXM_PHY(D,PDZZ,ZWORK5) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PRUS(IIJB:IIJE,1:D%NKT)= PRUS(IIJB:IIJE,1:D%NKT)+ZWORK1(IIJB:IIJE,1:D%NKT)*(ZRES(IIJB:IIJE,1:D%NKT) & - - PUM(IIJB:IIJE,1:D%NKT))/PTSTEP +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRUS(IIJB:IIJE,1:IKT)= PRUS(IIJB:IIJE,1:IKT)+ZWORK1(IIJB:IIJE,1:IKT)*(ZRES(IIJB:IIJE,1:IKT) & + - PUM(IIJB:IIJE,1:IKT))/PTSTEP ! !* 5.2 Partial TKE Dynamic Production ! ! vertical flux of the U wind component ! -ZFLXZ(IIJB:IIJE,1:D%NKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK4(IIJB:IIJE,1:D%NKT) & - / ZWORK5(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +ZFLXZ(IIJB:IIJE,1:IKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT) & + / ZWORK5(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (OOCEAN) THEN ZFLXZ(IIJB:IIJE,IKE+1) = ZFLUXSFCU(IIJB:IIJE) @@ -504,9 +508,9 @@ ELSE ZFLXZ(IIJB:IIJE,IKB) = ZWORK1(IIJB:IIJE,IKB) * & ( ZSOURCE(IIJB:IIJE,IKB) & +ZCOEFS(IIJB:IIJE) * ZRES(IIJB:IIJE,IKB) * TURBN%XIMPL & - ) / 0.5 / ( 1. + ZWORK2(IIJB:IIJE,D%NKA)/ ZWORK2(IIJB:IIJE,IKB) ) + ) / 0.5 / ( 1. + ZWORK2(IIJB:IIJE,IKA)/ ZWORK2(IIJB:IIJE,IKB) ) ! - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -527,20 +531,20 @@ END IF ! ! first part of total momentum flux ! -PWU(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) +PWU(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) ! ! Contribution to the TKE dynamic production of TKE ! (computed at mass point) ! CALL GZ_U_UW_PHY(D,PUM,PDZZ,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK2(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK2,ZWORK3) CALL MZF_PHY(D,ZWORK3,ZWORK4) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PDP(IIJB:IIJE,1:D%NKT) = -ZWORK4(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PDP(IIJB:IIJE,1:IKT) = -ZWORK4(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Special cases near surface CALL MXM_PHY(D,PDZZ,ZWORK1) @@ -548,8 +552,8 @@ IF (OOCEAN) THEN ! evaluate the dynamic production at w(IKE) and store in PDP(IKE) ! before to be extrapolated in tke_eps routine !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PUM(IIJB:IIJE,IKE)-PUM(IIJB:IIJE,IKE-D%NKL)) & - / ZWORK1(IIJB:IIJE,IKE-D%NKL) + ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PUM(IIJB:IIJE,IKE)-PUM(IIJB:IIJE,IKE-IKL)) & + / ZWORK1(IIJB:IIJE,IKE-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MXF_PHY(D,ZWORK2,ZWORK3) !$mnh_expand_array(JIJ=IIJB:IIJE) @@ -558,8 +562,8 @@ IF (OOCEAN) THEN ELSE ! Atmosphere ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+D%NKL) * (PUM(IIJB:IIJE,IKB+D%NKL)-PUM(IIJB:IIJE,IKB)) & - / ZWORK1(IIJB:IIJE,IKB+D%NKL) + ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+IKL) * (PUM(IIJB:IIJE,IKB+IKL)-PUM(IIJB:IIJE,IKB)) & + / ZWORK1(IIJB:IIJE,IKB+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MXF_PHY(D,ZWORK2,ZWORK3) !$mnh_expand_array(JIJ=IIJB:IIJE) @@ -578,16 +582,16 @@ IF (TLES%LLES_CALL) THEN CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_WU ) ! CALL GZ_U_UW_PHY(D,PUM,PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_U_SBG_UaU ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZCMFS * ZKEFF(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZCMFS * ZKEFF(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_Km ) ! CALL SECOND_MNH(ZTIME2) @@ -601,61 +605,61 @@ IF(TURBN%CTURBDIM=='3DIM') THEN ! Compute the source for the W wind component ! used to compute the W source at the ground !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+D%NKL) ! extrapolation + ZFLXZ(IIJB:IIJE,IKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+IKL) ! extrapolation !$mnh_end_expand_array(JIJ=IIJB:IIJE) IF (OOCEAN) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKU) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-D%NKL) ! extrapolation + ZFLXZ(IIJB:IIJE,IKU) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-IKL) ! extrapolation !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! CALL MXM_PHY(D,PRHODJ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) / PDXX(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) / PDXX(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DXF_PHY(D,ZWORK2,ZWORK1) ! IF (.NOT. OFLAT) THEN ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT)*PDZX(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)*PDZX(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK3(IIJB:IIJE,1:D%NKT) / PDXX(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT) / PDXX(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK3,ZWORK2) CALL MZF_PHY(D,PDZZ,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = PRHODJ(IIJB:IIJE,1:D%NKT) & - / ZWORK3(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT) & + / ZWORK3(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK3,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRWS(IIJB:IIJE,1:D%NKT) = PRWS(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) & - + ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRWS(IIJB:IIJE,1:IKT) = PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) & + + ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRWS(IIJB:IIJE,1:D%NKT)= PRWS(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRWS(IIJB:IIJE,1:IKT)= PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Complete the TKE dynamical production with the W wind contribution ! CALL GX_W_UW_PHY(D,OFLAT,PWM,PDXX,PDZZ,PDZX, ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = -ZWORK3(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Special cases near surface CALL DXM_PHY(D,PWM,ZWORK1) @@ -664,36 +668,36 @@ IF(TURBN%CTURBDIM=='3DIM') THEN ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKE) * ZWORK1(IIJB:IIJE,IKE) & - / (0.5*(PDXX(IIJB:IIJE,IKE-D%NKL)+PDXX(IIJB:IIJE,IKE))) + / (0.5*(PDXX(IIJB:IIJE,IKE-IKL)+PDXX(IIJB:IIJE,IKE))) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MXF2D_PHY(D,ZWORK31D,ZWORK41D) ZA(IIJB:IIJE,IKE) = ZWORK41D(IIJB:IIJE) ! ELSE !Atmosphere - ! evaluate the dynamic production at w(IKB+D%NKL) in PDP(IKB) + ! evaluate the dynamic production at w(IKB+IKL) in PDP(IKB) ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*D%NKL)-PWM(IIJB:IIJE,IKB+D%NKL)) & - / (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+PDZZ(IIJB:IIJE,IKB+D%NKL)) & - + (PWM(IIJB:IIJE,IKB+D%NKL)-PWM(IIJB:IIJE,IKB)) & - / (PDZZ(IIJB:IIJE,IKB+D%NKL)+PDZZ(IIJB:IIJE,IKB)) + ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*IKL)-PWM(IIJB:IIJE,IKB+IKL)) & + / (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) & + + (PWM(IIJB:IIJE,IKB+IKL)-PWM(IIJB:IIJE,IKB)) & + / (PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! CALL MXM2D_PHY(D,ZWORK21D,ZWORK51D) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKB+D%NKL) & - * ( ZWORK1(IIJB:IIJE,IKB+D%NKL) - ZWORK51D(IIJB:IIJE) & - * PDZX(IIJB:IIJE,IKB+D%NKL) ) & - / (0.5*(PDXX(IIJB:IIJE,IKB+D%NKL)+PDXX(IIJB:IIJE,IKB))) + ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKB+IKL) & + * ( ZWORK1(IIJB:IIJE,IKB+IKL) - ZWORK51D(IIJB:IIJE) & + * PDZX(IIJB:IIJE,IKB+IKL) ) & + / (0.5*(PDXX(IIJB:IIJE,IKB+IKL)+PDXX(IIJB:IIJE,IKB))) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MXF2D_PHY(D,ZWORK31D,ZWORK41D) ZA(IIJB:IIJE,IKB) = ZWORK41D(IIJB:IIJE) ! END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PDP(IIJB:IIJE,1:D%NKT)=PDP(IIJB:IIJE,1:D%NKT)+ZA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Storage in the LES configuration ! @@ -701,36 +705,36 @@ IF(TURBN%CTURBDIM=='3DIM') THEN CALL SECOND_MNH(ZTIME1) ! CALL GX_W_UW_PHY(D,OFLAT,PWM,PDXX,PDZZ,PDZX,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK1) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_RES_ddxa_W_SBG_UaW ) ! CALL GX_M_U_PHY(D,OFLAT,PTHLM,PDXX,PDZZ,PDZX,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK2,ZWORK1) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_RES_ddxa_Thl_SBG_UaW ) ! IF (KRR>=1) THEN CALL GX_U_M_PHY(D,OFLAT,PRM(:,:,1),PDXX,PDZZ,PDZX,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK1,ZWORK2) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddxa_Rt_SBG_UaW ) END IF DO JSV=1,KSV CALL GX_U_M_PHY(D,OFLAT,PSVM(:,:,JSV),PDXX,PDZZ,PDZX,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MXF_PHY(D,ZWORK1,ZWORK2) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) ) END DO @@ -753,10 +757,10 @@ CALL MYM_PHY(D,ZKEFF,ZWORK1) CALL MYM_PHY(D,PDZZ,ZWORK2) CALL MZM_PHY(D,PRHODJ,ZWORK3) CALL MYM_PHY(D,ZWORK3,ZWORK4) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZA(IIJB:IIJE,1:D%NKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:D%NKT)* ZWORK4(IIJB:IIJE,1:D%NKT) & - / ZWORK2(IIJB:IIJE,1:D%NKT)**2 -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZA(IIJB:IIJE,1:IKT) = -PTSTEP * ZCMFS * ZWORK1(IIJB:IIJE,1:IKT)* ZWORK4(IIJB:IIJE,1:IKT) & + / ZWORK2(IIJB:IIJE,1:IKT)**2 +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! ! @@ -798,7 +802,7 @@ IF (OOCEAN) THEN ! Ocean case ! !$mnh_expand_array(JIJ=IIJB:IIJE) ZSOURCE(IIJB:IIJE,IKE) = ZWORK21D(IIJB:IIJE) & - *0.5 * ( 1. + ZWORK1(IIJB:IIJE,D%NKU) / ZWORK1(IIJB:IIJE,IKE)) + *0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKU) / ZWORK1(IIJB:IIJE,IKE)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) !No flux at the ocean domain bottom ZSOURCE(IIJB:IIJE,IKB) = 0. @@ -830,7 +834,7 @@ ELSE ! Atmos case ( ZWORK51D(IIJB:IIJE) & + ZWORK61D(IIJB:IIJE) & - ZCOEFS(IIJB:IIJE) * PVM(IIJB:IIJE,IKB) * TURBN%XIMPL & - ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,D%NKA) / ZWORK1(IIJB:IIJE,IKB) ) + ) * 0.5 * ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !No flux at the atmosphere top @@ -845,23 +849,23 @@ CALL TRIDIAG_WIND(D,PVM,ZA,ZCOEFS,PTSTEP,PEXPL,TURBN%XIMPL, & ! CALL MYM_PHY(D,PRHODJ,ZWORK1) CALL MYM_PHY(D,ZKEFF,ZWORK2) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK3(IIJB:IIJE,1:D%NKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT) + PEXPL*PVM(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK3(IIJB:IIJE,1:IKT)=TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PVM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK3,ZWORK4) CALL MYM_PHY(D,PDZZ,ZWORK5) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PRVS(IIJB:IIJE,1:D%NKT) = PRVS(IIJB:IIJE,1:D%NKT)+ZWORK1(IIJB:IIJE,1:D%NKT)*(ZRES(IIJB:IIJE,1:D%NKT)& - - PVM(IIJB:IIJE,1:D%NKT))/PTSTEP +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRVS(IIJB:IIJE,1:IKT) = PRVS(IIJB:IIJE,1:IKT)+ZWORK1(IIJB:IIJE,1:IKT)*(ZRES(IIJB:IIJE,1:IKT)& + - PVM(IIJB:IIJE,1:IKT))/PTSTEP ! ! !* 6.2 Complete 1D dynamic Production ! ! vertical flux of the V wind component ! -ZFLXZ(IIJB:IIJE,1:D%NKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK4(IIJB:IIJE,1:D%NKT) & - / ZWORK5(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +ZFLXZ(IIJB:IIJE,1:IKT) = -ZCMFS * ZWORK2(IIJB:IIJE,1:IKT) * ZWORK4(IIJB:IIJE,1:IKT) & + / ZWORK5(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (OOCEAN) THEN ZFLXZ(IIJB:IIJE,IKE+1) = ZFLUXSFCV(IIJB:IIJE) @@ -870,9 +874,9 @@ ELSE ZFLXZ(IIJB:IIJE,IKB) = ZWORK5(IIJB:IIJE,IKB) * & ( ZSOURCE(IIJB:IIJE,IKB) & +ZCOEFS(IIJB:IIJE) * ZRES(IIJB:IIJE,IKB) * TURBN%XIMPL & - ) / 0.5 / ( 1. + ZWORK1(IIJB:IIJE,D%NKA) / ZWORK1(IIJB:IIJE,IKB) ) + ) / 0.5 / ( 1. + ZWORK1(IIJB:IIJE,IKA) / ZWORK1(IIJB:IIJE,IKB) ) ! - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -893,20 +897,20 @@ END IF ! ! second part of total momentum flux ! -PWV(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) +PWV(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) ! ! Contribution to the TKE dynamical production ! computed at mass point ! CALL GZ_V_VW_PHY(D,PVM,PDZZ,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK2(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK2,ZWORK3) CALL MZF_PHY(D,ZWORK3,ZWORK4) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZA(IIJB:IIJE,1:D%NKT) = -ZWORK4(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZA(IIJB:IIJE,1:IKT) = -ZWORK4(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Special cases at surface CALL MYM_PHY(D,PDZZ,ZWORK1) @@ -914,8 +918,8 @@ IF (OOCEAN) THEN ! evaluate the dynamic production at w(IKE) in PDP(IKE) ! before extrapolation done in routine tke_eps_source !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PVM(IIJB:IIJE,IKE)-PVM(IIJB:IIJE,IKE-D%NKL)) & - / ZWORK1(IIJB:IIJE,IKE-D%NKL) + ZWORK2(IIJB:IIJE,IKE) = ZFLXZ(IIJB:IIJE,IKE) * (PVM(IIJB:IIJE,IKE)-PVM(IIJB:IIJE,IKE-IKL)) & + / ZWORK1(IIJB:IIJE,IKE-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MYF_PHY(D,ZWORK2,ZWORK3) !$mnh_expand_array(JIJ=IIJB:IIJE) @@ -923,10 +927,10 @@ IF (OOCEAN) THEN !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ELSE ! Atmosphere - ! evaluate the dynamic production at w(IKB+D%NKL) in PDP(IKB) + ! evaluate the dynamic production at w(IKB+IKL) in PDP(IKB) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+D%NKL) * (PVM(IIJB:IIJE,IKB+D%NKL)-PVM(IIJB:IIJE,IKB)) & - / ZWORK1(IIJB:IIJE,IKB+D%NKL) + ZWORK2(IIJB:IIJE,IKB) = ZFLXZ(IIJB:IIJE,IKB+IKL) * (PVM(IIJB:IIJE,IKB+IKL)-PVM(IIJB:IIJE,IKB)) & + / ZWORK1(IIJB:IIJE,IKB+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MYF_PHY(D,ZWORK2,ZWORK3) !$mnh_expand_array(JIJ=IIJB:IIJE) @@ -934,9 +938,9 @@ ELSE ! Atmosphere !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PDP(IIJB:IIJE,1:D%NKT)=PDP(IIJB:IIJE,1:D%NKT)+ZA(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Storage in the LES configuration ! @@ -948,9 +952,9 @@ IF (TLES%LLES_CALL) THEN CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_WV ) ! CALL GZ_V_VW_PHY(D,PVM,PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK1) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_RES_ddxa_V_SBG_UaV ) @@ -966,65 +970,65 @@ IF(TURBN%CTURBDIM=='3DIM') THEN ! Compute the source for the W wind component IF (OOCEAN) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,IKE+D%NKL) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-D%NKL) ! extrapolation + ZFLXZ(IIJB:IIJE,IKE+IKL) = 2 * ZFLXZ(IIJB:IIJE,IKE) - ZFLXZ(IIJB:IIJE,IKE-IKL) ! extrapolation !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+D%NKL) ! extrapolation + ZFLXZ(IIJB:IIJE,IKA) = 2 * ZFLXZ(IIJB:IIJE,IKB) - ZFLXZ(IIJB:IIJE,IKB+IKL) ! extrapolation !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! IF (.NOT. O2D) THEN CALL MYM_PHY(D,PRHODJ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) / PDYY(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) / PDYY(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DYF_PHY(D,ZWORK2,ZWORK1) ! - !ZWORK1 = DYF( MZM(MYM(PRHODJ) /PDYY, D%NKA, D%NKU, D%NKL) * ZFLXZ ) + !ZWORK1 = DYF( MZM(MYM(PRHODJ) /PDYY, IKA, IKU, IKL) * ZFLXZ ) IF (.NOT. OFLAT) THEN CALL MZF_PHY(D,PDZZ,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) * PDZY(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * PDZY(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK4) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK4(IIJB:IIJE,1:D%NKT) = ZWORK4(IIJB:IIJE,1:D%NKT) / PDYY(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) = ZWORK4(IIJB:IIJE,1:IKT) / PDYY(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK4,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = PRHODJ(IIJB:IIJE,1:D%NKT) / ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT) / ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK3,ZWORK2) !ZWORK2 = DZM(PRHODJ / MZF(PDZZ) * MYF(MZF(ZFLXZ*PDZY) / PDYY ) ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRWS(IIJB:IIJE,1:D%NKT) = PRWS(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) & - + ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRWS(IIJB:IIJE,1:IKT) = PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) & + + ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRWS(IIJB:IIJE,1:D%NKT)= PRWS(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRWS(IIJB:IIJE,1:IKT)= PRWS(IIJB:IIJE,1:IKT) - ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! ! Complete the Dynamical production with the W wind component IF (.NOT. O2D) THEN CALL GY_W_VW_PHY(D,OFLAT,PWM,PDYY,PDZZ,PDZY, ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = -ZWORK3(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL DYM_PHY(D,PWM,ZWORK1) ! Special case near surface @@ -1032,34 +1036,34 @@ IF(TURBN%CTURBDIM=='3DIM') THEN ! evaluate the dynamic production at w(IKE) and stored in PDP(IKE) !$mnh_expand_array(JIJ=IIJB:IIJE) ZWORK31D(IIJB:IIJE) = - ZFLXZ(IIJB:IIJE,IKE) * ZWORK1(IIJB:IIJE,IKE) & - / (0.5*(PDYY(IIJB:IIJE,IKE-D%NKL)+PDYY(IIJB:IIJE,IKE))) + / (0.5*(PDYY(IIJB:IIJE,IKE-IKL)+PDYY(IIJB:IIJE,IKE))) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MYF2D_PHY(D,ZWORK31D,ZWORK41D) ZA(IIJB:IIJE,IKE) = ZWORK41D(IIJB:IIJE) ELSE ! Atmosphere ! evaluate the dynamic production at w(IKB+KKL) and stored in PDP(IKB) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*D%NKL )-PWM(IIJB:IIJE,IKB+D%NKL)) & - / (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+PDZZ(IIJB:IIJE,IKB+D%NKL)) & - + (PWM(IIJB:IIJE,IKB+D%NKL)-PWM(IIJB:IIJE,IKB)) & - / (PDZZ(IIJB:IIJE,IKB+D%NKL)+PDZZ(IIJB:IIJE,IKB)) + ZWORK21D(IIJB:IIJE) = (PWM(IIJB:IIJE,IKB+2*IKL )-PWM(IIJB:IIJE,IKB+IKL)) & + / (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) & + + (PWM(IIJB:IIJE,IKB+IKL)-PWM(IIJB:IIJE,IKB)) & + / (PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! CALL MYM2D_PHY(D,ZWORK21D,ZWORK51D) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZWORK31D(IIJB:IIJE ) = - ZFLXZ(IIJB:IIJE,IKB+D%NKL) & - * ( ZWORK1(IIJB:IIJE,IKB+D%NKL) - ZWORK51D(IIJB:IIJE ) & - * PDZY(IIJB:IIJE,IKB+D%NKL) ) & - / (0.5*(PDYY(IIJB:IIJE,IKB+D%NKL)+PDYY(IIJB:IIJE,IKB))) + ZWORK31D(IIJB:IIJE ) = - ZFLXZ(IIJB:IIJE,IKB+IKL) & + * ( ZWORK1(IIJB:IIJE,IKB+IKL) - ZWORK51D(IIJB:IIJE ) & + * PDZY(IIJB:IIJE,IKB+IKL) ) & + / (0.5*(PDYY(IIJB:IIJE,IKB+IKL)+PDYY(IIJB:IIJE,IKB))) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MYF2D_PHY(D,ZWORK31D,ZWORK41D) ZA(IIJB:IIJE,IKB) = ZWORK41D(IIJB:IIJE) ! END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PDP(IIJB:IIJE,1:D%NKT)=PDP(IIJB:IIJE,1:D%NKT)+ZA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PDP(IIJB:IIJE,1:IKT)=PDP(IIJB:IIJE,1:IKT)+ZA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! END IF ! @@ -1069,27 +1073,27 @@ IF(TURBN%CTURBDIM=='3DIM') THEN CALL SECOND_MNH(ZTIME1) ! CALL GY_W_VW_PHY(D,OFLAT,PWM,PDYY,PDZZ,PDZY,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK1,ZWORK2) CALL MZF_PHY(D,ZWORK2,ZWORK1) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%X_LES_RES_ddxa_W_SBG_UaW , .TRUE. ) ! CALL GY_M_V_PHY(D,OFLAT,PTHLM,PDYY,PDZZ,PDZY,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK2,ZWORK1) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. ) ! IF (KRR>=1) THEN CALL GY_V_M_PHY(D,OFLAT,PRM(:,:,1),PDYY,PDZZ,PDZY,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MYF_PHY(D,ZWORK1,ZWORK2) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. ) END IF @@ -1108,10 +1112,10 @@ END IF ! IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED .AND. TURBN%CTURBDIM == '1DIM') THEN CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT)= (2./3.) * PTKEM(IIJB:IIJE,1:D%NKT) & - -ZCMFS*PLM(IIJB:IIJE,1:D%NKT)*SQRT(PTKEM(IIJB:IIJE,1:D%NKT))*ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT)= (2./3.) * PTKEM(IIJB:IIJE,1:IKT) & + -ZCMFS*PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT))*ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! to be tested & ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:) ! stores the W variance diff --git a/src/common/turb/mode_turb_ver_sv_corr.F90 b/src/common/turb/mode_turb_ver_sv_corr.F90 index e790136bdbfd742e9f2af41640ea8244866ce6f5..2a1915b221dabe682ce5f2e6cf85e163a2941ff9 100644 --- a/src/common/turb/mode_turb_ver_sv_corr.F90 +++ b/src/common/turb/mode_turb_ver_sv_corr.F90 @@ -122,7 +122,7 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZA, ZFLXZ, & REAL :: ZCSV !constant for the scalar flux ! INTEGER :: JIJ,JK,JSV ! loop counters -INTEGER :: IIJB, IIJE +INTEGER :: IIJB, IIJE, IKT ! REAL :: ZTIME1, ZTIME2 ! @@ -136,6 +136,7 @@ IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',0,ZHOOK_HANDLE) ! IIJE=D%NIJE IIJB=D%NIJB +IKT=D%NKT ! CALL SECOND_MNH(ZTIME1) ! @@ -157,12 +158,12 @@ DO JSV=1,KSV CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1) CALL MZF_PHY(D,ZFLXZ,ZWORK2) CALL MZF_PHY(D,PWM,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = PPSI_SV(IIJB:IIJE,1:D%NKT,JSV)*ZWORK1(IIJB:IIJE,1:D%NKT)**2 - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZCSV / ZCSVD * PLM(IIJB:IIJE,1:D%NKT) * PLEPS(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -2.*ZCSVD*SQRT(PTKEM(IIJB:IIJE,1:D%NKT))*ZFLXZ(IIJB:IIJE,1:D%NKT)/PLEPS(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK3(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = PPSI_SV(IIJB:IIJE,1:IKT,JSV)*ZWORK1(IIJB:IIJE,1:IKT)**2 + ZFLXZ(IIJB:IIJE,1:IKT) = ZCSV / ZCSVD * PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -2.*ZCSVD*SQRT(PTKEM(IIJB:IIJE,1:IKT))*ZFLXZ(IIJB:IIJE,1:IKT)/PLEPS(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) ) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Sv2(:,:,:,JSV) ) END IF @@ -176,17 +177,17 @@ DO JSV=1,KSV CALL GZ_M_W_PHY(D,PTHLM,PDZZ,ZWORK1) CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT)= ( CSTURB%XCSHF * PPHI3(IIJB:IIJE,1:D%NKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:D%NKT,JSV) ) & - * ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT)= ( CSTURB%XCSHF * PPHI3(IIJB:IIJE,1:IKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:IKT,JSV) ) & + * ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL MZF_PHY(D,ZFLXZ,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT)= PLM(IIJB:IIJE,1:D%NKT) * PLEPS(IIJB:IIJE,1:D%NKT) / (2.*ZCTSVD) * ZWORK3(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:D%NKT)/3.*ZA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT)= PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) / (2.*ZCTSVD) * ZWORK3(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:IKT)/3.*ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) ) CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK2, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.) @@ -195,16 +196,16 @@ DO JSV=1,KSV CALL EMOIST(D,CST,KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN,ZA) ! CALL GZ_M_W_PHY(D,PRM(:,:,1),PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT)= ( ZCSV * PPSI3(IIJB:IIJE,1:D%NKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:D%NKT,JSV) ) & - * ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT)= ( ZCSV * PPSI3(IIJB:IIJE,1:IKT) + ZCSV * PPSI_SV(IIJB:IIJE,1:IKT,JSV) ) & + * ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZFLXZ,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT)= PLM(IIJB:IIJE,1:D%NKT) * PLEPS(IIJB:IIJE,1:D%NKT) / (2.*ZCQSVD) * ZWORK3(IIJB:IIJE,1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:D%NKT)/3.*ZA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT)= PLM(IIJB:IIJE,1:IKT) * PLEPS(IIJB:IIJE,1:IKT) / (2.*ZCQSVD) * ZWORK3(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = -CST%XG/PTHVREF(IIJB:IIJE,1:IKT)/3.*ZA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK1, TLES%X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.) CALL LES_MEAN_SUBGRID_PHY(D,TLES, ZWORK2, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.) END IF diff --git a/src/common/turb/mode_turb_ver_sv_flux.F90 b/src/common/turb/mode_turb_ver_sv_flux.F90 index d5e75f639495484bb152ecaa9be1b0b960aed452..e1bc59249485149a8d7189f5fd8c4801ae66b5a8 100644 --- a/src/common/turb/mode_turb_ver_sv_flux.F90 +++ b/src/common/turb/mode_turb_ver_sv_flux.F90 @@ -291,8 +291,9 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ZWORK1,ZWORK2,& ZWORK3,ZWORK4! working var. for shuman operators (array syntax) INTEGER :: IKT ! array size in k direction -INTEGER :: IIJB,IIJE,IKB,IKE ! index value for the mass points of the domain +INTEGER :: IIJB,IIJE,IKB,IKE,IKA ! index value for the mass points of the domain INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain +INTEGER :: IKL INTEGER :: JSV ! loop counters INTEGER :: JIJ,JK ! loop ! @@ -315,17 +316,19 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKL=D%NKL IIJE=D%NIJE IIJB=D%NIJB ! IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZKEFF(IIJB:IIJE,IKB:IKE) = PLM(IIJB:IIJE,IKB:IKE) * SQRT(PTKEM(IIJB:IIJE,IKB:IKE)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT)*SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZKEFF) ENDIF ! @@ -347,15 +350,15 @@ DO JSV=1,KSV ! ! Preparation of the arguments for TRIDIAG IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZA(IIJB:IIJE,IKB:IKE) = -PTSTEP * ZKEFF(IIJB:IIJE,IKB:IKE) * ZWORK1(IIJB:IIJE,IKB:IKE) & / PDZZ(IIJB:IIJE,IKB:IKE)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZA(IIJB:IIJE,IKB:IKE) = -PTSTEP*ZCSV*PPSI_SV(IIJB:IIJE,IKB:IKE,JSV) * & ZKEFF(IIJB:IIJE,IKB:IKE) * ZWORK1(IIJB:IIJE,IKB:IKE) / PDZZ(IIJB:IIJE,IKB:IKE)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ZSOURCE(IIJB:IIJE,IKB:IKE) = 0. ! @@ -369,13 +372,13 @@ DO JSV=1,KSV !$mnh_expand_array(JIJ=IIJB:IIJE) ZSOURCE(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) / & PDZZ(IIJB:IIJE,IKB) * PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) ZSOURCE(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFSVP(IIJB:IIJE,JSV) + PEXPL*PSFSVM(IIJB:IIJE,JSV)) / & PDZZ(IIJB:IIJE,IKB) / PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ZSOURCE(IIJB:IIJE,IKTB+1:IKTE-1) = 0. @@ -385,25 +388,25 @@ DO JSV=1,KSV CALL TRIDIAG(D,PSVM(:,:,JSV),ZA,PTSTEP,PEXPL,TURBN%XIMPL,PRHODJ,ZSOURCE,ZRES) ! ! Compute the equivalent tendency for the JSV scalar variable - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) PRSVS(IIJB:IIJE,IKB:IKE,JSV)= PRSVS(IIJB:IIJE,IKB:IKE,JSV)+ & PRHODJ(IIJB:IIJE,IKB:IKE)*(ZRES(IIJB:IIJE,IKB:IKE)-PSVM(IIJB:IIJE,IKB:IKE,JSV))/PTSTEP - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF ( (TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL ) THEN ! Diagnostic of the cartesian vertical flux ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT)*SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - ZWORK2(IIJB:IIJE,1:D%NKT) = TURBN%XIMPL*ZRES(IIJB:IIJE,1:D%NKT) + PEXPL*PSVM(IIJB:IIJE,1:D%NKT,JSV) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*SQRT(PTKEM(IIJB:IIJE,1:IKT)) + ZWORK2(IIJB:IIJE,1:IKT) = TURBN%XIMPL*ZRES(IIJB:IIJE,1:IKT) + PEXPL*PSVM(IIJB:IIJE,1:IKT,JSV) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) CALL DZM_PHY(D,ZWORK2,ZWORK4) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZFLXZ(IIJB:IIJE,IKB:IKE) = -ZCSV * PPSI_SV(IIJB:IIJE,IKB:IKE,JSV) * ZWORK3(IIJB:IIJE,IKB:IKE) & / PDZZ(IIJB:IIJE,IKB:IKE) * & ZWORK4(IIJB:IIJE,IKB:IKE) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! surface flux !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally ! (in presence of slopes) @@ -424,16 +427,16 @@ DO JSV=1,KSV ! the IKB flux gives the ground value ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PWSV(IIJB:IIJE,JK,JSV)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+D%NKL)) + PWSV(IIJB:IIJE,JK,JSV)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) - PWSV(IIJB:IIJE,IKB,JSV)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+D%NKL)) - PWSV(IIJB:IIJE,IKE,JSV)=PWSV(IIJB:IIJE,IKE-D%NKL,JSV) + PWSV(IIJB:IIJE,IKB,JSV)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL)) + PWSV(IIJB:IIJE,IKE,JSV)=PWSV(IIJB:IIJE,IKE-IKL,JSV) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -463,27 +466,27 @@ DO JSV=1,KSV CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WSv(:,:,:,JSV) ) ! CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) ) ! CALL GZ_M_W_PHY(D,PSVM(:,:,JSV),PDZZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) ) ! CALL MZF_PHY(D,ZFLXZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = -ZCSVP*SQRT(PTKEM(IIJB:IIJE,1:D%NKT))/PLM(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = -ZCSVP*SQRT(PTKEM(IIJB:IIJE,1:IKT))/PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_SvPz(:,:,:,JSV) ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PWM(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_WSv(:,:,:,JSV) ) ! diff --git a/src/common/turb/mode_turb_ver_thermo_corr.F90 b/src/common/turb/mode_turb_ver_thermo_corr.F90 index a535dfb9c654ba15db362b3f509dddde05b223ed..cdf672b1664697fa0a03717a4306143b4aa1a302 100644 --- a/src/common/turb/mode_turb_ver_thermo_corr.F90 +++ b/src/common/turb/mode_turb_ver_thermo_corr.F90 @@ -326,12 +326,13 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ZWKPHIPSI1,ZWKPHIPSI2,& ZWKPHIPSI3,ZWKPHIPSI4 ! working var. for shuman operators (array syntax) -INTEGER :: IIJB, IIJE, IKB,IKE ! index value for the mass points of the domain +INTEGER :: IIJB, IIJE, IKB,IKE,IKT,IKA,IKU ! index value for the mass points of the domain INTEGER :: IKU ! array sizes +INTEGER :: IKL INTEGER :: JIJ, JK ! loop indexes -REAL, DIMENSION(D%NIJT,MIN(D%NKA+JPVEXT_TURB*D%NKL,D%NKA+JPVEXT_TURB*D%NKL+2*D%NKL):& - MAX(D%NKA+JPVEXT_TURB*D%NKL,D%NKA+JPVEXT_TURB*D%NKL+2*D%NKL))& +REAL, DIMENSION(D%NIJT,MIN(IKA+JPVEXT_TURB*IKL,IKA+JPVEXT_TURB*IKL+2*IKL):& + MAX(IKA+JPVEXT_TURB*IKL,IKA+JPVEXT_TURB*IKL+2*IKL))& :: ZCOEFF ! coefficients for the uncentred gradient ! computation near the ground, defined in @@ -356,6 +357,10 @@ IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_CORR',0,ZHOOK_HANDLE) ! IKB=D%NKB IKE=D%NKE +IKT=D%NKT +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJE=D%NIJE IIJB=D%NIJB ! @@ -364,12 +369,12 @@ GUSERV = (KRR/=0) ! compute the coefficients for the uncentred gradient computation near the ! ground !$mnh_expand_array(JIJ=IIJB:IIJE) -ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)= - PDZZ(IIJB:IIJE,IKB+D%NKL) / & - ( (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+PDZZ(IIJB:IIJE,IKB+D%NKL)) * PDZZ(IIJB:IIJE,IKB+2*D%NKL) ) -ZCOEFF(IIJB:IIJE,IKB+D%NKL)= (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+PDZZ(IIJB:IIJE,IKB+D%NKL)) / & - ( PDZZ(IIJB:IIJE,IKB+D%NKL) * PDZZ(IIJB:IIJE,IKB+2*D%NKL) ) -ZCOEFF(IIJB:IIJE,IKB)= - (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+2.*PDZZ(IIJB:IIJE,IKB+D%NKL)) / & - ( (PDZZ(IIJB:IIJE,IKB+2*D%NKL)+PDZZ(IIJB:IIJE,IKB+D%NKL)) * PDZZ(IIJB:IIJE,IKB+D%NKL) ) +ZCOEFF(IIJB:IIJE,IKB+2*IKL)= - PDZZ(IIJB:IIJE,IKB+IKL) / & + ( (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) * PDZZ(IIJB:IIJE,IKB+2*IKL) ) +ZCOEFF(IIJB:IIJE,IKB+IKL)= (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) / & + ( PDZZ(IIJB:IIJE,IKB+IKL) * PDZZ(IIJB:IIJE,IKB+2*IKL) ) +ZCOEFF(IIJB:IIJE,IKB)= - (PDZZ(IIJB:IIJE,IKB+2*IKL)+2.*PDZZ(IIJB:IIJE,IKB+IKL)) / & + ( (PDZZ(IIJB:IIJE,IKB+2*IKL)+PDZZ(IIJB:IIJE,IKB+IKL)) * PDZZ(IIJB:IIJE,IKB+IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! @@ -384,17 +389,17 @@ IF (TURBN%LHARAT) THEN ! function MZF produces -999 for level IKU (82 for 80 levels) ! so put these to normal value as this level (82) is indeed calculated !$mnh_expand_array(JIJ=IIJB:IIJE) - PLMF(IIJB:IIJE,D%NKT)=0.001 - PLEPSF(IIJB:IIJE,D%NKT)=0.001 + PLMF(IIJB:IIJE,IKT)=0.001 + PLEPSF(IIJB:IIJE,IKT)=0.001 !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! with energy cascade contribution 50MF term can be omitted - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZKEFF(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZKEFF) ENDIF ! @@ -425,29 +430,29 @@ END IF ! Compute the turbulent variance F and F' at time t-dt. ! IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT)=PDTH_DZ(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT)=PDTH_DZ(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) IF (TURBN%LSTATNW) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV * & - PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * & + PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT)=PPHI3(IIJB:IIJE,1:D%NKT)*PDTH_DZ(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT)=PPHI3(IIJB:IIJE,1:IKT)*PDTH_DZ(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ZDFDDTDZ(:,:) = 0. ! this term, because of discretization, is treated separately ! @@ -459,12 +464,12 @@ END IF CALL D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFTH2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTH2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFTH2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTH2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2th')/dz @@ -475,12 +480,12 @@ END IF CALL D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,& & PLM,PLEPS,PTKEM,GUSERV,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF (KRR/=0) THEN @@ -491,12 +496,12 @@ END IF CALL D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,& & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFR2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFR2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFR2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFR2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2r')/dz @@ -507,12 +512,12 @@ END IF CALL D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,& & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'r')/dz @@ -522,29 +527,29 @@ END IF CALL D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PTHLP(IIJB:IIJE,1:D%NKT) - PTHLM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK3,ZWORK4) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:D%NKT) & - * ZWORK4(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) & + * ZWORK4(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! special case near the ground ( uncentred gradient ) IF (TURBN%LHARAT) THEN @@ -552,12 +557,12 @@ END IF ZFLXZ(IIJB:IIJE,IKB) = PLMF(IIJB:IIJE,IKB) & * PLEPSF(IIJB:IIJE,IKB) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLM(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLM(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB ) )**2 & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB ) )**2 & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -568,40 +573,40 @@ END IF END IF ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCTV * PPHI3(IIJB:IIJE,IKB+D%NKL) * PLM(IIJB:IIJE,IKB) & + ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCTV * PPHI3(IIJB:IIJE,IKB+IKL) * PLM(IIJB:IIJE,IKB) & * PLEPS(IIJB:IIJE,IKB) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLM(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLM(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB ) )**2 & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB ) )**2 & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (TURBN%LSTATNW) THEN !wc The variance from the budget eq should be multiplied by 2 here ! thl'2=2*L*LEPS*(dthl/dz**2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = MAX(0., ZFLXZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF (KRRL > 0) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PSIGS(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) * PATHETA(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGS(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) * PATHETA(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE PSIGS(:,:) = 0. END IF @@ -630,26 +635,26 @@ END IF CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_Thl2 ) ! CALL MZF_PHY(D,PWM,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Thl2 ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) & - / PLEPS(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) & + / PLEPS(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Thl2 ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PETHETA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlThv ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) & - * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) & + * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlPz, .TRUE. ) ! CALL SECOND_MNH(ZTIME2) @@ -663,30 +668,30 @@ END IF ! ! Compute the turbulent variance F and F' at time t-dt. IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PDTH_DZ(IIJB:IIJE,1:D%NKT)*PDR_DZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) IF (TURBN%LSTATNW) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV * & - PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * & + PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = 0.5*(PPHI3(IIJB:IIJE,1:D%NKT)+PPSI3(IIJB:IIJE,1:D%NKT))& - *PDTH_DZ(IIJB:IIJE,1:D%NKT)*PDR_DZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = 0.5*(PPHI3(IIJB:IIJE,1:IKT)+PPSI3(IIJB:IIJE,1:IKT))& + *PDTH_DZ(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ZDFDDTDZ(:,:) = 0. ! this term, because of discretization, is treated separately ZDFDDRDZ(:,:) = 0. ! this term, because of discretization, is treated separately @@ -702,13 +707,13 @@ END IF CALL D_M3_THR_WTH2_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFTH2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTH2(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * PFTH2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFTH2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTH2(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * PFTH2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2th')/dz @@ -721,14 +726,14 @@ END IF CALL D_M3_THR_W2TH_O_DDRDZ(D,CSTURB,PREDTH1,PREDR1,& & PD,PLM,PLEPS,PTKEM,ZWORK4) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK4(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'r'2)/dz @@ -740,13 +745,13 @@ END IF CALL D_M3_THR_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,& & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFR2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFR2(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * PFR2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFR2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFR2(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * PFR2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2r')/dz @@ -759,13 +764,13 @@ END IF CALL D_M3_THR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,& & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST,ZWORK4) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK4(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'r')/dz @@ -777,47 +782,47 @@ END IF CALL D_M3_THR_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFTHR(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFTHR(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PTHLP(IIJB:IIJE,1:D%NKT) - PTHLM(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PRP(IIJB:IIJE,1:D%NKT) - PRM(IIJB:IIJE,1:D%NKT,1) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK3) CALL DZM_PHY(D,ZWORK2,ZWORK4) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK3(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK4(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK4(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK7) CALL MZF_PHY(D,ZWORK2,ZWORK8) ! IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK5(IIJB:IIJE,1:D%NKT) = 2. *PDR_DZ(IIJB:IIJE,1:D%NKT) *ZWORK3(IIJB:IIJE,1:D%NKT) & - / PDZZ(IIJB:IIJE,1:D%NKT) & - + 2. *PDTH_DZ(IIJB:IIJE,1:D%NKT) *ZWORK4(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK5(IIJB:IIJE,1:IKT) = 2. *PDR_DZ(IIJB:IIJE,1:IKT) *ZWORK3(IIJB:IIJE,1:IKT) & + / PDZZ(IIJB:IIJE,1:IKT) & + + 2. *PDTH_DZ(IIJB:IIJE,1:IKT) *ZWORK4(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! CALL MZF_PHY(D,ZWORK5,ZWORK6) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*0.5 & - * ZWORK5(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:D%NKT) * ZWORK7(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:D%NKT) * ZWORK8(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*0.5 & + * ZWORK5(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * ZWORK7(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK8(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (TURBN%LSTATNW) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI1) @@ -829,21 +834,21 @@ END IF CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI4) ! d(psi3*drdz )/ddrdz term - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK5(IIJB:IIJE,1:D%NKT) = (ZWKPHIPSI1(IIJB:IIJE,1:D%NKT)+ZWKPHIPSI2(IIJB:IIJE,1:D%NKT))& - *PDR_DZ(IIJB:IIJE,1:D%NKT)*ZWORK3(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) & - + (ZWKPHIPSI3(IIJB:IIJE,1:D%NKT) + ZWKPHIPSI4(IIJB:IIJE,1:D%NKT)) & - *PDTH_DZ(IIJB:IIJE,:D%NKT)*ZWORK4(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK5(IIJB:IIJE,1:IKT) = (ZWKPHIPSI1(IIJB:IIJE,1:IKT)+ZWKPHIPSI2(IIJB:IIJE,1:IKT))& + *PDR_DZ(IIJB:IIJE,1:IKT)*ZWORK3(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) & + + (ZWKPHIPSI3(IIJB:IIJE,1:IKT) + ZWKPHIPSI4(IIJB:IIJE,1:IKT)) & + *PDTH_DZ(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK5,ZWORK6) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)*0.5 & - * ZWORK6(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:D%NKT) * ZWORK7(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:D%NKT) * ZWORK8(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)*0.5 & + * ZWORK6(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * ZWORK7(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK8(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! ! special case near the ground ( uncentred gradient ) @@ -852,18 +857,18 @@ END IF ZFLXZ(IIJB:IIJE,IKB) = & (1. ) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLM(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLM(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB )) & - *( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRM(IIJB:IIJE,IKB+2*D%NKL,1) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRM(IIJB:IIJE,IKB+D%NKL,1 ) & + *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) & +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 )) & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB )) & - *( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRP(IIJB:IIJE,IKB+2*D%NKL ) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRP(IIJB:IIJE,IKB+D%NKL ) & + *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL ) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB )) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -875,49 +880,49 @@ END IF ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) ZFLXZ(IIJB:IIJE,IKB) = & - (CSTURB%XCHT1 * PPHI3(IIJB:IIJE,IKB+D%NKL) + CSTURB%XCHT2 * PPSI3(IIJB:IIJE,IKB+D%NKL)) & + (CSTURB%XCHT1 * PPHI3(IIJB:IIJE,IKB+IKL) + CSTURB%XCHT2 * PPSI3(IIJB:IIJE,IKB+IKL)) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLM(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLM(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLM(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLM(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLM(IIJB:IIJE,IKB )) & - *( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRM(IIJB:IIJE,IKB+2*D%NKL,1) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRM(IIJB:IIJE,IKB+D%NKL,1 ) & + *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) & +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 )) & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PTHLP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PTHLP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PTHLP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PTHLP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PTHLP(IIJB:IIJE,IKB )) & - *( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRP(IIJB:IIJE,IKB+2*D%NKL ) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRP(IIJB:IIJE,IKB+D%NKL ) & + *( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL ) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB )) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (TURBN%LSTATNW) THEN !wc The variance from the budget eq should be multiplied by 2 here ! e.g. thl'2=2*L*LEPS*(cab)^-1 *(dthl/dz**2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = MIN(0., 2.*ZFLXZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = MIN(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF IF ( KRRL > 0 ) THEN IF (TURBN%LSTATNW) THEN !wc Part of the new statistical cloud scheme set up. Normal notation so - sign - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PSIGS(IIJB:IIJE,1:D%NKT) = PSIGS(IIJB:IIJE,1:D%NKT) - & - 2. * PATHETA(IIJB:IIJE,1:D%NKT) * PAMOIST(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) - & + 2. * PATHETA(IIJB:IIJE,1:IKT) * PAMOIST(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE ! NB PATHETA is -b in Chaboureau Bechtold 2002 which explains the + sign here - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PSIGS(IIJB:IIJE,1:D%NKT) = PSIGS(IIJB:IIJE,1:D%NKT) + & - 2. * PATHETA(IIJB:IIJE,1:D%NKT) * PAMOIST(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) + & + 2. * PATHETA(IIJB:IIJE,1:IKT) * PAMOIST(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF END IF ! stores <THl Rnp> @@ -943,37 +948,37 @@ IF (TLES%LLES_CALL) THEN CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_THlRt ) ! CALL MZF_PHY(D,PWM,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_ThlRt ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) & - / PLEPS(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) & + / PLEPS(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_ThlRt ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PETHETA(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PETHETA(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtThv ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:D%NKT)*PETHETA(IIJB:IIJE,1:D%NKT) & - * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PETHETA(IIJB:IIJE,1:IKT) & + * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtPz, .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PEMOIST(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PEMOIST(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlThv , .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT) & - * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) & + * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_ThlPz, .TRUE. ) ! CALL SECOND_MNH(ZTIME2) @@ -986,27 +991,27 @@ END IF ! ! Compute the turbulent variance F and F' at time t-dt. IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PDR_DZ(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = PLMF(IIJB:IIJE,1:D%NKT)*PLEPSF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = PLMF(IIJB:IIJE,1:IKT)*PLEPSF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (TURBN%LSTATNW) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV * ZF(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZF(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PPSI3(IIJB:IIJE,1:D%NKT)*PDR_DZ(IIJB:IIJE,1:D%NKT)**2 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PPSI3(IIJB:IIJE,1:IKT)*PDR_DZ(IIJB:IIJE,1:IKT)**2 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:D%NKT)*PLEPS(IIJB:IIJE,1:D%NKT)& - *ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT)*PLEPS(IIJB:IIJE,1:IKT)& + *ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ZDFDDRDZ(:,:) = 0. ! this term, because of discretization, is treated separately ! @@ -1019,11 +1024,11 @@ ENDIF CALL D_M3_R2_WR2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFR2(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFR2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFR2(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFR2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2r')/dz @@ -1034,11 +1039,11 @@ ENDIF CALL D_M3_R2_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,PLM,PLEPS,PTKEM,GUSERV,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF (KRR/=0) THEN @@ -1049,11 +1054,11 @@ ENDIF CALL D_M3_R2_WTH2_O_DDRDZ(D,CSTURB,PREDR1,& & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT)*PFTH2(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTH2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT)*PFTH2(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTH2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2r')/dz @@ -1064,11 +1069,11 @@ ENDIF CALL D_M3_R2_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT)+ZWORK2(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT)+ZWORK2(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'r')/dz @@ -1078,58 +1083,58 @@ ENDIF CALL D_M3_R2_WTHR_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFTHR(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFTHR(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PRP(IIJB:IIJE,1:D%NKT) - PRM(IIJB:IIJE,1:D%NKT,1) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK2) IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK5(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = 2.*PDR_DZ(IIJB:IIJE,1:D%NKT)* ZWORK5(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK5(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = 2.*PDR_DZ(IIJB:IIJE,1:IKT)* ZWORK5(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK3,ZWORK4) CALL MZF_PHY(D,ZWORK5,ZWORK6) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * PLMF(IIJB:IIJE,1:D%NKT) *PLEPSF(IIJB:IIJE,1:D%NKT) & - * ZWORK4(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:D%NKT) * ZWORK6(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * PLMF(IIJB:IIJE,1:IKT) *PLEPSF(IIJB:IIJE,1:IKT) & + * ZWORK4(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK6(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF (TURBN%LSTATNW) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = CSTURB%XCTV * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ELSE CALL D_PSI3DRDZ2_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,TURBN%CTURBDIM,GUSERV,ZWKPHIPSI1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWKPHIPSI1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) & - / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWKPHIPSI1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) & + / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK4(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK4(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK4,ZWORK5) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:D%NKT) *PLEPS(IIJB:IIJE,1:D%NKT) & - * ZWORK3(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:D%NKT) * ZWORK5(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * CSTURB%XCTV*PLM(IIJB:IIJE,1:IKT) *PLEPS(IIJB:IIJE,1:IKT) & + * ZWORK3(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK5(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! ! special case near the ground ( uncentred gradient ) @@ -1138,12 +1143,12 @@ ENDIF ZFLXZ(IIJB:IIJE,IKB) = PLMF(IIJB:IIJE,IKB) & * PLEPSF(IIJB:IIJE,IKB) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRM(IIJB:IIJE,IKB+2*D%NKL,1) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRM(IIJB:IIJE,IKB+D%NKL,1 ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) & +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 ))**2 & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB ))**2 & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -1154,36 +1159,36 @@ ENDIF END IF ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCHV * PPSI3(IIJB:IIJE,IKB+D%NKL) * PLM(IIJB:IIJE,IKB) & + ZFLXZ(IIJB:IIJE,IKB) = CSTURB%XCHV * PPSI3(IIJB:IIJE,IKB+IKL) * PLM(IIJB:IIJE,IKB) & * PLEPS(IIJB:IIJE,IKB) & *( PEXPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRM(IIJB:IIJE,IKB+2*D%NKL,1) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRM(IIJB:IIJE,IKB+D%NKL,1 ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRM(IIJB:IIJE,IKB+2*IKL,1) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRM(IIJB:IIJE,IKB+IKL,1 ) & +ZCOEFF(IIJB:IIJE,IKB )*PRM(IIJB:IIJE,IKB ,1 ))**2 & +TURBN%XIMPL * & - ( ZCOEFF(IIJB:IIJE,IKB+2*D%NKL)*PRP(IIJB:IIJE,IKB+2*D%NKL) & - +ZCOEFF(IIJB:IIJE,IKB+D%NKL )*PRP(IIJB:IIJE,IKB+D%NKL ) & + ( ZCOEFF(IIJB:IIJE,IKB+2*IKL)*PRP(IIJB:IIJE,IKB+2*IKL) & + +ZCOEFF(IIJB:IIJE,IKB+IKL )*PRP(IIJB:IIJE,IKB+IKL ) & +ZCOEFF(IIJB:IIJE,IKB )*PRP(IIJB:IIJE,IKB ))**2 & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) IF (TURBN%LSTATNW) THEN !wc The variance from the budget eq should be multiplied by 2 here ! thl'2=2*L*LEPS*(dthl/dz**2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = MAX(0., 2.*ZFLXZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! IF ( KRRL > 0 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PSIGS(IIJB:IIJE,1:D%NKT) = PSIGS(IIJB:IIJE,1:D%NKT) + PAMOIST(IIJB:IIJE,1:D%NKT) **2 & - * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PSIGS(IIJB:IIJE,1:IKT) = PSIGS(IIJB:IIJE,1:IKT) + PAMOIST(IIJB:IIJE,1:IKT) **2 & + * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! stores <Rnp Rnp> IF ( TURBN%LTURB_FLX .AND. TPFILE%LOPENED ) THEN @@ -1208,26 +1213,26 @@ ENDIF CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZFLXZ, TLES%X_LES_SUBGRID_Rt2 ) ! CALL MZF_PHY(D,PWM,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_W_SBG_Rt2 ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PEMOIST(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PEMOIST(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtThv , .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:D%NKT)*PEMOIST(IIJB:IIJE,1:D%NKT) & - * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -CSTURB%XA3*PBETA(IIJB:IIJE,1:IKT)*PEMOIST(IIJB:IIJE,1:IKT) & + * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_RtPz, .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) & - / PLEPS(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = -2.*CSTURB%XCTD*PSQRT_TKE(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) & + / PLEPS(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_DISS_Rt2 ) ! CALL SECOND_MNH(ZTIME2) @@ -1242,17 +1247,17 @@ ENDIF IF ( KRRL > 0 ) THEN ! Extrapolate PSIGS at the ground and at the top !$mnh_expand_array(JIJ=IIJB:IIJE) - PSIGS(IIJB:IIJE,D%NKA) = PSIGS(IIJB:IIJE,IKB) - PSIGS(IIJB:IIJE,D%NKU) = PSIGS(IIJB:IIJE,IKE) + PSIGS(IIJB:IIJE,IKA) = PSIGS(IIJB:IIJE,IKB) + PSIGS(IIJB:IIJE,IKU) = PSIGS(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) #ifdef REPRO48 - PSIGS(IIJB:IIJE,1:D%NKT) = MAX (PSIGS(IIJB:IIJE,1:D%NKT) , 0.) - PSIGS(IIJB:IIJE,1:D%NKT) = SQRT(PSIGS(IIJB:IIJE,1:D%NKT)) + PSIGS(IIJB:IIJE,1:IKT) = MAX (PSIGS(IIJB:IIJE,1:IKT) , 0.) + PSIGS(IIJB:IIJE,1:IKT) = SQRT(PSIGS(IIJB:IIJE,1:IKT)) #else - PSIGS(IIJB:IIJE,1:D%NKT) = SQRT( MAX (PSIGS(IIJB:IIJE,1:D%NKT) , 1.E-12) ) + PSIGS(IIJB:IIJE,1:IKT) = SQRT( MAX (PSIGS(IIJB:IIJE,1:IKT) , 1.E-12) ) #endif - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! diff --git a/src/common/turb/mode_turb_ver_thermo_flux.F90 b/src/common/turb/mode_turb_ver_thermo_flux.F90 index cb84c52a5c31ee58ca192dc23f958c17167ec19d..a0109e16f3798cec305350c215f59550ff6bc59e 100644 --- a/src/common/turb/mode_turb_ver_thermo_flux.F90 +++ b/src/common/turb/mode_turb_ver_thermo_flux.F90 @@ -377,10 +377,11 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: & ! INTEGER :: IKB,IKE ! I index values for the Beginning and End ! mass points of the domain in the 3 direct. -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU ! array size in k direction INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: JIJ, JK ! loop indexes INTEGER :: IIJB, IIJE +INTEGER :: IKL ! REAL :: ZTIME1, ZTIME2 REAL :: ZFLPROV @@ -410,10 +411,13 @@ IJU=D%NJT IIJE=D%NIJE IIJB=D%NIJB IKT=D%NKT +IKA=D%NKA +IKU=D%NKU IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKL=D%NKL ! GUSERV = (KRR/=0) ! @@ -422,13 +426,13 @@ GUSERV = (KRR/=0) IF (TURBN%LHARAT) THEN ! LHARAT so TKE and length scales at half levels! !wc 50MF can be omitted with energy cascade included - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZKEFF(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZKEFF(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT) * SQRT(PTKEM(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT) * SQRT(PTKEM(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZKEFF) ENDIF ! @@ -437,13 +441,13 @@ ENDIF IF(TURBN%LLEONARD) THEN IF ( KRRL >= 1 ) THEN IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZCLD_THOLD(IIJB:IIJE,1:D%NKT) = PRM(IIJB:IIJE,1:D%NKT,2) + PRM(IIJB:IIJE,1:D%NKT,4) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCLD_THOLD(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,2) + PRM(IIJB:IIJE,1:IKT,4) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZCLD_THOLD(IIJB:IIJE,1:D%NKT) = PRM(IIJB:IIJE,1:D%NKT,2) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCLD_THOLD(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF END IF @@ -476,16 +480,16 @@ END IF CALL DZM_PHY(D,PTHLM,ZWORK1) CALL D_PHI3DTDZ_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2) IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = -ZKEFF(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = -ZKEFF(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = -CSTURB%XCSHF*PPHI3(IIJB:IIJE,1:D%NKT)*ZKEFF(IIJB:IIJE,1:D%NKT)& - *ZWORK1(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*PPHI3(IIJB:IIJE,1:IKT)*ZKEFF(IIJB:IIJE,1:IKT)& + *ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF (TURBN%LLEONARD) THEN @@ -494,11 +498,11 @@ IF (TURBN%LLEONARD) THEN CALL MZM_PHY(D,PHGRAD(:,:,3),ZWORK2) ! GX_M_M(PTHLM CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM) CALL MZM_PHY(D,PHGRAD(:,:,4),ZWORK4) ! GY_M_M(PTHLM) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF_LEONARD (IIJB:IIJE,1:D%NKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:D%NKT)*PDYY(IIJB:IIJE,1:D%NKT)/12.0*( & - ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) & - + ZWORK3(IIJB:IIJE,1:D%NKT)*ZWORK4(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( & + ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) & + + ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Effect of 3rd order terms in temperature flux (at flux point) @@ -509,11 +513,11 @@ IF (GFWTH) THEN CALL D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,& & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM,ZWORK1) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT)= ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) * PFWTH(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFWTH(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT)= ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) * PFWTH(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFWTH(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'2)/dz @@ -523,12 +527,12 @@ IF (GFTH2) THEN & PD,PBLL_O_E,PETHETA,ZWORK1) CALL MZM_PHY(D,PFTH2,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2r')/dz @@ -536,11 +540,11 @@ IF (GFWR) THEN CALL M3_WTH_W2R(D,CSTURB,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZWORK1) CALL D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFWR(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFWR(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFWR(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFWR(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'r'2)/dz @@ -550,11 +554,11 @@ IF (GFR2) THEN CALL D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,& & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'r')/dz @@ -564,18 +568,18 @@ IF (GFTHR) THEN CALL D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,Z3RDMOMENT,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,ZWORK1) CALL MZM_PHY(D,PFTHR, ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - ZDFDDTDZ(IIJB:IIJE,1:D%NKT) = ZDFDDTDZ(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + ZDFDDTDZ(IIJB:IIJE,1:IKT) = ZDFDDTDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! specialcase for surface IF (OOCEAN) THEN ! ocean model in coupled case !$mnh_expand_array(JIJ=IIJB:IIJE) ZF(IIJB:IIJE,IKE+1) = PSFTHM(IIJB:IIJE) & - *0.5* ( 1. + PRHODJ(IIJB:IIJE,D%NKU)/PRHODJ(IIJB:IIJE,IKE) ) + *0.5* ( 1. + PRHODJ(IIJB:IIJE,IKU)/PRHODJ(IIJB:IIJE,IKE) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE ! atmosp bottom !*In 3D, a part of the flux goes vertically, @@ -585,13 +589,13 @@ ELSE ! atmosp bottom !$mnh_expand_array(JIJ=IIJB:IIJE) ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE) ) & * PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE) ) & / PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -608,54 +612,54 @@ CALL TRIDIAG_THERMO(D,PTHLM,ZF,ZDFDDTDZ,PTSTEP,TURBN%XIMPL,PDZZ,& ! ! Compute the equivalent tendency for the conservative potential temperature ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZRWTHL(IIJB:IIJE,1:D%NKT)= PRHODJ(IIJB:IIJE,1:D%NKT)*(PTHLP(IIJB:IIJE,1:D%NKT)-PTHLM(IIJB:IIJE,1:D%NKT))& +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZRWTHL(IIJB:IIJE,1:IKT)= PRHODJ(IIJB:IIJE,1:IKT)*(PTHLP(IIJB:IIJE,1:IKT)-PTHLM(IIJB:IIJE,1:IKT))& /PTSTEP -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD IF (TURBN%LLEONARD) THEN - DO JK=1,D%NKT + DO JK=1,IKT !$mnh_expand_array(JIJ=IIJB:IIJE) ZALT(IIJB:IIJE,JK) = PZZ(IIJB:IIJE,JK)-PZS(IIJB:IIJE) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO CALL MZM_PHY(D,PRHODJ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT)*ZF_LEONARD(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZF_LEONARD(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL GZ_W_M_PHY(D,ZWORK2,PDZZ,ZWORK3) - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:D%NKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:D%NKT) >= TURBN%XALTHGRAD) ) - ZRWTHL(IIJB:IIJE,1:D%NKT) = -ZWORK3(IIJB:IIJE,1:D%NKT) - PTHLP(IIJB:IIJE,1:D%NKT)=PTHLM(IIJB:IIJE,1:D%NKT)+PTSTEP*ZRWTHL(IIJB:IIJE,1:D%NKT)/PRHODJ(IIJB:IIJE,1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD) ) + ZRWTHL(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT) + PTHLP(IIJB:IIJE,1:IKT)=PTHLM(IIJB:IIJE,1:IKT)+PTSTEP*ZRWTHL(IIJB:IIJE,1:IKT)/PRHODJ(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZWORK1(IIJB:IIJE,1:D%NKT) = PTHLP(IIJB:IIJE,1:D%NKT) - PTHLM(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWORK1(IIJB:IIJE,1:IKT) = PTHLP(IIJB:IIJE,1:IKT) - PTHLM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK2) ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PRTHLS(IIJB:IIJE,1:D%NKT)= PRTHLS(IIJB:IIJE,1:D%NKT) + ZRWTHL(IIJB:IIJE,1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PRTHLS(IIJB:IIJE,1:IKT)= PRTHLS(IIJB:IIJE,1:IKT) + ZRWTHL(IIJB:IIJE,1:IKT) ! !* 2.2 Partial Thermal Production ! ! Conservative potential temperature flux : ! ! -ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:D%NKT) * & - ZWORK2(IIJB:IIJE,1:D%NKT)/ PDZZ(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + TURBN%XIMPL * ZDFDDTDZ(IIJB:IIJE,1:IKT) * & + ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! replace the flux by the Leonard terms IF (TURBN%LLEONARD) THEN - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:D%NKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:D%NKT) >= TURBN%XALTHGRAD) ) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF_LEONARD(IIJB:IIJE,1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD) ) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF_LEONARD(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! IF (OOCEAN) THEN @@ -664,30 +668,30 @@ IF (OOCEAN) THEN !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PWTH(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+D%NKL)) + PWTH(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PWTH(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+D%NKL)) +PWTH(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (OOCEAN) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) - PWTH(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+D%NKL)) - PWTH(IIJB:IIJE,D%NKA)=0. - PWTH(IIJB:IIJE,D%NKU)=PWTH(IIJB:IIJE,IKE)! not used + PWTH(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+IKL)) + PWTH(IIJB:IIJE,IKA)=0. + PWTH(IIJB:IIJE,IKU)=PWTH(IIJB:IIJE,IKE)! not used !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - PWTH(IIJB:IIJE,D%NKA)=0.5*(ZFLXZ(IIJB:IIJE,D%NKA)+ZFLXZ(IIJB:IIJE,D%NKA+D%NKL)) - PWTH(IIJB:IIJE,IKE)=PWTH(IIJB:IIJE,IKE-D%NKL) + PWTH(IIJB:IIJE,IKA)=0.5*(ZFLXZ(IIJB:IIJE,IKA)+ZFLXZ(IIJB:IIJE,IKA+IKL)) + PWTH(IIJB:IIJE,IKE)=PWTH(IIJB:IIJE,IKE-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! @@ -709,36 +713,36 @@ END IF ! Contribution of the conservative temperature flux to the buoyancy flux IF (OOCEAN) THEN CALL MZF_PHY(D,ZFLXZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PTP(IIJB:IIJE,1:D%NKT)= CST%XG*CST%XALPHAOC * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PTP(IIJB:IIJE,1:IKT)= CST%XG*CST%XALPHAOC * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE IF (KRR /= 0) THEN CALL MZM_PHY(D,PETHETA,ZWORK1) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !ZWORK1 = MZF( MZM(PETHETA,D%NKA, D%NKU, D%NKL) * ZFLXZ,D%NKA, D%NKU, D%NKL ) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PTP(IIJB:IIJE,1:D%NKT) = PBETA(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !ZWORK1 = MZF( MZM(PETHETA,IKA, IKU, IKL) * ZFLXZ,IKA, IKU, IKL ) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PTP(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) PTP(IIJB:IIJE,IKB)= PBETA(IIJB:IIJE,IKB) * PETHETA(IIJB:IIJE,IKB) * & - 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+D%NKL) ) + 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE CALL MZF_PHY(D,ZFLXZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PTP(IIJB:IIJE,1:D%NKT)= PBETA(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PTP(IIJB:IIJE,1:IKT)= PBETA(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! ! Buoyancy flux at flux points ! CALL MZM_PHY(D,PETHETA,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PWTHV(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PWTHV(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) PWTHV(IIJB:IIJE,IKB) = PETHETA(IIJB:IIJE,IKB) * ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -753,25 +757,25 @@ END IF ! Correction for qc and qi negative in AROME IF(HPROGRAM/='AROME ') THEN IF ( KRRL >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZF_PHY(D,ZWORK1,ZWORK2) IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRRS(IIJB:IIJE,1:D%NKT,2) = PRRS(IIJB:IIJE,1:D%NKT,2) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PATHETA(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - *ZWORK2(IIJB:IIJE,1:D%NKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:D%NKT)) - PRRS(IIJB:IIJE,1:D%NKT,4) = PRRS(IIJB:IIJE,1:D%NKT,4) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PATHETA(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - * ZWORK2(IIJB:IIJE,1:D%NKT)*PFRAC_ICE(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - & + PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + *ZWORK2(IIJB:IIJE,1:IKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:IKT)) + PRRS(IIJB:IIJE,1:IKT,4) = PRRS(IIJB:IIJE,1:IKT,4) - & + PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + * ZWORK2(IIJB:IIJE,1:IKT)*PFRAC_ICE(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRRS(IIJB:IIJE,1:D%NKT,2) = PRRS(IIJB:IIJE,1:D%NKT,2) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PATHETA(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - *ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - & + PRHODJ(IIJB:IIJE,1:IKT)*PATHETA(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + *ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF END IF @@ -785,62 +789,62 @@ IF (TLES%LLES_CALL) THEN ! CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WThl ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PWM(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_W_SBG_WThl ) ! CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaThl ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PDTH_DZ(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Thl_SBG_UaThl ) ! CALL MZM_PHY(D,PETHETA,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK3,ZWORK4) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:D%NKT)/PLM(IIJB:IIJE,1:D%NKT) & - *ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:IKT)/PLM(IIJB:IIJE,1:IKT) & + *ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_ThlPz ) ! IF (KRR>=1) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PDR_DZ(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Rt_SBG_UaThl ) END IF ! !* diagnostic of mixing coefficient for heat CALL DZM_PHY(D,PTHLP,ZA) - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE (ZA(IIJB:IIJE,1:D%NKT)==0.) - ZA(IIJB:IIJE,1:D%NKT)=1.E-6 + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE (ZA(IIJB:IIJE,1:IKT)==0.) + ZA(IIJB:IIJE,1:IKT)=1.E-6 END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = - ZFLXZ(IIJB:IIJE,1:D%NKT) / ZA(IIJB:IIJE,1:D%NKT) * PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = - ZFLXZ(IIJB:IIJE,1:IKT) / ZA(IIJB:IIJE,1:IKT) * PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) ZA(IIJB:IIJE,IKB) = CSTURB%XCSHF*PPHI3(IIJB:IIJE,IKB)*ZKEFF(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) CALL MZF_PHY(D,ZA,ZA) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = MIN(MAX(ZA(IIJB:IIJE,1:D%NKT),-1000.),1000.) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = MIN(MAX(ZA(IIJB:IIJE,1:IKT),-1000.),1000.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZA, TLES%X_LES_SUBGRID_Kh ) ! CALL SECOND_MNH(ZTIME2) @@ -866,17 +870,17 @@ IF (KRR /= 0) THEN ! CALL DZM_PHY(D,PRM(:,:,1),ZWORK1) IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = -ZKEFF(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = -ZKEFF(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = -ZKEFF(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE CALL D_PSI3DRDZ_O_DDRDZ(D,CSTURB,PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,TURBN%CTURBDIM,GUSERV,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = -CSTURB%XCSHF*PPSI3(IIJB:IIJE,1:D%NKT)*ZKEFF(IIJB:IIJE,1:D%NKT)& - *ZWORK1(IIJB:IIJE,1:D%NKT)/PDZZ(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*PPSI3(IIJB:IIJE,1:IKT)*ZKEFF(IIJB:IIJE,1:IKT)& + *ZWORK1(IIJB:IIJE,1:IKT)/PDZZ(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = -CSTURB%XCSHF*ZKEFF(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF ! ! Compute Leonard Terms for Cloud mixing ratio @@ -885,11 +889,11 @@ IF (KRR /= 0) THEN CALL MZM_PHY(D,PHGRAD(:,:,5),ZWORK2) ! GX_M_M(PRM) CALL MYF_PHY(D,PHGRAD(:,:,2),ZWORK3) ! GY_W_VW(PWM) CALL MZM_PHY(D,PHGRAD(:,:,6),ZWORK4) ! GY_M_M(PRM) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF_LEONARD (IIJB:IIJE,1:D%NKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:D%NKT)*PDYY(IIJB:IIJE,1:D%NKT)/12.0*( & - ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) & - + ZWORK3(IIJB:IIJE,1:D%NKT)*ZWORK4(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF_LEONARD (IIJB:IIJE,1:IKT)= TURBN%XCOEFHGRADTHL*PDXX(IIJB:IIJE,1:IKT)*PDYY(IIJB:IIJE,1:IKT)/12.0*( & + ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) & + + ZWORK3(IIJB:IIJE,1:IKT)*ZWORK4(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Effect of 3rd order terms in temperature flux (at flux point) @@ -900,11 +904,11 @@ IF (KRR /= 0) THEN CALL D_M3_WR_W2R_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,& & PBLL_O_E,PEMOIST,ZKEFF,PTKEM,ZWORK1) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT)= ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) * PFWR(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) & - * PFWR(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT)= ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) * PFWR(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) & + * PFWR(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'r'2)/dz @@ -914,12 +918,12 @@ IF (KRR /= 0) THEN CALL D_M3_WR_WR2_O_DDRDZ(D,CSTURB,Z3RDMOMENT,PREDR1,& & PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'2th')/dz @@ -929,11 +933,11 @@ IF (KRR /= 0) THEN CALL D_M3_WR_W2TH_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,& & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * PFWTH(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * PFWTH(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * PFWTH(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * PFWTH(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'2)/dz @@ -944,11 +948,11 @@ IF (KRR /= 0) THEN CALL D_M3_WR_WTH2_O_DDRDZ(D,CSTURB,PREDR1,PREDTH1,PD,& &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,ZWORK3) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK3(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! d(w'th'r')/dz @@ -959,12 +963,12 @@ IF (KRR /= 0) THEN CALL D_M3_WR_WTHR_O_DDRDZ(D,CSTURB,Z3RDMOMENT,PREDR1, & & PREDTH1,PD,PBLL_O_E,PEMOIST,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZF(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) + Z3RDMOMENT(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - ZDFDDRDZ(IIJB:IIJE,1:D%NKT) = ZDFDDRDZ(IIJB:IIJE,1:D%NKT) + ZWORK2(IIJB:IIJE,1:D%NKT) & - * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZF(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) + Z3RDMOMENT(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + ZDFDDRDZ(IIJB:IIJE,1:IKT) = ZDFDDRDZ(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) & + * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! !special case at sfc @@ -983,13 +987,13 @@ IF (KRR /= 0) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFRP(IIJB:IIJE) + PEXPL*PSFRM(IIJB:IIJE) ) & * PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) ZF(IIJB:IIJE,IKB) = ( TURBN%XIMPL*PSFRP(IIJB:IIJE) + PEXPL*PSFRM(IIJB:IIJE) ) & / PDIRCOSZW(IIJB:IIJE) & - * 0.5 * (1. + PRHODJ(IIJB:IIJE,D%NKA) / PRHODJ(IIJB:IIJE,IKB)) + * 0.5 * (1. + PRHODJ(IIJB:IIJE,IKA) / PRHODJ(IIJB:IIJE,IKB)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF ! atmos top @@ -1004,77 +1008,77 @@ IF (KRR /= 0) THEN ! ! Compute the equivalent tendency for the conservative mixing ratio ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZRWRNP(IIJB:IIJE,1:D%NKT) = PRHODJ(IIJB:IIJE,1:D%NKT)*(PRP(IIJB:IIJE,1:D%NKT)-PRM(IIJB:IIJE,1:D%NKT,1))& + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZRWRNP(IIJB:IIJE,1:IKT) = PRHODJ(IIJB:IIJE,1:IKT)*(PRP(IIJB:IIJE,1:IKT)-PRM(IIJB:IIJE,1:IKT,1))& /PTSTEP - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD IF (TURBN%LLEONARD) THEN CALL MZM_PHY(D,PRHODJ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT)*ZF_LEONARD(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT)*ZF_LEONARD(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL GZ_W_M_PHY(D,ZWORK2,PDZZ,ZWORK3) - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:D%NKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:D%NKT) >= TURBN%XALTHGRAD ) ) - ZRWRNP(IIJB:IIJE,1:D%NKT) = -ZWORK3(IIJB:IIJE,1:D%NKT) - PRP(IIJB:IIJE,1:D%NKT)=PRM(IIJB:IIJE,1:D%NKT,1)+PTSTEP*ZRWTHL(IIJB:IIJE,1:D%NKT)/PRHODJ(IIJB:IIJE,1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD ) ) + ZRWRNP(IIJB:IIJE,1:IKT) = -ZWORK3(IIJB:IIJE,1:IKT) + PRP(IIJB:IIJE,1:IKT)=PRM(IIJB:IIJE,1:IKT,1)+PTSTEP*ZRWTHL(IIJB:IIJE,1:IKT)/PRHODJ(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PRP(IIJB:IIJE,1:D%NKT) - PRM(IIJB:IIJE,1:D%NKT,1) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PRP(IIJB:IIJE,1:IKT) - PRM(IIJB:IIJE,1:IKT,1) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRRS(IIJB:IIJE,1:D%NKT,1) = PRRS(IIJB:IIJE,1:D%NKT,1) + ZRWRNP(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + ZRWRNP(IIJB:IIJE,1:IKT) ! !* 3.2 Complete thermal production ! ! cons. mixing ratio flux : ! - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF(IIJB:IIJE,1:D%NKT) & - + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) / PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF(IIJB:IIJE,1:IKT) & + + TURBN%XIMPL * ZDFDDRDZ(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) / PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD IF (TURBN%LLEONARD) THEN - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:D%NKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:D%NKT) >= TURBN%XALTHGRAD ) ) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZF_LEONARD(IIJB:IIJE,1:D%NKT) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE ( (ZCLD_THOLD(IIJB:IIJE,1:IKT) >= TURBN%XCLDTHOLD ) .AND. ( ZALT(IIJB:IIJE,1:IKT) >= TURBN%XALTHGRAD ) ) + ZFLXZ(IIJB:IIJE,1:IKT) = ZF_LEONARD(IIJB:IIJE,1:IKT) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (OOCEAN) THEN - ZFLXZ(IIJB:IIJE,D%NKU) = ZFLXZ(IIJB:IIJE,IKE) + ZFLXZ(IIJB:IIJE,IKU) = ZFLXZ(IIJB:IIJE,IKE) END IF ! DO JK=IKTB+1,IKTE-1 !$mnh_expand_array(JIJ=IIJB:IIJE) - PWRC(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+D%NKL)) + PWRC(IIJB:IIJE,JK)=0.5*(ZFLXZ(IIJB:IIJE,JK)+ZFLXZ(IIJB:IIJE,JK+IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) - PWRC(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+D%NKL)) + PWRC(IIJB:IIJE,IKB)=0.5*(ZFLXZ(IIJB:IIJE,IKB)+ZFLXZ(IIJB:IIJE,IKB+IKL)) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (OOCEAN) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) - PWRC(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+D%NKL)) - PWRC(IIJB:IIJE,D%NKA)=0. + PWRC(IIJB:IIJE,IKE)=0.5*(ZFLXZ(IIJB:IIJE,IKE)+ZFLXZ(IIJB:IIJE,IKE+IKL)) + PWRC(IIJB:IIJE,IKA)=0. PWRC(IIJB:IIJE,IKE+1)=ZFLXZ(IIJB:IIJE,IKE+1) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - PWRC(IIJB:IIJE,D%NKA)=0.5*(ZFLXZ(IIJB:IIJE,D%NKA)+ZFLXZ(IIJB:IIJE,D%NKA+D%NKL)) - PWRC(IIJB:IIJE,IKE)=PWRC(IIJB:IIJE,IKE-D%NKL) + PWRC(IIJB:IIJE,IKA)=0.5*(ZFLXZ(IIJB:IIJE,IKA)+ZFLXZ(IIJB:IIJE,IKA+IKL)) + PWRC(IIJB:IIJE,IKE)=PWRC(IIJB:IIJE,IKE-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ENDIF ! @@ -1096,34 +1100,34 @@ IF (KRR /= 0) THEN ! Contribution of the conservative water flux to the Buoyancy flux IF (OOCEAN) THEN CALL MZF_PHY(D,ZFLXZ,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT)= -CST%XG*CST%XBETAOC * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT)= -CST%XG*CST%XBETAOC * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE CALL MZM_PHY(D,PEMOIST,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK1,ZWORK2) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = PBETA(IIJB:IIJE,1:D%NKT) * ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = PBETA(IIJB:IIJE,1:IKT) * ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) ZA(IIJB:IIJE,IKB) = PBETA(IIJB:IIJE,IKB) * PEMOIST(IIJB:IIJE,IKB) * & - 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+D%NKL) ) + 0.5 * ( ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKB+IKL) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PTP(IIJB:IIJE,1:D%NKT) = PTP(IIJB:IIJE,1:D%NKT) + ZA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PTP(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) + ZA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! ! Buoyancy flux at flux points ! CALL MZM_PHY(D,PEMOIST,ZWORK1) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PWTHV(IIJB:IIJE,1:D%NKT)=PWTHV(IIJB:IIJE,1:D%NKT) + ZWORK1(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PWTHV(IIJB:IIJE,1:IKT)=PWTHV(IIJB:IIJE,1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) PWTHV(IIJB:IIJE,IKB) = PWTHV(IIJB:IIJE,IKB) + PEMOIST(IIJB:IIJE,IKB) * ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) @@ -1137,27 +1141,27 @@ IF (KRR /= 0) THEN ! Correction of qc and qi negative for AROME IF(HPROGRAM/='AROME ') THEN IF ( KRRL >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = ZFLXZ(IIJB:IIJE,1:D%NKT) / & - PDZZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = ZFLXZ(IIJB:IIJE,1:IKT) / & + PDZZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZF_PHY(D,ZWORK2,ZWORK1) ! IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRRS(IIJB:IIJE,1:D%NKT,2) = PRRS(IIJB:IIJE,1:D%NKT,2) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PAMOIST(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - *ZWORK1(IIJB:IIJE,1:D%NKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:D%NKT)) - PRRS(IIJB:IIJE,1:D%NKT,4) = PRRS(IIJB:IIJE,1:D%NKT,4) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PAMOIST(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - *ZWORK1(IIJB:IIJE,1:D%NKT) *PFRAC_ICE(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - & + PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + *ZWORK1(IIJB:IIJE,1:IKT) *(1.0-PFRAC_ICE(IIJB:IIJE,1:IKT)) + PRRS(IIJB:IIJE,1:IKT,4) = PRRS(IIJB:IIJE,1:IKT,4) - & + PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + *ZWORK1(IIJB:IIJE,1:IKT) *PFRAC_ICE(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRRS(IIJB:IIJE,1:D%NKT,2) = PRRS(IIJB:IIJE,1:D%NKT,2) - & - PRHODJ(IIJB:IIJE,1:D%NKT)*PAMOIST(IIJB:IIJE,1:D%NKT)*2.*PSRCM(IIJB:IIJE,1:D%NKT)& - *ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRRS(IIJB:IIJE,1:IKT,2) = PRRS(IIJB:IIJE,1:IKT,2) - & + PRHODJ(IIJB:IIJE,1:IKT)*PAMOIST(IIJB:IIJE,1:IKT)*2.*PSRCM(IIJB:IIJE,1:IKT)& + *ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF END IF @@ -1171,41 +1175,41 @@ END IF ! CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1, TLES%X_LES_SUBGRID_WRt ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PWM(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PWM(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_W_SBG_WRt ) ! CALL GZ_W_M_PHY(D,PWM,PDZZ,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_W_SBG_UaRt ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PDTH_DZ(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PDTH_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Thl_SBG_UaRt ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PDR_DZ(IIJB:IIJE,1:D%NKT)*ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PDR_DZ(IIJB:IIJE,1:IKT)*ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK2,ZWORK3) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK3, TLES%X_LES_RES_ddxa_Rt_SBG_UaRt ) ! CALL MZM_PHY(D,PEMOIST,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK3(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT) * ZFLXZ(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK3(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT) * ZFLXZ(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZF_PHY(D,ZWORK3,ZWORK4) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK4, TLES%X_LES_SUBGRID_WThv , .TRUE. ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:D%NKT)/PLM(IIJB:IIJE,1:D%NKT) & - *ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = -CSTURB%XCTP*PSQRT_TKE(IIJB:IIJE,1:IKT)/PLM(IIJB:IIJE,1:IKT) & + *ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_SUBGRID_RtPz ) CALL SECOND_MNH(ZTIME2) TLES%XTIME_LES = TLES%XTIME_LES + ZTIME2 - ZTIME1 @@ -1227,42 +1231,42 @@ IF ( ((TURBN%LTURB_FLX .AND. TPFILE%LOPENED) .OR. TLES%LLES_CALL) .AND. (KRRL > ! recover the Conservative potential temperature flux : ! With TURBN%LHARAT is true tke and length scales at half levels ! yet modify to use length scale and tke at half levels from vdfexcuhl - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = TURBN%XIMPL * PTHLP(IIJB:IIJE,1:D%NKT) + PEXPL * PTHLM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = TURBN%XIMPL * PTHLP(IIJB:IIJE,1:IKT) + PEXPL * PTHLM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL DZM_PHY(D,ZWORK1,ZWORK2) IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT)/ PDZZ(IIJB:IIJE,1:D%NKT) * & - (-PLM(IIJB:IIJE,1:D%NKT)*PSQRT_TKE(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT) * & + (-PLM(IIJB:IIJE,1:IKT)*PSQRT_TKE(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PLM(IIJB:IIJE,1:D%NKT)*PSQRT_TKE(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PLM(IIJB:IIJE,1:IKT)*PSQRT_TKE(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZA(IIJB:IIJE,1:D%NKT) = ZWORK2(IIJB:IIJE,1:D%NKT)/ PDZZ(IIJB:IIJE,1:D%NKT) * & - (-PPHI3(IIJB:IIJE,1:D%NKT)*ZWORK3(IIJB:IIJE,1:D%NKT)) * CSTURB%XCSHF - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZA(IIJB:IIJE,1:IKT) = ZWORK2(IIJB:IIJE,1:IKT)/ PDZZ(IIJB:IIJE,1:IKT) * & + (-PPHI3(IIJB:IIJE,1:IKT)*ZWORK3(IIJB:IIJE,1:IKT)) * CSTURB%XCSHF + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF !$mnh_expand_array(JIJ=IIJB:IIJE) ZA(IIJB:IIJE,IKB) = (TURBN%XIMPL*PSFTHP(IIJB:IIJE) + PEXPL*PSFTHM(IIJB:IIJE)) * PDIRCOSZW(IIJB:IIJE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! compute <w Rc> - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = PAMOIST(IIJB:IIJE,1:D%NKT) * 2.* PSRCM(IIJB:IIJE,1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = PATHETA(IIJB:IIJE,1:D%NKT) * 2.* PSRCM(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = PAMOIST(IIJB:IIJE,1:IKT) * 2.* PSRCM(IIJB:IIJE,1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = PATHETA(IIJB:IIJE,1:IKT) * 2.* PSRCM(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL MZM_PHY(D,ZWORK1,ZWORK3) CALL MZM_PHY(D,ZWORK2,ZWORK4) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFLXZ(IIJB:IIJE,1:D%NKT) = ZWORK3(IIJB:IIJE,1:D%NKT)* ZFLXZ(IIJB:IIJE,1:D%NKT) & - + ZWORK4(IIJB:IIJE,1:D%NKT)* ZA(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFLXZ(IIJB:IIJE,1:IKT) = ZWORK3(IIJB:IIJE,1:IKT)* ZFLXZ(IIJB:IIJE,1:IKT) & + + ZWORK4(IIJB:IIJE,1:IKT)* ZA(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) !$mnh_expand_array(JIJ=IIJB:IIJE) - ZFLXZ(IIJB:IIJE,D%NKA) = ZFLXZ(IIJB:IIJE,IKB) + ZFLXZ(IIJB:IIJE,IKA) = ZFLXZ(IIJB:IIJE,IKB) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! ! store the liquid water mixing ratio vertical flux diff --git a/src/common/turb/mode_update_iiju_phy.F90 b/src/common/turb/mode_update_iiju_phy.F90 index b109abd0498c882704fca028f030cffc12f7f837..c67545befe1ec9fba984d2ea008431bb8692963c 100644 --- a/src/common/turb/mode_update_iiju_phy.F90 +++ b/src/common/turb/mode_update_iiju_phy.F90 @@ -52,7 +52,7 @@ IMPLICIT NONE TYPE(DIMPHYEX_t), INTENT(IN) :: D REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PVAR ! working variable ! -INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU +INTEGER :: IIE,IIB,IJE,IJB,IIU,IJU,IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',0,ZHOOK_HANDLE) @@ -62,9 +62,10 @@ IJE=D%NJEC IJB=D%NJBC IIU=D%NIT IJU=D%NJT +IKT=D%NKT ! -PVAR(IIU,IJB:IJE,1:D%NKT) = PVAR(IIU-1,IJB:IJE,1:D%NKT) -PVAR(IIB:IIE,IJU,1:D%NKT) = PVAR(IIB:IIE,IJU-1,1:D%NKT) +PVAR(IIU,IJB:IJE,1:IKT) = PVAR(IIU-1,IJB:IJE,1:IKT) +PVAR(IIB:IIE,IJU,1:IKT) = PVAR(IIB:IIE,IJU-1,1:IKT) ! IF (LHOOK) CALL DR_HOOK('UPDATE_IIJU_PHY',1,ZHOOK_HANDLE) END SUBROUTINE UPDATE_IIJU_PHY diff --git a/src/common/turb/shallow_mf.F90 b/src/common/turb/shallow_mf.F90 index 1027e0cfc0b61a34a680d8b87b29dfa0b61aeb06..7315b0f8b636904144109b08afe2a0dd024f1801 100644 --- a/src/common/turb/shallow_mf.F90 +++ b/src/common/turb/shallow_mf.F90 @@ -183,14 +183,20 @@ REAL, DIMENSION(D%NIJT,D%NKT) :: ZRSAT_UP ! Rsat in updraft LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux INTEGER, DIMENSION(D%NIJT,D%NKT) :: IERR -INTEGER :: JI, JK +INTEGER :: JIJ, JK +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKT ! REAL(KIND=JPRB) :: ZHOOK_HANDLE !------------------------------------------------------------------------ !!! 1. Initialisation IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE) - +! +IIJE=D%NIJE +IIJB=D%NIJB +IKT=D%NKT +! ! updraft governing variables IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN PENTR = 1.E20 @@ -202,15 +208,15 @@ ENDIF ! Thermodynamics functions ZFRAC_ICE(:,:) = 0. IF (KRR.GE.4) THEN - !$mnh_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) - WHERE(PRM(D%NIJB:D%NIJE,1:D%NKT,2)+PRM(D%NIJB:D%NIJE,1:D%NKT,4) > 1.E-20) - ZFRAC_ICE(D%NIJB:D%NIJE,1:D%NKT) = PRM(D%NIJB:D%NIJE,1:D%NKT,4) / (PRM(D%NIJB:D%NIJE,1:D%NKT,2)+PRM(D%NIJB:D%NIJE,1:D%NKT,4)) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE(PRM(IIJB:IIJE,1:IKT,2)+PRM(IIJB:IIJE,1:IKT,4) > 1.E-20) + ZFRAC_ICE(IIJB:IIJE,1:IKT) = PRM(IIJB:IIJE,1:IKT,4) / (PRM(IIJB:IIJE,1:IKT,2)+PRM(IIJB:IIJE,1:IKT,4)) ENDWHERE - !$mnh_end_expand_where(JI=D%NIJB:D%NIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ENDIF -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZWK(D%NIJB:D%NIJE,1:D%NKT)=PTHM(D%NIJB:D%NIJE,1:D%NKT)*PEXNM(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZWK(IIJB:IIJE,1:IKT)=PTHM(IIJB:IIJE,1:IKT)*PEXNM(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),ZWK(:,:), IERR(:,:)) ! Conservative variables at t-dt @@ -219,10 +225,10 @@ CALL THL_RT_FROM_TH_R_MF(D, CST, KRR,KRRL,KRRI, & ZTHLM, ZRTM ) ! Virtual potential temperature at t-dt -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZTHVM(D%NIJB:D%NIJE,1:D%NKT) = PTHM(D%NIJB:D%NIJE,1:D%NKT)*& - & ((1.+CST%XRV / CST%XRD *PRM(D%NIJB:D%NIJE,1:D%NKT,1))/(1.+ZRTM(D%NIJB:D%NIJE,1:D%NKT))) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZTHVM(IIJB:IIJE,1:IKT) = PTHM(IIJB:IIJE,1:IKT)*& + & ((1.+CST%XRV / CST%XRD *PRM(IIJB:IIJE,1:IKT,1))/(1.+ZRTM(IIJB:IIJE,1:IKT))) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !!! 2. Compute updraft !!! --------------- @@ -294,9 +300,9 @@ CALL COMPUTE_MF_CLOUD(D, CST, CSTURB, PARAMMF, OSTATNW, & !!! 3. Compute fluxes of conservative variables and their divergence = tendency !!! ------------------------------------------------------------------------ ! -!$mnh_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) -ZEMF_O_RHODREF(D%NIJB:D%NIJE,1:D%NKT)=PEMF(D%NIJB:D%NIJE,1:D%NKT)/PRHODREF(D%NIJB:D%NIJE,1:D%NKT) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZEMF_O_RHODREF(IIJB:IIJE,1:IKT)=PEMF(IIJB:IIJE,1:IKT)/PRHODREF(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF ( PIMPL_MF > 1.E-10 ) THEN CALL MF_TURB(D, KSV, OMIXUV, & diff --git a/src/common/turb/shuman_mf.F90 b/src/common/turb/shuman_mf.F90 index 567347cbe7dc59c80935119686968b482808db3b..b2c36ff65890346fab17693dd60df0f25879f49c 100644 --- a/src/common/turb/shuman_mf.F90 +++ b/src/common/turb/shuman_mf.F90 @@ -117,7 +117,17 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZF ! result at mass !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK, JI +INTEGER :: JK, JIJ +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKA,IKU,IKT +INTEGER :: IKL +! +IIJE=D%NIJE +IIJB=D%NIJB +IKA=D%NKA +IKU=D%NKU +IKT=D%NKT +IKL=D%NKL ! ! !------------------------------------------------------------------------------- @@ -125,15 +135,15 @@ INTEGER :: JK, JI !* 1. DEFINITION OF MZF ! ------------------ ! -DO JK=2,D%NKT-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PMZF(D%NIJB:D%NIJE,JK) = 0.5*( PA(D%NIJB:D%NIJE,JK)+PA(D%NIJB:D%NIJE,JK+D%NKL) ) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=2,IKT-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + PMZF(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK+IKL) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PMZF(D%NIJB:D%NIJE,D%NKA) = 0.5*( PA(D%NIJB:D%NIJE,D%NKA)+PA(D%NIJB:D%NIJE,D%NKA+D%NKL) ) -PMZF(D%NIJB:D%NIJE,D%NKU) = PA(D%NIJB:D%NIJE,D%NKU) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PMZF(IIJB:IIJE,IKA) = 0.5*( PA(IIJB:IIJE,IKA)+PA(IIJB:IIJE,IKA+IKL) ) +PMZF(IIJB:IIJE,IKU) = PA(IIJB:IIJE,IKU) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! @@ -198,23 +208,31 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PMZM ! result at flux localizati !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK, JI +INTEGER :: JK, JIJ +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKA,IKU,IKT +! ! +IIJE=D%NIJE +IIJB=D%NIJB +IKA=D%NKA +IKU=D%NKU +IKT=D%NKT ! !------------------------------------------------------------------------------- ! !* 1. DEFINITION OF MZM ! ------------------ ! -DO JK=2,D%NKT-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PMZM(D%NIJB:D%NIJE,JK) = 0.5*( PA(D%NIJB:D%NIJE,JK)+PA(D%NIJB:D%NIJE,JK-D%NKL) ) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=2,IKT-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + PMZM(IIJB:IIJE,JK) = 0.5*( PA(IIJB:IIJE,JK)+PA(IIJB:IIJE,JK-IKL) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PMZM(D%NIJB:D%NIJE,D%NKA) = PA(D%NIJB:D%NIJE,D%NKA) -PMZM(D%NIJB:D%NIJE,D%NKU) = 0.5*( PA(D%NIJB:D%NIJE,D%NKU)+PA(D%NIJB:D%NIJE,D%NKU-D%NKL) ) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PMZM(IIJB:IIJE,IKA) = PA(IIJB:IIJE,IKA) +PMZM(IIJB:IIJE,IKU) = 0.5*( PA(IIJB:IIJE,IKU)+PA(IIJB:IIJE,IKU-IKL) ) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! @@ -280,22 +298,30 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZF ! result at mass !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK, JI +INTEGER :: JK, JIJ +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKA,IKU,IKT ! !------------------------------------------------------------------------------- ! +IIJE=D%NIJE +IIJB=D%NIJB +IKA=D%NKA +IKU=D%NKU +IKT=D%NKT +! !* 1. DEFINITION OF DZF ! ------------------ ! -DO JK=2,D%NKT-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PDZF(D%NIJB:D%NIJE,JK) = PA(D%NIJB:D%NIJE,JK+D%NKL) - PA(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=2,IKT-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + PDZF(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK+IKL) - PA(IIJB:IIJE,JK) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PDZF(D%NIJB:D%NIJE,D%NKA) = PA(D%NIJB:D%NIJE,D%NKA+D%NKL) - PA(D%NIJB:D%NIJE,D%NKA) -PDZF(D%NIJB:D%NIJE,D%NKU) = 0. -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PDZF(IIJB:IIJE,IKA) = PA(IIJB:IIJE,IKA+IKL) - PA(IIJB:IIJE,IKA) +PDZF(IIJB:IIJE,IKU) = 0. +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! @@ -361,22 +387,30 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PDZM ! result at flux !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER :: JK, JI +INTEGER :: JK, JIJ +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKA,IKU,IKT ! !------------------------------------------------------------------------------- ! +IIJE=D%NIJE +IIJB=D%NIJB +IKA=D%NKA +IKU=D%NKU +IKT=D%NKT +! !* 1. DEFINITION OF DZM ! ------------------ ! -DO JK=2,D%NKT-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PDZM(D%NIJB:D%NIJE,JK) = PA(D%NIJB:D%NIJE,JK) - PA(D%NIJB:D%NIJE,JK-D%NKL) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=2,IKT-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + PDZM(IIJB:IIJE,JK) = PA(IIJB:IIJE,JK) - PA(IIJB:IIJE,JK-IKL) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PDZM(D%NIJB:D%NIJE,D%NKA) = 0. -PDZM(D%NIJB:D%NIJE,D%NKU) = PA(D%NIJB:D%NIJE,D%NKU) - PA(D%NIJB:D%NIJE,D%NKU-D%NKL) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PDZM(IIJB:IIJE,IKA) = 0. +PDZM(IIJB:IIJE,IKU) = PA(IIJB:IIJE,IKU) - PA(IIJB:IIJE,IKU-IKL) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! @@ -443,21 +477,29 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PGZ_M_W ! result at flux side !* 0.2 Declarations of local variables ! ------------------------------- ! -INTEGER JK, JI +INTEGER JK, JIJ +INTEGER :: IIJB,IIJE ! physical horizontal domain indices +INTEGER :: IKA,IKU,IKT !------------------------------------------------------------------------------- ! +IIJE=D%NIJE +IIJB=D%NIJB +IKA=D%NKA +IKU=D%NKU +IKT=D%NKT +! !* 1. COMPUTE THE GRADIENT ALONG Z ! ----------------------------- ! -DO JK=2,D%NKT-1 - !$mnh_expand_array(JI=D%NIJB:D%NIJE) - PGZ_M_W(D%NIJB:D%NIJE,JK) = (PY(D%NIJB:D%NIJE,JK) - PY(D%NIJB:D%NIJE,JK-D%NKL)) / PDZZ(D%NIJB:D%NIJE,JK) - !$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +DO JK=2,IKT-1 + !$mnh_expand_array(JIJ=IIJB:IIJE) + PGZ_M_W(IIJB:IIJE,JK) = (PY(IIJB:IIJE,JK) - PY(IIJB:IIJE,JK-IKL)) / PDZZ(IIJB:IIJE,JK) + !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO -!$mnh_expand_array(JI=D%NIJB:D%NIJE) -PGZ_M_W(D%NIJB:D%NIJE,D%NKA) = 0. -PGZ_M_W(D%NIJB:D%NIJE,D%NKU) = (PY(D%NIJB:D%NIJE,D%NKU) - PY(D%NIJB:D%NIJE,D%NKU-D%NKL)) / PDZZ(D%NIJB:D%NIJE,D%NKU) -!$mnh_end_expand_array(JI=D%NIJB:D%NIJE) +!$mnh_expand_array(JIJ=IIJB:IIJE) +PGZ_M_W(IIJB:IIJE,IKA) = 0. +PGZ_M_W(IIJB:IIJE,IKU) = (PY(IIJB:IIJE,IKU) - PY(IIJB:IIJE,IKU-IKL)) / PDZZ(IIJB:IIJE,IKU) +!$mnh_end_expand_array(JIJ=IIJB:IIJE) ! !------------------------------------------------------------------------------- ! diff --git a/src/common/turb/turb.F90 b/src/common/turb/turb.F90 index 5b129d93af8cdda9329f1c15caf8f76d6a0e914b..e0713fcd3a642d3f4888df1f9548d6769958e08a 100644 --- a/src/common/turb/turb.F90 +++ b/src/common/turb/turb.F90 @@ -489,7 +489,8 @@ REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the INTEGER :: IIJB,IIJE,IKB,IKE ! index value for the INTEGER :: IINFO_ll ! return code of parallel routine ! Beginning and the End of the physical domain for the mass points -INTEGER :: IKT ! array size in k direction +INTEGER :: IKT,IKA,IKU ! array size in k direction +INTEGER :: IKL INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain INTEGER :: JRR,JK,JSV ! loop counters INTEGER :: JIJ ! loop counters @@ -522,6 +523,9 @@ IKTB=D%NKTB IKTE=D%NKTE IKB=D%NKB IKE=D%NKE +IKA=D%NKA +IKU=D%NKU +IKL=D%NKL IIJE=D%NIJE IIJB=D%NIJB ! @@ -530,12 +534,12 @@ ZRVORD= CST%XRV / CST%XRD ! !Copy data into ZTHLM and ZRM only if needed IF (TURBN%CTURBLEN=='BL89' .OR. TURBN%CTURBLEN=='RM17' .OR. TURBN%CTURBLEN=='ADAP' .OR. TURBN%LRMC01) THEN - ZTHLM(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) - ZRM(IIJB:IIJE,1:D%NKT,:) = PRT(IIJB:IIJE,1:D%NKT,:) + ZTHLM(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) + ZRM(IIJB:IIJE,1:IKT,:) = PRT(IIJB:IIJE,1:IKT,:) END IF ! !Save LIMA scalar variables sources -ZRSVS(IIJB:IIJE,1:D%NKT,1:KSV)=PRSVS(IIJB:IIJE,1:D%NKT,1:KSV) +ZRSVS(IIJB:IIJE,1:IKT,1:KSV)=PRSVS(IIJB:IIJE,1:IKT,1:KSV) ! ! !---------------------------------------------------------------------------- @@ -545,53 +549,53 @@ ZRSVS(IIJB:IIJE,1:D%NKT,1:KSV)=PRSVS(IIJB:IIJE,1:D%NKT,1:KSV) ! !* 2.1 Cph at t ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZCP(IIJB:IIJE,1:D%NKT)=CST%XCPD +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZCP(IIJB:IIJE,1:IKT)=CST%XCPD ! -IF (KRR > 0) ZCP(IIJB:IIJE,1:D%NKT) = ZCP(IIJB:IIJE,1:D%NKT) + CST%XCPV * PRT(IIJB:IIJE,1:D%NKT,1) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +IF (KRR > 0) ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCPV * PRT(IIJB:IIJE,1:IKT,1) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) DO JRR = 2,1+KRRL ! loop on the liquid components -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZCP(IIJB:IIJE,1:D%NKT) = ZCP(IIJB:IIJE,1:D%NKT) + CST%XCL * PRT(IIJB:IIJE,1:D%NKT,JRR) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCL * PRT(IIJB:IIJE,1:IKT,JRR) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO ! DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZCP(IIJB:IIJE,1:D%NKT) = ZCP(IIJB:IIJE,1:D%NKT) + CST%XCI * PRT(IIJB:IIJE,1:D%NKT,JRR) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZCP(IIJB:IIJE,1:IKT) = ZCP(IIJB:IIJE,1:IKT) + CST%XCI * PRT(IIJB:IIJE,1:IKT,JRR) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END DO ! !* 2.2 Exner function at t ! IF (OOCEAN) THEN -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZEXN(IIJB:IIJE,1:D%NKT) = 1. -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZEXN(IIJB:IIJE,1:IKT) = 1. +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZEXN(IIJB:IIJE,1:D%NKT) = (PPABST(IIJB:IIJE,1:D%NKT)/CST%XP00) ** (CST%XRD/CST%XCPD) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZEXN(IIJB:IIJE,1:IKT) = (PPABST(IIJB:IIJE,1:IKT)/CST%XP00) ** (CST%XRD/CST%XCPD) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! !* 2.3 dissipative heating coeff a t ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZCOEF_DISS(IIJB:IIJE,1:D%NKT) = 1/(ZCP(IIJB:IIJE,1:D%NKT) * ZEXN(IIJB:IIJE,1:D%NKT)) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZCOEF_DISS(IIJB:IIJE,1:IKT) = 1/(ZCP(IIJB:IIJE,1:IKT) * ZEXN(IIJB:IIJE,1:IKT)) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ! -ZFRAC_ICE(IIJB:IIJE,1:D%NKT) = 0.0 -ZATHETA(IIJB:IIJE,1:D%NKT) = 0.0 -ZAMOIST(IIJB:IIJE,1:D%NKT) = 0.0 +ZFRAC_ICE(IIJB:IIJE,1:IKT) = 0.0 +ZATHETA(IIJB:IIJE,1:IKT) = 0.0 +ZAMOIST(IIJB:IIJE,1:IKT) = 0.0 ! IF (KRRL >=1) THEN ! !* 2.4 Temperature at t ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZT(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) * ZEXN(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) * ZEXN(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !* 2.5 Lv/Cph/Exn ! @@ -609,21 +613,21 @@ IF (KRRL >=1) THEN ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE) ENDIF ! - !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) - WHERE(PRT(IIJB:IIJE,1:D%NKT,2)+PRT(IIJB:IIJE,1:D%NKT,4)>0.0) - ZFRAC_ICE(IIJB:IIJE,1:D%NKT) = PRT(IIJB:IIJE,1:D%NKT,4) / ( PRT(IIJB:IIJE,1:D%NKT,2) & - +PRT(IIJB:IIJE,1:D%NKT,4) ) + !$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) + WHERE(PRT(IIJB:IIJE,1:IKT,2)+PRT(IIJB:IIJE,1:IKT,4)>0.0) + ZFRAC_ICE(IIJB:IIJE,1:IKT) = PRT(IIJB:IIJE,1:IKT,4) / ( PRT(IIJB:IIJE,1:IKT,2) & + +PRT(IIJB:IIJE,1:IKT,4) ) END WHERE - !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZLOCPEXNM(IIJB:IIJE,1:D%NKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:D%NKT))*ZLVOCPEXNM(IIJB:IIJE,1:D%NKT) & - +ZFRAC_ICE(IIJB:IIJE,1:D%NKT) *ZLSOCPEXNM(IIJB:IIJE,1:D%NKT) - ZAMOIST(IIJB:IIJE,1:D%NKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:D%NKT))*ZAMOIST(IIJB:IIJE,1:D%NKT) & - +ZFRAC_ICE(IIJB:IIJE,1:D%NKT) *ZAMOIST_ICE(IIJB:IIJE,1:D%NKT) - ZATHETA(IIJB:IIJE,1:D%NKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:D%NKT))*ZATHETA(IIJB:IIJE,1:D%NKT) & - +ZFRAC_ICE(IIJB:IIJE,1:D%NKT) *ZATHETA_ICE(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +! + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZLOCPEXNM(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZLVOCPEXNM(IIJB:IIJE,1:IKT) & + +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZLSOCPEXNM(IIJB:IIJE,1:IKT) + ZAMOIST(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZAMOIST(IIJB:IIJE,1:IKT) & + +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZAMOIST_ICE(IIJB:IIJE,1:IKT) + ZATHETA(IIJB:IIJE,1:IKT) = (1.0-ZFRAC_ICE(IIJB:IIJE,1:IKT))*ZATHETA(IIJB:IIJE,1:IKT) & + +ZFRAC_ICE(IIJB:IIJE,1:IKT) *ZATHETA_ICE(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE !wc call new stat functions or not IF (TURBN%LSTATNW) THEN @@ -663,38 +667,38 @@ IF (KRRL >=1) THEN END IF ! ELSE - ZLOCPEXNM(IIJB:IIJE,1:D%NKT)=0. + ZLOCPEXNM(IIJB:IIJE,1:IKT)=0. END IF ! loop end on KRRL >= 1 ! ! computes conservative variables ! IF ( KRRL >= 1 ) THEN IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Rnp at t - PRT(IIJB:IIJE,1:D%NKT,1) = PRT(IIJB:IIJE,1:D%NKT,1) + PRT(IIJB:IIJE,1:D%NKT,2) & - + PRT(IIJB:IIJE,1:D%NKT,4) - PRRS(IIJB:IIJE,1:D%NKT,1) = PRRS(IIJB:IIJE,1:D%NKT,1) + PRRS(IIJB:IIJE,1:D%NKT,2) & - + PRRS(IIJB:IIJE,1:D%NKT,4) + PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) + PRT(IIJB:IIJE,1:IKT,2) & + + PRT(IIJB:IIJE,1:IKT,4) + PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + PRRS(IIJB:IIJE,1:IKT,2) & + + PRRS(IIJB:IIJE,1:IKT,4) ! Theta_l at t - PTHLT(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) - ZLVOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRT(IIJB:IIJE,1:D%NKT,2) & - - ZLSOCPEXNM(IIJB:IIJE,1:D%NKT) * PRT(IIJB:IIJE,1:D%NKT,4) - PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) - ZLVOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRRS(IIJB:IIJE,1:D%NKT,2) & - - ZLSOCPEXNM(IIJB:IIJE,1:D%NKT) * PRRS(IIJB:IIJE,1:D%NKT,4) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) - ZLVOCPEXNM(IIJB:IIJE,1:IKT) & + * PRT(IIJB:IIJE,1:IKT,2) & + - ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRT(IIJB:IIJE,1:IKT,4) + PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - ZLVOCPEXNM(IIJB:IIJE,1:IKT) & + * PRRS(IIJB:IIJE,1:IKT,2) & + - ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRRS(IIJB:IIJE,1:IKT,4) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! Rnp at t - PRT(IIJB:IIJE,1:D%NKT,1) = PRT(IIJB:IIJE,1:D%NKT,1) + PRT(IIJB:IIJE,1:D%NKT,2) - PRRS(IIJB:IIJE,1:D%NKT,1) = PRRS(IIJB:IIJE,1:D%NKT,1) + PRRS(IIJB:IIJE,1:D%NKT,2) + PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) + PRT(IIJB:IIJE,1:IKT,2) + PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) + PRRS(IIJB:IIJE,1:IKT,2) ! Theta_l at t - PTHLT(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) - ZLOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRT(IIJB:IIJE,1:D%NKT,2) - PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) - ZLOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRRS(IIJB:IIJE,1:D%NKT,2) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) - ZLOCPEXNM(IIJB:IIJE,1:IKT) & + * PRT(IIJB:IIJE,1:IKT,2) + PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - ZLOCPEXNM(IIJB:IIJE,1:IKT) & + * PRRS(IIJB:IIJE,1:IKT,2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! @@ -735,10 +739,10 @@ SELECT CASE (TURBN%CTURBLEN) CALL MZF_PHY(D,ZWORK1,ZWORK2) CALL MYF_PHY(D,ZWORK2,ZDVDZ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZSHEAR(IIJB:IIJE,1:D%NKT) = SQRT(ZDUDZ(IIJB:IIJE,1:D%NKT)*ZDUDZ(IIJB:IIJE,1:D%NKT) & - + ZDVDZ(IIJB:IIJE,1:D%NKT)*ZDVDZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)*ZDUDZ(IIJB:IIJE,1:IKT) & + + ZDVDZ(IIJB:IIJE,1:IKT)*ZDVDZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM) ! !* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths @@ -753,10 +757,10 @@ SELECT CASE (TURBN%CTURBLEN) CALL MZF_PHY(D,ZWORK1,ZWORK2) CALL MYF_PHY(D,ZWORK2,ZDVDZ) ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZSHEAR(IIJB:IIJE,1:D%NKT) = SQRT(ZDUDZ(IIJB:IIJE,1:D%NKT)*ZDUDZ(IIJB:IIJE,1:D%NKT) & - + ZDVDZ(IIJB:IIJE,1:D%NKT)*ZDVDZ(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZSHEAR(IIJB:IIJE,1:IKT) = SQRT(ZDUDZ(IIJB:IIJE,1:IKT)*ZDUDZ(IIJB:IIJE,1:IKT) & + + ZDVDZ(IIJB:IIJE,1:IKT)*ZDVDZ(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN,HPROGRAM) CALL DELT(ZLMW,ODZ=.FALSE.) @@ -766,9 +770,9 @@ SELECT CASE (TURBN%CTURBLEN) !and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well) ! For grid meshes in the grey zone, then this is the smaller of the two. ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZLM(IIJB:IIJE,1:D%NKT) = MIN(ZLM(IIJB:IIJE,1:D%NKT),TURBN%XCADAP*ZLMW(IIJB:IIJE,1:D%NKT)) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZLM(IIJB:IIJE,1:IKT) = MIN(ZLM(IIJB:IIJE,1:IKT),TURBN%XCADAP*ZLMW(IIJB:IIJE,1:IKT)) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !* 3.4 Delta mixing length ! ------------------- @@ -787,16 +791,16 @@ SELECT CASE (TURBN%CTURBLEN) ! CASE ('BLKR') ZL0 = 100. - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZLM(IIJB:IIJE,1:D%NKT) = ZL0 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZLM(IIJB:IIJE,1:IKT) = ZL0 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ZALPHA=0.5**(-1.5) ! DO JK=IKTB,IKTE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZLM(IIJB:IIJE,JK) = ( 0.5*(PZZ(IIJB:IIJE,JK)+PZZ(IIJB:IIJE,JK+D%NKL)) - & - & PZZ(IIJB:IIJE,D%NKA+JPVEXT_TURB*D%NKL) ) * PDIRCOSZW(IIJB:IIJE) + ZLM(IIJB:IIJE,JK) = ( 0.5*(PZZ(IIJB:IIJE,JK)+PZZ(IIJB:IIJE,JK+IKL)) - & + & PZZ(IIJB:IIJE,IKA+JPVEXT_TURB*IKL) ) * PDIRCOSZW(IIJB:IIJE) ZLM(IIJB:IIJE,JK) = ZALPHA * ZLM(IIJB:IIJE,JK) * ZL0 / ( ZL0 + ZALPHA*ZLM(IIJB:IIJE,JK) ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO @@ -820,11 +824,11 @@ ENDIF ! end LHARRAT ! ------------------ IF (TURBN%LHARAT) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZLEPS(IIJB:IIJE,1:D%NKT)=PLENGTHM(IIJB:IIJE,1:D%NKT)*(3.75**2.) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZLEPS(IIJB:IIJE,1:IKT)=PLENGTHM(IIJB:IIJE,1:IKT)*(3.75**2.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - ZLEPS(IIJB:IIJE,1:D%NKT)=ZLM(IIJB:IIJE,1:D%NKT) + ZLEPS(IIJB:IIJE,1:IKT)=ZLM(IIJB:IIJE,1:IKT) ENDIF ! !* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001) @@ -849,9 +853,9 @@ END IF ! !RMC01 is only applied on RM17 in ADAP IF (TURBN%CTURBLEN=='ADAP') THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZLEPS(IIJB:IIJE,1:D%NKT) = MIN(ZLEPS(IIJB:IIJE,1:D%NKT),ZLMW(IIJB:IIJE,1:D%NKT)*TURBN%XCADAP) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZLEPS(IIJB:IIJE,1:IKT) = MIN(ZLEPS(IIJB:IIJE,1:IKT),ZLMW(IIJB:IIJE,1:IKT)*TURBN%XCADAP) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! !* 3.8 Mixing length in external points (used if TURBN%CTURBDIM="3DIM") @@ -886,12 +890,12 @@ IF (HPROGRAM/='AROME ') THEN ! CALL UPDATE_ROTATE_WIND(D,ZUSLOPE,ZVSLOPE,HLBCX,HLBCY) ELSE - ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,D%NKA) - ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,D%NKA) + ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,IKA) + ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,IKA) END IF IF (OOCEAN) THEN - ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,D%NKU-1) - ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,D%NKU-1) + ZUSLOPE(IIJB:IIJE)=PUT(IIJB:IIJE,IKU-1) + ZVSLOPE(IIJB:IIJE)=PVT(IIJB:IIJE,IKU-1) END IF ! ! @@ -912,10 +916,10 @@ IF (OOCEAN) THEN ZTAU11M(IIJB:IIJE)=0. ELSE !$mnh_expand_array(JIJ=IIJB:IIJE) - ZTAU11M(IIJB:IIJE) =2./3.*( (1.+ (PZZ(IIJB:IIJE,IKB+D%NKL)-PZZ(IIJB:IIJE,IKB)) & - /(PDZZ(IIJB:IIJE,IKB+D%NKL)+PDZZ(IIJB:IIJE,IKB)) & + ZTAU11M(IIJB:IIJE) =2./3.*( (1.+ (PZZ(IIJB:IIJE,IKB+IKL)-PZZ(IIJB:IIJE,IKB)) & + /(PDZZ(IIJB:IIJE,IKB+IKL)+PDZZ(IIJB:IIJE,IKB)) & ) *PTKET(IIJB:IIJE,IKB) & - -0.5 *PTKET(IIJB:IIJE,IKB+D%NKL) & + -0.5 *PTKET(IIJB:IIJE,IKB+IKL) & ) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END IF @@ -938,10 +942,10 @@ IF (TURBN%CTOM=='TM06') THEN ! CALL GZ_M_W_PHY(D,ZMWTH,PDZZ,ZWORK1) ! -d(w'2th' )/dz CALL GZ_W_M_PHY(D,ZMTH2,PDZZ,ZWORK2) ! -d(w'th'2 )/dz - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZFWTH(IIJB:IIJE,1:D%NKT) = -ZWORK1(IIJB:IIJE,1:D%NKT) - ZFTH2(IIJB:IIJE,1:D%NKT) = -ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZFWTH(IIJB:IIJE,1:IKT) = -ZWORK1(IIJB:IIJE,1:IKT) + ZFTH2(IIJB:IIJE,1:IKT) = -ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ZFWTH(:,IKTE:) = 0. ZFWTH(:,:IKTB) = 0. @@ -1173,15 +1177,15 @@ END IF ! 6.1 Contribution of mass-flux in the TKE buoyancy production if ! cloud computation is not statistical CALL MZF_PHY(D,PFLXZTHVMF,ZWORK1) -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -PTP(IIJB:IIJE,1:D%NKT) = PTP(IIJB:IIJE,1:D%NKT) & - + CST%XG / PTHVREF(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +PTP(IIJB:IIJE,1:IKT) = PTP(IIJB:IIJE,1:IKT) & + + CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF(PRESENT(PTPMF)) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PTPMF(IIJB:IIJE,1:D%NKT)=CST%XG / PTHVREF(IIJB:IIJE,1:D%NKT) * ZWORK1(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PTPMF(IIJB:IIJE,1:IKT)=CST%XG / PTHVREF(IIJB:IIJE,1:IKT) * ZWORK1(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF ! 6.2 TKE evolution equation @@ -1281,15 +1285,15 @@ END IF ! !* stores value of conservative variables & wind before turbulence tendency (AROME only) IF(PRESENT(PDRUS_TURB)) THEN -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PDRUS_TURB(IIJB:IIJE,1:D%NKT) = PRUS(IIJB:IIJE,1:D%NKT) - PDRUS_TURB(IIJB:IIJE,1:D%NKT) - PDRVS_TURB(IIJB:IIJE,1:D%NKT) = PRVS(IIJB:IIJE,1:D%NKT) - PDRVS_TURB(IIJB:IIJE,1:D%NKT) - PDRTHLS_TURB(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) - PDRTHLS_TURB(IIJB:IIJE,1:D%NKT) - PDRRTS_TURB(IIJB:IIJE,1:D%NKT) = PRRS(IIJB:IIJE,1:D%NKT,1) - PDRRTS_TURB(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT,JSV=1:KSV) - PDRSVS_TURB(IIJB:IIJE,1:D%NKT,:) = PRSVS(IIJB:IIJE,1:D%NKT,:) - PDRSVS_TURB(IIJB:IIJE,1:D%NKT,:) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT,JSV=1:KSV) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PDRUS_TURB(IIJB:IIJE,1:IKT) = PRUS(IIJB:IIJE,1:IKT) - PDRUS_TURB(IIJB:IIJE,1:IKT) + PDRVS_TURB(IIJB:IIJE,1:IKT) = PRVS(IIJB:IIJE,1:IKT) - PDRVS_TURB(IIJB:IIJE,1:IKT) + PDRTHLS_TURB(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) - PDRTHLS_TURB(IIJB:IIJE,1:IKT) + PDRRTS_TURB(IIJB:IIJE,1:IKT) = PRRS(IIJB:IIJE,1:IKT,1) - PDRRTS_TURB(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV) + PDRSVS_TURB(IIJB:IIJE,1:IKT,:) = PRSVS(IIJB:IIJE,1:IKT,:) - PDRSVS_TURB(IIJB:IIJE,1:IKT,:) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT,JSV=1:KSV) END IF !---------------------------------------------------------------------------- ! @@ -1298,28 +1302,28 @@ END IF ! IF ( KRRL >= 1 ) THEN IF ( KRRI >= 1 ) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRT(IIJB:IIJE,1:D%NKT,1) = PRT(IIJB:IIJE,1:D%NKT,1) - PRT(IIJB:IIJE,1:D%NKT,2) & - - PRT(IIJB:IIJE,1:D%NKT,4) - PRRS(IIJB:IIJE,1:D%NKT,1) = PRRS(IIJB:IIJE,1:D%NKT,1) - PRRS(IIJB:IIJE,1:D%NKT,2) & - - PRRS(IIJB:IIJE,1:D%NKT,4) - PTHLT(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) + ZLVOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRT(IIJB:IIJE,1:D%NKT,2) & - + ZLSOCPEXNM(IIJB:IIJE,1:D%NKT) * PRT(IIJB:IIJE,1:D%NKT,4) - PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) + ZLVOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRRS(IIJB:IIJE,1:D%NKT,2) & - + ZLSOCPEXNM(IIJB:IIJE,1:D%NKT) * PRRS(IIJB:IIJE,1:D%NKT,4) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) - PRT(IIJB:IIJE,1:IKT,2) & + - PRT(IIJB:IIJE,1:IKT,4) + PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) - PRRS(IIJB:IIJE,1:IKT,2) & + - PRRS(IIJB:IIJE,1:IKT,4) + PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) + ZLVOCPEXNM(IIJB:IIJE,1:IKT) & + * PRT(IIJB:IIJE,1:IKT,2) & + + ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRT(IIJB:IIJE,1:IKT,4) + PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + ZLVOCPEXNM(IIJB:IIJE,1:IKT) & + * PRRS(IIJB:IIJE,1:IKT,2) & + + ZLSOCPEXNM(IIJB:IIJE,1:IKT) * PRRS(IIJB:IIJE,1:IKT,4) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PRT(IIJB:IIJE,1:D%NKT,1) = PRT(IIJB:IIJE,1:D%NKT,1) - PRT(IIJB:IIJE,1:D%NKT,2) - PRRS(IIJB:IIJE,1:D%NKT,1) = PRRS(IIJB:IIJE,1:D%NKT,1) - PRRS(IIJB:IIJE,1:D%NKT,2) - PTHLT(IIJB:IIJE,1:D%NKT) = PTHLT(IIJB:IIJE,1:D%NKT) + ZLOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRT(IIJB:IIJE,1:D%NKT,2) - PRTHLS(IIJB:IIJE,1:D%NKT) = PRTHLS(IIJB:IIJE,1:D%NKT) + ZLOCPEXNM(IIJB:IIJE,1:D%NKT) & - * PRRS(IIJB:IIJE,1:D%NKT,2) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PRT(IIJB:IIJE,1:IKT,1) = PRT(IIJB:IIJE,1:IKT,1) - PRT(IIJB:IIJE,1:IKT,2) + PRRS(IIJB:IIJE,1:IKT,1) = PRRS(IIJB:IIJE,1:IKT,1) - PRRS(IIJB:IIJE,1:IKT,2) + PTHLT(IIJB:IIJE,1:IKT) = PTHLT(IIJB:IIJE,1:IKT) + ZLOCPEXNM(IIJB:IIJE,1:IKT) & + * PRT(IIJB:IIJE,1:IKT,2) + PRTHLS(IIJB:IIJE,1:IKT) = PRTHLS(IIJB:IIJE,1:IKT) + ZLOCPEXNM(IIJB:IIJE,1:IKT) & + * PRRS(IIJB:IIJE,1:IKT,2) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF @@ -1364,34 +1368,34 @@ IF (TLES%LLES_CALL) THEN ! IF (TURBN%CTURBDIM=="1DIM") THEN ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK1(IIJB:IIJE,1:D%NKT) = 2./3.*PTKET(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK1(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK1,TLES%X_LES_SUBGRID_U2) TLES%X_LES_SUBGRID_V2(:,:,:) = TLES%X_LES_SUBGRID_U2(:,:,:) TLES%X_LES_SUBGRID_W2(:,:,:) = TLES%X_LES_SUBGRID_U2(:,:,:) ! CALL GZ_M_W_PHY(D,PTHLT,PDZZ,ZWORK1) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = 2./3.*PTKET(IIJB:IIJE,1:D%NKT) *ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddz_Thl_SBG_W2) ! IF (KRR>=1) THEN CALL GZ_M_W_PHY(D,PRT(:,:,1),PDZZ,ZWORK1) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = 2./3.*PTKET(IIJB:IIJE,1:D%NKT) *ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2,TLES%X_LES_RES_ddz_Rt_SBG_W2) END IF DO JSV=1,KSV CALL GZ_M_W_PHY(D,PSVT(:,:,JSV),PDZZ,ZWORK1) CALL MZF_PHY(D,ZWORK1,ZWORK2) - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - ZWORK2(IIJB:IIJE,1:D%NKT) = 2./3.*PTKET(IIJB:IIJE,1:D%NKT) *ZWORK2(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + ZWORK2(IIJB:IIJE,1:IKT) = 2./3.*PTKET(IIJB:IIJE,1:IKT) *ZWORK2(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) CALL LES_MEAN_SUBGRID_PHY(D,TLES,ZWORK2, TLES%X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV)) END DO END IF @@ -1457,46 +1461,46 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA ! !* 1.1 Lv/Cph at t ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLOCPEXN(IIJB:IIJE,1:D%NKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:D%NKT)-CST%XTT) ) & - / PCP(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLOCPEXN(IIJB:IIJE,1:IKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:IKT)-CST%XTT) ) & + / PCP(IIJB:IIJE,1:IKT) ! !* 1.2 Saturation vapor pressure at t ! - ZRVSAT(IIJB:IIJE,1:D%NKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:D%NKT) - PGAM*ALOG( PT(IIJB:IIJE,1:D%NKT) ) ) + ZRVSAT(IIJB:IIJE,1:IKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:IKT) - PGAM*ALOG( PT(IIJB:IIJE,1:IKT) ) ) ! !* 1.3 saturation mixing ratio at t ! - ZRVSAT(IIJB:IIJE,1:D%NKT) = ZRVSAT(IIJB:IIJE,1:D%NKT) & - * ZEPS / ( PPABST(IIJB:IIJE,1:D%NKT) - ZRVSAT(IIJB:IIJE,1:D%NKT) ) + ZRVSAT(IIJB:IIJE,1:IKT) = ZRVSAT(IIJB:IIJE,1:IKT) & + * ZEPS / ( PPABST(IIJB:IIJE,1:IKT) - ZRVSAT(IIJB:IIJE,1:IKT) ) ! !* 1.4 compute the saturation mixing ratio derivative (rvs') ! - ZDRVSATDT(IIJB:IIJE,1:D%NKT) = ( PBETA / PT(IIJB:IIJE,1:D%NKT) - PGAM ) / PT(IIJB:IIJE,1:D%NKT) & - * ZRVSAT(IIJB:IIJE,1:D%NKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:D%NKT) / ZEPS ) + ZDRVSATDT(IIJB:IIJE,1:IKT) = ( PBETA / PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) & + * ZRVSAT(IIJB:IIJE,1:IKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:IKT) / ZEPS ) ! !* 1.5 compute Amoist ! - PAMOIST(IIJB:IIJE,1:D%NKT)= 0.5 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:D%NKT) * PLOCPEXN(IIJB:IIJE,1:D%NKT) ) + PAMOIST(IIJB:IIJE,1:IKT)= 0.5 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) ) ! !* 1.6 compute Atheta ! - PATHETA(IIJB:IIJE,1:D%NKT)= PAMOIST(IIJB:IIJE,1:D%NKT) * PEXN(IIJB:IIJE,1:D%NKT) * & - ( ( ZRVSAT(IIJB:IIJE,1:D%NKT) - PRT(IIJB:IIJE,1:D%NKT,1) ) * PLOCPEXN(IIJB:IIJE,1:D%NKT) / & - ( 1. + ZDRVSATDT(IIJB:IIJE,1:D%NKT) * PLOCPEXN(IIJB:IIJE,1:D%NKT) ) * & + PATHETA(IIJB:IIJE,1:IKT)= PAMOIST(IIJB:IIJE,1:IKT) * PEXN(IIJB:IIJE,1:IKT) * & + ( ( ZRVSAT(IIJB:IIJE,1:IKT) - PRT(IIJB:IIJE,1:IKT,1) ) * PLOCPEXN(IIJB:IIJE,1:IKT) / & + ( 1. + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) ) * & ( & - ZRVSAT(IIJB:IIJE,1:D%NKT) * (1. + ZRVSAT(IIJB:IIJE,1:D%NKT)/ZEPS) & - * ( -2.*PBETA/PT(IIJB:IIJE,1:D%NKT) + PGAM ) / PT(IIJB:IIJE,1:D%NKT)**2 & - +ZDRVSATDT(IIJB:IIJE,1:D%NKT) * (1. + 2. * ZRVSAT(IIJB:IIJE,1:D%NKT)/ZEPS) & - * ( PBETA/PT(IIJB:IIJE,1:D%NKT) - PGAM ) / PT(IIJB:IIJE,1:D%NKT) & + ZRVSAT(IIJB:IIJE,1:IKT) * (1. + ZRVSAT(IIJB:IIJE,1:IKT)/ZEPS) & + * ( -2.*PBETA/PT(IIJB:IIJE,1:IKT) + PGAM ) / PT(IIJB:IIJE,1:IKT)**2 & + +ZDRVSATDT(IIJB:IIJE,1:IKT) * (1. + 2. * ZRVSAT(IIJB:IIJE,1:IKT)/ZEPS) & + * ( PBETA/PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) & ) & - - ZDRVSATDT(IIJB:IIJE,1:D%NKT) & + - ZDRVSATDT(IIJB:IIJE,1:IKT) & ) ! !* 1.7 Lv/Cph/Exner at t-1 ! - PLOCPEXN(IIJB:IIJE,1:D%NKT) = PLOCPEXN(IIJB:IIJE,1:D%NKT) / PEXN(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PLOCPEXN(IIJB:IIJE,1:IKT) = PLOCPEXN(IIJB:IIJE,1:IKT) / PEXN(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',1,ZHOOK_HANDLE2) END SUBROUTINE COMPUTE_FUNCTION_THERMO @@ -1541,34 +1545,34 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PAMOIST,PATHETA ! !* 1.1 Lv/Cph at t ! - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLOCPEXN(IIJB:IIJE,1:D%NKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:D%NKT)-CST%XTT) ) / PCP(IIJB:IIJE,1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLOCPEXN(IIJB:IIJE,1:IKT) = ( PLTT + (CST%XCPV-PC) * (PT(IIJB:IIJE,1:IKT)-CST%XTT) ) / PCP(IIJB:IIJE,1:IKT) ! !* 1.2 Saturation vapor pressure at t ! - ZRVSAT(IIJB:IIJE,1:D%NKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:D%NKT) - PGAM*ALOG( PT(IIJB:IIJE,1:D%NKT) ) ) + ZRVSAT(IIJB:IIJE,1:IKT) = EXP( PALP - PBETA/PT(IIJB:IIJE,1:IKT) - PGAM*ALOG( PT(IIJB:IIJE,1:IKT) ) ) ! !* 1.3 saturation mixing ratio at t ! - ZRVSAT(IIJB:IIJE,1:D%NKT) = ZRVSAT(IIJB:IIJE,1:D%NKT) * ZEPS / ( PPABST(IIJB:IIJE,1:D%NKT) - ZRVSAT(IIJB:IIJE,1:D%NKT) ) + ZRVSAT(IIJB:IIJE,1:IKT) = ZRVSAT(IIJB:IIJE,1:IKT) * ZEPS / ( PPABST(IIJB:IIJE,1:IKT) - ZRVSAT(IIJB:IIJE,1:IKT) ) ! !* 1.4 compute the saturation mixing ratio derivative (rvs') ! - ZDRVSATDT(IIJB:IIJE,1:D%NKT) = ( PBETA / PT(IIJB:IIJE,1:D%NKT) - PGAM ) / PT(IIJB:IIJE,1:D%NKT) & - * ZRVSAT(IIJB:IIJE,1:D%NKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:D%NKT) / ZEPS ) + ZDRVSATDT(IIJB:IIJE,1:IKT) = ( PBETA / PT(IIJB:IIJE,1:IKT) - PGAM ) / PT(IIJB:IIJE,1:IKT) & + * ZRVSAT(IIJB:IIJE,1:IKT) * ( 1. + ZRVSAT(IIJB:IIJE,1:IKT) / ZEPS ) ! !* 1.5 compute Amoist ! - PAMOIST(IIJB:IIJE,1:D%NKT)= 1.0 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:D%NKT) * PLOCPEXN(IIJB:IIJE,1:D%NKT) ) + PAMOIST(IIJB:IIJE,1:IKT)= 1.0 / ( 1.0 + ZDRVSATDT(IIJB:IIJE,1:IKT) * PLOCPEXN(IIJB:IIJE,1:IKT) ) ! !* 1.6 compute Atheta ! - PATHETA(IIJB:IIJE,1:D%NKT)= PAMOIST(IIJB:IIJE,1:D%NKT) * PEXN(IIJB:IIJE,1:D%NKT) * ZDRVSATDT(IIJB:IIJE,1:D%NKT) + PATHETA(IIJB:IIJE,1:IKT)= PAMOIST(IIJB:IIJE,1:IKT) * PEXN(IIJB:IIJE,1:IKT) * ZDRVSATDT(IIJB:IIJE,1:IKT) ! !* 1.7 Lv/Cph/Exner at t-1 ! - PLOCPEXN(IIJB:IIJE,1:D%NKT) = PLOCPEXN(IIJB:IIJE,1:D%NKT) / PEXN(IIJB:IIJE,1:D%NKT) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + PLOCPEXN(IIJB:IIJE,1:IKT) = PLOCPEXN(IIJB:IIJE,1:IKT) / PEXN(IIJB:IIJE,1:IKT) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO_NEW_STAT',1,ZHOOK_HANDLE2) END SUBROUTINE COMPUTE_FUNCTION_THERMO_NEW_STAT @@ -1611,37 +1615,37 @@ IF (ODZ) THEN ! Dz is take into account in the computation DO JK = IKTB,IKTE ! 1D turbulence scheme !$mnh_expand_array(JIJ=IIJB:IIJE) - PLM(IIJB:IIJE,JK) = PZZ(IIJB:IIJE,JK+D%NKL) - PZZ(IIJB:IIJE,JK) + PLM(IIJB:IIJE,JK) = PZZ(IIJB:IIJE,JK+IKL) - PZZ(IIJB:IIJE,JK) !$mnh_end_expand_array(JIJ=IIJB:IIJE) END DO !$mnh_expand_array(JIJ=IIJB:IIJE) - PLM(IIJB:IIJE,D%NKU) = PLM(IIJB:IIJE,IKE) - PLM(IIJB:IIJE,D%NKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,D%NKA) + PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE) + PLM(IIJB:IIJE,IKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,IKA) !$mnh_end_expand_array(JIJ=IIJB:IIJE) IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme IF ( O2D) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT) = SQRT( PLM(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) ) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT) = SQRT( PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT) = (PLM(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) ) ** (1./3.) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT) = (PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./3.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ELSE ! Dz not taken into account in computation to assure invariability with vertical grid mesh - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT)=1.E10 - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT)=1.E10 + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme IF ( O2D) THEN PLM(:,:) = ZWORK1(:,:) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT) = (ZWORK1(IIJB:IIJE,1:D%NKT)*ZWORK2(IIJB:IIJE,1:D%NKT) ) ** (1./2.) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT) = (ZWORK1(IIJB:IIJE,1:IKT)*ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./2.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF END IF @@ -1664,7 +1668,7 @@ IF (.NOT. TURBN%LRMC01) THEN END DO ELSE DO JK=IKTB,IKTE - ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+D%NKL))& + ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))& -PZZ(JIJ,IKB)) *PDIRCOSZW(JIJ) IF ( PLM(JIJ,JK)>ZD) THEN PLM(JIJ,JK)=ZD @@ -1677,8 +1681,8 @@ IF (.NOT. TURBN%LRMC01) THEN END IF ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PLM(IIJB:IIJE,D%NKA) = PLM(IIJB:IIJE,IKB) -PLM(IIJB:IIJE,D%NKU) = PLM(IIJB:IIJE,IKE) +PLM(IIJB:IIJE,IKA) = PLM(IIJB:IIJE,IKB) +PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (LHOOK) CALL DR_HOOK('TURB:DELT',1,ZHOOK_HANDLE2) @@ -1722,23 +1726,23 @@ IF ( TURBN%CTURBDIM /= '1DIM' ) THEN END IF ! 1D turbulence scheme !$mnh_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) -PLM(IIJB:IIJE,IKTB:IKTE) = PZZ(IIJB:IIJE,D%NKL+IKTB:IKTE+D%NKL) - PZZ(IIJB:IIJE,IKTB:IKTE) +PLM(IIJB:IIJE,IKTB:IKTE) = PZZ(IIJB:IIJE,IKL+IKTB:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB:IKTE) !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=IKTB:IKTE) !$mnh_expand_array(JIJ=IIJB:IIJE) -PLM(IIJB:IIJE,D%NKU) = PLM(IIJB:IIJE,IKE) -PLM(IIJB:IIJE,D%NKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,D%NKA) +PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKE) +PLM(IIJB:IIJE,IKA) = PZZ(IIJB:IIJE,IKB) - PZZ(IIJB:IIJE,IKA) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF ( TURBN%CTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme IF ( O2D) THEN - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT) = SQRT( PLM(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) ) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT) = SQRT( PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) ) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ELSE - !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) - PLM(IIJB:IIJE,1:D%NKT) = (PLM(IIJB:IIJE,1:D%NKT)*ZWORK1(IIJB:IIJE,1:D%NKT) & - * ZWORK2(IIJB:IIJE,1:D%NKT) ) ** (1./3.) - !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) + !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) + PLM(IIJB:IIJE,1:IKT) = (PLM(IIJB:IIJE,1:IKT)*ZWORK1(IIJB:IIJE,1:IKT) & + * ZWORK2(IIJB:IIJE,1:IKT) ) ** (1./3.) + !$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) END IF END IF ! compute a mixing length limited by the stability @@ -1749,10 +1753,10 @@ CALL EMOIST(D,CST,KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT,OOCEAN,ZEMOIST) IF (KRR>0) THEN DO JK = IKTB+1,IKTE-1 DO JIJ=IIJB,IIJE - ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+D%NKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+D%NKL)+ & - (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-D%NKL))/PDZZ(JIJ,JK )) - ZDRTDZ(JIJ,JK) = 0.5*((PRT(JIJ,JK+D%NKL,1)-PRT(JIJ,JK ,1))/PDZZ(JIJ,JK+D%NKL)+ & - (PRT(JIJ,JK ,1)-PRT(JIJ,JK-D%NKL,1))/PDZZ(JIJ,JK )) + ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+IKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+IKL)+ & + (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-IKL))/PDZZ(JIJ,JK )) + ZDRTDZ(JIJ,JK) = 0.5*((PRT(JIJ,JK+IKL,1)-PRT(JIJ,JK ,1))/PDZZ(JIJ,JK+IKL)+ & + (PRT(JIJ,JK ,1)-PRT(JIJ,JK-IKL,1))/PDZZ(JIJ,JK )) IF (OOCEAN) THEN ZVAR=CST%XG*(CST%XALPHAOC*ZDTHLDZ(JIJ,JK)-CST%XBETAOC*ZDRTDZ(JIJ,JK)) ELSE @@ -1769,8 +1773,8 @@ IF (KRR>0) THEN ELSE! For dry atmos or unsalted ocean runs DO JK = IKTB+1,IKTE-1 DO JIJ=IIJB,IIJE - ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+D%NKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+D%NKL)+ & - (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-D%NKL))/PDZZ(JIJ,JK )) + ZDTHLDZ(JIJ,JK)= 0.5*((PTHLT(JIJ,JK+IKL)-PTHLT(JIJ,JK ))/PDZZ(JIJ,JK+IKL)+ & + (PTHLT(JIJ,JK )-PTHLT(JIJ,JK-IKL))/PDZZ(JIJ,JK )) IF (OOCEAN) THEN ZVAR= CST%XG*CST%XALPHAOC*ZDTHLDZ(JIJ,JK) ELSE @@ -1786,12 +1790,12 @@ ELSE! For dry atmos or unsalted ocean runs END IF ! special case near the surface !$mnh_expand_array(JIJ=IIJB:IIJE) -ZDTHLDZ(IIJB:IIJE,IKB)=(PTHLT(IIJB:IIJE,IKB+D%NKL)-PTHLT(IIJB:IIJE,IKB))/PDZZ(IIJB:IIJE,IKB+D%NKL) +ZDTHLDZ(IIJB:IIJE,IKB)=(PTHLT(IIJB:IIJE,IKB+IKL)-PTHLT(IIJB:IIJE,IKB))/PDZZ(IIJB:IIJE,IKB+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! For dry simulations IF (KRR>0) THEN !$mnh_expand_array(JIJ=IIJB:IIJE) - ZDRTDZ(IIJB:IIJE,IKB)=(PRT(IIJB:IIJE,IKB+D%NKL,1)-PRT(IIJB:IIJE,IKB,1))/PDZZ(IIJB:IIJE,IKB+D%NKL) + ZDRTDZ(IIJB:IIJE,IKB)=(PRT(IIJB:IIJE,IKB+IKL,1)-PRT(IIJB:IIJE,IKB,1))/PDZZ(IIJB:IIJE,IKB+IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ELSE ZDRTDZ(:,IKB)=0 @@ -1831,7 +1835,7 @@ IF (.NOT. TURBN%LRMC01) THEN END DO ELSE DO JK=IKTB,IKTE - ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+D%NKL))-PZZ(JIJ,IKB)) & + ZD=ZALPHA*(0.5*(PZZ(JIJ,JK)+PZZ(JIJ,JK+IKL))-PZZ(JIJ,IKB)) & *PDIRCOSZW(JIJ) IF ( PLM(JIJ,JK)>ZD) THEN PLM(JIJ,JK)=ZD @@ -1844,9 +1848,9 @@ IF (.NOT. TURBN%LRMC01) THEN END IF ! !$mnh_expand_array(JIJ=IIJB:IIJE) -PLM(IIJB:IIJE,D%NKA) = PLM(IIJB:IIJE,IKB) -PLM(IIJB:IIJE,IKE) = PLM(IIJB:IIJE,IKE-D%NKL) -PLM(IIJB:IIJE,D%NKU) = PLM(IIJB:IIJE,D%NKU-D%NKL) +PLM(IIJB:IIJE,IKA) = PLM(IIJB:IIJE,IKB) +PLM(IIJB:IIJE,IKE) = PLM(IIJB:IIJE,IKE-IKL) +PLM(IIJB:IIJE,IKU) = PLM(IIJB:IIJE,IKU-IKL) !$mnh_end_expand_array(JIJ=IIJB:IIJE) ! IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE2) @@ -1912,29 +1916,29 @@ IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',0,ZHOOK_HANDLE2) ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN ) ZCOEF_AMPL_CEI_NUL = 1. - ZPENTE * PCEI_MIN ! -!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) -ZCOEF_AMPL(IIJB:IIJE,1:D%NKT) = 1. -!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) +ZCOEF_AMPL(IIJB:IIJE,1:IKT) = 1. +!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT) ! !* 2. CALCULATION OF THE AMPLIFICATION COEFFICIENT ! -------------------------------------------- ! ! Saturation ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE ( PCEI(IIJB:IIJE,1:D%NKT)>=PCEI_MAX ) - ZCOEF_AMPL(IIJB:IIJE,1:D%NKT)=PCOEF_AMPL_SAT +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE ( PCEI(IIJB:IIJE,1:IKT)>=PCEI_MAX ) + ZCOEF_AMPL(IIJB:IIJE,1:IKT)=PCOEF_AMPL_SAT END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Between the min and max limits of CEI index, linear variation of the ! amplification coefficient ZCOEF_AMPL as a function of CEI ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE ( PCEI(IIJB:IIJE,1:D%NKT) < PCEI_MAX .AND. PCEI(IIJB:IIJE,1:D%NKT) > PCEI_MIN) - ZCOEF_AMPL(IIJB:IIJE,1:D%NKT) = ZPENTE * PCEI(IIJB:IIJE,1:D%NKT) + ZCOEF_AMPL_CEI_NUL +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE ( PCEI(IIJB:IIJE,1:IKT) < PCEI_MAX .AND. PCEI(IIJB:IIJE,1:IKT) > PCEI_MIN) + ZCOEF_AMPL(IIJB:IIJE,1:IKT) = ZPENTE * PCEI(IIJB:IIJE,1:IKT) + ZCOEF_AMPL_CEI_NUL END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! ! !* 3. CALCULATION OF THE MIXING LENGTH IN CLOUDS @@ -1984,19 +1988,19 @@ ENDIF ! ! Amplification of the mixing length when the criteria are verified ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE (ZCOEF_AMPL(IIJB:IIJE,1:D%NKT) /= 1.) - ZLM(IIJB:IIJE,1:D%NKT) = ZCOEF_AMPL(IIJB:IIJE,1:D%NKT)*ZLM_CLOUD(IIJB:IIJE,1:D%NKT) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE (ZCOEF_AMPL(IIJB:IIJE,1:IKT) /= 1.) + ZLM(IIJB:IIJE,1:IKT) = ZCOEF_AMPL(IIJB:IIJE,1:IKT)*ZLM_CLOUD(IIJB:IIJE,1:IKT) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! ! Cloud mixing length in the clouds at the points which do not verified the CEI ! -!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) -WHERE (PCEI(IIJB:IIJE,1:D%NKT) == -1.) - ZLM(IIJB:IIJE,1:D%NKT) = ZLM_CLOUD(IIJB:IIJE,1:D%NKT) +!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) +WHERE (PCEI(IIJB:IIJE,1:IKT) == -1.) + ZLM(IIJB:IIJE,1:IKT) = ZLM_CLOUD(IIJB:IIJE,1:IKT) END WHERE -!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT) +!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT) ! ! !* 5. IMPRESSION