Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / read_teb_gardenn.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_GARDEN_n(HPROGRAM,HPATCH)
7 !     ##################################
8 !
9 !!****  *READ_TEB_GARDEN_n* - routine to initialise ISBA variables
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 !!      READ_SURF for general reading : 08/2003 (S.Malardel)
38 !!      B. Decharme  2008    : Floodplains
39 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read
40 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
41 !-------------------------------------------------------------------------------
42 !
43 !*       0.    DECLARATIONS
44 !              ------------
45 !
46 !
47 USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN
48 USE MODD_TEB_VEG_n,      ONLY : CPHOTO, CRESPSL, NNBIOMASS
49 USE MODD_TEB_GARDEN_n,   ONLY : NGROUND_LAYER,               &
50                                 XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &
51                                 XRESA, XANFM, XANF, XAN, XLE, XANDAY,&
52                                 XBSLAI, XBIOMASS, XRESP_BIOMASS  
53 !                                
54 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
55 USE MODD_SNOW_PAR,       ONLY : XZ0SN
56 !
57 USE MODI_READ_SURF
58 !
59 USE MODI_INIT_IO_SURF_n
60 USE MODI_SET_SURFEX_FILEIN
61 USE MODI_END_IO_SURF_n
62 USE MODI_TOWN_PRESENCE
63 USE MODI_ALLOCATE_GR_SNOW
64 USE MODI_READ_GR_SNOW
65 !
66 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
67 USE PARKIND1  ,ONLY : JPRB
68 !
69 USE MODI_GET_TYPE_DIM_n
70 !
71 IMPLICIT NONE
72 !
73 !*       0.1   Declarations of arguments
74 !              -------------------------
75 !
76  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
77  CHARACTER(LEN=3),  INTENT(IN)  :: HPATCH   ! current TEB patch identificator
78 !
79 !*       0.2   Declarations of local variables
80 !              -------------------------------
81 !
82 LOGICAL           :: GTOWN          ! town variables written in the file
83 INTEGER           :: IVERSION, IBUGFIX
84 INTEGER           :: ILU            ! 1D physical dimension
85 INTEGER           :: IRESP          ! Error code after redding
86  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
87  CHARACTER(LEN=4)  :: YLVL
88 REAL, DIMENSION(:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file
89 !
90 INTEGER :: IWORK   ! Work integer
91 !
92 INTEGER :: JLAYER, JNBIOMASS  ! loop counter on layers
93 REAL(KIND=JPRB) :: ZHOOK_HANDLE
94 !
95 !-------------------------------------------------------------------------------
96 !
97 !
98 !* 1D physical dimension
99 !
100 IF (LHOOK) CALL DR_HOOK('READ_TEB_GARDEN_N',0,ZHOOK_HANDLE)
101 YRECFM='SIZE_TOWN'
102  CALL GET_TYPE_DIM_n('TOWN  ',ILU)
103 !
104 YRECFM='VERSION'
105  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
106 !
107 YRECFM='BUG'
108  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
109 !
110 !*       2.     Prognostic fields:
111 !               -----------------
112 !
113 ALLOCATE(ZWORK(ILU))
114 !* soil temperatures
115 !
116 IWORK=NGROUND_LAYER
117 !
118 ALLOCATE(XTG(ILU,IWORK))
119 DO JLAYER=1,IWORK
120   WRITE(YLVL,'(I2)') JLAYER
121   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
122     YRECFM=HPATCH//'GD_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
123   ELSE
124     YRECFM='TWN_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
125   ENDIF
126   YRECFM=ADJUSTL(YRECFM)  
127   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
128   XTG(:,JLAYER)=ZWORK
129 END DO
130 !
131 !
132 !* soil liquid water content
133 !
134 ALLOCATE(XWG(ILU,IWORK))
135 DO JLAYER=1,NGROUND_LAYER
136   WRITE(YLVL,'(I2)') JLAYER
137   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
138     YRECFM=HPATCH//'GD_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
139   ELSE
140     YRECFM='TWN_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
141   ENDIF  
142   YRECFM=ADJUSTL(YRECFM)
143   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
144   XWG(:,JLAYER)=ZWORK
145 END DO
146 !
147 !* soil ice water content
148 !
149 ALLOCATE(XWGI(ILU,IWORK))
150 DO JLAYER=1,NGROUND_LAYER
151   WRITE(YLVL,'(I2)') JLAYER
152 ! ajouter ici un test pour lire les anciens fichiers
153   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
154     YRECFM=HPATCH//'GD_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
155   ELSE
156     YRECFM='TWN_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
157   ENDIF  
158   YRECFM=ADJUSTL(YRECFM)  
159   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
160   XWGI(:,JLAYER)=ZWORK
161 END DO
162 !
163 !* water intercepted on leaves
164 !
165 ALLOCATE(XWR(ILU))
166 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
167   YRECFM=HPATCH//'GD_WR'
168 ELSE
169   YRECFM='TWN_WR'
170 ENDIF
171 YRECFM=ADJUSTL(YRECFM)
172  CALL READ_SURF(HPROGRAM,YRECFM,XWR(:),IRESP)
173 !
174 !* Leaf Area Index (if prognostic)
175 !
176 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
177   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
178     YRECFM=HPATCH//'GD_LAI'
179   ELSE
180     YRECFM='TWN_LAI'
181   ENDIF        
182   YRECFM=ADJUSTL(YRECFM)
183   CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:),IRESP)        
184 END IF
185 !
186 !* snow mantel
187 !
188  CALL END_IO_SURF_n(HPROGRAM)
189  CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
190  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
191 !
192  CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
193 !
194  CALL END_IO_SURF_n(HPROGRAM)
195  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
196  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
197 !
198 IF (.NOT. GTOWN) THEN
199   TSNOW%SCHEME='1-L'
200   CALL ALLOCATE_GR_SNOW(TSNOW,ILU,1)
201 ELSE
202   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
203     CALL READ_GR_SNOW(HPROGRAM,'GD',HPATCH,ILU,1,TSNOW  )
204   ELSE
205     CALL READ_GR_SNOW(HPROGRAM,'GARD',HPATCH,ILU,1,TSNOW  )
206   ENDIF
207 ENDIF
208 !
209 !-------------------------------------------------------------------------------
210 !
211 !*       4.  Semi-prognostic variables
212 !            -------------------------
213 !
214 !* aerodynamical resistance
215 !
216 ALLOCATE(XRESA(ILU))
217 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
218   YRECFM=HPATCH//'GD_RES'
219 ELSE
220   YRECFM='TWN_RESA'
221 ENDIF
222 YRECFM=ADJUSTL(YRECFM)
223 XRESA(:) = 100.
224  CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:),IRESP)
225 !
226 ALLOCATE(XLE(ILU))
227 XLE(:) = XUNDEF
228 !
229 !* ISBA-AGS variables
230 !
231 IF (CPHOTO/='NON') THEN
232   ALLOCATE(XAN   (ILU)) 
233   ALLOCATE(XANDAY(ILU)) 
234   ALLOCATE(XANFM (ILU))
235   ALLOCATE(XANF  (ILU))
236   XAN(:)    = 0.
237   XANDAY(:) = 0.
238   XANFM(:)  = XANFMINIT
239   XLE(:)    = 0.
240 ELSE
241   ALLOCATE(XAN   (0)) 
242   ALLOCATE(XANDAY(0)) 
243   ALLOCATE(XANFM (0))
244   ALLOCATE(XANF  (0))
245 ENDIF
246 !
247 IF(CPHOTO/='NON') THEN
248   ALLOCATE(XBIOMASS         (ILU,NNBIOMASS))
249   ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS))
250 ELSE
251   ALLOCATE(XBIOMASS         (0,0))
252   ALLOCATE(XRESP_BIOMASS    (0,0))
253 END IF
254 !
255 IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
256   !
257   XBIOMASS(:,:) = 0.
258   XRESP_BIOMASS(:,:) = 0.
259 ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
260   !
261   XBIOMASS(:,1) = XBSLAI(:) * XLAI(:)
262   XRESP_BIOMASS(:,:) = 0.
263 ELSEIF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
264   !
265   XBIOMASS(:,:) = 0.
266   DO JNBIOMASS=1,NNBIOMASS
267     WRITE(YLVL,'(I1)') JNBIOMASS
268     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
269       YRECFM=HPATCH//'GD_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
270     ELSE
271       YRECFM='TWN_BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
272     ENDIF
273     CALL READ_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS),IRESP)
274   END DO
275
276   XRESP_BIOMASS(:,:) = 0.
277   DO JNBIOMASS=2,NNBIOMASS
278     WRITE(YLVL,'(I1)') JNBIOMASS
279     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
280       YRECFM=HPATCH//'GD_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
281     ELSE
282       YRECFM='TWN_RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
283     ENDIF    
284     CALL READ_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS),IRESP)
285   END DO
286   !
287 ENDIF
288 !
289 DEALLOCATE(ZWORK)
290 IF (LHOOK) CALL DR_HOOK('READ_TEB_GARDEN_N',1,ZHOOK_HANDLE)
291 !
292 !-------------------------------------------------------------------------------
293 !
294 END SUBROUTINE READ_TEB_GARDEN_n