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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE DIAG_TOWN_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, PSWBD, PSWBU, PLWD, PLWU, 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_TOWN_n * - Chooses the surface schemes for town 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 !!      Modified    09/2012 : new PLEI diag required by atmospheric model
00033 !!------------------------------------------------------------------
00034 !
00035 
00036 !
00037 USE MODD_SURF_PAR,   ONLY : XUNDEF
00038 USE MODD_SURF_ATM_n, ONLY : CTOWN
00039 USE MODD_CSTS,       ONLY : XTT
00040 !
00041 USE MODI_DIAG_TEB_n
00042 USE MODI_DIAG_IDEAL_n
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*      0.1    declarations of arguments
00050 !
00051  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM ! program calling surf. schemes
00052 !
00053 REAL, DIMENSION(:), INTENT(OUT) :: PRN      ! Net radiation       (W/m2)
00054 REAL, DIMENSION(:), INTENT(OUT) :: PH       ! Sensible heat flux  (W/m2)
00055 REAL, DIMENSION(:), INTENT(OUT) :: PLE      ! Total latent heat flux    (W/m2)
00056 REAL, DIMENSION(:), INTENT(OUT) :: PLEI     ! Sublimation latent heat flux (W/m2)
00057 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUX   ! Storage flux        (W/m2)
00058 REAL, DIMENSION(:), INTENT(OUT) :: PRI      ! Richardson number   (-)
00059 REAL, DIMENSION(:), INTENT(OUT) :: PCD      ! drag coefficient    (W/s2)
00060 REAL, DIMENSION(:), INTENT(OUT) :: PCH      ! transf. coef heat   (W/s)
00061 REAL, DIMENSION(:), INTENT(OUT) :: PCE      ! transf. coef vapor  (W/s/K)
00062 REAL, DIMENSION(:), INTENT(OUT) :: PQS
00063 REAL, DIMENSION(:), INTENT(OUT) :: PZ0      ! rough. length wind  (m)
00064 REAL, DIMENSION(:), INTENT(OUT) :: PZ0H     ! rough. length heat  (m)
00065 REAL, DIMENSION(:), INTENT(OUT) :: PTS      ! surface temperature (K)
00066 REAL, DIMENSION(:), INTENT(OUT) :: PT2M     ! temperature at 2m   (K)
00067 REAL, DIMENSION(:), INTENT(OUT) :: PQ2M     ! humidity at 2m      (kg/kg)
00068 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M    ! relative humidity at 2m (-)
00069 REAL, DIMENSION(:), INTENT(OUT) :: PZON10M  ! zonal wind at 10m   (m/s)
00070 REAL, DIMENSION(:), INTENT(OUT) :: PMER10M  ! meridian wind at 10m(m/s)
00071 REAL, DIMENSION(:), INTENT(OUT) :: PSWD     ! incoming short wave radiation (W/m2)
00072 REAL, DIMENSION(:), INTENT(OUT) :: PSWU     ! outgoing short wave radiation (W/m2)
00073 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBD  ! incoming short wave radiation by spectral band(W/m2)
00074 REAL, DIMENSION(:,:), INTENT(OUT) :: PSWBU  ! outgoing short wave radiation by spectral band(W/m2)
00075 REAL, DIMENSION(:), INTENT(OUT) :: PLWD     ! incoming long wave radiation (W/m2)
00076 REAL, DIMENSION(:), INTENT(OUT) :: PLWU     ! outgoing long wave radiation (W/m2)
00077 REAL, DIMENSION(:), INTENT(OUT) :: PFMU     ! zonal friction
00078 REAL, DIMENSION(:), INTENT(OUT) :: PFMV     ! meridian friction 
00079 REAL, DIMENSION(:), INTENT(OUT) :: PRNC     ! Net radiation       (J/m2)
00080 REAL, DIMENSION(:), INTENT(OUT) :: PHC      ! Sensible heat flux  (J/m2)
00081 REAL, DIMENSION(:), INTENT(OUT) :: PLEC     ! Total latent heat flux       (J/m2)
00082 REAL, DIMENSION(:), INTENT(OUT) :: PLEIC    ! Sublimation latent heat flux (J/m2)
00083 REAL, DIMENSION(:), INTENT(OUT) :: PGFLUXC  ! Storage flux        (J/m2)
00084 REAL, DIMENSION(:), INTENT(OUT) :: PSWDC    ! incoming short wave radiation (J/m2)
00085 REAL, DIMENSION(:), INTENT(OUT) :: PSWUC    ! outgoing short wave radiation (J/m2)
00086 REAL, DIMENSION(:), INTENT(OUT) :: PLWDC    ! incoming long wave radiation (J/m2)
00087 REAL, DIMENSION(:), INTENT(OUT) :: PLWUC    ! outgoing long wave radiation (J/m2)
00088 REAL, DIMENSION(:), INTENT(OUT) :: PFMUC    ! zonal friction
00089 REAL, DIMENSION(:), INTENT(OUT) :: PFMVC    ! meridian friction 
00090 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MIN ! Minimum temperature at 2m   (K)
00091 REAL, DIMENSION(:), INTENT(OUT) :: PT2M_MAX ! Maximum temperature at 2m   (K)
00092 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MIN! Minimum relative humidity at 2m (-)
00093 REAL, DIMENSION(:), INTENT(OUT) :: PHU2M_MAX! Maximum relative humidity at 2m (-)
00094 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M ! wind at 10m (m/s)
00095 REAL, DIMENSION(:), INTENT(OUT) :: PWIND10M_MAX! Maximum wind at 10m (m/s)
00096 !
00097 !*      0.2    declarations of local variables
00098 !
00099 REAL, DIMENSION(SIZE(PRN)) :: ZDELTA
00100 !
00101 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00102 !-------------------------------------------------------------------------------------
00103 !
00104 IF (LHOOK) CALL DR_HOOK('DIAG_TOWN_N',0,ZHOOK_HANDLE)
00105 IF (CTOWN=='TEB   ') THEN
00106   CALL DIAG_TEB_n(HPROGRAM,                                          &
00107                     PRN, PH, PLE, PGFLUX, PRI, PCD, PCH, PCE, PQS,     &
00108                     PZ0, PZ0H, PT2M, PQ2M, PHU2M, PZON10M, PMER10M,    &
00109                     PSWD, PSWU, PLWD, PLWU, PSWBD, PSWBU, PFMU, PFMV   )  
00110 !
00111 ! new diag not yet inplemeted for TEB (these diag are required for the climate model)
00112 !
00113 ! Ok with atmospheric model but LEI (latent heat of sublimation) must by implemented in TEB
00114   IF (SIZE(PLEI)>0) THEN
00115     PLEI(:) = XUNDEF
00116     WHERE(PLE(:)/=XUNDEF)
00117       ZDELTA(:) = MAX(0.0,SIGN(1.0,XTT-PT2M(:)))
00118       PLEI  (:) = PLE(:) * ZDELTA(:)
00119     ENDWHERE
00120   ENDIF
00121 !
00122   PTS      = XUNDEF
00123   PRNC     = XUNDEF
00124   PHC      = XUNDEF
00125   PLEC     = XUNDEF
00126   PLEIC    = XUNDEF
00127   PGFLUXC  = XUNDEF
00128   PSWDC    = XUNDEF
00129   PSWUC    = XUNDEF
00130   PLWDC    = XUNDEF
00131   PLWUC    = XUNDEF
00132   PFMUC    = XUNDEF
00133   PFMVC    = XUNDEF
00134   PT2M_MIN = XUNDEF
00135   PT2M_MAX = 0.0
00136   PHU2M_MIN= XUNDEF
00137   PHU2M_MAX= -XUNDEF
00138   PWIND10M_MAX = 0.0      
00139   PT2M_MIN = MIN(PT2M(:),PT2M_MIN(:))
00140   PT2M_MAX = MAX(PT2M(:),PT2M_MAX(:))
00141   PHU2M_MIN= MIN(PHU2M(:),PHU2M_MIN(:))
00142   PHU2M_MAX= MAX(PHU2M(:),PHU2M_MAX(:))
00143   PWIND10M    (:) = SQRT(PZON10M(:)**2+PMER10M(:)**2)
00144   PWIND10M_MAX(:) = MAX(PWIND10M_MAX(:),PWIND10M(:))
00145 !      
00146 ELSE IF (CTOWN=='FLUX  ') THEN
00147   CALL DIAG_IDEAL_n(HPROGRAM, PQS, PZ0, PZ0H, PH, PLE, PRN, PGFLUX)
00148   PLEI     = XUNDEF
00149   PRI      = XUNDEF
00150   PCD      = XUNDEF
00151   PCH      = XUNDEF
00152   PCE      = XUNDEF
00153   PTS      = XUNDEF
00154   PT2M     = XUNDEF
00155   PQ2M     = XUNDEF
00156   PHU2M    = XUNDEF
00157   PZON10M  = XUNDEF
00158   PMER10M  = XUNDEF
00159   PSWD     = XUNDEF
00160   PSWU     = XUNDEF
00161   PSWBD    = XUNDEF
00162   PSWBU    = XUNDEF
00163   PLWD     = XUNDEF
00164   PLWU     = XUNDEF
00165   PFMU     = XUNDEF
00166   PFMV     = XUNDEF
00167   PRNC     = XUNDEF
00168   PHC      = XUNDEF
00169   PLEC     = XUNDEF
00170   PLEIC    = XUNDEF
00171   PGFLUXC  = XUNDEF
00172   PSWDC    = XUNDEF
00173   PSWUC    = XUNDEF
00174   PLWDC    = XUNDEF
00175   PLWUC    = XUNDEF
00176   PFMUC    = XUNDEF
00177   PFMVC    = XUNDEF 
00178   PT2M_MIN = XUNDEF
00179   PT2M_MAX = XUNDEF
00180   PHU2M_MIN= XUNDEF
00181   PHU2M_MAX= XUNDEF  
00182   PWIND10M = XUNDEF
00183   PWIND10M_MAX = XUNDEF
00184 ELSE IF (CTOWN=='NONE  ') THEN
00185   PRN      = XUNDEF
00186   PH       = XUNDEF
00187   PLE      = XUNDEF
00188   PLEI     = XUNDEF
00189   PGFLUX   = XUNDEF
00190   PRI      = XUNDEF
00191   PCD      = XUNDEF
00192   PCH      = XUNDEF
00193   PCE      = XUNDEF
00194   PQS      = XUNDEF
00195   PZ0      = XUNDEF
00196   PZ0H     = XUNDEF
00197   PTS      = XUNDEF
00198   PT2M     = XUNDEF
00199   PQ2M     = XUNDEF
00200   PHU2M    = XUNDEF
00201   PZON10M  = XUNDEF
00202   PMER10M  = XUNDEF
00203   PSWD     = XUNDEF
00204   PSWU     = XUNDEF
00205   PSWBD    = XUNDEF
00206   PSWBU    = XUNDEF
00207   PLWD     = XUNDEF
00208   PLWU     = XUNDEF
00209   PFMU     = XUNDEF
00210   PFMV     = XUNDEF
00211   PRNC     = XUNDEF
00212   PHC      = XUNDEF
00213   PLEC     = XUNDEF
00214   PLEIC    = XUNDEF
00215   PGFLUXC  = XUNDEF
00216   PSWDC    = XUNDEF
00217   PSWUC    = XUNDEF
00218   PLWDC    = XUNDEF
00219   PLWUC    = XUNDEF
00220   PFMUC    = XUNDEF
00221   PFMVC    = XUNDEF 
00222   PT2M_MIN = XUNDEF
00223   PT2M_MAX = XUNDEF
00224   PHU2M_MIN= XUNDEF
00225   PHU2M_MAX= XUNDEF  
00226   PWIND10M = XUNDEF
00227   PWIND10M_MAX = XUNDEF
00228 END IF
00229 IF (LHOOK) CALL DR_HOOK('DIAG_TOWN_N',1,ZHOOK_HANDLE)
00230 !
00231 !-------------------------------------------------------------------------------------
00232 !
00233 END SUBROUTINE DIAG_TOWN_n