-
Notifications
You must be signed in to change notification settings - Fork 1
/
FreshWt.FOR
273 lines (230 loc) · 9.59 KB
/
FreshWt.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
!=======================================================================
! FreshWt, Subroutine, C.H.Porter, K.J.Boote, J.I.Lizaso
!-----------------------------------------------------------------------
! Computes fresh pod weigt
!-----------------------------------------------------------------------
! REVISION HISTORY
! 05/09/2007 Written. KJB, CHP, JIL, RR
! 02/27/2008 Added pod quality for snap bean. JIL
!-----------------------------------------------------------------------
! Called from: PODS
!=======================================================================
SUBROUTINE FreshWt(DYNAMIC, ISWFWT, NR2TIM, PHTIM, SDNO, SHELN,
& WTSD, WTSHE, YRPLT)
!-----------------------------------------------------------------------
USE ModuleDefs
USE ModuleData
IMPLICIT NONE
SAVE
CHARACTER*1 ISWFWT
CHARACTER*2 CROP
CHARACTER*7 ERRKEY
PARAMETER (ERRKEY = 'FreshWt')
CHARACTER*11, PARAMETER :: FWFile = "FreshWt.OUT"
CHARACTER*16 CROPD
CHARACTER*78 MSG(3)
INTEGER DAP, DAS, DOY, DYNAMIC, ERRNUM, I
INTEGER NOUTPF, NPP, NR2TIM, TIMDIF
INTEGER YEAR, YRDOY, YRPLT
REAL AvgDMC, AvgDPW, AvgFPW, PodDiam, PodLen
REAL PAGE, PodAge, PODNO, SEEDNO, SHELPC
REAL TDPW, TFPW, TDSW
REAL CLASS(7)
REAL, DIMENSION(NCOHORTS) :: DMC, DryPodWt, FreshPodWt, PHTIM
REAL, DIMENSION(NCOHORTS) :: SDNO, SHELN, WTSD, WTSHE, XPAGE
LOGICAL FEXIST
TYPE (ControlType) CONTROL
TYPE (SwitchType) ISWITCH
CALL GET(CONTROL)
!***********************************************************************
!***********************************************************************
! Seasonal initialization - run once per season
!***********************************************************************
IF (DYNAMIC .EQ. SEASINIT) THEN
!-----------------------------------------------------------------------
CALL GET(ISWITCH)
! Switch for fresh weight calculations
IF (INDEX('Y',ISWFWT) < 1 .OR.
& INDEX('N,0',ISWITCH%IDETL) > 0) RETURN
CROP = CONTROL % CROP
! Currently only works for tomato. Add other crops later.
! Send a message if not available crop
IF (INDEX('TM,GB',CROP) < 0) THEN
CALL GET_CROPD(CROP, CROPD)
WRITE(MSG(1),'(A)')
& "Fresh weight calculations not currently available for "
WRITE(MSG(2),'(A2,1X,A16)') CROP, CROPD
CALL INFO(2,ERRKEY,MSG)
ENDIF
!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
CALL GETLUN(FWFile, NOUTPF)
INQUIRE (FILE= FWFile, EXIST = FEXIST)
IF (FEXIST) THEN
OPEN(UNIT = NOUTPF, FILE = FWFile, STATUS = 'OLD',
& IOSTAT = ERRNUM, POSITION = 'APPEND')
ELSE
OPEN (UNIT = NOUTPF, FILE = FWFile, STATUS = 'NEW',
& IOSTAT = ERRNUM)
WRITE(NOUTPF,'("*Fresh Weight Output File")')
ENDIF
!Write headers
CALL HEADER(SEASINIT, NOUTPF, CONTROL%RUN)
! Change header to PWAD1 (was PWAD) because GBuild requires
! unique headers (PlantGro also lists PWAD). Should have same
! value, but slightly off. Why?
! Need to look at how GBuild handles P#AD and SH%D here, too.
SELECT CASE (CROP)
CASE ('TM') ! Tomato
WRITE (NOUTPF,230)
CASE ('GB') ! Snap bean
WRITE (NOUTPF,231)
END SELECT
230 FORMAT('@YEAR DOY DAS DAP',
& ' FPWAD PDMCD AFPWD',
& ' ADPWD PAGED')
231 FORMAT('@YEAR DOY DAS DAP',
& ' FPWAD PDMCD AFPWD',
& ' ADPWD PAGED',
& ' FCULD FSZ1D FSZ2D FSZ3D FSZ4D FSZ5D FSZ6D')
AvgDMC = 0.0
AvgDPW = 0.0
AvgFPW = 0.0
PodAge = 0.0
PODNO = 0.0
SEEDNO = 0.0
SHELPC = 0.0
TDPW = 0.0
TFPW = 0.0
!***********************************************************************
!***********************************************************************
! DAILY RATE/INTEGRATION
!***********************************************************************
ELSEIF (DYNAMIC .EQ. INTEGR) THEN
!-----------------------------------------------------------------------
IF (INDEX('Y',ISWFWT) < 1 .OR.
& INDEX('N,0',ISWITCH%IDETL) > 0) RETURN
! Calculate number of pods, including those with and without seeds
SEEDNO = 0.0
PODNO = 0.0
TFPW = 0.0
TDPW = 0.0
TDSW = 0.0
DO I = 1, 7
CLASS(I) = 0.0
ENDDO
!-----------------------------------------------------------------------
DO NPP = 1, NR2TIM + 1
PAGE = PHTIM(NR2TIM + 1) - PHTIM(NPP)
XPAGE(NPP) = PAGE
! Dry matter concentration (fraction)
! DMC(NPP) = (5. + 7.2 * EXP(-7.5 * PAGE / 40.)) / 100.
SELECT CASE (CROP)
CASE ('TM') ! Tomato
DMC(NPP) = (5. + 7.2 * EXP(-7.5 * PAGE / 40.)) / 100.
CASE ('GB') ! Snap bean
! DMC(NPP) = 0.0465 + 0.0116 * EXP(0.161 * PAGE)
DMC(NPP) = 0.023 + 0.0277 * EXP(0.116 * PAGE)
END SELECT
! Fresh weight (g/pod)
IF (SHELN(NPP) > 1.E-6) THEN
FreshPodWt(NPP) = (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) /
& SHELN(NPP) !g/pod
DryPodWt(NPP) = (WTSD(NPP) + WTSHE(NPP))/SHELN(NPP) !g/pod
ELSE
FreshPodWt(NPP) = 0.0
ENDIF
! Snap bean quality
IF (CROP .EQ. 'GB') THEN
PodDiam = 8.991 *(1.0-EXP(-0.438*(FreshPodWt(NPP)+0.5))) !(mm/pod)
PodLen = 14.24 *(1.0-EXP(-0.634*(FreshPodWt(NPP)+0.46))) !(cm/pod)
IF (PodDiam .LT. 4.7625) THEN
CLASS(7) = CLASS(7) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Culls
ELSEIF (PodDiam .LT. 5.7547) THEN
CLASS(1) = CLASS(1) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 1
ELSEIF (PodDiam .LT. 7.3422) THEN
CLASS(2) = CLASS(2) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 2
ELSEIF (PodDiam .LT. 8.3344) THEN
CLASS(3) = CLASS(3) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 3
ELSEIF (PodDiam .LT. 9.5250) THEN
CLASS(4) = CLASS(4) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 4
ELSEIF (PodDiam .LT. 10.7156) THEN
CLASS(5) = CLASS(5) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 5
ELSE
CLASS(6) = CLASS(6) + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP) !Sieve size 6
ENDIF
ENDIF
TFPW = TFPW + (WTSD(NPP) + WTSHE(NPP)) / DMC(NPP)
TDPW = TDPW + WTSD(NPP) + WTSHE(NPP)
TDSW = TDSW + WTSD(NPP)
PODNO = PODNO + SHELN(NPP)
SEEDNO = SEEDNO + SDNO(NPP)
ENDDO
PodAge = XPAGE(1)
IF (PODNO > 1.E-6) THEN
AvgFPW = TFPW / PODNO
AvgDPW = TDPW / PODNO
ELSE
AvgFPW = 0.0
AvgDPW = 0.0
ENDIF
IF (TFPW > 1.E-6) THEN
AvgDMC = TDPW / TFPW
ELSE
AvgDMC = 0.0
ENDIF
IF (TDPW > 1.E-6) THEN
ShelPC = TDSW / TDPW * 100.
ELSE
ShelPC = 0.0
ENDIF
!***********************************************************************
!***********************************************************************
! DAILY OUTPUT
!***********************************************************************
ELSE IF (DYNAMIC .EQ. OUTPUT) THEN
!-----------------------------------------------------------------------
IF (INDEX('Y',ISWFWT) < 1 .OR.
& INDEX('N,0',ISWITCH%IDETL) > 0) RETURN
YRDOY = CONTROL % YRDOY
IF (YRDOY .LT. YRPLT .OR. YRPLT .LT. 0) RETURN
! DAS = MAX(0,TIMDIF(YRSIM,YRDOY))
DAS = CONTROL % DAS
! Daily output every FROP days
IF (MOD(DAS,CONTROL%FROP) == 0) THEN
CALL YR_DOY(YRDOY, YEAR, DOY)
DAP = MAX(0,TIMDIF(YRPLT,YRDOY))
IF (DAP > DAS) DAP = 0
SELECT CASE (CROP)
CASE ('TM') ! Tomato
WRITE(NOUTPF, 1000) YEAR, DOY, DAS, DAP,
& NINT(TFPW * 10.), AvgDMC, AvgFPW, AvgDPW,
& PodAge
CASE ('GB') ! Snap bean
WRITE(NOUTPF, 2000) YEAR, DOY, DAS, DAP,
& NINT(TFPW * 10.), AvgDMC, AvgFPW, AvgDPW,
& PodAge,NINT(CLASS(7)*10.),NINT(CLASS(1)*10.),
& NINT(CLASS(2)*10.),NINT(CLASS(3)*10.),NINT(CLASS(4)*10.),
& NINT(CLASS(5)*10.),NINT(CLASS(6)*10.)
END SELECT
1000 FORMAT(1X,I4,1X,I3.3,2(1X,I5),
& I8,F8.3,F8.1,F8.2,F8.1)
2000 FORMAT(1X,I4,1X,I3.3,2(1X,I5),
& I8,F8.3,F8.1,F8.2,F8.1,
& 7(1X,I5))
ENDIF
!***********************************************************************
!***********************************************************************
! SEASONAL SUMMARY
!***********************************************************************
ELSE IF (DYNAMIC .EQ. SEASEND) THEN
!-----------------------------------------------------------------------
CLOSE (NOUTPF)
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!***********************************************************************
RETURN
END SUBROUTINE FreshWt
!=======================================================================