source_code/version2.2_windows/crown.f

+!*****************************************************************!
+!*                                                               *!
+!*                 FORESEE Simulation Model                      *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutine for:                            *!
+!*            Calculation of rise of bole height                 *!
+!*                                                               *!
+!*                  Copyright (C) 1996-2018                      *!
+!*     Potsdam Institute for Climate Impact Reserach (PIK)       *!
+!*          Authors and contributors see AUTHOR file             *!
+!*  This file is part of 4C and is licensed under BSD-2-Clause   *!
+!*                   See LICENSE file or under:                  *!
+!*     http://www.https://opensource.org/licenses/BSD-2-Clause   *!
+!*                           Contact:                            *!
+!*       https://gitlab.pik-potsdam.de/foresee/4C                *!
+!*                                                               *!
+!*****************************************************************!
+
+SUBROUTINE CROWN (p)
+
+  !*** Declaration part ***!
+
+  USE data_stand
+  USE data_species
+  USE data_simul
+
+  IMPLICIT NONE
+
+  REAL          :: relnpp, &  ! layer specific amount of npp per cohort
+                   reldm      ! layer specific dry matter to be replaced
+  INTEGER       :: nl         ! variable for crown layers
+  INTEGER       :: i
+  TYPE(Coh_Obj) :: p          ! pointer to cohort list
+
+  !*** Calculation part ***!
+  ! evaluate assimilation balance vs. foliage turnover rate for the crown layers
+  
+  ns = p%coh%species
+
+  DO i = p%coh%topLayer, p%coh%botLayer, -1
+
+     nl = i
+
+       relnpp = p%coh%antFPAR(i) * p%coh%netAss
+       reldm =  1.5*spar(ns)%psf * p%coh%sleafArea(i) / p%coh%med_sla
+
+    IF ( relnpp < reldm) THEN
+        nl = nl + 1 
+        EXIT
+    ENDIF
+
+  END DO
+
+  p%coh%deltaB = (nl - p%coh%botLayer) * dz
+  IF(p%coh%deltaB.GT.0.05*(p%coh%height-p%coh%x_hbole)) p%coh%deltaB=0.05*(p%coh%height-p%coh%x_hbole)
+
+
+END SUBROUTINE CROWN