-
Notifications
You must be signed in to change notification settings - Fork 1
/
CSP_INCOMP.FOR
336 lines (289 loc) · 14.3 KB
/
CSP_INCOMP.FOR
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
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
C========================================================================
C CSP_INCOMP Subroutine
C This subroutine initializes parameters for composition of tissues
C which vary with genotype at the beginning of each run.
C----------------------------------------------------------------------
C REVISION HISTORY
C 03/31/1991 JWW Separated old INPHEN into INPHEN, INVEG, INCOMP
C 04/01/1991 GH Adapted for CROPGRO
C 09/18/1998 CHP Moved to PLANT module and added input statements
C 05/10/1999 GH Incorporated in CROPGRO
C 11/09/2001 O.H. Daza adapted to sugarcane model
C 08/12/2003 CHP Added I/O error checking
C 08/25/2003 F.S. Royce updated to DSSAT 4.0 version of CASUPRO
C 07/26/2004 CHP Removed variables which were not being used
C-----------------------------------------------------------------------
C Called from: CASUPRO
C Calls : ERROR, FIND, IGNORE, CSP_INCOMP_OUT
C=======================================================================
SUBROUTINE CSP_INCOMP(DYNAMIC,
& FILECC, FRLF, FRRT, FRSTM, FRSU, !Input
& AGRLF, AGRRT, AGRSTM, AGRSU, AGRVG, AGRVG2) !Output
!-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
SAVE
!-----------------------------------------------------------------------
CHARACTER*6 ERRKEY
PARAMETER (ERRKEY = 'INCOMP')
CHARACTER*6 SECTION ! , ECONO, ECOTYP
CHARACTER*80 CHAR
CHARACTER*92 FILECC ! , FILEGC
! CHARACTER*255 C255
INTEGER LUNCRP ! , LUNECO
INTEGER DYNAMIC, ERR, LNUM, FOUND, ISECT
REAL AGRLF , AGRRT , AGRSTM, AGRVG , AGRVG2,
& FRLF , FRRT , FRSTM,
& PCARLF, PCARRT, PCARST, PCARSU,
& PLIGLF, PLIGRT, PLIGST, PLIGSU,
& PLIPLF, PLIPRT, PLIPST, PLIPSU,
& PMINLF, PMINRT, PMINST, PMINSU,
& POALF , POART , POAST , POASU ,
& PROLFI, PRORTI, PROSTI, PROSUI,
& RCH2O , RLIG , RLIP , RMIN , RNO3C , ROA
! LIST OF NEW VARIABLES ADDED TO ENABLE SIMULATION OF SUGARS IN THE
! SUGARCANE MODEL
REAL AGRSU, FRSU !, CADSU, CRUSSU, FNINSU, NADSU, NGRSU, NGRSUG
! REAL PROSUG, PROSUT, WCRSU, WSUDOTN
! REAL PCNSU
! REAL NRUSSU, NSUDOT, SUWT
! REAL WNRSU
!***********************************************************************
!***********************************************************************
! Run Initialization - Called once per simulation
!***********************************************************************
IF (DYNAMIC .EQ. RUNINIT) THEN
!-----------------------------------------------------------------------
! Open and read in values from FILEC (.SPE) input file.
!-----------------------------------------------------------------------
CALL GETLUN('FILEC', LUNCRP)
OPEN (LUNCRP,FILE = FILECC, STATUS = 'OLD',IOSTAT=ERR)
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,0)
LNUM = 0
!-----------------------------------------------------------------------
! Find and Read Respiration Section
!-----------------------------------------------------------------------
! Subroutine FIND finds appropriate SECTION in a file by
! searching for the specified 6-character string at beginning
! of each line.
!-----------------------------------------------------------------------
SECTION = '*#RESP'
CALL FIND(LUNCRP, SECTION, LNUM, FOUND)
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILECC, LNUM)
ELSE
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR) !GRLF
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR) !GRSU
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RCH2O
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RLIP
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RLIG
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.4)',IOSTAT=ERR) ROA
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.2)',IOSTAT=ERR) RMIN
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
ENDIF
!-----------------------------------------------------------------------
SECTION = '*#PLAN'
CALL FIND(LUNCRP, SECTION, LNUM, FOUND)
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILECC, LNUM)
ELSE
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PCARLF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PCARRT
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PCARST
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PCARSU
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIGLF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIGRT
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIGST
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIGSU
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIPLF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIPRT
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIPST
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PLIPSU
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.4)',IOSTAT=ERR) PMINLF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) PMINRT
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PMINST
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) PMINSU
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.3)',IOSTAT=ERR) POALF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.4)',IOSTAT=ERR) POART
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) POAST
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) POASU
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) PROLFI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) PRORTI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) PROSTI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(14X,F6.2)',IOSTAT=ERR) PROSUI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
ENDIF
CLOSE (LUNCRP)
!-----------------------------------------------------------------------
! Echoes input data
CALL CSP_INCOMP_OUT(
& FILECC, RNO3C, RCH2O, RLIP, RLIG, ROA, RMIN, PROLFI, !Input
& PROSTI, PRORTI, PROSUI, PCARLF, PCARST, PCARRT, PCARSU, !Input
& PLIPLF, PLIPST, PLIPRT, PLIPSU, PLIGLF, PLIGST, PLIGRT, !Input
& PLIGSU, POALF, POAST, POART, POASU, PMINLF, PMINST, !Input
& PMINRT, PMINSU) !Input
!***********************************************************************
!***********************************************************************
! Seasonal initialization - run once per season
!***********************************************************************
ELSEIF (DYNAMIC .EQ. SEASINIT) THEN
AGRVG = AGRLF * FRLF + AGRRT * FRRT + AGRSTM * FRSTM +
!Sugars
& AGRSU * FRSU
AGRVG2 = AGRVG + (FRLF * PROLFI + FRRT * PRORTI + FRSTM * PROSTI +
!Sugars
& FRSU * PROSUI) * RNO3C
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!-----------------------------------------------------------------------
RETURN
END ! SUBROUTINE INCOMP
!=======================================================================
!-----------------------------------------------------------------------
! Variable definitions
!-----------------------------------------------------------------------
! AGRLF Mass of CH2O required for new leaf growth
! AGRRT Mass of CH2O required for new root growth
! AGRSTM Mass of CH2O required for new stem growth
! AGRVG Mass of CH2O required for vegetative tissue growth including
! stoichiometry and respiration
! AGRVG2 Total mass of CH2O required for vegetative tissue growth
! DYNAMIC Module control variable; =RUNINIT, SEASINIT, RATE, EMERG, INTEGR,
! OUTPUT, or FINAL
! ECONO Ecotype code - used to match ECOTYP in .ECO file
! ","IPDMND, IPGROW, IPIBS, IPPHENOL, PODS, IPPLNT
! ECOTYP Ecotype code for this simulation "
! ERR Error code for file operation
! FILECC Path plus filename for species file (*.spe)
! FILEGC Pathname plus filename for ECO file "
! FOUND Indicator that good data was read from file by subroutine FIND (0
! - End-of-file encountered, 1 - NAME was found)
! FRLF Fraction of vegetative tissue growth that goes to leaves on a day
!
! FRRT Fraction of vegetative tissue growth that goes to roots on a day
! FRSTM Fraction of vegetative tissue growth that goes to stems on a day
! ISECT Data record code (0 - End of file encountered, 1 - Found a good
! line to read, 2 - End of Section in file encountered, denoted
! by * in column 1
! LNUM Current line number of input file
! LUNCRP Logical unit number for FILEC (*.spe file)
! LUNECO Logical unit number for FILEE (*.eco file) "
! PCARLF Proportion of leaf tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PCARRT Proportion of root tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PCARST Proportion of stem tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PLIGLF Proportion of leaf tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIGRT Proportion of root tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIGST Proportion of stem tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIPLF Proportion of leaf tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PLIPRT Proportion of root tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PLIPST Proportion of stem tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PMINLF Proportion of leaf tissue that is mineral
! (fraction)","IPGROW, INCOMP
! PMINRT Proportion of root tissue that is mineral
! (fraction)","IPGROW, INCOMP
! PMINST Proportion of stem tissue that is mineral
! (fraction)","IPGROW, INCOMP
! POALF Proportion of leaf tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! POART Proportion of root tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! POAST Proportion of stem tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! PROLFF Minimum leaf protein composition after N mining
! ( g[protein] / g[leaf])
! PROLFI Maximum protein composition in leaves during growth with
! luxurious supply of N
! (g[protein] / g[leaf tissue])","IPPLNT, IPDMND, I
! PRORTI Maximum protein composition in roots during growth with luxurious
! supply of N (g[protein] / g[root])","IPPLNT, IPDMND, IPGROW,
! PROSTF Minimum stem protein composition after N mining
! (g[protein] / g[stem])","IPGROW, INCOMP, IPDMND
! PROSTI Maximum protein composition in stems during growth with luxurious
! supply of N (g[protein] / g[stem])","IPPLNT, IPDMND, IPGROW,
! RCH2O Respiration required for synthesizing CH2O structure
! (g[CH2O] / g[tissue])","IPDMND, PODCOMP, IPPLNT,
! RLIG Respiration required for synthesizing lignin structure
! (g[CH2O] / g[lignin])","IPDMND, PODCOMP, IPPLNT,
! RLIP Respiration required for synthesizing lipid structure
! (g[CH2O] / g[lipid])","IPDMND, PODCOMP, IPPLNT, I
! RMIN Respiration required for synthesizing mineral structure
! (g[CH2O] / g[mineral])","IPPLNT, IPDMND, PODCOMP
! RNO3C Respiration required for reducing NO3 to protein
! (g[CH2O] / g[protein])","IPDMND, IPPLNT, INCOMP
! ROA Respiration required for synthesizing organic acids
! (g[CH2O] / g[product])","IPDMND, PODCOMP, IPPLNT
!-----------------------------------------------------------------------
! END SUBROUTINE INCOMP_SC
!=======================================================================