Newer
Older
END DO
!$acc end kernels
!$acc kernels
!$acc loop independent collapse(2) private(ZVAR)
DO CONCURRENT (JK=IKTB+1:IKTE-1,JIJ=IIJB:IIJE)
ZVAR=CST%XG*(CST%XALPHAOC*ZDTHLDZ(JIJ,JK)-CST%XBETAOC*ZDRTDZ(JIJ,JK))
ELSE
ZVAR=CST%XG/PTHVREF(JIJ,JK)* &
(ZETHETA(JIJ,JK)*ZDTHLDZ(JIJ,JK)+ZEMOIST(JIJ,JK)*ZDRTDZ(JIJ,JK))
END IF
!
IF (ZVAR>0.) THEN
PLM(JIJ,JK)=MAX(CST%XMNH_EPSILON,MIN(PLM(JIJ,JK), &
0.76* SQRT(PTKET(JIJ,JK)/ZVAR)))
END IF

RODIER Quentin
committed
END DO
!$acc end kernels

RODIER Quentin
committed
ELSE! For dry atmos or unsalted ocean runs
!$acc kernels
!$acc loop independent collapse(2) private(ZVAR)
DO CONCURRENT (JK=IKTB+1:IKTE-1,JIJ=IIJB:IIJE)
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 ))
ZVAR= CST%XG*CST%XALPHAOC*ZDTHLDZ(JIJ,JK)
ELSE
ZVAR= CST%XG/PTHVREF(JIJ,JK)*ZETHETA(JIJ,JK)*ZDTHLDZ(JIJ,JK)
END IF

RODIER Quentin
committed
!
IF (ZVAR>0.) THEN
PLM(JIJ,JK)=MAX(CST%XMNH_EPSILON,MIN(PLM(JIJ,JK), &
0.76* SQRT(PTKET(JIJ,JK)/ZVAR)))
END IF

RODIER Quentin
committed
END DO
!$acc end kernels

RODIER Quentin
committed
END IF
!$acc kernels present(ZWORK2D, PLM)

RODIER Quentin
committed
! special case near the surface
!$mnh_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ZDTHLDZ(:,IKB)=(PTHLT(:,IKB+IKL)-PTHLT(:,IKB))/PDZZ(:,IKB+IKL)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
! For dry simulations
IF (KRR>0) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ZDRTDZ(:,IKB)=(PRT(:,IKB+IKL,1)-PRT(:,IKB,1))/PDZZ(:,IKB+IKL)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ELSE

RODIER Quentin
committed
ENDIF
!$mnh_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ZWORK2D(:)=CST%XG*(CST%XALPHAOC*ZDTHLDZ(:,IKB)-CST%XBETAOC*ZDRTDZ(:,IKB))
!$mnh_end_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ELSE
!$mnh_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
ZWORK2D(:)=CST%XG/PTHVREF(:,IKB)* &
(ZETHETA(:,IKB)*ZDTHLDZ(:,IKB)+ZEMOIST(:,IKB)*ZDRTDZ(:,IKB))
!$mnh_end_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
END IF
!$mnh_expand_where(JIJ=IIJB:IIJE)

RODIER Quentin
committed
WHERE(ZWORK2D(:)>0.)
PLM(:,IKB)=MAX(CST%XMNH_EPSILON,MIN( PLM(:,IKB), &
0.76* SQRT(PTKET(:,IKB)/ZWORK2D(:))))
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
! mixing length limited by the distance normal to the surface (with the same factor as for BL89)
!

RODIER Quentin
committed
IF (.NOT. TURBN%LRMC01) THEN
ZALPHA=0.5**(-1.5)
!
DO JK=IKTE,IKTB,-1
ZD=ZALPHA*(PZZ(JIJ,IKTE+1)-PZZ(JIJ,JK))
IF ( PLM(JIJ,JK)>ZD) THEN
PLM(JIJ,JK)=ZD
ELSE
EXIT
ENDIF
END DO
ELSE
DO JK=IKTB,IKTE
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
ELSE
EXIT
ENDIF
END DO
END DO
END IF
!
!$mnh_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
PLM(:,IKA) = PLM(:,IKB)
PLM(:,IKE) = PLM(:,IKE-IKL)
PLM(:,IKU) = PLM(:,IKU-IKL)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)

