SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_coupling

Go to the documentation of this file.
00001 !     ######spl
00002         MODULE MODE_COUPLING_CANOPY
00003 !     ####################
00004 !
00005 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00006 USE PARKIND1  ,ONLY : JPRB
00007 !
00008 CONTAINS
00009 !
00010 !     ###############################################################################
00011 SUBROUTINE INIT_FORC( PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, &
00012                       PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ )
00013 !
00014 IMPLICIT NONE
00015 !
00016 REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_U
00017 REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_UDU
00018 REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_E
00019 REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_EDE
00020 REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_T
00021 REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_TDT
00022 REAL, DIMENSION(:,:), INTENT(OUT) :: PFORC_Q
00023 REAL, DIMENSION(:,:), INTENT(OUT) :: PDFORC_QDQ
00024 !
00025 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00026 !
00027 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_FORC',0,ZHOOK_HANDLE)
00028 !
00029 PFORC_U    = 0.
00030 PDFORC_UDU = 0.
00031 !
00032 PFORC_E(:,:) = 0.
00033 PDFORC_EDE(:,:) = 0.
00034 !
00035 PFORC_T(:,:) = 0.
00036 PDFORC_TDT(:,:) = 0.
00037 !
00038 PFORC_Q(:,:) = 0.
00039 PDFORC_QDQ(:,:) = 0.
00040 !
00041 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_FORC',1,ZHOOK_HANDLE)
00042 !
00043 END SUBROUTINE INIT_FORC
00044 !     ###############################################################################
00045 !
00046 !     ###############################################################################
00047 SUBROUTINE INIT_COUPLING_CANOPY( PP, PPA, PT, PQ, PU, PV, PZ, PXU, &
00048                                  PRHOA, PALFAU, PBETAU, PALFATH,   &
00049                                  PBETATH, PALFAQ, PBETAQ,          &
00050                                  PPPA, PTTA, PQQA, PUU, PVV,       &
00051                                  PUUREF, PZZREF,  PEXNA,           &
00052                                  PPEW_AA_COEF, PPEW_BB_COEF,       &
00053                                  PPET_AA_COEF, PPET_BB_COEF,       &
00054                                  PPEQ_AA_COEF, PPEQ_BB_COEF        )
00055 !
00056 USE MODD_SURF_PAR,         ONLY : XUNDEF
00057 USE MODD_CSTS,             ONLY : XCPD, XRD, XP00
00058 USE MODD_SURF_ATM,         ONLY : XWINDMIN
00059 !
00060 IMPLICIT NONE
00061 !
00062 REAL, DIMENSION(:), INTENT(IN) :: PP
00063 REAL, DIMENSION(:), INTENT(IN) :: PPA
00064 REAL, DIMENSION(:), INTENT(IN) :: PT
00065 REAL, DIMENSION(:), INTENT(IN) :: PQ
00066 REAL, DIMENSION(:), INTENT(IN) :: PU
00067 REAL, DIMENSION(:), INTENT(IN) :: PV
00068 REAL, DIMENSION(:), INTENT(IN) :: PZ
00069 REAL, DIMENSION(:), INTENT(IN) :: PXU
00070 REAL, DIMENSION(:), INTENT(IN) :: PRHOA
00071 REAL, DIMENSION(:), INTENT(IN) :: PALFAU
00072 REAL, DIMENSION(:), INTENT(IN) :: PBETAU
00073 REAL, DIMENSION(:), INTENT(IN) :: PALFATH
00074 REAL, DIMENSION(:), INTENT(IN) :: PBETATH
00075 REAL, DIMENSION(:), INTENT(IN) :: PALFAQ
00076 REAL, DIMENSION(:), INTENT(IN) :: PBETAQ
00077 REAL, DIMENSION(:), INTENT(OUT) :: PPPA
00078 REAL, DIMENSION(:), INTENT(OUT) :: PTTA
00079 REAL, DIMENSION(:), INTENT(OUT) :: PQQA
00080 REAL, DIMENSION(:), INTENT(OUT) :: PUU
00081 REAL, DIMENSION(:), INTENT(OUT) :: PVV
00082 REAL, DIMENSION(:), INTENT(OUT) :: PUUREF
00083 REAL, DIMENSION(:), INTENT(OUT) :: PZZREF
00084 REAL, DIMENSION(:), INTENT(OUT) :: PEXNA
00085 REAL, DIMENSION(:), INTENT(OUT) :: PPEW_AA_COEF
00086 REAL, DIMENSION(:), INTENT(OUT) :: PPEW_BB_COEF
00087 REAL, DIMENSION(:), INTENT(OUT) :: PPET_AA_COEF
00088 REAL, DIMENSION(:), INTENT(OUT) :: PPET_BB_COEF
00089 REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_AA_COEF
00090 REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_BB_COEF
00091 !
00092 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00093 !
00094 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_COUPLING_CANOPY',0,ZHOOK_HANDLE)
00095 !
00096 PPPA = PP(:)
00097 PTTA = PT(:)
00098 PQQA = PQ(:)
00099 PUU  = PU / MAX(SQRT(PU**2+PV**2),XWINDMIN) * PXU(:)
00100 PVV  = PV / MAX(SQRT(PU**2+PV**2),XWINDMIN) * PXU(:)
00101 PUUREF = PZ(:)
00102 PZZREF = PZ(:)
00103 !
00104 PEXNA(:)   = (PP(:)/XP00)**(XRD/XCPD)
00105 WHERE (PP(:)==XUNDEF) !* security at first time-step
00106   PEXNA = (PPA/XP00)**(XRD/XCPD)
00107   PPPA  = PPA
00108 END WHERE
00109 !
00110 !* ALMA conventions for implicit coefficients:
00111 ! U+  = - rho A u'w'  + B
00112 ! Th+ = - rho A w'th' + B
00113 ! q+  = - rho A w'q'  + B
00114 !
00115 PPEW_AA_COEF = - PALFAU / PRHOA
00116 PPEW_BB_COEF = PBETAU
00117 PPET_AA_COEF = - PALFATH / PRHOA
00118 PPET_BB_COEF = PBETATH
00119 PPEQ_AA_COEF = - PALFAQ / PRHOA
00120 PPEQ_BB_COEF = PBETAQ
00121 !
00122 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_COUPLING_CANOPY',1,ZHOOK_HANDLE)
00123 !
00124 END SUBROUTINE INIT_COUPLING_CANOPY
00125 !     ###############################################################################
00126 !
00127 !     ###############################################################################
00128 SUBROUTINE INIT_COUPLING( HCOUPLING,                  &
00129                           PPS, PPA, PTA, PQA, PU, PV, &
00130                           PUREF, PZREF,               &
00131                           PPEW_A_COEF, PPEW_B_COEF,   &
00132                           PPET_A_COEF, PPET_B_COEF,   &
00133                           PPEQ_A_COEF, PPEQ_B_COEF,   &
00134                           PPPA, PTTA, PQQA, PUU, PVV, &
00135                           PUUREF, PZZREF,             &
00136                           PPEW_AA_COEF, PPEW_BB_COEF, &
00137                           PPET_AA_COEF, PPET_BB_COEF, &
00138                           PPEQ_AA_COEF, PPEQ_BB_COEF  ) 
00139 !
00140 USE MODD_CSTS,             ONLY : XCPD, XRD, XP00
00141 !
00142 IMPLICIT NONE
00143 !
00144  CHARACTER(LEN=1),   INTENT(IN) :: HCOUPLING
00145 REAL, DIMENSION(:), INTENT(IN) :: PPS
00146 REAL, DIMENSION(:), INTENT(IN) :: PPA
00147 REAL, DIMENSION(:), INTENT(IN) :: PTA
00148 REAL, DIMENSION(:), INTENT(IN) :: PQA
00149 REAL, DIMENSION(:), INTENT(IN) :: PU
00150 REAL, DIMENSION(:), INTENT(IN) :: PV
00151 REAL, DIMENSION(:), INTENT(IN) :: PUREF
00152 REAL, DIMENSION(:), INTENT(IN) :: PZREF
00153 REAL, DIMENSION(:), INTENT(IN) :: PPEW_A_COEF
00154 REAL, DIMENSION(:), INTENT(IN) :: PPEW_B_COEF
00155 REAL, DIMENSION(:), INTENT(IN) :: PPET_A_COEF
00156 REAL, DIMENSION(:), INTENT(IN) :: PPET_B_COEF
00157 REAL, DIMENSION(:), INTENT(IN) :: PPEQ_A_COEF
00158 REAL, DIMENSION(:), INTENT(IN) :: PPEQ_B_COEF
00159 REAL, DIMENSION(:), INTENT(OUT) :: PPPA
00160 REAL, DIMENSION(:), INTENT(OUT) :: PTTA
00161 REAL, DIMENSION(:), INTENT(OUT) :: PQQA
00162 REAL, DIMENSION(:), INTENT(OUT) :: PUU
00163 REAL, DIMENSION(:), INTENT(OUT) :: PVV
00164 REAL, DIMENSION(:), INTENT(OUT) :: PUUREF
00165 REAL, DIMENSION(:), INTENT(OUT) :: PZZREF
00166 REAL, DIMENSION(:), INTENT(OUT) :: PPEW_AA_COEF
00167 REAL, DIMENSION(:), INTENT(OUT) :: PPEW_BB_COEF
00168 REAL, DIMENSION(:), INTENT(OUT) :: PPET_AA_COEF
00169 REAL, DIMENSION(:), INTENT(OUT) :: PPET_BB_COEF
00170 REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_AA_COEF
00171 REAL, DIMENSION(:), INTENT(OUT) :: PPEQ_BB_COEF
00172 !
00173 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00174 !
00175 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_COUPLING',0,ZHOOK_HANDLE)
00176 !
00177 PPPA = PPA
00178 PTTA = PTA
00179 PQQA = PQA
00180 PUU  = PU 
00181 PVV  = PV 
00182 PUUREF = PUREF
00183 PZZREF = PZREF
00184 !
00185 PPEW_AA_COEF = PPEW_A_COEF
00186 PPEW_BB_COEF = PPEW_B_COEF
00187 !
00188 IF (HCOUPLING=='I') THEN
00189   PPET_AA_COEF = PPET_A_COEF
00190   PPEQ_AA_COEF = PPEQ_A_COEF
00191   PPET_BB_COEF = PPET_B_COEF
00192   PPEQ_BB_COEF = PPEQ_B_COEF
00193 ELSE
00194   PPET_AA_COEF =  0.
00195   PPET_BB_COEF =  PTA / (PPA/XP00)**(XRD/XCPD)
00196   PPEQ_AA_COEF =  0.
00197   PPEQ_BB_COEF =  PQA
00198 ENDIF
00199 !
00200 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_COUPLING',1,ZHOOK_HANDLE)
00201 !
00202 END SUBROUTINE INIT_COUPLING
00203 !     ###############################################################################
00204 !
00205 !     ###############################################################################
00206 SUBROUTINE INIT_2M_10M( PP, PT, PQ, PXU, PXZ, PU, PV, PWIND, PRHOA,   &
00207                         PT2M, PQ2M, PHU2M, PZON10M, PMER10M,          &
00208                         PWIND10M,  PWIND10M_MAX, PT2M_MIN, PT2M_MAX,  &
00209                         PHU2M_MIN, PHU2M_MAX                          )
00210 !
00211 USE MODD_SURF_PAR, ONLY : XUNDEF
00212 !
00213 USE MODE_THERMOS,  ONLY : QSAT
00214 !
00215 USE MODI_INTERPOL_SBL
00216 !
00217 IMPLICIT NONE
00218 !
00219 REAL, DIMENSION(:), INTENT(IN) :: PP
00220 REAL, DIMENSION(:), INTENT(IN) :: PT
00221 REAL, DIMENSION(:), INTENT(IN) :: PQ
00222 REAL, DIMENSION(:,:), INTENT(IN) :: PXU
00223 REAL, DIMENSION(:,:), INTENT(IN) :: PXZ
00224 REAL, DIMENSION(:), INTENT(IN) :: PU
00225 REAL, DIMENSION(:), INTENT(IN) :: PV
00226 REAL, DIMENSION(:), INTENT(IN) :: PWIND
00227 REAL, DIMENSION(:), INTENT(IN) :: PRHOA
00228 REAL, DIMENSION(:), INTENT(OUT) :: PT2M 
00229 REAL, DIMENSION(:), INTENT(OUT) :: PQ2M
00230 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M
00231 REAL, DIMENSION(:), INTENT(OUT) :: PZON10M
00232 REAL, DIMENSION(:), INTENT(OUT) :: PMER10M
00233 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M
00234 REAL, DIMENSION(:), INTENT(INOUT) :: PWIND10M_MAX
00235 REAL, DIMENSION(:), INTENT(INOUT) :: PT2M_MIN
00236 REAL, DIMENSION(:), INTENT(INOUT) :: PT2M_MAX
00237 REAL, DIMENSION(:), INTENT(INOUT) :: PHU2M_MIN
00238 REAL, DIMENSION(:), INTENT(INOUT) :: PHU2M_MAX
00239 !
00240 REAL, DIMENSION(SIZE(PT))   :: ZU10
00241 INTEGER                     :: JJ
00242 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00243 !
00244 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_2M_10M',0,ZHOOK_HANDLE)
00245 !
00246 PT2M(:) = PT(:)
00247 PT2M_MIN(:) = MIN(PT2M(:),PT2M_MIN(:))
00248 PT2M_MAX(:) = MAX(PT2M(:),PT2M_MAX(:))
00249 PQ2M(:) = PQ(:) / PRHOA(:)
00250 PHU2M(:)= MIN( PQ2M(:) / QSAT(PT2M(:),PP(:)) , 1.)
00251 PHU2M_MIN(:) = MIN(PHU2M(:),PHU2M_MIN(:))
00252 PHU2M_MAX(:) = MAX(PHU2M(:),PHU2M_MAX(:))
00253  CALL INTERPOL_SBL(PXZ(:,:),PXU(:,:),10.,ZU10(:))
00254 DO JJ=1,SIZE(PT)
00255   IF (ZU10(JJ)/=XUNDEF) THEN
00256     IF (PWIND(JJ)>0.) THEN
00257       PZON10M(JJ) = ZU10(JJ) * PU(JJ)/PWIND(JJ)
00258       PMER10M(JJ) = ZU10(JJ) * PV(JJ)/PWIND(JJ)
00259     ELSE
00260       PZON10M(JJ) = 0.
00261       PMER10M(JJ) = 0.
00262     END IF
00263      PWIND10M(JJ) = SQRT(PZON10M(JJ)**2+PMER10M(JJ)**2)
00264      PWIND10M_MAX(JJ) = MAX(PWIND10M(JJ),PWIND10M_MAX(JJ))
00265   ELSE
00266     PZON10M(JJ) = XUNDEF
00267     PMER10M(JJ) = XUNDEF
00268     PWIND10M(JJ) = XUNDEF
00269     PWIND10M_MAX(JJ) = XUNDEF
00270   END IF
00271 END DO
00272 !
00273 IF (LHOOK) CALL DR_HOOK('MODE_COUPLING_CANOPY:INIT_2M_10M',1,ZHOOK_HANDLE)
00274 !
00275 END SUBROUTINE
00276 !
00277 END MODULE MODE_COUPLING_CANOPY