-
Notifications
You must be signed in to change notification settings - Fork 102
/
vegNrgFlux.f90
executable file
·3288 lines (2952 loc) · 265 KB
/
vegNrgFlux.f90
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
! SUMMA - Structure for Unifying Multiple Modeling Alternatives
! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
!
! This file is part of SUMMA
!
! For more information see: http://www.ral.ucar.edu/projects/summa
!
! This program is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
module vegNrgFlux_module
! data types
USE nrtype
! derived types to define the data structures
USE data_types,only:&
var_i, & ! data vector (i4b)
var_d, & ! data vector (dp)
var_ilength, & ! data vector with variable length dimension (i4b)
var_dlength, & ! data vector with variable length dimension (dp)
model_options ! defines the model decisions
! indices that define elements of the data structures
USE var_lookup,only:iLookTYPE ! named variables for structure elements
USE var_lookup,only:iLookPROG ! named variables for structure elements
USE var_lookup,only:iLookDIAG ! named variables for structure elements
USE var_lookup,only:iLookFLUX ! named variables for structure elements
USE var_lookup,only:iLookFORCE ! named variables for structure elements
USE var_lookup,only:iLookPARAM ! named variables for structure elements
USE var_lookup,only:iLookINDEX ! named variables for structure elements
USE var_lookup,only:iLookBVAR ! named variables for structure elements
USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
! constants
USE multiconst,only:gravity ! acceleration of gravity (m s-2)
USE multiconst,only:vkc ! von Karman's constant (-)
USE multiconst,only:w_ratio ! molecular ratio water to dry air (-)
USE multiconst,only:R_wv ! gas constant for water vapor (Pa K-1 m3 kg-1; J kg-1 K-1)
USE multiconst,only:Cp_air ! specific heat of air (J kg-1 K-1)
USE multiconst,only:Cp_ice ! specific heat of ice (J kg-1 K-1)
USE multiconst,only:Cp_soil ! specific heat of soil (J kg-1 K-1)
USE multiconst,only:Cp_water ! specific heat of liquid water (J kg-1 K-1)
USE multiconst,only:Tfreeze ! temperature at freezing (K)
USE multiconst,only:LH_fus ! latent heat of fusion (J kg-1)
USE multiconst,only:LH_vap ! latent heat of vaporization (J kg-1)
USE multiconst,only:LH_sub ! latent heat of sublimation (J kg-1)
USE multiconst,only:sb ! Stefan Boltzman constant (W m-2 K-4)
USE multiconst,only:iden_air ! intrinsic density of air (kg m-3)
USE multiconst,only:iden_ice ! intrinsic density of ice (kg m-3)
USE multiconst,only:iden_water ! intrinsic density of liquid water (kg m-3)
! look-up values for method used to compute derivative
USE mDecisions_module,only: &
numerical, & ! numerical solution
analytical ! analytical solution
! look-up values for choice of boundary conditions for thermodynamics
USE mDecisions_module,only: &
prescribedTemp, & ! prescribed temperature
energyFlux, & ! energy flux
zeroFlux ! zero flux
! look-up values for the choice of parameterization for vegetation roughness length and displacement height
USE mDecisions_module,only: &
Raupach_BLM1994, & ! Raupach (BLM 1994) "Simplified expressions..."
CM_QJRMS1988, & ! Choudhury and Monteith (QJRMS 1988) "A four layer model for the heat budget..."
vegTypeTable ! constant parameters dependent on the vegetation type
! look-up values for the choice of parameterization for canopy emissivity
USE mDecisions_module,only: &
simplExp, & ! simple exponential function
difTrans ! parameterized as a function of diffuse transmissivity
! look-up values for the choice of canopy wind profile
USE mDecisions_module,only: &
exponential, & ! exponential wind profile extends to the surface
logBelowCanopy ! logarithmic profile below the vegetation canopy
! look-up values for choice of stability function
USE mDecisions_module,only: &
standard, & ! standard MO similarity, a la Anderson (1976)
louisInversePower, & ! Louis (1979) inverse power function
mahrtExponential ! Mahrt (1987) exponential
! look-up values for the choice of groundwater representation (local-column, or single-basin)
USE mDecisions_module,only: &
localColumn, & ! separate groundwater representation in each local soil column
singleBasin ! single groundwater store over the entire basin
! -------------------------------------------------------------------------------------------------
! privacy
implicit none
private
public::vegNrgFlux
public::wettedFrac
! dimensions
integer(i4b),parameter :: nBands=2 ! number of spectral bands for shortwave radiation
! named variables
integer(i4b),parameter :: ist = 1 ! Surface type: IST=1 => soil; IST=2 => lake
integer(i4b),parameter :: isc = 4 ! Soil color type
integer(i4b),parameter :: ice = 0 ! Surface type: ICE=0 => soil; ICE=1 => sea-ice
! spatial indices
integer(i4b),parameter :: iLoc = 1 ! i-location
integer(i4b),parameter :: jLoc = 1 ! j-location
! algorithmic parameters
real(dp),parameter :: missingValue=-9999._dp ! missing value, used when diagnostic or state variables are undefined
real(dp),parameter :: verySmall=1.e-6_dp ! used as an additive constant to check if substantial difference among real numbers
real(dp),parameter :: tinyVal=epsilon(1._dp) ! used as an additive constant to check if substantial difference among real numbers
real(dp),parameter :: mpe=1.e-6_dp ! prevents overflow error if division by zero
real(dp),parameter :: dx=1.e-11_dp ! finite difference increment
! control
logical(lgt) :: printflag ! flag to turn on printing
contains
! *******************************************************************************************************
! public subroutine vegNrgFlux: muster program to compute energy fluxes at vegetation and ground surfaces
! *******************************************************************************************************
subroutine vegNrgFlux(&
! input: model control
firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
firstFluxCall, & ! intent(in): flag to indicate if we are processing the first flux call
computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
! input: model state variables
upperBoundTemp, & ! intent(in): temperature of the upper boundary (K) --> NOTE: use air temperature
canairTempTrial, & ! intent(in): trial value of the canopy air space temperature (K)
canopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
groundTempTrial, & ! intent(in): trial value of ground temperature (K)
canopyIceTrial, & ! intent(in): trial value of mass of ice on the vegetation canopy (kg m-2)
canopyLiqTrial, & ! intent(in): trial value of mass of liquid water on the vegetation canopy (kg m-2)
! input: model derivatives
dCanLiq_dTcanopy, & ! intent(in): derivative in canopy liquid w.r.t. canopy temperature (kg m-2 K-1)
! input/output: data structures
type_data, & ! intent(in): type of vegetation and soil
forc_data, & ! intent(in): model forcing data
mpar_data, & ! intent(in): model parameters
indx_data, & ! intent(in): state vector geometry
prog_data, & ! intent(in): model prognostic variables for a local HRU
diag_data, & ! intent(inout): model diagnostic variables for a local HRU
flux_data, & ! intent(inout): model fluxes for a local HRU
bvar_data, & ! intent(in): model variables for the local basin
model_decisions, & ! intent(in): model decisions
! output: liquid water fluxes associated with evaporation/transpiration (needed for coupling)
returnCanopyTranspiration, & ! intent(out): canopy transpiration (kg m-2 s-1)
returnCanopyEvaporation, & ! intent(out): canopy evaporation/condensation (kg m-2 s-1)
returnGroundEvaporation, & ! intent(out): ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
! output: fluxes
canairNetFlux, & ! intent(out): net energy flux for the canopy air space (W m-2)
canopyNetFlux, & ! intent(out): net energy flux for the vegetation canopy (W m-2)
groundNetFlux, & ! intent(out): net energy flux for the ground surface (W m-2)
! output: energy flux derivatives
dCanairNetFlux_dCanairTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
dCanairNetFlux_dCanopyTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
dCanairNetFlux_dGroundTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
dCanopyNetFlux_dCanairTemp, & ! intent(out): derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
dCanopyNetFlux_dCanopyTemp, & ! intent(out): derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
dCanopyNetFlux_dGroundTemp, & ! intent(out): derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
dGroundNetFlux_dCanairTemp, & ! intent(out): derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
dGroundNetFlux_dCanopyTemp, & ! intent(out): derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
dGroundNetFlux_dGroundTemp, & ! intent(out): derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
! output liquid water flux derivarives (canopy evap)
dCanopyEvaporation_dCanLiq, & ! intent(out): derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
dCanopyEvaporation_dTCanair, & ! intent(out): derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
dCanopyEvaporation_dTCanopy, & ! intent(out): derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
dCanopyEvaporation_dTGround, & ! intent(out): derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! output: liquid water flux derivarives (ground evap)
dGroundEvaporation_dCanLiq, & ! intent(out): derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
dGroundEvaporation_dTCanair, & ! intent(out): derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
dGroundEvaporation_dTCanopy, & ! intent(out): derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
dGroundEvaporation_dTGround, & ! intent(out): derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! output: cross derivative terms
dCanopyNetFlux_dCanLiq, & ! intent(out): derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
dGroundNetFlux_dCanLiq, & ! intent(out): derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! output: error control
err,message) ! intent(out): error control
! utilities
USE expIntegral_module,only:expInt ! function to calculate the exponential integral
! conversion functions
USE conv_funcs_module,only:satVapPress ! function to compute the saturated vapor pressure (Pa)
USE conv_funcs_module,only:getLatentHeatValue ! function to identify latent heat of vaporization/sublimation (J kg-1)
! stomatal resistance
USE stomResist_module,only:stomResist ! subroutine to calculate stomatal resistance
! compute energy and mass fluxes for vegetation
implicit none
! ---------------------------------------------------------------------------------------
! * dummy variables
! ---------------------------------------------------------------------------------------
! input: model control
logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
logical(lgt),intent(in) :: firstFluxCall ! flag to indicate if we are processing the first flux call
logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
! input: model state variables
real(dp),intent(in) :: upperBoundTemp ! temperature of the upper boundary (K) --> NOTE: use air temperature
real(dp),intent(in) :: canairTempTrial ! trial value of canopy air space temperature (K)
real(dp),intent(in) :: canopyTempTrial ! trial value of canopy temperature (K)
real(dp),intent(in) :: groundTempTrial ! trial value of ground temperature (K)
real(dp),intent(in) :: canopyIceTrial ! trial value of mass of ice on the vegetation canopy (kg m-2)
real(dp),intent(in) :: canopyLiqTrial ! trial value of mass of liquid water on the vegetation canopy (kg m-2)
! input: model derivatives
real(dp),intent(in) :: dCanLiq_dTcanopy ! intent(in): derivative in canopy liquid w.r.t. canopy temperature (kg m-2 K-1)
! input/output: data structures
type(var_i),intent(in) :: type_data ! type of vegetation and soil
type(var_d),intent(in) :: forc_data ! model forcing data
type(var_dlength),intent(in) :: mpar_data ! model parameters
type(var_ilength),intent(in) :: indx_data ! state vector geometry
type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
type(model_options),intent(in) :: model_decisions(:) ! model decisions
! output: liquid water fluxes associated with evaporation/transpiration (needed for coupling)
real(dp),intent(out) :: returnCanopyTranspiration ! canopy transpiration (kg m-2 s-1)
real(dp),intent(out) :: returnCanopyEvaporation ! canopy evaporation/condensation (kg m-2 s-1)
real(dp),intent(out) :: returnGroundEvaporation ! ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
! output: fluxes
real(dp),intent(out) :: canairNetFlux ! net energy flux for the canopy air space (W m-2)
real(dp),intent(out) :: canopyNetFlux ! net energy flux for the vegetation canopy (W m-2)
real(dp),intent(out) :: groundNetFlux ! net energy flux for the ground surface (W m-2)
! output: energy flux derivatives
real(dp),intent(out) :: dCanairNetFlux_dCanairTemp ! derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
real(dp),intent(out) :: dCanairNetFlux_dCanopyTemp ! derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
real(dp),intent(out) :: dCanairNetFlux_dGroundTemp ! derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
real(dp),intent(out) :: dCanopyNetFlux_dCanairTemp ! derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
real(dp),intent(out) :: dCanopyNetFlux_dCanopyTemp ! derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
real(dp),intent(out) :: dCanopyNetFlux_dGroundTemp ! derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
real(dp),intent(out) :: dGroundNetFlux_dCanairTemp ! derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
real(dp),intent(out) :: dGroundNetFlux_dCanopyTemp ! derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
real(dp),intent(out) :: dGroundNetFlux_dGroundTemp ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
! output: liquid flux derivatives (canopy evap)
real(dp),intent(out) :: dCanopyEvaporation_dCanLiq ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
real(dp),intent(out) :: dCanopyEvaporation_dTCanair ! derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
real(dp),intent(out) :: dCanopyEvaporation_dTCanopy ! derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
real(dp),intent(out) :: dCanopyEvaporation_dTGround ! derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! output: liquid flux derivatives (ground evap)
real(dp),intent(out) :: dGroundEvaporation_dCanLiq ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
real(dp),intent(out) :: dGroundEvaporation_dTCanair ! derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
real(dp),intent(out) :: dGroundEvaporation_dTCanopy ! derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
real(dp),intent(out) :: dGroundEvaporation_dTGround ! derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! output: cross derivative terms
real(dp),intent(out) :: dCanopyNetFlux_dCanLiq ! derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
real(dp),intent(out) :: dGroundNetFlux_dCanLiq ! derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! output: error control
integer(i4b),intent(out) :: err ! error code
character(*),intent(out) :: message ! error message
! ---------------------------------------------------------------------------------------
! * local variables
! ---------------------------------------------------------------------------------------
! local (general)
character(LEN=256) :: cmessage ! error message of downwind routine
real(dp) :: VAI ! vegetation area index (m2 m-2)
real(dp) :: exposedVAI ! exposed vegetation area index (m2 m-2)
real(dp) :: totalCanopyWater ! total water on the vegetation canopy (kg m-2)
real(dp) :: scalarAquiferStorage ! aquifer storage (m)
! local (compute numerical derivatives)
integer(i4b),parameter :: unperturbed=1 ! named variable to identify the case of unperturbed state variables
integer(i4b),parameter :: perturbStateGround=2 ! named variable to identify the case where we perturb the ground temperature
integer(i4b),parameter :: perturbStateCanopy=3 ! named variable to identify the case where we perturb the canopy temperature
integer(i4b),parameter :: perturbStateCanair=4 ! named variable to identify the case where we perturb the canopy air temperature
integer(i4b),parameter :: perturbStateCanLiq=5 ! named variable to identify the case where we perturb the canopy liquid water content
integer(i4b) :: itry ! index of flux evaluation
integer(i4b) :: nFlux ! number of flux evaluations
real(dp) :: groundTemp ! value of ground temperature used in flux calculations (may be perturbed)
real(dp) :: canopyTemp ! value of canopy temperature used in flux calculations (may be perturbed)
real(dp) :: canairTemp ! value of canopy air temperature used in flux calculations (may be perturbed)
real(dp) :: try0,try1 ! trial values to evaluate specific derivatives (testing only)
! local (saturation vapor pressure of veg)
real(dp) :: TV_celcius ! vegetaion temperature (C)
real(dp) :: TG_celcius ! ground temperature (C)
real(dp) :: dSVPCanopy_dCanopyTemp ! derivative in canopy saturated vapor pressure w.r.t. vegetation temperature (Pa/K)
real(dp) :: dSVPGround_dGroundTemp ! derivative in ground saturated vapor pressure w.r.t. ground temperature (Pa/K)
! local (wetted canopy area)
real(dp) :: fracLiquidCanopy ! fraction of liquid water in the canopy (-)
real(dp) :: canopyWetFraction ! trial value of the canopy wetted fraction (-)
real(dp) :: dCanopyWetFraction_dWat ! derivative in wetted fraction w.r.t. canopy total water (kg-1 m2)
real(dp) :: dCanopyWetFraction_dT ! derivative in wetted fraction w.r.t. canopy temperature (K-1)
! local (longwave radiation)
real(dp) :: expi ! exponential integral
real(dp) :: scaleLAI ! scaled LAI (computing diffuse transmissivity)
real(dp) :: diffuseTrans ! diffuse transmissivity (-)
real(dp) :: groundEmissivity ! emissivity of the ground surface (-)
real(dp),parameter :: vegEmissivity=0.98_dp ! emissivity of vegetation (0.9665 in JULES) (-)
real(dp),parameter :: soilEmissivity=0.98_dp ! emmisivity of the soil (0.9665 in JULES) (-)
real(dp),parameter :: snowEmissivity=0.99_dp ! emissivity of snow (-)
real(dp) :: dLWNetCanopy_dTCanopy ! derivative in net canopy radiation w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dLWNetGround_dTGround ! derivative in net ground radiation w.r.t. ground temperature (W m-2 K-1)
real(dp) :: dLWNetCanopy_dTGround ! derivative in net canopy radiation w.r.t. ground temperature (W m-2 K-1)
real(dp) :: dLWNetGround_dTCanopy ! derivative in net ground radiation w.r.t. canopy temperature (W m-2 K-1)
! local (aerodynamic resistance)
real(dp) :: scalarCanopyStabilityCorrection_old ! stability correction for the canopy (-)
real(dp) :: scalarGroundStabilityCorrection_old ! stability correction for the ground surface (-)
! local (turbulent heat transfer)
real(dp) :: z0Ground ! roughness length of the ground (ground below the canopy or non-vegetated surface) (m)
real(dp) :: soilEvapFactor ! soil water control on evaporation from non-vegetated surfaces
real(dp) :: soilRelHumidity_noSnow ! relative humidity in the soil pores [0-1]
real(dp) :: scalarLeafConductance ! leaf conductance (m s-1)
real(dp) :: scalarCanopyConductance ! canopy conductance (m s-1)
real(dp) :: scalarGroundConductanceSH ! ground conductance for sensible heat (m s-1)
real(dp) :: scalarGroundConductanceLH ! ground conductance for latent heat -- includes soil resistance (m s-1)
real(dp) :: scalarEvapConductance ! conductance for evaporation (m s-1)
real(dp) :: scalarTransConductance ! conductance for transpiration (m s-1)
real(dp) :: scalarTotalConductanceSH ! total conductance for sensible heat (m s-1)
real(dp) :: scalarTotalConductanceLH ! total conductance for latent heat (m s-1)
real(dp) :: dGroundResistance_dTGround ! derivative in ground resistance w.r.t. ground temperature (s m-1 K-1)
real(dp) :: dGroundResistance_dTCanopy ! derivative in ground resistance w.r.t. canopy temperature (s m-1 K-1)
real(dp) :: dGroundResistance_dTCanair ! derivative in ground resistance w.r.t. canopy air temperature (s m-1 K-1)
real(dp) :: dCanopyResistance_dTCanopy ! derivative in canopy resistance w.r.t. canopy temperature (s m-1 K-1)
real(dp) :: dCanopyResistance_dTCanair ! derivative in canopy resistance w.r.t. canopy air temperature (s m-1 K-1)
real(dp) :: turbFluxCanair ! total turbulent heat fluxes exchanged at the canopy air space (W m-2)
real(dp) :: turbFluxCanopy ! total turbulent heat fluxes from the canopy to the canopy air space (W m-2)
real(dp) :: turbFluxGround ! total turbulent heat fluxes from the ground to the canopy air space (W m-2)
! local (turbulent heat transfer -- compute numerical derivatives)
! (temporary scalar resistances when states are perturbed)
real(dp) :: trialLeafResistance ! mean leaf boundary layer resistance per unit leaf area (s m-1)
real(dp) :: trialGroundResistance ! below canopy aerodynamic resistance (s m-1)
real(dp) :: trialCanopyResistance ! above canopy aerodynamic resistance (s m-1)
real(dp) :: notUsed_RiBulkCanopy ! bulk Richardson number for the canopy (-)
real(dp) :: notUsed_RiBulkGround ! bulk Richardson number for the ground surface (-)
real(dp) :: notUsed_z0Canopy ! roughness length of the vegetation canopy (m)
real(dp) :: notUsed_WindReductionFactor ! canopy wind reduction factor (-)
real(dp) :: notUsed_ZeroPlaneDisplacement ! zero plane displacement (m)
real(dp) :: notUsed_scalarCanopyStabilityCorrection ! stability correction for the canopy (-)
real(dp) :: notUsed_scalarGroundStabilityCorrection ! stability correction for the ground surface (-)
real(dp) :: notUsed_EddyDiffusCanopyTop ! eddy diffusivity for heat at the top of the canopy (m2 s-1)
real(dp) :: notUsed_FrictionVelocity ! friction velocity (m s-1)
real(dp) :: notUsed_WindspdCanopyTop ! windspeed at the top of the canopy (m s-1)
real(dp) :: notUsed_WindspdCanopyBottom ! windspeed at the height of the bottom of the canopy (m s-1)
real(dp) :: notUsed_dGroundResistance_dTGround ! derivative in ground resistance w.r.t. ground temperature (s m-1 K-1)
real(dp) :: notUsed_dGroundResistance_dTCanopy ! derivative in ground resistance w.r.t. canopy temperature (s m-1 K-1)
real(dp) :: notUsed_dGroundResistance_dTCanair ! derivative in ground resistance w.r.t. canopy air temperature (s m-1 K-1)
real(dp) :: notUsed_dCanopyResistance_dTCanopy ! derivative in canopy resistance w.r.t. canopy temperature (s m-1 K-1)
real(dp) :: notUsed_dCanopyResistance_dTCanair ! derivative in canopy resistance w.r.t. canopy air temperature (s m-1 K-1)
! (fluxes after perturbations in model states -- canopy air space)
real(dp) :: turbFluxCanair_dStateCanair ! turbulent exchange from the canopy air space to the atmosphere, after canopy air temperature is perturbed (W m-2)
real(dp) :: turbFluxCanair_dStateCanopy ! turbulent exchange from the canopy air space to the atmosphere, after canopy temperature is perturbed (W m-2)
real(dp) :: turbFluxCanair_dStateGround ! turbulent exchange from the canopy air space to the atmosphere, after ground temperature is perturbed (W m-2)
real(dp) :: turbFluxCanair_dStateCanliq ! turbulent exchange from the canopy air space to the atmosphere, after canopy liquid water content is perturbed (W m-2)
! (fluxes after perturbations in model states -- vegetation canopy)
real(dp) :: turbFluxCanopy_dStateCanair ! total turbulent heat fluxes from the canopy to the canopy air space, after canopy air temperature is perturbed (W m-2)
real(dp) :: turbFluxCanopy_dStateCanopy ! total turbulent heat fluxes from the canopy to the canopy air space, after canopy temperature is perturbed (W m-2)
real(dp) :: turbFluxCanopy_dStateGround ! total turbulent heat fluxes from the canopy to the canopy air space, after ground temperature is perturbed (W m-2)
real(dp) :: turbFluxCanopy_dStateCanLiq ! total turbulent heat fluxes from the canopy to the canopy air space, after canopy liquid water content is perturbed (W m-2)
! (fluxes after perturbations in model states -- ground surface)
real(dp) :: turbFluxGround_dStateCanair ! total turbulent heat fluxes from the ground to the canopy air space, after canopy air temperature is perturbed (W m-2)
real(dp) :: turbFluxGround_dStateCanopy ! total turbulent heat fluxes from the ground to the canopy air space, after canopy temperature is perturbed (W m-2)
real(dp) :: turbFluxGround_dStateGround ! total turbulent heat fluxes from the ground to the canopy air space, after ground temperature is perturbed (W m-2)
real(dp) :: turbFluxGround_dStateCanLiq ! total turbulent heat fluxes from the ground to the canopy air space, after canopy liquid water content is perturbed (W m-2)
! (fluxes after perturbations in model states -- canopy evaporation)
real(dp) :: latHeatCanEvap_dStateCanair ! canopy evaporation after canopy air temperature is perturbed (W m-2)
real(dp) :: latHeatCanEvap_dStateCanopy ! canopy evaporation after canopy temperature is perturbed (W m-2)
real(dp) :: latHeatCanEvap_dStateGround ! canopy evaporation after ground temperature is perturbed (W m-2)
real(dp) :: latHeatCanEvap_dStateCanLiq ! canopy evaporation after canopy liquid water content is perturbed (W m-2)
! (flux derivatives -- canopy air space)
real(dp) :: dTurbFluxCanair_dTCanair ! derivative in net canopy air space fluxes w.r.t. canopy air temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanair_dTCanopy ! derivative in net canopy air space fluxes w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanair_dTGround ! derivative in net canopy air space fluxes w.r.t. ground temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanair_dCanLiq ! derivative in net canopy air space fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! (flux derivatives -- vegetation canopy)
real(dp) :: dTurbFluxCanopy_dTCanair ! derivative in net canopy turbulent fluxes w.r.t. canopy air temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanopy_dTCanopy ! derivative in net canopy turbulent fluxes w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanopy_dTGround ! derivative in net canopy turbulent fluxes w.r.t. ground temperature (W m-2 K-1)
real(dp) :: dTurbFluxCanopy_dCanLiq ! derivative in net canopy turbulent fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! (flux derivatives -- ground surface)
real(dp) :: dTurbFluxGround_dTCanair ! derivative in net ground turbulent fluxes w.r.t. canopy air temperature (W m-2 K-1)
real(dp) :: dTurbFluxGround_dTCanopy ! derivative in net ground turbulent fluxes w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dTurbFluxGround_dTGround ! derivative in net ground turbulent fluxes w.r.t. ground temperature (W m-2 K-1)
real(dp) :: dTurbFluxGround_dCanLiq ! derivative in net ground turbulent fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! (liquid water flux derivatives -- canopy evap)
real(dp) :: dLatHeatCanopyEvap_dCanLiq ! derivative in latent heat of canopy evaporation w.r.t. canopy liquid water content (W kg-1)
real(dp) :: dLatHeatCanopyEvap_dTCanair ! derivative in latent heat of canopy evaporation w.r.t. canopy air temperature (W m-2 K-1)
real(dp) :: dLatHeatCanopyEvap_dTCanopy ! derivative in latent heat of canopy evaporation w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dLatHeatCanopyEvap_dTGround ! derivative in latent heat of canopy evaporation w.r.t. ground temperature (W m-2 K-1)
! (liquid water flux derivatives -- ground evap)
real(dp) :: dLatHeatGroundEvap_dCanLiq ! derivative in latent heat of ground evaporation w.r.t. canopy liquid water content (J kg-1 s-1)
real(dp) :: dLatHeatGroundEvap_dTCanair ! derivative in latent heat of ground evaporation w.r.t. canopy air temperature (W m-2 K-1)
real(dp) :: dLatHeatGroundEvap_dTCanopy ! derivative in latent heat of ground evaporation w.r.t. canopy temperature (W m-2 K-1)
real(dp) :: dLatHeatGroundEvap_dTGround ! derivative in latent heat of ground evaporation w.r.t. ground temperature (W m-2 K-1)
! ---------------------------------------------------------------------------------------
! point to variables in the data structure
! ---------------------------------------------------------------------------------------
associate(&
! input: model decisions
ix_bcUpprTdyn => model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision, & ! intent(in): [i4b] choice of upper boundary condition for thermodynamics
ix_fDerivMeth => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): [i4b] choice of method to compute derivatives
ix_veg_traits => model_decisions(iLookDECISIONS%veg_traits)%iDecision, & ! intent(in): [i4b] choice of parameterization for vegetation roughness length and displacement height
ix_canopyEmis => model_decisions(iLookDECISIONS%canopyEmis)%iDecision, & ! intent(in): [i4b] choice of parameterization for canopy emissivity
ix_windPrfile => model_decisions(iLookDECISIONS%windPrfile)%iDecision, & ! intent(in): [i4b] choice of canopy wind profile
ix_astability => model_decisions(iLookDECISIONS%astability)%iDecision, & ! intent(in): [i4b] choice of stability function
ix_soilStress => model_decisions(iLookDECISIONS%soilStress)%iDecision, & ! intent(in): [i4b] choice of function for the soil moisture control on stomatal resistance
ix_groundwatr => model_decisions(iLookDECISIONS%groundwatr)%iDecision, & ! intent(in): [i4b] choice of groundwater parameterization
ix_stomResist => model_decisions(iLookDECISIONS%stomResist)%iDecision, & ! intent(in): [i4b] choice of function for stomatal resistance
ix_spatial_gw => model_decisions(iLookDECISIONS%spatial_gw)%iDecision, & ! intent(in): [i4b] choice of groundwater representation (local, basin)
! input: layer geometry
nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): [i4b] number of snow layers
nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1), & ! intent(in): [i4b] number of soil layers
nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1), & ! intent(in): [i4b] total number of layers
! input: physical attributes
vegTypeIndex => type_data%var(iLookTYPE%vegTypeIndex), & ! intent(in): [i4b] vegetation type index
soilTypeIndex => type_data%var(iLookTYPE%soilTypeIndex), & ! intent(in): [i4b] soil type index
! input: vegetation parameters
heightCanopyTop => mpar_data%var(iLookPARAM%heightCanopyTop)%dat(1), & ! intent(in): [dp] height at the top of the vegetation canopy (m)
heightCanopyBottom => mpar_data%var(iLookPARAM%heightCanopyBottom)%dat(1), & ! intent(in): [dp] height at the bottom of the vegetation canopy (m)
canopyWettingFactor => mpar_data%var(iLookPARAM%canopyWettingFactor)%dat(1), & ! intent(in): [dp] maximum wetted fraction of the canopy (-)
canopyWettingExp => mpar_data%var(iLookPARAM%canopyWettingExp)%dat(1), & ! intent(in): [dp] exponent in canopy wetting function (-)
scalarCanopyIceMax => diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1), & ! intent(in): [dp] maximum interception storage capacity for ice (kg m-2)
scalarCanopyLiqMax => diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1), & ! intent(in): [dp] maximum interception storage capacity for liquid water (kg m-2)
! input: vegetation phenology
scalarLAI => diag_data%var(iLookDIAG%scalarLAI)%dat(1), & ! intent(in): [dp] one-sided leaf area index (m2 m-2)
scalarSAI => diag_data%var(iLookDIAG%scalarSAI)%dat(1), & ! intent(in): [dp] one-sided stem area index (m2 m-2)
scalarExposedLAI => diag_data%var(iLookDIAG%scalarExposedLAI)%dat(1), & ! intent(in): [dp] exposed leaf area index after burial by snow (m2 m-2)
scalarExposedSAI => diag_data%var(iLookDIAG%scalarExposedSAI)%dat(1), & ! intent(in): [dp] exposed stem area index after burial by snow (m2 m-2)
scalarGrowingSeasonIndex => diag_data%var(iLookDIAG%scalarGrowingSeasonIndex)%dat(1), & ! intent(in): [dp] growing season index (0=off, 1=on)
scalarFoliageNitrogenFactor => diag_data%var(iLookDIAG%scalarFoliageNitrogenFactor)%dat(1), & ! intent(in): [dp] foliage nitrogen concentration (1.0 = saturated)
! input: aerodynamic resistance parameters
z0Snow => mpar_data%var(iLookPARAM%z0Snow)%dat(1), & ! intent(in): [dp] roughness length of snow (m)
z0Soil => mpar_data%var(iLookPARAM%z0Soil)%dat(1), & ! intent(in): [dp] roughness length of soil (m)
z0CanopyParam => mpar_data%var(iLookPARAM%z0Canopy)%dat(1), & ! intent(in): [dp] roughness length of the canopy (m)
zpdFraction => mpar_data%var(iLookPARAM%zpdFraction)%dat(1), & ! intent(in): [dp] zero plane displacement / canopy height (-)
critRichNumber => mpar_data%var(iLookPARAM%critRichNumber)%dat(1), & ! intent(in): [dp] critical value for the bulk Richardson number where turbulence ceases (-)
Louis79_bparam => mpar_data%var(iLookPARAM%Louis79_bparam)%dat(1), & ! intent(in): [dp] parameter in Louis (1979) stability function
Louis79_cStar => mpar_data%var(iLookPARAM%Louis79_cStar)%dat(1), & ! intent(in): [dp] parameter in Louis (1979) stability function
Mahrt87_eScale => mpar_data%var(iLookPARAM%Mahrt87_eScale)%dat(1), & ! intent(in): [dp] exponential scaling factor in the Mahrt (1987) stability function
windReductionParam => mpar_data%var(iLookPARAM%windReductionParam)%dat(1), & ! intent(in): [dp] canopy wind reduction parameter (-)
leafExchangeCoeff => mpar_data%var(iLookPARAM%leafExchangeCoeff)%dat(1), & ! intent(in): [dp] turbulent exchange coeff between canopy surface and canopy air ( m s-(1/2) )
leafDimension => mpar_data%var(iLookPARAM%leafDimension)%dat(1), & ! intent(in): [dp] characteristic leaf dimension (m)
! input: soil stress parameters
theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat(1), & ! intent(in): [dp] soil porosity (-)
theta_res => mpar_data%var(iLookPARAM%theta_res)%dat(1), & ! intent(in): [dp] residual volumetric liquid water content (-)
plantWiltPsi => mpar_data%var(iLookPARAM%plantWiltPsi)%dat(1), & ! intent(in): [dp] matric head at wilting point (m)
soilStressParam => mpar_data%var(iLookPARAM%soilStressParam)%dat(1), & ! intent(in): [dp] parameter in the exponential soil stress function (-)
critSoilWilting => mpar_data%var(iLookPARAM%critSoilWilting)%dat(1), & ! intent(in): [dp] critical vol. liq. water content when plants are wilting (-)
critSoilTranspire => mpar_data%var(iLookPARAM%critSoilTranspire)%dat(1), & ! intent(in): [dp] critical vol. liq. water content when transpiration is limited (-)
critAquiferTranspire => mpar_data%var(iLookPARAM%critAquiferTranspire)%dat(1), & ! intent(in): [dp] critical aquifer storage value when transpiration is limited (m)
minStomatalResistance => mpar_data%var(iLookPARAM%minStomatalResistance)%dat(1), & ! intent(in): [dp] mimimum stomatal resistance (s m-1)
! input: forcing at the upper boundary
mHeight => diag_data%var(iLookDIAG%scalarAdjMeasHeight)%dat(1), & ! intent(in): [dp] measurement height (m)
airtemp => forc_data%var(iLookFORCE%airtemp), & ! intent(in): [dp] air temperature at some height above the surface (K)
windspd => forc_data%var(iLookFORCE%windspd), & ! intent(in): [dp] wind speed at some height above the surface (m s-1)
airpres => forc_data%var(iLookFORCE%airpres), & ! intent(in): [dp] air pressure at some height above the surface (Pa)
LWRadAtm => forc_data%var(iLookFORCE%LWRadAtm), & ! intent(in): [dp] downwelling longwave radiation at the upper boundary (W m-2)
scalarVPair => diag_data%var(iLookDIAG%scalarVPair)%dat(1), & ! intent(in): [dp] vapor pressure at some height above the surface (Pa)
scalarO2air => diag_data%var(iLookDIAG%scalarO2air)%dat(1), & ! intent(in): [dp] atmospheric o2 concentration (Pa)
scalarCO2air => diag_data%var(iLookDIAG%scalarCO2air)%dat(1), & ! intent(in): [dp] atmospheric co2 concentration (Pa)
scalarTwetbulb => diag_data%var(iLookDIAG%scalarTwetbulb)%dat(1), & ! intent(in): [dp] wetbulb temperature (K)
scalarRainfall => flux_data%var(iLookFLUX%scalarRainfall)%dat(1), & ! intent(in): [dp] computed rainfall rate (kg m-2 s-1)
scalarSnowfall => flux_data%var(iLookFLUX%scalarSnowfall)%dat(1), & ! intent(in): [dp] computed snowfall rate (kg m-2 s-1)
scalarThroughfallRain => flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1), & ! intent(in): [dp] rainfall through the vegetation canopy (kg m-2 s-1)
scalarThroughfallSnow => flux_data%var(iLookFLUX%scalarThroughfallSnow)%dat(1), & ! intent(in): [dp] snowfall through the vegetation canopy (kg m-2 s-1)
! input: water storage
! NOTE: soil stress only computed at the start of the substep (firstFluxCall=.true.)
scalarSWE => prog_data%var(iLookPROG%scalarSWE)%dat(1), & ! intent(in): [dp] snow water equivalent on the ground (kg m-2)
scalarSnowDepth => prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! intent(in): [dp] snow depth on the ground surface (m)
mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat, & ! intent(in): [dp(:)] volumetric fraction of liquid water in each layer (-)
mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat, & ! intent(in): [dp(:)] matric head in each soil layer (m)
localAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1), & ! intent(in): [dp] aquifer storage for the local column (m)
basinAquiferStorage => bvar_data%var(iLookBVAR%basin__AquiferStorage)%dat(1), & ! intent(in): [dp] aquifer storage for the single basin (m)
! input: shortwave radiation fluxes
scalarCanopySunlitLAI => diag_data%var(iLookDIAG%scalarCanopySunlitLAI)%dat(1), & ! intent(in): [dp] sunlit leaf area (-)
scalarCanopyShadedLAI => diag_data%var(iLookDIAG%scalarCanopyShadedLAI)%dat(1), & ! intent(in): [dp] shaded leaf area (-)
scalarCanopySunlitPAR => flux_data%var(iLookFLUX%scalarCanopySunlitPAR)%dat(1), & ! intent(in): [dp] average absorbed par for sunlit leaves (w m-2)
scalarCanopyShadedPAR => flux_data%var(iLookFLUX%scalarCanopyShadedPAR)%dat(1), & ! intent(in): [dp] average absorbed par for shaded leaves (w m-2)
scalarCanopyAbsorbedSolar => flux_data%var(iLookFLUX%scalarCanopyAbsorbedSolar)%dat(1), & ! intent(in): [dp] solar radiation absorbed by canopy (W m-2)
scalarGroundAbsorbedSolar => flux_data%var(iLookFLUX%scalarGroundAbsorbedSolar)%dat(1), & ! intent(in): [dp] solar radiation absorbed by ground (W m-2)
! output: fraction of wetted canopy area and fraction of snow on the ground
scalarCanopyWetFraction => diag_data%var(iLookDIAG%scalarCanopyWetFraction)%dat(1), & ! intent(out): [dp] fraction of canopy that is wet
scalarGroundSnowFraction => diag_data%var(iLookDIAG%scalarGroundSnowFraction)%dat(1), & ! intent(out): [dp] fraction of ground covered with snow (-)
! output: longwave radiation fluxes
scalarCanopyEmissivity => diag_data%var(iLookDIAG%scalarCanopyEmissivity)%dat(1), & ! intent(out): [dp] effective emissivity of the canopy (-)
scalarLWRadCanopy => flux_data%var(iLookFLUX%scalarLWRadCanopy)%dat(1), & ! intent(out): [dp] longwave radiation emitted from the canopy (W m-2)
scalarLWRadGround => flux_data%var(iLookFLUX%scalarLWRadGround)%dat(1), & ! intent(out): [dp] longwave radiation emitted at the ground surface (W m-2)
scalarLWRadUbound2Canopy => flux_data%var(iLookFLUX%scalarLWRadUbound2Canopy)%dat(1), & ! intent(out): [dp] downward atmospheric longwave radiation absorbed by the canopy (W m-2)
scalarLWRadUbound2Ground => flux_data%var(iLookFLUX%scalarLWRadUbound2Ground)%dat(1), & ! intent(out): [dp] downward atmospheric longwave radiation absorbed by the ground (W m-2)
scalarLWRadUbound2Ubound => flux_data%var(iLookFLUX%scalarLWRadUbound2Ubound)%dat(1), & ! intent(out): [dp] atmospheric radiation reflected by the ground and lost thru upper boundary (W m-2)
scalarLWRadCanopy2Ubound => flux_data%var(iLookFLUX%scalarLWRadCanopy2Ubound)%dat(1), & ! intent(out): [dp] longwave radiation emitted from canopy lost thru upper boundary (W m-2)
scalarLWRadCanopy2Ground => flux_data%var(iLookFLUX%scalarLWRadCanopy2Ground)%dat(1), & ! intent(out): [dp] longwave radiation emitted from canopy absorbed by the ground (W m-2)
scalarLWRadCanopy2Canopy => flux_data%var(iLookFLUX%scalarLWRadCanopy2Canopy)%dat(1), & ! intent(out): [dp] canopy longwave reflected from ground and absorbed by the canopy (W m-2)
scalarLWRadGround2Ubound => flux_data%var(iLookFLUX%scalarLWRadGround2Ubound)%dat(1), & ! intent(out): [dp] longwave radiation emitted from ground lost thru upper boundary (W m-2)
scalarLWRadGround2Canopy => flux_data%var(iLookFLUX%scalarLWRadGround2Canopy)%dat(1), & ! intent(out): [dp] longwave radiation emitted from ground and absorbed by the canopy (W m-2)
scalarLWNetCanopy => flux_data%var(iLookFLUX%scalarLWNetCanopy)%dat(1), & ! intent(out): [dp] net longwave radiation at the canopy (W m-2)
scalarLWNetGround => flux_data%var(iLookFLUX%scalarLWNetGround)%dat(1), & ! intent(out): [dp] net longwave radiation at the ground surface (W m-2)
scalarLWNetUbound => flux_data%var(iLookFLUX%scalarLWNetUbound)%dat(1), & ! intent(out): [dp] net longwave radiation at the upper boundary (W m-2)
! output: aerodynamic resistance
scalarZ0Canopy => diag_data%var(iLookDIAG%scalarZ0Canopy)%dat(1), & ! intent(out): [dp] roughness length of the canopy (m)
scalarWindReductionFactor => diag_data%var(iLookDIAG%scalarWindReductionFactor)%dat(1), & ! intent(out): [dp] canopy wind reduction factor (-)
scalarZeroPlaneDisplacement => diag_data%var(iLookDIAG%scalarZeroPlaneDisplacement)%dat(1), & ! intent(out): [dp] zero plane displacement (m)
scalarRiBulkCanopy => diag_data%var(iLookDIAG%scalarRiBulkCanopy)%dat(1), & ! intent(out): [dp] bulk Richardson number for the canopy (-)
scalarRiBulkGround => diag_data%var(iLookDIAG%scalarRiBulkGround)%dat(1), & ! intent(out): [dp] bulk Richardson number for the ground surface (-)
scalarEddyDiffusCanopyTop => flux_data%var(iLookFLUX%scalarEddyDiffusCanopyTop)%dat(1), & ! intent(out): [dp] eddy diffusivity for heat at the top of the canopy (m2 s-1)
scalarFrictionVelocity => flux_data%var(iLookFLUX%scalarFrictionVelocity)%dat(1), & ! intent(out): [dp] friction velocity (m s-1)
scalarWindspdCanopyTop => flux_data%var(iLookFLUX%scalarWindspdCanopyTop)%dat(1), & ! intent(out): [dp] windspeed at the top of the canopy (m s-1)
scalarWindspdCanopyBottom => flux_data%var(iLookFLUX%scalarWindspdCanopyBottom)%dat(1), & ! intent(out): [dp] windspeed at the height of the bottom of the canopy (m s-1)
scalarLeafResistance => flux_data%var(iLookFLUX%scalarLeafResistance)%dat(1), & ! intent(out): [dp] mean leaf boundary layer resistance per unit leaf area (s m-1)
scalarGroundResistance => flux_data%var(iLookFLUX%scalarGroundResistance)%dat(1), & ! intent(out): [dp] below canopy aerodynamic resistance (s m-1)
scalarCanopyResistance => flux_data%var(iLookFLUX%scalarCanopyResistance)%dat(1), & ! intent(out): [dp] above canopy aerodynamic resistance (s m-1)
! input/output: soil resistance -- intent(in) and intent(inout) because only called at the first flux call
mLayerRootDensity => diag_data%var(iLookDIAG%mLayerRootDensity)%dat, & ! intent(in): [dp] root density in each layer (-)
scalarAquiferRootFrac => diag_data%var(iLookDIAG%scalarAquiferRootFrac)%dat(1), & ! intent(in): [dp] fraction of roots below the lowest soil layer (-)
scalarTranspireLim => diag_data%var(iLookDIAG%scalarTranspireLim)%dat(1), & ! intent(inout): [dp] weighted average of the transpiration limiting factor (-)
mLayerTranspireLim => diag_data%var(iLookDIAG%mLayerTranspireLim)%dat, & ! intent(inout): [dp] transpiration limiting factor in each layer (-)
scalarTranspireLimAqfr => diag_data%var(iLookDIAG%scalarTranspireLimAqfr)%dat(1), & ! intent(inout): [dp] transpiration limiting factor for the aquifer (-)
scalarSoilRelHumidity => diag_data%var(iLookDIAG%scalarSoilRelHumidity)%dat(1), & ! intent(inout): [dp] relative humidity in the soil pores [0-1]
scalarSoilResistance => flux_data%var(iLookFLUX%scalarSoilResistance)%dat(1), & ! intent(inout): [dp] resistance from the soil (s m-1)
! input/output: stomatal resistance -- intent(inout) because only called at the first flux call
scalarStomResistSunlit => flux_data%var(iLookFLUX%scalarStomResistSunlit)%dat(1), & ! intent(inout): [dp] stomatal resistance for sunlit leaves (s m-1)
scalarStomResistShaded => flux_data%var(iLookFLUX%scalarStomResistShaded)%dat(1), & ! intent(inout): [dp] stomatal resistance for shaded leaves (s m-1)
scalarPhotosynthesisSunlit => flux_data%var(iLookFLUX%scalarPhotosynthesisSunlit)%dat(1), & ! intent(inout): [dp] sunlit photosynthesis (umolco2 m-2 s-1)
scalarPhotosynthesisShaded => flux_data%var(iLookFLUX%scalarPhotosynthesisShaded)%dat(1), & ! intent(inout): [dp] shaded photosynthesis (umolco2 m-2 s-1)
! output: turbulent heat fluxes
scalarLatHeatSubVapCanopy => diag_data%var(iLookDIAG%scalarLatHeatSubVapCanopy)%dat(1), & ! intent(inout): [dp] latent heat of sublimation/vaporization for the vegetation canopy (J kg-1)
scalarLatHeatSubVapGround => diag_data%var(iLookDIAG%scalarLatHeatSubVapGround)%dat(1), & ! intent(inout): [dp] latent heat of sublimation/vaporization for the ground surface (J kg-1)
scalarSatVP_canopyTemp => diag_data%var(iLookDIAG%scalarSatVP_CanopyTemp)%dat(1), & ! intent(out): [dp] saturation vapor pressure at the temperature of the vegetation canopy (Pa)
scalarSatVP_groundTemp => diag_data%var(iLookDIAG%scalarSatVP_GroundTemp)%dat(1), & ! intent(out): [dp] saturation vapor pressure at the temperature of the ground surface (Pa)
scalarSenHeatTotal => flux_data%var(iLookFLUX%scalarSenHeatTotal)%dat(1), & ! intent(out): [dp] sensible heat from the canopy air space to the atmosphere (W m-2)
scalarSenHeatCanopy => flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1), & ! intent(out): [dp] sensible heat flux from the canopy to the canopy air space (W m-2)
scalarSenHeatGround => flux_data%var(iLookFLUX%scalarSenHeatGround)%dat(1), & ! intent(out): [dp] sensible heat flux from ground surface below vegetation (W m-2)
scalarLatHeatTotal => flux_data%var(iLookFLUX%scalarLatHeatTotal)%dat(1), & ! intent(out): [dp] latent heat from the canopy air space to the atmosphere (W m-2)
scalarLatHeatCanopyEvap => flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1), & ! intent(out): [dp] latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
scalarLatHeatCanopyTrans => flux_data%var(iLookFLUX%scalarLatHeatCanopyTrans)%dat(1), & ! intent(out): [dp] latent heat flux for transpiration from the canopy to the canopy air space (W m-2)
scalarLatHeatGround => flux_data%var(iLookFLUX%scalarLatHeatGround)%dat(1), & ! intent(out): [dp] latent heat flux from ground surface below vegetation (W m-2)
! output: advective heat fluxes
scalarCanopyAdvectiveHeatFlux => flux_data%var(iLookFLUX%scalarCanopyAdvectiveHeatFlux)%dat(1), & ! intent(out): [dp] heat advected to the canopy surface with rain + snow (W m-2)
scalarGroundAdvectiveHeatFlux => flux_data%var(iLookFLUX%scalarGroundAdvectiveHeatFlux)%dat(1), & ! intent(out): [dp] heat advected to the ground surface with throughfall (W m-2)
! output: mass fluxes
scalarCanopySublimation => flux_data%var(iLookFLUX%scalarCanopySublimation)%dat(1), & ! intent(out): [dp] canopy sublimation/frost (kg m-2 s-1)
scalarSnowSublimation => flux_data%var(iLookFLUX%scalarSnowSublimation)%dat(1), & ! intent(out): [dp] snow sublimation/frost -- below canopy or non-vegetated (kg m-2 s-1)
! input/output: canopy air space variables
scalarVP_CanopyAir => diag_data%var(iLookDIAG%scalarVP_CanopyAir)%dat(1), & ! intent(inout): [dp] vapor pressure of the canopy air space (Pa)
scalarCanopyStabilityCorrection => diag_data%var(iLookDIAG%scalarCanopyStabilityCorrection)%dat(1),& ! intent(inout): [dp] stability correction for the canopy (-)
scalarGroundStabilityCorrection => diag_data%var(iLookDIAG%scalarGroundStabilityCorrection)%dat(1),& ! intent(inout): [dp] stability correction for the ground surface (-)
! output: liquid water fluxes
scalarCanopyTranspiration => flux_data%var(iLookFLUX%scalarCanopyTranspiration)%dat(1), & ! intent(out): [dp] canopy transpiration (kg m-2 s-1)
scalarCanopyEvaporation => flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1), & ! intent(out): [dp] canopy evaporation/condensation (kg m-2 s-1)
scalarGroundEvaporation => flux_data%var(iLookFLUX%scalarGroundEvaporation)%dat(1), & ! intent(out): [dp] ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
! output: derived fluxes
scalarTotalET => flux_data%var(iLookFLUX%scalarTotalET)%dat(1), & ! intent(out): [dp] total ET (kg m-2 s-1)
scalarNetRadiation => flux_data%var(iLookFLUX%scalarNetRadiation)%dat(1) & ! intent(out): [dp] net radiation (W m-2)
)
! ---------------------------------------------------------------------------------------
! initialize error control
err=0; message="vegNrgFlux/"
! initialize printflag
printflag = .false.
! identify the type of boundary condition for thermodynamics
select case(ix_bcUpprTdyn)
! *****
! (1) DIRICHLET OR ZERO FLUX BOUNDARY CONDITION...
! ************************************************
! NOTE: Vegetation fluxes are not computed in this case
! ** prescribed temperature or zero flux at the upper boundary of the snow-soil system
case(prescribedTemp,zeroFlux)
! derived fluxes
scalarTotalET = 0._dp ! total ET (kg m-2 s-1)
scalarNetRadiation = 0._dp ! net radiation (W m-2)
! liquid water fluxes associated with evaporation/transpiration
scalarCanopyTranspiration = 0._dp ! canopy transpiration (kg m-2 s-1)
scalarCanopyEvaporation = 0._dp ! canopy evaporation/condensation (kg m-2 s-1)
scalarGroundEvaporation = 0._dp ! ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
! solid water fluxes associated with sublimation/frost
scalarCanopySublimation = 0._dp ! sublimation from the vegetation canopy ((kg m-2 s-1)
scalarSnowSublimation = 0._dp ! sublimation from the snow surface ((kg m-2 s-1)
! set canopy fluxes to zero (no canopy)
canairNetFlux = 0._dp ! net energy flux for the canopy air space (W m-2)
canopyNetFlux = 0._dp ! net energy flux for the vegetation canopy (W m-2)
! set canopy derivatives to zero
dCanairNetFlux_dCanairTemp = 0._dp ! derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
dCanairNetFlux_dCanopyTemp = 0._dp ! derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
dCanairNetFlux_dGroundTemp = 0._dp ! derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
dCanopyNetFlux_dCanairTemp = 0._dp ! derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
dCanopyNetFlux_dCanopyTemp = 0._dp ! derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
dCanopyNetFlux_dGroundTemp = 0._dp ! derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
dGroundNetFlux_dCanairTemp = 0._dp ! derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
dGroundNetFlux_dCanopyTemp = 0._dp ! derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
! set liquid flux derivatives to zero (canopy evap)
dCanopyEvaporation_dCanLiq = 0._dp ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
dCanopyEvaporation_dTCanair= 0._dp ! derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
dCanopyEvaporation_dTCanopy= 0._dp ! derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
dCanopyEvaporation_dTGround= 0._dp ! derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! set liquid flux derivatives to zero (ground evap)
dGroundEvaporation_dCanLiq = 0._dp ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
dGroundEvaporation_dTCanair= 0._dp ! derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
dGroundEvaporation_dTCanopy= 0._dp ! derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
dGroundEvaporation_dTGround= 0._dp ! derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
! compute fluxes and derivatives -- separate approach for prescribed temperature and zero flux
if(ix_bcUpprTdyn == prescribedTemp)then
! compute ground net flux (W m-2)
groundNetFlux = -diag_data%var(iLookDIAG%iLayerThermalC)%dat(0)*(groundTempTrial - upperBoundTemp)/(prog_data%var(iLookPROG%mLayerDepth)%dat(1)*0.5_dp)
! compute derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
dGroundNetFlux_dGroundTemp = -diag_data%var(iLookDIAG%iLayerThermalC)%dat(0)/(prog_data%var(iLookPROG%mLayerDepth)%dat(1)*0.5_dp)
elseif(model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision == zeroFlux)then
groundNetFlux = 0._dp
dGroundNetFlux_dGroundTemp = 0._dp
else
err=20; message=trim(message)//'unable to identify upper boundary condition for thermodynamics: expect the case to be prescribedTemp or zeroFlux'; return
end if
! *****
! (2) NEUMANN BOUNDARY CONDITION...
! *********************************
! NOTE 1: This is the main routine for calculating vegetation fluxes
! NOTE 2: This routine also calculates surface fluxes for the case where vegetation is buried with snow (or bare soil)
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! ***** PRELIMINARIES **********************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! * flux boundary condition
case(energyFlux)
! identify the appropriate groundwater variable
select case(ix_spatial_gw)
case(singleBasin); scalarAquiferStorage = basinAquiferStorage
case(localColumn); scalarAquiferStorage = localAquiferStorage
case default; err=20; message=trim(message)//'unable to identify spatial representation of groundwater'; return
end select ! (modify the groundwater representation for this single-column implementation)
! set canopy stability corrections to the previous values
scalarCanopyStabilityCorrection_old = scalarCanopyStabilityCorrection ! stability correction for the canopy (-)
scalarGroundStabilityCorrection_old = scalarGroundStabilityCorrection ! stability correction for the ground surface (-)
! initialize variables to compute stomatal resistance
if(firstFluxCall .and. firstSubStep)then
! vapor pressure in the canopy air space initialized as vapor pressure of air above the vegetation canopy
! NOTE: this is needed for the stomatal resistance calculations
if(scalarVP_CanopyAir < 0._dp)then
scalarVP_CanopyAir = scalarVPair - 1._dp ! "small" offset used to assist in checking initial derivative calculations
end if
end if
! set latent heat of sublimation/vaporization for canopy and ground surface (Pa/K)
! NOTE: variables are constant over the substep, to simplify relating energy and mass fluxes
if(firstFluxCall)then
scalarLatHeatSubVapCanopy = getLatentHeatValue(canopyTempTrial)
! case when there is snow on the ground (EXCLUDE "snow without a layer" -- in this case, evaporate from the soil)
if(nSnow > 0)then
if(groundTempTrial > Tfreeze)then; err=20; message=trim(message)//'do not expect ground temperature > 0 when snow is on the ground'; return; end if
scalarLatHeatSubVapGround = LH_sub ! sublimation from snow
scalarGroundSnowFraction = 1._dp
! case when the ground is snow-free
else
scalarLatHeatSubVapGround = LH_vap ! evaporation of water in the soil pores: this occurs even if frozen because of super-cooled water
scalarGroundSnowFraction = 0._dp
end if ! (if there is snow on the ground)
end if ! (if the first flux call)
!write(*,'(a,1x,10(f30.10,1x))') 'groundTempTrial, scalarLatHeatSubVapGround = ', groundTempTrial, scalarLatHeatSubVapGround
! compute the roughness length of the ground (ground below the canopy or non-vegetated surface)
z0Ground = z0soil*(1._dp - scalarGroundSnowFraction) + z0Snow*scalarGroundSnowFraction ! roughness length (m)
! compute the total vegetation area index (leaf plus stem)
VAI = scalarLAI + scalarSAI ! vegetation area index
exposedVAI = scalarExposedLAI + scalarExposedSAI ! exposed vegetation area index
! compute emissivity of the canopy (-)
if(computeVegFlux)then
select case(ix_canopyEmis)
! *** simple exponential function
case(simplExp)
scalarCanopyEmissivity = 1._dp - exp(-exposedVAI) ! effective emissivity of the canopy (-)
! *** canopy emissivity parameterized as a function of diffuse transmissivity
case(difTrans)
! compute the exponential integral
scaleLAI = 0.5_dp*exposedVAI
expi = expInt(scaleLAI)
! compute diffuse transmissivity (-)
diffuseTrans = (1._dp - scaleLAI)*exp(-scaleLAI) + (scaleLAI**2._dp)*expi
! compute the canopy emissivity
scalarCanopyEmissivity = (1._dp - diffuseTrans)*vegEmissivity
! *** check we found the correct option
case default
err=20; message=trim(message)//'unable to identify option for canopy emissivity'; return
end select
end if
! ensure canopy longwave fluxes are zero when not computing canopy fluxes
if(.not.computeVegFlux) scalarCanopyEmissivity=0._dp
! compute emissivity of the ground surface (-)
groundEmissivity = scalarGroundSnowFraction*snowEmissivity + (1._dp - scalarGroundSnowFraction)*soilEmissivity ! emissivity of the ground surface (-)
! compute the fraction of canopy that is wet
! NOTE: we either sublimate or evaporate over the entire substep
if(computeVegFlux)then
! compute the fraction of liquid water in the canopy (-)
totalCanopyWater = canopyLiqTrial + canopyIceTrial
if(totalCanopyWater > tiny(1.0_dp))then
fracLiquidCanopy = canopyLiqTrial / (canopyLiqTrial + canopyIceTrial)
else
fracLiquidCanopy = 0._dp
end if
! get wetted fraction and derivatives
call wettedFrac(&
! input
.true., & ! flag to denote if derivative is desired
(ix_fDerivMeth == numerical), & ! flag to denote that numerical derivatives are required (otherwise, analytical derivatives are calculated)
(scalarLatHeatSubVapCanopy > LH_vap+verySmall), & ! flag to denote if the canopy is frozen
dCanLiq_dTcanopy, & ! derivative in canopy liquid w.r.t. canopy temperature (kg m-2 K-1)
fracLiquidCanopy, & ! fraction of liquid water on the canopy (-)
canopyLiqTrial, & ! canopy liquid water (kg m-2)
canopyIceTrial, & ! canopy ice (kg m-2)
scalarCanopyLiqMax, & ! maximum canopy liquid water (kg m-2)
scalarCanopyIceMax, & ! maximum canopy ice content (kg m-2)
canopyWettingFactor, & ! maximum wetted fraction of the canopy (-)
canopyWettingExp, & ! exponent in canopy wetting function (-)
! output
scalarCanopyWetFraction, & ! canopy wetted fraction (-)
dCanopyWetFraction_dWat, & ! derivative in wetted fraction w.r.t. canopy total water (kg-1 m2)
dCanopyWetFraction_dT, & ! derivative in wetted fraction w.r.t. canopy temperature (K-1)
err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
else
scalarCanopyWetFraction = 0._dp ! canopy wetted fraction (-)
dCanopyWetFraction_dWat = 0._dp ! derivative in wetted fraction w.r.t. canopy liquid water (kg-1 m2)
dCanopyWetFraction_dT = 0._dp ! derivative in wetted fraction w.r.t. canopy temperature (K-1)
end if
!write(*,'(a,1x,L1,1x,f25.15,1x))') 'computeVegFlux, scalarCanopyWetFraction = ', computeVegFlux, scalarCanopyWetFraction
!print*, 'dCanopyWetFraction_dWat = ', dCanopyWetFraction_dWat
!print*, 'dCanopyWetFraction_dT = ', dCanopyWetFraction_dT
!print*, 'canopyLiqTrial = ', canopyLiqTrial
!print*, 'canopyIceTrial = ', canopyIceTrial
!print*, 'scalarCanopyLiqMax = ', scalarCanopyLiqMax
!print*, 'scalarCanopyIceMax = ', scalarCanopyIceMax
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! ***** AERODYNAMIC RESISTANCE *****************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! NOTE: compute for all iterations
! compute aerodynamic resistances
! Refs: Choudhury and Monteith (4-layer model for heat budget of homogenous surfaces; QJRMS, 1988)
! Niu and Yang (Canopy effects on snow processes; JGR, 2004)
! Mahat et al. (Below-canopy turbulence in a snowmelt model, WRR, 2012)
call aeroResist(&
! input: model control
computeVegFlux, & ! intent(in): logical flag to compute vegetation fluxes (.false. if veg buried by snow)
(ix_fDerivMeth == analytical), & ! intent(in): logical flag if would like to compute analytical derivaties
ix_veg_traits, & ! intent(in): choice of parameterization for vegetation roughness length and displacement height
ix_windPrfile, & ! intent(in): choice of canopy wind profile
ix_astability, & ! intent(in): choice of stability function
! input: above-canopy forcing data
mHeight, & ! intent(in): measurement height (m)
airtemp, & ! intent(in): air temperature at some height above the surface (K)
windspd, & ! intent(in): wind speed at some height above the surface (m s-1)
! input: canopy and ground temperature
canairTempTrial, & ! intent(in): temperature of the canopy air space (K)
groundTempTrial, & ! intent(in): temperature of the ground surface (K)
! input: diagnostic variables
exposedVAI, & ! intent(in): exposed vegetation area index -- leaf plus stem (m2 m-2)
scalarSnowDepth, & ! intent(in): snow depth (m)
! input: parameters
z0Ground, & ! intent(in): roughness length of the ground (below canopy or non-vegetated surface [snow]) (m)
z0CanopyParam, & ! intent(in): roughness length of the canopy (m)
zpdFraction, & ! intent(in): zero plane displacement / canopy height (-)
critRichNumber, & ! intent(in): critical value for the bulk Richardson number where turbulence ceases (-)
Louis79_bparam, & ! intent(in): parameter in Louis (1979) stability function
Mahrt87_eScale, & ! intent(in): exponential scaling factor in the Mahrt (1987) stability function
windReductionParam, & ! intent(in): canopy wind reduction parameter (-)
leafExchangeCoeff, & ! intent(in): turbulent exchange coeff between canopy surface and canopy air ( m s-(1/2) )
leafDimension, & ! intent(in): characteristic leaf dimension (m)
heightCanopyTop, & ! intent(in): height at the top of the vegetation canopy (m)
heightCanopyBottom, & ! intent(in): height at the bottom of the vegetation canopy (m)
! output: stability corrections
scalarRiBulkCanopy, & ! intent(out): bulk Richardson number for the canopy (-)
scalarRiBulkGround, & ! intent(out): bulk Richardson number for the ground surface (-)
scalarCanopyStabilityCorrection, & ! intent(out): stability correction for the canopy (-)
scalarGroundStabilityCorrection, & ! intent(out): stability correction for the ground surface (-)
! output: scalar resistances
scalarZ0Canopy, & ! intent(out): roughness length of the canopy (m)
scalarWindReductionFactor, & ! intent(out): canopy wind reduction factor (-)
scalarZeroPlaneDisplacement, & ! intent(out): zero plane displacement (m)
scalarEddyDiffusCanopyTop, & ! intent(out): eddy diffusivity for heat at the top of the canopy (m2 s-1)
scalarFrictionVelocity, & ! intent(out): friction velocity (m s-1)
scalarWindspdCanopyTop, & ! intent(out): windspeed at the top of the canopy (m s-1)
scalarWindspdCanopyBottom, & ! intent(out): windspeed at the height of the bottom of the canopy (m s-1)
scalarLeafResistance, & ! intent(out): mean leaf boundary layer resistance per unit leaf area (s m-1)
scalarGroundResistance, & ! intent(out): below canopy aerodynamic resistance (s m-1)
scalarCanopyResistance, & ! intent(out): above canopy aerodynamic resistance (s m-1)
! output: derivatives in scalar resistances
dGroundResistance_dTGround, & ! intent(out): derivative in ground resistance w.r.t. ground temperature (s m-1 K-1)
dGroundResistance_dTCanopy, & ! intent(out): derivative in ground resistance w.r.t. canopy temperature (s m-1 K-1)
dGroundResistance_dTCanair, & ! intent(out): derivative in ground resistance w.r.t. canopy air temperature (s m-1 K-1)
dCanopyResistance_dTCanopy, & ! intent(out): derivative in canopy resistance w.r.t. canopy temperature (s m-1 K-1)
dCanopyResistance_dTCanair, & ! intent(out): derivative in canopy resistance w.r.t. canopy air temperature (s m-1 K-1)
! output: error control
err,cmessage ) ! intent(out): error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
!print*, scalarLeafResistance, & ! mean leaf boundary layer resistance per unit leaf area (s m-1)
! scalarGroundResistance, & ! below canopy aerodynamic resistance (s m-1)
! scalarCanopyResistance, & ! above canopy aerodynamic resistance (s m-1)
! '(leaf, ground, canopy)'
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! ***** STOMATAL RESISTANCE *****************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! stomatal resistance is constant over the SUBSTEP
! NOTE: This is a simplification, as stomatal resistance does depend on canopy temperature
! This "short-cut" made because:
! (1) computations are expensive;
! (2) derivative calculations are rather complex (iterations within the Ball-Berry routine); and
! (3) stomatal resistance does not change rapidly
if(firstFluxCall)then
! compute the saturation vapor pressure for vegetation temperature
TV_celcius = canopyTempTrial - Tfreeze
call satVapPress(TV_celcius, scalarSatVP_CanopyTemp, dSVPCanopy_dCanopyTemp)
! compute soil moisture factor controlling stomatal resistance
call soilResist(&
! input (model decisions)
ix_soilStress, & ! intent(in): choice of function for the soil moisture control on stomatal resistance
ix_groundwatr, & ! intent(in): groundwater parameterization
! input (state variables)
mLayerMatricHead(1:nSoil), & ! intent(in): matric head in each soil layer (m)
mLayerVolFracLiq(nSnow+1:nLayers), & ! intent(in): volumetric fraction of liquid water in each soil layer (-)
scalarAquiferStorage, & ! intent(in): aquifer storage (m)
! input (diagnostic variables)
mLayerRootDensity(1:nSoil), & ! intent(in): root density in each layer (-)
scalarAquiferRootFrac, & ! intent(in): fraction of roots below the lowest soil layer (-)
! input (parameters)
plantWiltPsi, & ! intent(in): matric head at wilting point (m)
soilStressParam, & ! intent(in): parameter in the exponential soil stress function (-)
critSoilWilting, & ! intent(in): critical vol. liq. water content when plants are wilting (-)
critSoilTranspire, & ! intent(in): critical vol. liq. water content when transpiration is limited (-)
critAquiferTranspire, & ! intent(in): critical aquifer storage value when transpiration is limited (m)
! output
scalarTranspireLim, & ! intent(out): weighted average of the transpiration limiting factor (-)
mLayerTranspireLim(1:nSoil), & ! intent(out): transpiration limiting factor in each layer (-)
scalarTranspireLimAqfr, & ! intent(out): transpiration limiting factor for the aquifer (-)
err,cmessage ) ! intent(out): error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
!print*, 'weighted average of the soil moiture factor controlling stomatal resistance (-) = ', scalarTranspireLim
!write(*,'(a,1x,10(f20.10,1x))') 'canopyTempTrial, scalarSatVP_CanopyTemp, scalarVP_CanopyAir = ', &
! canopyTempTrial, scalarSatVP_CanopyTemp, scalarVP_CanopyAir
! compute stomatal resistance
call stomResist(&
! input (state and diagnostic variables)
canopyTempTrial, & ! intent(in): temperature of the vegetation canopy (K)
scalarSatVP_CanopyTemp, & ! intent(in): saturation vapor pressure at the temperature of the veg canopy (Pa)
scalarVP_CanopyAir, & ! intent(in): canopy air vapor pressure (Pa)
! input: data structures
type_data, & ! intent(in): type of vegetation and soil
forc_data, & ! intent(in): model forcing data
mpar_data, & ! intent(in): model parameters
model_decisions, & ! intent(in): model decisions
! input-output: data structures
diag_data, & ! intent(inout): model diagnostic variables for a local HRU
flux_data, & ! intent(inout): model fluxes for a local HRU
! output: error control
err,cmessage ) ! intent(out): error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
end if ! (if the first flux call in a given sub-step)
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! ***** LONGWAVE RADIATION *****************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! compute canopy longwave radiation balance
call longwaveBal(&
! input: model control
ix_fDerivMeth, & ! intent(in): method used to calculate flux derivatives
computeVegFlux, & ! intent(in): flag to compute fluxes over vegetation
! input: canopy and ground temperature
canopyTempTrial, & ! intent(in): temperature of the vegetation canopy (K)
groundTempTrial, & ! intent(in): temperature of the ground surface (K)
! input: canopy and ground emissivity
scalarCanopyEmissivity, & ! intent(in): canopy emissivity (-)
groundEmissivity, & ! intent(in): ground emissivity (-)
! input: forcing
LWRadAtm, & ! intent(in): downwelling longwave radiation at the upper boundary (W m-2)
! output: emitted radiation from the canopy and ground
scalarLWRadCanopy, & ! intent(out): longwave radiation emitted from the canopy (W m-2)
scalarLWRadGround, & ! intent(out): longwave radiation emitted at the ground surface (W m-2)
! output: individual fluxes
scalarLWRadUbound2Canopy, & ! intent(out): downward atmospheric longwave radiation absorbed by the canopy (W m-2)
scalarLWRadUbound2Ground, & ! intent(out): downward atmospheric longwave radiation absorbed by the ground (W m-2)
scalarLWRadUbound2Ubound, & ! intent(out): atmospheric radiation reflected by the ground and lost thru upper boundary (W m-2)
scalarLWRadCanopy2Ubound, & ! intent(out): longwave radiation emitted from canopy lost thru upper boundary (W m-2)
scalarLWRadCanopy2Ground, & ! intent(out): longwave radiation emitted from canopy absorbed by the ground (W m-2)
scalarLWRadCanopy2Canopy, & ! intent(out): canopy longwave reflected from ground and absorbed by the canopy (W m-2)
scalarLWRadGround2Ubound, & ! intent(out): longwave radiation emitted from ground lost thru upper boundary (W m-2)
scalarLWRadGround2Canopy, & ! intent(out): longwave radiation emitted from ground and absorbed by the canopy (W m-2)
! output: net fluxes
scalarLWNetCanopy, & ! intent(out): net longwave radiation at the canopy (W m-2)
scalarLWNetGround, & ! intent(out): net longwave radiation at the ground surface (W m-2)
scalarLWNetUbound, & ! intent(out): net longwave radiation at the upper boundary (W m-2)
! output: flux derivatives
dLWNetCanopy_dTCanopy, & ! intent(out): derivative in net canopy radiation w.r.t. canopy temperature (W m-2 K-1)
dLWNetGround_dTGround, & ! intent(out): derivative in net ground radiation w.r.t. ground temperature (W m-2 K-1)
dLWNetCanopy_dTGround, & ! intent(out): derivative in net canopy radiation w.r.t. ground temperature (W m-2 K-1)
dLWNetGround_dTCanopy, & ! intent(out): derivative in net ground radiation w.r.t. canopy temperature (W m-2 K-1)
! output: error control
err,cmessage ) ! intent(out): error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
!print*, 'dLWNetCanopy_dTGround = ', dLWNetCanopy_dTGround
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! ***** TURBULENT HEAT FLUXES **************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! *******************************************************************************************************************************************************************
! check the need to compute numerical derivatives
if(ix_fDerivMeth == numerical)then
nFlux=5 ! compute the derivatives using one-sided finite differences
else
nFlux=1 ! compute analytical derivatives