2e618c8c7113043dfefc1ebf6a67023f6a9a2ee8
[MNH-git_open_source-lfs.git] / src / SURFEX / read_tebn.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 READ_TEB_n(HPROGRAM,KPATCH)
7 !     #########################################
8 !
9 !!****  *READ_TEB_n* - reads TEB fields
10 !!                        
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!      V. Masson   *Meteo France*      
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    01/2003 
36 !-------------------------------------------------------------------------------
37 !
38 !*       0.    DECLARATIONS
39 !              ------------
40 !
41 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
42 !
43 USE MODD_TEB_n,          ONLY : NROOF_LAYER, XT_ROOF, XWS_ROOF, &
44                                   NROAD_LAYER, XT_ROAD, XWS_ROAD, &
45                                   NWALL_LAYER,XT_WALL_A,XT_WALL_B,&
46                                   XTI_ROAD, CBEM,                 &
47                                   TSNOW_ROOF, TSNOW_ROAD,         &
48                                   XT_CANYON, XQ_CANYON,           &
49                                   NTEB_PATCH, CROAD_DIR, CWALL_OPT
50 USE MODD_BEM_n, ONLY : NFLOOR_LAYER, XT_FLOOR, XT_MASS,           &
51                        XT_WIN1, XT_WIN2, XQI_BLD, XTI_BLD                                   
52 !
53 USE MODI_READ_SURF
54 !
55 USE MODI_INIT_IO_SURF_n
56 USE MODI_SET_SURFEX_FILEIN
57 USE MODI_END_IO_SURF_n
58 USE MODI_TOWN_PRESENCE
59 USE MODI_ALLOCATE_GR_SNOW
60 USE MODI_READ_GR_SNOW
61 !
62 !
63 !
64 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
65 USE PARKIND1  ,ONLY : JPRB
66 !
67 USE MODI_GET_TYPE_DIM_n
68 USE MODD_SURF_PAR, ONLY : XUNDEF
69 !
70 IMPLICIT NONE
71 !
72 !*       0.1   Declarations of arguments
73 !              -------------------------
74 !
75  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
76 INTEGER,           INTENT(IN)  :: KPATCH   ! current patch number
77 !
78 !
79 !*       0.2   Declarations of local variables
80 !              -------------------------------
81 !
82 LOGICAL           :: GTOWN          ! town variables written in the file
83 INTEGER           :: ILU          ! 1D physical dimension
84 !
85 INTEGER           :: IRESP          ! Error code after redding
86 !
87  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
88  CHARACTER(LEN=3)  :: YPATCH         ! suffix if more than 1 patch
89 !
90 INTEGER           :: IVERSION, IBUGFIX
91 LOGICAL           :: GOLD_NAME      ! name of temperatures in old versions of SURFEX
92 !
93 INTEGER :: JLAYER  ! loop counter on layers
94 REAL(KIND=JPRB) :: ZHOOK_HANDLE
95 !
96 !-------------------------------------------------------------------------------
97 !
98 !* 1D physical dimension
99 !
100 IF (LHOOK) CALL DR_HOOK('READ_TEB_N',0,ZHOOK_HANDLE)
101 YRECFM='SIZE_TOWN'
102  CALL GET_TYPE_DIM_n('TOWN  ',ILU)
103 !
104 YPATCH='   '
105 IF (NTEB_PATCH>1) WRITE(YPATCH,FMT='(A1,I1,A1)') 'T',KPATCH,'_'
106 !  
107  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
108  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
109 GOLD_NAME = (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<=2))
110 !
111 !*       2.     Prognostic fields:
112 !               -----------------
113 !
114 !* roof temperatures
115 !
116 ALLOCATE(XT_ROOF(ILU,NROOF_LAYER))
117 !
118 DO JLAYER=1,NROOF_LAYER
119   WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TROOF',JLAYER
120   YRECFM=ADJUSTL(YRECFM)
121   IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_ROOF',JLAYER
122
123  CALL READ_SURF(HPROGRAM,YRECFM,XT_ROOF(:,JLAYER),IRESP)
124 END DO
125 !
126 !* roof water content
127 !
128 ALLOCATE(XWS_ROOF(ILU))
129 !
130 YRECFM=YPATCH//'WS_ROOF'
131 YRECFM=ADJUSTL(YRECFM)
132  CALL READ_SURF(HPROGRAM,YRECFM,XWS_ROOF(:),IRESP)
133 !
134 !* road temperatures
135 !
136 ALLOCATE(XT_ROAD(ILU,NROAD_LAYER))
137 !
138 DO JLAYER=1,NROAD_LAYER
139   WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TROAD',JLAYER
140   YRECFM=ADJUSTL(YRECFM)
141   IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_ROAD',JLAYER
142  CALL READ_SURF(HPROGRAM,YRECFM,XT_ROAD(:,JLAYER),IRESP)
143 END DO
144 !
145 !* road water content
146 !
147 ALLOCATE(XWS_ROAD(ILU))
148 !
149 YRECFM=YPATCH//'WS_ROAD'
150 YRECFM=ADJUSTL(YRECFM)
151  CALL READ_SURF(HPROGRAM,YRECFM,XWS_ROAD(:),IRESP)
152 !
153 !* wall temperatures
154 !
155 ALLOCATE(XT_WALL_A(ILU,NWALL_LAYER))
156 ALLOCATE(XT_WALL_B(ILU,NWALL_LAYER))
157 !
158 DO JLAYER=1,NWALL_LAYER
159   IF (CWALL_OPT=='UNIF' .OR. GOLD_NAME) THEN
160     WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TWALL',JLAYER
161     YRECFM=ADJUSTL(YRECFM)
162     IF (GOLD_NAME) WRITE(YRECFM,'(A6,I1.1)') 'T_WALL',JLAYER
163     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP)
164     !
165     XT_WALL_B = XT_WALL_A
166   ELSE
167     WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLA',JLAYER
168     YRECFM=ADJUSTL(YRECFM)
169     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_A(:,JLAYER),IRESP)
170     !
171     WRITE(YRECFM,'(A3,A6,I1.1)') YPATCH,'TWALLB',JLAYER
172     YRECFM=ADJUSTL(YRECFM)
173     CALL READ_SURF(HPROGRAM,YRECFM,XT_WALL_B(:,JLAYER),IRESP)
174   END IF
175 END DO
176 !
177 !* internal building temperature
178 !
179 ALLOCATE(XTI_BLD(ILU))
180 !
181 YRECFM=YPATCH//'TI_BLD'
182 YRECFM=ADJUSTL(YRECFM)
183  CALL READ_SURF(HPROGRAM,YRECFM,XTI_BLD(:),IRESP)
184
185 !
186 !* outdoor window temperature
187 !
188 ALLOCATE(XT_WIN1(ILU))
189 !
190 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
191    YRECFM=YPATCH//'T_WIN1'
192    YRECFM=ADJUSTL(YRECFM)
193    CALL READ_SURF(HPROGRAM,YRECFM,XT_WIN1(:),IRESP)
194 ELSE
195    XT_WIN1(:)=XUNDEF
196 ENDIF
197 !
198 !
199 !* internal building specific humidity
200 !
201 ALLOCATE(XQI_BLD(ILU))
202 !
203 IF (CBEM=='BEM' .AND. (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)) THEN
204    YRECFM=YPATCH//'QI_BLD'
205    YRECFM=ADJUSTL(YRECFM)
206    CALL READ_SURF(HPROGRAM,YRECFM,XQI_BLD(:),IRESP)
207 ELSE
208    XQI_BLD(:) = XUNDEF
209 ENDIF
210 !
211 IF (CBEM=='BEM') THEN
212   !
213   !* indoor window temperature
214   !
215   ALLOCATE(XT_WIN2(ILU))
216   !
217   YRECFM=YPATCH//'T_WIN2'
218   YRECFM=ADJUSTL(YRECFM)
219   CALL READ_SURF(HPROGRAM,YRECFM,XT_WIN2(:),IRESP)        
220   !
221   !* floor temperatures
222   !
223   ALLOCATE(XT_FLOOR(ILU,NFLOOR_LAYER))
224   !
225   DO JLAYER=1,NFLOOR_LAYER
226     WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TFLOO',JLAYER
227     YRECFM=ADJUSTL(YRECFM)
228     CALL READ_SURF(HPROGRAM,YRECFM,XT_FLOOR(:,JLAYER),IRESP)
229   END DO
230   !
231   !* mass temperatures
232   !
233   ALLOCATE(XT_MASS(ILU,NFLOOR_LAYER))
234   !
235   DO JLAYER=1,NFLOOR_LAYER
236     WRITE(YRECFM,'(A3,A5,I1.1)') YPATCH,'TMASS',JLAYER
237     YRECFM=ADJUSTL(YRECFM)
238     CALL READ_SURF(HPROGRAM,YRECFM,XT_MASS(:,JLAYER),IRESP)
239   END DO
240   !
241 ELSE 
242   ALLOCATE(XT_WIN2(0))
243   ALLOCATE(XT_FLOOR(0,0))
244   ALLOCATE(XT_MASS(0,0))
245 ENDIF
246 !
247 !* deep road temperature
248 !
249 ALLOCATE(XTI_ROAD(ILU))
250 !
251 YRECFM=YPATCH//'TI_ROAD'
252 YRECFM=ADJUSTL(YRECFM)
253  CALL READ_SURF(HPROGRAM,YRECFM,XTI_ROAD(:),IRESP)
254 !
255 !
256 !* snow mantel
257 !
258  CALL END_IO_SURF_n(HPROGRAM)
259  CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
260  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
261 !
262  CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
263 !
264  CALL END_IO_SURF_n(HPROGRAM)
265  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
266  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
267 !
268 IF (.NOT. GTOWN) THEN
269   TSNOW_ROAD%SCHEME='1-L'
270   CALL ALLOCATE_GR_SNOW(TSNOW_ROAD,ILU,1)
271   TSNOW_ROOF%SCHEME='1-L'
272   CALL ALLOCATE_GR_SNOW(TSNOW_ROOF,ILU,1)  
273 ELSE
274   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
275     CALL READ_GR_SNOW(HPROGRAM,'RD',YPATCH,ILU,1,TSNOW_ROAD  )
276     CALL READ_GR_SNOW(HPROGRAM,'RF',YPATCH,ILU,1,TSNOW_ROOF  )
277   ELSE
278     CALL READ_GR_SNOW(HPROGRAM,'ROAD',YPATCH,ILU,1,TSNOW_ROAD  )
279     CALL READ_GR_SNOW(HPROGRAM,'ROOF',YPATCH,ILU,1,TSNOW_ROOF  )
280   ENDIF    
281 END IF
282 !
283 !-------------------------------------------------------------------------------
284 !
285 !*       3.     Semi-prognostic fields:
286 !               ----------------------
287 !
288 !* temperature in canyon air
289 !
290 ALLOCATE(XT_CANYON(ILU))
291 XT_CANYON(:) = XT_ROAD(:,1)
292 !
293 YRECFM=YPATCH//'TCANYON'
294 YRECFM=ADJUSTL(YRECFM)
295 IF (GOLD_NAME) YRECFM='T_CANYON'
296  CALL READ_SURF(HPROGRAM,YRECFM,XT_CANYON(:),IRESP)
297 !
298 !* water vapor in canyon air
299 !
300 ALLOCATE(XQ_CANYON(ILU))
301 XQ_CANYON(:) = 0.
302 !
303 YRECFM=YPATCH//'QCANYON'
304 YRECFM=ADJUSTL(YRECFM)
305 IF (GOLD_NAME) YRECFM='Q_CANYON'
306  CALL READ_SURF(HPROGRAM,YRECFM,XQ_CANYON(:),IRESP)
307 IF (LHOOK) CALL DR_HOOK('READ_TEB_N',1,ZHOOK_HANDLE)
308 !
309 !-------------------------------------------------------------------------------
310 !
311 END SUBROUTINE READ_TEB_n