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

Go to the documentation of this file.
00001 !     #########
00002        SUBROUTINE DIAG_INLINE_WATFLUX_n (PTSTEP, PTA, PTS, PQA, PPA, PPS, PRHOA, PZONA,  &
00003                                            PMERA, PHT, PHW, PCD, PCDN, PCH, PRI, PHU, PZ0, &
00004                                            PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER,      &
00005                                            PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB,      &
00006                                            PEMIS, PTRAD, PRAIN, PSNOW, PTICE, PSFTH_ICE,   &
00007                                            PSFTQ_ICE                                       )  
00008 !     ###############################################################################
00009 !
00010 !!****  *DIAG_INLINE_WATFLUX_n * - computes diagnostics during WATFLUX 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 !!      B. Decharme 08/2009 : Diag for Earth System Model Coupling
00030 !!      S. Riette   06/2009 CLS_2M becomes CLS_TQ, CLS_TQ and CLS_WIND have one
00031 !!                          more argument (height of diagnostic)
00032 !!------------------------------------------------------------------
00033 !
00034 
00035 !
00036 !
00037 USE MODD_CSTS,           ONLY : XTT
00038 USE MODD_SURF_PAR,       ONLY : XUNDEF
00039 USE MODD_SURF_ATM,       ONLY : LCPL_ESM
00040 USE MODD_WATFLUX_n,      ONLY : LSBL
00041 USE MODD_DIAG_WATFLUX_n, ONLY : N2M, LSURF_BUDGET, LCOEF, LSURF_VARS, &
00042                                   XT2M, XQ2M, XHU2M, XZON10M, XMER10M,  &
00043                                   XRN, XH, XLE, XLEI, XGFLUX, XRI, XCD, &
00044                                   XCH, XCE, XZ0, XZ0H, XQS, XSWD, XSWU, &
00045                                   XLWD, XLWU, XSWBD, XSWBU, XFMU, XFMV, &
00046                                   LSURF_BUDGETC, XT2M_MIN, XT2M_MAX,    &
00047                                   XDIAG_TS, XHU2M_MIN, XHU2M_MAX,       &
00048                                   XWIND10M, XWIND10M_MAX  
00049 !
00050 USE MODI_PARAM_CLS
00051 USE MODI_CLS_TQ
00052 USE MODI_CLS_WIND
00053 USE MODI_DIAG_SURF_BUDGET_WATER
00054 USE MODI_DIAG_SURF_BUDGETC_WATER
00055 USE MODI_DIAG_CPL_ESM_WATER
00056 ! 
00057 !
00058 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00059 USE PARKIND1  ,ONLY : JPRB
00060 !
00061 IMPLICIT NONE
00062 !
00063 !*      0.1    declarations of arguments
00064 !
00065 REAL,               INTENT(IN) :: PTSTEP ! atmospheric time-step                 (s)
00066 REAL, DIMENSION(:), INTENT(IN) :: PTA    ! atmospheric temperature
00067 REAL, DIMENSION(:), INTENT(IN) :: PTS    ! surface temperature
00068 REAL, DIMENSION(:), INTENT(IN) :: PQA    ! atmospheric specific humidity
00069 REAL, DIMENSION(:), INTENT(IN) :: PPA    ! atmospheric level pressure
00070 REAL, DIMENSION(:), INTENT(IN) :: PPS    ! surface pressure
00071 REAL, DIMENSION(:), INTENT(IN) :: PRHOA  ! air density
00072 REAL, DIMENSION(:), INTENT(IN) :: PZONA  ! zonal wind
00073 REAL, DIMENSION(:), INTENT(IN) :: PMERA  ! meridian wind
00074 REAL, DIMENSION(:), INTENT(IN) :: PHT    ! atmospheric level height
00075 REAL, DIMENSION(:), INTENT(IN) :: PHW    ! atmospheric level height for wind
00076 REAL, DIMENSION(:), INTENT(IN) :: PCD    ! drag coefficient for momentum
00077 REAL, DIMENSION(:), INTENT(IN) :: PCDN   ! neutral drag coefficient
00078 REAL, DIMENSION(:), INTENT(IN) :: PCH    ! drag coefficient for heat
00079 REAL, DIMENSION(:), INTENT(IN) :: PRI    ! Richardson number
00080 REAL, DIMENSION(:), INTENT(IN) :: PHU    ! near-surface humidity
00081 REAL, DIMENSION(:), INTENT(IN) :: PZ0    ! roughness length for momentum
00082 REAL, DIMENSION(:), INTENT(IN) :: PZ0H   ! roughness length for heat
00083 REAL, DIMENSION(:), INTENT(IN) :: PQSAT  ! humidity at saturation
00084 REAL, DIMENSION(:), INTENT(IN) :: PSFZON ! zonal friction
00085 REAL, DIMENSION(:), INTENT(IN) :: PSFMER ! meridian friction
00086 REAL, DIMENSION(:), INTENT(IN) :: PSFTH  ! heat flux  (W/m2)
00087 REAL, DIMENSION(:), INTENT(IN) :: PSFTQ  ! water flux (kg/m2/s)
00088 REAL, DIMENSION(:,:),INTENT(IN):: PDIR_SW   ! direct  solar radiation (on horizontal surf.)
00089 !                                           !                                       (W/m2)
00090 REAL, DIMENSION(:,:),INTENT(IN):: PSCA_SW   ! diffuse solar radiation (on horizontal surf.)
00091 !                                           !                                       (W/m2)
00092 REAL, DIMENSION(:), INTENT(IN) :: PLW       ! longwave radiation (on horizontal surf.)
00093 REAL, DIMENSION(:), INTENT(IN) :: PTRAD     ! radiative temperature                 (K)
00094 REAL, DIMENSION(:,:),INTENT(IN):: PDIR_ALB  ! direct albedo for each spectral band  (-)
00095 REAL, DIMENSION(:,:),INTENT(IN):: PSCA_ALB  ! diffuse albedo for each spectral band (-)
00096 REAL, DIMENSION(:), INTENT(IN) :: PEMIS     ! emissivity                            (-)
00097 !
00098 REAL, DIMENSION(:), INTENT(IN) :: PRAIN     ! Rainfall (kg/m2/s)
00099 REAL, DIMENSION(:), INTENT(IN) :: PSNOW     ! Snowfall (kg/m2/s)
00100 REAL, DIMENSION(:), INTENT(IN) :: PSFTH_ICE ! heat flux  (W/m2)
00101 REAL, DIMENSION(:), INTENT(IN) :: PSFTQ_ICE ! water flux (kg/m2/s)
00102 REAL, DIMENSION(:), INTENT(IN) :: PTICE     ! Ice Surface Temperature
00103 !
00104 !*      0.2    declarations of local variables
00105 !
00106 REAL, DIMENSION(SIZE(PTA)) :: ZH
00107 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00108 !-------------------------------------------------------------------------------------
00109 !
00110 IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_WATFLUX_N',0,ZHOOK_HANDLE)
00111 XDIAG_TS(:) = PTS(:)
00112 !
00113 IF (.NOT. LSBL) THEN
00114 !        
00115   IF (N2M==1) THEN
00116        
00117     CALL PARAM_CLS(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PHT, PHW, &
00118                      PSFTH, PSFTQ, PSFZON, PSFMER,                       &
00119                      XT2M, XQ2M, XHU2M, XZON10M, XMER10M                       )  
00120   ELSE IF (N2M==2) THEN
00121     ZH(:)=2.          
00122     CALL CLS_TQ(PTA, PQA, PPA, PPS, PHT,         &
00123                   PCD, PCH, PRI,                   &
00124                   PTS, PHU, PZ0H, ZH,              &
00125                   XT2M, XQ2M, XHU2M                )  
00126     ZH(:)=10.                
00127     CALL CLS_WIND(PZONA, PMERA, PHW,             &
00128                     PCD, PCDN, PRI, ZH,            &
00129                     XZON10M, XMER10M               )  
00130   END IF
00131 !
00132   IF (N2M>=1) THEN
00133     !
00134     XT2M_MIN(:) = MIN(XT2M_MIN(:),XT2M(:))
00135     XT2M_MAX(:) = MAX(XT2M_MAX(:),XT2M(:))
00136     !
00137     XHU2M_MIN(:) = MIN(XHU2M_MIN(:),XHU2M(:))
00138     XHU2M_MAX(:) = MAX(XHU2M_MAX(:),XHU2M(:))
00139     !
00140     XWIND10M    (:) = SQRT(XZON10M**2+XMER10M**2)
00141     XWIND10M_MAX(:) = MAX(XWIND10M_MAX(:),XWIND10M(:))
00142     !
00143     !* Richardson number
00144     XRI = PRI
00145     !
00146   ENDIF
00147 !
00148 ELSE
00149   IF (N2M>=1) THEN        
00150     XT2M    = XUNDEF
00151     XQ2M    = XUNDEF
00152     XHU2M   = XUNDEF
00153     XZON10M = XUNDEF
00154     XMER10M = XUNDEF
00155     XRI     = PRI           
00156   ENDIF
00157 ENDIF        
00158 !
00159 IF (LSURF_BUDGET.OR.LSURF_BUDGETC) THEN
00160   !
00161   CALL  DIAG_SURF_BUDGET_WATER (XTT, PRHOA, PSFTH, PSFTQ,             &
00162                                   PDIR_SW, PSCA_SW, PLW,                &
00163                                   PDIR_ALB, PSCA_ALB, PEMIS, PTRAD,     &
00164                                   PSFZON, PSFMER,                       &
00165                                   XRN, XH, XLE, XLEI, XGFLUX,           &
00166                                   XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU, &
00167                                   XFMU, XFMV )  
00168   !
00169 END IF
00170 !
00171 IF(LSURF_BUDGETC)THEN
00172   CALL DIAG_SURF_BUDGETC_WATER(PTSTEP, XRN, XH, XLE, XLEI, XGFLUX, &
00173                                  XSWD, XSWU, XLWD, XLWU, XFMU, XFMV  )  
00174 ENDIF
00175 !
00176 IF (LCOEF) THEN
00177   !
00178   !* Transfer coefficients
00179   !
00180   XCD = PCD
00181   XCH = PCH
00182   XCE = PCH
00183   !
00184   !* Roughness lengths
00185   !
00186   XZ0  = PZ0
00187   XZ0H = PZ0H
00188   !
00189 END IF
00190 !
00191 IF (LSURF_VARS) THEN
00192   !
00193   !* Humidity at saturation
00194   !
00195   XQS = PQSAT
00196   !
00197 END IF
00198 !
00199 ! Diag for Earth System Model coupling
00200 !
00201 IF (LCPL_ESM) THEN
00202 !
00203   CALL DIAG_CPL_ESM_WATER(PTSTEP,XZON10M,XMER10M,XFMU,XFMV,  &
00204                             XSWD,XSWU,XGFLUX,PSFTQ,PRAIN,      &
00205                             PSNOW,PLW,PTICE,PSFTH_ICE,         &
00206                             PSFTQ_ICE,PDIR_SW,PSCA_SW          )  
00207 ! 
00208 ENDIF
00209 IF (LHOOK) CALL DR_HOOK('DIAG_INLINE_WATFLUX_N',1,ZHOOK_HANDLE)
00210 !
00211 !-------------------------------------------------------------------------------------
00212 !
00213 END SUBROUTINE DIAG_INLINE_WATFLUX_n