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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE DIAG_ISBA_n(HPROGRAM,                                               &
00003                          PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PQS,    &
00004                          PZ0, PZ0H, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M,    &
00005                          PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV,       &
00006                          PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC,          &
00007                          PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC,         &
00008                          PHU2M_MIN, PHU2M_MAX, PWIND10M, PWIND10M_MAX            )  
00009 !     ###############################################################################
00010 !
00011 !!****  *DIAG_ISBA_n * - Stores ISBA diagnostics
00012 !!
00013 !!    PURPOSE
00014 !!    -------
00015 !
00016 !!**  METHOD
00017 !!    ------
00018 !!
00019 !!    REFERENCE
00020 !!    ---------
00021 !!      
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!     V. Masson 
00026 !!
00027 !!    MODIFICATIONS
00028 !!    -------------
00029 !!      Original    01/2004
00030 !!      Modified    01/2006 : sea flux parameterization.
00031 !!      Modified    08/2009 : new diag
00032 !!------------------------------------------------------------------
00033 !
00034 !
00035 USE MODD_SURF_PAR,    ONLY : XUNDEF
00036 USE MODD_ISBA_n,      ONLY : TTIME
00037 USE MODD_DIAG_EVAP_ISBA_n, ONLY : LSURF_BUDGETC, XAVG_RNC,       &
00038                                     XAVG_HC, XAVG_LEC, XAVG_LEIC,  &
00039                                     XAVG_GFLUXC  
00040 !                                  
00041 USE MODD_DIAG_ISBA_n, ONLY : N2M, LSURF_BUDGET, LCOEF, LSURF_VARS,       &
00042                                XAVG_RN, XAVG_H, XAVG_LE, XAVG_GFLUX,     &
00043                                XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE,       &
00044                                XAVG_T2M, XAVG_Q2M, XAVG_HU2M,            &
00045                                XAVG_ZON10M, XAVG_MER10M, XAVG_T2M_MAX,   &
00046                                XAVG_QS, XAVG_Z0, XAVG_Z0H, XAVG_T2M_MIN, &
00047                                XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU, &
00048                                XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV  , &
00049                                XAVG_SWDC, XAVG_SWUC, XAVG_LWDC,          &
00050                                XAVG_LWUC, XAVG_FMUC, XAVG_FMVC,          &
00051                                XAVG_TS, XAVG_LEI, XAVG_HU2M_MIN,         &
00052                                XAVG_HU2M_MAX, XAVG_WIND10M,              &
00053                                XAVG_WIND10M_MAX  
00054 !
00055 !
00056 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00057 USE PARKIND1  ,ONLY : JPRB
00058 !
00059 IMPLICIT NONE
00060 !
00061 !*      0.1    declarations of arguments
00062 !
00063  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! program calling surf. schemes
00064 !
00065 REAL, DIMENSION(:), INTENT(OUT) :: PRN      ! Net radiation       (W/m2)
00066 REAL, DIMENSION(:), INTENT(OUT) :: PH       ! Sensible heat flux  (W/m2)
00067 REAL, DIMENSION(:), INTENT(OUT) :: PLE      ! Total latent heat flux    (W/m2)
00068 REAL, DIMENSION(:), INTENT(OUT) :: PLEI     ! Sublimation latent heat flux    (W/m2)
00069 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX   ! Storage flux        (W/m2)
00070 REAL, DIMENSION(:), INTENT(OUT) :: PRI      ! Richardson number   (-)
00071 REAL, DIMENSION(:), INTENT(OUT) :: PCD      ! drag coefficient    (W/s2)
00072 REAL, DIMENSION(:), INTENT(OUT) :: PCH      ! transf. coef heat   (W/s)
00073 REAL, DIMENSION(:), INTENT(OUT) :: PCE      ! transf. coef vapor  (W/s/K)
00074 REAL, DIMENSION(:), INTENT(OUT) :: PQS
00075 REAL, DIMENSION(:), INTENT(OUT) :: PZ0      ! rough. length wind  (m)
00076 REAL, DIMENSION(:), INTENT(OUT) :: PZ0H     ! rough. length heat  (m)
00077 REAL, DIMENSION(:), INTENT(OUT) :: PTS      ! surface temperature (K)
00078 REAL, DIMENSION(:), INTENT(OUT) :: PT2M     ! temperature at 2m   (K)
00079 REAL, DIMENSION(:), INTENT(OUT) :: PQ2M     ! humidity at 2m      (kg/kg)
00080 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M    ! relative humidity at 2m (-)
00081 REAL, DIMENSION(:), INTENT(OUT) :: PZON10M  ! zonal wind at 10m   (m/s)
00082 REAL, DIMENSION(:), INTENT(OUT) :: PMER10M  ! meridian wind at 10m(m/s)
00083 REAL, DIMENSION(:), INTENT(OUT) :: PSWD     ! incoming short-wave radiation (W/m2)
00084 REAL, DIMENSION(:), INTENT(OUT) :: PSWU     ! upward short-wave radiation (W/m2)
00085 REAL, DIMENSION(:), INTENT(OUT) :: PLWD     ! incoming long-wave radiation (W/m2)
00086 REAL, DIMENSION(:), INTENT(OUT) :: PLWU     ! upward long-wave radiation (W/m2)
00087 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD  ! incoming short-wave radiation by spectral band (W/m2)
00088 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU  ! upward short-wave radiation by spectral band (W/m2)
00089 REAL, DIMENSION(:), INTENT(OUT) :: PFMU     ! zonal momentum flux (Pa)
00090 REAL, DIMENSION(:), INTENT(OUT) :: PFMV     ! meridian momentum flux (Pa)
00091 REAL, DIMENSION(:), INTENT(OUT) :: PRNC     ! Net radiation       (J/m2)
00092 REAL, DIMENSION(:), INTENT(OUT) :: PHC      ! Sensible heat flux  (J/m2)
00093 REAL, DIMENSION(:), INTENT(OUT) :: PLEC     ! Total latent heat flux    (J/m2)
00094 REAL, DIMENSION(:), INTENT(OUT) :: PLEIC    ! Sublimation latent heat flux    (J/m2)
00095 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC  ! Storage flux        (J/m2)
00096 REAL, DIMENSION(:), INTENT(OUT) :: PSWDC    ! incoming short wave radiation (J/m2)
00097 REAL, DIMENSION(:), INTENT(OUT) :: PSWUC    ! outgoing short wave radiation (J/m2)
00098 REAL, DIMENSION(:), INTENT(OUT) :: PLWDC    ! incoming long wave radiation (J/m2)
00099 REAL, DIMENSION(:), INTENT(OUT) :: PLWUC    ! outgoing long wave radiation (J/m2)
00100 REAL, DIMENSION(:), INTENT(OUT) :: PFMUC    ! zonal friction
00101 REAL, DIMENSION(:), INTENT(OUT) :: PFMVC    ! meridian friction
00102 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m   (K)
00103 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m   (K)
00104 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
00105 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
00106 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
00107 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 !
00110 !
00111 !*      0.2    declarations of local variables
00112 !
00113 !-------------------------------------------------------------------------------------
00114 !
00115 IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_N',0,ZHOOK_HANDLE)
00116 IF (LSURF_BUDGET) THEN
00117   PRN      = XAVG_RN
00118   PH       = XAVG_H
00119   PLE      = XAVG_LE
00120   PLEI     = XAVG_LEI
00121   PGFLUX   = XAVG_GFLUX
00122   PSWD     = XAVG_SWD
00123   PSWU     = XAVG_SWU
00124   PLWD     = XAVG_LWD
00125   PLWU     = XAVG_LWU
00126   PSWBD    = XAVG_SWBD
00127   PSWBU    = XAVG_SWBU
00128   PFMU     = XAVG_FMU
00129   PFMV     = XAVG_FMV
00130 END IF
00131 !
00132 IF (LSURF_BUDGETC) THEN
00133   PRNC      = XAVG_RNC
00134   PHC       = XAVG_HC
00135   PLEC      = XAVG_LEC
00136   PLEIC     = XAVG_LEIC
00137   PGFLUXC   = XAVG_GFLUXC
00138   PSWDC     = XAVG_SWDC
00139   PSWUC     = XAVG_SWUC
00140   PLWDC     = XAVG_LWDC
00141   PLWUC     = XAVG_LWUC
00142   PFMUC     = XAVG_FMUC
00143   PFMVC     = XAVG_FMVC
00144 END IF
00145 !
00146 IF (N2M>=1 .OR. LSURF_BUDGET .OR. LSURF_BUDGETC) PTS = XAVG_TS
00147 !
00148 IF (N2M>=1) THEN
00149   PRI      = XAVG_RI
00150   PT2M     = XAVG_T2M
00151   PT2M_MIN = XAVG_T2M_MIN
00152   PT2M_MAX = XAVG_T2M_MAX
00153   PQ2M     = XAVG_Q2M
00154   PHU2M    = XAVG_HU2M
00155   PHU2M_MIN= XAVG_HU2M_MIN
00156   PHU2M_MAX= XAVG_HU2M_MAX
00157   PZON10M  = XAVG_ZON10M
00158   PMER10M  = XAVG_MER10M
00159   PWIND10M = XAVG_WIND10M
00160   PWIND10M_MAX = XAVG_WIND10M_MAX
00161 END IF
00162 !
00163 IF (LCOEF) THEN
00164   PCD      = XAVG_CD
00165   PCH      = XAVG_CH
00166   PCE      = XAVG_CE
00167   PZ0      = XAVG_Z0
00168   PZ0H     = XAVG_Z0H
00169 END IF
00170 !
00171 IF (LSURF_VARS) THEN
00172   PQS = XAVG_QS
00173 ENDIF
00174 !
00175 IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_N',1,ZHOOK_HANDLE)
00176 !
00177 !-------------------------------------------------------------------------------------
00178 !
00179 END SUBROUTINE DIAG_ISBA_n