Skip to content
Snippets Groups Projects
phys_paramn.f90 60.3 KiB
Newer Older
              PSIG3D=ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),   &
              PN3D=ZNDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
    END IF
    !
    IF ((LSALT)) THEN ! sea salt convective balance
      ALLOCATE(ZSIGSLT(IIU,IJU,IKU,NMODE_SLT))
      ALLOCATE(ZRGSLT(IIU,IJU,IKU,NMODE_SLT))
      ALLOCATE(ZNSLT(IIU,IJU,IKU,NMODE_SLT))
      ALLOCATE(ZSVSLT(IIU,IJU,IKU,NSV_SLT))
      !
      DO JSV=1,NMODE_SLT
        IMODEIDX = JPSALTORDER(JSV)
        IF (CRGUNITS=="MASS") THEN
          ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX) * &
                            EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
        ELSE
          ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX)
        END IF
        ZSIGSLT(:,:,:,JSV) = XINISIG_SLT(IMODEIDX)
        ZRGSLT(:,:,:,JSV)  = ZINIRADIUS_SLT(JSV)
        ZNSLT(:,:,:,JSV)   = XN0MIN_SLT(IMODEIDX)
      ENDDO
      !
      DO JSV=NSV_SLTBEG,NSV_SLTEND
        ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
      ENDDO
      CALL PPP2SALT(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
              PSIG3D=ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),   &
              PN3D=ZNSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
    END IF
    !
!
! Compute convective tendency for all tracers
!
  IF (LCHTRANS) THEN
    DO JSV = 1, SIZE(XRSVS,4)
      XRSVS(:,:,:,JSV) = XRSVS(:,:,:,JSV) + XRHODJ(:,:,:) * XDSVCONV(:,:,:,JSV)
    END DO
    IF (LORILAM) THEN
      DO JSV = NSV_AERBEG,NSV_AEREND
        PWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
        XRSVS(:,:,:,JSV) = ZRSVS(:,:,:,JSV) 
      END DO
    END IF  
  END IF
!
  IF ((LDUST).AND.(LCHTRANS)) THEN ! dust convective balance
    IF (CPROGRAM == "MESONH") THEN
      DO JSV=NSV_DSTBEG,NSV_DSTEND
          ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
      ENDDO
    ELSE
      DO JSV=NSV_DSTBEG,NSV_DSTEND
        ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XSVT(:,:,:,JSV)
      ENDDO
    ENDIF
    CALL DUST2PPP(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
                    XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),&
                    ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
    DO JSV=NSV_DSTBEG,NSV_DSTEND
      XRSVS(:,:,:,JSV) =  ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / XTSTEP
    ENDDO
    !
    DEALLOCATE(ZSVDST)
    DEALLOCATE(ZNDST)
    DEALLOCATE(ZRGDST)
    DEALLOCATE(ZSIGDST)
  END IF
    !
  IF ((LSALT).AND.(LCHTRANS)) THEN ! sea salt convective balance
    IF (CPROGRAM == "MESONH") THEN
      DO JSV=NSV_SLTBEG,NSV_SLTEND
        ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:) 
      ENDDO
    ELSE
      DO JSV=NSV_SLTBEG,NSV_SLTEND
        ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XSVT(:,:,:,JSV)
      ENDDO
    END IF
    CALL SALT2PPP(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
                  XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
                  ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
    DO JSV=NSV_SLTBEG,NSV_SLTEND
      XRSVS(:,:,:,JSV) =  ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / XTSTEP
    ENDDO
    !
    DEALLOCATE(ZSVSLT)
    DEALLOCATE(ZNSLT)
    DEALLOCATE(ZRGSLT)
    DEALLOCATE(ZSIGSLT)
  END IF
  !
END IF
!
  IF( LUSERC .AND. LUSERI ) THEN
    XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * XDRCCONV(:,:,:)
    XRRS(:,:,:,4) = XRRS(:,:,:,4) + XRHODJ(:,:,:) * XDRICONV(:,:,:)
!
  ELSE IF ( LUSERC .AND. (.NOT. LUSERI) ) THEN
!
!  If only cloud water but no cloud ice is used, the convective tendency
!     for cloud ice is added to the tendency for cloud water
!
      XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
                                                       XDRICONV(:,:,:)   )
