-
Notifications
You must be signed in to change notification settings - Fork 9
Expand file tree
/
Copy pathCASAONLY_LUC.F90
More file actions
287 lines (218 loc) · 11.9 KB
/
Copy pathCASAONLY_LUC.F90
File metadata and controls
287 lines (218 loc) · 11.9 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
SUBROUTINE CASAONLY_LUC(dels, curr_time, ktauday, veg,soil,casabiome,casapool, &
casaflux,casamet,casabal,phen,POP,climate,LALLOC,LUC_EXPT, POPLUC, &
sum_casapool, sum_casaflux )
USE cable_def_types_mod
USE cable_carbon_module
USE casa_ncdf_module, ONLY: is_casa_time
USE cable_common_module, ONLY: CABLE_USER
USE cable_IO_vars_module, ONLY: logn, landpt, patch
USE casadimension
USE casaparm
USE casavariable
USE phenvariable
USE POP_Types, ONLY: POP_TYPE
USE POPMODULE, ONLY: POPStep, POP_init_single
USE TypeDef, ONLY: i4b, dp
USE CABLE_LUC_EXPT, ONLY: LUC_EXPT_TYPE, read_LUH2,&
ptos,ptog,stog,gtos,grassfrac, pharv, smharv, syharv
USE POPLUC_Types
USE POPLUC_Module, ONLY: POPLUCStep, POPLUC_weights_Transfer, WRITE_LUC_OUTPUT_NC, &
POP_LUC_CASA_transfer, WRITE_LUC_RESTART_NC, READ_LUC_RESTART_NC, &
POPLUC_set_patchfrac, WRITE_LUC_OUTPUT_GRID_NC
USE casa_cable
USE casa_inout_module
USE biogeochem_mod, ONLY : biogeochem
USE casa_offline_inout_module, ONLY : WRITE_CASA_OUTPUT_NC
use datetime_module, only: datetime
IMPLICIT NONE
!!CLN CHARACTER(LEN=99), INTENT(IN) :: fcnpspin
REAL, INTENT(IN) :: dels
INTEGER, INTENT(IN) :: LALLOC, ktauday
TYPE (veg_parameter_type), INTENT(INOUT) :: veg ! vegetation parameters
TYPE (soil_parameter_type), INTENT(INOUT) :: soil ! soil parameters
TYPE (casa_biome), INTENT(INOUT) :: casabiome
TYPE (casa_pool), INTENT(INOUT) :: casapool
TYPE (casa_flux), INTENT(INOUT) :: casaflux
TYPE (casa_met), INTENT(INOUT) :: casamet
TYPE (casa_balance), INTENT(INOUT) :: casabal
TYPE (phen_variable), INTENT(INOUT) :: phen
TYPE (POP_TYPE), INTENT(INOUT) :: POP
TYPE (climate_TYPE), INTENT(INOUT) :: climate
TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT
TYPE(POPLUC_TYPE), INTENT(INOUT) :: POPLUC
TYPE (casa_pool) , INTENT(INOUT) :: sum_casapool
TYPE (casa_flux) , INTENT(INOUT) :: sum_casaflux
type(datetime), intent(in) :: curr_time
TYPE (casa_met) :: casaspin
! local variables
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cleaf2met, avg_cleaf2str, avg_croot2met, avg_croot2str, avg_cwood2cwd
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nleaf2met, avg_nleaf2str, avg_nroot2met, avg_nroot2str, avg_nwood2cwd
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_pleaf2met, avg_pleaf2str, avg_proot2met, avg_proot2str, avg_pwood2cwd
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_cgpp, avg_cnpp, avg_nuptake, avg_puptake
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_nsoilmin, avg_psoillab, avg_psoilsorb, avg_psoilocc
!chris 12/oct/2012 for spin up casa
REAL, DIMENSION(:), ALLOCATABLE, SAVE :: avg_ratioNCsoilmic, avg_ratioNCsoilslow, avg_ratioNCsoilpass
REAL(r_2), DIMENSION(:), ALLOCATABLE, SAVE :: avg_xnplimit, avg_xkNlimiting,avg_xklitter, avg_xksoil
! local variables
INTEGER :: myearspin,nyear, yyyy, nyear_dump
CHARACTER(LEN=99) :: ncfile
CHARACTER(LEN=4) :: cyear
INTEGER :: idoy
REAL, DIMENSION(mp) :: cleaf2met, cleaf2str, croot2met, croot2str, cwood2cwd
REAL, DIMENSION(mp) :: nleaf2met, nleaf2str, nroot2met, nroot2str, nwood2cwd
REAL, DIMENSION(mp) :: pleaf2met, pleaf2str, proot2met, proot2str, pwood2cwd
REAL, DIMENSION(mp) :: xcgpp, xcnpp, xnuptake, xpuptake
REAL, DIMENSION(mp) :: xnsoilmin, xpsoillab, xpsoilsorb,xpsoilocc
REAL(r_2), DIMENSION(mp) :: xnplimit, xkNlimiting, xklitter, xksoil,xkleaf, xkleafcold, xkleafdry
! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012
REAL, DIMENSION(5,mvtype,mplant) :: bmcplant, bmnplant, bmpplant
REAL, DIMENSION(5,mvtype,mlitter) :: bmclitter, bmnlitter, bmplitter
REAL, DIMENSION(5,mvtype,msoil) :: bmcsoil, bmnsoil, bmpsoil
REAL, DIMENSION(5,mvtype) :: bmnsoilmin,bmpsoillab,bmpsoilsorb, bmpsoilocc
REAL, DIMENSION(mvtype) :: bmarea
INTEGER :: nptx,nvt,kloop, ctime, k, j, l
REAL(dp) :: StemNPP(mp,2)
INTEGER, ALLOCATABLE :: Iw(:) ! array of indices corresponding to woody (shrub or forest) tiles
INTEGER :: count_sum_casa ! number of time steps over which casa pools &
!and fluxes are aggregated (for output)
IF (.NOT.ALLOCATED(Iw)) ALLOCATE(Iw(POP%np))
!! vh_js !!
IF (cable_user%CALL_POP) THEN
Iw = POP%Iwood
ENDIF
ctime = 0
CALL zero_sum_casa(sum_casapool, sum_casaflux)
count_sum_casa = 0
myearspin = CABLE_USER%YEAREND - CABLE_USER%YEARSTART + 1
yyyy = CABLE_USER%YEARSTART - 1
DO nyear=1,myearspin
yyyy = yyyy+1
WRITE(*,*) 'casaonly_LUC', YYYY
nyear_dump = MOD(nyear, &
CABLE_USER%CASA_SPIN_ENDYEAR - CABLE_USER%CASA_SPIN_STARTYEAR + 1)
IF (nyear_dump == 0) &
nyear_dump = CABLE_USER%CASA_SPIN_ENDYEAR - CABLE_USER%CASA_SPIN_STARTYEAR + 1
WRITE(CYEAR,FMT="(I4)") CABLE_USER%CASA_SPIN_STARTYEAR + nyear_dump - 1
ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc'
CALL read_casa_dump( ncfile,casamet, casaflux, phen,climate, 1,1,.TRUE. )
!!CLN901 format(A99)
DO idoy=1,mdyear
casamet%tairk(:) = casamet%Tairkspin(:,idoy)
casamet%tsoil(:,1) = casamet%Tsoilspin_1(:,idoy)
casamet%tsoil(:,2) = casamet%Tsoilspin_2(:,idoy)
casamet%tsoil(:,3) = casamet%Tsoilspin_3(:,idoy)
casamet%tsoil(:,4) = casamet%Tsoilspin_4(:,idoy)
casamet%tsoil(:,5) = casamet%Tsoilspin_5(:,idoy)
casamet%tsoil(:,6) = casamet%Tsoilspin_6(:,idoy)
casamet%moist(:,1) = casamet%moistspin_1(:,idoy)
casamet%moist(:,2) = casamet%moistspin_2(:,idoy)
casamet%moist(:,3) = casamet%moistspin_3(:,idoy)
casamet%moist(:,4) = casamet%moistspin_4(:,idoy)
casamet%moist(:,5) = casamet%moistspin_5(:,idoy)
casamet%moist(:,6) = casamet%moistspin_6(:,idoy)
casaflux%cgpp(:) = casamet%cgppspin(:,idoy)
casaflux%crmplant(:,1) = casamet%crmplantspin_1(:,idoy)
casaflux%crmplant(:,2) = casamet%crmplantspin_2(:,idoy)
casaflux%crmplant(:,3) = casamet%crmplantspin_3(:,idoy)
phen%phase(:) = phen%phasespin(:,idoy)
phen%doyphase(:,1) = phen%doyphasespin_1(:,idoy)
phen%doyphase(:,2) = phen%doyphasespin_2(:,idoy)
phen%doyphase(:,3) = phen%doyphasespin_3(:,idoy)
phen%doyphase(:,4) = phen%doyphasespin_4(:,idoy)
climate%qtemp_max_last_year(:) = casamet%mtempspin(:,idoy)
CALL biogeochem(dels,idoy,LALLOC,veg,soil,casabiome,casapool,casaflux, &
casamet,casabal,phen,POP,climate,xnplimit,xkNlimiting,xklitter, &
xksoil,xkleaf,xkleafcold,xkleafdry,&
cleaf2met,cleaf2str,croot2met,croot2str,cwood2cwd, &
nleaf2met,nleaf2str,nroot2met,nroot2str,nwood2cwd, &
pleaf2met,pleaf2str,proot2met,proot2str,pwood2cwd)
! update time-aggregates of casa pools and fluxes
CALL update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, &
& .TRUE. , .FALSE., 1)
count_sum_casa = count_sum_casa + 1
! accumulate annual variables for use in POP
IF(idoy==1 ) THEN
casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 ! (assumes 70% of wood NPP is allocated above ground)
casabal%LAImax = casamet%glai
casabal%Cleafmean = casapool%cplant(:,1)/REAL(mdyear)/1000.
casabal%Crootmean = casapool%cplant(:,3)/REAL(mdyear)/1000.
ELSE
casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7
casabal%LAImax = MAX(casamet%glai, casabal%LAImax)
casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1)/REAL(mdyear)/1000.
casabal%Crootmean = casabal%Crootmean +casapool%cplant(:,3)/REAL(mdyear)/1000.
ENDIF
IF(idoy==mdyear) THEN ! end of year
LUC_EXPT%CTSTEP = yyyy - LUC_EXPT%FirstYear + 1
CALL READ_LUH2(LUC_EXPT)
DO k=1,mland
POPLUC%ptos(k) = LUC_EXPT%INPUT(ptos)%VAL(k)
POPLUC%ptog(k) = LUC_EXPT%INPUT(ptog)%VAL(k)
POPLUC%stop(k) = 0.0
POPLUC%stog(k) = LUC_EXPT%INPUT(stog)%VAL(k)
POPLUC%gtop(k) = 0.0
POPLUC%gtos(k) = LUC_EXPT%INPUT(gtos)%VAL(k)
POPLUC%pharv(k) = LUC_EXPT%INPUT(pharv)%VAL(k)
POPLUC%smharv(k) = LUC_EXPT%INPUT(smharv)%VAL(k)
POPLUC%syharv(k) = LUC_EXPT%INPUT(syharv)%VAL(k)
POPLUC%thisyear = yyyy
ENDDO
!stop
! set landuse index for secondary forest POP landscapes
DO k=1,POP%np
IF (yyyy.EQ.LUC_EXPT%YearStart) THEN
IF (veg%iLU(POP%Iwood(k)).EQ.2) THEN
POP%pop_grid(k)%LU = 2
ENDIF
ENDIF
ENDDO
! zero secondary forest tiles in POP where secondary forest area is zero
DO k=1,mland
IF ((POPLUC%primf(k)-POPLUC%frac_forest(k))==0.0 &
.AND. (.NOT.LUC_EXPT%prim_only(k))) THEN
j = landpt(k)%cstart+1
DO l=1,SIZE(POP%Iwood)
IF( POP%Iwood(l) == j) THEN
CALL POP_init_single(POP,veg%disturbance_interval,l)
EXIT
ENDIF
ENDDO
casapool%cplant(j,leaf) = 0.01
casapool%nplant(j,leaf)= casabiome%ratioNCplantmin(veg%iveg(j),leaf)* casapool%cplant(j,leaf)
casapool%pplant(j,leaf)= casabiome%ratioPCplantmin(veg%iveg(j),leaf)* casapool%cplant(j,leaf)
casapool%cplant(j,froot) = 0.01
casapool%nplant(j,froot)= casabiome%ratioNCplantmin(veg%iveg(j),froot)* casapool%cplant(j,froot)
casapool%pplant(j,froot)= casabiome%ratioPCplantmin(veg%iveg(j),froot)* casapool%cplant(j,froot)
casapool%cplant(j,wood) = 0.01
casapool%nplant(j,wood)= casabiome%ratioNCplantmin(veg%iveg(j),wood)* casapool%cplant(j,wood)
casapool%pplant(j,wood)= casabiome%ratioPCplantmin(veg%iveg(j),wood)* casapool%cplant(j,wood)
casaflux%frac_sapwood(j) = 1.0
ENDIF
ENDDO
CALL POPLUCStep(POPLUC,yyyy)
CALL POPLUC_weights_transfer(POPLUC,POP,LUC_EXPT)
CALL POPdriver(casaflux,casabal,veg, POP)
CALL POP_IO( pop, casamet, YYYY, 'WRITE_EPI', &
( YYYY.EQ.cable_user%YearEnd ) )
!!$ WHERE (pop%pop_grid(:)%cmass_sum_old.gt.0.1 .and. pop%pop_grid(:)%cmass_sum.gt.0.1 )
!!$ casapool%Cplant(Iw,2) = casapool%Cplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99))
!!$ casapool%Nplant(Iw,2) = casapool%Nplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99))
!!$ ENDWHERE
CALL POP_LUC_CASA_transfer(POPLUC,POP,LUC_EXPT,casapool,casabal,casaflux,ktauday)
CALL WRITE_LUC_OUTPUT_GRID_NC( POPLUC, YYYY, ( YYYY.EQ.cable_user%YearEnd ))
CALL POPLUC_set_patchfrac(POPLUC,LUC_EXPT)
ENDIF ! end of year
IF ( IS_CASA_TIME("write", curr_time, logn) ) THEN
ctime = ctime +1
CALL update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, &
.FALSE. , .TRUE. , count_sum_casa)
CALL WRITE_CASA_OUTPUT_NC ( veg, casamet, sum_casapool, casabal, sum_casaflux, &
.TRUE., ctime, ( idoy.EQ.mdyear .AND. YYYY .EQ. &
cable_user%YearEnd ) )
count_sum_casa = 0
CALL zero_sum_casa(sum_casapool, sum_casaflux)
ENDIF
ENDDO
ENDDO
CALL WRITE_LUC_RESTART_NC ( POPLUC, YYYY )
END SUBROUTINE CASAONLY_LUC