-
Notifications
You must be signed in to change notification settings - Fork 1
/
CSM.for
665 lines (601 loc) · 26.8 KB
/
CSM.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
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
C=======================================================================
C COPYRIGHT 1998-2010 The University of Georgia, Griffin, Georgia
C University of Florida, Gainesville, Florida
C Mississippi State University, Starkville, MS
C International Center for Soil Fertility and
C Agricultural Development, Muscle Shoals, Alabama
C University of Guelph, Guelph, Ontario
C USDA-ARS U.S Arid Land Agricultural Research Center
C ALL RIGHTS RESERVED
C=======================================================================
C=======================================================================
C
C CROPPING SYSTEM MODEL Version 4.5
C
C Decision Support System for Agrotechnology Transfer (DSSAT)
C
C July 2010 CSM Version 4.5
C
C Gerrit Hoogenboom, J.W. Jones, Cheryl Porter, K.J. Boote,
C
C Tony Hunt, Arjan Gijsman, Jon Lizaso
C
C Paul Wilkens, Upendra Singh, Jeff W. White, Bill Batchelor
C
C=======================================================================
C
C=======================================================================
C REVISION HISTORY
C 11/04/2001 GH Written.
C 12/12/2001 GH Rename to CSM and integrate with Land/CROPGRO routines
C 01/13/2002 CHP Add debug mode
C 02/02/2002 GH Revise driver for argument calls
C 04/20/2002 GH Revisions for sequence analysis
C 06/10/2002 GH Revisions for outputs of sequence analysis
C 06/11/2002 GH Modified for Y2K
C 07/22/2002 CHP Added calls to OPCLEAR and OPNAMES
C 11/25/2002 GH Upgrade to CSM Version 3.9, 020 for December Workshop
C 08/12/2003 CHP Added I/O error checking
C 03/31/2004 GH Upgrade to CSM Version 4.0, 040 for March 31 Release
C 09/03/2004 CHP Added GetPut_Control call to push control information
C into constructed variable which is accessible to
C all modules. Added TRTNUM to CONTROL variable.
C 11/23/2004 CHP Increased length of PATHX (path for executable) to 120.
C 02/08/2005 CHP Changed criteria for ending a sequence run.
C 06/14/2005 CHP Added FILEX to CONTROL variable, read FILEX from FILEIO
C 02/20/2006 GH Add RNMODE="G" option for GENCALC
! 01/11/2007 CHP Changed GETPUT calls to GET and PUT
! 01/12/2007 CHP Read trt number and rotation number for sequence mode
C=======================================================================
PROGRAM CSM
USE ModuleDefs
USE ModuleData
USE HeaderMod
IMPLICIT NONE
C-----------------------------------------------------------------------
CHARACTER*1 ANS,RNMODE,BLANK,UPCASE
CHARACTER*6 ERRKEY,FINDCH,TRNARG
CHARACTER*8 FNAME,DUMMY,MODELARG
CHARACTER*12 FILEX !,DSCSM,INPUT
CHARACTER*25 TITLET
CHARACTER*30 FILEB,FILEIO,FILEIOH
CHARACTER*78 MSG(10)
CHARACTER*80 PATHEX
CHARACTER*102 DSSATP
! CHARACTER*120 INPUTX
CHARACTER*120 FILECTL !12/11/08 control file includes path
CHARACTER*120 PATHX
CHARACTER*130 CHARTEST
INTEGER YRDOY,YRSIM,YRPLT,MDATE,YREND,YR,ISIM, YR0, ISIM0
INTEGER MULTI,NYRS,INCYD,YEAR,DOY,DAS,TIMDIF
INTEGER ERRNUM,LUNIO,TRTALL,TRTNUM,EXPNO,I,RUN
INTEGER YRSIM_SAVE, YRDIF, YRDOY_END !IP,IPX,
INTEGER LUNBIO,LINBIO,ISECT,IFIND,LN
INTEGER NREPS, REPNO,END_POS, ROTNUM, TRTREP, NARG
LOGICAL FEXIST, DONE
PARAMETER (ERRKEY = 'CSM ')
PARAMETER (BLANK = ' ')
C Define constructed variable types based on definitions in
C ModuleDefs.for.
C The variable "CONTROL" is of type "ControlType".
TYPE (ControlType) CONTROL
C The variable "ISWITCH" is of type "SwitchType".
TYPE (SwitchType) ISWITCH
C-----------------------------------------------------------------------
! Timer function
! Date / time variables
INTEGER DATE_TIME(8), LUNTIME
! date_time(1) The 4-digit year
! date_time(2) The month of the year
! date_time(3) The day of the month
! date_time(4) The time difference with respect to Coordinated Universal Time (UTC) in minutes
! date_time(5) The hour of the day (range 0 to 23) - local time
! date_time(6) The minutes of the hour (range 0 to 59) - local time
! date_time(7) The seconds of the minute (range 0 to 59) - local time
! date_time(8) The milliseconds of the second (range 0 to 999) - local time
REAL TIME0, TIME1, TIME2, TIMEE
REAL DELTA_TIME_RUN
C-----------------------------------------------------------------------
! Get initial time
CALL DATE_AND_TIME (VALUES=DATE_TIME)
! Convert time to seconds
TIME0 = DATE_TIME(7) !seconds
& + DATE_TIME(8) / 1000. !milliseconds
& + DATE_TIME(6) * 60. !minutes
& + DATE_TIME(5) * 3600. !hours
CALL GETLUN('TIMER',LUNTIME)
OPEN (UNIT=LUNTIME, FILE='TIMER.OUT', STATUS='REPLACE')
WRITE(LUNTIME,'(" RUN FILEX TRT START END",
& " DeltaT Treatment")')
C-----------------------------------------------------------------------
DONE = .FALSE.
YRDOY_END = 9999999
! OPSYS defined in ModuleDefs.
CALL SETOP()
!Delete existing output files
CALL OPCLEAR
CALL GETLUN('FILEIO', LUNIO)
FILEIO = 'DSSAT45.INP'
C-----------------------------------------------------------------------
C Get argument from runtime module to determine path of the EXE files
C-----------------------------------------------------------------------
CALL GETARG(0,PATHX) !,IPX
CALL GETARG(1,DUMMY) !,IP !DUMMY is (the first letter + spaces) of command argument in project setting
IF ((INDEX('ABCDEFGILNPQSTabcdefginlpqst',DUMMY(1:1)).GT. 0) .AND.
& (DUMMY(2:2) .EQ. BLANK))THEN
CALL GETARG(1,RNMODE) !,IP
NARG = 1
ELSEIF ((DUMMY(1:1) .NE. BLANK) .AND. (DUMMY(2:2) .EQ. BLANK))
& THEN
CALL ERROR (ERRKEY,4,DSSATPRO,0)
ELSE
CALL GETARG(1,MODELARG) !,IP
CALL GETARG(2,RNMODE) !,IP
NARG = 2
ENDIF
C-----------------------------------------------------------------------
C RNMODE:
C A - Run all treatments. User specifies fileX on the command
C line and the model runs all treatments
C B - Batch mode. User defines fileX and treatment numbers in
C Batch file
C C - Command line mode. Use input from the command line.
C D - Debug mode. Model skips input module and reads temp
C file from the command line
C E - Sensitivity analysis. User defines fileX and treatment
C number in Batch file
C F - Farm model. Use Batch file to define experiment
C G - Gencalc. Use Command line to define experiment and treatment
C I - Interactive mode. Use model interface for exp. & trtno.
C L - Gene based model (Locus). Use Batch file to define experiment
C N - Seasonal analysis. Use Batch file to define experiment and
C treatments
C P - Perennial. Use Batch file to define experiment and treatments.
C Q - Sequence analysis. Use Batch file to define experiment
C S - Spatial. Use Batch file to define experiment
C T - Gencalc. Use Batch file to define experiments and treatment
C-----------------------------------------------------------------------
RNMODE = UPCASE(RNMODE)
ROTNUM = 0
TRTNUM = 0
SELECT CASE(RNMODE)
! Read experiment file from command line -- run all treatments
CASE('A') !run All treatments
CALL GETARG(NARG+1,FILEX) !,IP !Experiment file
CALL GETARG(NARG+2,FILECTL) !,IP !Simulation control file name
! Read experiment file and treatment number from command line
CASE('C','G') !Command line, Gencalc
CALL GETARG(NARG+1,FILEX) !,IP !Experiment file
CALL GETARG(NARG+2,TRNARG) !,IP !Treatment number
CALL GETARG(NARG+3,FILECTL) !,IP !Simulation control file name
READ(TRNARG,'(I6)') TRTNUM
! Get experiment and treatment from batch file
CASE('B','N','Q','S','F','T','E','L','P')
! Batch, seasoNal, seQuence, Spatial,
! Farm, Gencalc(T), sEnsitivity, Locus
CALL GETARG(NARG+1,FILEB) !,IP !Batch file name
CALL GETARG(NARG+2,FILECTL) !,IP !Simulation control file name
! Debug mode -- bypass input module and read FILEIO
CASE ('D') !Debug
CALL GETARG(NARG+1,FILEIO) !,IP !INP file
DO I = 1, LEN(FILEIO)
FILEIO(I:I) = UPCASE(FILEIO(I:I))
ROTNUM = 0
TRTNUM = 0
END DO
! Interactive mode, no command line arguments
CASE DEFAULT !Interactive mode.
RNMODE = 'I'
END SELECT
C-----------------------------------------------------------------------
C Delete previouse copies of temporary input file
C-----------------------------------------------------------------------
IF (RNMODE .NE. 'D') THEN
INQUIRE (FILE = FILEIO,EXIST = FEXIST)
IF (FEXIST) THEN
OPEN (LUNIO, FILE = FILEIO,STATUS = 'UNKNOWN',IOSTAT=ERRNUM)
CLOSE (LUNIO,STATUS = 'DELETE')
ENDIF
LN = LEN(TRIM(FILEIO))
FILEIOH = FILEIO
WRITE(FILEIOH(LN:LN),'(A1)') 'H'
INQUIRE (FILE = FILEIOH,EXIST = FEXIST)
IF (FEXIST) THEN
OPEN (LUNIO, FILE = FILEIOH,STATUS = 'UNKNOWN',IOSTAT=ERRNUM)
CLOSE (LUNIO,STATUS = 'DELETE')
ENDIF
C-----------------------------------------------------------------------
C Open BATCH file
C-----------------------------------------------------------------------
IF (INDEX('NQSFBEPT',RNMODE) .GT. 0) THEN
CALL GETLUN('BATCH ', LUNBIO)
FINDCH='$BATCH'
OPEN (LUNBIO, FILE = FILEB,STATUS = 'UNKNOWN',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,28,FILEB,LINBIO)
CALL FIND (LUNBIO,FINDCH,LINBIO,IFIND)
IF (IFIND .EQ. 0) CALL ERROR (ERRKEY,26,FILEB,LINBIO)
ENDIF
ENDIF
C-----------------------------------------------------------------------
C Set run number and replication number
C-----------------------------------------------------------------------
RUN = 0
REPNO = 1
CONTROL % REPNO = REPNO
C***********************************************************************
C***********************************************************************
C RUN INITIALIZATION
C***********************************************************************
RUN_LOOP: DO WHILE (.NOT. DONE)
YREND = -99
RUN = RUN + 1
CONTROL % RUN = RUN
CONTROL % YRDOY = 0
CALL PUT(CONTROL)
!-----------------------------------------------------------------------
! Timer function
! Get time before call to input module
CALL DATE_AND_TIME (VALUES=DATE_TIME)
! Convert time to seconds
TIME1 = DATE_TIME(7) !seconds
& + DATE_TIME(8) / 1000. !milliseconds
& + DATE_TIME(6) * 60. !minutes
& + DATE_TIME(5) * 3600. !hours
!-----------------------------------------------------------------------
IF ((INDEX('NSFBT',RNMODE) .GT. 0) .OR. (INDEX('E',RNMODE) .GT.
& 0 .AND. RUN .EQ. 1)) THEN
CALL IGNORE (LUNBIO,LINBIO,ISECT,CHARTEST)
IF (ISECT .EQ. 1) THEN
END_POS = LEN(TRIM(CHARTEST(1:92)))+1
FILEX = CHARTEST((END_POS-12):(END_POS-1))
PATHEX = CHARTEST(1:END_POS-13)
READ(CHARTEST(93:113),110,IOSTAT=ERRNUM) TRTNUM,TRTREP,ROTNUM
110 FORMAT(3(1X,I6))
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,26,FILEB,LINBIO)
ELSE
DONE = .TRUE.
GO TO 2000
ENDIF
ENDIF
IF (INDEX('QP',RNMODE) .GT. 0) THEN
CALL IGNORE (LUNBIO,LINBIO,ISECT,CHARTEST)
IF (ISECT .EQ. 0 .OR. RUN .EQ. 1) THEN
REWIND(LUNBIO)
CALL FIND (LUNBIO,FINDCH,LINBIO,IFIND)
CALL IGNORE (LUNBIO,LINBIO,ISECT,CHARTEST)
ENDIF
END_POS = INDEX(CHARTEST,BLANK)
FILEX = CHARTEST((END_POS-12):(END_POS-1))
PATHEX = CHARTEST(1:END_POS-13)
READ (CHARTEST(93:113),110,IOSTAT=ERRNUM) TRTNUM,TRTREP,ROTNUM
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,26,FILEB,LINBIO)
ENDIF
CONTROL % FILEIO = FILEIO
CONTROL % FILEX = FILEX
CONTROL % RNMODE = RNMODE
CONTROL % ROTNUM = ROTNUM
CONTROL % TRTNUM = TRTNUM
CONTROL % ERRCODE = 0
CALL PUT(CONTROL)
C-----------------------------------------------------------------------
C Run INPUT module
C-----------------------------------------------------------------------
IF (RNMODE .NE. 'D') THEN
CALL INPUT_SUB(
& FILECTL, FILEIO, FILEX, MODELARG, PATHEX, !Input
& RNMODE, ROTNUM, RUN, TRTNUM, !Input
& ISWITCH, CONTROL) !Output
ELSE
FILEX = ' ' !Debug mode - no FILEX
CALL PATHD (DSSATP,PATHX,LEN_TRIM(PATHX))
CONTROL % DSSATP = DSSATP
ENDIF
C-----------------------------------------------------------------------
C Check to see if the temporary file exists
C-----------------------------------------------------------------------
INQUIRE (FILE = FILEIO,EXIST = FEXIST)
IF (.NOT. FEXIST) THEN
CALL ERROR(ERRKEY,2,FILEIO,LUNIO)
ENDIF
OPEN (LUNIO, FILE = FILEIO,STATUS = 'OLD',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,0)
READ (LUNIO,300,IOSTAT=ERRNUM) EXPNO,TRTNUM,TRTALL
300 FORMAT(36X,3(1X,I5))
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,1)
READ (LUNIO,'(//,15X,A12)',IOSTAT=ERRNUM) FILEX
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,1)
IF (RUN .EQ. 1) THEN
READ(LUNIO,'(8(/),15X,A8)',IOSTAT=ERRNUM) FNAME
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,13)
READ(LUNIO,400,IOSTAT=ERRNUM) NYRS, NREPS, YRSIM
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,15)
400 FORMAT(/,15X,I5,1X,I5,7X,I7)
ELSE IF (INDEX('QP',RNMODE) .LE. 0 ) THEN
!ELSE IF (RNMODE .NE. 'Q') THEN
READ(LUNIO,500,IOSTAT=ERRNUM) NYRS, NREPS, YRSIM
IF (ERRNUM .NE. 0) CALL ERROR (ERRKEY,ERRNUM,FILEIO,15)
500 FORMAT(10(/),15X,I5,1X,I5,7X,I7)
ENDIF
CLOSE(LUNIO)
IF (NYRS > 1) THEN
YRSIM_SAVE = YRSIM
ENDIF
IF (INDEX('FPQ',RNMODE) .GT. 0) THEN
IF (RUN .EQ. 1) THEN
CALL YR_DOY(YRSIM,YR,ISIM)
YRDOY_END = (YR + NYRS) * 1000 + ISIM
YRDOY_END = INCYD(YRDOY_END, -1)
ENDIF
NYRS = 1
ENDIF
! IF (RNMODE .NE. 'Q' .OR. RUN .EQ. 1) THEN
IF((INDEX('QP',RNMODE) .LE. 0) .OR. RUN .EQ. 1) THEN
YRDOY = YRSIM
ENDIF
MULTI = 0
YRDIF = 0
! IF (INDEX('FQ',RNMODE).GT. 0 .AND. RUN .GT. 1) THEN
IF (INDEX('FPQ',RNMODE).GT. 0 .AND. RUN .GT. 1) THEN ! JZW remove "p"
YRSIM = INCYD(YRDOY,1)
CALL YR_DOY(YRSIM_SAVE, YR0, ISIM0)
CALL YR_DOY(YRSIM, YR, ISIM)
YRDIF = YR - YR0
CONTROL % YRDIF = YRDIF
ENDIF
CONTROL % FILEX = FILEX
CONTROL % NYRS = NYRS
CONTROL % MULTI = MULTI
CONTROL % RUN = RUN
CONTROL % TRTNUM = TRTNUM
CONTROL % YRDIF = YRDIF
CONTROL % YRDOY = YRDOY
CONTROL % YRSIM = YRSIM
CONTROL % DYNAMIC = RUNINIT
CALL PUT(CONTROL)
CALL RUNLIST(CONTROL)
WRITE(MSG(1),'("RNMODE = ",A)') RNMODE
WRITE(MSG(2),'("PATHEX = ",A)') PATHEX(1:67)
WRITE(MSG(3),'("FILEX = ",A)') FILEX
WRITE(MSG(4),'("FILEB = ",A)') FILEB
WRITE(MSG(5),'("FILEIO = ",A)') FILEIO
WRITE(MSG(6),'("MODEL = ",A)') CONTROL % MODEL
WRITE(MSG(7),'("TRTNUM = ",I5)') TRTNUM
WRITE(MSG(8),'("ROTNUM = ",I5)') ROTNUM
IF (INDEX('FPQ',RNMODE) > 0) THEN
CALL INFO(8,ERRKEY,MSG)
ELSE
CALL INFO(7,ERRKEY,MSG)
ENDIF
! for perennial model, only first run has Run initial
IF ((INDEX('P',RNMODE) .LE. 0 ) .OR. (RUN ==1) )Then
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
endif
C***********************************************************************
C***********************************************************************
C-----------------------------------------------------------------------
C BEGINNING of SEASONAL SIMULATION loop
C-----------------------------------------------------------------------
C SEASONAL INITIALIZATION
C***********************************************************************
SEAS_LOOP: DO WHILE (MULTI .NE. NYRS)
C***********************************************************************
IF (NYRS .GT. 1) THEN
MULTI = MULTI + 1
ELSE
MULTI = 1
ENDIF
IF (MULTI .GT. 1) THEN
RUN = RUN + 1
CALL MULTIRUN(RUN, 0) !chp 3/17/2011
YRSIM = YRSIM_SAVE
CALL YR_DOY(YRSIM,YR,ISIM)
YRSIM = (YR + MULTI - 1) * 1000 + ISIM
YREND = -99
IF (CONTROL%ErrCode /= 0) THEN
CONTROL%ErrCode = 0
! EXIT SEAS_LOOP
IF (INDEX('PQ',RNMODE) > 0) EXIT SEAS_LOOP
ENDIF
ENDIF
!IF (RNMODE .NE. 'P' .OR. RUN .GT. 1) THEN
IF ((INDEX('PQ',RNMODE) .LE. 0).OR. RUN .GT. 1) THEN
!YRDOY = YRSIM
IF (RNMODE .NE. 'P') then ! JZW change
YRDOY = YRSIM
else
YRDOY = INCYD(YRDOY,1)
endif
ENDIF
CONTROL % DAS = 0
CONTROL % RUN = RUN
CONTROL % YRSIM = YRSIM
CONTROL % YRDOY = YRDOY
CONTROL % MULTI = MULTI
CONTROL % DYNAMIC = SEASINIT
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
YRDOY = INCYD(YRDOY,-1)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C BEGINNING of DAILY SIMULATION loop
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
DAY_LOOP: DO WHILE (YRDOY .GT. YREND)
C-----------------------------------------------------------------------
C Increment day (YRDOY)
C-----------------------------------------------------------------------
YRDOY = INCYD(YRDOY,1)
C-----------------------------------------------------------------------
C Calculate days after simulation (DAS)
C-----------------------------------------------------------------------
CALL YR_DOY(YRDOY,YEAR,DOY)
! DAS = MAX(0,TIMDIF(YRSIM,YRDOY))
DAS = MAX(0,TIMDIF(INCYD(YRSIM,-1),YRDOY))
CONTROL % YRDOY = YRDOY
CONTROL % DAS = DAS
C***********************************************************************
C RATE CALCULATIONS
C***********************************************************************
CONTROL % DYNAMIC = RATE
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
C***********************************************************************
C INTEGRATION
C***********************************************************************
CONTROL % DYNAMIC = INTEGR
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
C***********************************************************************
C OUTPUT
C***********************************************************************
CONTROL % DYNAMIC = OUTPUT
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
C***********************************************************************
ENDDO DAY_LOOP !End of daily loop
C-----------------------------------------------------------------------
C END of DAILY SIMULATION loop
C----------------------------------------------------------------------
C***********************************************************************
C End of Season
C***********************************************************************
CONTROL % DYNAMIC = SEASEND
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
C-----------------------------------------------------------------------
! Timer function
! Get time at end of run
CALL DATE_AND_TIME (VALUES=DATE_TIME)
! Convert time to seconds
TIME2 = DATE_TIME(7) !seconds
& + DATE_TIME(8) / 1000. !milliseconds
& + DATE_TIME(6) * 60. !minutes
& + DATE_TIME(5) * 3600. !hours
DELTA_TIME_RUN = TIME2 - TIME1
WRITE(LUNTIME,'(1X,I3,1X,A12,I3,2F12.3,F8.3,1X,A)')
& RUN, FILEX, TRTNUM, TIME1, TIME2, DELTA_TIME_RUN, TITLET
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
ENDDO SEAS_LOOP
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C END of SEASONAL SIMULATION loop
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
C Check to see if all treatments have been run for RNMODE = 'A'
C-----------------------------------------------------------------------
I = INDEX('A', RNMODE)
IF (INDEX('A',RNMODE) .GT. 0 .AND. TRTNUM .GE. TRTALL) THEN
DONE = .TRUE.
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
ELSE IF (INDEX('GDC',RNMODE) .GT. 0) THEN
DONE = .TRUE.
! ELSE IF (INDEX('FQ',RNMODE).GT. 0 .AND. YEAR .GE. YEAR_END) THEN
ELSE IF (INDEX('FPQ',RNMODE).GT. 0 .AND. YRDOY .GE.YRDOY_END) THEN
REPNO = REPNO + 1
CONTROL % REPNO = REPNO
IF (REPNO .GT. NREPS) THEN
DONE = .TRUE.
ELSE
RUN = 0
ENDIF
ELSE IF (INDEX('IE',RNMODE) .GT. 0) THEN
WRITE(*,1700)
1700 FORMAT(/,1X,'Do you want to run more simulations ? ',
& /,1X,'Y or N ? [Default = "N"] ===> ',$)
READ (5,1800) ANS
1800 FORMAT(A1)
ANS = UPCASE(ANS)
IF (ANS .NE. 'Y') DONE = .TRUE.
ENDIF
2000 CONTINUE
END DO RUN_LOOP
! Final end-of-run call to land unit module
CONTROL % DYNAMIC = ENDRUN
CALL PUT(CONTROL)
CALL LAND(CONTROL, ISWITCH,
& YRPLT, MDATE, YREND)
!Change output file names if FNAME set
CALL OPNAMES(FNAME)
CALL RUNLIST(CONTROL)
C-----------------------------------------------------------------------
! Timer function
! Get time at end of run
CALL DATE_AND_TIME (VALUES=DATE_TIME)
! Convert time to seconds
TIMEE = DATE_TIME(7) !seconds
& + DATE_TIME(8) / 1000. !milliseconds
& + DATE_TIME(6) * 60. !minutes
& + DATE_TIME(5) * 3600. !hours
DELTA_TIME_RUN = TIMEE - TIME0
WRITE(LUNTIME,'(/," TOTAL",14X,2F12.3,F8.3)')
& TIME0, TIMEE, DELTA_TIME_RUN
CLOSE(LUNTIME)
C-----------------------------------------------------------------------
END PROGRAM CSM
!===========================================================================
! Variable listing for main program
! ---------------------------------
! BLANK Blank character
! CONTROL Composite variable containing variables related to control and/or
! timing of simulation. The structure of the variable
! (ControlType) is defined in ModuleDefs.for.
! DAS Days after start of simulation (d)
! DONE Logical variable. TRUE if all runs have been completed. FALSE
! otherwise.
! DOY Current day of simulation (d)
! DSCSM Name of CSM model executable (i.e., DSCSM040.EXE)
! ERRKEY Subroutine name for error file
! ERRNUM Error number for input
! EXPNO Experiment number
! FEXIST Logical variable
! FILEARG Run-time argument which contains name of input file (either
! FILEIO, FILEB or FILEX depending on run mode).
! FILEB Name of batch file (i.e., D4batch.dv4)
! FILEIO Filename for input file (e.g., IBSNAT35.INP)
! FILEX Experiment file, e.g., UFGA7801.SBX
! FNAME Output file name, usually 'OVERVIEW'
! I Loop counter
! INPUT Name of input module executable (i.e., MINPT040.EXE)
! INPUTX Command line for system call to run input module.
! IP Return status of GETARG command
! IPX Length of path plus filename for CSM executable
! ISECT Indicator of completion of IGNORE routine: 0 - End of file
! encountered, 1 - Found a good line to read, 2 - End of Section
! in file encountered denoted by * in column 1.
! ISIM Day portion of Julian date
! ISWITCH Composite variable containing switches which control flow of
! execution for model. The structure of the variable
! (SwitchType) is defined in ModuleDefs.for.
! LN Pest number
! LUNIO Logical unit number for FILEIO
! MDATE Harvest maturity date (YYYYDDD)
! MULTI Current simulation year (=1 for first or single simulation, =NYRS
! for last seasonal simulation)
! NREPS Number of replications for sequenced simulation
! NYRS Number of years of simulations to perform for multi-season run
! (each with identical intitial conditions, but different weather
! years)
! REPNO Replication number for current simulation
! RNMODE Simulation run mode (I=Interactive, A=All treatments,
! B=Batch mode, E=Sensitivity, D=Debug, N=Seasonal, Q=Sequence, P=perennial )
! RUN Change in date between two observations for linear interpolation
! TRTNUM Treatment number being simulated (from FILEX)
! YEAR Year of current date of simulation
! YR Year portion of date
! YRDIF Increment in years which must be added to operations dates for
! seasonal or sequenced simulations (yr)
! YRDOY Current day of simulation (YYYYDDD)
! YREND Date for end of season (usually harvest date) (YYYYDDD)
! YRPLT Planting date (YYYYDDD)
! YRSIM Start of simulation date (YYYYDDD)
!===========================================================================