8c84bdb742661da42109f8a5e7576f5ba0e425a4
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_teb.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 ZOOM_PGD_TEB(HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP,OGARDEN)
7 !     ###########################################################
8
9 !!
10 !!    PURPOSE
11 !!    -------
12 !!   This program prepares the physiographic data fields.
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!
31 !!    V. Masson                   Meteo-France
32 !!
33 !!    MODIFICATION
34 !!    ------------
35 !!
36 !!    Original     13/10/03
37 !----------------------------------------------------------------------------
38 !
39 !*    0.     DECLARATION
40 !            -----------
41 !
42 USE MODD_SURF_PAR,        ONLY : XUNDEF
43 !
44 USE MODD_DATA_COVER_PAR,  ONLY : JPCOVER
45 USE MODD_TEB_GRID_n,      ONLY : XLAT, XLON, CGRID, XGRID_PAR,          &
46                                  XMESH_SIZE, NDIM
47 USE MODD_TEB_n,           ONLY : XCOVER, LCOVER, XZS,                   &
48                                  NROOF_LAYER, NROAD_LAYER, NWALL_LAYER, &
49                                  LECOCLIMAP, LGARDEN, NTEB_PATCH,       &
50                                  CBEM, CBLD_ATYPE
51 USE MODD_BEM_n,           ONLY : NFLOOR_LAYER
52 !
53 USE MODD_PREP,            ONLY : CINGRID_TYPE, CINTERP_TYPE, LINTERP
54 !
55 USE MODI_GET_LUOUT
56 USE MODI_ABOR1_SFX
57 USE MODI_OPEN_AUX_IO_SURF
58 USE MODI_GET_SURF_SIZE_n
59 USE MODI_PACK_PGD
60 USE MODI_PREP_GRID_EXTERN
61 USE MODI_PREP_OUTPUT_GRID
62 USE MODI_READ_SURF
63 USE MODI_READ_PGD_TEB_PAR_n
64 USE MODI_CLOSE_AUX_IO_SURF
65 USE MODI_CLEAN_PREP_OUTPUT_GRID
66 USE MODI_GOTO_TEB
67 !
68 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
69 USE PARKIND1  ,ONLY : JPRB
70 !
71 !
72 IMPLICIT NONE
73 !
74 !*    0.1    Declaration of dummy arguments
75 !            ------------------------------
76 !
77  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
78  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! file to read
79  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! file type
80 LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
81 LOGICAL,              INTENT(IN)  :: OGARDEN     ! flag to use garden
82 !
83 !
84 !*    0.2    Declaration of local variables
85 !            ------------------------------
86 !
87 INTEGER :: IRESP   ! error return code
88 INTEGER :: ILUOUT  ! output listing logical unit
89 INTEGER :: INI     ! total 1D dimension (input grid)
90 INTEGER :: JLAYER  ! loop counter
91 INTEGER :: ILU     ! total 1D dimension (output grid, TOWN points only)
92 INTEGER :: JPATCH  ! TEB patch
93 REAL(KIND=JPRB) :: ZHOOK_HANDLE
94 INTEGER           :: IVERSION
95 INTEGER           :: IBUGFIX
96 !------------------------------------------------------------------------------
97 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',0,ZHOOK_HANDLE)
98  CALL GET_LUOUT(HPROGRAM,ILUOUT)
99 !
100 LECOCLIMAP = OECOCLIMAP
101 LGARDEN = OGARDEN
102 !
103 IF (.NOT. OECOCLIMAP) THEN
104   WRITE(ILUOUT,*) 'ERROR'
105   WRITE(ILUOUT,*) 'Ecoclimap is not used'
106   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
107   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic fields'
108   CALL ABOR1_SFX('ZOOM_PGD_TEB: ECOCLIMAP NOT USED, ROUTINE MUST BE UPDATED')
109 END IF
110 !
111 !
112 !*      1.     Preparation of IO for reading in the file
113 !              -----------------------------------------
114 !
115 !* Note that all points are read, even those without physical meaning.
116 !  These points will not be used during the horizontal interpolation step.
117 !  Their value must be defined as XUNDEF.
118 !
119  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
120 !
121  CALL GOTO_TEB(1)
122 !-------------------------------------------------------------------------------
123 !
124 !*    2.      Number of points and packing of general fields
125 !             ----------------------------------------------
126 !
127 !
128  CALL GET_SURF_SIZE_n('TOWN  ',ILU)
129 !
130 ALLOCATE(LCOVER     (JPCOVER))
131 ALLOCATE(XCOVER     (ILU,JPCOVER))
132 ALLOCATE(XZS        (ILU))
133 ALLOCATE(XLAT       (ILU))
134 ALLOCATE(XLON       (ILU))
135 ALLOCATE(XMESH_SIZE (ILU))
136 !
137  CALL PACK_PGD(HPROGRAM, 'TOWN  ',                      &
138                 CGRID,  XGRID_PAR,                     &
139                 LCOVER, XCOVER, XZS,                   &
140                 XLAT, XLON, XMESH_SIZE                 )  
141 !
142 NDIM = ILU
143 !
144 !
145  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
146  CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
147 !------------------------------------------------------------------------------
148 !
149 !*      3.     Reading of grid
150 !              ---------------
151 !
152  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
153 !
154  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
155 !
156 !
157 !------------------------------------------------------------------------------
158 !
159 !*      4.     Reading & interpolation of fields
160 !              ---------------------------------
161 !
162 !
163 IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=2) THEN
164   NTEB_PATCH=1
165 ELSE
166   CALL READ_SURF(HPROGRAM,'TEB_PATCH',NTEB_PATCH,IRESP)
167 END IF
168
169 !
170  CALL READ_SURF(HPROGRAM,'ROOF_LAYER',NROOF_LAYER,IRESP)
171  CALL READ_SURF(HPROGRAM,'ROAD_LAYER',NROAD_LAYER,IRESP)
172  CALL READ_SURF(HPROGRAM,'WALL_LAYER',NWALL_LAYER,IRESP)
173 !
174 IF (IVERSION<7 .OR.( IVERSION==7 .AND. IBUGFIX<=2)) THEN
175   CBLD_ATYPE='ARI'
176   CBEM = 'DEF'
177 ELSE
178   CALL READ_SURF(HPROGRAM,'BLD_ATYPE' ,CBLD_ATYPE,IRESP)
179   CALL READ_SURF(HPROGRAM,'BEM'       ,CBEM      ,IRESP)
180 END IF
181 !
182 IF (CBEM/='DEF') THEN
183   CALL READ_SURF(HPROGRAM,'FLOOR_LAYER',NFLOOR_LAYER,IRESP)
184 END IF
185 !
186 DO JPATCH=1,NTEB_PATCH
187   CALL GOTO_TEB(JPATCH)
188   CALL READ_PGD_TEB_PAR_n(HPROGRAM,INI,'A')
189 !
190 !------------------------------------------------------------------------------
191 !
192 !*      5.     Gardens
193 !              -------
194 !
195   IF (LGARDEN) CALL ZOOM_PGD_TEB_GARDEN
196 END DO
197 !
198  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
199 !
200  CALL CLEAN_PREP_OUTPUT_GRID
201 !
202 !------------------------------------------------------------------------------
203 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB',1,ZHOOK_HANDLE)
204 !------------------------------------------------------------------------------
205 !
206 CONTAINS
207 !
208 SUBROUTINE ZOOM_PGD_TEB_GARDEN
209 !
210 USE MODI_HOR_INTERPOL
211 !
212 USE MODD_ISBA_PAR,     ONLY : XOPTIMGRID
213 USE MODD_TEB_VEG_n,    ONLY : CPHOTO, CISBA,                 &
214                               CPEDOTF, NNBIOMASS
215 USE MODD_TEB_GARDEN_n, ONLY : NGROUND_LAYER,                 &
216                               XSAND, XCLAY,                  &
217                               XWDRAIN, XRUNOFFB, LPAR_GARDEN,&
218                               XSOILGRID
219 !
220 IMPLICIT NONE
221 !
222 REAL, DIMENSION(:,:), POINTER     :: ZIN     ! field  on all surface points
223 !
224 REAL, DIMENSION(INI)              :: ZFIELD  ! field read
225 REAL, DIMENSION(ILU,1)            :: ZOUT    ! final field
226 REAL(KIND=JPRB) :: ZHOOK_HANDLE
227  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
228 !
229 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',0,ZHOOK_HANDLE)
230 !
231 LINTERP(:) = .TRUE.
232 !
233 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
234   CALL READ_SURF(HPROGRAM,'GD_LAYER',NGROUND_LAYER,IRESP)
235   CALL READ_SURF(HPROGRAM,'GD_ISBA',CISBA,IRESP)
236   CALL READ_SURF(HPROGRAM,'GD_PHOTO',CPHOTO,IRESP)
237   CALL READ_SURF(HPROGRAM,'GD_PEDOTF',CPEDOTF,IRESP)
238   NNBIOMASS=1
239   IF (CPHOTO=='NIT') NNBIOMASS=3  
240 ELSE
241   CALL READ_SURF(HPROGRAM,'TWN_LAYER',NGROUND_LAYER,IRESP)
242   CALL READ_SURF(HPROGRAM,'TWN_ISBA',CISBA,IRESP)
243   CALL READ_SURF(HPROGRAM,'TWN_PHOTO',CPHOTO,IRESP)
244   CALL READ_SURF(HPROGRAM,'TWN_PEDOTF',CPEDOTF,IRESP)
245   CALL READ_SURF(HPROGRAM,'TWN_NBIOMASS',NNBIOMASS,IRESP)
246 ENDIF
247 !
248 !* sand
249 !
250 ALLOCATE(ZIN(INI,NGROUND_LAYER))
251 YRECFM='TWN_SAND'
252 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
253  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
254 DO JLAYER=1,NGROUND_LAYER
255   ZIN(:,JLAYER) = ZFIELD(:)
256 END DO
257 ALLOCATE(XSAND(ILU,NGROUND_LAYER))
258  CALL HOR_INTERPOL(ILUOUT,ZIN,XSAND)
259 DEALLOCATE(ZIN)
260 !
261 !* clay
262 !
263 ALLOCATE(ZIN(INI,NGROUND_LAYER))
264 YRECFM='TWN_CLAY'
265 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
266  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
267 DO JLAYER=1,NGROUND_LAYER
268   ZIN(:,JLAYER) = ZFIELD(:)
269 END DO
270 ALLOCATE(XCLAY(ILU,NGROUND_LAYER))
271  CALL HOR_INTERPOL(ILUOUT,ZIN,XCLAY)
272 DEALLOCATE(ZIN)
273 !
274 !* runoff & drainage
275 !
276 ALLOCATE(ZIN(INI,1))
277 YRECFM='TWN_RUNOFFB'
278 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_RUNOFFB'
279 CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
280 ZIN(:,1) = ZFIELD(:)
281 ALLOCATE(XRUNOFFB(ILU))
282  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
283 XRUNOFFB(:) = ZOUT(:,1)
284 !
285 IF (IVERSION<=3) THEN
286   XWDRAIN = 0.
287 ELSE
288  YRECFM='TWN_WDRAIN'
289  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_WDRAIN'
290  CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD,IRESP,HDIR='A')
291  ZIN(:,1) = ZFIELD(:)
292  ALLOCATE(XWDRAIN(ILU))
293  CALL HOR_INTERPOL(ILUOUT,ZIN,ZOUT)
294  XWDRAIN(:) = ZOUT(:,1)
295 ENDIF
296 !
297 DEALLOCATE(ZIN)
298 !
299 IF(CISBA=='DIF') THEN
300   ALLOCATE(XSOILGRID(NGROUND_LAYER))
301   XSOILGRID=XUNDEF
302   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
303     CALL READ_SURF(HPROGRAM,'GD_SOILGRID',XSOILGRID,IRESP,HDIR='-')
304   ELSE
305     XSOILGRID(1:NGROUND_LAYER)=XOPTIMGRID(1:NGROUND_LAYER)
306   ENDIF
307 ELSE
308   ALLOCATE(XSOILGRID(0))
309 ENDIF
310 !
311 !
312 !* other garden parameters
313 !
314  CALL READ_SURF(HPROGRAM,'PAR_GARDEN',LPAR_GARDEN,IRESP)
315 !
316 !!
317 IF (LPAR_GARDEN) THEN
318   WRITE(ILUOUT,*) 'ERROR'
319   WRITE(ILUOUT,*) 'Specific garden fields are prescribed'
320   WRITE(ILUOUT,*) 'Routine zoom_pgd_teb.f90 must be updated'
321   WRITE(ILUOUT,*) 'to interpolate all TEB physiographic garden fields'
322   CALL ABOR1_SFX('ZOOM_PGD_TEB: GARDEN fields used, ROUTINE MUST BE UPDATED')
323 END IF
324 !
325 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',1,ZHOOK_HANDLE)
326 !
327 END SUBROUTINE ZOOM_PGD_TEB_GARDEN
328 !_______________________________________________________________________________
329 !
330 END SUBROUTINE ZOOM_PGD_TEB