-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathAUTHAR.for
427 lines (371 loc) · 16.2 KB
/
AUTHAR.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
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
C=======================================================================
C AUTHAR, Subroutine
C-----------------------------------------------------------------------
C Determines when automatic harvest occurs
C-----------------------------------------------------------------------
C REVISION HISTORY
C 09/01/1991 WTB Written
C 12/31/1996 GH Delete stop condition; set last window
C 12/01/1999 CHP Modular format.
C 07/01/2000 GH Incorporated in CROPGRO
C 03/19/2001 GH Corrected YREND initialization
C 04/17/2002 GH Modified for sequence analysis
C 08/01/2002 CHP Merged RUNINIT and SEASINIT into INIT section
C 08/20/2002 GH Modified for Y2K
! 12/16/2004 CHP Added defaults for HPC and HBPC
C=======================================================================
SUBROUTINE AUTHAR(CONTROL, ISWWAT,
& DLAYR, DUL, IDETO, IHARI, LL, STGDOY, !Input
& SW, MDATE, YRPLT, !Input
& YREND, HARVFRAC, HDATE, NHAR) !Output
!-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
SAVE
CHARACTER*1 IHARI, IDETO, ISWWAT, RNMODE
CHARACTER*6, PARAMETER :: ERRKEY = 'AUTHAR'
CHARACTER*78 MESSAGE(10) !Up to 10 lines of text to be output
INTEGER YREND, HDLAY, HEARLY, HLATE, I
INTEGER NHAR, YR, IDATE, DEARLY, YREARLY
INTEGER MULTI, TIMDIF, YRPLT, YRDIF, YRSIM
INTEGER YRDOY, MDATE, DAP, NOUTDO
INTEGER DYNAMIC, RUN
INTEGER HDATE(3), HSTG(3)
INTEGER STGDOY(20)
REAL AVGSW, CUMSW, DTRY, SWPLTD
REAL SWPLTH, SWPLTL, XDEP, XDEPL
REAL HPC(3), HBPC(3)
REAL HARVFRAC(2)
REAL DLAYR(NL), DUL(NL), LL(NL), SW(NL)
! The variable "CONTROL" is of constructed type "ControlType" as
! defined in ModuleDefs.for, and contains the following variables.
! The components are copied into local variables for use here.
TYPE (ControlType) CONTROL
DYNAMIC = CONTROL % DYNAMIC
MULTI = CONTROL % MULTI
YRDOY = CONTROL % YRDOY
YRSIM = CONTROL % YRSIM
YRDIF = CONTROL % YRDIF
RNMODE = CONTROL % RNMODE
RUN = CONTROL % RUN
C***********************************************************************
C***********************************************************************
C Input and Initialization
C***********************************************************************
IF (DYNAMIC .EQ. INIT) THEN
C-----------------------------------------------------------------------
CALL IPAHAR(CONTROL,
& HPC, HBPC, HDATE, HDLAY, HLATE, HSTG, !Output
& NHAR, SWPLTL, SWPLTH, SWPLTD) !Output
CALL GETLUN('OUTO', NOUTDO)
MDATE = -99
C-----------------------------------------------------------------------
C Adjust for multi year runs
C-----------------------------------------------------------------------
IF (MULTI .GT. 1) THEN
IF (NHAR .GT. 0 .AND. IHARI .NE. 'D') THEN
DO I = 1, NHAR
CALL YR_DOY(HDATE(I), YR, IDATE)
HDATE(I) = (YR + MULTI - 1) * 1000 + IDATE
ENDDO
ENDIF
IF (IHARI .EQ. 'A') THEN
CALL YR_DOY(HLATE, YR, IDATE)
HLATE = (YR + MULTI - 1) * 1000 + IDATE
ENDIF
ENDIF
C-----------------------------------------------------------------------
C Adjust for crop rotations
C-----------------------------------------------------------------------
! IF (RNMODE .EQ. 'Q') THEN
IF (INDEX('FQ',RNMODE) > 0) THEN
IF (NHAR .GT. 0 .AND. HDATE(1) .LT. YRSIM .AND.
& IHARI .NE. 'D') THEN
DO I = 1, NHAR
CALL YR_DOY(HDATE(I), YR, IDATE)
HDATE(I) = (YR + YRDIF) * 1000 + IDATE
END DO
ENDIF
IF (IHARI .EQ. 'A' .AND. HLATE .LT. YRSIM) THEN
CALL YR_DOY(HLATE, YR, IDATE)
HLATE = (YR + YRDIF) * 1000 + IDATE
ENDIF
ENDIF
! 08/12/2003 chp moved to potato module
! IF (INDEX('PT',CROP) > 0) THEN
! MDATE = HDATE(1)
! ELSE
! MDATE = -99
! ENDIF
HARVFRAC(1) = HPC(1) / 100.
HARVFRAC(2) = HBPC(1) / 100.
C***********************************************************************
C***********************************************************************
C Daily integration
C***********************************************************************
ELSEIF (DYNAMIC .EQ. INTEGR) THEN
! YREND = -99
IF (YRDOY == YREND) RETURN
C-----------------------------------------------------------------------
C Harvest at maturity, NR8
C-----------------------------------------------------------------------
IF (IHARI .EQ. 'M') THEN
YREND = MDATE
C-----------------------------------------------------------------------
C Harvest on specified day of year, HDATE
C-----------------------------------------------------------------------
ELSE IF (IHARI .EQ. 'R') THEN
IF (YRDOY .GE. HDATE(1)) THEN
C-GH IF (YRDOY .GE. HDATE(1) .OR. MDATE .EQ. YRDOY) THEN
YREND = YRDOY
ENDIF
C-----------------------------------------------------------------------
C Harvest on specified day after planting, HDATE
C-----------------------------------------------------------------------
ELSE IF (IHARI .EQ. 'D') THEN
DAP = MAX(0,TIMDIF(YRPLT,YRDOY))
IF (DAP .GE. HDATE(1)) THEN
C-GH IF (DAP .GE. HDATE(1) .OR. MDATE .EQ. YRDOY) THEN
YREND = YRDOY
ENDIF
C-----------------------------------------------------------------------
C Harvest at specified growth stage, HSTG
C-----------------------------------------------------------------------
ELSE IF (IHARI .EQ. 'G') THEN
DO I = 1, 13
IF (HSTG(1) .EQ. I .AND. YRDOY .EQ. STGDOY(I)) THEN
YREND = YRDOY
RETURN
ENDIF
END DO
C-----------------------------------------------------------------------
C Harvest within specified window if conditions are met
C-----------------------------------------------------------------------
ELSE IF (IHARI .EQ. 'A') THEN
! Havest maturity not reached yet.
IF (YRDOY .LT. MDATE .OR. MDATE .EQ. -99) THEN
RETURN
! Harvest maturity reached today. Set earliest harvest day.
ELSE IF (YRDOY .EQ. MDATE) THEN
HEARLY = YRDOY + HDLAY
! Past harvest maturity.
ELSE IF (YRDOY .GT. MDATE) THEN
C Check window for automatic harvest, HEARLY < YRDOY < HLATE
IF (YRDOY .LT. HEARLY) RETURN !too early
! Too late for harvest. Print error message to screen and to
! Overview.OUT and Warning.OUT files.
IF (YRDOY .GT. HLATE) THEN
CALL YR_DOY(HEARLY, YREARLY, DEARLY)
CALL YR_DOY(HLATE, YR, IDATE)
!Warning.out
WRITE(MESSAGE(1), 110)
WRITE(MESSAGE(2), 115) YREARLY,DEARLY,YR,IDATE
CALL WARNING(2, ERRKEY, MESSAGE)
!Screen
WRITE (*,120) MESSAGE(1), MESSAGE(2)
!Overview.out
IF (IDETO .EQ. 'Y') THEN
WRITE(NOUTDO,120) MESSAGE(1), MESSAGE(2)
ENDIF
110 FORMAT('Conditions not met during defined window for harvesting')
115 FORMAT('between DAY ',I4,1X,I3,' and DAY ',I4,1X,I3)
120 FORMAT(/,5X,A78,/,5X,A78,/)
C Assume harvest to occur on the first day after the defined
C window to terminate the simulation. This needs to be changed
C to account for harvest loss of the crop;
YREND = YRDOY
! STGDOY(16) = YRDOY
RETURN
ENDIF
! Today is within harvest window.
IF (ISWWAT .EQ. 'Y') THEN
C Compute average soil moisture as percent, AVGSW***
I = 1
XDEP = 0.0
CUMSW = 0.0
20 IF (XDEP .LT. SWPLTD) THEN
XDEPL = XDEP
XDEP = XDEP + DLAYR(I)
DTRY = MIN(DLAYR(I),SWPLTD - XDEPL)
CUMSW = CUMSW + DTRY *
& (MAX(SW(I) - LL(I),0.0)) / (DUL(I) - LL(I))
I = I + 1
GO TO 20
ENDIF
AVGSW = (CUMSW / SWPLTD) * 100.0
IF (AVGSW .GE. SWPLTL .AND. AVGSW .LE. SWPLTH) THEN
YREND = YRDOY
! STGDOY(16) = YRDOY
ENDIF
ELSE
!Soil water not being simulated - conditions assumed OK
YREND = YRDOY
ENDIF
ENDIF
C-----------------------------------------------------------------------
C Error message if an incorrect code has been specified
C-----------------------------------------------------------------------
ELSE
! Invalid harvest code
CALL ERROR(ERRKEY,10,' ',0)
ENDIF
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!***********************************************************************
RETURN
END SUBROUTINE AUTHAR
C=======================================================================
C IPAHAR, Subroutine, C. Porter
C-----------------------------------------------------------------------
C Reads input variables from temporary data file for use by automatic
! harvest routine (AUTHAR)
C-----------------------------------------------------------------------
C REVISION HISTORY
C 11/23/1999 CHP Written for modular version of AUTHAR.
C 08/20/2002 GH Modified for Y2K
C 08/12/2003 CHP Added error checking
C========================================================================
SUBROUTINE IPAHAR(CONTROL,
& HPC, HBPC, HDATE, HDLAY, HLATE, HSTG, !Output
& NHAR, SWPLTL, SWPLTH, SWPLTD) !Output
C-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
CHARACTER*5 HCOM(3), HSIZ(3)
CHARACTER*6 SECTION, ERRKEY
PARAMETER (ERRKEY = 'IPAHAR')
CHARACTER*30 FILEIO
CHARACTER*90 CHAR
INTEGER ERRNUM
INTEGER HDLAY, HLATE, I, NHAR, HDATE(3), HSTG(3)
INTEGER LINC, LNUM, FOUND
INTEGER LUNIO
REAL HPP, HRP, SWPLTL, SWPLTH, SWPLTD
REAL HPC(3), HBPC(3)
! The variable "CONTROL" is of constructed type "ControlType" as
! defined in ModuleDefs.for, and contains the following variables.
! The components are copied into local variables for use here.
TYPE (ControlType) CONTROL
FILEIO = CONTROL % FILEIO
LUNIO = CONTROL % LUNIO
C-----------------------------------------------------------------------
C Open Temporary File
C-----------------------------------------------------------------------
OPEN (LUNIO, FILE = FILEIO, STATUS = 'OLD', IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,0)
LNUM = 0
C-----------------------------------------------------------------------
C Read Automatic Management
C-----------------------------------------------------------------------
SECTION = '!AUTOM'
CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILEIO, LNUM)
ELSE
READ(LUNIO,'(30X,3(1X,F5.0))',IOSTAT=ERRNUM)
& SWPLTL, SWPLTH, SWPLTD
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
READ (LUNIO,'(///,14X,2(1X,I7),5(1X,F5.0))', IOSTAT=ERRNUM)
& HDLAY, HLATE, HPP, HRP
LNUM = LNUM + 4
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
ENDIF
C-----------------------------------------------------------------------
C Read Harvest Section
C-----------------------------------------------------------------------
SECTION = '*HARVE'
CALL FIND(LUNIO, SECTION, LINC, FOUND); LNUM = LNUM + LINC
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILEIO, LNUM)
ELSE
NHAR = 0
DO I = 1,3
READ(LUNIO,'(3X,I7,4X,A90)',ERR=4102,END=4102) HDATE(I), CHAR
LNUM = LNUM + 1
READ(CHAR,4100,IOSTAT=ERRNUM)
& HSTG(I), HCOM(I), HSIZ(I), HPC(I), HBPC(I)
4100 FORMAT(I2,2(1X,A5),2(1X,F5.0))
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
NHAR = NHAR + 1
ENDDO
4102 CONTINUE
ENDIF
CLOSE (LUNIO)
!Harvest Initialization Section
IF (NHAR .EQ. 0) THEN
HPC(1) = HPP
HBPC(1) = HRP
ENDIF
IF (HPC(1) < 0.) HPC(1) = 100. !Percent product harvested
IF (HBPC(1) < 0.) HBPC(1) = 0. !Percent by-product harvested
RETURN
END !SUBROUTINE IPAHAR
!=======================================================================
! AUTHAR and IPAHAR Variable Definitions
!=======================================================================
! AVGSW Average soil moisture as percent of depth SWPLTD; Also, in
! WDCONT, average volumetric soil water in top 30 cm.
! (%; cm3/cm3 for WDCONT))
! CUMSW Cumulative soil moisture to depth of SWPLTD, calculated as
! fraction of moisture content between lower limit and drained
! upper limit multiplied by layer depth. (cm)
! DAP Number of days after planting (d)
! DLAYR(L) Soil thickness in layer L (cm)
! DS(L) Cumulative depth in soil layer L (cm)
! DTRY Effective depth of current soil layer (cm)
! DUL(L) Volumetric soil water content at Drained Upper Limit in soil
! layer L (cm3[water]/cm3[soil])
! ERRKEY Subroutine name for error file
! ERRNUM Error number for input
! FILEIO Filename for input file (e.g., IBSNAT35.INP)
! FOUND Indicator that good data was read from file by subroutine FIND
! (0 - End-of-file encountered, 1 - NAME was found)
! YREND Computed harvest date (YYDDD)
! HDATE(I) Harvest dates (normally only the first is used) (YYDDD)
! HDLAY Earliest day after harvest maturity (R8) for harvest window
! (da)
! HEARLY First day of harvest window (YYDDD)
! HLATE Latest day of the year to harvest; last day of window (YYDDD)
! HSTG Growth stage which triggers automatic harvesting for IHARI='G'
! IDATE Day of irrigation or fertilizer application (d)
! LNUM Line number of input file
! LL(L) Volumetric soil water content in soil layer L at lower limit
! (cm3 [water] / cm3 [soil])
! LUNIO Logical unit number for FILEIO
! MULTI Current simulation year (=1 for first or single simulation,
! =NYRS for last seasonal simulation)
! NHAR Number harvest dates read
! NL Maximum number of soil layers
! NOUTDO Logical unit for OVERVIEW.OUT file
! SECTION Section name in input file
! STGDOY(I) Day when stage I occurred (YYDDD)
! SW(L) Volumetric soil water content in layer L
! (cm3 [water] / cm3 [soil])
! SWPLTD Depth to which average soil moisture is determined for
! automatic planting and harvest conditions (cm)
! SWPLTH Upper limit on soil moisture for automatic planting and harvest
! conditions (%)
! SWPLTL Lower limit on soil moisture for automatic planting and harvest
! conditions (%)
! TIMDIF Integer function which calculates the number of days between
! two Julian dates (da)
! XDEP Depth to bottom of current soil layer (cm)
! XDEPL Depth to top of current soil layer (cm)
! YR Year portion of date
! YR_DOY Function subroutine converts date in YYDDD format to integer
! year (YY) and day (DDD).
! YRDIF Function subroutine which calculates number of days between two
! dates (da)
! YRDOY Current day of simulation (YYDDD)
! YRNR8 Date of harvest maturity (YYDDD)
! MDATE Date of harvest maturity (YYDDD)
! YRPLT Planting date (YYDDD)
!=======================================================================