Newer
Older
IIJE=D%NIJE
IIJB=D%NIJB
!
!
IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
RODIER Quentin
committed
#ifdef REPRO48
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#else
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#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))))
ELSEWHERE
PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT)
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT)
END IF
ELSE
!* 1DIM case
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
RODIER Quentin
committed
#ifdef REPRO48
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#else
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#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))
ELSEWHERE
PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT)
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
END IF
!
RODIER Quentin
committed
#ifdef REPRO48
#else
RODIER Quentin
committed
!* smoothing
CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3,PD_PHI3DRDZ_O_DDRDZ)
RODIER Quentin
committed
#endif
PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKB-1)=PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKB)
PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKE+1)=PD_PHI3DRDZ_O_DDRDZ(IIJB:IIJE,IKE)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_PHI3DRDZ_O_DDRDZ
!----------------------------------------------------------------------------
SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(D,CSTURB,PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV,PD_PHI3DTDZ2_O_DDTDZ)
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
TYPE(DIMPHYEX_t), INTENT(IN) :: D
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPHI3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2TH3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRED2THR3
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
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_PHI3DTDZ2_O_DDTDZ
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1 ! working array
INTEGER :: IKB, IKE, JIJ,JK, IIJB,IIJE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
!
!
IF (HTURBDIM=='3DIM') THEN
RODIER Quentin
committed
! 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)
ELSE
!* 1DIM case
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
RODIER Quentin
committed
#ifdef REPRO48
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)/=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#else
WHERE (PPHI3(IIJB:IIJE,1:D%NKT)<=CSTURB%XPHI_LIM)
RODIER Quentin
committed
#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))
ELSEWHERE
PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,1:D%NKT) = PPHI3(IIJB:IIJE,1:D%NKT) * 2. * PDTDZ(IIJB:IIJE,1:D%NKT)
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:D%NKT)
END IF
!
RODIER Quentin
committed
#ifdef REPRO48
#else
RODIER Quentin
committed
!* smoothing
CALL SMOOTH_TURB_FUNCT(D,CSTURB,PPHI3,PPHI3*2.*PDTDZ,PD_PHI3DTDZ2_O_DDTDZ)
RODIER Quentin
committed
#endif
RODIER Quentin
committed
!
PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKB)
PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_PHI3DTDZ2_O_DDTDZ(IIJB:IIJE,IKE)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_PHI3DTDZ2_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_WTH_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',1,ZHOOK_HANDLE)
END SUBROUTINE M3_WTH_WTH2
!----------------------------------------------------------------------------
SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(D,CSTURB,PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTH2_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WTH_WTH2
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_WTH_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',1,ZHOOK_HANDLE)
END SUBROUTINE M3_WTH_W2TH
!----------------------------------------------------------------------------
SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE,PD_M3_WTH_W2TH_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
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(IN) :: PKEFF
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
RODIER Quentin
committed
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)
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_WTH_W2R(D,CSTURB,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
RODIER Quentin
committed
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)
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',1,ZHOOK_HANDLE)
END SUBROUTINE M3_WTH_W2R
!----------------------------------------------------------------------------
SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD_M3_WTH_W2R_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
RODIER Quentin
committed
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)
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_WTH_W2R_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_WTH_WR2(D,CSTURB,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ,PM3_WTH_WR2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',1,ZHOOK_HANDLE)
END SUBROUTINE M3_WTH_WR2
!----------------------------------------------------------------------------
SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PD_M3_WTH_WR2_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_WTH_WR2_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_WTH_WTHR(D,CSTURB,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST,PM3_WTH_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PKEFF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBETA
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',1,ZHOOK_HANDLE)
END SUBROUTINE M3_WTH_WTHR
!----------------------------------------------------------------------------
SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(D,CSTURB,PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTHR_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PM3_WTH_WTHR
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_TH2_W2TH(D,CSTURB,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W2TH)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDTDZ
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',1,ZHOOK_HANDLE)
END SUBROUTINE M3_TH2_W2TH
!----------------------------------------------------------------------------
SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_TH2_W2TH_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
IKB=D%NKTB
IKE=D%NKTE
IIJE=D%NIJE
IIJB=D%NIJB
IF (OUSERV) THEN
! D_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,1:D%NKT) = - 1.5*PLM*PLEPS/PTKE*CSTURB%XCTV * MZF( &
! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
RODIER Quentin
committed
! / (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)
RODIER Quentin
committed
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: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)
RODIER Quentin
committed
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)
END IF
!
PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB-1)=PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKB)
PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKE+1)=PD_M3_TH2_W2TH_O_DDTDZ(IIJB:IIJE,IKE)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_TH2_WTH2(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',1,ZHOOK_HANDLE)
END SUBROUTINE M3_TH2_WTH2
!----------------------------------------------------------------------------
SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_TH2_WTH2_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
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_TH2_WTH2_O_DDTDZ
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_TH2_W2R(D,CSTURB,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_W2R)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',1,ZHOOK_HANDLE)
END SUBROUTINE M3_TH2_W2R
!----------------------------------------------------------------------------
SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_W2R_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLM
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_TH2_W2R_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_TH2_WR2(D,CSTURB,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WR2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',1,ZHOOK_HANDLE)
END SUBROUTINE M3_TH2_WR2
!----------------------------------------------------------------------------
SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WR2_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_TH2_WR2_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_TH2_WTHR(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',1,ZHOOK_HANDLE)
END SUBROUTINE M3_TH2_WTHR
!----------------------------------------------------------------------------
SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WTHR_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEMOIST
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_THR_WTHR(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',1,ZHOOK_HANDLE)
END SUBROUTINE M3_THR_WTHR
!----------------------------------------------------------------------------
SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(D,CSTURB,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTHR_O_DDTDZ)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDTH1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
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_THR_WTHR_O_DDTDZ
REAL, DIMENSION(D%NIJT,D%NKT) :: ZWORK1,ZWORK2 ! working array
INTEGER :: IKB, IKE, JIJ,JK,IIJB,IIJE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)
RODIER Quentin
committed
!
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)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END SUBROUTINE D_M3_THR_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
SUBROUTINE M3_THR_WTH2(D,CSTURB,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_THR_WTH2)
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CSTURB_t), INTENT(IN) :: CSTURB
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PREDR1
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PD
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLEPS
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSQRT_TKE
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(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
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE)
RODIER Quentin
committed
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)
RODIER Quentin
committed
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)