SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
co2_initn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE co2_init_n (I, &
7  hphoto, ksize_nature_p, kr_nature_p, pvegtype_patch, &
8  pco2, pgmes, pgc, pdmax, pabc, ppoi, panmax, &
9  pfzero, pepso, pgamm, pqdgamm, pqdgmes, &
10  pt1gmes, pt2gmes, pamax, pqdamax, &
11  pt1amax, pt2amax, pah, pbh, &
12  ptau_wood, pincrease, pturnover )
13 ! #####################
14 !
15 !!**** *CO2_INIT_n* - routine to initialize ISBA-AGS variables
16 !!
17 !! PURPOSE
18 !! -------
19 !!
20 !!** METHOD
21 !! ------
22 !!
23 !! EXTERNAL
24 !! --------
25 !!
26 !!
27 !! IMPLICIT ARGUMENTS
28 !! ------------------
29 !!
30 !! REFERENCE
31 !! ---------
32 !!
33 !!
34 !! AUTHOR
35 !! ------
36 !! V. Masson *Meteo France*
37 !!
38 !! MODIFICATIONS
39 !! -------------
40 !! Original 02/2003
41 !! J.C. Calvet 01/2004 Externalization
42 !! P Le Moigne 11/2004 cotwoinit changed into cotwoinit_n
43 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan
44 !! S Lafont 09/2008 Add initialisation of POI and ABC (needed for TORI)
45 !! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
46 !! A.L. Gibelin 04/2009 : Add carbon spinup
47 !! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
48 !! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
49 !!
50 !-------------------------------------------------------------------------------
51 !
52 !* 0. DECLARATIONS
53 ! ------------
54 !
55 !
56 !
57 USE modd_isba_n, ONLY : isba_t
58 !
59 USE modd_surfex_mpi, ONLY : nrank,npio
60 USE modd_surf_par, ONLY : xundef
61 USE modd_data_cover_par, ONLY : nvegtype
62 !
63 USE modi_cotwoinit_n
64 !
65 USE yomhook ,ONLY : lhook, dr_hook
66 USE parkind1 ,ONLY : jprb
67 !
68 IMPLICIT NONE
69 !
70 !* 0.1 Declarations of arguments
71 ! -------------------------
72 !
73 !
74 TYPE(isba_t), INTENT(INOUT) :: i
75 !
76  CHARACTER(LEN=3), INTENT(IN) :: hphoto
77 INTEGER, DIMENSION(:), INTENT(IN) :: ksize_nature_p
78 INTEGER, DIMENSION(:,:), INTENT(IN) :: kr_nature_p
79 REAL, DIMENSION(:,:,:), INTENT(IN) :: pvegtype_patch
80 REAL, DIMENSION(:), INTENT(IN) :: pco2 ! air CO2 concentration (kg/kg)
81 REAL, DIMENSION(:,:), INTENT(IN) :: pgmes
82 REAL, DIMENSION(:,:), INTENT(IN) :: pgc
83 REAL, DIMENSION(:,:), INTENT(IN) :: pdmax
84 REAL, DIMENSION(:), INTENT(OUT) :: pabc
85 REAL, DIMENSION(:), INTENT(OUT) :: ppoi
86 REAL, DIMENSION(:,:), INTENT(OUT) :: panmax
87 REAL, DIMENSION(:,:), INTENT(OUT) :: pfzero
88 REAL, DIMENSION(:,:), INTENT(OUT) :: pepso
89 REAL, DIMENSION(:,:), INTENT(OUT) :: pgamm
90 REAL, DIMENSION(:,:), INTENT(OUT) :: pqdgamm
91 REAL, DIMENSION(:,:), INTENT(OUT) :: pqdgmes
92 REAL, DIMENSION(:,:), INTENT(OUT) :: pt1gmes
93 REAL, DIMENSION(:,:), INTENT(OUT) :: pt2gmes
94 REAL, DIMENSION(:,:), INTENT(OUT) :: pamax
95 REAL, DIMENSION(:,:), INTENT(OUT) :: pqdamax
96 REAL, DIMENSION(:,:), INTENT(OUT) :: pt1amax
97 REAL, DIMENSION(:,:), INTENT(OUT) :: pt2amax
98 REAL, DIMENSION(:,:), INTENT(OUT) :: pah
99 REAL, DIMENSION(:,:), INTENT(OUT) :: pbh
100 REAL, DIMENSION(:,:), INTENT(OUT) :: ptau_wood
101 REAL, DIMENSION(:,:,:), INTENT(OUT) :: pincrease
102 REAL, DIMENSION(:,:,:), INTENT(OUT) :: pturnover
103 !
104 !* 0.2 Declarations of local variables
105 ! -------------------------------
106 !
107 REAL, DIMENSION(:,:), ALLOCATABLE :: zp_vegtype_patch ! vegtypes present for each tile
108 REAL, DIMENSION(:), ALLOCATABLE :: zp_gmes !
109 REAL, DIMENSION(:), ALLOCATABLE :: zp_co2 ! air CO2 concentration (kg/kg)
110 REAL, DIMENSION(:), ALLOCATABLE :: zp_gc !
111 REAL, DIMENSION(:), ALLOCATABLE :: zp_dmax !
112 REAL, DIMENSION(:), ALLOCATABLE :: zp_anmax !
113 REAL, DIMENSION(:), ALLOCATABLE :: zp_fzero !
114 REAL, DIMENSION(:), ALLOCATABLE :: zp_epso !
115 REAL, DIMENSION(:), ALLOCATABLE :: zp_gamm !
116 REAL, DIMENSION(:), ALLOCATABLE :: zp_qdgamm !
117 REAL, DIMENSION(:), ALLOCATABLE :: zp_qdgmes !
118 REAL, DIMENSION(:), ALLOCATABLE :: zp_t1gmes !
119 REAL, DIMENSION(:), ALLOCATABLE :: zp_t2gmes !
120 REAL, DIMENSION(:), ALLOCATABLE :: zp_amax !
121 REAL, DIMENSION(:), ALLOCATABLE :: zp_qdamax !
122 REAL, DIMENSION(:), ALLOCATABLE :: zp_t1amax !
123 REAL, DIMENSION(:), ALLOCATABLE :: zp_t2amax !
124 REAL, DIMENSION(:), ALLOCATABLE :: zp_ah !
125 REAL, DIMENSION(:), ALLOCATABLE :: zp_bh !
126 REAL, DIMENSION(:), ALLOCATABLE :: zp_tau_wood !
127 REAL, DIMENSION(:,:), ALLOCATABLE :: zp_increase !
128 REAL, DIMENSION(:,:), ALLOCATABLE :: zp_turnover !
129 REAL, DIMENSION(:), ALLOCATABLE :: zp_abc !
130 REAL, DIMENSION(:), ALLOCATABLE :: zp_poi !
131 !
132 INTEGER :: ilu ! size of arrays
133 INTEGER :: ipatch
134 INTEGER :: inbiomass
135 INTEGER :: jp ! loop on tiles
136 REAL(KIND=JPRB) :: zhook_handle
137 !-------------------------------------------------------------------------------
138 IF (lhook) CALL dr_hook('CO2_INIT_N',0,zhook_handle)
139 !
140 ilu = SIZE(pvegtype_patch,1)
141 ipatch = SIZE(pvegtype_patch,3)
142 inbiomass = SIZE(pincrease,2)
143 !
144 DO jp=1,ipatch
145 !
146  IF (ksize_nature_p(jp) == 0 ) cycle
147 !
148  IF (maxval(pgmes(:,jp)).NE.xundef .OR. minval(pgmes(:,jp)).NE.xundef) THEN
149 
150  CALL pack_co2_init(kr_nature_p(:,jp),ksize_nature_p(jp),jp)
151 !
152  CALL cotwoinit_n(i, &
153  hphoto, zp_vegtype_patch,zp_gmes,zp_co2,zp_gc, &
154  zp_dmax,zp_abc,zp_poi,zp_anmax,zp_fzero, &
155  zp_epso,zp_gamm,zp_qdgamm,zp_qdgmes,zp_t1gmes, &
156  zp_t2gmes,zp_amax,zp_qdamax,zp_t1amax, &
157  zp_t2amax,zp_ah,zp_bh,zp_tau_wood )
158 
159  zp_increase = 0.
160  zp_turnover = 0.
161 !
162  CALL unpack_co2_init(kr_nature_p(:,jp),ksize_nature_p(jp),jp)
163 
164  ENDIF
165 
166 ENDDO
167 !
168 !-------------------------------------------------------------------------------
169 IF (lhook) CALL dr_hook('CO2_INIT_N',1,zhook_handle)
170  CONTAINS
171 !-------------------------------------------------------------------------------
172 SUBROUTINE pack_co2_init(KMASK,KSIZE,KPATCH)
173 IMPLICIT NONE
174 INTEGER, INTENT(IN) :: ksize, kpatch
175 INTEGER, DIMENSION(:), INTENT(IN) :: kmask
176 !
177 INTEGER jj, ji
178 REAL(KIND=JPRB) :: zhook_handle
179 !
180 IF (lhook) CALL dr_hook('PACK_CO2_INIT',0,zhook_handle)
181 ALLOCATE(zp_vegtype_patch(ksize,nvegtype))
182 ALLOCATE(zp_gmes(ksize))
183 ALLOCATE(zp_co2(ksize))
184 ALLOCATE(zp_gc(ksize))
185 ALLOCATE(zp_dmax(ksize))
186 ALLOCATE(zp_anmax(ksize))
187 ALLOCATE(zp_fzero(ksize))
188 ALLOCATE(zp_epso(ksize))
189 ALLOCATE(zp_gamm(ksize))
190 ALLOCATE(zp_qdgamm(ksize))
191 ALLOCATE(zp_qdgmes(ksize))
192 ALLOCATE(zp_t1gmes(ksize))
193 ALLOCATE(zp_t2gmes(ksize))
194 ALLOCATE(zp_amax(ksize))
195 ALLOCATE(zp_qdamax(ksize))
196 ALLOCATE(zp_t1amax(ksize))
197 ALLOCATE(zp_t2amax(ksize))
198 ALLOCATE(zp_ah(ksize))
199 ALLOCATE(zp_bh(ksize))
200 ALLOCATE(zp_tau_wood(ksize))
201 ALLOCATE(zp_increase(ksize,inbiomass))
202 ALLOCATE(zp_turnover(ksize,inbiomass))
203 !
204 ! initialisation needed for TORI
205 ALLOCATE(zp_abc(SIZE(pabc)))
206 ALLOCATE(zp_poi(SIZE(ppoi)))
207 zp_abc(:)=0.
208 zp_poi(:)=0.
209 !
210 DO jj=1,ksize
211  ji = kmask(jj)
212  zp_vegtype_patch(jj,:) = pvegtype_patch(ji,:,kpatch)
213  zp_gmes(jj) = pgmes(ji,kpatch)
214  zp_co2(jj) = pco2(ji)
215  zp_gc(jj) = pgc(ji,kpatch)
216  zp_dmax(jj) = pdmax(ji,kpatch)
217 END DO
218 IF (lhook) CALL dr_hook('PACK_CO2_INIT',1,zhook_handle)
219 !-------------------------------------------------------------------------------
220 END SUBROUTINE pack_co2_init
221 !-------------------------------------------------------------------------------
222 SUBROUTINE unpack_co2_init(KMASK,KSIZE,KPATCH)
223 IMPLICIT NONE
224 INTEGER, INTENT(IN) :: ksize, kpatch
225 INTEGER, DIMENSION(:), INTENT(IN) :: kmask
226 !
227 INTEGER jj, ji
228 REAL(KIND=JPRB) :: zhook_handle
229 !
230 IF (lhook) CALL dr_hook('UNPACK_CO2_INIT',0,zhook_handle)
231 panmax(:,kpatch) = xundef
232 pfzero(:,kpatch) = xundef
233 pepso(:,kpatch) = xundef
234 pgamm(:,kpatch) = xundef
235 pqdgamm(:,kpatch) = xundef
236 pqdgmes(:,kpatch) = xundef
237 pt1gmes(:,kpatch) = xundef
238 pt2gmes(:,kpatch) = xundef
239 pamax(:,kpatch) = xundef
240 pqdamax(:,kpatch) = xundef
241 pt1amax(:,kpatch) = xundef
242 pt2amax(:,kpatch) = xundef
243 pah(:,kpatch) = xundef
244 pbh(:,kpatch) = xundef
245 ptau_wood(:,kpatch) = xundef
246 pincrease(:,:,kpatch) = xundef
247 pturnover(:,:,kpatch) = xundef
248 !
249 DO jj=1,ksize
250  ji = kmask(jj)
251  panmax(ji, kpatch) = zp_anmax(jj)
252  pfzero(ji, kpatch) = zp_fzero(jj)
253  pepso(ji, kpatch) = zp_epso(jj)
254  pgamm(ji, kpatch) = zp_gamm(jj)
255  pqdgamm(ji, kpatch) = zp_qdgamm(jj)
256  pqdgmes(ji, kpatch) = zp_qdgmes(jj)
257  pt1gmes(ji, kpatch) = zp_t1gmes(jj)
258  pt2gmes(ji, kpatch) = zp_t2gmes(jj)
259  pamax(ji, kpatch) = zp_amax(jj)
260  pqdamax(ji, kpatch) = zp_qdamax(jj)
261  pt1amax(ji, kpatch) = zp_t1amax(jj)
262  pt2amax(ji, kpatch) = zp_t2amax(jj)
263  pah(ji, kpatch) = zp_ah(jj)
264  pbh(ji, kpatch) = zp_bh(jj)
265  ptau_wood(ji, kpatch) = zp_tau_wood(jj)
266  pincrease(ji, :, kpatch) = zp_increase(jj, :)
267  pturnover(ji, :, kpatch) = zp_turnover(jj, :)
268 END DO
269 !
270 DO jj=1,SIZE(pabc)
271  pabc(jj)=zp_abc(jj)
272  ppoi(jj)=zp_poi(jj)
273 END DO
274 
275 DEALLOCATE(zp_vegtype_patch)
276 DEALLOCATE(zp_gmes )
277 DEALLOCATE(zp_co2 )
278 DEALLOCATE(zp_gc )
279 DEALLOCATE(zp_dmax )
280 DEALLOCATE(zp_anmax )
281 DEALLOCATE(zp_fzero )
282 DEALLOCATE(zp_epso )
283 DEALLOCATE(zp_gamm )
284 DEALLOCATE(zp_qdgamm )
285 DEALLOCATE(zp_qdgmes )
286 DEALLOCATE(zp_t1gmes )
287 DEALLOCATE(zp_t2gmes )
288 DEALLOCATE(zp_amax )
289 DEALLOCATE(zp_qdamax )
290 DEALLOCATE(zp_t1amax )
291 DEALLOCATE(zp_t2amax )
292 DEALLOCATE(zp_ah )
293 DEALLOCATE(zp_bh )
294 DEALLOCATE(zp_tau_wood )
295 DEALLOCATE(zp_increase )
296 DEALLOCATE(zp_turnover )
297 DEALLOCATE(zp_abc )
298 DEALLOCATE(zp_poi )
299 IF (lhook) CALL dr_hook('UNPACK_CO2_INIT',1,zhook_handle)
300 !-------------------------------------------------------------------------------
301 END SUBROUTINE unpack_co2_init
302 !-------------------------------------------------------------------------------
303 !
304 END SUBROUTINE co2_init_n
modd_surfex_mpi
Definition: modd_surfex_mpi.F90:6
unpack_co2_init
subroutine unpack_co2_init(KMASK, KSIZE, KPATCH)
Definition: co2_initn.F90:222
modd_isba_n
Definition: modd_isban.F90:6
cotwoinit_n
subroutine cotwoinit_n(I, HPHOTO, PVEGTYPE, PGMES, PCO2, PGC, PDMAX, PABC, PPOI, PANMAX, PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PAH, PBH, PTAU_WOOD)
Definition: cotwoinitn.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
co2_init_n
subroutine co2_init_n(I, HPHOTO, KSIZE_NATURE_P, KR_NATURE_P, PVEGTYPE_PATCH, PCO2, PGMES, PGC, PDMAX, PABC, PPOI, PANMAX, PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PAH, PBH, PTAU_WOOD, PINCREASE, PTURNOVER)
Definition: co2_initn.F90:6
pack_co2_init
subroutine pack_co2_init(KMASK, KSIZE, KPATCH)
Definition: co2_initn.F90:172
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5