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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_TEB_DEPTHS(HFILEPGDTYPE, PD_ROOF, PD_ROAD, PD_WALL, PD_FLOOR)
00003 !     ##############################################################
00004 !
00005 !!**** *CONVERT_COVER* 
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!    IMPLICIT ARGUMENTS
00017 !!    ------------------
00018 !!
00019 !!    REFERENCE
00020 !!    ---------
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!
00025 !!    V. Masson        Meteo-France
00026 !!
00027 !!    MODIFICATION
00028 !!    ------------
00029 !!
00030 !!    Original    01/2004
00031 !     
00032 !----------------------------------------------------------------------------
00033 !
00034 !*    0.     DECLARATION
00035 !            -----------
00036 !
00037 USE MODD_DATA_COVER,     ONLY : XDATA_D_ROOF, XDATA_D_ROAD, XDATA_D_WALL, XDATA_D_FLOOR
00038 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NDATA_ROOF_LAYER, NDATA_ROAD_LAYER, &
00039                                 NDATA_WALL_LAYER, NDATA_FLOOR_LAYER
00040 !
00041 USE MODI_READ_SURF
00042 USE MODI_AV_PGD
00043 USE MODI_OLD_NAME
00044 USE MODI_THERMAL_LAYERS_CONF
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 USE MODI_ABOR1_SFX
00050 !
00051 IMPLICIT NONE
00052 !
00053 !*    0.1    Declaration of arguments
00054 !            ------------------------
00055 !
00056  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
00057 !
00058 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_ROOF
00059 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_ROAD
00060 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_WALL
00061 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_FLOOR
00062 !
00063 !*    0.2    Declaration of local variables
00064 !            ------------------------------
00065 !
00066 LOGICAL, DIMENSION(JPCOVER)          :: GCOVER ! flag to read the covers
00067 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
00068 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZD     ! depth of surface layers
00069 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZPAR_D ! depth of data_surface layers
00070 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZPAR_HC, ZPAR_TC, ZHC, ZTC ! work arrays
00071 !
00072 INTEGER           :: IVERSION       ! surface version
00073 INTEGER           :: IBUGFIX        ! surface bugfix version
00074  CHARACTER(LEN=5)  :: YSURF          ! Type of surface
00075  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00076  CHARACTER(LEN=12) :: YRECFM0        ! Name of the article to be read
00077  CHARACTER(LEN=12) :: YRECFM1        ! Name of the article to be read
00078  CHARACTER(LEN=12) :: YRECFM2        ! Name of the article to be read
00079  CHARACTER(LEN=3)  :: YAREA          ! Area where field is to be averaged
00080 INTEGER           :: IRESP          ! reading return code
00081 LOGICAL           :: GDATA          ! T if depth is to be read in the file
00082 REAL, DIMENSION(SIZE(XDATA_D_ROOF,1),SIZE(XDATA_D_ROOF,2)) :: ZDATA
00083 INTEGER :: ILAYER                   ! number of surface layers
00084 INTEGER :: JLAYER                   ! loop counter on surface layers
00085 INTEGER :: IPAR_LAYER               ! number of data surface layers
00086 INTEGER :: IDATA_LAYER              ! number of data surface layers from ecoclimap
00087 INTEGER :: ILU                      ! number of points
00088 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00089 !-------------------------------------------------------------------------------
00090 !
00091 !*    2.      SECONDARY VARIABLES
00092 !             -------------------
00093 !
00094 !*    2.2     fields on artificial surfaces only
00095 !             ----------------------------------
00096 !
00097 IF (LHOOK) CALL DR_HOOK('GET_TEB_DEPTHS',0,ZHOOK_HANDLE)
00098 !
00099 YRECFM='VERSION'
00100  CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
00101 YRECFM='BUG'
00102  CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
00103 !
00104 IF (PRESENT(PD_ROOF)) THEN
00105   YSURF='ROOF '
00106   ZDATA = XDATA_D_ROOF
00107   YRECFM0 = 'PAR_RF_LAYER'
00108   YRECFM1 = 'L_D_ROOF'
00109   YRECFM2 = 'D_D_ROOF'
00110   IDATA_LAYER = NDATA_ROOF_LAYER
00111   ILU     = SIZE(PD_ROOF,1)
00112   ILAYER  = SIZE(PD_ROOF,2)
00113   YAREA   = 'BLD'
00114 END IF
00115 IF (PRESENT(PD_WALL)) THEN
00116   YSURF='WALL '
00117   ZDATA = XDATA_D_WALL
00118   YRECFM0 = 'PAR_WL_LAYER'
00119   YRECFM1 = 'L_D_WALL'
00120   YRECFM2 = 'D_D_WALL'
00121   IDATA_LAYER = NDATA_WALL_LAYER
00122   ILU     = SIZE(PD_WALL,1)
00123   ILAYER  = SIZE(PD_WALL,2)
00124   YAREA   = 'BLD'
00125 END IF
00126 IF (PRESENT(PD_ROAD)) THEN
00127   YSURF='ROAD '
00128   ZDATA = XDATA_D_ROAD
00129   YRECFM0 = 'PAR_RD_LAYER'
00130   YRECFM1 = 'L_D_ROAD'
00131   YRECFM2 = 'D_D_ROAD'
00132   IDATA_LAYER = NDATA_ROAD_LAYER
00133   ILU     = SIZE(PD_ROAD,1)
00134   ILAYER  = SIZE(PD_ROAD,2)
00135   YAREA   = 'STR'
00136 END IF
00137 IF (PRESENT(PD_FLOOR)) THEN
00138   YSURF='FLOOR'
00139   ZDATA = XDATA_D_FLOOR
00140   YRECFM0 = 'PAR_FL_LAYER'
00141   YRECFM1 = 'L_D_FLOOR'
00142   YRECFM2 = 'D_D_FLOOR'
00143   IDATA_LAYER = NDATA_FLOOR_LAYER
00144   ILU     = SIZE(PD_FLOOR,1)
00145   ILAYER  = SIZE(PD_FLOOR,2)
00146   YAREA   = 'BLD'
00147 END IF
00148 
00149 ALLOCATE(ZD(ILU,ILAYER))
00150 !
00151 !* read if the depths description are written in the file
00152 IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
00153   GDATA = .FALSE.
00154 ELSE
00155   CALL READ_SURF(HFILEPGDTYPE,YRECFM1,GDATA,IRESP)
00156 END IF
00157 !
00158 !* depths are read in the file
00159 IF (GDATA) THEN
00160   !* gets number of data layers
00161   CALL READ_SURF(HFILEPGDTYPE,YRECFM1,IPAR_LAYER,IRESP)
00162   !* gets the data layers depths
00163   ALLOCATE(ZPAR_D(ILU,IPAR_LAYER))
00164   DO JLAYER=1,IPAR_LAYER
00165     WRITE(YRECFM,FMT='(A,I1)') TRIM(YRECFM2),JLAYER
00166     CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZD(:,JLAYER),IRESP,HDIR='A')
00167   END DO
00168 !
00169 ELSE
00170 !* depths are deduced from the cover types
00171   ALLOCATE(ZPAR_D(ILU,IDATA_LAYER))
00172   !* reading of the cover to obtain the thickness of layers
00173   CALL OLD_NAME(HFILEPGDTYPE,'COVER_LIST      ',YRECFM)
00174   CALL READ_SURF(HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
00175   !* reading of the cover fractions
00176   ALLOCATE(ZCOVER(ILU,JPCOVER))
00177   YRECFM='COVER'
00178   CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCOVER(:,:),GCOVER,IRESP,HDIR='A')
00179   !
00180   !* deduces the depths of each layer
00181   DO JLAYER=1,IDATA_LAYER
00182     CALL AV_PGD (ZPAR_D(:,JLAYER), ZCOVER, ZDATA(:,JLAYER),YAREA,'ARI')
00183   END DO
00184   DEALLOCATE(ZCOVER)
00185 ENDIF
00186 !
00187 !* recomputes the grid from the available data
00188 !
00189 IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
00190   !* in old version of TEB, the computational grid was equal to the data grid
00191   ZD(:,:) = ZPAR_D(:,:)
00192 ELSE
00193   !* recomputes the grid from the available data
00194   ALLOCATE(ZPAR_HC(ILU,SIZE(ZPAR_D,2)))
00195   ALLOCATE(ZPAR_TC(ILU,SIZE(ZPAR_D,2)))
00196   ALLOCATE(ZTC    (ILU,ILAYER))
00197   ALLOCATE(ZHC    (ILU,ILAYER))
00198   ZPAR_HC = 1.E6  ! not physically used
00199   ZPAR_TC = 1.    ! not physically used
00200   CALL THERMAL_LAYERS_CONF(YSURF,ZPAR_HC,ZPAR_TC,ZPAR_D,ZHC,ZTC,ZD)
00201   DEALLOCATE(ZPAR_HC)
00202   DEALLOCATE(ZPAR_TC)
00203   DEALLOCATE(ZHC)
00204   DEALLOCATE(ZTC)
00205 END IF
00206 !
00207 IF (PRESENT(PD_ROOF )) PD_ROOF  = ZD
00208 IF (PRESENT(PD_WALL )) PD_WALL  = ZD
00209 IF (PRESENT(PD_ROAD )) PD_ROAD  = ZD
00210 IF (PRESENT(PD_FLOOR)) PD_FLOOR = ZD
00211 !
00212 DEALLOCATE(ZD)
00213 !
00214 IF (LHOOK) CALL DR_HOOK('GET_TEB_DEPTHS',1,ZHOOK_HANDLE)
00215 !-------------------------------------------------------------------------------
00216 !
00217 END SUBROUTINE GET_TEB_DEPTHS