forked from NGEET/fates
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathEDTypesMod.F90
1142 lines (879 loc) · 68.5 KB
/
EDTypesMod.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
module EDTypesMod
use FatesConstantsMod, only : r8 => fates_r8
use FatesConstantsMod, only : ifalse
use FatesConstantsMod, only : itrue
use FatesGlobals, only : fates_log
use FatesHydraulicsMemMod, only : ed_cohort_hydr_type
use FatesHydraulicsMemMod, only : ed_site_hydr_type
use PRTGenericMod, only : prt_vartypes
use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ
use PRTGenericMod, only : repro_organ, store_organ, struct_organ
use PRTGenericMod, only : all_carbon_elements
use PRTGenericMod, only : num_organ_types
use PRTGenericMod, only : num_elements
use PRTGenericMod, only : element_list
use PRTGenericMod, only : num_element_types
use FatesLitterMod, only : litter_type
use FatesLitterMod, only : ncwd
use FatesConstantsMod, only : n_anthro_disturbance_categories
use FatesConstantsMod, only : days_per_year
use FatesConstantsMod, only : fates_unset_r8
use FatesRunningMeanMod, only : rmean_type
use FatesInterfaceTypesMod,only : bc_in_type
use FatesInterfaceTypesMod,only : bc_out_type
use EDParamsMod ,only : ED_val_max_cohorts
implicit none
private ! By default everything is private
save
integer, parameter, public :: maxPatchesPerSite = 14 ! maximum number of patches to live on a site
integer, parameter, public :: maxPatchesPerSite_by_disttype(n_anthro_disturbance_categories) = &
(/ 10, 4 /) !!! MUST SUM TO maxPatchesPerSite !!!
integer, public :: maxCohortsPerPatch = ED_val_max_cohorts ! maximum number of cohorts per patch
integer, parameter, public :: nclmax = 2 ! Maximum number of canopy layers
integer, parameter, public :: ican_upper = 1 ! Nominal index for the upper canopy
integer, parameter, public :: ican_ustory = 2 ! Nominal index for diagnostics that refer
! to understory layers (all layers that
! are not the top canopy layer)
integer, parameter, public :: maxpft = 16 ! maximum number of PFTs allowed
! the parameter file may determine that fewer
! are used, but this helps allocate scratch
! space and output arrays.
real(r8), parameter, public :: init_recruit_trim = 0.8_r8 ! This is the initial trimming value that
! new recruits start with
! -------------------------------------------------------------------------------------
! Radiation parameters
! These should be part of the radiation module, but since we only have one option
! this is ok for now. (RGK 04-2018)
! -------------------------------------------------------------------------------------
integer, parameter, public :: n_rad_stream_types = 2 ! The number of radiation streams used (direct/diffuse)
integer, parameter, public :: idirect = 1 ! This is the array index for direct radiation
integer, parameter, public :: idiffuse = 2 ! This is the array index for diffuse radiation
! parameters that govern the VAI (LAI+SAI) bins used in radiative transfer code
integer, parameter, public :: nlevleaf = 30 ! number of leaf+stem layers in canopy layer
real(r8), public :: dinc_vai(nlevleaf) = fates_unset_r8 ! VAI bin widths array
real(r8), public :: dlower_vai(nlevleaf) = fates_unset_r8 ! lower edges of VAI bins
! TODO: we use this cp_maxSWb only because we have a static array q(size=2) of
! land-ice abledo for vis and nir. This should be a parameter, which would
! get us on track to start using multi-spectral or hyper-spectral (RGK 02-2017)
integer, parameter, public :: maxSWb = 2 ! maximum number of broad-bands in the
! shortwave spectrum cp_numSWb <= cp_maxSWb
! this is just for scratch-array purposes
! if cp_numSWb is larger than this value
! simply bump this number up as needed
integer, parameter, public :: ivis = 1 ! This is the array index for short-wave
! radiation in the visible spectrum, as expected
! in boundary condition files and parameter
! files. This will be compared with
! the HLM's expectation in FatesInterfaceMod
integer, parameter, public :: inir = 2 ! This is the array index for short-wave
! radiation in the near-infrared spectrum, as expected
! in boundary condition files and parameter
! files. This will be compared with
! the HLM's expectation in FatesInterfaceMod
integer, parameter, public :: ipar = ivis ! The photosynthetically active band
! can be approximated to be equal to the visible band
integer, parameter, public :: leaves_on = 2 ! Flag specifying that a deciduous plant has leaves
! and should be allocating to them as well
integer, parameter, public :: leaves_off = 1 ! Flag specifying that a deciduous plant has dropped
! its leaves and should not be trying to allocate
! towards any growth.
! Flag to turn on/off salinity effects on the effective "btran"
! btran stress function.
logical, parameter, public :: do_fates_salinity = .false.
! This is the community level amount of spread expected in nearly-bare-ground
! and inventory starting modes.
! These are used to initialize only. These values will scale between
! the PFT defined maximum and minimum crown area scaing parameters.
!
! A value of 1 indicates that
! plants should have crown areas at maximum spread for their size and PFT.
! A value of 0 means that they have the least amount of spread for their
! size and PFT.
real(r8), parameter, public :: init_spread_near_bare_ground = 1.0_r8
real(r8), parameter, public :: init_spread_inventory = 0.0_r8
! MODEL PARAMETERS
real(r8), parameter, public :: area = 10000.0_r8 ! Notional area of simulated forest m2
real(r8), parameter, public :: area_inv = 1.0e-4_r8 ! Inverse of the notion area (faster math)
integer, parameter, public :: numWaterMem = 10 ! watermemory saved as site level var
integer, parameter, public :: numlevsoil_max = 30 ! This is scratch space used for static arrays
! The actual number of soil layers should not exceed this
! BIOLOGY/BIOGEOCHEMISTRY
integer , parameter, public :: num_vegtemp_mem = 10 ! Window of time over which we track temp for cold sensecence (days)
integer , parameter, public :: N_DIST_TYPES = 3 ! Disturbance Modes 1) tree-fall, 2) fire, 3) logging
integer , parameter, public :: dtype_ifall = 1 ! index for naturally occuring tree-fall generated event
integer , parameter, public :: dtype_ifire = 2 ! index for fire generated disturbance event
integer , parameter, public :: dtype_ilog = 3 ! index for logging generated disturbance event
! Phenology status flag definitions (cold type is cstat, dry type is dstat)
integer, parameter, public :: phen_cstat_nevercold = 0 ! This (location/plant) has not experienced a cold period over a large number
! of days, leaves are dropped and flagged as non-cold region
integer, parameter, public :: phen_cstat_iscold = 1 ! This (location/plant) is in a cold-state where leaves should have fallen
integer, parameter, public :: phen_cstat_notcold = 2 ! This site is in a warm-state where leaves are allowed to flush
integer, parameter, public :: phen_dstat_timeoff = 0 ! Leaves off due to time exceedance (drought phenology)
integer, parameter, public :: phen_dstat_moistoff = 1 ! Leaves off due to moisture avail (drought phenology)
integer, parameter, public :: phen_dstat_moiston = 2 ! Leaves on due to moisture avail (drought phenology)
integer, parameter, public :: phen_dstat_timeon = 3 ! Leaves on due to time exceedance (drought phenology)
! SPITFIRE
integer, parameter, public :: NFSC = NCWD+2 ! number fuel size classes (4 cwd size classes, leaf litter, and grass)
integer, parameter, public :: tw_sf = 1 ! array index of twig pool for spitfire
integer, parameter, public :: lb_sf = 3 ! array index of large branch pool for spitfire
integer, parameter, public :: tr_sf = 4 ! array index of dead trunk pool for spitfire
integer, parameter, public :: dl_sf = 5 ! array index of dead leaf pool for spitfire (dead grass and dead leaves)
integer, parameter, public :: lg_sf = 6 ! array index of live grass pool for spitfire
! PATCH FUSION
real(r8), parameter, public :: force_patchfuse_min_biomass = 0.005_r8 ! min biomass (kg / m2 patch area) below which to force-fuse patches
integer , parameter, public :: N_DBH_BINS = 6 ! no. of dbh bins used when comparing patches
real(r8), parameter, public :: patchfusion_dbhbin_loweredges(N_DBH_BINS) = &
(/0._r8, 5._r8, 20._r8, 50._r8, 100._r8, 150._r8/) ! array of bin lower edges for comparing patches
real(r8), parameter, public :: patch_fusion_tolerance_relaxation_increment = 1.1_r8 ! amount by which to increment patch fusion threshold
real(r8), parameter, public :: max_age_of_second_oldest_patch = 200._r8 ! age in years above which to combine all patches
! COHORT FUSION
real(r8), parameter, public :: HITEMAX = 30.0_r8 ! max dbh value used in hgt profile comparison
integer , parameter, public :: N_HITE_BINS = 60 ! no. of hite bins used to distribute LAI
! COHORT TERMINATION
real(r8), parameter, public :: min_npm2 = 1.0E-7_r8 ! minimum cohort number density per m2 before termination
real(r8), parameter, public :: min_patch_area = 0.01_r8 ! smallest allowable patch area before termination
real(r8), parameter, public :: min_patch_area_forced = 0.0001_r8 ! patch termination will not fuse the youngest patch
! if the area is less than min_patch_area.
! however, it is allowed to fuse the youngest patch
! if the fusion area is less than min_patch_area_forced
real(r8), parameter, public :: min_nppatch = min_npm2*min_patch_area ! minimum number of cohorts per patch (min_npm2*min_patch_area)
real(r8), parameter, public :: min_n_safemath = 1.0E-12_r8 ! in some cases, we want to immediately remove super small
! number densities of cohorts to prevent FPEs
character*4 yearchar
! special mode to cause PFTs to create seed mass of all currently-existing PFTs
logical, parameter, public :: homogenize_seed_pfts = .false.
! Global identifier of how nutrients interact with the host land model
! either they are fully coupled, or they generate uptake rates synthetically
! in prescribed mode. In the latter, there is both NO mass removed from the HLM's soil
! BGC N and P pools, and there is also none removed.
integer, public :: n_uptake_mode
integer, public :: p_uptake_mode
!************************************
!** COHORT type structure **
!************************************
type, public :: ed_cohort_type
! POINTERS
type (ed_cohort_type) , pointer :: taller => null() ! pointer to next tallest cohort
type (ed_cohort_type) , pointer :: shorter => null() ! pointer to next shorter cohort
type (ed_patch_type) , pointer :: patchptr => null() ! pointer to patch that cohort is in
! Multi-species, multi-organ Plant Reactive Transport (PRT)
! Contains carbon and nutrient state variables for various plant organs
class(prt_vartypes), pointer :: prt
! VEGETATION STRUCTURE
integer :: pft ! pft number
real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default)
real(r8) :: dbh ! dbh: cm
real(r8) :: coage ! cohort age in years
real(r8) :: hite ! height: meters
integer :: indexnumber ! unique number for each cohort. (within clump?)
real(r8) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv
real(r8) :: sapwmemory ! target sapwood biomass- set from previous year: kGC per indiv
real(r8) :: structmemory ! target structural biomass- set from previous year: kGC per indiv
integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.)
real(r8) :: canopy_layer_yesterday ! recent canopy status of cohort
! (1 = canopy, 2 = understorey, etc.)
! real to be conservative during fusion
real(r8) :: lai ! leaf area index of cohort: m2 leaf area of entire cohort per m2 of canopy area of a patch
real(r8) :: sai ! stem area index of cohort: m2 leaf area of entire cohort per m2 of canopy area of a patch
real(r8) :: g_sb_laweight ! Total conductance (stomata+boundary layer) of the cohort, weighted by its leaf area [m/s]*[m2]
real(r8) :: canopy_trim ! What is the fraction of the maximum leaf biomass that we are targeting? :-
real(r8) :: leaf_cost ! How much does it cost to maintain leaves: kgC/m2/year-1
real(r8) :: excl_weight ! How much of this cohort is demoted each year, as a proportion of all cohorts:-
real(r8) :: prom_weight ! How much of this cohort is promoted each year, as a proportion of all cohorts:-
integer :: nv ! Number of leaf layers: -
integer :: status_coh ! growth status of plant (2 = leaves on , 1 = leaves off)
real(r8) :: c_area ! areal extent of canopy (m2)
real(r8) :: treelai ! lai of an individual within cohort leaf area (m2) / crown area (m2)
real(r8) :: treesai ! stem area index of an indiv. within cohort: stem area (m2) / crown area (m2)
logical :: isnew ! flag to signify a new cohort, new cohorts have not experienced
! npp or mortality and should therefore not be fused or averaged
integer :: size_class ! An index that indicates which diameter size bin the cohort currently resides in
! this is used for history output. We maintain this in the main cohort memory
! because we don't want to continually re-calculate the cohort's position when
! performing size diagnostics at high-frequency calls
integer :: coage_class ! An index that indicates which age bin the cohort currently resides in
! used for history output.
integer :: size_by_pft_class ! An index that indicates the cohorts position of the joint size-class x functional
! type classification. We also maintain this in the main cohort memory
! because we don't want to continually re-calculate the cohort's position when
! performing size diagnostics at high-frequency calls
integer :: coage_by_pft_class ! An index that indicates the cohorts position of the join cohort age class x PFT
integer :: size_class_lasttimestep ! size class of the cohort at the last time step
! CARBON FLUXES
! ----------------------------------------------------------------------------------
! NPP, GPP and RESP: Instantaneous, accumulated and accumulated-hold types.*
!
! _tstep: The instantaneous estimate that is calculated at each rapid plant biophysics
! time-step (ie photosynthesis, sub-hourly). (kgC/indiv/timestep)
! _acc: The accumulation of the _tstep variable from the beginning to ending of
! the dynamics time-scale. This variable is zero'd during initialization and
! after the dynamics call-sequence is completed. (kgC/indiv/day)
! _acc_hold: While _acc is zero'd after the dynamics call sequence and then integrated,
! _acc_hold "holds" the integrated value until the next time dynamics is
! called. This is necessary for restarts. This variable also has units
! converted to a useful rate (kgC/indiv/yr)
! ----------------------------------------------------------------------------------
real(r8) :: gpp_tstep ! Gross Primary Production (see above *)
real(r8) :: gpp_acc
real(r8) :: gpp_acc_hold
real(r8) :: npp_tstep ! Net Primary Production (see above *)
real(r8) :: npp_acc
real(r8) :: npp_acc_hold
real(r8) :: resp_tstep ! Autotrophic respiration (see above *)
real(r8) :: resp_acc
real(r8) :: resp_acc_hold
! carbon 13c discrimination
real(r8) :: c13disc_clm ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/timestep
real(r8) :: c13disc_acc ! carbon 13 discrimination in new synthesized carbon: part-per-mil, at each indiv/day, at the end of a day
! Nutrient Fluxes (if N, P, etc. are turned on)
real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day]
real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day]
real(r8) :: daily_p_uptake ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day]
real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kg C/plant/day]
real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kg N/plant/day]
real(r8) :: daily_p_efflux ! daily mean efflux of excess phophorus from roots into labile pool [kg P/plant/day]
real(r8) :: daily_n_need ! Generic Nitrogen need of the plant, (hypothesis dependent) [kgN/plant/day]
real(r8) :: daily_p_need ! Generic Phosphorus need of the plant, (hypothesis dependent) [kgN/plant/day]
! These two variables may use the previous "need" variables, by applying a smoothing function.
! These variables are used in two scenarios. 1) They work with the prescribed uptake fraction
! in un-coupled mode, and 2) They are the plant's demand subbmitted to the Relative-Demand
! type soil BGC scheme.
real(r8) :: daily_n_demand ! The daily amount of N demanded by the plant [kgN]
real(r8) :: daily_p_demand ! The daily amount of P demanded by the plant [kgN]
! The following four biophysical rates are assumed to be
! at the canopy top, at reference temp 25C, and based on the
! leaf age weighted average of the PFT parameterized values. The last
! condition is why it is dynamic and tied to the cohort
real(r8) :: vcmax25top ! Maximum carboxylation at the cohort's top
! at reference temperature (25C).
real(r8) :: jmax25top ! canopy top: maximum electron transport
! rate at 25C (umol electrons/m**2/s)
real(r8) :: tpu25top ! canopy top: triose phosphate utilization
! rate at 25C (umol CO2/m**2/s)
real(r8) :: kp25top ! canopy top: initial slope of CO2 response
! curve (C4 plants) at 25C
real(r8) :: ts_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/timestep
real(r8) :: year_net_uptake(nlevleaf) ! Net uptake of leaf layers: kgC/m2/year
! RESPIRATION COMPONENTS
real(r8) :: rdark ! Dark respiration: kgC/indiv/s
real(r8) :: resp_g_tstep ! Growth respiration: kgC/indiv/timestep
real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep
real(r8) :: resp_m_def ! Optional: (NOT IMPLEMENTED YET)
! It may be possible to not respire at desired rate
! because of low carbon stores, and thus build
! up a deficit. This tracks that deficit. kgC/indiv
real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s
! (Above ground)
real(r8) :: livecroot_mr ! Live stem maintenance respiration: kgC/indiv/s
! (below ground)
real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s
!MORTALITY
real(r8) :: dmort ! proportional mortality rate. (year-1)
! Mortality Rate Partitions
real(r8) :: bmort ! background mortality rate n/year
real(r8) :: cmort ! carbon starvation mortality rate n/year
real(r8) :: hmort ! hydraulic failure mortality rate n/year
real(r8) :: frmort ! freezing mortality n/year
real(r8) :: smort ! senesence mortality n/year
real(r8) :: asmort ! age senescence mortality n/year
! Logging Mortality Rate
! Yi Xu & M. Huang
real(r8) :: lmort_direct ! directly logging rate fraction /per logging activity
real(r8) :: lmort_collateral ! collaterally damaged rate fraction /per logging activity
real(r8) :: lmort_infra ! mechanically damaged rate fraction /per logging activity
real(r8) :: l_degrad ! rate of trees that are not killed but suffer from forest degradation
! (i.e. they are moved to newly-anthro-disturbed secondary
! forest patch). fraction /per logging activity
real(r8) :: seed_prod ! diagnostic seed production rate [kgC/plant/day]
! NITROGEN POOLS
! ----------------------------------------------------------------------------------
! Nitrogen pools are not prognostic in the current implementation.
! They are diagnosed during photosynthesis using a simple C2N parameter. Local values
! used in that routine.
! ----------------------------------------------------------------------------------
! GROWTH DERIVIATIVES
real(r8) :: dndt ! time derivative of cohort size : n/year
real(r8) :: dhdt ! time derivative of height : m/year
real(r8) :: ddbhdt ! time derivative of dbh : cm/year
real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year
! FIRE
real(r8) :: fraction_crown_burned ! proportion of crown affected by fire:-
real(r8) :: cambial_mort ! probability that trees dies due to cambial char
! (conditional on the tree being subjected to the fire)
real(r8) :: crownfire_mort ! probability of tree post-fire mortality
! due to crown scorch (conditional on the tree being subjected to the fire)
real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:-
! Hydraulics
type(ed_cohort_hydr_type), pointer :: co_hydr ! All cohort hydraulics data, see FatesHydraulicsMemMod.F90
! Running means
! (keeping this in-code as an example)
!class(rmean_type), pointer :: tveg_lpa ! exponential moving average of leaf temperature at the
! leaf photosynthetic acclimation time-scale [K]
end type ed_cohort_type
!************************************
!** Patch type structure **
!************************************
type, public :: ed_patch_type
! POINTERS
type (ed_cohort_type), pointer :: tallest => null() ! pointer to patch's tallest cohort
type (ed_cohort_type), pointer :: shortest => null() ! pointer to patch's shortest cohort
type (ed_patch_type), pointer :: older => null() ! pointer to next older patch
type (ed_patch_type), pointer :: younger => null() ! pointer to next younger patch
!INDICES
integer :: patchno ! unique number given to each new patch created for tracking
! PATCH INFO
real(r8) :: age ! average patch age: years
integer :: age_class ! age class of the patch for history binning purposes
real(r8) :: area ! patch area: m2
integer :: countcohorts ! Number of cohorts in patch
integer :: ncl_p ! Number of occupied canopy layers
integer :: anthro_disturbance_label ! patch label for anthropogenic disturbance classification
real(r8) :: age_since_anthro_disturbance ! average age for secondary forest since last anthropogenic disturbance
! Running means
!class(rmean_type), pointer :: t2m ! Place-holder for 2m air temperature (variable window-size)
class(rmean_type), pointer :: tveg24 ! 24-hour mean vegetation temperature (K)
class(rmean_type), pointer :: tveg_lpa ! Running mean of vegetation temperature at the
! leaf photosynthesis acclimation timescale [K]
integer :: nocomp_pft_label ! where nocomp is active, use this label for patch ID.
! LEAF ORGANIZATION
real(r8) :: pft_agb_profile(maxpft,n_dbh_bins) ! binned above ground biomass, for patch fusion: KgC/m2
real(r8) :: canopy_layer_tlai(nclmax) ! total leaf area index of each canopy layer
! used to determine attenuation of parameters during
! photosynthesis m2 veg / m2 of canopy area (patch without bare ground)
real(r8) :: total_canopy_area ! area that is covered by vegetation : m2
real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2
real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode
real(r8) :: c_stomata ! Mean stomatal conductance of all leaves in the patch [umol/m2/s]
real(r8) :: c_lblayer ! Mean boundary layer conductance of all leaves in the patch [umol/m2/s]
! UNITS for the ai profiles
! [ m2 leaf / m2 contributing crown footprints]
real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer.
real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer
real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer
real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer
real(r8) :: radiation_error ! radiation error (w/m2)
real(r8) :: layer_height_profile(nclmax,maxpft,nlevleaf)
real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer
! they will sum to 1.0 in the fully closed canopy layers
! but only in leaf-layers that contain contributions
! from all cohorts that donate to canopy_area
! layer, pft, and leaf layer:-
integer :: canopy_mask(nclmax,maxpft) ! is there any of this pft in this canopy layer?
integer :: nrad(nclmax,maxpft) ! number of exposed leaf layers for each canopy layer and pft
integer :: ncan(nclmax,maxpft) ! number of total leaf layers for each canopy layer and pft
!RADIATION FLUXES
real(r8) :: fcansno ! Fraction of canopy covered in snow
logical :: solar_zenith_flag ! integer flag specifying daylight (based on zenith angle)
real(r8) :: solar_zenith_angle ! solar zenith angle (radians)
real(r8) :: gnd_alb_dif(maxSWb) ! ground albedo for diffuse rad, both bands (fraction)
real(r8) :: gnd_alb_dir(maxSWb) ! ground albedo for direct rad, both bands (fraction)
real(r8) :: fabd_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of direct light absorbed by each canopy
! layer, pft, and leaf layer:-
real(r8) :: fabd_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of direct light absorbed by each canopy
! layer, pft, and leaf layer:-
real(r8) :: fabi_sun_z(nclmax,maxpft,nlevleaf) ! sun fraction of indirect light absorbed by each canopy
! layer, pft, and leaf layer:-
real(r8) :: fabi_sha_z(nclmax,maxpft,nlevleaf) ! shade fraction of indirect light absorbed by each canopy
! layer, pft, and leaf layer:-
real(r8) :: ed_laisun_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the sun in each canopy layer,
! pft, and leaf layer. m2/m2
real(r8) :: ed_laisha_z(nclmax,maxpft,nlevleaf) ! amount of LAI in the shade in each canopy layer,
real(r8) :: ed_parsun_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the sun in each canopy layer,
real(r8) :: ed_parsha_z(nclmax,maxpft,nlevleaf) ! PAR absorbed in the shade in each canopy layer,
real(r8) :: f_sun(nclmax,maxpft,nlevleaf) ! fraction of leaves in the sun in each canopy layer, pft,
! radiation profiles for comparison against observations
! normalized direct photosynthetically active radiation profiles by
! incident type (direct/diffuse at top of canopy),leaf,pft,leaf (unitless)
real(r8) :: nrmlzd_parprof_pft_dir_z(n_rad_stream_types,nclmax,maxpft,nlevleaf)
! normalized diffuse photosynthetically active radiation profiles by
! incident type (direct/diffuse at top of canopy),leaf,pft,leaf (unitless)
real(r8) :: nrmlzd_parprof_pft_dif_z(n_rad_stream_types,nclmax,maxpft,nlevleaf)
! normalized direct photosynthetically active radiation profiles by
! incident type (direct/diffuse at top of canopy),leaf,leaf (unitless)
real(r8) :: nrmlzd_parprof_dir_z(n_rad_stream_types,nclmax,nlevleaf)
! normalized diffuse photosynthetically active radiation profiles by
! incident type (direct/diffuse at top of canopy),leaf,leaf (unitless)
real(r8) :: nrmlzd_parprof_dif_z(n_rad_stream_types,nclmax,nlevleaf)
real(r8) :: parprof_pft_dir_z(nclmax,maxpft,nlevleaf) ! direct-beam PAR profile through canopy, by canopy,PFT,leaf level (w/m2)
real(r8) :: parprof_pft_dif_z(nclmax,maxpft,nlevleaf) ! diffuse PAR profile through canopy, by canopy,PFT,leaf level (w/m2)
real(r8) :: parprof_dir_z(nclmax,nlevleaf) ! direct-beam PAR profile through canopy, by canopy,leaf level (w/m2)
real(r8) :: parprof_dif_z(nclmax,nlevleaf) ! diffuse PAR profile through canopy, by canopy,leaf level (w/m2)
! and leaf layer. m2/m2
real(r8),allocatable :: tr_soil_dir(:) ! fraction of incoming direct radiation that (cm_numSWb)
! is transmitted to the soil as direct
real(r8),allocatable :: tr_soil_dif(:) ! fraction of incoming diffuse radiation that
! is transmitted to the soil as diffuse
real(r8),allocatable :: tr_soil_dir_dif(:) ! fraction of incoming direct radiation that
! is transmitted to the soil as diffuse
real(r8),allocatable :: fab(:) ! fraction of incoming total radiation that is absorbed by the canopy
real(r8),allocatable :: fabd(:) ! fraction of incoming direct radiation that is absorbed by the canopy
real(r8),allocatable :: fabi(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy
real(r8),allocatable :: sabs_dir(:) ! fraction of incoming direct radiation that is absorbed by the canopy
real(r8),allocatable :: sabs_dif(:) ! fraction of incoming diffuse radiation that is absorbed by the canopy
! PHOTOSYNTHESIS
real(r8) :: psn_z(nclmax,maxpft,nlevleaf) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s
! ROOTS
real(r8) :: btran_ft(maxpft) ! btran calculated seperately for each PFT:-
real(r8) :: bstress_sal_ft(maxpft) ! bstress from salinity calculated seperately for each PFT:-
! DISTURBANCE
real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality
! 2) fire: fraction/day
! 3) logging mortatliy
real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day
integer :: disturbance_mode ! index identifying which disturbance was applied
! can be one of: dtype_ifall, dtype_ilog or dtype_ifire
real(r8) :: fract_ldist_not_harvested ! fraction of logged area that is canopy trees that weren't harvested
! Litter and Coarse Woody Debris
type(litter_type), pointer :: litter(:) ! Litter (leaf,fnrt,CWD and seeds) for different elements
real(r8),allocatable :: fragmentation_scaler(:) ! Scale rate of litter fragmentation based on soil layer. 0 to 1.
!FUEL CHARECTERISTICS
real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2
real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel:-.
real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2
real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel. kgBiomass/m3
! (incl. live grasses. omits 1000hr fuels). KgC/m3
real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel. cm-1
! (incl. live grasses. omits 1000hr fuels).
real(r8) :: fuel_mef ! average moisture of extinction factor
! of the ground fuel (incl. live grasses. omits 1000hr fuels).
real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel
! (incl. live grasses. omits 1000hr fuels)
real(r8) :: litter_moisture(nfsc)
! FIRE SPREAD
real(r8) :: ros_front ! rate of forward spread of fire: m/min
real(r8) :: ros_back ! rate of backward spread of fire: m/min
real(r8) :: effect_wspeed ! windspeed modified by fraction of relative grass and tree cover: m/min
real(r8) :: tau_l ! Duration of lethal heating: mins
real(r8) :: fi ! average fire intensity of flaming front: kj/m/s or kw/m
integer :: fire ! Is there a fire? 1=yes 0=no
real(r8) :: fd ! fire duration: mins
! FIRE EFFECTS
real(r8) :: scorch_ht(maxpft) ! scorch height: m
real(r8) :: frac_burnt ! fraction burnt: frac patch/day
real(r8) :: tfc_ros ! total intensity-relevant fuel consumed - no trunks. KgC/m2 of burned ground/day
real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned, conditional on it being burned
! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018)
! type(ed_patch_hydr_type) , pointer :: pa_hydr ! All patch hydraulics data, see FatesHydraulicsMemMod.F90
end type ed_patch_type
!************************************
!** Resources management type **
! YX
!************************************
type, public :: ed_resources_management_type
real(r8) :: trunk_product_site ! Actual trunk product at site level KgC/site
!debug variables
real(r8) :: delta_litter_stock ! kgC/site = kgC/ha
real(r8) :: delta_biomass_stock ! kgC/site
real(r8) :: delta_individual !
end type ed_resources_management_type
! =====================================================================================
type, public :: site_fluxdiags_type
! ----------------------------------------------------------------------------------
! Diagnostics for fluxes into the litter pool from plants
! these fluxes are the total from
! (1) turnover from living plants
! (2) mass transfer from non-disturbance inducing mortality events
! (3) mass transfer from disturbance inducing mortality events
! [kg / ha / day]
! ---------------------------------------------------------------------------------
real(r8) :: cwd_ag_input(1:ncwd)
real(r8) :: cwd_bg_input(1:ncwd)
real(r8),allocatable :: leaf_litter_input(:)
real(r8),allocatable :: root_litter_input(:)
real(r8),allocatable :: nutrient_uptake_scpf(:)
real(r8),allocatable :: nutrient_efflux_scpf(:)
real(r8),allocatable :: nutrient_need_scpf(:)
contains
procedure :: ZeroFluxDiags
end type site_fluxdiags_type
! ====================================================================================
type, public :: site_massbal_type
! ----------------------------------------------------------------------------------
! This type is used for accounting purposes to ensure that we are not
! loosing or creating mass. This type is supposed to be allocated for each element
! we simulate (e.g. carbon12_element, etc)
! Note that the unit of "site", is nominally equivalent to 1 hectare
!
! This set of mass checks are for INCREMENTAL checks during the dynamics step.
! ----------------------------------------------------------------------------------
real(r8) :: old_stock ! remember biomass stock from last time [Kg/site]
real(r8) :: err_fates ! Total mass balance error for FATES processes [kg/site]
! ----------------------------------------------------------------------------------
! Group 3: Components of the total site level mass fluxes
! ----------------------------------------------------------------------------------
real(r8) :: gpp_acc ! Accumulated gross primary productivity [kg/site/day]
real(r8) :: aresp_acc ! Accumulated autotrophic respiration [kg/site/day]
real(r8) :: net_root_uptake ! Net uptake of carbon or nutrients through the roots [kg/site/day]
! (if carbon most likely exudation, if even active)
real(r8) :: seed_in ! Total mass of external seed rain into fates site [kg/site/day]
! This is from external grid-cells or from user parameterization
! (user param seed rain, or dispersal model)
real(r8) :: seed_out ! Total mass of seeds exported outside of fates site [kg/site/day]
! (this is not used currently, placeholder, rgk feb-2019)
real(r8) :: frag_out ! Litter and coarse woody debris fragmentation flux [kg/site/day]
real(r8) :: wood_product ! Total mass exported as wood product [kg/site/day]
real(r8) :: burn_flux_to_atm ! Total mass burned and exported to the atmosphere [kg/site/day]
real(r8) :: flux_generic_in ! Used for prescribed or artificial input fluxes
! and initialization [kg/site/day]
real(r8) :: flux_generic_out ! Used for prescribed or artificial output fluxes
! for instance when prescribed physiology is on
real(r8) :: patch_resize_err ! This is the amount of mass gained (or loss when negative)
! due to re-sizing patches when area math starts to lose
! precision
contains
procedure :: ZeroMassBalState
procedure :: ZeroMassBalFlux
end type site_massbal_type
!************************************
!** Site type structure **
!************************************
type, public :: ed_site_type
! POINTERS
type (ed_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site
type (ed_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site
! Resource management
type (ed_resources_management_type) :: resources_management ! resources_management at the site
! If this simulation uses shared memory then the sites need to know what machine
! index they are on. This index is (currently) only used to identify the sites
! position in history output fields
!integer :: clump_id
! Global index of this site in the history output file
integer :: h_gid
! INDICES
real(r8) :: lat ! latitude: degrees
real(r8) :: lon ! longitude: degrees
! Fixed Biogeography mode inputs
real(r8), allocatable :: area_PFT(:) ! Area allocated to individual PFTs
integer, allocatable :: use_this_pft(:) ! Is area_PFT > 0 ? (1=yes, 0=no)
! Total area of patches in each age bin [m2]
real(r8), allocatable :: area_by_age(:)
! SP mode target PFT level variables
real(r8), allocatable :: sp_tlai(:) ! target TLAI per FATES pft
real(r8), allocatable :: sp_tsai(:) ! target TSAI per FATES pft
real(r8), allocatable :: sp_htop(:) ! target HTOP per FATES pft
! Mass Balance (allocation for each element)
type(site_massbal_type), pointer :: mass_balance(:)
! Flux diagnostics (allocation for each element)
type(site_fluxdiags_type), pointer :: flux_diags(:)
! PHENOLOGY
real(r8) :: grow_deg_days ! Phenology growing degree days
real(r8) :: snow_depth ! site-level snow depth (used for ELAI/TLAI calcs)
integer :: cstatus ! are leaves in this pixel on or off for cold decid
! 0 = this site has not experienced a cold period over at least
! 400 days, leaves are dropped and flagged as non-cold region
! 1 = this site is in a cold-state where leaves should have fallen
! 2 = this site is in a warm-state where leaves are allowed to flush
integer :: dstatus ! are leaves in this pixel on or off for drought decid
! 0 = leaves off due to time exceedance
! 1 = leaves off due to moisture avail
! 2 = leaves on due to moisture avail
! 3 = leaves on due to time exceedance
integer :: nchilldays ! num chilling days: (for botta gdd trheshold calculation)
integer :: ncolddays ! num cold days: (must exceed threshold to drop leaves)
real(r8) :: vegtemp_memory(num_vegtemp_mem) ! record of last 10 days temperature for senescence model. deg C
integer :: cleafondate ! model date (day integer) of leaf on (cold):-
integer :: cleafoffdate ! model date (day integer) of leaf off (cold):-
integer :: dleafondate ! model date (day integer) of leaf on drought:-
integer :: dleafoffdate ! model date (day integer) of leaf off drought:-
real(r8) :: water_memory(numWaterMem) ! last 10 days of soil moisture memory...
! FIRE
real(r8) :: wind ! daily wind in m/min for Spitfire units
real(r8) :: acc_ni ! daily nesterov index accumulating over time.
real(r8) :: fdi ! daily probability an ignition event will start a fire
real(r8) :: NF ! daily ignitions in km2
real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire
! PLANT HYDRAULICS
type(ed_site_hydr_type), pointer :: si_hydr
! Soil Layering
integer :: nlevsoil ! Number of soil layers in this site
real(r8), allocatable :: zi_soil(:) ! interface level below a "z" level (m)
! this contains a zero index for surface.
real(r8), allocatable :: dz_soil(:) ! layer thickness (m)
real(r8), allocatable :: z_soil(:) ! layer depth (m)
real(r8), allocatable :: rootfrac_scr(:) ! This is just allocated scratch space to hold
! root fractions. Since root fractions may be dependent
! on cohort properties, and we do not want to store this infromation
! on each cohort, we do not keep root fractions in
! memory, and instead calculate them on demand.
! This array is allocated over the number of soil
! layers for each site, and save allocating deallocating.
! NOTE: THIS SCRATCH SPACE WOULD NOT BE THREAD-SAFE
! IF WE FORK ON PATCHES
! Mineralized nutrient flux from veg to the soil, via multiple mechanisms
! inluding symbiotic fixation, or other
!real(r8) :: allocatable :: minn_flux_out ! kg/ha/day
!real(r8) :: allocatable :: minp_flux_out ! kg/ha/day
! DIAGNOSTICS
! TERMINATION, RECRUITMENT, DEMOTION, and DISTURBANCE
real(r8), allocatable :: term_nindivs_canopy(:,:) ! number of canopy individuals that were in cohorts which
! were terminated this timestep, on size x pft
real(r8), allocatable :: term_nindivs_ustory(:,:) ! number of understory individuals that were in cohorts which
! were terminated this timestep, on size x pft
real(r8) :: term_carbonflux_canopy ! carbon flux from live to dead pools associated
! with termination mortality, per canopy level
real(r8) :: term_carbonflux_ustory ! carbon flux from live to dead pools associated
! with termination mortality, per canopy level
real(r8) :: demotion_carbonflux ! biomass of demoted individuals from canopy to understory [kgC/ha/day]
real(r8) :: promotion_carbonflux ! biomass of promoted individuals from understory to canopy [kgC/ha/day]
real(r8) :: imort_carbonflux ! biomass of individuals killed due to impact mortality per year. [kgC/ha/day]
real(r8) :: fmort_carbonflux_canopy ! biomass of canopy indivs killed due to fire per year. [gC/m2/sec]
real(r8) :: fmort_carbonflux_ustory ! biomass of understory indivs killed due to fire per year [gC/m2/sec]
real(r8) :: recruitment_rate(1:maxpft) ! number of individuals that were recruited into new cohorts
real(r8), allocatable :: demotion_rate(:) ! rate of individuals demoted from canopy to understory per FATES timestep
real(r8), allocatable :: promotion_rate(:) ! rate of individuals promoted from understory to canopy per FATES timestep
real(r8), allocatable :: imort_rate(:,:) ! rate of individuals killed due to impact mortality per year. on size x pft array
real(r8), allocatable :: fmort_rate_canopy(:,:) ! rate of canopy individuals killed due to fire mortality per year.
! on size x pft array (1:nlevsclass,1:numpft)
real(r8), allocatable :: fmort_rate_ustory(:,:) ! rate of understory individuals killed due to fire mortality per year.
! on size x pft array (1:nlevsclass,1:numpft)
real(r8), allocatable :: fmort_rate_cambial(:,:) ! rate of individuals killed due to fire mortality
! from cambial damage per year. on size x pft array
real(r8), allocatable :: fmort_rate_crown(:,:) ! rate of individuals killed due to fire mortality
! from crown damage per year. on size x pft array
real(r8), allocatable :: growthflux_fusion(:,:) ! rate of individuals moving into a given size class bin
! due to fusion in a given day. on size x pft array
! Canopy Spread
real(r8) :: spread ! dynamic canopy allometric term [unitless]
! site-level variables to keep track of the disturbance rates, both actual and "potential"
real(r8) :: disturbance_rates_primary_to_primary(N_DIST_TYPES) ! actual disturbance rates from primary patches to primary patches [m2/m2/day]
real(r8) :: disturbance_rates_primary_to_secondary(N_DIST_TYPES) ! actual disturbance rates from primary patches to secondary patches [m2/m2/day]
real(r8) :: disturbance_rates_secondary_to_secondary(N_DIST_TYPES) ! actual disturbance rates from secondary patches to secondary patches [m2/m2/day]
real(r8) :: potential_disturbance_rates(N_DIST_TYPES) ! "potential" disturb rates (i.e. prior to the "which is most" logic) [m2/m2/day]
real(r8) :: primary_land_patchfusion_error ! error term in total area of primary patches associated with patch fusion [m2/m2/day]
real(r8) :: harvest_carbon_flux ! diagnostic site level flux of carbon as harvested plants [kg C / m2 / day]
end type ed_site_type
! Make public necessary subroutines and functions
public :: val_check_ed_vars
public :: dump_site
public :: dump_patch
public :: dump_cohort
public :: dump_cohort_hydr
contains
subroutine ZeroFluxDiags(this)
class(site_fluxdiags_type) :: this
this%cwd_ag_input(:) = 0._r8
this%cwd_bg_input(:) = 0._r8
this%leaf_litter_input(:) = 0._r8
this%root_litter_input(:) = 0._r8
this%nutrient_uptake_scpf(:) = 0._r8
this%nutrient_efflux_scpf(:) = 0._r8
this%nutrient_need_scpf(:) = 0._r8
return
end subroutine ZeroFluxDiags
! =====================================================================================
subroutine ZeroMassBalState(this)
class(site_massbal_type) :: this
this%old_stock = 0._r8
this%err_fates = 0._r8
return
end subroutine ZeroMassBalState
subroutine ZeroMassBalFlux(this)
class(site_massbal_type) :: this
this%gpp_acc = 0._r8
this%aresp_acc = 0._r8
this%net_root_uptake = 0._r8
this%seed_in = 0._r8
this%seed_out = 0._r8
this%frag_out = 0._r8
this%wood_product = 0._r8
this%burn_flux_to_atm = 0._r8
this%flux_generic_in = 0._r8
this%flux_generic_out = 0._r8
this%patch_resize_err = 0._r8
return
end subroutine ZeroMassBalFlux
! =====================================================================================
subroutine val_check_ed_vars(currentPatch,var_aliases,return_code)
! ----------------------------------------------------------------------------------
! Perform numerical checks on variables of interest.
! The input string is of the form: 'VAR1_NAME:VAR2_NAME:VAR3_NAME'
! ----------------------------------------------------------------------------------
use FatesUtilsMod,only : check_hlm_list
use FatesUtilsMod,only : check_var_real
! Arguments
type(ed_patch_type),intent(in), target :: currentPatch
character(len=*),intent(in) :: var_aliases
integer,intent(out) :: return_code ! return 0 for all fine
! return 1 if a nan detected
! return 10+ if an overflow
! return 100% if an underflow
! Locals
type(ed_cohort_type), pointer :: currentCohort
! Check through a registry of variables to check
if ( check_hlm_list(trim(var_aliases),'co_n') ) then
currentCohort => currentPatch%shortest
do while(associated(currentCohort))
call check_var_real(currentCohort%n,'cohort%n',return_code)
if(.not.(return_code.eq.0)) then
call dump_patch(currentPatch)
call dump_cohort(currentCohort)
return
end if
currentCohort => currentCohort%taller
end do
end if
if ( check_hlm_list(trim(var_aliases),'co_dbh') ) then
currentCohort => currentPatch%shortest
do while(associated(currentCohort))
call check_var_real(currentCohort%dbh,'cohort%dbh',return_code)
if(.not.(return_code.eq.0)) then
call dump_patch(currentPatch)
call dump_cohort(currentCohort)
return
end if
currentCohort => currentCohort%taller
end do
end if
if ( check_hlm_list(trim(var_aliases),'pa_area') ) then
call check_var_real(currentPatch%area,'patch%area',return_code)
if(.not.(return_code.eq.0)) then
call dump_patch(currentPatch)
return
end if
end if
return
end subroutine val_check_ed_vars
! =====================================================================================
subroutine dump_site(csite)
type(ed_site_type),intent(in),target :: csite
! EDTypes is
write(fates_log(),*) '----------------------------------------'
write(fates_log(),*) ' Site Coordinates '
write(fates_log(),*) '----------------------------------------'
write(fates_log(),*) 'latitude = ', csite%lat
write(fates_log(),*) 'longitude = ', csite%lon
write(fates_log(),*) '----------------------------------------'
return
end subroutine dump_site
! =====================================================================================
subroutine dump_patch(cpatch)
type(ed_patch_type),intent(in),target :: cpatch
! locals
integer :: el ! element loop counting index