!     and cloud ice is melted
!
      XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) *                      &
         ( XP00/XPABST(:,:,:) )**(XRD/XCPD) * XLMTT / XCPD * XDRICONV(:,:,:)
!
  ELSE IF ( (.NOT. LUSERC) .AND. (.NOT. LUSERI) ) THEN
!
!  If no cloud water and no cloud ice are used the convective tendencies for these
!     variables are added to the water vapor tendency
!
      XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
                                                       XDRICONV(:,:,:)   )
!     and all cloud condensate is evaporated
!
      XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * (              &
                     XLVTT * XDRCCONV(:,:,:) + XLSTT * XDRICONV(:,:,:) ) *&
                    ( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
  END IF

  if (  lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :)    )
  if (  lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
  if (  lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
  if (  lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
  if (  lbudget_sv .and. lchtrans ) then
    do jsv = 1, size( xrsvs, 4 )
      call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
    end do
  end if
END IF
!
CALL SECOND_MNH2(ZTIME2)
!
PKAFR = PKAFR + ZTIME2 - ZTIME1 &
       - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!-----------------------------------------------------------------------------
!
!*        3.    TURBULENT SURFACE FLUXES
!               ------------------------
!
ZTIME1 = ZTIME2
!
IF (CSURF=='EXTE') THEN
  CALL GOTO_SURFEX(IMI)
!
  IF( LTRANS ) THEN
    XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) + XUTRANS
    XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) + XVTRANS
  END IF
  !
  ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
  ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
  ALLOCATE(ZTSRAD (IIU,IJU))
  !  
  DO JKID = IMI+1,NMODEL  ! min value of the possible kids
    IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. &
     CPROGRAM=='MESONH' .AND. &
     (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
    !  where kids exist, use the two-way output fields (i.e. OMASKkids true)
    !  rather than the farther calculations in radiation and convection schemes
! BUG if number of the son does not follow the number of the dad
!    IKIDM = JKID-IMI
      IKIDM = IKIDM + 1
Gaelle TANGUY's avatar
Gaelle TANGUY committed
     IF (LUSERC .AND. (                                               &
         (LSEDIC .AND. CCLOUD(1:3) == 'ICE')                     .OR. &
         (LSEDC  .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
         (MSEDC  .AND. CCLOUD=='LIMA')                                &
        )) THEN
         WHERE (OMASKkids(:,:) )
            XINPRC(:,:) = ZSAVE_INPRC(:,:,IKIDM)
          ENDWHERE
      END IF
      IF (LUSERR) THEN
        WHERE (OMASKkids(:,:) )
          XINPRR(:,:) = ZSAVE_INPRR(:,:,IKIDM)
        ENDWHERE
      END IF
      IF (LUSERS) THEN
        WHERE (OMASKkids(:,:) )
          XINPRS(:,:) = ZSAVE_INPRS(:,:,IKIDM)
       ENDWHERE
      END IF
      IF (LUSERG) THEN
        WHERE (OMASKkids(:,:) )
          XINPRG(:,:) = ZSAVE_INPRG(:,:,IKIDM)
        ENDWHERE
      END IF
      IF (LUSERH) THEN
        WHERE (OMASKkids(:,:) )
          XINPRH(:,:) = ZSAVE_INPRH(:,:,IKIDM)
        ENDWHERE
      END IF
      IF (CDCONV /= 'NONE') THEN
        WHERE (OMASKkids(:,:) )
          XPRCONV(:,:) = ZSAVE_PRCONV(:,:,IKIDM)
          XPRSCONV(:,:) = ZSAVE_PRSCONV(:,:,IKIDM)
        ENDWHERE
      END IF
      IF (CRAD /= 'NONE') THEN
        DO JSWB=1,NSWB_MNH
          WHERE (OMASKkids(:,:) ) 
            XDIRFLASWD(:,:,JSWB) = ZSAVE_DIRFLASWD(:,:,JSWB,IKIDM)
            XSCAFLASWD(:,:,JSWB) = ZSAVE_SCAFLASWD(:,:,JSWB,IKIDM)
            XDIRSRFSWD(:,:,JSWB) = ZSAVE_DIRSRFSWD(:,:,JSWB,IKIDM)
          ENDWHERE
        ENDDO
      END IF
    ENDIF
  END DO
  !
 IF (IMODSON /= 0 ) THEN
    DEALLOCATE( ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH)
    DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
    DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
 END IF
  CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
                      ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD        )
  !
  IF (LIBM) THEN
    WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
      ZSFTH(:,:)=0.
      ZSFRV(:,:)=0. 
      ZSFU (:,:)=0. 
      ZSFV (:,:)=0.
    ENDWHERE
    IF (NSV>0) THEN
      DO JSV = 1 , NSV
         WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
      ENDDO
    ENDIF 
  ENDIF
  !
  IF (SIZE(XEMIS)>0) THEN
    XDIR_ALB = ZDIR_ALB
    XSCA_ALB = ZSCA_ALB
    XEMIS    = ZEMIS
    XTSRAD   = ZTSRAD
  END IF
  !
  DEALLOCATE(ZDIR_ALB)
  DEALLOCATE(ZSCA_ALB)
  DEALLOCATE(ZEMIS   )
  DEALLOCATE(ZTSRAD  )
  !
  !
  IF( LTRANS ) THEN
    XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) - XUTRANS
    XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) - XVTRANS
  END IF
