mode_coupling_canopy.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ######spl
        MODULE mode_coupling_canopy
!     ####################
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
CONTAINS
!
!     ###############################################################################
SUBROUTINE init_forc( PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, &
                      PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ )
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_U
REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_UDU
REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_E
REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_EDE
REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_T
REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_TDT
REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_Q
REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_QDQ
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_FORC',0,zhook_handle)
!
pforc_u    = 0.
pdforc_udu = 0.
!
pforc_e(:,:) = 0.
pdforc_ede(:,:) = 0.
!
pforc_t(:,:) = 0.
pdforc_tdt(:,:) = 0.
!
pforc_q(:,:) = 0.
pdforc_qdq(:,:) = 0.
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_FORC',1,zhook_handle)
!
END SUBROUTINE init_forc
!     ###############################################################################
!
!     ###############################################################################
SUBROUTINE init_coupling_canopy( SB, PPA, PU, PV, &
                                 PRHOA, PALFAU, PBETAU, PALFATH,   &
                                 PBETATH, PALFAQ, PBETAQ,          &
                                 PPPA, PTTA, PQQA, PUU, PVV,       &
                                 PUUREF, PZZREF,  PEXNA,           &
                                 PPEW_AA_COEF, PPEW_BB_COEF,       &
                                 PPET_AA_COEF, PPET_BB_COEF,       &
                                 PPEQ_AA_COEF, PPEQ_BB_COEF        )
!
USE modd_canopy_n, ONLY : canopy_t
!
USE modd_surf_par,         ONLY : xundef
USE modd_csts,             ONLY : xcpd, xrd, xp00
USE modd_surf_atm,         ONLY : xwindmin
!
IMPLICIT NONE
!
TYPE(canopy_t), INTENT(INOUT) :: SB
!
REAL, DIMENSION(:), INTENT(IN) :: PPA
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
REAL, DIMENSION(:), INTENT(IN) :: PALFAU
REAL, DIMENSION(:), INTENT(IN) :: PBETAU
REAL, DIMENSION(:), INTENT(IN) :: PALFATH
REAL, DIMENSION(:), INTENT(IN) :: PBETATH
REAL, DIMENSION(:), INTENT(IN) :: PALFAQ
REAL, DIMENSION(:), INTENT(IN) :: PBETAQ
REAL, DIMENSION(:), INTENT(OUT) :: PPPA
REAL, DIMENSION(:), INTENT(OUT) :: PTTA
REAL, DIMENSION(:), INTENT(OUT) :: PQQA
REAL, DIMENSION(:), INTENT(OUT) :: PUU
REAL, DIMENSION(:), INTENT(OUT) :: PVV
REAL, DIMENSION(:), INTENT(OUT) :: PUUREF
REAL, DIMENSION(:), INTENT(OUT) :: PZZREF
REAL, DIMENSION(:), INTENT(OUT) :: PEXNA
REAL, DIMENSION(:), INTENT(OUT) :: PPEW_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEW_BB_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPET_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPET_BB_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_BB_COEF
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_COUPLING_CANOPY',0,zhook_handle)
!
pppa = sb%XP(:,1)
ptta = sb%XT(:,1)
pqqa = sb%XQ(:,1)
puu  = pu / max(sqrt(pu**2+pv**2),xwindmin) * sb%XU(:,1)
pvv  = pv / max(sqrt(pu**2+pv**2),xwindmin) * sb%XU(:,1)
puuref = sb%XZ(:,1)
pzzref = sb%XZ(:,1)
!
pexna(:)   = (sb%XP(:,1)/xp00)**(xrd/xcpd)
WHERE (sb%XP(:,1)==xundef) !* security at first time-step
  pexna = (ppa/xp00)**(xrd/xcpd)
  pppa  = ppa
END WHERE
!
!* ALMA conventions for implicit coefficients:
! U+  = - rho A u'w'  + B
! Th+ = - rho A w'th' + B
! q+  = - rho A w'q'  + B
!
ppew_aa_coef = - palfau / prhoa
ppew_bb_coef = pbetau
ppet_aa_coef = - palfath / prhoa
ppet_bb_coef = pbetath
ppeq_aa_coef = - palfaq / prhoa
ppeq_bb_coef = pbetaq
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_COUPLING_CANOPY',1,zhook_handle)
!
END SUBROUTINE init_coupling_canopy
!     ###############################################################################
!
!     ###############################################################################
SUBROUTINE init_coupling( HCOUPLING,                  &
                          PPS, PPA, PTA, PQA, PU, PV, &
                          PUREF, PZREF,               &
                          PPEW_A_COEF, PPEW_B_COEF,   &
                          PPET_A_COEF, PPET_B_COEF,   &
                          PPEQ_A_COEF, PPEQ_B_COEF,   &
                          PPPA, PTTA, PQQA, PUU, PVV, &
                          PUUREF, PZZREF,             &
                          PPEW_AA_COEF, PPEW_BB_COEF, &
                          PPET_AA_COEF, PPET_BB_COEF, &
                          PPEQ_AA_COEF, PPEQ_BB_COEF  ) 
