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