-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathCSP_ROOTS.FOR
679 lines (607 loc) · 29.9 KB
/
CSP_ROOTS.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
666
667
668
669
670
671
672
673
674
675
676
677
678
679
C=======================================================================
C CSP_ROOTS, Subroutine, O.H. Daza, F.S. Royce based on ROOTS Subroutine,
C by G. Hoogenboom, J.W. Jones
C-----------------------------------------------------------------------
C Calculates root growth, extension, respiration, and senescence
C
C-----------------------------------------------------------------------
C REVISION HISTORY
C 01/09/1989 GH Written.
C 09/29/1995 KJB Changed to lessen effect of water deficit on root depth
C increase.
C 01/19/1996 JWJ Added effects of excess water.
C 01/20/1996 KJB Increase root extension rate under drought stress
C 09/13/1998 CHP Modified for modular format
C 09/14/1998 CHP Changed TROOT to TRLV to match same variable in ROOTDM
C Changed SWDF1 to SWFAC to match variable name in WATBAL
C 05/11/1999 GH Incorporated in CROPGRO
C 11/09/2001 O.H.Daza modified for sugarcane
C 08/26/2003 FSR Incorporated into CASUPRO sugarcane model as CSP_ROOTS
C 02/21/2005 SJR Moved ISWWAT condition here to allow computation of
C root senescence even when water not simulated.
C 10/04/2005 SJR Include senescence due to water stress in total
C daily senescence.
C 10/20/2005 CHP Added optional minimum root mass for senescence,
C RTWTMIN, to species file
C 01/19/2006 CHP Fixed discrepancies between plant root senescence
C calculated and that sent to soil routines for addition
C to organic matter.
C-----------------------------------------------------------------------
C Called by : CASUPRO
C Calls : CSP_IPROOT, CSP_INROOT
C=======================================================================
SUBROUTINE CSP_ROOTS(CONTROL, DYNAMIC,
& AGRRT, CROP, DLAYR, DS, DTX, DUL, ESW, FILECC, !Input
& FRRT, ISWWAT, LL, NLAYR, PGT, PLTPOP, PLWT, RO, RP, !Input
& RTDWP, RTWTHa, SAT, SW, SWFAC, !Input
& VSTAGE, WR, WRDOTN, WTNEW, !Input
& CUMDEP, RLV, RTDEP, SATFAC, SENRT, SRDOT) !Output
C-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
SAVE
CHARACTER*1 ISWWAT
CHARACTER*2 CROP
CHARACTER*92 FILECC
INTEGER L, L1, NLAYR
INTEGER DYNAMIC, DAS
REAL CUMDEP, DEPMAX, DTX, FRRT,
& PGT, RFAC1, RFAC2, RFAC3,
& RLDSM, RLNEW, RO, RP,
& RTDEP, RTSDF, RTSEN, SRDOT, SWDF, SWFAC,
& TRLDF, TRLV, WRDOTN !, TRTDY
REAL CGRRT, AGRRT
REAL SWEXF, PORMIN, RTEXF, RTSURV
REAL RTDEPI, SUMEX, SUMRL, SATFAC
REAL PLTPOP, PLWT, WTNEW, VSTAGE
REAL TABEX !Function subroutine located in UTILS.FOR
REAL XRTFAC(4), YRTFAC(4)
REAL DLAYR(NL), DS(NL), DUL(NL), ESW(NL), LL(NL), RLDF(NL)
REAL RLGRW(NL), RLSEN(NL), RLV(NL), RLV_WS(NL), RRLF(NL)
REAL SW(NL), SAT(NL), WR(NL)
REAL GRESPR(NL), MRESPR(NL), RESPS(NL)
REAL SENRT(NL) !TRLSEN, TRLGRW,
REAL, DIMENSION(0:NumOfDays) :: RTDWP, RTWTHa
! Added 10/20/2005 for minimum RLV calculations
! RTWTMIN = minimum root mass per layer; used to limit senescence
! (g/m2) (species file parameter)
! TRLV_MIN = conversion of RTWTMIN to RLV units per layer
REAL TRLV_MIN, RLSENTOT, FACTOR, RTWTMIN
!-----------------------------------------------------------------------
! Define constructed variable types based on definitions in
! ModuleDefs.for.
! The variable "CONTROL" is of type "ControlType".
TYPE (ControlType) CONTROL
! Transfer values from constructed data types into local variables.
DAS = CONTROL % DAS
!!! DYNAMIC = CONTROL % DYNAMIC
!***********************************************************************
!***********************************************************************
! Run Initialization - Called once per simulation
!***********************************************************************
IF (DYNAMIC .EQ. RUNINIT) THEN
!-----------------------------------------------------------------------
CALL CSP_IPROOT(FILECC, !Input
& PORMIN, RFAC1, RLDSM, RTDEPI, RTEXF, !Output
& RTSEN, RTSDF, RTWTMIN, XRTFAC, YRTFAC) !Output
DEPMAX = DS(NLAYR)
!***********************************************************************
!***********************************************************************
! Seasonal initialization - run once per season
!***********************************************************************
ELSEIF (DYNAMIC .EQ. SEASINIT) THEN
!-----------------------------------------------------------------------
SRDOT = 0.0
RTDEP = 0.0
SUMEX = 0.0
SUMRL = 0.0
SATFAC = 0.0
DO L = 1,NLAYR
RLV(L) = 0.0
SENRT(L) = 0.0
ENDDO
!-----------------------------------------------------------------------
C ROOT DEPTH INCREASE RATE WITH TIME, cm/physiological day
C-----------------------------------------------------------------------
! IF (CROP .NE. 'FA' .AND. ISWWAT .NE. 'N') THEN
IF (CROP .NE. 'FA') THEN
RFAC2 = TABEX(YRTFAC,XRTFAC,0.0,4)
ENDIF
!***********************************************************************
!***********************************************************************
! EMERGENCE CALCULATIONS - Performed once per season upon emergence
! or transplanting of plants
!***********************************************************************
ELSEIF (DYNAMIC .EQ. EMERG) THEN
!-----------------------------------------------------------------------
! Call CSP_INROOT for initialization of root variables on
! day of emergence. (GROW emergence initialization
! must preceed call to INROOT.)
! Note: This may not occur in Casupro, since neither CSP_CASUPRO
! nor CSP_Grow_Cane uses "DYNAMIC .EQ. EMERG" - FSR
!-----------------------------------------------------------------------
CALL CSP_INROOT(
& DLAYR, FRRT, NLAYR, PLTPOP, PLWT, RFAC1, !Input
& RTDEPI, WTNEW, !Input
& RLV, RTDEP) !Output
RFAC3 = RFAC1
TRLV = 0.0
DO L = 1,NLAYR
TRLV = TRLV + RLV(L) * DLAYR(L) ! cm[root] / cm2[ground]
ENDDO
!***********************************************************************
!***********************************************************************
! DAILY RATE/INTEGRATION
!***********************************************************************
ELSEIF (DYNAMIC .EQ. INTEGR) THEN
!-----------------------------------------------------------------------
C Calculate Root Depth Rate of Increase, Physiological Day (RFAC2)
C-----------------------------------------------------------------------
RFAC2 = TABEX(YRTFAC, XRTFAC, VSTAGE, 4)
! RLNEW = WRDOTN * RFAC1 / 10000. ! WRDOTN not used in CASUPRO
! CGRRT = AGRRT * WRDOTN ! WRDOTN not used in CASUPRO
RLNEW = RTDWP(DAS)* PLTPOP * RFAC1 / 10000.
CGRRT = AGRRT * RTDWP(DAS)* PLTPOP
C-----------------------------------------------------------------------
C Calculate root length per cm2 soil and initiate growth,
C respiration and senescence by layer
C-----------------------------------------------------------------------
! TRTDY = 0.0
! 1/19/2006 Remove TRTDY and replace with TRLV -- RLV is only updated
! once, so yesterday's value is stored in TRLV here.
DO L = 1,NLAYR
! TRTDY = TRTDY + RLV(L) * DLAYR(L) ! cm[root] / cm2[ground]
RRLF(L) = 0.0 !Root length density factor ratio (RLDF(L)/TRLDF)
RLSEN(L) = 0.0 !Root length density senesced today (cm/cm3[soil])
RLGRW(L) = 0.0 !Incremental root length density in soil layer L
MRESPR(L) = 0.0 !Maintenance respiration for new root growth in layer L
GRESPR(L) = 0.0 !Growth respiration for new root growth in layer L
RESPS(L) = 0.0 !Total respiration for new root growth in layer L
ENDDO
! Update RFAC3 based on yesterday's root weight and TRLV
! converting root weight from kg/ha to g/m2: RTWTHa(DAS-1)/10
IF ((RTWTHa(DAS-1) /10) - WRDOTN .GE. 0.0001
&. AND. TRLV .GE. 0.00001) THEN
! RFAC3 = TRTDY * 10000.0 / ((RTWTHa(DAS-1)/10) - WRDOTN)
! Since RTWTHa(DAS) has not yet been updated today, use yesterday's
! value and don't subtract out today's growth - chp 11/13/00
RFAC3 = TRLV * 10000.0 / (RTWTHa(DAS-1)/10)
ELSE
RFAC3 = RFAC1
ENDIF
! 10/20/2005 Limit RLV decrease due to senscence to
! a minimum resulting root weight
IF (RTWTMIN > 0.0) THEN
TRLV_MIN = RTWTMIN * RFAC3 / 1.E4 !same units as TRLV
! cm/cm2 = (g/m2) *(cm/g) / (cm2/m2)
ELSE
! Set TRLV_MIN to zero -- no minimum root mass
TRLV_MIN = 0.0
ENDIF
!-----------------------------------------------------------------------
TRLDF = 0.0
CUMDEP = 0.0
SUMEX = 0.0
SUMRL = 0.0
RLV_WS = 0.0
RLSEN = 0.0
DO L = 1,NLAYR
L1 = L
CUMDEP = CUMDEP + DLAYR(L)
SWDF = 1.0
SWEXF = 1.0
C-----------------------------------------------------------------------
C 2/21/05 - SJR - move conditional call for water stress from CROPGRO
C to ROOTS. Allows root senescence when Water dynamics option is
C turned off. Water stress options set to no stress levels. This
C also allows output of root growth dynamics without limimiting
C water or N uptake.
C-----------------------------------------------------------------------
IF (ISWWAT .EQ. 'Y') THEN
IF (SAT(L)-SW(L) .LT. PORMIN) THEN
SWEXF = (SAT(L) - SW(L)) / PORMIN
SWEXF = MIN(SWEXF, 1.0)
ENDIF
SUMEX = SUMEX + DLAYR(L)*RLV(L)*(1.0 - SWEXF)
SUMRL = SUMRL + DLAYR(L)*RLV(L)
ESW(L) = DUL(L) - LL(L)
IF (SW(L) - LL(L) .LT. 0.25*ESW(L)) THEN
SWDF = (SW(L) - LL(L)) / (0.25*ESW(L))
SWDF = MAX(SWDF, 0.0)
ENDIF
ENDIF
C-----------------------------------------------------------------------
RTSURV = MIN(1.0,(1.-RTSDF*(1.-SWDF)),(1.-RTEXF*(1.-SWEXF)))
IF (RLV(L) .GT. RLDSM .AND. TRLV + RLNEW > TRLV_MIN) THEN
! 1/14/2005 CHP Don't subtract water stress senescence
! yet - combine with natural senescence and check to see if
! enough RLV for senescence to occur (TRLV > TRLV_MIN)
!RLV(L) = RLV(L) * RTSURV
RLV_WS(L) = RLV(L) * (1.0 - RTSURV)
ELSE
RLV_WS(L) = 0.0
ENDIF
C-----------------------------------------------------------------------
RLDF(L) = WR(L) * DLAYR(L) * MIN(SWDF,SWEXF)
IF (CUMDEP .LT. RTDEP) THEN
TRLDF = TRLDF + RLDF(L)
ELSE
IF (WR(L) .GT. 0.0 .AND. RLNEW .GT. 0.0) THEN
IF (L .EQ. 1) THEN
RTDEP = RTDEP + DTX * RFAC2
ELSE
RTDEP = RTDEP + DTX * RFAC2 * MIN(SWDF,SWEXF) *
& (1. + 0.25 * (1. - MAX(SWFAC,0.40)))
C-----------------------------------------------------------------------
C-KJB DO NOT WANT TO DECREASE ROOT DEPTH WITH STRESS. IF PG TO ROOTS
C IS LOW BECAUSE OF SEED GROWTH OR IF WATER DEFICIT CAUSES LOW PG TO ROOTS
C DESPITE INCREASED PARTITIONING TO ROOTS, THEN RLV WILL NOT INCREASE
C SO THERE WILL BE NO EFFECTIVE INCREASE IN WATER EXTRACTION. IDEALLY THE
C DECISION SHOULD BE BASED ON AMOUNT OF ROOT GROWTH VS NORMAL UNSTRESS.
C ACCELERATE FROM 1.0 TO 0.5, STAY FLAT, SHOULD DROP AGAIN, 0.5 TO 0.0
C AS THE OTHER FUNCTION ACTS. NOTE: SWFAC*2.0 WAS NOT USED IN ALL 40 CASES
C EXCEPT 1985-RAINFED WHERE DELETING INCREASED YIELD 2764 TO 2770 KG/HA.
C NOW ACCELERATING ROOT GROWTH BY ABOUT 12-13% AT SWFAC=0.50. THIS
C HELPS IOWA 88 AND VEG STRESS TRTS IN 1981 AND 1985. INCR SEED AND BIO.
C-----------------------------------------------------------------------
ENDIF
IF (RTDEP .GT. DEPMAX) THEN
RTDEP = DEPMAX
ENDIF
ENDIF
RLDF(L) = RLDF(L) * (1. - (CUMDEP - RTDEP) / DLAYR(L))
TRLDF = TRLDF + RLDF(L)
GO TO 2900
ENDIF
ENDDO
C-----------------------------------------------------------------------
C Calculate root senescence, growth, maintenance and growth
C respiration, and update root length density for each layer.
!-----------------------------------------------------------------------
2900 CONTINUE
IF (SUMRL .GT. 0.0) THEN
SATFAC = SUMEX/SUMRL
ELSE
SATFAC = 0.0
ENDIF
SRDOT = 0.0
RLSENTOT = 0.0
DO L = 1,L1
IF (TRLDF .LT. 0.00001) THEN
RRLF(L) = 1.0
ELSE
RRLF(L) = RLDF(L)/TRLDF
ENDIF
!-----------------------------------------------------------------------
! MRESPR, GRESPR, and RESPS are not used anywhere
! chp 9/22/98
!-----------------------------------------------------------------------
MRESPR(L) = (RLV(L)/RFAC1*RO*DLAYR(L)*100.0
& +RRLF(L)*FRRT*PGT*RP) * 44.0 / 30.0
GRESPR(L) = RRLF(L) * (CGRRT-WRDOTN) * 44.0 /30.0
RESPS(L) = MRESPR(L) + GRESPR(L)
!-----------------------------------------------------------------------
! RLGRW(L) Incremental root length density in soil layer L
! (cm[root] / cm3[soil])
! RRLF(L) Root length density factor ratio (RLDF(L) / TRLDF)
! RLNEW New root growth added (cm[root]/cm2[ground]/d)
! DLAYR(L) Soil thickness in layer L (cm)
! TRLV Total root length per square cm soil today
! (cm[root]/cm2[soil])
! RLSEN(L) Root length density senesced today (cm[root]/ cm3[soil])
! RTSEN Fraction of existing root length which can be senesced per
! physiological day. (fraction / ptd)
! DTX Thermal time that occurs in a real day based on vegetative
! development temperature function (thermal days / day)
RLGRW(L) = RRLF(L) * RLNEW / DLAYR(L) !cm[root]/cm3[ground]
IF (TRLV + RLNEW > TRLV_MIN) THEN
RLSEN(L) = RLV(L) * RTSEN * DTX
ELSE
RLSEN(L) = 0.0
ENDIF
! Limit total senescence in each layer to existing RLV
IF (RLV(L) - RLSEN(L) - RLV_WS(L) + RLGRW(L) < 0.0) THEN
RLSEN(L) = RLV(L) + RLGRW(L) - RLV_WS(L)
ENDIF
!-----------------------------------------------------------------------
! RLSENTOT is profile senescence, water stress and natural cm/cm2
RLSENTOT = RLSENTOT + (RLSEN(L) + RLV_WS(L)) * DLAYR(L)
ENDDO
! If senescence too high (results in TRLV < TRLV_MIN) then
! reduce senescence in each layer by factor.
IF (RLSENTOT > 1.E-6 .AND. TRLV + RLNEW - RLSENTOT < TRLV_MIN)THEN
FACTOR = (TRLV + RLNEW - TRLV_MIN) / RLSENTOT
FACTOR = MAX(0.0, MIN(1.0, FACTOR))
RLSEN = RLSEN * FACTOR
RLV_WS = RLV_WS * FACTOR
ENDIF
! Update RLV and TRLV based on today's growth and senescence
TRLV = 0.0
DO L = 1, NLAYR
RLV(L) = RLV(L) + RLGRW(L) - RLSEN(L) - RLV_WS(L)
TRLV = TRLV + RLV(L) * DLAYR(L)
! Keep senescence in each layer for adding C and N to soil
!SENRT(L) = RLSEN(L) * DLAYR(L) / RFAC1 * 10000. * 10. !kg/ha
! 1/14/2005 CHP - water stress senesence needs to be inlcuded.
SENRT(L) = (RLSEN(L) + RLV_WS(L)) * DLAYR(L) / RFAC3 * 1.E5
! cm[root] g[root] 1000 cm2 10(kg/ha)
! kg/ha = -------- * cm[soil] * ------- * -------- * ---------
! cm3[soil] cm[root] m2 (g/m2)
SENRT(L) = AMAX1(SENRT(L), 0.0)
SRDOT = SRDOT + SENRT(L)/10. !g/m2
! Not used:
!TRLGRW = TRLGRW + RLGRW(L) * DLAYR(L)
!TRLSEN = TRLSEN + RLSEN(L) * DLAYR(L)
ENDDO
! 11/13/2000 CHP Sum RLSEN for total root senescence today.
! SRDOT = TRLSEN / RFAC3 * 10000. !g/m2
! Total root senescence = water stress + natural senescence
! 10/3/2005 SJR
! SRDOT = (TRTDY + RLNEW - TRLV) * 10000.0 / RFAC3 !g/m2
SRDOT = AMAX1(SRDOT, 0.0)
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!***********************************************************************
RETURN
END !SUBROUTINE CSP_ROOTS
!=======================================================================
C=======================================================================
C CSP_IPROOT Subroutine
C Reads root parameters from input files.
C----------------------------------------------------------------------
C REVISION HISTORY
C 09/13/1998 CHP wrote
C 08/12/2003 CHP Added I/O error checking
C 08/26/2003 FSR Incorporated in CASUPRO sugarcane model as CSP_IPROOT
C-----------------------------------------------------------------------
C Called : CSP_ROOTS
C Calls : FIND, ERROR, IGNORE
C=======================================================================
SUBROUTINE CSP_IPROOT(FILECC, !Input
& PORMIN, RFAC1, RLDSM, RTDEPI, RTEXF, !Output
& RTSEN, RTSDF, RTWTMIN, XRTFAC, YRTFAC) !Output
! ------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
! NL defined in ModuleDefs.for
IMPLICIT NONE
CHARACTER*6 ERRKEY
PARAMETER (ERRKEY = 'ROOTS')
CHARACTER*6 SECTION
CHARACTER*80 CHAR
CHARACTER*92 FILECC
INTEGER LUNCRP, ERR, LNUM, ISECT, FOUND, II
REAL RTDEPI, RLDSM, PORMIN
REAL RFAC1, RTSEN, RTSDF, RTEXF
REAL XRTFAC(4), YRTFAC(4)
! Added 10/20/2005 for minimum root mass for senescence
!CHARACTER (len=7) RWMTXT
REAL RTWTMIN
!-----------------------------------------------------------------------
! ***** READ ROOT GROWTH PARAMETERS *****************
!-----------------------------------------------------------------------
! Read in values from input file, which were previously input
! in Subroutine IPCROP.
!-----------------------------------------------------------------------
CALL GETLUN('FILEC', LUNCRP)
OPEN (LUNCRP,FILE = FILECC, STATUS = 'OLD',IOSTAT=ERR)
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,0)
!-----------------------------------------------------------------------
SECTION = '*#ROOT'
CALL FIND(LUNCRP, SECTION, LNUM, FOUND)
IF (FOUND .EQ. 0) THEN
CALL ERROR(SECTION, 42, FILECC, LNUM)
ELSE
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.2)',IOSTAT=ERR) RTDEPI
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.0)',IOSTAT=ERR) RFAC1
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RTSEN
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.2)',IOSTAT=ERR) RLDSM
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RTSDF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,4F6.1)',IOSTAT=ERR) (XRTFAC(II),II = 1,4)
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,4F6.2)',IOSTAT=ERR) (YRTFAC(II),II = 1,4)
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) PORMIN
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RTEXF
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
CALL IGNORE(LUNCRP,LNUM,ISECT,CHAR)
READ(CHAR,'(13X,F6.3)',IOSTAT=ERR) RTWTMIN
IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILECC,LNUM)
ENDIF
CLOSE (LUNCRP)
!***********************************************************************
RETURN
END SUBROUTINE CSP_IPROOT
!=======================================================================
C=======================================================================
C CSP_INROOT Subroutine
C Initializes root variables at emergence.
C----------------------------------------------------------------------
C REVISION HISTORY
C 04/01/1991 GH Adapted for CROPGRO
C 06/17/1998 CHP Modified for modular format
C 05/11/1999 GH Incorporated in CROPGRO
C 08/26/2003 FSR Incorporated in CASUPRO sugarcane model
C-----------------------------------------------------------------------
C Called : CSP_ROOTS
C Calls : None
C=======================================================================
SUBROUTINE CSP_INROOT(
& DLAYR, FRRT, NLAYR, PLTPOP, PLWT, RFAC1, !Input
& RTDEPI, WTNEW, !Input
& RLV, RTDEP) !Output
! ------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
! NL defined in ModuleDefs.for
IMPLICIT NONE
INTEGER L, NLAYR
REAL DEP,PLWT,RLINIT
REAL RTDEP,RTDEPI,CUMDEP
REAL RFAC1
REAL WTNEW, FRRT, PLTPOP
REAL RLV(NL), DLAYR(NL)
!***********************************************************************
C INITIALIZE ROOT DEPTH AT EMERGENCE
C-----------------------------------------------------------------------
RTDEP = RTDEPI
C-----------------------------------------------------------------------
C DISTRIBUTE ROOT LENGTH EVENLY IN ALL LAYERS TO A DEPTH OF
C RTDEPTI (ROOT DEPTH AT EMERGENCE)
C-----------------------------------------------------------------------
CUMDEP = 0.
WTNEW = PLWT/(PLTPOP*1000)
! WTNEW Initial mass of seedling or seed (g / plant)
! PLWT Fresh weight of seed cane planted in field [(kg/ ha)]
! FSR added to overcome absence of WTNEW value, which was eliminated
! with the old GROW module. This was needed to produce root
! development when water stress is turned on.
DO L = 1,NLAYR
RLV(L) = 0.0
ENDDO
DO L = 1,NLAYR
DEP = MIN(RTDEP - CUMDEP, DLAYR(L))
RLINIT = WTNEW * FRRT * PLTPOP * RFAC1 * DEP / ( RTDEP *
& 10000 )
! cm[root] g[root] plants cm[root] m2
! -------- = -------- * ------ * ------- * ---
! cm2[ground] plant m2 g[root] cm2
CUMDEP = CUMDEP + DEP
RLV(L) = RLINIT / DLAYR(L)
IF (CUMDEP .GE. RTDEP) GO TO 300
ENDDO
300 CONTINUE
!***********************************************************************
RETURN
END !SUBROUTINE CSP_INROOT
!=======================================================================
!-----------------------------------------------------------------------
! Variable definitions
!-----------------------------------------------------------------------
! AGRRT Mass of CH2O required for new root growth (g[CH2O] / g[root])
! CGRRT Carbon demand for new root growth (g[CH2O] / m2 / d)
! CROP Crop identification code
! CUMDEP Cumulative depth of soil profile (cm)
! DEP Cumulative soil depth (cm)
! DEPMAX Maximum depth of reported soil layers (cm)
! DLAYR(L) Soil thickness in layer L (cm)
! DS(L) Cumulative depth in soil layer L (cm)
! DTX Thermal time that occurs in a real day based on vegetative
! development temperature function (thermal days / day)
! DUL(L) Volumetric soil water content at Drained Upper Limit in soil
! layer L (cm3 [H2O] /cm3 [soil])
! DYNAMIC Module control variable; =RUNINIT, SEASINIT, RATE, EMERG,
! INTEGR, OUTPUT, or FINAL
! ESW(L) Plant extractable soil water by layer (= DUL - LL) (cm3/cm3)
! FILECC Path plus filename for species file (*.spe)
! FRRT Fraction of vegetative tissue growth that goes to roots on a
! day (g[root] / g[veg])
! GRESPR(L) Growth respiration for new root growth in layer L
! LL(L) Volumetric soil water content in soil layer L at lower limit
! ( cm3/cm3)
! LUNCRP Logical unit number for FILEC (*.spe file)
! LUNIO Logical unit number for FILEIO
! MRESPR(L) Maintenance respiration for new root growth in layer L
! NL Maximum number of soil layers = 20
! NLAYR Number of soil layers
! PGT Daily gross photosynthesis (g[CH2O] / m2 / d)
! PLTPOP Plant population (# plants / m2)
! PORMIN Minimum pore space required for supplying oxygen to roots for
! optimal growth and function (cm3/cm3)
! RESPS(L) Total respiration for new root growth in layer L
! RFAC1 Root length per unit root weight. (cm/g)
! RFAC2 Root depth increase rate with time (cm / physiol. day)
! RFAC3 Ratio of root length to root weight at the current time (cm/g)
! RLDF(L) Combined weighting factor to determine root growth distribution
! RLDSM Minimum root length density in a given layer, below which
! drought-induced senescence is not allowed.
! (cm [root ]/ cm3 [soil])
! RLGRW(L) Incremental root length density in soil layer L
! (cm[root] / cm3[soil])
! RLINIT Initial root density (cm[root]/cm2[ground])
! RLNEW New root growth added (cm[root]/cm2[ground]/d)
! RLSEN(L) Root length density senesced today (cm[root]/ cm3[soil])
! RLV(L) Root length density for soil layer L (cm[root] / cm3[soil])
! RO Respiration coefficient that depends on total plant mass
! (g[CH2O] / g[tissue])
! RP proportion of the day's photosynthesis which is respired in the
! maintenance process
! RRLF(L) Root length density factor ratio (RLDF(L) / TRLDF)
! RTDEP Root depth (cm)
! RTDEPI Depth of roots on day of plant emergence. (cm)
! RTDWP(i) Root growth increment on day i for the plant (all live stalks)
! g[root tissue] / plant / day
! RTEXF Fraction root death per day under oxygen depleted soil
! RTSDF Maximum fraction of root length senesced in a given layer per
! physiological day when water content in a given layer falls
! below 25 % of extractable soil water.
! RTSEN Fraction of existing root length which can be senesced per
! physiological day. (fraction / ptd)
! RTSURV(L) Fraction survival of roots on a given day, taking into account
! death due to excess or deficit water conditions
! RTWTHa(i) Dry mass of root tissue, including C and N on day i
! (kg[root] / ha[ground])
! SAT(L) Volumetric soil water content in layer L at saturation
! (cm3 [water] / cm3 [soil])
! SATFAC Watterlogging stress factor (0-1.0)
! Root length weighted soil water excess stress factor ( 0 = no
! stress; 1 = saturated stress )
! SENRT(L) Daily senesced matter from roots in soil layer L
! SRDOT Daily root senescence (g / m2 / d)
! SW(L) Volumetric soil water content in layer L
! (cm3 [water] / cm3 [soil])
! SWDF Soil water deficit factor for layer with deepest roots (0-1)
! SWEXF Excess water stress factor for layer with deepest roots (0-1)
! SWFAC Effect of soil-water stress on photosynthesis, 1.0=no stress,
! 0.0=max stress
! TABEX Function subroutine - Lookup utility
! TRLDF Total root length density factor for root depth (cm)
! TRLGRW Total new root length density in soil layer L
! (cm[root] / cm2[soil])
! TRLSEN Total root length density senesced today (cm[root]/ cm2[soil])
! TRLV Total root length per square cm soil today
! (cm[root]/cm2[soil])
! TRTDY Total root length per square cm soil yesterday
! (cm[root]/cm2[soil])
! VSTAGE Number of nodes on main stem of plant
! WR(L) Root hospitality factor, used to compute root distribution
! WRDOTN Dry weight growth rate of new root tissue including N but not C
! reserves (g[root] / m2[ground]-d)
! WTNEW Initial mass of seedling or seed (g / plant)
! XRTFAC(I) V-stage at which rate of increase in root depth per
! physiological day is YRTFAC(I). (# leaf nodes)
! YRTFAC(I) Rate of increase in root depth per degree day at V-stage
! XRTFAC(I). (cm / (physiol. day))
!***********************************************************************
! END SUBROUTINES ROOTS, IPROOT, and INROOT
!=======================================================================