!
USE modd_csts,             ONLY : xcpd, xrd, xp00
!
IMPLICIT NONE
!
 CHARACTER(LEN=1),   INTENT(IN) :: HCOUPLING
REAL, DIMENSION(:), INTENT(IN) :: PPS
REAL, DIMENSION(:), INTENT(IN) :: PPA
REAL, DIMENSION(:), INTENT(IN) :: PTA
REAL, DIMENSION(:), INTENT(IN) :: PQA
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PUREF
REAL, DIMENSION(:), INTENT(IN) :: PZREF
REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF
REAL, DIMENSION(:), INTENT(IN) :: PPEW_B_COEF
REAL, DIMENSION(:), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(:), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(:), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(:), INTENT(IN) :: PPEQ_B_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPPA
REAL, DIMENSION(:), INTENT(OUT) :: PTTA
REAL, DIMENSION(:), INTENT(OUT) :: PQQA
REAL, DIMENSION(:), INTENT(OUT) :: PUU
REAL, DIMENSION(:), INTENT(OUT) :: PVV
REAL, DIMENSION(:), INTENT(OUT) :: PUUREF
REAL, DIMENSION(:), INTENT(OUT) :: PZZREF
REAL, DIMENSION(:), INTENT(OUT) :: PPEW_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEW_BB_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPET_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPET_BB_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_AA_COEF
REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_BB_COEF
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_COUPLING',0,zhook_handle)
!
pppa = ppa
ptta = pta
pqqa = pqa
puu  = pu 
pvv  = pv 
puuref = puref
pzzref = pzref
!
ppew_aa_coef = ppew_a_coef
ppew_bb_coef = ppew_b_coef
!
IF (hcoupling=='I') THEN
  ppet_aa_coef = ppet_a_coef
  ppeq_aa_coef = ppeq_a_coef
  ppet_bb_coef = ppet_b_coef
  ppeq_bb_coef = ppeq_b_coef
ELSE
  ppet_aa_coef =  0.
  ppet_bb_coef =  pta / (ppa/xp00)**(xrd/xcpd)
  ppeq_aa_coef =  0.
  ppeq_bb_coef =  pqa
ENDIF
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_COUPLING',1,zhook_handle)
!
END SUBROUTINE init_coupling
!     ###############################################################################
!
!     ###############################################################################
SUBROUTINE init_2m_10m( SB, D, PU, PV, PWIND, PRHOA )
!
USE modd_canopy_n, ONLY : canopy_t
USE modd_diag_n, ONLY : diag_t
!
USE modd_surf_par, ONLY : xundef
!
USE mode_thermos,  ONLY : qsat
!
USE modi_interpol_sbl
!
IMPLICIT NONE
!
TYPE(canopy_t), INTENT(INOUT) :: SB
TYPE(diag_t), INTENT(INOUT) :: D
!
REAL, DIMENSION(:), INTENT(IN) :: PU
REAL, DIMENSION(:), INTENT(IN) :: PV
REAL, DIMENSION(:), INTENT(IN) :: PWIND
REAL, DIMENSION(:), INTENT(IN) :: PRHOA
!
REAL, DIMENSION(SIZE(SB%XT,1))   :: ZU10
INTEGER                     :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_2M_10M',0,zhook_handle)
!
d%XT2M(:) = sb%XT(:,2)
d%XT2M_MIN(:) = min(d%XT2M(:),d%XT2M_MIN(:))
d%XT2M_MAX(:) = max(d%XT2M(:),d%XT2M_MAX(:))
d%XQ2M(:) = sb%XQ(:,2) / prhoa(:)
d%XHU2M(:)= min( d%XQ2M(:) / qsat(d%XT2M(:),sb%XP(:,2)) , 1.)
d%XHU2M_MIN(:) = min(d%XHU2M(:),d%XHU2M_MIN(:))
d%XHU2M_MAX(:) = max(d%XHU2M(:),d%XHU2M_MAX(:))
 CALL interpol_sbl(sb%XZ(:,:),sb%XU(:,:),10.,zu10(:))
DO jj=1,SIZE(sb%XT(:,2))
  IF (zu10(jj)/=xundef) THEN
    IF (pwind(jj)>0.) THEN
      d%XZON10M(jj) = zu10(jj) * pu(jj)/pwind(jj)
      d%XMER10M(jj) = zu10(jj) * pv(jj)/pwind(jj)
    ELSE
      d%XZON10M(jj) = 0.
      d%XMER10M(jj) = 0.
    END IF
     d%XWIND10M(jj) = sqrt(d%XZON10M(jj)**2+d%XMER10M(jj)**2)
     d%XWIND10M_MAX(jj) = max(d%XWIND10M(jj),d%XWIND10M_MAX(jj))
  ELSE
    d%XZON10M(jj) = xundef
    d%XMER10M(jj) = xundef
    d%XWIND10M(jj) = xundef
    d%XWIND10M_MAX(jj) = xundef
  END IF
END DO
!
IF (lhook) CALL dr_hook('MODE_COUPLING_CANOPY:INIT_2M_10M',1,zhook_handle)
!
END SUBROUTINE
!
END MODULE mode_coupling_canopy