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