-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathETPHOT.for
1724 lines (1445 loc) · 58.3 KB
/
ETPHOT.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
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
C=======================================================================
C ETPHOT, Subroutine, N.B. Pickering
C Computes canopy daily ET (mm/d) and gross photosynthesis (g CO2/d)
C by integrating over hourly timesteps in the day.
C-----------------------------------------------------------------------
C Zonal ET calculations (MEEVP = 'Z') are for research purposes only
C and are not supported in the CSM v3.9 distribution version
C-----------------------------------------------------------------------
C REVISION HISTORY
C 12/05/1990 NBP Written.
C 11/05/1993 KJB Added layers for SLW and leaf N.
C 11/20/1993 NBP Error checks in SHADOW.
C 11/23/1993 NBP Removed SLW effect from INVEG, all in PGLFEQ
C 12/11/1993 NBP Made calc. of Rsoil larger, removed AWES1, and made
C RWUH greater i.e. less E and more T.
C 12/12/1993 NBP Added avg. soil and surface temps.--passed back.
C 01/27/1994 NBP Added hourly TCAN array and TCANAV--passed back to GPHEN.
C 02/11/1994 NBP Corrected initialization for photo. to NVEG0+1
C 03/13/1994 NBP Added soil layer conversion: 5,15.. cm to 10,10.. cm.
C Switched ET and PG fixed and daily init. routines.
C 04/24/1994 NBP Added TCANDY. Used DAYTIM for FRSHAV. Repl. 24 with TS.
C 03/20/1996 KJB Minimum default LAI decreased from 0.05 to 0.01. This
C artificially held up canopy rate, and used
C in conjunction with VSSINK effects on F, gave very low
C SLA and messed up ability to do low density plantings.
C 02/10/1999 chp changed SWDF1 to SWFAC
C 01/10/2000 NBP Modular version
C 01/13/2000 NBP Added calls to ROOTWU and SWFACS
C 01/13/2000 NBP Added SWFAC effect on PG for MEPHO='L' and MEEVP<>'Z'
C 07/02/2000 GH Eliminate SWFACS section
C 03/29/2001 CHP Added PLTPOP to input variable list (can be modified in
C plant routines). Removed TURFAC (not used)
C 06/21/2001 GH Add seasonal initialization section
C 09/17/2001 CHP PORMIN, RWUMX input from Plant Modules.
C 01/09/2002 CHP SWFAC calculated here.
C 06/11/2002 GH Modified for Y2K
! 10/24/2005 CHP Put weather variables in constructed variable.
! Removed GETPUT_Weather subroutine.
! 01/11/2007 CHP Changed GETPUT calls to GET and PUT
C-----------------------------------------------------------------------
C Called from: SPAM
C Calls: ETIND,ETINP,PGINP,PGIND,RADABS,ETPHR,ROOTWU,SOIL05,SWFACS
C========================================================================
SUBROUTINE ETPHOT (CONTROL, ISWITCH,
& PORMIN, PSTRES1, RLV, RWUMX, SOILPROP, ST, SW, !Input
& WEATHER, XLAI, !Input
& EOP, EP, ES, RWU, TRWUP) !Output
C-----------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
USE ModuleData
IMPLICIT NONE
SAVE
CHARACTER FILEIO*30,ISWWAT*1,MEEVP*1,MEPHO*1,METEMP*1,
& TYPPGN*3,TYPPGL*3, CROP*2
INTEGER DAS,DYNAMIC,H,I,NELAYR,NHOUR,
& NLAYR,NR5, LUNIO
LOGICAL DAYTIM
REAL AGEFAC,AWEV1,AZIR,AZZON(TS),BETA(TS),BETN,
& CANHT,CANWH,CEC,CEN,CLOUDS,CO2,CO2HR,DAYKP,DAYKR,DAYPAR,
& DAYRAD,DLAYR(NL),DLAYR2(NL),DULE,DYABSP,DYABSR,DYINTP,
& DYINTR,EDAY,EHR,EOP,EP,ES,ETNOON,FNPGN(4),FNPGL(4),FRACSH,
& FRDFPN,FRDFRN,FRDIFP(TS),FRDIFR(TS),FRSHAV,FRSHV,
& HS,HOLDHT,KDIRBL,KDRBLV,HOLDLA,LAISH,LAISHV,LAISL,
& LAISLV,LFANGD(3),LFMXSH,LFMXSL,LL(NL),LL2(NL),LLE,LMXSHN,
& LMXSLN,LMXREF,LNREF,LWIDTH,NSLOPE,PALB,PARHR(TS),PARN,PARSH,
& PARSUN(3),PCABPD,PCABPN,PCABRD,PCABRN,PCABSP,PCABSR,PCINPD,
& PCINPN,PCINRD,PCINRN,PCINTP,PCINTR,PCNLSH,PCNLSL,PG,PGCO2,
& PGDAY,SLPF,PGHR,PGNOON,PNLSHN,PNLSLN,QEREF,RABS(3),
& RADHR(TS),RADN,RCUTIC,REFHT,RHUMHR(TS),RLV(NL),RNITP,ROWSPC,
& RWU(NL),RWUH,SALB,SCVIR,SCVP,SHCAP(NL),SLAAD,SLWREF,
& SLWSH,SLWSHN,
& SLWSL,SLWSLN,SLWSLO,SNDN,SNUP,ST(NL),ST2(NL),STCOND(NL),
& SW(NL),SW2(NL),SWFAC,SWE,SWEF,T0HR,TAIRHR(TS),TA,
& TCAN(TS),TCANAV,TCANDY,TDAY,TEMPN,THR,TINCR,TRWUP,
& TSHR(NL),TSRF(3),TSRFN(3),TSURF(3,1),HOLDWH,WINDHR(TS),
& XLAI,
& XLMAXT(6),XSW(NL,3),YLMAXT(6),YSCOND(NL,3),YSHCAP(NL,3),TMIN
REAL SAT(NL),TGRO(TS),TGROAV,TGRODY
REAL PGXX,DXR57,EXCESS,XPOD,CUMSTR,COLDSTR
PARAMETER (TINCR=24.0/TS)
REAL PHTHRS10, PLTPOP
REAL PORMIN, RWUMX
REAL PALBW, SALBW, SRAD, DayRatio
REAL, DIMENSION(NL) :: BD, DUL, SAT2, DUL2, RLV2
REAL PSTRES1 !3/22/2011
! SAVE AZIR,BETN,CEC,DLAYR,DLAYR2,DULE,FNPGL,FNPGN,LFANGD,
! & LL,LL2,LLE,LMXREF,LNREF,LWIDTH,NELAYR,NLAYR,NSLOPE,PALB,
! & SLPF,QEREF,RCUTIC,ROWSPC,RWU,SALB,SAT,SCVIR,SCVP,SLWREF,
! & SLWSLO,SWEF,TYPPGN,TYPPGL,XLMAXT,XSW,YLMAXT,YSCOND,YSHCAP
!-----------------------------------------------------------------------
TYPE (ControlType) CONTROL
TYPE (SoilType) SOILPROP
TYPE (SwitchType) ISWITCH
TYPE (WeatherType) WEATHER
! Transfer values from constructed data types into local variables.
CROP = CONTROL % CROP
DAS = CONTROL % DAS
DYNAMIC = CONTROL % DYNAMIC
FILEIO = CONTROL % FILEIO
LUNIO = CONTROL % LUNIO
BD = SOILPROP % BD
DLAYR = SOILPROP % DLAYR
DUL = SOILPROP % DUL
LL = SOILPROP % LL
NLAYR = SOILPROP % NLAYR
! CHP 7/24/2006
! SOILPROP now includes MSALB (with soil water and mulch effects
! on soil albedo) and CMSALB (also includes canopy cover effects)
SALBW = SOILPROP % SALB
SLPF = SOILPROP % SLPF
SAT = SOILPROP % SAT
ISWWAT = ISWITCH % ISWWAT
MEEVP = ISWITCH % MEEVP
MEPHO = ISWITCH % MEPHO
AZZON = WEATHER % AZZON
BETA = WEATHER % BETA
CLOUDS = WEATHER % CLOUDS
CO2 = WEATHER % CO2
FRDIFP = WEATHER % FRDIFP
FRDIFR = WEATHER % FRDIFR
PARHR = WEATHER % PARHR
RADHR = WEATHER % RADHR
REFHT = WEATHER % REFHT
RHUMHR = WEATHER % RHUMHR
SNDN = WEATHER % SNDN
SNUP = WEATHER % SNUP
SRAD = WEATHER % SRAD
TA = WEATHER % TA
TAIRHR = WEATHER % TAIRHR
TGRO = WEATHER % TGRO !I/O
TGROAV = WEATHER % TGROAV !I/O
TGRODY = WEATHER % TGRODY
TMIN = WEATHER % TMIN
WINDHR = WEATHER % WINDHR
! Retrieve plant module data for use here.
Call GET('PLANT', 'CANHT', CANHT)
Call GET('PLANT', 'CANWH', CANWH)
Call GET('PLANT', 'DXR57', DXR57)
Call GET('PLANT', 'EXCESS', EXCESS)
Call GET('PLANT', 'NR5', NR5)
Call GET('PLANT', 'PLTPOP', PLTPOP)
Call GET('PLANT', 'RNITP', RNITP)
Call GET('PLANT', 'SLAAD', SLAAD)
Call GET('PLANT', 'XPOD', XPOD)
C========================================================================
C MEPHO MEEVP
C ----- -----
C 'C' /='Z' PHOTO used for photosynthesis, WATBAL used for ET
C 'L' /='Z' ETPHOT used for photosynthesis, WATBAL used for ET
C 'L' 'Z' ETPHOT used for both photosynthesis and ET
C========================================================================
C Set MEEVP='N' temporarily if the water balance is not performed.
C MEEVP reset on exit from ETPHOT to maintain input settings.
IF (ISWWAT .EQ. 'N') THEN
METEMP = MEEVP
MEEVP = 'N'
ENDIF
!***********************************************************************
!***********************************************************************
! Run Initialization - Called once per simulation
!***********************************************************************
IF (DYNAMIC .EQ. RUNINIT) THEN
IF (MEEVP .EQ. 'Z') THEN
CALL ETINP(
& BD, DLAYR, DUL, FILEIO, LL, LUNIO, NLAYR, !Input
& SALBW, SAT, !Input
& AZIR, BETN, CEC, DLAYR2, DUL2, DULE, LFANGD, !Output
& LL2, LLE, LWIDTH, NELAYR, PALBW, PHTHRS10, !Output
& RCUTIC, ROWSPC, SAT2, SCVIR,SCVP, SWEF, XSW, !Output
& YSCOND, YSHCAP) !Output
ENDIF
IF (MEPHO .EQ. 'L' .AND. CROP .NE. 'FA') THEN
CALL PGINP(
& FILEIO, LUNIO, SALB, !Input
& AZIR, BETN, FNPGL, FNPGN, LFANGD, LMXREF, !Output
& LNREF, NSLOPE, PALBW, QEREF, ROWSPC, !Output
& SCVP, SLWREF, SLWSLO, TYPPGL, TYPPGN, !Output
& XLMAXT, YLMAXT, PHTHRS10) !Output
CALL OpETPhot(CONTROL, ISWITCH,
& PCINPD, PG, PGNOON, PCINPN, SLWSLN, SLWSHN,
& PNLSLN, PNLSHN, LMXSLN, LMXSHN, TGRO, TGROAV)
ENDIF
!***********************************************************************
!***********************************************************************
! Seasonal initialization - run once per season
!***********************************************************************
ELSEIF (DYNAMIC .EQ. SEASINIT) THEN
!-----------------------------------------------------------------------
IF (MEEVP .EQ. 'Z') THEN
DO I=1,NLAYR
! TSHR(I) = TAV
TSHR(I) = TA
ENDDO
DO I = 1, TS
TGRO(I) = TA
ENDDO
EP = 0.0
ES = 0.0
EOP = 0.0
TGROAV = TA
TGRODY = TA
TEMPN = 0.0
DO I = 1,3
TSRF(I) = TA
TSRFN(I) = TA
ENDDO
CALL ROOTWU(SEASINIT,
& DLAYR, LL, NLAYR, PORMIN, RLV, RWUMX, SAT, SW,!Input
& RWU, TRWUP) !Output
ENDIF
AGEFAC = 1.0
CUMSTR = 0.0
COLDSTR = 0.0
LMXSLN = 0.0
LMXSHN = 0.0
PCINPD = 0.0
PCINPN = 0.0
PG = 0.0
PGNOON = 0.0
PNLSLN = 0.0
PNLSHN = 0.0
SLWSLN = 0.0
SLWSHN = 0.0
SWFAC = 1.0
IF (MEPHO .EQ. 'L') THEN
CALL OpETPhot(CONTROL, ISWITCH,
& PCINPD, PG, PGNOON, PCINPN, SLWSLN, SLWSHN,
& PNLSLN, PNLSHN, LMXSLN, LMXSHN, TGRO, TGROAV)
ENDIF
C***********************************************************************
C***********************************************************************
C COMPUTE DAILY RATES
C***********************************************************************
ELSE IF (DYNAMIC.EQ.RATE) THEN
C Initialize DAILY parameters.
! PLTPOP can change due to pest damage. CHP
IF (ROWSPC.GT.0.0 .AND. PLTPOP.GT.0.0) THEN
BETN = 1.0 / (ROWSPC*PLTPOP)
ELSE
BETN = 0.0
ENDIF
HOLDLA = XLAI
HOLDHT = CANHT
HOLDWH = CANWH
FRSHAV = 0.0
NHOUR = 0
TCANAV = 0.0
TCANDY = 0.0
IF (XLAI.GT.0.0 .AND. XLAI.LT.0.002) XLAI = 0.002
IF (CANHT.GT.0.0 .AND. CANHT.LT.0.01) CANHT = 0.01
IF (CANWH.GT.0.0 .AND. CANWH.LT.0.01) CANWH = 0.01
IF (MEEVP .EQ. 'Z') THEN
CALL ETIND(
& DUL2, RLV, SALBW, SW, !Input
& CEN,DAYRAD,DLAYR2,DULE,DYABSR,DYINTR,EDAY, !Output
& EOP,ETNOON,FRDFRN,LLE,NELAYR,NLAYR,PCABRN, !Output
& PCINRN,RADN,RLV2, SALB, SHCAP,ST2,STCOND,SW2, !Output
& SWE, TDAY,TEMPN,TSRF,TSRFN,XSW,YSCOND,YSHCAP) !Output
CALL ROOTWU(RATE,
& DLAYR, LL, NLAYR, PORMIN, RLV, RWUMX, SAT, SW,!Input
& RWU, TRWUP) !Output
C KJB NOTE TO CP. NEED TO DELETE RWUH HERE, PUT IT INTO HOURLY
C KJB CALL TO ROOTWU, DO WE INITIATE HOURLY? PRIOR TO HOURLY RATE?
C Increase root water uptake rate 5-fold to account for
C instantaeous vs. daily rates and convert to mm/h.
!RWUH = 5.0 * TRWUP * 10.0/24.0
ENDIF
IF (MEPHO .EQ. 'L') THEN
CALL PGIND(
& NLAYR, PALBW, DUL2, SW, !Input
& DAYPAR, DYABSP, DYINTP, FRDFPN, LMXSLN, !Output
& LMXSHN, PALB, PARN, PGCO2, PGDAY, PGNOON, !Output
& PCABPN, PCINPN, PNLSLN, PNLSHN, SLWSLN, !Output
& SLWSHN, SW2) !Output
ENDIF
C Compute hourly rates of canopy photosynthesis and evapotranspiration
C and sum for day (TS=24 for hourly).
! Accounting for hours of high transpiration compared to 24 hours which
! is used by daily model. The 2.0 accounts for lower transpiration
! during early morning hours, with high relative humidity.
DayRatio = 24.0 / (WEATHER % DAYL - 2.0)
DO H=1,TS
C Calculate real and solar time.
HS = REAL(H) * TINCR
IF (HS.GT.SNUP .AND. HS.LT.SNDN) THEN
DAYTIM = .TRUE.
ELSE
DAYTIM = .FALSE.
ENDIF
CO2HR = CO2
C Calculate hourly radiation absorption by canopy/soil.
CALL RADABS(
& AZIR, AZZON(H), BETA(H), BETN, CANHT, CANWH, !Input
& DAYTIM, FRDIFP(H), FRDIFR(H), H, LFANGD, !Input
& MEEVP, MEPHO, PALB, PARHR(H), RADHR(H), !Input
& ROWSPC, SALB, SCVIR, SCVP, XLAI, !Input
& FRACSH, FRSHV, KDIRBL, KDRBLV, LAISH, LAISHV, !Output
& LAISL, LAISLV, PARSH, PARSUN, PCABSP, PCABSR, !Output
& PCINTP, PCINTR, RABS) !Output
C Calculate canopy ET/photosynthesis.
C KJB NOTE TO CP. WE NEED TO CALL ROOTWU INSIDE ETPHR, PASS MODIFIER
C KJB OF RWUMX HERE?
C KJB Possibly call ROOTWU here hourly, so the water content decreases
C KJB progressively with time of day to impact RWUH
C KJB We would need the saved TRWUP from "iterated" transp to be used
C KJB to compute actual water loss, as RWUH is hypothetical until the
C KJB transpiration rate is solved in the loop.
C KJB That would be the option to calling it from within ETPHR. IF
C KJB inside ETPHR, you could use the relative stress of "Now" to
C KJB impact the computed RWUH. Which is safer?
C KJB If inside the loop, we could let the EO have a small influence
C KJB on RWUH, like water potential demand
C
C KJB Present ROOTWU will not work. We need a "psuedo-water content"
C KJB update, so the SW(L) decreases each hour. Can we call EXTRACT
C KJB and SPSUM on an hourly basis? Or put a dummy one in an hourly
C KJB place inside ROOTWU that is called only if we have Z version
C KJB The problem is the need to come back to this after iterative to
C KJB create the actual water extracted. So, need to call EXTRACT
C KJB and SPSUM hourly.
RWUH = TRWUP * RADHR(H) / SRAD * 3600. / 1.E6 * 10.
! mm/h = cm/d * J/m2-s / MJ/m2-d * s/hr / J/MJ * mm/cm
! Need multiplier to account for hourly : daily uptake rate
RWUH = RWUH * DayRatio
CALL ETPHR(
& CANHT, CEC, CEN, CLOUDS, CO2HR, DAYTIM, !Input
& DLAYR2, DULE, FNPGL, FNPGN, FRACSH, FRSHV, !Input
& KDIRBL, LAISH, LAISHV, LAISL, LAISLV, LLE, !Input
& LMXREF, LNREF, LWIDTH, MEEVP, MEPHO, NLAYR, !Input
& NSLOPE, PARSH, PARSUN, QEREF, RABS, RCUTIC, !Input
& REFHT, RHUMHR(H), RNITP, RWUH, SHCAP, SLAAD, !Input
& SLWREF, SLWSLO, STCOND, SWE, TAIRHR(H), TA, !Input
& TMIN, TYPPGL, TYPPGN, WINDHR(H), XLAI, !Input
& XLMAXT, YLMAXT, !Input
& AGEFAC, EHR, LFMXSH, LFMXSL, PCNLSH, PCNLSL, !Output
& PGHR, SLWSH, SLWSL, T0HR, TCAN(H), THR, TSHR, !Output
& TSURF) !Output
C Integrate instantaneous canopy photoynthesis (µmol CO2/m2/s)
C and evapotranspiration (mm/h) to get daily values (g CO2/m2/d
C and mm/d).
IF (MEPHO .EQ. 'L') THEN
PGDAY = PGDAY + TINCR*PGHR*44.0*0.0036
ENDIF
IF (MEEVP .EQ. 'Z') THEN
EDAY = EDAY + TINCR*EHR
TDAY = TDAY + TINCR*THR
EOP = EOP + TINCR*T0HR
DO I=1,NLAYR
ST2(I) = ST2(I) + TSHR(I)
ENDDO
DO I=1,3
TSRF(I) = TSRF(I) + TSURF(I,1)
ENDDO
TCANAV = TCANAV + TCAN(H)
IF (DAYTIM) TCANDY = TCANDY + TCAN(H)
ENDIF
DAYPAR = DAYPAR + TINCR*PARHR(H)*0.0036
DYABSP = DYABSP + TINCR*PCABSP*PARHR(H)*0.000036
DYINTP = DYINTP + TINCR*PCINTP*PARHR(H)*0.000036
DAYRAD = DAYRAD + TINCR*RADHR(H)*0.0036
DYINTR = DYINTR + TINCR*PCINTR*RADHR(H)*0.000036
DYABSR = DYABSR + TINCR*PCABSR*RADHR(H)*0.000036
IF (DAYTIM) THEN
FRSHAV = FRSHAV + FRACSH
NHOUR = NHOUR + 1
ENDIF
C Remember noon values (ET in mm/h; PG in mg CO2/m2/s).
C KJB WE COULD, BUT DON'T NEED, TO REMEMBER A MID-DAY WATER STRESS FACTOR?
IF (H .EQ. 12) THEN
IF (MEPHO .EQ. 'L') THEN
FRDFPN = FRDIFP(H)
LMXSLN = LFMXSL * 0.044
LMXSHN = LFMXSH * 0.044
PARN = PARHR(H)
PCINPN = PCINTP
PCABPN = PCABSP
PGNOON = PGHR * 0.044
PNLSLN = PCNLSL
PNLSHN = PCNLSH
SLWSLN = SLWSL * 1000.
SLWSHN = SLWSH * 1000.
ENDIF
IF (MEEVP .EQ. 'Z') THEN
ETNOON = EHR + THR
RADN = RADHR(H)
FRDFRN = FRDIFR(H)
PCINRN = PCINTR
PCABRN = PCABSR
TEMPN = TAIRHR(H)
DO I=1,3
TSRFN(I) = TSURF(I,1)
ENDDO
ENDIF
ENDIF
ENDDO
C Assign daily values.
XLAI = HOLDLA
CANHT = HOLDHT
CANWH = HOLDWH
IF (MEEVP .EQ. 'Z') THEN
IF (XLAI .GT. 1.E-4) THEN
DAYKR = -LOG((DAYRAD-DYINTR)/DAYRAD) / XLAI
ELSE
DAYKR = 0.0
ENDIF
PCABRD = DYABSR / DAYRAD * 100.0
PCINRD = DYINTR / DAYRAD * 100.0
DO I=1,NLAYR
ST2(I) = ST2(I) / TS
ENDDO
DO I=1,3
TSRF(I) = TSRF(I) / TS
ENDDO
TCANAV = TCANAV / TS
TCANDY = TCANDY / NHOUR
TGRODY = TCANDY
TGROAV = TCANAV
DO I=1,TS
TGRO(I) = TCAN(I)
ENDDO
CALL SOIL05(
& ST2,0,NLAYR, !Input
& ST) !Output
! CALL SOIL05(
! & RWU2, 0, NLAYR,
! & RWU)
!CHP
! AWEV1 = (SW2(1)-LL2(1)*SWEF) * DLAYR2(1) * 10.0
AWEV1 = (SW(1)-LL(1)*SWEF) * DLAYR(1) * 10.0
EP = MAX(TDAY,0.0)
ES = MAX(MIN(EDAY,AWEV1),0.0)
ENDIF
IF (MEPHO .EQ. 'L') THEN
IF (XLAI .GT. 1.E-4) THEN
DAYKP = -LOG((DAYPAR-DYINTP)/DAYPAR) / XLAI
ELSE
DAYKP = 0.0
ENDIF
PCABPD = DYABSP / DAYPAR * 100.0
PCINPD = DYINTP / DAYPAR * 100.0
FRSHAV = FRSHAV / NHOUR
PG = PGDAY/44.0*30.0 * SLPF
PGCO2 = PGDAY * SLPF
!*****************************************
! Calculate daily water stess factors (from SWFACS)
SWFAC = 1.0
IF (EOP .GT. 1.E-4 .AND. ISWWAT .EQ. 'Y') THEN
IF ((EOP * 0.1) .GE. TRWUP) THEN
SWFAC = TRWUP / (EOP * 0.1)
ENDIF
ENDIF
!*****************************************
IF (MEEVP .NE. 'Z') THEN
C
C KJB USE THE REAL MID-DAY WATER STRESS FACTOR HERE, NOT THE DAILY ONE?
C KJB AT LEAST FOR THE PGNOON?
C
! CHP 3/22/2011 - multiply by P stress here.
PG = PG * SWFAC * PSTRES1
PGCO2 = PGCO2 * SWFAC * PSTRES1
LMXSLN = LMXSLN * SWFAC * PSTRES1
LMXSHN = LMXSHN * SWFAC * PSTRES1
PGNOON = PGNOON * SWFAC * PSTRES1
ENDIF
C Post-processing for some stress effects (duplicated in PHOTO).
PGXX = PG
IF (DAS .GT. NR5) THEN
CUMSTR = CUMSTR + DXR57 * (1.0-SWFAC)*XPOD / PHTHRS10
COLDSTR = 0.0
PG = PG * (1.0 - 0.3*CUMSTR)
ELSE
CUMSTR = 0.0
COLDSTR = 0.0
ENDIF
PG = PG * EXCESS
CALL OpETPhot(CONTROL, ISWITCH,
& PCINPD, PG, PGNOON, PCINPN, SLWSLN, SLWSHN,
& PNLSLN, PNLSHN, LMXSLN, LMXSHN, TGRO, TGROAV)
ENDIF
!***********************************************************************
!***********************************************************************
! SEASEND
!***********************************************************************
ELSEIF (DYNAMIC .EQ. SEASEND .OR. DYNAMIC .EQ. OUTPUT) THEN
!-----------------------------------------------------------------------
IF (MEPHO .EQ. 'L') THEN
CALL OpETPhot(CONTROL, ISWITCH,
& PCINPD, PG, PGNOON, PCINPN, SLWSLN, SLWSHN,
& PNLSLN, PNLSHN, LMXSLN, LMXSHN, TGRO, TGROAV)
ENDIF
!***********************************************************************
!***********************************************************************
! END OF DYNAMIC IF CONSTRUCT
!***********************************************************************
ENDIF
!***********************************************************************
IF (ISWWAT .EQ. 'N') THEN
MEEVP = METEMP
METEMP = ' '
ENDIF
! Store PG and AGEFAC for use by PLANT routine.
CALL PUT('SPAM', 'AGEFAC', AGEFAC)
CALL PUT('SPAM', 'PG' , PG)
WEATHER % TGROAV = TGROAV !I/O
WEATHER % TGRO = TGRO !I/O
WEATHER % TGRODY = TGRODY
RETURN
END SUBROUTINE ETPHOT
C=======================================================================
C ETINP, Subroutine, N.B. Pickering, 12/12/90
C Reads in and initializes fixed ET parameters.
C------------------------------------------------------------------------
C REVISION HISTORY
C 12/05/1990 NBP Written.
C 05/10/1994 NBP Added PGFAC3,SLWSLO,LNREF,SLWREF
C 09/21/1999 NBP Moved weather parameters to ETPSIM.
C 09/25/1999 NBP Separate ET and PHOT routines.
C 01/20/2000 NBP Put ETINF in ETINP.
C 08/12/2003 CHP Added I/O error checking
C-----------------------------------------------------------------------
C Called from: ETPHOT
C Calls: ERROR,FIND,SOIL10
C=======================================================================
SUBROUTINE ETINP(
& BD, DLAYR, DUL, FILEIO, LL, LUNIO, NLAYR, !Input
& SALBW, SAT, !Input
& AZIR, BETN, CEC, DLAYR2, DUL2, DULE, LFANGD, !Output
& LL2, LLE, LWIDTH, NELAYR, PALBW, PHTHRS10, !Output
& RCUTIC, ROWSPC, SAT2, SCVIR,SCVP, SWEF, XSW, !Output
& YSCOND, YSHCAP) !Output
! ------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
IMPLICIT NONE
SAVE
CHARACTER BLANK*1,ERRKEY*6,FILEC*12,FILECC*92,FILEIO*30,
& PATHCR*80,SECTION*6
CHARACTER*80 C80
INTEGER ERRNUM,FOUND,I,J,LNUM,LUNCRP,LUNIO,NELAYR,NLAYR,
& PATHL, ISECT
PARAMETER (BLANK=' ', ERRKEY='ETPINP')
REAL AZIR,BD(NL),BD2(NL),BETN,CEC,CORRN, DLAYR(NL),
& DLAYR2(NL),DUL(NL),DUL2(NL),DULE,GA,GC,HCAPS(NL),HCAPS2(NL),
& KSOIL,LFANGB,LFANGD(3),LL(NL),LL2(NL),LLE,LWIDTH,N1,PALBW,
& PLTPOP,RCUTIC,ROWSPC,SALBW, SCVIR,SCVP,
& SWEF,TCAIR,TCNDS2(NL),TCONDS(NL),TCWATR,VHCWAT,XAIR,
& XPORE,XSOIL,XSW(NL,3),XWATER,YSCOND(NL,3),YSHCAP(NL,3),ZERO
PARAMETER (VHCWAT=4.18E+6, TCAIR=0.025, TCWATR=0.57, ZERO=1.0E-6)
REAL PHTHRS10
REAL, DIMENSION(NL) :: SAT, SAT2
C Read IBSNAT35.INP file.
OPEN(LUNIO,FILE=FILEIO,STATUS='OLD',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,0)
SECTION = '*FILES'
CALL FIND(LUNIO,SECTION,LNUM,FOUND)
IF (FOUND .EQ. 0) CALL ERROR(SECTION, 42, FILEIO,LNUM)
READ(LUNIO,'(////,15X,A,1X,A)',IOSTAT=ERRNUM) FILEC,PATHCR
LNUM = LNUM + 5
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
PATHL = INDEX(PATHCR,BLANK)
IF (PATHL .LE. 1) THEN
FILECC = FILEC
ELSE
FILECC = PATHCR(1:(PATHL-1)) // FILEC
ENDIF
REWIND(LUNIO)
SECTION = '*PLANT'
CALL FIND(LUNIO,SECTION,LNUM,FOUND)
IF (FOUND .EQ. 0) CALL ERROR(SECTION, 42, FILEIO,LNUM)
READ(LUNIO,'(24X,F6.0,12X,2F6.0)',IOSTAT=ERRNUM)PLTPOP,ROWSPC,AZIR
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM+1)
DO I = 1,NL
HCAPS(I) = 0.0
TCONDS(I) = 0.0
ENDDO
! PHTHRS(10) needed for calculation of CUMSTR
REWIND(LUNIO)
SECTION = '*CULTI'
CALL FIND(LUNIO, SECTION, LNUM, FOUND)
IF (FOUND .EQ. 0) CALL ERROR (SECTION, 42, FILEIO,LNUM)
READ(LUNIO,'(60X,F6.0)',IOSTAT=ERRNUM) PHTHRS10; LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM)
CLOSE(LUNIO)
C Read species file.
CALL GETLUN('FILEC', LUNCRP)
OPEN(LUNCRP,FILE=FILECC,STATUS='OLD',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,0)
SECTION = '!*PHOT'
CALL FIND(LUNCRP,SECTION,LNUM,FOUND)
DO I=1,8 !Read 8th line of photosynthesis section
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
ENDDO
READ(C80,'(6X,F6.0,6X,F6.0)',IOSTAT=ERRNUM) SCVP,LFANGB
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CLOSE(LUNCRP)
C Initialize some parameters.
SCVIR = 4.0 * SCVP
PALBW = 0.6 * SALBW
ROWSPC = ROWSPC / 100.0
IF (ROWSPC.GT.0.0 .AND. PLTPOP.GT.0.0) THEN
BETN = 1.0 / (ROWSPC*PLTPOP)
ELSE
BETN = 0.0
ENDIF
NELAYR = 1
LWIDTH = 0.02
RCUTIC = 5000.0
DO I = 1,NLAYR
hcaps(i) = 2.17e6
tconds(i) = 7.8
ENDDO
SWEF = 0.9-0.00038*(DLAYR(1)-30.)**2
C Transform soil layers from 5,15,etc. to 10,10,etc. (10 in top layer
C is necessary to prevent instability in ETPHOT).
CALL SOIL10(
& DLAYR, !Input
& 1,NLAYR,DLAYR2) !Output
CALL SOIL10(
& LL, !Input
& 0,NLAYR,LL2) !Output
CALL SOIL10(
& DUL, !Input
& 0,NLAYR,DUL2) !Output
CALL SOIL10(
& SAT, !Input
& 0,NLAYR,SAT2) !Output
CALL SOIL10(
& BD, !Input
& 0,NLAYR,BD2) !Output
CALL SOIL10(
& HCAPS, !Input
& 0,NLAYR,HCAPS2) !Output
CALL SOIL10(
& TCONDS, !Input
& 0,NLAYR,TCNDS2) !Output
C Calculate parameters for E depth (DULE and LLE in mm). CEC starts
C at 0.1 * the 1st stage evaporation amount.
DULE = 0.0
LLE = 0.0
DO I = 1,NELAYR
DULE = DULE + DUL2(I)*DLAYR2(I)*10.0
LLE = LLE + LL2(I)*DLAYR2(I)*10.0
ENDDO
C CEC = 0.45 * U / (DULE-LLE) * 100.0
CEC = 0.0
C Calculate soil thermal properties. Arrays YSHCAP and YSCOND store
C results for daily table lookup as a function of moisture content.
N1 = 5.0
GA = 1.0 / (2.0+N1)
GC = 1.0 - 2.0*GA
DO I=1,NL
DO J=1,3
XSW(I,J) = 0.0
YSHCAP(I,J) = 0.0
YSCOND(I,J) = 0.0
ENDDO
ENDDO
DO I=1,NLAYR
XSOIL = BD2(I)/2.65
XPORE = 1.0 - XSOIL
C Calculate soil heat capacity and thermal conductivity parameters
C using De Vries (1963) for dry, field capacity and saturated
C moisture contents (XSW).
DO J=1,3
C Dry soil.
IF (J .EQ. 1) THEN
XAIR = XPORE
XWATER = 0.0
KSOIL = (2.0 / (1.+(TCNDS2(I)/TCAIR-1.0)*GA)
& + 1.0 / (1.+(TCNDS2(I)/TCAIR-1.0)*GC)) / 3.0
CORRN = 1.25
C Field capacity soil.
ELSE IF (J .EQ. 2) THEN
XAIR = XPORE - DUL2(I)
XWATER = DUL2(I)
KSOIL = (2.0 / (1.+(TCNDS2(I)/TCWATR-1.0)*GA)
& + 1.0 / (1.+(TCNDS2(I)/TCWATR-1.0)*GC)) / 3.0
CORRN = 1.0
C Saturated soil.
ELSE
XAIR = 0.0
XWATER = XPORE
KSOIL = (2.0 / (1.+(TCNDS2(I)/TCWATR-1.0)*GA)
& + 1.0 / (1.+(TCNDS2(I)/TCWATR-1.0)*GC)) / 3.0
CORRN = 1.0
ENDIF
XSW(I,J) = XWATER
YSHCAP(I,J) = HCAPS2(I)*XSOIL + VHCWAT*XWATER
YSCOND(I,J) = (KSOIL*XSOIL*TCNDS2(I)+XWATER*TCWATR+XAIR*TCAIR)
& / (KSOIL*XSOIL+XWATER+XAIR) * CORRN
ENDDO
ENDDO
C Compute leaf angles in three classes (0-30, 30-60, 60-90) using
C the ellipsoidal distribution. Approx. eqn. for CDF at 30 and 60 deg.
LFANGD(1) = 0.936 * (1.0-0.630*EXP(-0.719*LFANGB))**4.950
LFANGD(2) = 0.974 * (1.0-1.109*EXP(-1.037*LFANGB))**1.408
LFANGD(3) = 1.0 - LFANGD(2)
LFANGD(2) = LFANGD(2) - LFANGD(1)
RETURN
END SUBROUTINE ETINP
C=======================================================================
C PGINP, Subroutine, N.B. Pickering, 12/12/90
C Reads and initializes fixed PG parameters.
C-----------------------------------------------------------------------
C REVISION HISTORY
C 12/05/1990 NBP Written.
C 05/10/1994 NBP Added PGFAC3,SLWSLO,LNREF,SLWREF
C 09/21/1999 NBP Moved weather parameters to ETPSIM.
C 09/25/1999 NBP Separate ET and PHOT routines.
C 01/20/2000 NBP Put PGINF in PGINP.
C 07/03/2000 GH Included PHTHRS10
C 08/12/2003 CHP Added I/O error checking
C-----------------------------------------------------------------------
C Called from: ETPHOT
C Calls: ERROR,FIND
C=======================================================================
SUBROUTINE PGINP(
& FILEIO, LUNIO, SALBW, !Input
& AZIR, BETN, FNPGL, FNPGN, LFANGD, LMXREF, !Output
& LNREF, NSLOPE, PALBW, QEREF, ROWSPC, !Output
& SCVP, SLWREF, SLWSLO, TYPPGL, TYPPGN, !Output
& XLMAXT, YLMAXT, PHTHRS10) !Output
IMPLICIT NONE
SAVE
CHARACTER BLANK*1,ERRKEY*6,FILEC*12,FILECC*92,FILEIO*30,
& PATHCR*80,SECTION*6,TYPPGL*3,TYPPGN*3
CHARACTER*80 C80
INTEGER ERRNUM,FOUND,I,LINC,LNUM,LUNCRP,LUNIO,PATHL
INTEGER ISECT
PARAMETER (BLANK=' ', ERRKEY='PGINP ')
REAL AZIR,BETN,FNPGL(4),LFANGB,LFANGD(3),LMXREF,LNREF,NSLOPE,
& PALBW,PLTPOP,QEREF,ROWSPC,SALBW,SCVP,SLWREF,
& SLWSLO,FNPGN(4),XLMAXT(6),YLMAXT(6),PHTHRS10
C Read IBSNAT35.INP file.
OPEN(LUNIO,FILE=FILEIO,STATUS='OLD',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,0)
SECTION = '*FILES'
CALL FIND(LUNIO,SECTION,LNUM,FOUND)
IF (FOUND .EQ. 0) CALL ERROR(SECTION, 42, FILEIO,LNUM)
READ (LUNIO,'(////15X,A,1X,A)',IOSTAT=ERRNUM) FILEC,PATHCR
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM+5)
PATHL = INDEX(PATHCR,BLANK)
IF (PATHL .LE. 1) THEN
FILECC = FILEC
ELSE
FILECC = PATHCR(1:(PATHL-1)) // FILEC
ENDIF
REWIND(LUNIO)
SECTION = '*PLANT'
CALL FIND(LUNIO,SECTION,LNUM,FOUND)
IF (FOUND .EQ. 0) CALL ERROR(SECTION, 42, FILEIO,LNUM)
READ(LUNIO,'(24X,F6.0,12X,2F6.0)',IOSTAT=ERRNUM)PLTPOP,ROWSPC,AZIR
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM+1)
REWIND(LUNIO)
SECTION = '*CULTI'
CALL FIND(LUNIO,SECTION,LNUM,FOUND)
CALL FIND(LUNIO,SECTION,LINC,FOUND) ; LNUM = LNUM + LINC
IF (FOUND .EQ. 0) CALL ERROR(SECTION, 42, FILEIO,LNUM)
C-GH READ(LUNIO,'(72X,F6.0)') LMXREF
READ(LUNIO,'(60X,F6.0,6X,F6.0)',IOSTAT=ERRNUM) PHTHRS10,LMXREF
LNUM = LNUM + 1
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILEIO,LNUM+1)
CLOSE(LUNIO)
C Read species file.
CALL GETLUN('FILEC', LUNCRP)
OPEN(LUNCRP,FILE=FILECC,STATUS='OLD',IOSTAT=ERRNUM)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,0)
SECTION = '!*PHOT'
CALL FIND(LUNCRP,SECTION,LNUM,FOUND)
! Read 3rd line of photosynthesis section of species file
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
READ(C80,'(4F6.0,3X,A)',IOSTAT=ERRNUM) (FNPGN(I),I=1,4), TYPPGN
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80) !5th line
READ(C80,'(6F6.0)',IOSTAT=ERRNUM) (XLMAXT(I),I=1,6)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80) !6th line
READ(C80,'(6F6.0)',IOSTAT=ERRNUM) (YLMAXT(I),I=1,6)
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80) !7th line
READ(C80,'(4F6.0,3X,A)',IOSTAT=ERRNUM) (FNPGL(I),I=1,4),TYPPGL
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM+7)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80) !8th line
READ(C80,'(2F6.0,6X,F6.0)',IOSTAT=ERRNUM) QEREF,SCVP,LFANGB
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CALL IGNORE(LUNCRP,LNUM,ISECT,C80) !9th line
READ(C80,'(4F6.0)',IOSTAT=ERRNUM) SLWREF,SLWSLO,NSLOPE,LNREF
IF (ERRNUM .NE. 0) CALL ERROR(ERRKEY,ERRNUM,FILECC,LNUM)
CLOSE(LUNCRP)
C Initialize some parameters.
PALBW = 0.6 * SALBW
! PGFAC3 = SLPF
ROWSPC = ROWSPC / 100.0
IF (ROWSPC.GT.0.0 .AND. PLTPOP.GT.0.0) THEN
BETN = 1.0 / (ROWSPC*PLTPOP)
ELSE
BETN = 0.0
ENDIF
C Compute leaf angles in three classes (0-30, 30-60, 60-90) using
C the ellipsoidal distribution. Approx. eqn. for CDF at 30 and 60 deg.
LFANGD(1) = 0.936 * (1.0-0.630*EXP(-0.719*LFANGB))**4.950
LFANGD(2) = 0.974 * (1.0-1.109*EXP(-1.037*LFANGB))**1.408
LFANGD(3) = 1.0 - LFANGD(2)
LFANGD(2) = LFANGD(2) - LFANGD(1)
RETURN
END SUBROUTINE PGINP
C=======================================================================
C ETIND, Subroutine, N.B. Pickering
C Initializes daily input variables for ET.
C-----------------------------------------------------------------------
C REVISION HISTORY
C 10/14/92 NBP Written
C 11/23/93 NBP SWE returned to ETPHOT.
C 12/11/93 NBP Made calc. of Rsoil larger, removed AWES1, RWUH greater.
C Added noon variable initialization.
C 03/13/94 NBP Added soil layer conversion: 5,15.. cm to 10,10.. cm.
C 04/24/94 NBP Replaced 24.0 with TS.
C-----------------------------------------------------------------------
C Called from: ETPHOT
C Calls: SOIL10,TABEX
C=======================================================================
SUBROUTINE ETIND(
& DUL2, RLV, SALBW, SW, !Input
& CEN,DAYRAD,DLAYR2,DULE,DYABSR,DYINTR,EDAY, !Output
& EOP,ETNOON,FRDFRN,LLE,NELAYR,NLAYR,PCABRN, !Output
& PCINRN,RADN,RLV2, SALB, SHCAP,ST2,STCOND,SW2, !Output
& SWE, TDAY,TEMPN,TSRF,TSRFN,XSW,YSCOND,YSHCAP) !Output
! ------------------------------------------------------------------
USE ModuleDefs !Definitions of constructed variable types,
! which contain control information, soil
! parameters, hourly weather data.
! NL, TS defined in ModuleDefs.for
IMPLICIT NONE
SAVE
INTEGER I,J,NELAYR,NLAYR
REAL CEN,DAYRAD,DLAYR2(NL),DULE,DYABSR,DYINTR,EDAY,ETNOON,FRDFRN,
& LLE,PCINRN,PCABRN,RADN,SHCAP(NL),ST2(NL),STCOND(NL),
& SW(NL),SW2(NL),SWE,EOP,TABEX,TDAY,TEMPN,TSRF(3),
& TSRFN(3),XC(3),XSW(NL,3),YHC(3),YTC(3),YSCOND(NL,3),
& YSHCAP(NL,3)
REAL SALB, SALBW, SALBD
REAL, DIMENSION(NL) :: DUL2, RLV, RLV2
C Initialize.
EDAY = 0.0
ETNOON = 0.0
FRDFRN = 0.0
EOP = 0.0
TDAY = 0.0
DAYRAD = 0.0