Juan 24/11/2015: modif for PREPLL from M.Mogié
[MNH-git_open_source-lfs.git] / src / SURFEX / get_teb_depths.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE GET_TEB_DEPTHS(HFILEPGDTYPE, PD_ROOF, PD_ROAD, PD_WALL, PD_FLOOR)
7 !     ##############################################################
8 !
9 !!**** *CONVERT_COVER* 
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!
23 !!    REFERENCE
24 !!    ---------
25 !!
26 !!    AUTHOR
27 !!    ------
28 !!
29 !!    V. Masson        Meteo-France
30 !!
31 !!    MODIFICATION
32 !!    ------------
33 !!
34 !!    Original    01/2004
35 !     
36 !----------------------------------------------------------------------------
37 !
38 !*    0.     DECLARATION
39 !            -----------
40 !
41 USE MODD_DATA_COVER,     ONLY : XDATA_D_ROOF, XDATA_D_ROAD, XDATA_D_WALL, XDATA_D_FLOOR
42 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NDATA_ROOF_LAYER, NDATA_ROAD_LAYER, &
43                                 NDATA_WALL_LAYER, NDATA_FLOOR_LAYER
44 !
45 USE MODI_READ_SURF
46 USE MODI_AV_PGD
47 USE MODI_OLD_NAME
48 USE MODI_THERMAL_LAYERS_CONF
49 !
50 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
51 USE PARKIND1  ,ONLY : JPRB
52 !
53 USE MODI_ABOR1_SFX
54 !
55 USE MODI_READ_COVERS_AND_AV_PGD_1D_ON_LAYERS
56 !
57 IMPLICIT NONE
58 !
59 !*    0.1    Declaration of arguments
60 !            ------------------------
61 !
62  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
63 !
64 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_ROOF
65 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_ROAD
66 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_WALL
67 REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL   :: PD_FLOOR
68 !
69 !*    0.2    Declaration of local variables
70 !            ------------------------------
71 !
72 LOGICAL, DIMENSION(JPCOVER)          :: GCOVER ! flag to read the covers
73 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
74 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZD     ! depth of surface layers
75 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZPAR_D ! depth of data_surface layers
76 REAL,    DIMENSION(:,:), ALLOCATABLE :: ZPAR_HC, ZPAR_TC, ZHC, ZTC ! work arrays
77 !
78 INTEGER           :: IVERSION       ! surface version
79 INTEGER           :: IBUGFIX        ! surface bugfix version
80  CHARACTER(LEN=5)  :: YSURF          ! Type of surface
81  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
82  CHARACTER(LEN=12) :: YRECFM0        ! Name of the article to be read
83  CHARACTER(LEN=12) :: YRECFM1        ! Name of the article to be read
84  CHARACTER(LEN=12) :: YRECFM2        ! Name of the article to be read
85  CHARACTER(LEN=3)  :: YAREA          ! Area where field is to be averaged
86 INTEGER           :: IRESP          ! reading return code
87 LOGICAL           :: GDATA          ! T if depth is to be read in the file
88 REAL, DIMENSION(SIZE(XDATA_D_ROOF,1),SIZE(XDATA_D_ROOF,2)) :: ZDATA
89 INTEGER :: ILAYER                   ! number of surface layers
90 INTEGER :: JLAYER                   ! loop counter on surface layers
91 INTEGER :: IPAR_LAYER               ! number of data surface layers
92 INTEGER :: IDATA_LAYER              ! number of data surface layers from ecoclimap
93 INTEGER :: ILU                      ! number of points
94 REAL(KIND=JPRB) :: ZHOOK_HANDLE
95 !-------------------------------------------------------------------------------
96 !
97 !*    2.      SECONDARY VARIABLES
98 !             -------------------
99 !
100 !*    2.2     fields on artificial surfaces only
101 !             ----------------------------------
102 !
103 IF (LHOOK) CALL DR_HOOK('GET_TEB_DEPTHS',0,ZHOOK_HANDLE)
104 !
105 YRECFM='VERSION'
106  CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
107 YRECFM='BUG'
108  CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
109 !
110 IF (PRESENT(PD_ROOF)) THEN
111   YSURF='ROOF '
112   ZDATA = XDATA_D_ROOF
113   YRECFM0 = 'PAR_RF_LAYER'
114   YRECFM1 = 'L_D_ROOF'
115   YRECFM2 = 'D_D_ROOF'
116   IDATA_LAYER = NDATA_ROOF_LAYER
117   ILU     = SIZE(PD_ROOF,1)
118   ILAYER  = SIZE(PD_ROOF,2)
119   YAREA   = 'BLD'
120 END IF
121 IF (PRESENT(PD_WALL)) THEN
122   YSURF='WALL '
123   ZDATA = XDATA_D_WALL
124   YRECFM0 = 'PAR_WL_LAYER'
125   YRECFM1 = 'L_D_WALL'
126   YRECFM2 = 'D_D_WALL'
127   IDATA_LAYER = NDATA_WALL_LAYER
128   ILU     = SIZE(PD_WALL,1)
129   ILAYER  = SIZE(PD_WALL,2)
130   YAREA   = 'BLD'
131 END IF
132 IF (PRESENT(PD_ROAD)) THEN
133   YSURF='ROAD '
134   ZDATA = XDATA_D_ROAD
135   YRECFM0 = 'PAR_RD_LAYER'
136   YRECFM1 = 'L_D_ROAD'
137   YRECFM2 = 'D_D_ROAD'
138   IDATA_LAYER = NDATA_ROAD_LAYER
139   ILU     = SIZE(PD_ROAD,1)
140   ILAYER  = SIZE(PD_ROAD,2)
141   YAREA   = 'STR'
142 END IF
143 IF (PRESENT(PD_FLOOR)) THEN
144   YSURF='FLOOR'
145   ZDATA = XDATA_D_FLOOR
146   YRECFM0 = 'PAR_FL_LAYER'
147   YRECFM1 = 'L_D_FLOOR'
148   YRECFM2 = 'D_D_FLOOR'
149   IDATA_LAYER = NDATA_FLOOR_LAYER
150   ILU     = SIZE(PD_FLOOR,1)
151   ILAYER  = SIZE(PD_FLOOR,2)
152   YAREA   = 'BLD'
153 END IF
154
155 ALLOCATE(ZD(ILU,ILAYER))
156 !
157 !* read if the depths description are written in the file
158 IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
159   GDATA = .FALSE.
160 ELSE
161   CALL READ_SURF(HFILEPGDTYPE,YRECFM1,GDATA,IRESP)
162 END IF
163 !
164 !* depths are read in the file
165 IF (GDATA) THEN
166   !* gets number of data layers
167   CALL READ_SURF(HFILEPGDTYPE,YRECFM0,IPAR_LAYER,IRESP)
168   !* gets the data layers depths
169   ALLOCATE(ZPAR_D(ILU,IPAR_LAYER))
170   DO JLAYER=1,IPAR_LAYER
171     WRITE(YRECFM,FMT='(A,I1)') TRIM(YRECFM2),JLAYER
172     CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZPAR_D(:,JLAYER),IRESP,HDIR='A')
173   END DO
174 !
175 ELSE
176 !* depths are deduced from the cover types
177   ALLOCATE(ZPAR_D(ILU,IDATA_LAYER))
178   !* reading of the cover to obtain the thickness of layers
179   CALL OLD_NAME(HFILEPGDTYPE,'COVER_LIST      ',YRECFM)
180 #ifdef MNH_PARALLEL
181   CALL READ_COVERS_AND_AV_PGD_1D_ON_LAYERS( HFILEPGDTYPE, YRECFM, ILU, IDATA_LAYER, ZPAR_D, ZDATA, YAREA,'ARI' )
182 #else
183   CALL READ_SURF(HFILEPGDTYPE,YRECFM,GCOVER(:),IRESP,HDIR='-')
184   !* reading of the cover fractions
185   ALLOCATE(ZCOVER(ILU,JPCOVER))
186   YRECFM='COVER'
187   CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCOVER(:,:),GCOVER,IRESP,HDIR='A')
188   !
189   !* deduces the depths of each layer
190   DO JLAYER=1,IDATA_LAYER
191     CALL AV_PGD (ZPAR_D(:,JLAYER), ZCOVER, ZDATA(:,JLAYER),YAREA,'ARI')
192   END DO
193   DEALLOCATE(ZCOVER)
194 #endif
195 ENDIF
196 !
197 !* recomputes the grid from the available data
198 !
199 IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2)) THEN
200   !* in old version of TEB, the computational grid was equal to the data grid
201   ZD(:,:) = ZPAR_D(:,:)
202 ELSE
203   !* recomputes the grid from the available data
204   ALLOCATE(ZPAR_HC(ILU,SIZE(ZPAR_D,2)))
205   ALLOCATE(ZPAR_TC(ILU,SIZE(ZPAR_D,2)))
206   ALLOCATE(ZTC    (ILU,ILAYER))
207   ALLOCATE(ZHC    (ILU,ILAYER))
208   ZPAR_HC = 1.E6  ! not physically used
209   ZPAR_TC = 1.    ! not physically used
210   CALL THERMAL_LAYERS_CONF(YSURF,ZPAR_HC,ZPAR_TC,ZPAR_D,ZHC,ZTC,ZD)
211   DEALLOCATE(ZPAR_HC)
212   DEALLOCATE(ZPAR_TC)
213   DEALLOCATE(ZHC)
214   DEALLOCATE(ZTC)
215 END IF
216 !
217 IF (PRESENT(PD_ROOF )) PD_ROOF  = ZD
218 IF (PRESENT(PD_WALL )) PD_WALL  = ZD
219 IF (PRESENT(PD_ROAD )) PD_ROAD  = ZD
220 IF (PRESENT(PD_FLOOR)) PD_FLOOR = ZD
221 !
222 DEALLOCATE(ZD)
223 !
224 IF (LHOOK) CALL DR_HOOK('GET_TEB_DEPTHS',1,ZHOOK_HANDLE)
225 !-------------------------------------------------------------------------------
226 !
227 END SUBROUTINE GET_TEB_DEPTHS