RODIER Quentin
committed
IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE2)
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
END SUBROUTINE DEAR
!
! #########################
SUBROUTINE CLOUD_MODIF_LM
! #########################
!!
!!*****CLOUD_MODIF_LM routine to:
!! 1/ change the mixing length in the clouds
!! 2/ emphasize the mixing length in the cloud
!! by the coefficient ZCOEF_AMPL calculated here
!! when the CEI index is above ZCEI_MIN.
!!
!!
!! ZCOEF_AMPL ^
!! |
!! |
!! ZCOEF_AMPL_SAT - ---------- Saturation
!! (XDUMMY1) | -
!! | -
!! | -
!! | -
!! | - Amplification
!! | - straight
!! | - line
!! | -
!! | -
!! | -
!! | -
!! | -
!! 1 ------------
!! |
!! |
!! 0 -----------|------------|----------> PCEI
!! 0 ZCEI_MIN ZCEI_MAX
!! (XDUMMY2) (XDUMMY3)
!!
!!
!!
!! AUTHOR
!! ------
!! M. Tomasini *CNRM METEO-FRANCE
!!
!! MODIFICATIONS
!! -------------
!! Original 09/07/04
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
!
!-------------------------------------------------------------------------------
!
!* 1. INITIALISATION
! --------------
!

RODIER Quentin
committed
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:IKT)

RODIER Quentin
committed
ZCOEF_AMPL(:,:) = 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:IKT)

RODIER Quentin
committed
WHERE ( PCEI(:,:)>=PCEI_MAX )
ZCOEF_AMPL(:,:)=PCOEF_AMPL_SAT

RODIER Quentin
committed
END WHERE
!$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:IKT)

RODIER Quentin
committed
WHERE ( PCEI(:,:) < PCEI_MAX .AND. PCEI(:,:) > PCEI_MIN)
ZCOEF_AMPL(:,:) = ZPENTE * PCEI(:,:) + ZCOEF_AMPL_CEI_NUL

RODIER Quentin
committed
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
!* 3. CALCULATION OF THE MIXING LENGTH IN CLOUDS
! ------------------------------------------
!

RODIER Quentin
committed
IF (HTURBLEN_CL == TURBN%CTURBLEN) THEN
!$acc kernels
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
ELSE
SELECT CASE (HTURBLEN_CL)
!
!* 3.1 BL89 mixing length
! ------------------
CASE ('BL89','RM17','HM21')
!$acc kernels
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
CALL BL89(D,CST,CSTURB,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,GOCEAN,HPROGRAM)
!
!* 3.2 Delta mixing length
! -------------------
CASE ('DELT')

RODIER Quentin
committed
CALL DELT(ZLM_CLOUD,ODZ=.TRUE.)
!
!* 3.3 Deardorff mixing length
! -----------------------
CASE ('DEAR')
CALL DEAR(ZLM_CLOUD)
!
END SELECT
ENDIF
!
!* 4. MODIFICATION OF THE MIXING LENGTH IN THE CLOUDS
! -----------------------------------------------
!
! Impression before modification of the mixing length

RODIER Quentin
committed
IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'LM_CLEAR_SKY', &
CSTDNAME = '', &
CLONGNAME = 'LM_CLEAR_SKY', &
CUNITS = 'm', &
CDIR = 'XY', &
CCOMMENT = 'X_Y_Z_LM CLEAR SKY', &
NGRID = 1, &
NTYPE = TYPEREAL, &
NDIMS = 3, &
LTIMEDEP = .TRUE. )
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM)
ENDIF
!
! Amplification of the mixing length when the criteria are verified
!
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)

RODIER Quentin
committed
WHERE (ZCOEF_AMPL(:,:) /= 1.)
ZLM(:,:) = ZCOEF_AMPL(:,:)*ZLM_CLOUD(:,:)

RODIER Quentin
committed
END WHERE
!$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:IKT)

RODIER Quentin
committed
WHERE (PCEI(:,:) == -1.)
ZLM(:,:) = ZLM_CLOUD(:,:)

RODIER Quentin
committed
END WHERE
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!
!
!* 5. IMPRESSION
! ----------
!

RODIER Quentin
committed
IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'COEF_AMPL', &
CSTDNAME = '', &
CLONGNAME = 'COEF_AMPL', &
CUNITS = '1', &
CDIR = 'XY', &
CCOMMENT = 'X_Y_Z_COEF AMPL', &
NGRID = 1, &
NTYPE = TYPEREAL, &
NDIMS = 3, &
LTIMEDEP = .TRUE. )
!$acc update self(ZCOEF_AMPL)
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZCOEF_AMPL)
TZFIELD = TFIELDMETADATA( &
CMNHNAME = 'LM_CLOUD', &
CSTDNAME = '', &
CLONGNAME = 'LM_CLOUD', &
CUNITS = 'm', &
CDIR = 'XY', &
CCOMMENT = 'X_Y_Z_LM CLOUD', &
NGRID = 1, &
NTYPE = TYPEREAL, &
NDIMS = 3, &
LTIMEDEP = .TRUE. )
!$acc update self(ZLM_CLOUD)
CALL IO_FIELD_WRITE_PHY(D,TPFILE,TZFIELD,ZLM_CLOUD)
!
ENDIF
!

RODIER Quentin
committed
IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',1,ZHOOK_HANDLE2)
END SUBROUTINE CLOUD_MODIF_LM
!