-
Notifications
You must be signed in to change notification settings - Fork 1
/
IPSOIL.FOR
348 lines (314 loc) · 13.7 KB
/
IPSOIL.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
C=======================================================================
C IPSOIL, Subroutine
C
C Read soil parameters from RESCH045.SDA
C-----------------------------------------------------------------------
C Revision history
C 06/15/1994 PWW Written
C 02/07/1993 PWW Header revision and minor changes
C 02/07/1993 PWW Added switch common block, restructured
C 06/09/1999 CHP Modular format
C 03/16/2000 GH Incorporated in CROPGRO
C Note, file name should be dynamically created based on
C model name
C 03/26/2003 GH Modified file name and location (SOL directory)
C 08/12/2003 CHP Added I/O error checking
C 08/22/2003 CHP Changed to read file once only and save arrays of data.
C 03/07/2006 CHP Added AM, RCP. Made output arguments optional
! 04/13/2006 CHP Revised format for input file. Most arguments are
! no longer needed, but defaults will be provided
! rather than values read from file. Note that the
! values which were previously included in the file
! were the same for each residue, so this will not
! change results from previous runs.
! 06/28/2007 CHP Added AM, WATFAC to SOILN045.SOL file
! 10/25/2007 CHP/GH Changed name of residue characteristics file to
! RESCH045.SDA
! 04/30/2008 CHP Changed units for SCN, SCP, RCN, RCP to %
! 04/30/2008 CHP Path for SDA files set in DSSATPRO file
! 06/25/2008 CHP Changed units for AM from ha/kg to cm2/g
! WATFAC from mm-ha/kg to kg[H2O]/kg[DM]
! Added EXTFAC - Light extinction coef. for mulch
! Check for file version number, use defaults if wrong
C-----------------------------------------------------------------------
C Called : CROPGRO
C=======================================================================
SUBROUTINE IPSOIL (CONTROL, RESTYPE, CROP, !Input
& AM, DMINR, DSNC, EXTFAC, PRCEL, PRCHO, !Output
& PRLIG, PSLIG, RCN, RCP, RDCEL, RDCHO, RDLIG, !Output
& SCN, SCP, WATFAC) !Output
C-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
SAVE
TYPE (ControlType), INTENT(IN) :: CONTROL
CHARACTER(len=5), INTENT(IN), OPTIONAL :: RESTYPE
CHARACTER(len=2), INTENT(IN), OPTIONAL :: CROP
REAL, INTENT(OUT), OPTIONAL :: PRLIG, PSLIG, RCN, RCP, SCN, SCP
REAL, INTENT(OUT), OPTIONAL :: AM, DMINR, DSNC, EXTFAC, PRCEL
REAL, INTENT(OUT), OPTIONAL :: PRCHO, RDCEL, RDCHO, RDLIG, WATFAC
CHARACTER(len=1), PARAMETER :: BLANK = ' '
CHARACTER(len=6), PARAMETER :: ERRKEY = 'IPSOIL'
CHARACTER(len=9) VERSION_TXT
CHARACTER(len=12) FILESS, NAMEF
CHARACTER(len=30) FILEIO
CHARACTER(len=78) MSG(4)
CHARACTER(len=80) PATHSD
CHARACTER(len=92) SOILNF
CHARACTER(len=180) CHAR
INTEGER FOUND, ERR, ISECT, LUNSOL, LNUM
INTEGER I, J, JJ, LUNIO, NRES, PFLAG
INTEGER, PARAMETER :: NR=50 !Maximum # of residue types
! Keep default values for legacy variables
REAL ADMINR, ADSNC, APRCEL, APRCHO
REAL ARDCEL, ARDCHO, ARDLIG
! Saved values from file
CHARACTER*2, DIMENSION(NR) :: ACROP
CHARACTER*5, DIMENSION(NR) :: ARESTYPE
REAL, DIMENSION(NR) :: AAM, AEXTFAC, ARCN, ARCP, ASCN, ASCP
REAL, DIMENSION(NR) :: APRLIG, APSLIG, AWATFAC
LOGICAL FIRST, FEXIST, EROR
DATA FIRST /.TRUE./
C-----------------------------------------------------------------------
! On first call to routine, read file and save values in arrays for
! subsequent retrieval.
IF (FIRST) THEN
FIRST = .FALSE.
EROR = .FALSE.
! Assign default values
ARESTYPE='RE001'
AAM = 32.0 !Area covered / unit dry mass of res (cm2/g)
AWATFAC= 3.8 !Sat. water content of res. (kg[H2O]/kg[DM])
AEXTFAC= 0.80 !Light extinction coef. for mulch
APSLIG = 0.10 !Proportion of lignin is surface res. (%)
ASCN = 1.0 !N content of init surface residue (%)
ASCP = 0.1 !P content of init surface residue (%)
APRLIG = 0.10 !Proportion of lignin in root residue (%)
ARCN = 1.0 !N content of init root residue (%)
ARCP = 0.02 !P content of init root residue (%)
ADMINR = 8.3E-05
ADSNC = 20.0
ARDCHO = 0.2
ARDCEL = 0.05
ARDLIG = 0.0095
APRCHO = 0.20 !PRCHO, PRCEL, and PRLIG are proportions of
APRCEL = 0.70 !carbohydrate, cellulose and lignin in residue
APRLIG = 0.10 !and must sum to 1.0.
FILEIO = CONTROL % FILEIO
LUNIO = CONTROL % LUNIO
! FILESS = 'RESCH045.SDA'
FILESS = 'RESCH' // CONTROL % MODEL(6:8) // '.SDA'
SOILNF = FILESS
INQUIRE (FILE = SOILNF, EXIST = FEXIST)
IF (.NOT. FEXIST) THEN
CALL PATH('STD',CONTROL%DSSATP,PATHSD,PFLAG,NAMEF)
SOILNF = TRIM(PATHSD) // FILESS
ENDIF
INQUIRE (FILE=SOILNF, EXIST=FEXIST)
IF (FEXIST) THEN
C-----------------------------------------------------------------------
C Open the RESCH045.SDA file
C-----------------------------------------------------------------------
CALL GETLUN('FILESS', LUNSOL)
OPEN (LUNSOL,FILE = SOILNF, STATUS = 'OLD', IOSTAT=ERR)
IF (ERR .EQ. 0) THEN
CALL FIND2(LUNSOL,'@VERSION',LNUM,FOUND)
IF (FOUND == 0) THEN
! Version not found in file
EROR = .TRUE.
ERR = 50
GOTO 500
ELSE
! Read version number
CALL IGNORE(LUNSOL,LNUM,ISECT,CHAR)
READ(CHAR,'(A9)',IOSTAT=ERR) VERSION_TXT
IF (INDEX(VERSION_TXT,"4.5") < 1 .OR. ERR /= 0) THEN
! Version not found in file, or wrong version
EROR = .TRUE.
ERR = 50
GOTO 500
ENDIF
ENDIF
C-----------------------------------------------------------------------
C Read Soil Parameters from RESCH045.SDA
C-----------------------------------------------------------------------
I = 0; ISECT = 1
! EOF not portable. CHP 7/24/2007
! ReadLoop: DO WHILE (.NOT. EOF (LUNSOL))
ReadLoop: DO WHILE (ISECT > 0)
CALL IGNORE(LUNSOL,LNUM,ISECT,CHAR)
IF (ISECT == 0) EXIT ReadLoop
IF (CHAR(1:1) .EQ. '*' .OR. CHAR(1:1) .EQ. '@') THEN
CYCLE ReadLoop
ENDIF
I = I + 1
READ(CHAR,'(1X,A5,1X,A2,3F8.0,2(F8.0,2F6.0))',IOSTAT=ERR)
& ARESTYPE(I), ACROP(I), AAM(I), AWATFAC(I), AEXTFAC(I),
& APSLIG(I), ASCN(I), ASCP(I),
& APRLIG(I), ARCN(I), ARCP(I)
IF (ERR .NE. 0) THEN
I = I - 1
EROR = .TRUE.
ENDIF
ENDDO ReadLoop
ELSE
!File could not be opened
EROR = .TRUE.
ERR = 20
ENDIF
ELSE
!File does not exist
EROR = .TRUE.
ERR = 40
ENDIF
NRES = I
CONTINUE
CLOSE (LUNSOL)
C-----------------------------------------------------------------------
500 CONTINUE
! Re-assign default values to arrays if problems with reading file
IF (EROR) THEN
SELECT CASE(ERR)
CASE (20)
MSG(1) = 'Error opening file: '
CASE (40)
MSG(1) = 'File does not exist: '
CASE (50)
MSG(1) = 'Incorrect version for file:'
CASE DEFAULT
MSG(1) = 'Error reading file: '
END SELECT
MSG(2) = SOILNF(1:78)
MSG(3) = 'Default residue characteristics will be used.'
CALL WARNING(3,ERRKEY,MSG)
ENDIF
ENDIF !End of FIRST block
C-----------------------------------------------------------------------
! Assign values independant of restype (legacy values)
IF (PRESENT(DMINR)) DMINR = ADMINR
IF (PRESENT(DSNC )) DSNC = ADSNC
IF (PRESENT(RDCHO)) RDCHO = ARDCHO
IF (PRESENT(RDCEL)) RDCEL = ARDCEL
IF (PRESENT(RDLIG)) RDLIG = ARDLIG
IF (PRESENT(PRCHO)) PRCHO = APRCHO
IF (PRESENT(PRCEL)) PRCEL = APRCEL
! Get appropriate residue or crop type, if included
IF (PRESENT(RESTYPE) .OR. PRESENT(CROP)) THEN
RLoop: DO J = 1, NR
IF (PRESENT(RESTYPE)) THEN
IF (RESTYPE == ' ') THEN
JJ = 1
EXIT RLoop
ENDIF
IF (RESTYPE .EQ. ARESTYPE(J)) THEN
JJ = J
EXIT RLoop
ENDIF
ELSEIF (PRESENT(CROP)) THEN
IF (CROP == ' ') THEN
JJ = 1
EXIT RLoop
ENDIF
IF (CROP .EQ. ACROP(J)) THEN
JJ = J
EXIT RLoop
ENDIF
ENDIF
ENDDO RLoop
IF (J > NR) THEN
JJ = 1
IF (PRESENT(RESTYPE)) THEN
WRITE(MSG(1),"('Residue type: ',A5,' not valid.')") RESTYPE
MSG(2) = 'Default residue characteristics will be used.'
CALL WARNING(2,ERRKEY,MSG)
ENDIF
ENDIF
ELSE !Default to residue type 1
JJ = 1
ENDIF
IF (PRESENT(AM )) THEN
AM = AAM(JJ)
! Check for incorrect units
IF (AM < 0.01) THEN
AM = AM * 1.E5
MSG(1) = "Units of mulch aerial coverage appear to be wrong."
WRITE(MSG(2),'(A,F8.2,A)') "Value changed to ",AM," cm2/g"
MSG(3) = "May need to update file: "
MSG(4) = SOILNF(1:78)
CALL WARNING(4,ERRKEY,MSG)
ENDIF
ENDIF
IF (PRESENT(WATFAC)) THEN
WATFAC= AWATFAC(JJ)
! Check for incorrect units
IF (AM < 0.001) THEN
WATFAC = WATFAC * 1.E4
MSG(1) ="Units of mulch saturation factor appear to be wrong."
WRITE(MSG(2),'(A,F8.3,A)')
& "Value changed to ",WATFAC," kg[H2O]/KG[DM]"
MSG(3) = "May need to update file: "
MSG(4) = SOILNF(1:78)
CALL WARNING(4,ERRKEY,MSG)
ENDIF
ENDIF
IF (PRESENT(EXTFAC)) EXTFAC= AEXTFAC(JJ)
IF (PRESENT(PSLIG )) PSLIG = APSLIG(JJ)
IF (PRESENT(SCN )) SCN = ASCN (JJ)
IF (PRESENT(SCP )) SCP = ASCP (JJ)
IF (PRESENT(PRLIG )) PRLIG = APRLIG(JJ)
IF (PRESENT(RCN )) RCN = ARCN (JJ)
IF (PRESENT(RCP )) RCP = ARCP (JJ)
C-----------------------------------------------------------------------
RETURN
END SUBROUTINE IPSOIL
C=======================================================================
! IPSOIL and SCREATE Variables
!
! ACRO(I) List of variables names used in RESCH045.SDA file which contains
! coefficients needed for simulating the decomposition of soil
! organic matter and organic matter
! CHAR Contains the contents of last record read
! DMINR Maximum decomposition rate constant of stable organic matter
! (d-1)
! DSNC Depth to which C and N are integrated across all soil layers for
! output in CARBON.OUT (cm)
! ERR Error code for file operation
! FILESS Path plus filename for species file (*.spe)
! I Loop counter
! J Loop counter
! LUNSOL Logical unit number for RESCH045.SDA
! PRCEL Cellulose fraction of the residue (fraction)
! PRCHO Carbohydrate fraction of the residue (fraction)
! PRLIG Lignin fraction of the residue (fraction)
! RCN N content of initial root residue (%)
! RCP P content of initial root residue (%)
! SCN N content of initial shoot residue (%)
! SCP P content of initial shoot residue (%)
! RDCEL Maximum decomposition rate of cellulose (fraction / day)
! RDCHO Maximum decomposition rate of carbohydrates (fraction / day)
! RDLIG Maximum decomposition rate of lignin (fraction / day)
! RESTYPE Residue application method as sent from calling routine
! T(I) Text array with explanatory text of the RESCH045.SDA file
!=======================================================================
!=======================================================================
MODULE Interface_IpSoil
! Interface needed for optional arguments with IPSOIL
INTERFACE
SUBROUTINE IPSOIL (CONTROL, RESTYPE, CROP, !Input
& AM, DMINR, DSNC, EXTFAC, PRCEL, PRCHO, !Output
& PRLIG, PSLIG, RCN, RCP, RDCEL, RDCHO, RDLIG, !Output
& SCN, SCP, WATFAC) !Output
USE ModuleDefs
TYPE (ControlType), INTENT(IN) :: CONTROL
CHARACTER(len=5), INTENT(IN), OPTIONAL :: RESTYPE
CHARACTER(len=2), INTENT(IN), OPTIONAL :: CROP
REAL, INTENT(OUT), OPTIONAL :: AM, DMINR, DSNC, EXTFAC
REAL, INTENT(OUT), OPTIONAL :: PRCEL, PRCHO, PRLIG, PSLIG
REAL, INTENT(OUT), OPTIONAL :: RCN, RCP, RDCEL, RDCHO, RDLIG
REAL, INTENT(OUT), OPTIONAL :: SCN, SCP, WATFAC
END SUBROUTINE
END INTERFACE
END MODULE Interface_IpSoil
!=======================================================================