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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PREP_TEB_UNIF(KLUOUT,HSURF,PFIELD)
00003 !     #################################################################################
00004 !
00005 !!****  *PREP_TEB_UNIF* - prepares TEB field from prescribed values
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    REFERENCE
00014 !!    ---------
00015 !!      
00016 !!
00017 !!    AUTHOR
00018 !!    ------
00019 !!     V. Masson 
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!      Original    01/2004
00024 !!------------------------------------------------------------------
00025 !
00026 !
00027 USE MODD_SURF_PAR,   ONLY : XUNDEF
00028 USE MODD_PREP,       ONLY : CINTERP_TYPE, XZS_LS
00029 USE MODD_PREP_TEB,   ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, XGRID_FLOOR,    &
00030                               XWS_ROOF, XWS_ROAD, XTS_ROAD, XTS_ROOF, XTS_WALL, &
00031                               XTI_BLD, XTI_ROAD, XT_CAN, XQ_CAN, XHUI_BLD
00032 USE MODD_CSTS, ONLY : XG, XP00
00033 !
00034 !
00035 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00036 USE PARKIND1  ,ONLY : JPRB
00037 !
00038 USE MODI_ABOR1_SFX
00039 USE MODE_THERMOS
00040 !
00041 IMPLICIT NONE
00042 !
00043 !*      0.1    declarations of arguments
00044 !
00045 INTEGER,            INTENT(IN)  :: KLUOUT    ! output listing logical unit
00046  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
00047 REAL, POINTER, DIMENSION(:,:)   :: PFIELD    ! field to interpolate horizontally
00048 !
00049 !*      0.2    declarations of local variables
00050 REAL, DIMENSION(:), ALLOCATABLE :: ZPS       ! surface pressure
00051 REAL, DIMENSION(:), ALLOCATABLE :: ZTI_BLD   ! indoor building temperature
00052 REAL, PARAMETER                 :: ZRHOA=1.19! air volumic mass at 20°C and 1015hPa
00053 !
00054 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00055 !
00056 !-------------------------------------------------------------------------------------
00057 !
00058 IF (LHOOK) CALL DR_HOOK('PREP_TEB_UNIF',0,ZHOOK_HANDLE)
00059 SELECT CASE(HSURF)
00060 !
00061 !*      3.0    Orography
00062 !
00063   CASE('ZS     ')
00064     ALLOCATE(PFIELD(1,1))
00065     PFIELD = 0.
00066 !
00067 !*      3.1    Profile of temperatures in roads
00068 !
00069   CASE('T_ROAD ')
00070     ALLOCATE(PFIELD(1,SIZE(XGRID_ROAD)))
00071     CALL PUT_UNIF_ON_REF_GRID('ROAD',XGRID_ROAD)
00072 
00073 !*      3.2    Profile of temperatures in walls
00074 
00075   CASE('T_WALLA','T_WALLB')
00076     ALLOCATE(PFIELD(1,SIZE(XGRID_WALL)))
00077     CALL PUT_UNIF_ON_REF_GRID('WALL',XGRID_WALL)
00078 
00079 !*      3.3    Profile of temperatures in roofs
00080 
00081   CASE('T_ROOF ')
00082     ALLOCATE(PFIELD(1,SIZE(XGRID_ROOF)))
00083     CALL PUT_UNIF_ON_REF_GRID('ROOF',XGRID_ROOF)
00084 
00085 !*      3.4bis Profile of temperatures in floors
00086 
00087   CASE('T_FLOOR')
00088     ALLOCATE(PFIELD(1,SIZE(XGRID_FLOOR)))
00089     CALL PUT_UNIF_ON_REF_GRID('FLOO',XGRID_FLOOR)
00090 
00091   CASE('T_MASS')
00092     ALLOCATE(PFIELD(1,SIZE(XGRID_FLOOR)))
00093     CALL PUT_UNIF_ON_REF_GRID('MASS',XGRID_FLOOR)
00094 
00095 !*      3.4    Other quantities
00096 
00097   CASE('WS_ROOF')
00098     ALLOCATE(PFIELD(1,1))
00099     PFIELD = XWS_ROOF
00100 
00101   CASE('WS_ROAD')
00102     ALLOCATE(PFIELD(1,1))
00103     PFIELD = XWS_ROAD
00104 
00105   CASE('TI_BLD  ')
00106     ALLOCATE(PFIELD(1,1))
00107     PFIELD = XTI_BLD
00108 
00109   CASE('QI_BLD  ')
00110     ALLOCATE(PFIELD(SIZE(XZS_LS),1))
00111     ALLOCATE(ZPS(SIZE(XZS_LS)))
00112     ALLOCATE(ZTI_BLD(SIZE(XZS_LS)))
00113     ZPS = XP00 - ZRHOA*XG*XZS_LS
00114     ZTI_BLD = XTI_BLD
00115     PFIELD(:,1) = XHUI_BLD * QSAT(ZTI_BLD, ZPS)
00116     DEALLOCATE(ZPS)
00117     DEALLOCATE(ZTI_BLD)
00118 
00119   CASE('T_WIN1  ')
00120     ALLOCATE(PFIELD(1,1))
00121     PFIELD = XTS_WALL
00122 
00123   CASE('T_WIN2  ')
00124     ALLOCATE(PFIELD(1,1))
00125     PFIELD = XTI_BLD
00126 
00127   CASE('TI_ROAD')
00128     ALLOCATE(PFIELD(1,1))
00129     PFIELD = XTI_ROAD
00130 
00131   CASE('T_CAN  ')
00132     ALLOCATE(PFIELD(1,1))
00133     PFIELD = XT_CAN
00134 
00135   CASE('Q_CAN  ')
00136     ALLOCATE(PFIELD(1,1))
00137     PFIELD = XQ_CAN
00138 
00139 END SELECT
00140 !
00141 !*      4.     Interpolation method
00142 !              --------------------
00143 !
00144 CINTERP_TYPE='UNIF  '
00145 !
00146 !-------------------------------------------------------------------------------------
00147 !-------------------------------------------------------------------------------------
00148 !
00149 IF (LHOOK) CALL DR_HOOK('PREP_TEB_UNIF',1,ZHOOK_HANDLE)
00150 CONTAINS
00151 !
00152 !-------------------------------------------------------------------------------------
00153 !-------------------------------------------------------------------------------------
00154 SUBROUTINE PUT_UNIF_ON_REF_GRID(HSURFTYPE,PGRID)
00155 !-------------------------------------------------------------------------------------
00156 !
00157 USE MODD_SURF_PAR,   ONLY : XUNDEF
00158 USE MODI_INTERP_GRID
00159 !
00160  CHARACTER(LEN=4),   INTENT(IN) :: HSURFTYPE ! surface type
00161 REAL, DIMENSION(:), INTENT(IN) :: PGRID     ! reference grid
00162 !
00163 REAL               :: ZTS! surface temperature
00164 REAL               :: ZTI! internal temperature
00165 REAL, DIMENSION(1,2) :: ZT ! temperature profile
00166 REAL, DIMENSION(1,2) :: ZD ! normalized depth profile
00167 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00168 !
00169 !-------------------------------------------------------------------------------------
00170 
00171 !* get surface temperature
00172 
00173 IF (LHOOK) CALL DR_HOOK('PUT_UNIF_ON_REF_GRID',0,ZHOOK_HANDLE)
00174 SELECT CASE(HSURFTYPE)
00175   CASE('ROOF')
00176     ZTS = XTS_ROOF
00177   CASE('ROAD')
00178     ZTS = XTS_ROAD
00179   CASE('WALL')
00180     ZTS = XTS_WALL
00181   CASE('FLOO')
00182     ZTS = XTI_BLD
00183   CASE('MASS')
00184     ZTS = XTI_BLD
00185 END SELECT
00186 
00187 !* get deep road or building interior temperature
00188 
00189 SELECT CASE(HSURFTYPE)
00190   CASE('ROOF', 'WALL', 'MASS')
00191     ZTI = XTI_BLD
00192   CASE('ROAD', 'FLOO')
00193     IF (XTI_ROAD/= XUNDEF) THEN
00194       ZTI = XTI_ROAD
00195     ELSE
00196       WRITE(KLUOUT,*) 'Error in PREParation of TEB fields'
00197       WRITE(KLUOUT,*) 'When Road Surface Temperature is prescribed,'
00198       WRITE(KLUOUT,*) 'Deep Road Temperature XTI_ROAD must also be prescribed'
00199       CALL ABOR1_SFX('PREP_TEB_UNIF: XTI_ROAD MUST BE PRESCRIBED')
00200     END IF
00201 END SELECT
00202 
00203 !* group all this information in one profile
00204 
00205 ZT(1,1) = ZTS
00206 ZT(1,2) = ZTI
00207 
00208 ZD(1,1) = 0.
00209 ZD(1,2) = 1.
00210 
00211 !* interpolate this field on the required grid
00212 !
00213  CALL INTERP_GRID(ZD,ZT,PGRID,PFIELD)
00214 IF (LHOOK) CALL DR_HOOK('PUT_UNIF_ON_REF_GRID',1,ZHOOK_HANDLE)
00215 !
00216 !-------------------------------------------------------------------------------------
00217 !
00218 END SUBROUTINE PUT_UNIF_ON_REF_GRID
00219 !
00220 !-------------------------------------------------------------------------------------
00221 END SUBROUTINE PREP_TEB_UNIF