Skip to content
Snippets Groups Projects
turb.f90 91.4 KiB
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
!$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
      IF (ZVAR>0.) THEN
        PLM(JIJ,JK)=MAX(CST%XMNH_EPSILON,MIN(PLM(JIJ,JK), &
                      0.76* SQRT(PTKET(JIJ,JK)/ZVAR)))
      END IF
!$acc kernels present(ZWORK2D, PLM)
!$mnh_expand_array(JIJ=IIJB:IIJE)
ZDTHLDZ(:,IKB)=(PTHLT(:,IKB+IKL)-PTHLT(:,IKB))/PDZZ(:,IKB+IKL)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
  !$mnh_expand_array(JIJ=IIJB:IIJE)
  ZDRTDZ(:,IKB)=(PRT(:,IKB+IKL,1)-PRT(:,IKB,1))/PDZZ(:,IKB+IKL)
  !$mnh_end_expand_array(JIJ=IIJB:IIJE)
  ZDRTDZ(:,IKB)=0
  !$mnh_expand_array(JIJ=IIJB:IIJE)
  ZWORK2D(:)=CST%XG*(CST%XALPHAOC*ZDTHLDZ(:,IKB)-CST%XBETAOC*ZDRTDZ(:,IKB))
  !$mnh_end_expand_array(JIJ=IIJB:IIJE)
  !$mnh_expand_array(JIJ=IIJB:IIJE)
  ZWORK2D(:)=CST%XG/PTHVREF(:,IKB)*                                           &
              (ZETHETA(:,IKB)*ZDTHLDZ(:,IKB)+ZEMOIST(:,IKB)*ZDRTDZ(:,IKB))
  !$mnh_end_expand_array(JIJ=IIJB:IIJE)
!$mnh_expand_where(JIJ=IIJB:IIJE)
WHERE(ZWORK2D(:)>0.)
  PLM(:,IKB)=MAX(CST%XMNH_EPSILON,MIN( PLM(:,IKB),                 &
                    0.76* SQRT(PTKET(:,IKB)/ZWORK2D(:))))
!$mnh_end_expand_where(JIJ=IIJB:IIJE)
!
!  mixing length limited by the distance normal to the surface (with the same factor as for BL89)
!
  DO JIJ=IIJB,IIJE
      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
!$mnh_expand_array(JIJ=IIJB:IIJE)
PLM(:,IKA) = PLM(:,IKB)
PLM(:,IKE) = PLM(:,IKE-IKL)
PLM(:,IKU) = PLM(:,IKU-IKL)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
!$acc end kernels
IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE2)
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
!              --------------
!
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)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
!
!*       2.    CALCULATION OF THE AMPLIFICATION COEFFICIENT
!              --------------------------------------------
!
! Saturation
!
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
WHERE ( PCEI(:,:)>=PCEI_MAX ) 
  ZCOEF_AMPL(:,:)=PCOEF_AMPL_SAT
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
!
! 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)
WHERE ( PCEI(:,:) <  PCEI_MAX .AND. PCEI(:,:) >  PCEI_MIN)
  ZCOEF_AMPL(:,:) = ZPENTE * PCEI(:,:) + ZCOEF_AMPL_CEI_NUL
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
!
!
!*       3.    CALCULATION OF THE MIXING LENGTH IN CLOUDS
!              ------------------------------------------
!
!$acc kernels
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
  ZLM_CLOUD(:,:) = ZLM(:,:)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
ELSE
  SELECT CASE (HTURBLEN_CL)
!
!*         3.1 BL89 mixing length
!           ------------------
    !$acc kernels
    !$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
    ZSHEAR(:,:)=0.
    !$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')
!
!*         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
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.                )
!$acc update self(ZLM)
  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)
WHERE (ZCOEF_AMPL(:,:) /= 1.) 
  ZLM(:,:) = ZCOEF_AMPL(:,:)*ZLM_CLOUD(:,:)
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
!
! Cloud mixing length in the clouds at the points which do not verified the CEI
!
!$mnh_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
WHERE (PCEI(:,:) == -1.)
  ZLM(:,:) = ZLM_CLOUD(:,:)
!$mnh_end_expand_where(JIJ=IIJB:IIJE,JK=1:IKT)
!$acc end kernels
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)
IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',1,ZHOOK_HANDLE2)
END SUBROUTINE TURB