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

Go to the documentation of this file.
00001 !     #########
00002        SUBROUTINE DIAG_INLINE_TEB_n (OCANOPY, PTA, PTS, PQA, PPA, PPS, PRHOA,                  &
00003                                        PZONA, PMERA, PWIND, PHT, PHW,                          &
00004                                        PCD, PCDN, PRI, PCH, PZ0,                               &
00005                                        PTRAD, PEMIS, PDIR_ALB, PSCA_ALB,                       &
00006                                        PLW, PDIR_SW, PSCA_SW,                                  &
00007                                        PSFTH, PSFTQ, PSFZON, PSFMER, PSFCO2,                   &
00008                                        PRN, PH, PLE, PGFLUX                                    )  
00009 !     ###############################################################################!
00010 !!****  *DIAG_INLINE_TEB_n * - Computes diagnostics during TEB time-step
00011 !!
00012 !!    PURPOSE
00013 !!    -------
00014 !
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!      
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!     V. Masson
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    01/2004
00029 !!      S. Riette   06/2009 CLS_WIND has one more argument (height of diagnostic)
00030 !!      S. Riette   01/2010 Use of interpol_sbl to compute 10m wind diagnostic
00031 !!------------------------------------------------------------------
00032 !
00033 
00034 !
00035 !
00036 USE MODD_SURF_PAR,   ONLY : XUNDEF
00037 USE MODD_TEB_n,      ONLY : XT_CANYON, XQ_CANYON
00038 USE MODD_TEB_CANOPY_n, ONLY : XZ, XU, XP, XT, XQ
00039 USE MODD_DIAG_TEB_n, ONLY : N2M, LSURF_BUDGET, LCOEF, LSURF_VARS, &
00040                               XT2M, XQ2M, XHU2M, XZON10M, XMER10M,  &
00041                               XRN, XH, XLE, XGFLUX, XRI, XCD, XCH,  &
00042                               XCE, XZ0, XZ0H, XQS, XSWD, XSWU, XLWD,&
00043                               XLWU, XSWBD, XSWBU, XFMU, XFMV, XSFCO2
00044 !
00045 USE MODI_CLS_WIND
00046 USE MODI_PARAM_CLS
00047 USE MODI_DIAG_SURF_BUDGET_TEB
00048 USE MODI_INTERPOL_SBL
00049 !
00050 USE MODE_THERMOS
00051 USE MODE_COUPLING_CANOPY
00052 !
00053 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00054 USE PARKIND1  ,ONLY : JPRB
00055 !
00056 IMPLICIT NONE
00057 !
00058 !*      0.1    declarations of arguments
00059 !
00060 LOGICAL,            INTENT(IN)       :: OCANOPY  ! Flag for canopy
00061 REAL, DIMENSION(:), INTENT(IN)       :: PTA      ! atmospheric temperature
00062 REAL, DIMENSION(:), INTENT(IN)       :: PTS      ! surface temperature
00063 REAL, DIMENSION(:), INTENT(IN)       :: PQA      ! atmospheric specific humidity
00064 REAL, DIMENSION(:), INTENT(IN)       :: PPA      ! atmospheric level pressure
00065 REAL, DIMENSION(:), INTENT(IN)       :: PPS      ! surface pressure
00066 REAL, DIMENSION(:), INTENT(IN)       :: PRHOA    ! air density
00067 REAL, DIMENSION(:), INTENT(IN)       :: PZONA    ! zonal wind
00068 REAL, DIMENSION(:), INTENT(IN)       :: PMERA    ! meridian wind
00069 REAL, DIMENSION(:), INTENT(IN)       :: PWIND    ! wind
00070 REAL, DIMENSION(:), INTENT(IN)       :: PHT      ! atmospheric level height
00071 REAL, DIMENSION(:), INTENT(IN)       :: PHW      ! atmospheric level height for wind
00072 REAL, DIMENSION(:), INTENT(IN)       :: PCD      ! drag coefficient for momentum
00073 REAL, DIMENSION(:), INTENT(IN)       :: PCDN     ! neutral drag coefficient
00074 REAL, DIMENSION(:), INTENT(IN)       :: PSFZON   ! zonal friction
00075 REAL, DIMENSION(:), INTENT(IN)       :: PSFMER   ! meridian friction
00076 REAL, DIMENSION(:), INTENT(IN)       :: PSFCO2   ! CO2 flux
00077 REAL, DIMENSION(:), INTENT(IN)       :: PSFTH    ! heat flux  (W/m2)
00078 REAL, DIMENSION(:), INTENT(IN)       :: PSFTQ    ! water flux (kg/m2)
00079 REAL, DIMENSION(:), INTENT(IN)       :: PRI      ! Richardson number
00080 REAL, DIMENSION(:), INTENT(IN)       :: PCH      ! drag coefficient for heat
00081 REAL, DIMENSION(:), INTENT(IN)       :: PZ0      ! roughness length for momentum
00082 REAL, DIMENSION(:), INTENT(IN)       :: PRN      ! net radiation
00083 REAL, DIMENSION(:), INTENT(IN)       :: PH       ! sensible heat flux
00084 REAL, DIMENSION(:), INTENT(IN)       :: PLE      ! latent heat flux
00085 REAL, DIMENSION(:), INTENT(IN)       :: PGFLUX   ! storage flux
00086 REAL, DIMENSION(:,:),INTENT(IN)      :: PDIR_SW  ! direct  solar radiation (on horizontal surf.)
00087 !                                                !                                      (W/m2)
00088 REAL, DIMENSION(:,:),INTENT(IN)      :: PSCA_SW  ! diffuse solar radiation (on horizontal surf.)
00089 !                                                !                                      (W/m2)
00090 REAL, DIMENSION(:), INTENT(IN)       :: PLW      ! longwave radiation (on horizontal surf.)
00091 REAL, DIMENSION(:), INTENT(IN)       :: PTRAD    ! radiative temperature                 (K)
00092 REAL, DIMENSION(:,:),INTENT(IN)      :: PDIR_ALB ! direct albedo for each spectral band  (-)
00093 REAL, DIMENSION(:,:),INTENT(IN)      :: PSCA_ALB ! diffuse albedo for each spectral band (-)
00094 REAL, DIMENSION(:), INTENT(IN)       :: PEMIS    ! emissivity                            (-)
00095 !
00096 !*      0.2    declarations of local variables
00097 !
00098 REAL                                 :: ZZ0_O_Z0H
00099 REAL, DIMENSION(SIZE(PTA))           :: ZH  
00100 REAL, DIMENSION(SIZE(PTA))  :: ZU10
00101 REAL, DIMENSION(SIZE(PTA))  :: ZWIND10M_MAX
00102 REAL, DIMENSION(SIZE(PTA))  :: ZT2M_MIN
00103 REAL, DIMENSION(SIZE(PTA))  :: ZT2M_MAX
00104 REAL, DIMENSION(SIZE(PTA))  :: ZHU2M_MIN
00105 REAL, DIMENSION(SIZE(PTA))  :: ZHU2M_MAX
00106 INTEGER                              :: JJ    ! loop counter
00107 
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 !-------------------------------------------------------------------------------------
00110 !
00111 IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_TEB_N',0,ZHOOK_HANDLE)
00112 ZZ0_O_Z0H = 200.
00113 !
00114 !* 2m and 10m variables interpolated from canopy if used
00115 !
00116 IF (OCANOPY) THEN
00117   ZT2M_MIN(:) = XUNDEF
00118   ZT2M_MAX(:) = XUNDEF
00119   ZHU2M_MIN(:) = XUNDEF
00120   ZHU2M_MAX(:) = XUNDEF
00121   ZWIND10M_MAX(:) = XUNDEF
00122   IF (N2M>0) CALL INIT_2M_10M( XP(:,2), XT(:,2), XQ(:,2),  XU, XZ, &
00123                                PZONA, PMERA, PWIND, PRHOA,         &
00124                                XT2M, XQ2M, XHU2M, XZON10M, XMER10M,&
00125                                ZU10, ZWIND10M_MAX, ZT2M_MIN,       &
00126                                ZT2M_MAX, ZHU2M_MIN, ZHU2M_MAX )
00127 ELSE
00128 !* 2m and 10m variables using CLS laws
00129  IF (N2M==1) THEN
00130   CALL PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
00131                    PSFTH, PSFTQ, PSFZON, PSFMER,                       &
00132                    XT2M, XQ2M, XHU2M, XZON10M, XMER10M                )  
00133   !
00134   !* erases temperature and humidity 2m above roof level bu canyon air values
00135   !
00136   XT2M  = XT_CANYON
00137   XQ2M  = XQ_CANYON
00138   !
00139   !* Richardson number
00140   !
00141   XRI = PRI
00142   XHU2M = MIN(XQ_CANYON /QSAT(XT_CANYON,PPA),1.)
00143  ELSE IF (N2M==2) THEN
00144   ZH(:)=10.
00145   CALL CLS_WIND(PZONA, PMERA, PHW,  &
00146                   PCD, PCDN, PRI, ZH, &
00147                   XZON10M, XMER10M    )  
00148   XT2M  = XT_CANYON
00149   XQ2M  = XQ_CANYON
00150   XRI   = PRI
00151   XHU2M = MIN(XQ_CANYON /QSAT(XT_CANYON,PPA),1.)
00152  END IF
00153 END IF
00154 !
00155 !
00156 IF (LSURF_BUDGET) THEN
00157    !
00158    CALL DIAG_SURF_BUDGET_TEB(PDIR_SW, PSCA_SW, PDIR_ALB, PSCA_ALB,  &
00159                                PLW, PEMIS, PTRAD,                     &
00160                                XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU   )  
00161    !                             
00162    XRN    = PRN
00163    XH     = PH
00164    XLE    = PLE
00165    XGFLUX = PGFLUX
00166    XFMU   = PSFZON
00167    XFMV   = PSFMER
00168    XSFCO2 = PSFCO2
00169    !
00170 END IF
00171 !
00172 IF (LCOEF) THEN
00173   XCD    = PCD
00174   XCH    = PCH
00175   XCE    = PCH
00176   XZ0    = PZ0
00177   XZ0H   = PZ0 / ZZ0_O_Z0H
00178 END IF
00179 !
00180 IF (LSURF_VARS) THEN
00181   XQS    = XQ_CANYON
00182 END IF
00183 IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_TEB_N',1,ZHOOK_HANDLE)
00184 !-------------------------------------------------------------------------------------
00185 !
00186 END SUBROUTINE DIAG_INLINE_TEB_n