Juan 13/01/2014: add header SURFEX_LIC to all SURFEX files
[MNH-git_open_source-lfs.git] / src / SURFEX / read_isban.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_ISBA_n(HPROGRAM)
7 !     ##################################
8 !
9 !!****  *READ_ISBA_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 !!      A.L. Gibelin   03/09 : modifications for CENTURY model 
41 !!      A.L. Gibelin    04/2009 : BIOMASS and RESP_BIOMASS arrays 
42 !!      A.L. Gibelin    06/2009 : Soil carbon variables for CNT option
43 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
44 !!
45 !-------------------------------------------------------------------------------
46 !
47 !*       0.    DECLARATIONS
48 !              ------------
49 !
50 !
51 USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN
52 USE MODD_ISBA_n,         ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS,   &
53                                   NNLITTER, NNLITTLEVS, NNSOILCARB,   &
54                                   CPHOTO, CRESPSL, XTSRAD_NAT,        &
55                                   XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &
56                                   XRESA, XANFM, XAN, XLE, XANDAY,     &
57                                   XBSLAI, XBIOMASS, XRESP_BIOMASS,    &
58                                   XLITTER, XSOILCARB, XLIGNIN_STRUC,  &
59                                   LFLOOD, XZ0_FLOOD, LTEMP_ARP,       &
60                                   NTEMPLAYER_ARP, LGLACIER, XICE_STO  
61 !                                
62 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
63 USE MODD_SNOW_PAR,       ONLY : XZ0SN
64 !
65 USE MODI_READ_SURF
66 !
67 USE MODI_READ_GR_SNOW
68 !
69 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
70 USE PARKIND1  ,ONLY : JPRB
71 !
72 USE MODI_GET_TYPE_DIM_n
73 !
74 IMPLICIT NONE
75 !
76 !*       0.1   Declarations of arguments
77 !              -------------------------
78 !
79  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
80 !
81 !*       0.2   Declarations of local variables
82 !              -------------------------------
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 !
89  CHARACTER(LEN=4)  :: YLVL
90 !
91 REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file
92 !
93 INTEGER :: IWORK   ! Work integer
94 !
95 INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on layers
96 !
97 INTEGER           :: IVERSION       ! surface version
98 INTEGER           :: IBUGFIX
99 !
100 REAL(KIND=JPRB) :: ZHOOK_HANDLE
101 !
102 !-------------------------------------------------------------------------------
103 !
104 !
105 !* 1D physical dimension
106 !
107 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
108 YRECFM='SIZE_NATURE'
109  CALL GET_TYPE_DIM_n('NATURE',ILU)
110 !
111 !
112 !*       2.     Prognostic fields:
113 !               -----------------
114 !
115 ALLOCATE(ZWORK(ILU,NPATCH))
116 !* soil temperatures
117 !
118 IF(LTEMP_ARP)THEN
119   IWORK=NTEMPLAYER_ARP
120 ELSE
121   IWORK=NGROUND_LAYER
122 ENDIF
123 !
124 ALLOCATE(XTG(ILU,IWORK,NPATCH))
125 !
126 DO JL=1,IWORK
127   WRITE(YLVL,'(I4)') JL
128   YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
129   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
130   XTG(:,JL,:)=ZWORK
131 END DO
132 !
133 !
134 !* soil liquid and ice water contents
135 !
136 ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))
137 ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))
138 !
139 XWG (:,:,:)=XUNDEF
140 XWGI(:,:,:)=XUNDEF
141 !
142 DO JL=1,NGROUND_LAYER
143   WRITE(YLVL,'(I4)') JL
144   YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
145    CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
146    XWG(:,JL,:)=ZWORK
147 END DO
148 !
149 DO JL=1,NGROUND_LAYER
150   WRITE(YLVL,'(I4)') JL
151   YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
152   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
153   XWGI(:,JL,:)=ZWORK
154 END DO
155 !
156 !* water intercepted on leaves
157 !
158 ALLOCATE(XWR(ILU,NPATCH))
159 !
160 YRECFM = 'WR'
161  CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP)
162 !
163 !* roughness length of Flood water
164 !
165 IF(LFLOOD)THEN
166   ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
167   YRECFM = 'Z0_FLOOD'
168   CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP)
169 ENDIF
170 !
171 !* Leaf Area Index
172 !
173 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
174   YRECFM = 'LAI'
175   CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP)
176 END IF
177 !
178 !* snow mantel
179 !
180  CALL READ_GR_SNOW(HPROGRAM,'VEG','     ',ILU,NPATCH,TSNOW  )
181 !
182 YRECFM='VERSION'
183  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
184 !
185 YRECFM='BUG'
186  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
187 !
188 IF(LGLACIER)THEN
189   ALLOCATE(XICE_STO(ILU,NPATCH))
190   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
191     YRECFM = 'ICE_STO'
192     CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP)
193   ELSE
194     XICE_STO(:,:) = 0.0
195   ENDIF
196 ENDIF
197 !
198 !-------------------------------------------------------------------------------
199 !
200 !*       4.  Semi-prognostic variables
201 !            -------------------------
202 !
203 ALLOCATE(XRESA(ILU,NPATCH))
204 ALLOCATE(XLE  (ILU,NPATCH))
205 IF (CPHOTO/='NON') THEN
206   ALLOCATE(XANFM  (ILU,NPATCH))
207   ALLOCATE(XAN    (ILU,NPATCH))
208   ALLOCATE(XANDAY (ILU,NPATCH))
209 END IF
210 !
211 IF(CPHOTO/='NON') THEN
212   ALLOCATE(XBIOMASS         (ILU,NNBIOMASS,NPATCH))
213   ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS,NPATCH))
214 END IF
215 !
216 !
217 !* aerodynamical resistance
218 !
219 YRECFM = 'RESA'
220 XRESA(:,:) = 100.
221  CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP)
222 !
223 !* patch averaged radiative temperature (K)
224 !
225 ALLOCATE(XTSRAD_NAT(ILU))
226 IF (IVERSION<6) THEN
227   XTSRAD_NAT(:)=0.
228   DO JP=1,NPATCH
229     XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)
230   ENDDO
231   XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH
232 ELSE
233   YRECFM='TSRAD_NAT'
234   CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)
235 ENDIF
236 !
237 XLE(:,:) = XUNDEF
238 !
239 !*       5. ISBA-AGS variables
240 !
241 IF (CPHOTO/='NON') THEN
242   YRECFM = 'AN'
243   XAN(:,:) = 0.
244   CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP)
245   !
246   YRECFM = 'ANDAY'
247   XANDAY(:,:) = 0.
248   CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP)
249   !
250   YRECFM = 'ANFM'
251   XANFM(:,:) = XANFMINIT
252   CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP)
253   !
254   YRECFM = 'LE_AGS'
255   XLE(:,:) = 0.
256   CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP)
257 END IF
258 !
259 IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
260   !
261   XBIOMASS(:,:,:) = 0.
262   XRESP_BIOMASS(:,:,:) = 0.
263
264 ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
265   !
266   XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)
267   XRESP_BIOMASS(:,:,:) = 0.
268
269 ELSEIF (CPHOTO=='NIT') THEN
270   !
271   XBIOMASS(:,:,:) = 0.
272   DO JNBIOMASS=1,NNBIOMASS
273     WRITE(YLVL,'(I1)') JNBIOMASS
274     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
275       YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
276     ELSE
277       YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
278     ENDIF
279     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
280     XBIOMASS(:,JNBIOMASS,:)=ZWORK
281   END DO
282
283   XRESP_BIOMASS(:,:,:) = 0.
284   DO JNBIOMASS=2,NNBIOMASS
285     WRITE(YLVL,'(I1)') JNBIOMASS
286     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
287       YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
288     ELSE
289       YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
290     ENDIF    
291     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
292     XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
293   END DO
294
295 ELSEIF (CPHOTO=='NCB') THEN
296   !
297   XBIOMASS(:,:,:) = 0.
298   DO JNBIOMASS=1,NNBIOMASS
299     WRITE(YLVL,'(I1)') JNBIOMASS
300     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
301       YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
302     ELSE
303       YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
304     ENDIF    
305     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
306     XBIOMASS(:,JNBIOMASS,:)=ZWORK
307   END DO
308
309   XRESP_BIOMASS(:,:,:) = 0.
310   DO JNBIOMASS=2,NNBIOMASS-2
311     WRITE(YLVL,'(I1)') JNBIOMASS
312     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
313       YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
314     ELSE
315       YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
316     ENDIF    
317     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
318     XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
319   END DO
320   !
321 ENDIF
322 !
323 !*       6. Soil carbon
324 !
325 !
326 IF (CRESPSL=='CNT') THEN
327   ALLOCATE(XLITTER          (ILU,NNLITTER,NNLITTLEVS,NPATCH))
328   ALLOCATE(XSOILCARB        (ILU,NNSOILCARB,NPATCH))
329   ALLOCATE(XLIGNIN_STRUC    (ILU,NNLITTLEVS,NPATCH))
330 END IF
331 !
332 IF (CRESPSL=='CNT') THEN
333   !
334   XLITTER(:,:,:,:) = 0.
335   DO JNLITTER=1,NNLITTER
336     DO JNLITTLEVS=1,NNLITTLEVS
337       WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
338       YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
339       CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
340       XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
341     END DO
342   END DO
343
344   XSOILCARB(:,:,:) = 0.
345   DO JNSOILCARB=1,NNSOILCARB
346     WRITE(YLVL,'(I4)') JNSOILCARB
347     YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
348     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
349     XSOILCARB(:,JNSOILCARB,:)=ZWORK
350   END DO
351 !
352   XLIGNIN_STRUC(:,:,:) = 0.
353   DO JNLITTLEVS=1,NNLITTLEVS
354     WRITE(YLVL,'(I4)') JNLITTLEVS
355     YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
356     CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
357     XLIGNIN_STRUC(:,JNLITTLEVS,:)=ZWORK
358   END DO
359 !
360 ENDIF
361 !
362 !
363 DEALLOCATE(ZWORK)
364 IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
365 !
366 !-------------------------------------------------------------------------------
367 !
368 END SUBROUTINE READ_ISBA_n