!
ELSE
  ZSFTH    = 0.
  ZSFRV    = 0.
  ZSFSV    = 0.
  ZSFCO2   = 0.
  ZSFU     = 0.
  ZSFV     = 0.
END IF
!
CALL SECOND_MNH2(ZTIME2)
!
PGROUND = PGROUND + ZTIME2 - ZTIME1
!
!-----------------------------------------------------------------------------
!
!*        3.1    EDDY FLUXES PARAMETRIZATION
!               ------------------
!
IF (IMI==1) THEN  ! On calcule les flus turb. comme preconise par PP

   ! Heat eddy fluxes
   IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
   !
   ! Momentum eddy fluxes
   IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)

ELSE
   ! TEST pour maille infèrieure à 20km ? 
   !      car pb d'instabilités ?
   !      Pour le modèle fils, on spawne les flux du modèle père
   ! Heat eddy fluxes
   IF ( LTH_FLX ) CALL EDDY_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
   !
   ! Momentum eddy fluxes
   IF ( LUV_FLX ) CALL EDDYUV_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
   !
END IF
!-----------------------------------------------------------------------------
!
!*        4.    PASSIVE POLLUTANTS
!               ------------------
!
ZTIME1 = ZTIME2
!
IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, TPFILE)
!
!
!*        4b.  PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
!              ---------------------------------------------------
!
IF (LCONDSAMP) CALL CONDSAMP(XTSTEP, ZSFSV, ILUOUT, NVERB)
!
CALL SECOND_MNH2(ZTIME2)
!
PTRACER = PTRACER + ZTIME2 - ZTIME1
!-----------------------------------------------------------------------------
!
!               ----------
!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
                              CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ,   &
                              XRUS, XRVS, XRTKES, XRRS, XRSVS )
IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
!
CALL SECOND_MNH2(ZTIME2)
!
PDRAG = PDRAG + ZTIME2 - ZTIME1 &
             - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!*        5b.   Drag force from wind turbines 
!               -----------------------
!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
 CALL EOL_MAIN(KTCOUNT,XTSTEP,     &
               XDXX,XDYY,XDZZ,     &
               XRHODJ,             &
               XUT,XVT,XWT,        &
               XRUS, XRVS, XRWS    )
END IF
!
CALL SECOND_MNH2(ZTIME2)
!
PEOL = PEOL + ZTIME2 - ZTIME1 &
             - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!*        
!-----------------------------------------------------------------------------
!
!*        6.    TURBULENCE SCHEME
!               -----------------
!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
ZSFTH(:,:)  = ZSFTH(:,:) * XDIRCOSZW(:,:)
ZSFRV(:,:)  = ZSFRV(:,:) * XDIRCOSZW(:,:)
DO JSV=1,NSV
  ZSFSV(:,:,JSV)  = ZSFSV(:,:,JSV) * XDIRCOSZW(:,:)
END DO
!
IF (LLES_CALL) CALL SWITCH_SBG_LES_n
!
!
IF ( CTURB == 'TKEL' ) THEN
!

