-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathINCOMP.for
361 lines (336 loc) · 16.4 KB
/
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
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
C=======================================================================
C 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 08/12/2003 CHP Added I/O error checking
! 11/26/2007 CHP THRESH, SDPRO, SDLIP moved from eco to cul file
C-----------------------------------------------------------------------
C Called : PLANT
C Calls : ERROR, FIND, IGNORE
C=======================================================================
SUBROUTINE INCOMP(DYNAMIC,
& FILECC, FILEIO, FRLF, FRRT, FRSTM, !Input
& AGRLF, AGRNOD, AGRRT, AGRSD1, AGRSD2, AGRSH1, !Output
& AGRSH2, AGRSTM, AGRVG, AGRVG2, SDPROR) !Output
C-----------------------------------------------------------------------
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
CHARACTER*30 FILEIO
CHARACTER*80 C80
CHARACTER*92 FILECC
INTEGER LUNCRP, LUNIO
INTEGER DYNAMIC, ERR, FOUND, ISECT, LINC, LNUM
REAL AGRLF , AGRNOD, AGRRT , AGRSD1, AGRSD2, AGRSH1,
& AGRSH2, AGRSTM, AGRVG , AGRVG2,
& FRLF , FRRT , FRSTM,
& PCARLF, PCARNO, PCARRT, PCARSD, PCARSH, PCARST,
& PLIGLF, PLIGNO, PLIGRT, PLIGSD, PLIGSH, PLIGST,
& PLIPLF, PLIPNO, PLIPRT, PLIPSH, PLIPST,
& PMINLF, PMINNO, PMINRT, PMINSD, PMINSH, PMINST,
& POALF , POANO , POART , POASD , POASH , POAST ,
& PROLFI, PRORTI, PROSHI, PROSTI,
& RCH2O , RLIG , RLIP , RMIN , RNO3C , ROA ,
& SDLIP, SDPRO , SDPROR, SDPROS
!***********************************************************************
!***********************************************************************
! Run Initialization - Called once per simulation
!***********************************************************************
IF (DYNAMIC .EQ. RUNINIT) THEN
!-----------------------------------------------------------------------
! Read INP file
!-----------------------------------------------------------------------
CALL GETLUN('FILEIO', LUNIO)
OPEN (LUNIO, FILE = FILEIO,STATUS = 'OLD',IOSTAT=ERR)
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEIO,0)
LNUM = 0
!-----------------------------------------------------------------------
! Find and read 2ND Cultivar Section
!-----------------------------------------------------------------------
SECTION = '*CULTI'
CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC
SECTION = '*CULTI'
CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC
IF (FOUND == 0) THEN
CALL ERROR(SECTION, 42, FILEIO, LNUM)
ELSE
READ(LUNIO,'(126X,2F6.0)',IOSTAT=ERR) SDPRO, SDLIP
LNUM = LNUM + 1
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEIO,LNUM)
ENDIF
CLOSE (LUNIO)
!-----------------------------------------------------------------------
! Read in values from species 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, LINC, FOUND) ; LNUM = LNUM + LINC
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILECC, LNUM)
ELSE
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(F6.0)',IOSTAT=ERR) RNO3C
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(5F6.0)',IOSTAT=ERR) RCH2O, RLIP, RLIG, ROA, RMIN
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
ENDIF
SECTION = '!*PLAN'
CALL FIND(LUNCRP, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILECC, LNUM)
ELSE
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
! READ(C80,'(F6.0,6X,2F6.0)',IOSTAT=ERR) PROLFI, PROLFF, PROSTI
READ(C80,'(F6.0,12X,F6.0)',IOSTAT=ERR) PROLFI, PROSTI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(F6.0,12X,F6.0)',IOSTAT=ERR) PRORTI, PROSHI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(F6.0)',IOSTAT=ERR) SDPROS
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(6F6.0)',IOSTAT=ERR)
& PCARLF, PCARST, PCARRT, PCARSH, PCARSD, PCARNO
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(5F6.0)',IOSTAT=ERR)
& PLIPLF, PLIPST, PLIPRT, PLIPSH, PLIPNO
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(6F6.0)',IOSTAT=ERR)
& PLIGLF, PLIGST, PLIGRT, PLIGSH, PLIGSD, PLIGNO
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(6F6.0)',IOSTAT=ERR)
& POALF, POAST, POART, POASH, POASD, POANO
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(6F6.0)',IOSTAT=ERR)
& PMINLF, PMINST, PMINRT, PMINSH, PMINSD, PMINNO
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
ENDIF
CLOSE (LUNCRP)
!C-----------------------------------------------------------------------
!C Read Ecotype Parameter File
!C-----------------------------------------------------------------------
! CALL GETLUN('FILEE', LUNECO)
! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR)
! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0)
! ECOTYP = ' '
! LNUM = 0
! DO WHILE (ECOTYP .NE. ECONO)
! CALL IGNORE(LUNECO, LNUM, ISECT, C255)
! IF (ISECT .EQ. 1 .AND. C255(1:1) .NE. ' ' .AND.
! & C255(1:1) .NE. '*') THEN
! READ (C255,'(A6,108X,2F6.0)',IOSTAT=ERR)
! & ECOTYP, SDPRO, SDLIP
! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM)
! IF (ECOTYP .EQ. ECONO) THEN
! EXIT
! ENDIF
!
! ELSE IF (ISECT .EQ. 0) THEN
! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM)
! ECONO = 'DFAULT'
! REWIND(LUNECO)
! LNUM = 0
! ENDIF
! ENDDO
!
! CLOSE (LUNECO)
!
!***********************************************************************
!***********************************************************************
! Seasonal initialization - run once per season
!***********************************************************************
ELSEIF (DYNAMIC .EQ. SEASINIT) THEN
C-----------------------------------------------------------------------
C COMPUTE RESPIRATION COEFFICIENTS BASED ON PLANT COMPOSITION
C-----------------------------------------------------------------------
C
AGRLF = PLIPLF*RLIP + PLIGLF*RLIG + POALF*ROA
& + PMINLF*RMIN + PCARLF*RCH2O
AGRSTM = PLIPST*RLIP + PLIGST*RLIG + POAST*ROA
& + PMINST*RMIN + PCARST*RCH2O
AGRRT = PLIPRT*RLIP + PLIGRT*RLIG + POART*ROA
& + PMINRT*RMIN + PCARRT*RCH2O
AGRNOD = PLIPNO*RLIP + PLIGNO*RLIG + POANO*ROA
& + PMINNO*RMIN + PCARNO*RCH2O
!-----------------------------------------------------------------------
! AGRVG2, AGRSH2, AGRSD2 include protein component of vegetative
! growth cost
!-----------------------------------------------------------------------
AGRVG = AGRLF * FRLF + AGRRT * FRRT + AGRSTM * FRSTM
AGRVG2 = AGRVG + (FRLF*PROLFI+FRRT*PRORTI+FRSTM*PROSTI)*RNO3C
!-----------------------------------------------------------------------
AGRSH1 = PLIPSH*RLIP + PLIGSH*RLIG + POASH*ROA
& + PMINSH*RMIN + PCARSH*RCH2O
AGRSH2 = AGRSH1 + PROSHI*RNO3C
!-----------------------------------------------------------------------
SDPROR = (SDPRO - SDPROS) / ( SDLIP + PCARSD )
AGRSD1 = PMINSD*RMIN + PLIGSD*RLIG + POASD*ROA
& + (SDLIP*RLIP + PCARSD*RCH2O)*(1. - SDPROR)
AGRSD2 = AGRSD1 + SDPRO*RNO3C
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!-----------------------------------------------------------------------
RETURN
END ! SUBROUTINE INCOMP
!=======================================================================
!-----------------------------------------------------------------------
! Variable definitions
!-----------------------------------------------------------------------
! AGRLF Mass of CH2O required for new leaf growth
! AGRNOD CH2O requirement for nodule growth
! AGRRT Mass of CH2O required for new root growth
! AGRSD1 CH2O requirement for seed growth, excluding cost for protein
! content
! AGRSD2 CH2O requirement for seed growth, including cost for protein
! content
! AGRSH1 CH2O required for shell growth, excluding cost for protein
! content
! AGRSH2 CH2O requirement for shell growth, including cost for protein
! content
! 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
! 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
! PCARNO Proportion of nodule tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PCARRT Proportion of root tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PCARSD Proportion of seed tissue that is carbohydrate
! (g[CH2O] / g[seed])","IPGROW, INCOMP, IPPLNT
! PCARSH Proportion of shell tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP, IPPLNT
! PCARST Proportion of stem tissue that is carbohydrate
! (fraction)","IPGROW, INCOMP
! PLIGLF Proportion of leaf tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIGNO Proportion of nodule tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIGRT Proportion of root tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIGSD Proportion of seed tissue that is lignin
! (fraction)","IPPLNT, IPDMND, PODCOMP, IPGROW, INC
! PLIGSH Proportion of shell tissue that is lignin
! (fraction)","IPPLNT, IPGROW, INCOMP
! PLIGST Proportion of stem tissue that is lignin
! (fraction)","IPGROW, INCOMP
! PLIPLF Proportion of leaf tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PLIPNO Proportion of nodule tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PLIPRT Proportion of root tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PLIPSH Proportion of shell tissue that is lipid
! (fraction)","IPPLNT, IPGROW, INCOMP
! PLIPST Proportion of stem tissue that is lipid
! (fraction)","IPGROW, INCOMP
! PMINLF Proportion of leaf tissue that is mineral
! (fraction)","IPGROW, INCOMP
! PMINNO Proportion of nodule tissue that is mineral
! (fraction)","IPGROW, INCOMP
! PMINRT Proportion of root tissue that is mineral
! (fraction)","IPGROW, INCOMP
! PMINSD Proportion of seed tissue that is mineral
! (fraction)","IPPLNT, IPDMND, PODCOMP, IPGROW, INC
! PMINSH Proportion of shell tissue that is mineral
! (fraction)","IPPLNT, 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
! POANO Proportion of nodule tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! POART Proportion of root tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! POASD Proportion of seed tissue that is organic acid
! (fraction)","IPPLNT, IPDMND, PODCOMP, IPGROW, INC
! POASH Proportion of shell tissue that is organic acid
! (fraction)","IPPLNT, IPGROW, INCOMP
! POAST Proportion of stem tissue that is organic acid
! (fraction)","IPGROW, INCOMP
! 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,
! PROSHI Maximum protein composition in shells during growth with
! luxurious supply of N
! ( g[protein] / g[shell tissue])","PODS, IPPLNT, I
! 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
! SDLIP Maximum lipid composition in seed
! (fraction)","IPDMND, IPGROW, INCOMP
! SDPRO Seed protein fraction at 25oC
! (g[protein] / g[seed])","IPDMND, IPGROW, INCOMP
! SDPROR Ratio to adjust lipid and carbohydrate proportions when seed
! protein differs from protein composition of standard cultivar
! (SDPROS)
! SDPROS Seed protein fraction of standard cultivar at 25oC
! (g[protein] / g[seed])","INCOMP
!-----------------------------------------------------------------------
! END SUBROUTINE INCOMP
!=======================================================================