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