!*        6.1 complete surface flux fields on the border
    CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFTH, 'PHYS_PARAM_n::ZSFTH' )
    CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFRV, 'PHYS_PARAM_n::ZSFRV' )
    CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFU,  'PHYS_PARAM_n::ZSFU' )
    CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFV,  'PHYS_PARAM_n::ZSFV' )
    IF(NSV >0)THEN
      DO JSV=1,NSV
        write ( ynum, '( I6 ) ' ) jsv
        CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFSV(:,:,JSV), 'PHYS_PARAM_n::ZSFSV:'//trim( adjustl( ynum ) ) )
    CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFCO2, 'PHYS_PARAM_n::ZSFCO2' )
    CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
    CALL CLEANLIST_ll(TZFIELDS_ll)
  CALL MPPDB_CHECK2D(ZSFU,"phys_param::ZSFU",PRECISION)
  !
  IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
    ZSFTH(IIB-1,:)=ZSFTH(IIB,:)
    ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
    ZSFU(IIB-1,:)=ZSFU(IIB,:)
    ZSFV(IIB-1,:)=ZSFV(IIB,:)
    IF (NSV>0)  THEN
      ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
      WHERE ((ZSFSV(IIB-1,:,:).LT.0.).AND.(XSVT(IIB-1,:,IKB,:).EQ.0.))
          ZSFSV(IIB-1,:,:) = 0.
      END WHERE
    ENDIF
    ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
  END IF
  IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
    ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
    ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
    ZSFU(IIE+1,:)=ZSFU(IIE,:)
    ZSFV(IIE+1,:)=ZSFV(IIE,:)
    IF (NSV>0) THEN
      ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
      WHERE ((ZSFSV(IIE+1,:,:).LT.0.).AND.(XSVT(IIE+1,:,IKB,:).EQ.0.))
          ZSFSV(IIE+1,:,:) = 0.
      END WHERE
    ENDIF
    ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
  END IF
  IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
    ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
    ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
    ZSFU(:,IJB-1)=ZSFU(:,IJB)
    ZSFV(:,IJB-1)=ZSFV(:,IJB)
    IF (NSV>0) THEN
      ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
      WHERE ((ZSFSV(:,IJB-1,:).LT.0.).AND.(XSVT(:,IJB-1,IKB,:).EQ.0.))
          ZSFSV(:,IJB-1,:) = 0.
      END WHERE
    ENDIF
    ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
  END IF
  IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
    ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
    ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
    ZSFU(:,IJE+1)=ZSFU(:,IJE)
    ZSFV(:,IJE+1)=ZSFV(:,IJE)
    IF (NSV>0) THEN
      ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
      WHERE ((ZSFSV(:,IJE+1,:).LT.0.).AND.(XSVT(:,IJE+1,IKB,:).EQ.0.))
          ZSFSV(:,IJE+1,:) = 0.
      END WHERE
    ENDIF
    ZSFCO2(:,IJE+1)=ZSFCO2(:,IJE)
  END IF
!
  IF( LTRANS ) THEN
    XUT(:,:,:) = XUT(:,:,:) + XUTRANS
    XVT(:,:,:) = XVT(:,:,:) + XVTRANS
  END IF
!
!
IF(ALLOCATED(XTHW_FLUX))  THEN
 DEALLOCATE(XTHW_FLUX)
 ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
 ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
END IF

IF(ALLOCATED(XRCW_FLUX))  THEN
 DEALLOCATE(XRCW_FLUX)
 ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
 ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
END IF
!
IF(ALLOCATED(XSVW_FLUX))  THEN
 DEALLOCATE(XSVW_FLUX)
 ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
 ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
   CALL TURB( 1, IKU, 1, IMI, NRR, NRRL, NRRI, CLBCX, CLBCY, 1, NMODEL_CLOUD,        &
              LTURB_FLX, LTURB_DIAG, LSUBG_COND, LRMC01,                             &
              CTURBDIM, CTURBLEN, CTOM, CTURBLEN_CLOUD, CCLOUD,XIMPL,                &
              XTSTEP, TPFILE,                                                        &
              XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ,                                     &
              XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE,                 &
              XRHODJ, XTHVREF,                                                       &
              ZSFTH, ZSFRV, ZSFSV, ZSFU, ZSFV,                                       &
              XPABST, XUT, XVT, XWT, XTKET, XSVT, XSRCT, XBL_DEPTH, XSBL_DEPTH,      &
              XCEI, XCEI_MIN, XCEI_MAX, XCOEF_AMPL_SAT,                              &
              XTHT, XRT,                                                             &
              XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES, XRTKEMS, XSIGS, XWTHVMF, &
              XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS, XLEM           )
