-
Notifications
You must be signed in to change notification settings - Fork 1
/
CO2VAL.FOR
307 lines (262 loc) · 9.51 KB
/
CO2VAL.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
!=================================================================
! CO2VAL, Subroutine, CHPorter
! Determines daily CO2 value
! Switch ICO2:
! ICO2 = 'D' use static value (CO2BAS from CO2???.WDA)
! ICO2 = 'W' use values read from weather file
! ICO2 = 'M' use monthly values read from CO2???.WDA file
! (default)
!-----------------------------------------------------------------------
! REVISION HISTORY
! 04/29/2008 CHP Written
! 07/07/2008 CHP Added error handling routine
! 08/31/2009 CHP Stop program if CO2 file not found or errors reading.
!-----------------------------------------------------------------------
! Called by: WEATHR
!=======================================================================
SUBROUTINE CO2VAL(CONTROL, ISWITCH, CCO2, CO2)
!-----------------------------------------------------------------------
USE ModuleDefs
IMPLICIT NONE
SAVE
TYPE (ControlType), INTENT(IN) :: CONTROL
TYPE (SwitchType), INTENT(IN) :: ISWITCH
REAL, INTENT(IN) :: CCO2
REAL, INTENT(OUT):: CO2
CHARACTER*1 ICO2
CHARACTER*10 TEXT
CHARACTER*12 NAMEF
CHARACTER*78 MSG(3)
CHARACTER*80 CHARTEST, PATHSD
CHARACTER*92 FILECO2
INTEGER DOY, DYNAMIC, ERR, FOUND, I, INDX
INTEGER LINE, LNUM, LUNCO2, NVals, PFLAG, YEAR
LOGICAL FEXIST, LEAP
CHARACTER*6, PARAMETER :: ERRKEY = 'CO2VAL'
INTEGER, PARAMETER :: MaxNVals = 5000 !Max number of records
INTEGER, DIMENSION(MaxNVals) :: FYEAR, FDOY
REAL, DIMENSION(MaxNVals) :: FCO2
REAL CO2BAS
! For free-format reads
! Up to MAXCOL headers per line, up to 10 characters long each
INTEGER, PARAMETER :: MAXCOL = 25
CHARACTER*15 HEADER(MAXCOL)
! COL keeps beginning and ending column for each header
INTEGER COL(MAXCOL,2), COUNT, C1, C2, ISECT
DYNAMIC = CONTROL % DYNAMIC
!-----------------------------------------------------------------------
IF (DYNAMIC == SEASINIT) THEN
!-----------------------------------------------------------------------
ICO2 = ISWITCH % ICO2
! Use CO2 from weather file if ICO2 = 'W'
IF (ICO2 == 'W' .AND. CCO2 > 1) THEN
CO2 = CCO2
CO2BAS = CCO2
RETURN
ELSE
CO2 = 380.
CO2BAS = 380.
ENDIF
!-----------------------------------------------------------------------
! Read from CO2???.WDA file
FILECO2 = 'CO2045.WDA'
LNUM = 0
INQUIRE (FILE = FILECO2, EXIST = FEXIST)
IF (.NOT. FEXIST) THEN
CALL PATH('STD',CONTROL%DSSATP,PATHSD,PFLAG,NAMEF)
FILECO2 = TRIM(PATHSD) // FILECO2
ENDIF
INQUIRE (FILE = FILECO2, EXIST = FEXIST)
IF (.NOT. FEXIST) THEN
CALL CO2_ERROR(29, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
RETURN
ENDIF
CALL GETLUN('FILECO2', LUNCO2)
OPEN (LUNCO2,FILE=FILECO2,STATUS='OLD',IOSTAT=ERR)
IF (ERR > 0) THEN
CALL CO2_ERROR(10, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
RETURN
ENDIF
! Read base CO2 (default static value) from file
REWIND (LUNCO2)
CALL FIND2(LUNCO2,'@CO2BAS',LINE,FOUND); LNUM = LNUM + LINE
IF (FOUND == 1) THEN
CALL IGNORE(LUNCO2,LNUM,ISECT,CHARTEST)
IF (ISECT == 1) THEN
READ(CHARTEST,*) CO2BAS
IF (CO2BAS > 1) THEN
CO2 = CO2BAS
ELSE
CO2 = 380.
ENDIF
IF (ICO2 /= 'M') THEN
CLOSE (LUNCO2)
RETURN !ICO2 = 'D' -- Use default CO2
ENDIF
ELSE
CALL CO2_ERROR(64, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
RETURN
ENDIF
ELSE
CALL CO2_ERROR(42, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
RETURN
ENDIF
! No need to read data again if it's already been read.
IF (NVals == 0) THEN
! Read time series CO2 values from file
CALL FIND2(LUNCO2,'@ YEAR',LINE,FOUND); LNUM = LNUM + LINE
IF (FOUND == 1) THEN
BACKSPACE(LUNCO2)
READ(LUNCO2,'(A)') CHARTEST
IF (ISECT == 1) THEN
CALL PARSE_HEADERS(CHARTEST, MAXCOL, HEADER, COUNT, COL)
ELSE
CALL CO2_ERROR(50, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
ENDIF
ELSE
CALL CO2_ERROR(50, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
RETURN
ENDIF
NVals = 1
ReadLoop: DO WHILE (NVals <= MaxNVals)
! Read a line of data
CALL IGNORE (LUNCO2, LNUM, ISECT, CHARTEST)
IF (ISECT .NE. 1) EXIT
HeaderLoop: DO I = 1, COUNT
C1 = COL(I,1)
C2 = COL(I,2)
READ(CHARTEST(C1:C2),'(A)',IOSTAT=ERR) TEXT
IF (TEXT .NE. ' ') THEN
SELECT CASE (TRIM(HEADER(I)))
CASE('YEAR')
READ(CHARTEST(C1:C2),*,IOSTAT=ERR)FYEAR(NVals)
CASE('DOY')
READ(CHARTEST(C1:C2),*,IOSTAT=ERR)FDOY(NVals)
CASE('CO2')
READ(CHARTEST(C1:C2),*,IOSTAT=ERR)FCO2(NVals)
END SELECT
IF (ERR /= 0) CYCLE ReadLoop
ENDIF
ENDDO HeaderLoop
IF (FCO2(NVals) < 1.) CYCLE ReadLoop
IF (LEAP(FYEAR(NVals))) THEN
IF (FDOY(NVals) > 366) CYCLE ReadLoop
ELSE
IF (FDOY(NVals) > 365) CYCLE ReadLoop
ENDIF
NVals = NVals + 1
ENDDO ReadLoop
NVals = NVals - 1
CLOSE (LUNCO2)
WRITE(MSG(1),'(I4,A)')
& NVals," CO2 data points read from file."
MSG(2) = FILECO2(1:78)
IF (NVals < MaxNVals) THEN
CALL INFO(2,ERRKEY,MSG)
ELSE
MSG(3) = "Remaining data will be ignored."
CALL WARNING(3,ERRKEY,MSG)
ENDIF
ENDIF
! Get value to use for first day of simulation
CALL YR_DOY(CONTROL % YRSIM, YEAR, DOY)
INDX = 1
CO2 = FCO2(1)
DO I = 1, NVALS
INDX = I
IF (YEAR < FYEAR(I)) THEN
EXIT
ELSEIF (YEAR == FYEAR(I)) THEN
IF (DOY < FDOY(I)) THEN
EXIT
ELSEIF (DOY == FDOY(I)) THEN
CO2 = FCO2(I)
EXIT
ELSE
CO2 = FCO2(I)
CYCLE
ENDIF
ELSE
CO2 = FCO2(I)
CYCLE
ENDIF
ENDDO
IF (CO2 < 1.) CO2 = CO2BAS
CO2BAS = CO2
CALL CO2Header(CO2)
!-----------------------------------------------------------------------
ELSEIF (DYNAMIC == RATE) THEN
!-----------------------------------------------------------------------
CO2 = CO2BAS
IF (ICO2 == 'M' .AND. NVals > 0) THEN
! Get value to use for today
CALL YR_DOY(CONTROL % YRDOY, YEAR, DOY)
DO I = INDX, NVALS
INDX = I
IF (YEAR < FYEAR(I)) THEN
EXIT
ELSEIF (YEAR == FYEAR(I)) THEN
IF (DOY < FDOY(I)) THEN
EXIT
ELSEIF (DOY == FDOY(I)) THEN
CO2 = FCO2(I)
IF (CO2 < 1.) CO2 = CO2BAS
CO2BAS = CO2
EXIT
ENDIF
ENDIF
ENDDO
ENDIF
!-----------------------------------------------------------------------
ENDIF !END OF DYNAMIC BLOCK
!-----------------------------------------------------------------------
RETURN
END SUBROUTINE CO2VAL
!=======================================================================
! CO2VAL variable definitions
!-----------------------------------------------------------------------
! CCO2 Atmospheric CO2 concentration read from weather file (ppm)
! CO2 Atmospheric carbon dioxide concentration (ppm)
! CO2BAS Default carbon dioxide base level (ppm)
!=======================================================================
SUBROUTINE CO2_ERROR(IERROR, CO2, ERRKEY, FILECO2, LNUM, LUNCO2)
! Error handling routine for CO2 input
IMPLICIT NONE
CHARACTER* 6 ERRKEY
CHARACTER*78 MSG(4)
CHARACTER*92 FILECO2
INTEGER IERROR, LNUM, LUNCO2
REAL CO2
CLOSE (LUNCO2)
IF (CO2 < 1.) THEN
CO2 = 380.
ENDIF
MSG(2) = FILECO2(1:78)
WRITE(MSG(3),'(A,I4)') "Line number ", LNUM
SELECT CASE(IERROR)
CASE (10)
MSG(1) ='Error opening CO2 input file.'
WRITE(MSG(4),'(A)') "Program will stop."
CALL WARNING(4,ERRKEY,MSG)
CALL ERROR(ERRKEY,IERROR,FILECO2,LNUM)
CASE (29)
MSG(1) ='CO2 input file does not exist or has invalid format.'
WRITE(MSG(4),'(A)') "Program will stop."
CALL WARNING(4,ERRKEY,MSG)
CALL ERROR(ERRKEY,IERROR,FILECO2,LNUM)
CASE (42)
MSG(1) ='Default CO2 section not found.'
WRITE(MSG(4),'(A,F7.1,A)') 'CO2 =',CO2,' ppm will be used.'
CALL WARNING(4,ERRKEY,MSG)
CASE (50)
MSG(1) ='CO2 time series section not found.'
WRITE(MSG(4),'(A,F7.1,A)') 'CO2 =',CO2,' ppm will be used.'
CALL WARNING(4,ERRKEY,MSG)
CASE (64)
MSG(1) ='Invalid format in CO2 file.'
WRITE(MSG(4),'(A,F7.1,A)') 'CO2 =',CO2,' ppm will be used.'
CALL WARNING(4,ERRKEY,MSG)
END SELECT
RETURN
END SUBROUTINE CO2_ERROR
!=======================================================================