-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathIPIBS.for
371 lines (332 loc) · 14.7 KB
/
IPIBS.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
362
363
364
365
366
367
368
369
370
C=======================================================================
C IPIBS, Subroutine, G. Hoogenboom
C-----------------------------------------------------------------------
C Reads input variables for temporary data file for transfer of
C information from the INPUT module to the CROPGRO module.
C-----------------------------------------------------------------------
C REVISION HISTORY
C 05/01/1989 GH Written.
C 01/08/1997 GH Modified for Chickpea
C 12/02/1997 CHP Modified for modularization of soil water routines.
C 01/21/1997 GH Added MESOM, correction for residue code
C 02/25/1998 CHP Modified for modularization of pest routines.
C 11/30/1998 CHP Added RUNINIT and SEASINIT sections. Data is read from files only
C once per simulation, but IPIBS is called for initialization
C calculations once per season
C 03/17/2000 GH Incorporated in CROPGRO
C 06/12/2001 CHP Added check for MESOM
C 11/05/2001 GH Removed reading of time variables for simulation control
C 08/12/2003 CHP Added I/O error checking
C 10/08/2004 CHP Added GetPut_Iswitch call to push switch information
C into constructed variable which is accessible to
C all modules.
C 06/14/2005 CHP Added read for MESIC variable for sequenced runs.
! 08/28/2006 CHP Added MESEV - option for new soil evaporation routine
! from SALUS
! 01/11/2007 CHP Changed GETPUT calls to GET and PUT
! 02/05/2007 CHP Reverse location of MESEV and METMP in FILEX
! 04/28/2008 CHP Added switch for CO2 from file (ICO2)
! 05/20/2008 CHP Changed method codes to trigger experimental routines:
! MEINF = 'R', Ritchie runoff, with mulch effects
! MEINF = 'S', SCS - same as Ritchie method
! MEINF = 'N', SCS - no much effects modeled
! MEINF = 'M', Mulch effects modelled.
! 12/09/2008 CHP Remove METMP
! 10/02/2009 CHP Removed some checks that are also done in IPEXP
C========================================================================
SUBROUTINE IPIBS (CONTROL, ISWITCH,
& CROP, IDETS, MODEL) !Output
C-----------------------------------------------------------------------
C
C*** EXPERIMENT AND TREATMENT SELECTION.
C
C-----------------------------------------------------------------------
USE ModuleDefs
USE ModuleData
IMPLICIT NONE
SAVE
CHARACTER*1 IDETC, IDETD, IDETG, IDETH, IDETL, IDETN, IDETO
CHARACTER*1 IDETP, IDETR, IDETS, IDETW
CHARACTER*1 IFERI, IRESI, IHARI
CHARACTER*1 IIRRI, IOX, IPLTI
CHARACTER*1 ISIMI
CHARACTER*1 ISWWAT, ISWNIT, ISWCHE, ISWTIL, ICO2
CHARACTER*1 ISWSYM, ISWPHO, ISWPOT, ISWDIS
CHARACTER*1 MEEVP, MEHYD, MEINF, MEPHO, MESIC
CHARACTER*1 MESOL, MESOM, MESEV, METMP
CHARACTER*1 UPCASE, RNMODE
CHARACTER*2 CROP
CHARACTER*6 ERRKEY, SECTION
PARAMETER (ERRKEY = 'IPIBS ')
CHARACTER*8 FNAME, MODEL
CHARACTER*12 FILEX, FILEA, FILEC
CHARACTER*30 FILEIO
! CHARACTER*78 MESSAGE(10)
CHARACTER*80 PATHCR,PATHEX
INTEGER FROP, ISENS, NSWI
INTEGER LUNIO, LINC, LNUM, FOUND
INTEGER ERRNUM, RUN, N_ELEMS
C The variable "CONTROL" is of type "ControlType".
TYPE (ControlType) CONTROL
C The variable "ISWITCH" is of type "SwitchType".
TYPE (SwitchType) ISWITCH
C Transfer values from constructed data types into local variables.
FILEIO = CONTROL % FILEIO
RUN = CONTROL % RUN
RNMODE = CONTROL % RNMODE
C-----------------------------------------------------------------------
C Open Temporary File
C-----------------------------------------------------------------------
CALL GETLUN('FILEIO', LUNIO)
OPEN (LUNIO, FILE = FILEIO, STATUS = 'OLD', IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,0)
C-----------------------------------------------------------------------
C Read FILE names and paths
C-----------------------------------------------------------------------
READ (LUNIO,'(55X,I5)', IOSTAT=ERRNUM) ISENS
LNUM = 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(/,15X,A8)', IOSTAT=ERRNUM) MODEL
LNUM = LNUM + 2
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
! FILEX used to determine output file names when FNAME <> 'OVERVIEW'
READ (LUNIO,'(15X,A12)', IOSTAT=ERRNUM) FILEX
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(15X,A12,1X,A80)', IOSTAT=ERRNUM) FILEA,PATHEX
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(/,15X,A12,1X,A80)', IOSTAT=ERRNUM) FILEC, PATHCR
LNUM = LNUM + 2
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
!-------------------------------------------------------------------------
! Can by-pass this section unless in debug model
IF (INDEX(RNMODE, 'D') > 0) THEN
! For sequenced runs, only read values for RUN 1
IF (INDEX('QF',RNMODE) .LE. 0 .OR. RUN .EQ. 1) THEN
READ (LUNIO,'(5(/),15X,A8)', IOSTAT=ERRNUM) FNAME
LNUM = LNUM + 6
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
C-----------------------------------------------------------------------
C Read Simulation Control
C-----------------------------------------------------------------------
READ (LUNIO,'(/,31X,A1,41X,A5)',IOSTAT=ERRNUM) ISIMI
READ (LUNIO,'(14X,9(5X,A1),2I6)', IOSTAT=ERRNUM)
& ISWWAT, ISWNIT, ISWSYM, ISWPHO, ISWPOT, ISWDIS, ISWCHE,
& ISWTIL, ICO2
LNUM = LNUM + 3
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
ISWWAT = UPCASE(ISWWAT)
ISWNIT = UPCASE(ISWNIT)
ISWSYM = UPCASE(ISWSYM)
ISWPHO = UPCASE(ISWPHO)
ISWPOT = UPCASE(ISWPOT)
ISWDIS = UPCASE(ISWDIS)
ISWCHE = UPCASE(ISWCHE)
ISWTIL = UPCASE(ISWTIL)
ICO2 = UPCASE(ICO2)
READ (LUNIO,200, IOSTAT=ERRNUM) MESIC, MEEVP, MEINF, MEPHO,
& MEHYD, NSWI, MESOM, MESEV, MESOL, METMP
200 FORMAT(25X,A1,11X,A1,3(5X,A1),5X,I1,4(5X,A1))
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(14X,5(5X,A1))', IOSTAT=ERRNUM)
& IPLTI, IIRRI, IFERI, IRESI, IHARI
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,250,IOSTAT=ERRNUM)
& IOX, IDETO, IDETS, FROP, IDETG, IDETC, IDETW,
& IDETN, IDETP, IDETD, IDETL, IDETH, IDETR
250 FORMAT(14X,3(5X,A1),4X,I2,9(5X,A1))
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
IF (FROP .LE. 0) FROP = 1
ELSE !For sequenced runs, read only selected variables
READ (LUNIO,'(8(/),31X,A1,17X,A1)',IOSTAT=ERRNUM)ISWSYM,ISWDIS
LNUM = LNUM + 9
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
ISWSYM = UPCASE(ISWSYM)
ISWDIS = UPCASE(ISWDIS)
READ (LUNIO,'(25X,A1,23X, A1)', IOSTAT=ERRNUM) MESIC,MEPHO
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(14X,5(5X,A1))', IOSTAT=ERRNUM)
& IPLTI, IIRRI, IFERI, IRESI, IHARI
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
ENDIF
ELSE
MEEVP = ISWITCH % MEEVP
MEPHO = ISWITCH % MEPHO
ISWWAT = ISWITCH % ISWWAT
ISWNIT = ISWITCH % ISWNIT
ISWPHO = ISWITCH % ISWPHO
NSWI = ISWITCH % NSWI
IDETS = ISWITCH % IDETS
ENDIF
!-------------------------------------------------------------------------
C-----------------------------------------------------------------------
C Read Cultivar Section
C-----------------------------------------------------------------------
!Read crop code from Cultivar Section
SECTION = '*CULTI'
CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILEIO, LNUM)
ELSE
READ (LUNIO,'(3X,A2)', IOSTAT=ERRNUM) CROP ; LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
ENDIF
C-----------------------------------------------------------------------
CLOSE (LUNIO)
!-------------------------------------------------------------------
! Determine how many elements are to be simulated (i.e., N, P, K)
IF (ISWWAT == 'Y') THEN
IF (ISWNIT == 'Y') THEN
IF (ISWPHO == 'Y' .OR. ISWPHO == 'H') THEN
! Water, N & P will be modelled.
N_ELEMS = 2
ELSE
! Water & N modelled, P not modelled.
N_ELEMS = 1
ENDIF
ELSE
! Water modelled, but neither N nor P.
NSWI = 0
ISWPHO = 'N'
N_ELEMS = 0
ENDIF
ELSE
! No simulation of water, N or P.
NSWI = 0
ISWNIT = 'N'
ISWPHO = 'N'
N_ELEMS = 0
ENDIF
IF (ISWWAT .EQ. 'N' .OR. ISWNIT .EQ. 'N') THEN
NSWI = 0
ENDIF
!-------------------------------------------------------------------
! Values read or modified here.
CONTROL % CROP = CROP
CONTROL % DAS = 0
CONTROL % LUNIO = LUNIO
CONTROL % N_ELEMS = N_ELEMS
ISWITCH % MEEVP = MEEVP
ISWITCH % MEPHO = MEPHO
ISWITCH % ISWWAT = ISWWAT
ISWITCH % ISWNIT = ISWNIT
ISWITCH % ISWPHO = ISWPHO
ISWITCH % NSWI = NSWI
!-------------------------------------------------------------------------
! Can by-pass this section unless in debug model
IF (INDEX(RNMODE, 'D') > 0) THEN
! Transfer values from local variables into constructed data types.
CONTROL % FROP = FROP
CONTROL % MESIC = MESIC
CONTROL % MODEL = MODEL
ISWITCH % IDETC = IDETC
ISWITCH % IDETD = IDETD
ISWITCH % IDETG = IDETG
ISWITCH % IDETL = IDETL
ISWITCH % IDETN = IDETN
ISWITCH % IDETO = IDETO
ISWITCH % IDETS = IDETS
ISWITCH % IDETW = IDETW
ISWITCH % IHARI = IHARI
ISWITCH % ISIMI = ISIMI
ISWITCH % ISWDIS = ISWDIS
ISWITCH % ISWSYM = ISWSYM
ISWITCH % ISWPOT = ISWPOT
ISWITCH % ISWCHE = ISWCHE
ISWITCH % ISWTIL = ISWTIL
ISWITCH % ICO2 = ICO2
ISWITCH % MEHYD = MEHYD
ISWITCH % MEINF = MEINF
ISWITCH % MESOL = MESOL
ISWITCH % MESOM = MESOM
ISWITCH % METMP = METMP
ISWITCH % MESEV = MESEV
ISWITCH % IPLTI = IPLTI
ISWITCH % IIRRI = IIRRI
ISWITCH % IFERI = IFERI
ISWITCH % IRESI = IRESI
ISWITCH % IDETP = IDETP
ISWITCH % IDETH = IDETH
ISWITCH % IDETR = IDETR
ENDIF
!-------------------------------------------------------------------------
CALL PUT(CONTROL)
CALL PUT(ISWITCH)
RETURN
END SUBROUTINE IPIBS
!=======================================================================
! Variable definitions for IPIBS
!=======================================================================
! CROP Crop identification code
! ERRKEY Subroutine name for error file
! ERRNUM Error number for input
! FILEA Input file which contains observed data for comparison with
! simulated results, corresponding to FILEX (e.g., UFGA7801.SBA)
! FILEC Filename for SPE file (e.g., SBGRO980.SPE)
! FILEIO Filename for input file (e.g., IBSNAT35.INP)
! FILEX Experiment file, e.g., UFGA7801.SBX
! FNAME Output file name, usually 'OVERVIEW'
! FOUND Indicator that good data was read from file by subroutine FIND
! (0 - End-of-file encountered, 1 - NAME was found)
! FROP Frequency of output days
! IDETC Code to generate OUTC file (e.g., SoilC.OUT), Y or N
! IDETH Code to generate OUTH file (e.g., CHEMICAL.OUT), Y or N
! IDETL Switch for detailed printout (Y or N)
! IDETN Code to generate OUTN file (e.g., SoilN.OUT), Y or N
! IDETO Switch for printing OVERVIEW.OUT file
! IDETP Code to generate OUTP file (e.g., SoilP.OUT), Y or N
! IDETR Code to generate OUTR file (e.g., OPERAT.OUT), Y or N
! IDETS Code to generate OUTR, OUTS and OUTE files (OPERAT.OUT,
! SUMMARY.OUT and ENVIRON.OUT)
! IHARI Harvest type code: M=at harvest maturity, R=on specified day of
! year (HDATE), D= on specified day after planting (HDATE), G=
! at specified growth stage (HSTG), A= within specified window
! when SW conditions are met
! IIRRI Irrigation switch R=on reported dates, D=as reported, days after
! planting, A=automatic, when required., F=automatic w/ fixed
! amt, P=as reported thru last reported day then automatic, W=as
! reported thru last reported day then fixed amount, N=not
! irrigated
! ISENS
! ISWCHE Switch for observed chemical applications
! ISWNIT Nitrogen simulation switch (Y or N)
! ISWTIL Switch for observed tillage application
! ISWWAT Water simulation control switch (Y or N)
! LNUM Line number of input file
! LUNIO Logical unit number for FILEIO
! MEEVP Method of evapotranspiration (P=Penman, R=Priestly-Taylor,
! Z=Zonal)
! MEPHO Method for photosynthesis computation ('C'=Canopy or daily,
! 'L'=hedgerow or hourly)
! MESIC Code for sequenced runs: 'S'=second or subsequent run in
! sequenced simulation, 'M'=single run or first run of sequenced
! simulation.
! MESOM Method for soil N computations ('G'=Godwin or Ceres-based,
! 'P'=Parton or Century-based (future))
! MODEL Name of CROPGRO executable file
! NCHEM Number of chemical applications
! NHAR Number harvest dates read
! NREP Report number for sequenced or multi-season runs
! NTIL Number tillage applications read
! PATHCR Pathname for SPE file or FILEE.
! PLME Planting method; T = transplant, S = seed, P = pre-germinated
! seed, N = nursery
! SECTION Section name in input file
! TDATE(I) Observed date for Ith tillage application
! TDEP(I) Depth for Ith tillage application
! TIMPL(I) Method for Ith tillage application
! VARNO Variety number
! VRNAME Variety name
! YEAR Year of current date of simulation
! YR Year portion of date
! YR_DOY Function subroutine converts date in YYDDD format to integer
! year (YY) and day (DDD).
! YRPLT Planting date (YYDDD)
! YRSIM Start of simulation date (YYDDD)
!=======================================================================