!
IF (LRMC01) THEN
  CALL ADD2DFIELD_ll( TZFIELDS_ll, XSBL_DEPTH, 'PHYS_PARAM_n::XSBL_DEPTH' )
  CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
  CALL CLEANLIST_ll(TZFIELDS_ll)
  IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
    XSBL_DEPTH(IIB-1,:)=XSBL_DEPTH(IIB,:)
  END IF
  IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
    XSBL_DEPTH(IIE+1,:)=XSBL_DEPTH(IIE,:)
  END IF
  IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
    XSBL_DEPTH(:,IJB-1)=XSBL_DEPTH(:,IJB)
  END IF
  IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
    XSBL_DEPTH(:,IJE+1)=XSBL_DEPTH(:,IJE)
  END IF
END IF
!
CALL SECOND_MNH2(ZTIME3)
!
!-----------------------------------------------------------------------------
!
!*        7.    EDMF SCHEME
!               -----------
!
IF (CSCONV == 'EDKF') THEN
     ALLOCATE(ZEXN (IIU,IJU,IKU))
     ALLOCATE(ZSIGMF (IIU,IJU,IKU))
     ZSIGMF(:,:,:)=0.    
     ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)  
     !$20131113 check3d on ZEXN
     CALL MPPDB_CHECK3D(ZEXN,"physparan.7::ZEXN",PRECISION)
     CALL ADD3DFIELD_ll( TZFIELDS_ll, ZEXN, 'PHYS_PARAM_n::ZEXN' )
     !$20131113 add update_halo_ll
     CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
     CALL CLEANLIST_ll(TZFIELDS_ll)
     CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
 !    
     CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV,  &
                   XIMPL_MF, XTSTEP,                                      &
                   XDZZ, XZZ,                                             &
                   XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV,          &
                   XRTHS,XRRS,XRUS,XRVS,XRSVS,                            &
                   ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
!
ELSE
    XWTHVMF(:,:,:)=0.
    XRC_MF(:,:,:)=0.
    XRI_MF(:,:,:)=0.
    XCF_MF(:,:,:)=0.
ENDIF   
!
CALL SECOND_MNH2(ZTIME4)

  IF( LTRANS ) THEN
    XUT(:,:,:) = XUT(:,:,:) - XUTRANS
    XVT(:,:,:) = XVT(:,:,:) - XVTRANS
  END IF

  IF (CMF_CLOUD == 'STAT') THEN
    XSIGS =SQRT( XSIGS**2 + ZSIGMF**2 )
  ENDIF
  IF (CSCONV == 'EDKF') THEN
    DEALLOCATE(ZSIGMF)
    DEALLOCATE(ZEXN)
  ENDIF
END IF
!
IF (LLES_CALL) CALL SWITCH_SBG_LES_n
!
CALL SECOND_MNH2(ZTIME2)
!
PTURB = PTURB + ZTIME2 - ZTIME1 - (XTIME_LES-ZTIME_LES_MF) - XTIME_LES_BU_PROCESS &
      - XTIME_BU_PROCESS - (ZTIME4 - ZTIME3)
!
PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!
!* deallocate sf flux array for ocean model (in grid nesting, dimensions can vary)
IF (LOCEAN .AND. (.NOT. LCOUPLES)) THEN
  DEALLOCATE(XSSUFL)
  DEALLOCATE(XSSVFL)
  DEALLOCATE(XSSTFL)
  DEALLOCATE(XSSOLA)
END IF
!-------------------------------------------------------------------------------
!
!* deallocation of variables used in more than one parameterization
!
DEALLOCATE(ZSFU  )         ! surface schemes + turbulence
DEALLOCATE(ZSFV  )
DEALLOCATE(ZSFTH )
DEALLOCATE(ZSFRV )
DEALLOCATE(ZSFSV )
DEALLOCATE(ZSFCO2)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE PHYS_PARAM_n