source_code/version_2.3_windows/npp.f

+!*****************************************************************!
+!*                                                               *!
+!*                     4C (FORESEE)                              *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*                Calculation of daily NPP                       *!
+!*                                                               *!
+!*  SR OPT_PS: optimum photosynthesis & conductance calculation  *!
+!*  SR NPP:    determination of realized net primary production  *!
+!*                                                               *!
+!*                  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 OPT_PS  *!
+!***********************!
+
+! calculates optimum photosynthesis following Haxeltine & Prentice (1996)
+
+SUBROUTINE OPT_PS(temp, dayl, PAR, ApPa)
+
+  !*** Declaration part ***!
+
+  USE data_species
+  USE data_stand
+  USE data_simul
+  USE data_climate
+  USE data_par
+
+  IMPLICIT NONE
+
+  ! input variables
+  REAL     :: temp,          & ! temperature
+              dayl,          & ! day length
+              PAR              ! total available PAR
+
+  ! auxiliary variables
+  REAL     :: ApPa,          & ! atmospheric pressure [Pa], input [hPa]
+              VmOpt = 0.,    &
+              VmMax = 0.,    & ! nitrogen limited carboxylation rate
+              Jc = 0.,       & ! Rubisco limited rate of photosynthesis
+              Je = 0.,       & ! photosynthetic response under light limitation
+              assiSpe = 0.,  & ! specific gross photosynthesis [gC m-2 canopy projection d-1]
+              respSpe = 0.,  & ! specific leaf respiration [gC m-2 canopy projection d-1]
+              assDt,         & ! net daytime assimilation rate              
+              PHIT = 0.,     &
+              XHELP = 0.,    &
+              kco2,          &    
+              ko2,           &
+              tau,           & ! Rubisco specificity
+              piCO2,         & ! leaf internal CO2 partial pressure [Pa]
+              gammas,        & ! CO2 compensation point in absence of mitochondrial respiration [Pa]
+              delta,         &
+              sigma,         &
+              c1,            &
+              c2,            &
+              vmspe,         &
+			  redn_h,        &
+			  h_age    
+                               
+  ! variables required for technical reasons
+  ! INTEGER  :: nl               ! loop variable for crown layers
+  integer ntr, i, j
+  
+  TYPE(coh_obj), POINTER :: p
+
+
+ !*** Calculation part ***!
+
+! conversion of pressure from [kPa] to [P] 
+  ApPa = ApPa * 100.   ! hPa ==> Pa
+
+  ! initialization of canopy conductance
+  gp_can = 0.
+  gp_tot = 0.
+  phot_C=0.
+  ! polar night 
+  if (dayl .lt. zero) then
+      p => pt%first
+      DO WHILE (ASSOCIATED(p))
+        p%coh%LUE     = 0.0
+        p%coh%assi    = 0.0
+        p%coh%resp    = 0.0
+        p%coh%gp      = 0.0
+        p%coh%Ndemc_d = 0.0
+      
+        p => p%next
+      enddo
+      return
+  endif
+  
+  
+  ! Determination of photosynthesis nitrogen reduction factor RedN for species
+    select case (flag_limi)   	       
+    case (11)
+         do j=1,anrspec
+           i = nrspec(j)
+           redn_h = svar(i)%RedN
+           if(svar(i)%Ndem .gt. 0) then
+               svar(i)%RedN = svar(i)%Nupt / svar(i)%Ndem
+               if (svar(i)%RedN .gt. 1.) svar(i)%RedN=1.
+           else
+               svar(i)%RedN = redn_h
+           endif
+         enddo
+
+	case (12)
+         do j=1,anrspec
+           i = nrspec(j)
+           redn_h = svar(i)%RedN
+           if(svar(i)%Ndem .gt. 0) then
+               if (svar(i)%Nupt .gt. svar(i)%Ndem) then
+                    svar(i)%RedN = 1
+               else
+                    svar(i)%RedN = exp((svar(i)%Nupt / svar(i)%Ndem) -1.)
+               endif
+           else
+               svar(i)%RedN = redn_h
+           endif
+         enddo
+
+	case (13,14)
+         do j=1,anrspec
+           i = nrspec(j)
+           redn_h = svar(i)%RedN
+           if(svar(i)%Ndem .gt. 0) then
+               xhelp = svar(i)%Nupt / svar(i)%Ndem
+                  svar(i)%RedN = 2.*(xhelp+0.01) / (xhelp+1.)
+           else
+               svar(i)%RedN = redn_h
+           endif
+           if(svar(i)%Nupt .le. zero) svar(i)%RedN = redn_h 
+         enddo
+
+	case (15)
+         do j=1,anrspec
+           i = nrspec(j)
+           redn_h = svar(i)%RedN
+           if(svar(i)%Ndem .gt. zero) then
+               xhelp = svar(i)%Nupt / svar(i)%Ndem
+               select case (i)    
+               case (3)       ! pine   
+                  if (xhelp .gt. 10.) then
+                      svar(i)%RedN=1.
+                  else
+                      svar(i)%RedN = exp(xhelp -0.7) - 0.5
+                  endif
+               
+               case (10, 14)      ! dougfir, ground vegetation
+                  continue      ! annual calculation in RedN_calc
+              
+               case default 
+                  svar(i)%RedN = 2.*(xhelp+0.01) / (xhelp+1.)
+               
+               end select
+               if (svar(i)%RedN .gt. 1.) svar(i)%RedN=1.
+               if (svar(i)%RedN .lt. 0.1) svar(i)%RedN=0.1
+          else
+               svar(i)%RedN = redn_h
+           endif
+           if(svar(i)%Nupt .le. zero) svar(i)%RedN = redn_h 
+           if (i.eq.nspec_tree+2) then
+             svar(i)%RedN=1.
+           endif
+         enddo
+	
+	case (16)
+        svar%Ndemp = -1.*svar%Ndemp
+        svar%Nuptp = -1.*svar%Nuptp
+	    zeig => pt%first
+        DO WHILE (ASSOCIATED(zeig))
+          
+            ns = zeig%coh%species
+	        ntr = zeig%coh%ntreea
+            svar(ns)%Ndemp = svar(ns)%Ndemp + ntr * zeig%coh%Ndemc_c
+            svar(ns)%Nuptp = svar(ns)%Nuptp + ntr * zeig%coh%Nuptc_c
+
+            zeig => zeig%next
+        ENDDO
+        
+         do j=1,anrspec
+           i = nrspec(j)
+           redn_h = svar(i)%RedN
+           if(svar(i)%Ndemp .gt. 0) then
+               svar(i)%RedN = svar(i)%Nuptp / svar(i)%Ndemp
+           else
+               svar(i)%RedN = redn_h
+           endif
+         enddo
+
+    end select   ! flag_limi
+
+! internal partial pressure of CO2 (Eq A9)
+piCO2 = ApPa * lambda * CO2
+
+! temperature dependent damping function; orig pars: 0.2, 10.
+PHIT  = 1. / ( 1.+exp(0.4*(7.-temp)) )
+
+! loop over all cohorts
+  p => pt%first
+  DO WHILE (ASSOCIATED(p))
+
+    ns   = p%coh%species
+
+    ! parameter variations with temperature (Eq A14)            
+
+    KCO2 = spar(ns)%kCO2_25 * spar(ns)%q10_kCO2 ** ( (temp - 25.) / 10.)
+    KO2  = spar(ns)%kO2_25  * spar(ns)%q10_kO2  ** ( (temp - 25.) / 10.)
+    tau  = spar(ns)%pc_25   * spar(ns)%q10_pc   ** ( (temp - 25.) / 10.)
+
+    ! CO2 compensation point in absence of mitochondrial respiration, O2 converted from kPa to Pa
+    gammas = O2*1000 / (2. * tau)
+    
+    ! slope for light response under PAR limitation (Eq A7)
+    C1 = PHIT*spar(ns)%phic*Cmass*QCO2*QCO2a * (piCO2 - gammas) / (piCO2 + 2.*gammas) ! 0.35
+
+    ! slope for light response under Rubisco limitation (Eq A11)
+    C2 = (piCO2 - gammas) / ( piCO2 + KCO2 * (1. + O2 / KO2) )         
+
+    ! daylength-dependent term (original: s)
+    DELTA = (24. / dayL) * spar(ns)%pb                            
+
+    ! optimal light use efficiency (Eq A17 and A17a)
+    SIGMA = AMAX1 (0.0001, 1. - (C2 - DELTA) / (C2 - PS * DELTA) ) ** 0.5 ! 0.25 - 0.45
+    VmSpe = (1. / spar(ns)%pb) * (C1 / C2) * ( (2.*PS - 1.) *   &
+            DELTA - (2.*PS * DELTA - C2) * SIGMA)                  
+
+    ! maximum carboxylation potential in gC m-2 d-1 ???
+    VmOpt = p%coh%totFPAR * PAR * VmSpe                            
+
+! Determination of photosynthesis nitrogen reduction factor RedN
+    select case (flag_limi)
+    case (0,1)
+           p%coh%RedNc = 1.
+    
+    case (2,3,10)
+           p%coh%RedNc = svar(ns)%RedN
+    
+    case (4,5)
+           ! N effect on photosynthesis
+           XHELP = PN * exp ( - 0.0693 * (temp - 25.) )
+          ! calculate Vmax as function of metabolically active nitrogen per unit crown projection area first, is now in mymol m-2 s-1 
+           VmMax = (p%coh%N_fol - Nc0*p%coh%x_fol) / p%coh%crown_area / XHELP 
+           p%coh%RedNc = MIN (1., VmMax / VmOpt)
+    
+    case (6,7)
+           if ((p%coh%Ndemc_d .gt. 1.E-6) .and. (p%coh%Nuptc_d .gt. 1.E-6)) then
+               p%coh%RedNc = p%coh%Nuptc_c / p%coh%Ndemc_c
+           else
+               p%coh%RedNc = svar(ns)%RedN
+           endif
+    
+    case (8,9)
+	      h_age = p%coh%x_age
+          if( h_age.lt.50.) then
+              redn_h =svar(ns)%RedN
+         else if( (h_age-time).lt.50) then
+
+    ! age dependent reduction of redN
+              redn_h = svar(ns)%RedN*(1-max(0.,(h_age-50)*0.002))
+          else
+              redn_h = svar(ns)%RedN*(1-max(0.,(time)*0.002))
+         end if
+	     p%coh%RedNc = redn_h
+	       
+    case (11,12,13,14,15,16)  ! calculation of cohort loop
+         p%coh%RedNc = svar(p%coh%species)%RedN
+
+    end select
+
+
+
+    ! limiting rates
+    Jc = C2 * VmSpe / 24.
+    Je = C1 / dayL
+
+    ! gross assimilation and leaf respiration in [g C/(day*m2)]
+    p%coh%LUE = dayL * ( Je+Jc - SQRT( (Je+Jc) * (Je+Jc) - 4.*PS*Je*Jc) ) / (2.*PS) * p%coh%RedNc
+    assiSpe = p%coh%LUE * p%coh%totFPAR * PAR
+    if(p%coh%totFPAR.lt.0) then
+	continue
+	end if
+    respSpe = spar(ns)%pb * VmOpt * p%coh%RedNc
+     phot_C = phot_C + p%coh%ntreea*assiSpe !summation for output BE
+
+        p%coh%assi = assiSpe * kPatchSize / 1000. * (1/cpart)    ! conversion g C/day*m2 -> kg DW/day*patch
+        p%coh%resp = respSpe * kPatchSize / 1000. * (1/cpart)    ! conversion g C/day*m2 -> kg DW/day*patch
+
+    ! optimum stomatal conductance (modified from Haxeltine & Prentice 1996) [mol/(m2*d)]
+    assDt = assiSpe - dayL/24.*respSpe
+    p%coh%gp = AMAX1( gmin, 1.56*assDt / (1.0-lambda) / CO2 / Cmass )
+    
+    ! update canopy conductance
+    IF (p%coh%species.le.nspec_tree .or. p%coh%species.eq.nspec_tree+2 )  then
+		gp_can = gp_can + p%coh%gp*p%coh%nTreeA
+	else
+		gp_tot = gp_tot + p%coh%gp*p%coh%nTreeA
+	endif
+
+
+
+    p => p%next
+    
+  END DO
+
+
+
+    gp_tot = gp_tot + gp_can
+ 
+END SUBROUTINE OPT_PS
+
+!********************!
+!*  SUBROUTINE NPP  *!
+!********************!
+
+! determines realized assimilation rate by taking into account water stress, and
+! calculates growth and maintenance respiration, plus overall net primary production
+
+SUBROUTINE NPP( temp, dayL, PAR, jx )
+
+  !*** Declaration part ***!
+
+  USE data_par
+  USE data_stand
+  USE data_species
+  USE data_simul
+  USE data_soil_cn
+
+  IMPLICIT NONE
+
+  ! input variables  
+  REAL:: temp,  &
+         dayL,  &
+         PAR 
+
+  ! auxiliary variables  
+  REAL :: netAsspot,    & ! daily potential (= no water and nutrient limitation) net assimilation rate [= dimension of p%coh%assi]
+          netAss,       & ! daily net assimilation rate  [= dimension of p%coh%assi]
+          maintResp,    & ! daily maintenance respiration costs
+          dailypotNPP,  & ! daily potential (= no water and nutrient limitation) net primary productivity per tree
+          dailyNPP,     & ! daily net primary productivity per tree [gC tree-1]
+          drLimF,       & ! drought factor limiting the assimilation rate 
+          grass = 0,    & ! gross daily assimilation rate  
+          respfol,      &
+          prms,         &
+          prmr,         &
+          NPP_mistletoe,&                    ! NPP of mistletoe
+          pq10,         &    ! q10 value for maint. respiration stem, fine root
+          help, presp
+  INTEGER :: jx        ! time step length of PS/NPP model
+
+  TYPE(coh_obj), POINTER :: p
+   pq10=2.0
+
+!*** Calculation part ***!
+   
+  !extraction of theor. produced NPP of mistletoe cohort
+    p => pt%first
+    do while (associated(p))
+     if (p%coh%species.eq.nspec_tree+2) then
+         NPP_mistletoe=p%coh%NPP
+           NPP_demand_mistletoe=0.3*NPP_mistletoe   ! NPP that  mistletoe demands from host (30% heterotroph carbon gain (Richter 1992)
+           p%coh%NPP=0.7*NPP_mistletoe              ! rest of NPP stays with mistletoe (autotroph)
+     end if
+     p => p%next
+    enddo
+
+  dailypotNPP_C=0.
+  dailyNPP_C=0.
+  dailyautresp_C = 0.
+  dailygrass_C = 0.
+  dailynetass_C = 0.
+  respr_day      = 0.
+  dailyrespfol_C = 0.
+  ! loop over all cohorts
+  p => pt%first
+  DO WHILE (ASSOCIATED(p))
+   ! reduction of NPP of mistletoe infected tree cohort
+    if (p%coh%mistletoe.eq.1) then
+      p%coh%NPP = p%coh%NPP-NPP_demand_mistletoe
+    endif
+    ns   = p%coh%species
+ IF ( p%coh%drIndPS .lt. 0.0 ) THEN
+    continue
+ endif
+   
+ ! drought index
+    IF ( p%coh%nDaysPS /= 0. ) THEN
+      p%coh%drIndPS = p%coh%drIndPS / p%coh%nDaysPS  
+    ELSE
+      p%coh%drIndPS = 0.  ! -> npp = 0
+    END IF
+    
+ ! limiting function 
+  select case(flag_limi)
+   case(0,2,4,6,8,14)
+      drLimF = 1.0
+
+   case default    
+      drLimF = p%coh%drIndPS
+   
+   end select  
+  
+    ! total net assimilation, maintenance respiration and NPP of this tree
+    if (p%coh%RedNc .gt. 1.E-6) then
+        netAsspot = (p%coh%assi - p%coh%resp) / p%coh%RedNc
+    else
+        netAsspot = 0.
+    endif
+    netAss    = drLimF * (p%coh%assi - p%coh%resp)   
+    grass     = drLimF * p%coh%assi    
+    p%coh%respfol = grass -netAss
+    respfol = p%coh%respfol
+ 
+    IF (flag_resp==1) THEN
+       ! calculate temperature dependant rates
+       prmr=spar(ns)%prmr*pq10**((temp-15)/10)
+       prms=spar(ns)%prms*pq10**((temp-15)/10)
+  ! leaf maintenance respiration added
+       maintResp = prms * p%coh%x_sap + prmr * p%coh%x_frt + respfol
+        
+! for complete outputs of respiration components:
+       p%coh%respsap =   prms * p%coh%x_sap
+       p%coh%respfrt =   prmr * p%coh%x_frt
+       p%coh%respbr  =   prms * p%coh%x_tb
+       dailypotNPP  = (1.-spar(ns)%prg) * (netAsspot - maintResp)
+       dailyNPP  = (1.-spar(ns)%prg) * (netAss - maintResp)
+       help = spar(ns)%prg * (netAss - maintResp)
+
+    ELSEIF (flag_resp==2) THEN
+
+       presp=0.03
+       maintResp = (p%coh%x_sap*cpart/spar(ns)%cnr_stem + p%coh%x_crt*cpart/spar(ns)%cnr_crt + p%coh%x_tb*cpart/spar(ns)%cnr_tbc + p%coh%x_frt*cpart/spar(ns)%cnr_frt)*presp
+       maintresp=maintresp*exp(308.56*((1/56.02)-(1/(temp+46.02))))
+
+       dailypotNPP  = (1.-spar(ns)%prg) * (netAsspot - maintResp)
+       dailyNPP  = (1.-spar(ns)%prg) * (netAss - maintResp)
+    ELSE
+       dailypotNPP=netAsspot*(1-spar(ns)%respcoeff)
+       dailyNPP=netAss*(1-spar(ns)%respcoeff)
+       maintResp = netAss*spar(ns)%respcoeff
+    ENDIF
+    IF(p%coh%species <= nspec_tree) THEN
+      dailypotNPP_C  = dailypotNPP_C + p%coh%ntreea*dailypotNPP*cpart*kg_in_g / (kPatchSize) !conversion in gC/m2
+      dailyNPP_C     = dailyNPP_C + p%coh%ntreea*dailyNPP*cpart*kg_in_g / (kPatchSize) !conversion in gC/m2
+      if (flag_resp.eq.1) then
+         dailyautresp_C = dailyautresp_C + p%coh%ntreea*(maintresp+help)*cpart*kg_in_g / (kPatchSize)
+      ELSE  ! flag_resp=0
+         dailyautresp_C = dailyautresp_C + p%coh%ntreea*(respfol+maintresp)*cpart*kg_in_g / (kPatchSize)
+      end if   
+	  dailygrass_C = dailygrass_C + p%coh%ntreea*grass*cpart*kg_in_g / (kPatchSize)
+	  dailynetass_C = dailynetass_C + p%coh%ntreea*netass*cpart*kg_in_g / (kPatchSize)
+	  dailyrespfol_C = dailyrespfol_C + p%coh%ntreea*respfol*cpart*kg_in_g / (kPatchSize)
+    ENDIF
+
+if (dailyNPP .gt. 10000.) then    
+    continue
+end if  
+ ! update annual net assimilation and NPP sum
+    p%coh%netAss = p%coh%netAss + netAss * jx
+    p%coh%grossass = p%coh%grossass  + grass * jx
+    if (flag_resp.eq.1)then
+        p%coh%maintres =  p%coh%maintres + (maintresp + help) * jx  
+    else
+        p%coh%maintres =  p%coh%maintres + (maintresp + respfol) * jx      
+    end if
+    
+	select case (flag_dis)    !phloem disturbance 
+     case (1,2)
+     dailyNPP    = dailyNPP * phlo_feed
+     case (0)
+     dailyNPP    = dailyNPP 
+     end select
+	 
+	p%coh%NPP    = p%coh%NPP  + dailyNPP * jx
+    p%coh%weekNPP = dailyNPP * jx 
+    IF (time_out .gt. 0 .and. flag_cohout .eq. 2) THEN
+       CALL OUT_ASS( p%coh%ident, PAR, p%coh%NPP, p%coh%totFPAR, p%coh%LUE, p%coh%netAss, p%coh%grossass, p%coh%nDaysPS)
+    ENDIF
+
+!    remove Mistletoe from N demand calculation
+     if (p%coh%species.ne.nspec_tree+2) then
+        p%coh%Ndemc_d=dailyNPP*1000.*spar(ns)%pcnr
+     end if
+    IF((flag_limi==4 .OR. flag_limi==5) .AND. 1. > p%coh%RedNc .AND.     &
+        p%coh%N_fol/p%coh%t_leaf <= 4.5 .AND. p%coh%N_pool > 0.) THEN
+       IF(p%coh%N_pool > p%coh%N_fol*(1./p%coh%RedNc - 1.)) THEN
+          p%coh%N_fol  = p%coh%N_fol / p%coh%RedNc
+          p%coh%N_pool = p%coh%N_pool - p%coh%N_fol*(1./p%coh%RedNc - 1.)
+       ELSE
+          p%coh%N_fol  = p%coh%N_fol + p%coh%N_pool
+          p%coh%N_pool = 0.0
+       ENDIF   
+    ENDIF
+    p => p%next
+  END DO 
+END SUBROUTINE NPP

source_code/version_2.3_windows/old_out.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*                  - output routines -                          *!
+!*          Specific files written from model subroutines        *!
+!*                                                               *!
+!*   contains                                                    *!
+!*   OLD_OUT:      Initialization of output files  ("private")   *!
+!*   OUT_ASS:      file output ("private")                       *!
+!*   OUT_ALL:      output for monitoring allocation              *!
+!*   OUTTEST:      test of output flags                          *!
+!*   OUTTEST_YEAR: test of output flags - yearly output          *!
+!*   OUTTEST_DAY:  test of output flags - daily output           *!
+!*   OUTTEST_COH:  test of output flags - cohort output          *!
+!*                                                               *!
+!*                  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 old_out
+
+ use data_out
+ use data_simul
+
+ implicit none
+
+ INTEGER help_ip
+ CHARACTER(100) ::filename
+
+IF(site_nr==1) THEN
+    help_ip=site_nr
+ELSE
+    help_ip=ip
+END IF
+
+! open output files & write column headers
+if (time_out .gt. 0) then
+   if (out_flag_light .ne. 0) then
+      unit_light=getunit()
+      filename = trim(site_name(help_ip))//'_light.res'//trim(anh)
+      OPEN (unit_light, file=trim(dirout)//filename, status = 'UNKNOWN')
+      WRITE (unit_light, '(A)') 'year coh totFAPR   LAI   '
+   endif
+
+   if (flag_cohout .eq. 2) then
+      unit_prod = getunit()
+      filename = trim(site_name(help_ip))//'_prod.res'//trim(anh)
+      OPEN (unit_prod, file=trim(dirout)// filename, status = 'UNKNOWN')
+      WRITE (unit_prod, '(A)') ' year  day  coh         PAR     totFPAR         LUE         NPP      netAss    grossAss     nDaysPS'
+      unit_allo = getunit()
+      filename = trim(site_name(help_ip))//'_allo.res'//trim(anh)
+      OPEN (unit_allo, file=trim(dirout)//filename, status = 'UNKNOWN')
+      WRITE (unit_allo, '(A)') ' year  coh   ntree        NPP        dbh growthrate       Fnew       Fmax      Htnew&
+                              &    lambdaf    lambdas    lambdar    lambdac         x1         x2&
+                              &    xnsc_sap_max         xnsc_tb_max         xnsc_crt_max         xnsc_sap         xnsc_tb         xnsc_crt'
+
+   endif
+endif
+
+   IF (flag_dayout .ge. 2) THEN
+      unit_wat = getunit()
+      filename = trim(site_name(help_ip))//'_water.res'//trim(anh)
+      OPEN (unit_wat, file=trim(dirout)//filename, status = 'UNKNOWN')
+      WRITE (unit_wat, '(A)') ' Year Iday   Temp   Prec Interc Int_st  Int_s I_st_s   Snow Snow_sm     PET TRA_DEM&
+                              &     PEV   AEV_s   AEV_i  Percol   WAtot   WEtot   WUtot WUtot_e&
+                              & WUtot_r Tratree Trasveg EVA_dem  GP_can     AET cep_can  cep_sv'
+
+      unit_soicnd = getunit()
+      filename = trim(site_name(help_ip))//'_Nmin.res'//trim(anh)
+      OPEN (unit_soicnd, file=trim(dirout)//filename, status = 'UNKNOWN')
+      WRITE (unit_soicnd, '(A)') ' Year Iday     N_min_1     N_min_2     N_min_3     N_min_4     N_min_5     N_min_6 ... '
+
+      unit_soicna = getunit()
+      filename = trim(site_name(help_ip))//'_remin.res'//trim(anh)
+      OPEN (unit_soicna, file=trim(dirout)// filename, status = 'UNKNOWN')
+      WRITE (unit_soicna, '(A)') ' Year Iday    remin_1     remin_2     remin_3     remin_4     remin_5     remin_6'
+
+     unit_soicnr = getunit()
+      filename = trim(site_name(help_ip))//'_rmin.res'//trim(anh)
+      OPEN (unit_soicnr, file=trim(dirout)// filename, status = 'UNKNOWN')
+      WRITE (unit_soicnr, '(A)') ' Year Iday    rmin_t     rmin_w     rmin_phv'
+
+   ENDIF
+
+END SUBROUTINE old_out
+
+!**************************************************************
+
+SUBROUTINE OUT_ASS(ident,PAR,NPP,totFPAR,LUE,netass,grossass,ndaysps)
+
+  USE data_simul
+  USE data_out
+
+  IMPLICIT NONE
+
+  REAL :: temp, dayL, PAR, netAss, grossass, maintResp, NPP, totFPAR, sapresp, coarseresp, frtresp, assi, resp, LUE, ndaysps
+  integer :: ident
+
+  WRITE(unit_prod, '(3I5,6E12.4,F6.1)') time_cur,iday,ident, PAR,totFPAR,LUE,NPP,netAss,grossass, ndaysps
+
+END SUBROUTINE OUT_ASS
+
+!**************************************************************
+
+SUBROUTINE OUT_ALL( ident, ntree, NPP, DBH, grate, Fnew,Fmax_old,Htnew, lf,ls,lr,lc,x1,x2,xnsc_sap_max, xnsc_tb_max, xnsc_crt_max, xnsc_sap, xnsc_tb, xnsc_crt)
+
+  !*** Declaration part ***!
+
+  USE data_out
+  USE data_simul
+  USE data_stand
+
+  IMPLICIT NONE
+
+  INTEGER :: ident
+  REAL  ::  ntree, NPP, DBH, lf, ls, lr, lc, x1, x2, grate,Fnew,Fmax_old,Htnew,xnsc_sap_max, xnsc_tb_max, xnsc_crt_max, xnsc_sap, xnsc_tb, xnsc_crt
+
+  !*** Calculation part ***!
+
+WRITE( unit_allo, '(2I5,F8.0,18F11.4)' ) time_cur, ident, ntree, NPP, DBH,grate,Fnew,Fmax_old,Htnew, lf,ls,lr,lc,x1,x2,xnsc_sap_max, xnsc_tb_max, xnsc_crt_max, xnsc_sap, xnsc_tb, xnsc_crt
+
+END SUBROUTINE out_all
+
+!**************************************************************
+
+SUBROUTINE outtest
+
+use data_out
+use data_simul
+
+implicit none
+
+integer hflag, j, i
+logical testflag
+character a
+
+call outtest_year
+call outtest_day
+call outtest_coh
+call outtest_end
+
+END subroutine outtest
+
+!**************************************************************
+
+SUBROUTINE outtest_year
+
+use data_out
+use data_simul
+
+implicit none
+
+integer i, j
+logical testflag
+character a
+
+IF (time_out > 0 ) then
+   if (nyvar .eq. 1) then
+      do i = 1,outy_n
+         SELECT CASE (outy(i)%kind_name)
+
+         CASE ('litter')
+            outy(i)%out_flag = 2
+
+         CASE ('soil')
+            outy(i)%out_flag = 2
+
+         CASE DEFAULT
+            outy(i)%out_flag = 1
+         end select
+      enddo
+   else
+      outy%out_flag = 0
+      do j = 1,nyvar-1
+         testflag = .TRUE.
+         do i = 1,outy_n
+            if (trim(outy_file(j)) .eq. trim(outy(i)%kind_name)) then
+               SELECT CASE (outy(i)%kind_name)
+               CASE ('litter')
+                  outy(i)%out_flag = 2
+               CASE ('soil')
+                  outy(i)%out_flag = 2
+               CASE DEFAULT
+                  outy(i)%out_flag = 1
+               end select
+			   testflag = .FALSE.
+			   exit
+			endif
+         enddo
+		 if (testflag .and. trim(outy_file(j)) .ne. 'end') then
+		    print *
+            print *,' >>>FORESEE message: Invalid output file name: '//trim(outy_file(j))
+		    print *
+         endif
+      enddo
+   endif  ! nyvar
+
+   IF (year/time_out > 500) then
+       print *,' '
+       write(*,*)'  Warning: Your choice of yearly output steps will create'
+       write(*,'(I8,A)') year/time_out, ' data records per file!'
+       write(*,'(A)',advance='no')'  Do you really want to use this value (y/n)? '
+       read *,a
+          IF (a .eq. 'n' .or. a .eq. 'N') then
+           write(*,'(A)',advance='no')'  New value of time distance for yearly output: '
+           read *, time_out
+          ENDIF
+   ENDIF
+ELSE
+   do i = 1,outy_n
+      outy(i)%out_flag = 0
+   enddo
+ENDIF   ! time_out > 0 
+
+END SUBROUTINE outtest_year
+
+!**************************************************************
+
+SUBROUTINE outtest_day
+
+use data_out
+use data_simul
+
+implicit none
+
+integer i, j
+logical testflag
+character a
+
+! daily output
+IF (flag_dayout > 0 ) then
+   if (ndvar .eq. 1) then
+      do i = 1,outd_n
+         outd(i)%out_flag = 1
+      enddo
+   else
+      outd%out_flag = 0
+      do j = 1,ndvar-1
+         testflag = .TRUE.
+         do i = 1,outd_n
+            if (trim(outd_file(j)) .eq. trim(outd(i)%kind_name)) then
+               outd(i)%out_flag = 1
+			   testflag = .FALSE.
+			   exit
+			endif
+         enddo
+		 if (testflag .and. trim(outd_file(j)) .ne. 'end') then
+		    print *
+            print *,' >>>FORESEE message: Invalid output file name: '//trim(outd_file(j))
+		    print *
+         endif
+      enddo
+   endif  ! ndvar
+else
+   do i = 1,outd_n
+      outd(i)%out_flag = 0
+   enddo
+endif
+
+END SUBROUTINE outtest_day
+
+!**************************************************************
+
+SUBROUTINE outtest_coh
+
+use data_out
+use data_simul
+
+implicit none
+
+integer i, j
+logical testflag
+
+! cohort output
+SELECT CASE (flag_cohout)
+CASE (0)
+   ! flags of all daily cohort files
+   do i = 1,outcd_n
+      outcd(i)%out_flag = 0
+   enddo
+
+   ! flags of all yearly cohort files
+   do i = 1,outcy_n
+      outcy(i)%out_flag = 0
+   enddo
+   flag_cohoutd = 0
+   flag_cohouty = 0
+
+CASE (1,2)
+   if (ncvar .eq. 1) then
+!    yearly cohort output
+      if (time_out .gt. 0) then
+        do i = 1,outcy_n
+          select case (outcy(i)%kind_name)
+          case ('dtr')
+            outcy(i)%out_flag = 2
+          case ('trman')
+            outcy(i)%out_flag = 2
+          case default
+            outcy(i)%out_flag = 1
+          end select
+        enddo
+        flag_cohouty   = 1
+      else
+	    outcy%out_flag = 0
+        flag_cohouty   = 0
+	  endif
+
+!    daily cohort output
+      if (flag_dayout .gt. 0) then
+        do i = 1,outcd_n
+          select case (outcd(i)%kind_name)
+          case ('dips')
+            outcd(i)%out_flag = 2
+          case ('gsdps')
+            outcd(i)%out_flag = 2
+          case default
+            outcd(i)%out_flag = 1
+          end select
+        enddo
+      else
+	     outcd%out_flag = 0
+	  endif
+   else
+      outcy%out_flag = 0
+      outcd%out_flag = 0
+      flag_cohoutd = 0
+      flag_cohouty = 0
+      do j = 1,ncvar-1
+         testflag = .TRUE.
+         do i = 1,outcy_n
+            if (trim(outc_file(j)) .eq. trim(outcy(i)%kind_name)) then
+               select case (outcy(i)%kind_name)
+               case ('dtr')
+                 outcy(i)%out_flag = 2
+               case ('trman')
+                 outcy(i)%out_flag = 2
+               case default
+                 outcy(i)%out_flag = 1
+               end select
+			   testflag = .FALSE.
+               flag_cohouty = 1
+			   exit
+			endif
+         enddo
+         if (testflag .and. flag_dayout .gt. 0) then
+           do i = 1,outcd_n
+              if (trim(outc_file(j)) .eq. trim(outcd(i)%kind_name)) then
+                 select case (outcd(i)%kind_name)
+                 case ('dips')
+                   outcd(i)%out_flag = 2
+                 case ('gsdps')
+                   outcd(i)%out_flag = 2
+                 case default
+                   outcd(i)%out_flag = 1
+                 end select
+			     testflag = .FALSE.
+                 flag_cohouty = 1
+			     exit
+		      endif
+           enddo
+         endif
+		 if (testflag .and. trim(outd_file(j)) .ne. 'end') then
+		    print *
+            print *,' >>>FORESEE message: Invalid output file name: '//trim(outd_file(j))
+		    print *
+         endif
+      enddo
+   endif  ! ncvar
+END SELECT
+
+if (flag_cohout .eq. 2) then
+   out_flag_light = 1
+else
+   out_flag_light = 0
+endif
+
+END SUBROUTINE outtest_coh
+
+!**************************************************************
+
+SUBROUTINE outtest_end
+
+use data_out
+use data_simul
+
+implicit none
+
+integer i, j
+if (flag_wpm == 1 .or. flag_wpm == 21 .or. flag_wpm == 11.or.flag_wpm== 5.or. flag_wpm == 4 .or. flag_wpm == 6) then
+	do i = 1,oute_n
+	  select case (oute(i)%kind_name)
+	  case ('wpm')
+		oute(i)%out_flag = 1
+	  case ('wpm_inter')
+		oute(i)%out_flag = 1
+	  end select
+	enddo
+else if (flag_wpm == 2) then
+	do i = 1,oute_n
+	  select case (oute(i)%kind_name)
+	  case ('sea')
+		oute(i)%out_flag = 1
+	  case ('sea_npv')
+		oute(i)%out_flag = 1
+	  case ('sea_ms')
+		oute(i)%out_flag = 1
+	  case ('sea_st')
+		oute(i)%out_flag = 1
+
+	  end select
+	enddo
+else if(flag_wpm.eq.3) then
+	do i = 1,oute_n
+	  select case (oute(i)%kind_name)
+	  case ('sea')
+		oute(i)%out_flag = 1
+	  case ('sea_npv')
+		oute(i)%out_flag = 1
+	  case ('sea_ms')
+		oute(i)%out_flag = 1
+	  case ('sea_st')
+		oute(i)%out_flag = 1
+	  case ('wpm')
+		oute(i)%out_flag = 1
+	  case ('wpm_inter')
+		oute(i)%out_flag = 1
+
+	  end select
+	enddo
+
+else
+	do i = 1,oute_n
+		oute(i)%out_flag = 0
+	enddo
+endif
+
+
+END SUBROUTINE outtest_end

source_code/version_2.3_windows/out_var_stat.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*   output of variables with statistics for climate scenarios   *!
+!*                                                               *!
+!*   contains                                                    *!
+!*   OUT_VAR_STAT  compressing of output variables               *!
+!*   CALC_STAT     calculation of statistics                     *!
+!*                  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 out_var_stat(kind, act_real)
+
+! compressing of output variables with statistics (multi run 9, 10)
+   use data_out
+   use data_par
+   use data_simul
+   use data_site
+
+  IMPLICIT NONE
+
+  integer kind      ! 1 - aggregation per realisation (average)
+                    ! 2 - aggregation per climate scenario over all realisations with statistics 
+                    ! 3 - statistics per month over all years  
+  integer act_real  ! number of actual realisation
+  integer i, j, k, unit_nr, ii
+  real varerr, help
+  character(50) :: filename    ! complete name of output file
+  real, dimension(nrreal) :: helparr
+  real, dimension(year):: helpmon
+  character(30) :: helpvar
+  character(20) idtext, datei
+  character(150) htext
+
+! mit Numerical Recipies
+      REAL:: adev,ave,var,  &
+             curt=-99.      ,  &
+             sdev=-99.      ,  &
+             skew=0.
+
+! Statistische Masszahlen fuer Klimaszen.-Realisierungen
+real:: avcl,          & ! Mittelwert
+       mincl,         & ! Minimum 
+       maxcl,         & ! Maximum  
+       median,        & ! Median
+       stdevcl=-99. , & ! Standardabweichung  
+       varicl,        & ! Streuung 
+       varcocl          ! Variationskoeffizient 
+real  quant05, quant95  ! 0.05 and 0.95 quantile
+real, external :: mean, variance   
+
+if (flag_trace) write (unit_trace, '(I4,I10,A,2I5)') iday, time_cur, ' out_var_stat ',kind,act_real
+
+select case (kind)
+case (1,2)
+    if (output_unit_all .le.0) then    
+         filename = trim(site_name1)//'_var_all.out'    
+         output_unit_all   = getunit()
+         open(output_unit_all,file=trim(dirout)//filename,status='replace')
+         write (output_unit_all, '(A)') '#  Output of mean annual values for each site and each realization of climate scenarios'
+         write (output_unit_all, '(A, I6)') '#  Simulation period (years):   ', year
+         write (output_unit_all, '(A, I6)') '#  Number of climate scenarios: ', nrclim
+         write (output_unit_all, '(A, I6)') '#  Number of realizations:      ', nrreal
+         write (output_unit_all, *) 
+         write (output_unit_all, '(A)', advance='no') '# Type_clim.scen.  Site_ip    Real.' 
+         
+         do i = 1, nvar-1
+            select case (trim(outvar(i)))
+            case ('AET_year','cwb_year','GPP_year','NEP_year','NPP_year','perc_year','PET_year','temp_year','TER_year','prec_year','resps_year')  
+                 continue
+           
+            case ('AET_mon','cwb_mon','GPP_mon','NEP_mon','NPP_mon','perc_mon','PET_mon','temp_mon','TER_mon','prec_mon','resps_mon')  
+                 continue
+           
+            case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+                 continue
+           
+            case default
+                 write (output_unit_all, '(A12)', advance='no') trim(outvar(i)) 
+         
+            end select
+         enddo      
+
+         write (output_unit_all, '(A)') ''
+    endif
+
+case (3)
+  do i = 1, nvar-1
+    if (output_unit_mon(i) .le.0) then     ! for monthly values
+         filename = trim(site_name1)//'_'//trim(outvar(i))//'_stat.res'    
+         output_unit_mon(i)   = getunit()
+         open(output_unit_mon(i),file=trim(dirout)//filename,status='replace')
+         write (output_unit_mon(i), '(A)') '#  Output of mean monthly values for '//trim(outvar(i))
+         write (output_unit_mon(i), '(A, I6)') '#  Simulation period (years):   ', year
+         varerr = 0
+    endif
+  enddo  
+end select
+
+select case (kind)
+
+case (1)     ! after each realisation
+  write (output_unit_all, '(2X, A15, 1X, A10, I5,2X)', advance = 'no') trim(typeclim(iclim)), sitenum(ip), act_real
+  do i = 1, nvar-1
+     select case (trim(outvar(i)))
+
+     case ('AET_year','cwb_year','GPP_year','NEP_year','NPP_year','perc_year','PET_year','temp_year','TER_year','prec_year','resps_year')  
+        ii = output_var(i,1,0) 
+            do j = 1, year
+                climszenyear(ii,ip,iclim,act_real,j) = output_var(i,1,j)
+            enddo
+
+     case ('AET_mon','cwb_mon','GPP_mon','NEP_mon','NPP_mon','perc_mon','PET_mon','temp_mon','TER_mon','prec_mon','resps_mon')  
+        ii = output_var(i,1,0)
+        do k = 1,12
+            help = 0.
+            do j = 1, year
+                help = help + output_varm(ii,1,j,k)
+            enddo
+            help = help / year
+            climszenmon(ii,ip,iclim,act_real,k) = help
+        enddo
+
+     case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+        ii = output_var(i,1,0)
+        do k = 1,52
+            help = 0.
+            do j = 1, year
+                help = help + output_varw(ii,1,j,k)
+            enddo
+            help = help / year
+            climszenweek(ii,ip,iclim,act_real,k) = help
+        enddo
+
+     case default
+        help = 0.
+       do j = 1, year
+           help = help + output_var(i,1,j)
+       enddo  ! j
+       help = help / year
+       climszenres(i,ip,iclim,act_real) = help
+       write (output_unit_all, '(E12.4)', advance = 'no')  help
+     end select    ! outvar
+  end do  ! i
+  write (output_unit_all, '(A)') ''
+
+case (2)    ! am Ende der Simulation
+  do i = 1, nvar-1
+
+    if (output_unit(i) .lt. 0) then
+        helpvar = outvar(i)
+        call out_var_select(helpvar, varerr, unit_nr)
+        if (varerr .ne. 0.) then
+            output_unit(i) = unit_nr
+            write (unit_nr, '(A, I6)') '#  Simulation period (years):   ', year
+            write (unit_nr, '(A, I6)') '#  Number of climate scenarios: ', nrclim
+            write (unit_nr, '(A, I6)') '#  Number of realizations:      ', nrreal
+            
+            select case (trim(outvar(i)))
+            case ('AET_year','cwb_year','GPP_year','NEP_year','NPP_year','perc_year','PET_year','temp_year','TER_year','prec_year','resps_year')  
+                    write (unit_nr, '(A)') '#  Statistics over all realizations for each year ' 
+                    write (unit_nr, '(A)') '# Type_clim.scen.    Site_ip   Year        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            
+            case ('AET_mon','cwb_mon','GPP_mon','NEP_mon','NPP_mon','perc_mon','PET_mon','temp_mon','TER_mon','prec_mon','resps_mon')  
+                    write (unit_nr, '(A)') '#  Statistics over all realizations and all years for each month '  
+                    write (unit_nr, '(A)') '# Type_clim.scen.    Site_ip  Month        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+
+            case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+                    write (unit_nr, '(A)') '#  Statistics over all realizations and all years for each week '  
+                    write (unit_nr, '(A)') '# Type_clim.scen.    Site_ip   Week        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+
+             case default
+                    write (unit_nr, '(A)') '#  Statistics over all realizations (mean of all years) '  
+                    write (unit_nr, '(A)') '# Type_clim.scen.    Site_ip        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            end select
+        else
+            write (*,*)
+            write (*,*) '***  4C-error - output of variables (out_var_file): ', trim(outvar(i)), ' not found'
+            write (*,*)
+            write (unit_err,*)
+            write (unit_err,*) '***  4C-error - no such output variable (out_var_file): ', trim(outvar(i))
+        endif
+    endif
+
+    if (output_unit(i) .ge. 0) then
+       select case (trim(outvar(i)))
+            case ('AET_year','cwb_year','GPP_year','NEP_year','NPP_year','perc_year','PET_year','temp_year','TER_year','prec_year','resps_year')  
+             ii = output_var(i,1,0)
+            do k = 1, year 
+               write (output_unit(i), '(2X, A15, 1X, A10, I7)', advance = 'no') trim(typeclim(iclim)),  sitenum(ip), k
+               do j = 1, nrreal
+                   helparr(j) = climszenyear(ii,ip,iclim,j,k)
+               enddo
+               call calc_stat(nrreal, helparr, output_unit(i))
+            enddo
+           
+            case ('AET_mon','cwb_mon','GPP_mon','NEP_mon','NPP_mon','perc_mon','PET_mon','temp_mon','TER_mon','prec_mon','resps_mon')  
+                ii = output_var(i,1,0)
+                do k = 1, 12 
+                   write (output_unit(i), '(2X, A15, 1X, A10, I7)', advance = 'no') trim(typeclim(iclim)),  sitenum(ip), k
+                   do j = 1, nrreal
+                       helparr(j) = climszenmon(ii,ip,iclim,j,k)
+                   enddo
+                   call calc_stat(nrreal, helparr, output_unit(i))
+                enddo
+
+            case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+            ii = output_var(i,1,0)
+            do k = 1, 52 
+               write (output_unit(i), '(2X, A15, 1X, A10, I7)', advance = 'no') trim(typeclim(iclim)),  sitenum(ip), k
+               do j = 1, nrreal
+                   helparr(j) = climszenweek(ii,ip,iclim,j,k)
+               enddo
+               call calc_stat(nrreal, helparr, output_unit(i))
+            enddo
+
+       case default
+           write (output_unit(i), '(2X, A15, 1X, A10)', advance = 'no') trim(typeclim(iclim)),  sitenum(ip)
+           do j = 1, nrreal
+               helparr(j) = climszenres(i,ip,iclim,j)
+           enddo
+               
+           call calc_stat(nrreal, helparr, output_unit(i))
+       end select
+    endif
+  enddo
+
+case (3)     ! Monthly values
+  do i = 1, nvar-1
+     helpvar = outvar(i)
+         select case (trim(outvar(i)))
+
+         case ('AET_year','cwb_year','GPP_year','NEP_year','NPP_year','perc_year','PET_year','temp_year','TER_year','prec_year','resps_year')  
+            ii = output_var(i,1,0) 
+                do j = 1, year
+                    climszenyear(ii,ip,iclim,act_real,j) = output_var(i,1,j)
+                enddo
+
+         case ('GPP_mon','NPP_mon','TER_mon')  
+            ii = output_var(i,1,0)
+            if (ip .eq.1) then
+                write (output_unit_mon(i), '(A)') '# Statistics over all years for each month '  
+                write (output_unit_mon(i), '(A)') '# g C/m '  
+                write (output_unit_mon(i), '(A)') '# ipnr site_id             Month        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            endif
+            do k = 1,12
+                help = 0.
+                do j = 1, year
+                    helpmon(j) = output_varm(ii,1,j,k) * 100.  ! tC/ha --> gC/m
+                enddo
+                htext  = adjustr(site_name(ip))
+                idtext = adjustl(htext (131:150))   ! only write last 20 signs
+                write (output_unit_mon(i), '(I5,2X, A20,I5)', advance = 'no') ip, idtext, k
+                call calc_stat(year, helpmon, output_unit_mon(i))
+            enddo
+
+         case ('NEE_mon')  
+            ii = output_var(i,1,0)
+            if (ip .eq.1) then
+                write (output_unit_mon(i), '(A)') '# Statistics over all years for each month '  
+                write (output_unit_mon(i), '(A)') '# g C/m '  
+                write (output_unit_mon(i), '(A)') '# ipnr site_id             Month        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            endif
+            do k = 1,12
+                help = 0.
+                do j = 1, year
+                    helpmon(j) = output_varm(ii,1,j,k)      ! gC/m
+                enddo
+                htext  = adjustr(site_name(ip))
+                idtext = adjustl(htext (131:150))   ! only write last 20 signs
+                write (output_unit_mon(i), '(I5,2X, A20,I5)', advance = 'no') ip, idtext, k
+                call calc_stat(year, helpmon, output_unit_mon(i))
+            enddo
+
+         case ('resps_mon')  
+            ii = output_var(i,1,0)
+            if (ip .eq.1) then
+                write (output_unit_mon(i), '(A)') '# Statistics over all years for each month '  
+                write (output_unit_mon(i), '(A)') '# g C/m '  
+                write (output_unit_mon(i), '(A)') '# ipnr site_id             Month        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            endif
+            do k = 1,12
+                help = 0.
+                do j = 1, year
+                    helpmon(j) = output_varm(ii,1,j,k) * kgha_in_gm2  ! kgC/ha --> gC/m
+                enddo
+                htext  = adjustr(site_name(ip))
+                idtext = adjustl(htext (131:150))   ! only write last 20 signs
+                write (output_unit_mon(i), '(I5,2X, A20,I5)', advance = 'no') ip, idtext, k
+                call calc_stat(year, helpmon, output_unit_mon(i))
+            enddo
+
+         case ('AET_mon','cwb_mon','perc_mon','PET_mon','temp_mon','prec_mon')  
+            ii = output_var(i,1,0)
+            if (ip .eq.1) then
+                write (output_unit_mon(i), '(A)') '# Statistics over all years for each month '  
+                write (output_unit_mon(i), '(A)') '#  '  
+                write (output_unit_mon(i), '(A)') '# ipnr site_id             Month        Mean     Minimum     Maximum    Variance  Var.Coeff.    Std.Dev.    Skewness      Excess 0.05-Quant. 0.95-Quant.     Median'
+            endif
+            do k = 1,12
+                help = 0.
+                do j = 1, year
+                    helpmon(j) = output_varm(ii,1,j,k)
+                enddo
+                htext  = adjustr(site_name(ip))
+                idtext = adjustl(htext (131:150))   ! only write last 20 signs
+                write (output_unit_mon(i), '(I5,2X, A20,I5)', advance = 'no') ip, idtext, k
+                call calc_stat(year, helpmon, output_unit_mon(i))
+            enddo
+
+         case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+            ii = output_var(i,1,0)
+            do k = 1,52
+                help = 0.
+                do j = 1, year
+                    help = help + output_varw(ii,1,j,k)
+                enddo
+                help = help / year
+                climszenweek(ii,ip,iclim,act_real,k) = help
+            enddo
+   
+         case default
+            help = 0.
+           do j = 1, year
+               help = help + output_var(i,1,j)
+           enddo  ! j
+           help = help / year
+           climszenres(i,ip,iclim,act_real) = help
+           write (output_unit_all, '(E12.4)', advance = 'no')  help
+         end select    ! outvar
+  end do  ! i
+  write (output_unit_all, '(A)') ''
+end select
+END SUBROUTINE out_var_stat
+
+!**************************************************************
+
+SUBROUTINE calc_stat(nreal, helparr, outunit)
+
+! calculate statistics
+   use data_out
+   use data_simul
+
+  IMPLICIT NONE
+
+integer :: outunit   ! output unit
+integer :: nreal     ! number of elements
+real, dimension(nreal) :: helparr   ! input-array with dimension nreal 
+
+! with numerical recipies
+      REAL:: adev,ave,var,  &
+             curt=-99.      ,  &
+             sdev=-99.      ,  &
+             skew=0.
+
+! statistical measurment figures for climate scenario realisation
+real:: avcl,          & ! mean
+       mincl,         & ! minimum 
+       maxcl,         & ! maximum  
+       median,        & ! median
+       stdevcl=-99. , & ! standard deviation  
+       varicl,        & ! dispersion
+       varcocl          ! coefficient of variance 
+real  quant05, quant95  ! 0.05 and 0.95 quantile
+real, external :: mean, variance
+
+    avcl    = mean(nreal, helparr)
+    mincl   = minval(helparr)
+    maxcl   = maxval(helparr)
+    varicl  = variance(nreal, avcl, helparr)
+    if (varicl .ge. 0.) stdevcl = sqrt(varicl)
+    if (avcl .ne. 0.) then
+        varcocl = stdevcl / avcl
+    else
+        varcocl = -9999.0
+    endif
+    call quantile(nreal, helparr, quant05, quant95, median)
+
+! with numerical recipies
+    if (nreal .gt. 1) call moment(helparr, nreal, ave,adev,sdev,var,skew,curt)
+    write (outunit, '(11E12.4)')  avcl, mincl, maxcl, varicl, varcocl, sdev, skew, curt, quant05, quant95, median
+
+END SUBROUTINE calc_stat

source_code/version_2.3_windows/output.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*    - output routines - initialization and writing in files    *!
+!*                                                               *!
+!*   contains                                                    *!
+!*   PREP_OUT       initialization of output files               *!
+!*   PREP_OUTYEAR   prepare yearly output files                  *!
+!*   PREP_COH       prepare output of cohorts                    *!
+!*   PREP_OUT_COMP  prepare compressed output                    *!
+!*   OUTYEAR        yearly output in files                       *!
+!*   OUTDAY         daily output in files                        *!
+!*   COH_OUT_D      daily cohort output                          *!
+!*   COH_OUT_Y      yearly cohort output                         *!
+!*   OUT_COMP       compressed output (multi run)                *!
+!*   OUT_WPM	    ouput for WPM after the simulation is ended  *!
+!*   OUT_SCEN       climate scenario control file (multi run)    *!
+!*   ERROR_MESS     print error message in error file "error.log"*!
+!*   STOP_MESS      print message on program abortion            *!
+!*   OPEN_FILE      open special output file                     *!
+!*   WR_HEADER_FILE write header of special output file          *!
+!*   OUTVEG         output of species values (files veg_species) *!
+!*   OUTSTORE       store of output variables (multi run 4)      *!
+!*   OUT_VAR_FILE   store of output variables (multi run 4)      *!
+!*                                                               *!
+!*                  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 prep_out
+
+! Open output files
+USE data_simul
+USE data_species
+USE data_stand
+USE data_out
+
+IMPLICIT NONE
+
+CHARACTER(50) ::filename
+INTEGER i,help_ip
+INTEGER unit_n       ! output unit
+
+IF(site_nr==1) THEN
+    help_ip=site_nr
+ELSE
+    help_ip=ip
+END IF
+
+! 1. yearly output
+! open all selected files
+if (time_out .gt. 0) then
+   call prep_outyear (help_ip)
+endif
+
+call old_out !behelfs, privatoutput
+
+! 2. daily output
+! open all selected files
+if (flag_dayout .ge. 1) then
+   do i = 1,outd_n
+     if (outd(i)%out_flag .ne. 0) then
+       select CASE (outd(i)%kind_name)
+       CASE ('Cbcd')
+        if (flag_bc .gt. 0) then
+             call open_file (outd(i), help_ip)
+             call wr_header_file (outd(i))
+        endif
+
+       CASE default
+         call open_file (outd(i), help_ip)
+         call wr_header_file (outd(i))
+
+       end select
+     endif
+   END DO   !i
+END IF
+
+! 3.Cohort output
+if(flag_cohout==1.or.flag_cohout==2) call prep_coh
+
+! 4. end output
+! open all selected files
+if (flag_wpm .gt. 0) then
+   do i = 1,oute_n
+     if (oute(i)%out_flag .ne. 0) then
+       select CASE (oute(i)%kind_name)
+
+       CASE default
+         call open_file (oute(i), help_ip)
+         call wr_header_file (oute(i))
+
+       end select
+     endif
+   END DO   !i
+END IF
+
+! 5.summation output
+if(flag_sum>0)then
+  unit_sum=getunit()
+  filename = trim(site_name(help_ip))//'_sum.out'//trim(anh)
+  open(unit_sum,file=trim(dirout)//filename,status='replace')
+  WRITE(unit_sum,'(A)') '# Photsum   = Sum of gross photosynthesis gC/m2'
+  WRITE(unit_sum,'(A)') '# NPPpotsum = Sum of potential NPP gC/m2'
+  WRITE(unit_sum,'(A)') '# NPPsum    = Sum of NPP gC/m2'
+  WRITE(unit_sum,'(A)') '# respsoil  = Sum of soil respiration gC/m2'
+  WRITE(unit_sum,'(A)') '# lightsum  = Sum of global radiation MJ/m2'
+  WRITE(unit_sum,'(A)') '# NEE       = Sum of respsoil - daily NPP gC/m2'
+  WRITE(unit_sum,'(A)') '# ALS       = Sum of absorbed global radiation MJ/m2'
+  WRITE(unit_sum,'(A)') '# Psum      = Sum of precipitation (mm)'
+  WRITE(unit_sum,'(A)') '# Tmean     = mean temperature (C)'
+  WRITE(unit_sum,'(A)') '# GPP       = GPP  gC/m2'
+  WRITE(unit_sum,'(A)') '# TER       = Total ecosystem respiration  gC/m2'
+  WRITE(unit_sum,'(A)') '# respaut   = Autotrophe respiration gC/m2'
+
+  select CASE(flag_sum)
+    CASE(1)
+      WRITE(unit_sum,'(A11)') '# Daily sum'
+      WRITE(unit_sum,'(2A5,13A10)') '# Day','Year','Photsum','NPPpotsum','NPPsum', &
+                                            'respsoil','lightsum','NEE', 'ALS', 'Psum',&
+                                            'Tmean','cor_res', 'GPP','TER','respaut'
+    CASE(2)
+      WRITE(unit_sum,'(A50)') '# AET       = Sum of actual evapotranspiration (mm)'
+      WRITE(unit_sum,'(A50)') '# PET       = Sum of potential evapotranspiration (mm)'
+      WRITE(unit_sum,'(A50)') '# Percol.   = Sum  of percolation water from last layer (mm)'
+      WRITE(unit_sum,'(A12)') '# Weekly sum'
+      WRITE(unit_sum,'(2A6,17A10)') '# Week','Year','timedec','Photsum','NPPpotsum','NPPsum', &
+                                             'respsoil','lightsum','NEE','ALS', 'Psum','Tmean', &
+                                             'cor_res', 'AET', 'PET', 'Percol.', 'GPP','TER','respaut'
+    CASE(3)
+      WRITE(unit_sum,'(A50)') '# AET       = Sum of actual evapotranspiration (mm)'
+      WRITE(unit_sum,'(A50)') '# PET       = Sum of potential evapotranspiration (mm)'
+      WRITE(unit_sum,'(A50)') '# Ind_cout  = monthly climate index according Coutange'
+      WRITE(unit_sum,'(A50)') '# Ind_wiss  = monthly climate index according v. Wissmann'
+      WRITE(unit_sum,'(A50)') '# Ind_arid  = monthly aridity index according UNEP'
+	  WRITE(unit_sum,'(A50)') '# CWB       = monthly climate water balance (P-PET)'
+      WRITE(unit_sum,'(A50)') '# Percol.   = Sum  of percolation water from last layer (mm)'
+      WRITE(unit_sum,'(A13)') '# Monthly sum'
+      WRITE(unit_sum,'(A7,A5,20A10)') '# Month','Year','timedec','Photsum','NPPpotsum','NPPsum', &
+                                             'respsoil','lightsum','NEE','ALS', 'Psum', 'Tmean', 'AET', 'PET', 'Ind_cout', &
+											 'Ind_wiss', 'Ind_arid', 'CWB', 'Percol.', 'GPP','TER','respaut'
+    CASE(4)
+      WRITE(unit_sum,'(12A)') '# Yearly sum'
+      WRITE(unit_sum,'(A6,A10,11A11)') '# Year','Photsum','NPPpotsum','NPPsum', &
+                                            'respsoil','lightsum','NEE','ALS', 'Psum', 'Tmean', 'GPP','TER','respaut'
+  end select
+END IF
+
+END subroutine prep_out
+
+!**************************************************************
+
+SUBROUTINE prep_outyear (help_ip)
+
+! Open yearly output files
+USE data_simul
+USE data_stand
+USE data_out
+USE data_species
+
+IMPLICIT NONE
+
+CHARACTER(10)  :: helpunit
+CHARACTER(2) :: helpvar
+INTEGER i,j,help_ip,k
+INTEGER unit_n       ! output unit
+
+do i = 1,outy_n
+   if (outy(i)%out_flag .ge. 1) then
+      select CASE (outy(i)%kind_name)
+
+      CASE ('AET_mon')
+         if (ip .eq. 1) then
+            nvar = nvar + 1
+            outvar(nvar) = "AET_mon" 
+         endif  
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+
+      CASE ('Cbc', 'Nbc')
+        if (flag_bc .gt. 0) then
+             call open_file (outy(i), help_ip)
+             call wr_header_file (outy(i))
+        endif
+      
+      CASE ('classd', 'classt')        !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do !k
+         WRITE(unit_n,*) ' '
+
+      CASE ('classage')        !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do !k
+         WRITE(unit_n,*) ' '
+
+      CASE ('classmvol')        !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do !k
+         WRITE(unit_n,*) ' '
+
+      CASE ('classd_h')        !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do
+         WRITE(unit_n,*) ' '
+
+      CASE ('classdm')        !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do
+         WRITE(unit_n,*) ' '
+
+     CASE ('classdm_h')        ! open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no') trim(outy(i)%header)
+         do k=1,nspecies
+          do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+          END DO  !j
+         end do
+         WRITE(unit_n,*) ' '
+
+      CASE ('classh')       !open classification file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+         WRITE(unit_n ,'(A)') trim(outy(i)%s_line)
+         WRITE(unit_n ,'(A)',advance='no')  trim(outy(i)%header)
+         do j=1,num_class
+            WRITE(unit_n,'(A8,I2)',advance='no')'Class',j
+         END DO   !j
+         WRITE(unit_n,*) ' '
+
+      CASE ('GPP_mon')
+         if (ip .eq. 1) then
+            nvar = nvar + 1
+            outvar(nvar) = "GPP_mon" 
+         endif  
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+
+      CASE ('NEE_mon')
+         if (ip .eq. 1) then
+            nvar = nvar + 1
+            outvar(nvar) = "NEE_mon" 
+         endif  
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+
+      CASE ('NPP_mon')
+         if (ip .eq. 1) then
+            nvar = nvar + 1
+            outvar(nvar) = "NPP_mon" 
+         endif  
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+               
+      CASE ('spec')       !open species file
+         call open_file (outy(i), help_ip)
+         unit_n = outy(i)%unit_nr
+
+    !    header
+         WRITE(unit_n ,'(A)',advance='no')  trim(outy(i)%header)
+         do j=1,nspecies
+            zeig=>pt%first
+            do while (associated(zeig))
+               if(zeig%coh%species.eq.j)then
+                  WRITE(helpunit,'(I2)') zeig%coh%species
+                  read(helpunit,*) helpvar
+                  WRITE(unit_n,'(A10)',advance='no') 'Diam_S'//helpvar
+                  WRITE(unit_n,'(A10)',advance='no') 'Heig_S'//helpvar
+                  WRITE(unit_n,'(2A10)',advance='no') 'Tree_S'//helpvar,'Biom_S'//helpvar
+                  exit
+               END IF
+               zeig=>zeig%next
+            END DO
+         END DO
+         WRITE(unit_n,*) ' '
+
+      CASE ('TER_mon')
+         if (ip .eq. 1) then
+            nvar = nvar + 1
+            outvar(nvar) = "TER_mon" 
+         endif  
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+
+      CASE default
+         call open_file (outy(i), help_ip)
+         call wr_header_file (outy(i))
+
+      end select
+   END IF
+END DO   !i
+
+if (nvar .gt. 0) then
+    if (.not. allocated(output_unit_mon)) then
+        allocate(output_unit_mon(nvar))
+        if (.not. allocated(output_var)) allocate(output_var(nvar,1,0:0))
+        if (.not. allocated(output_varm)) allocate(output_varm(nvar,site_nr,year,12))
+        do i=1,nvar
+             output_var(i,1,0) = i
+        enddo     
+        nvar = nvar + 1
+    endif
+endif
+
+END subroutine prep_outyear
+
+!**************************************************************
+
+SUBROUTINE prep_coh
+
+!prepare cohort output
+USE data_simul
+USE data_stand
+USE data_out
+
+IMPLICIT NONE
+
+INTEGER help_ip
+INTEGER i
+INTEGER unit_n       ! output unit
+
+IF(site_nr==1) THEN
+    help_ip=site_nr
+ELSE
+    help_ip=ip
+END IF
+
+  ! output of all selected daily cohort files
+   do i = 1,outcd_n
+      if (outcd(i)%out_flag .ne. 0) then
+         unit_n = outcd(i)%unit_nr
+
+         select CASE (outcd(i)%kind_name)
+
+         CASE default
+           call open_file (outcd(i), help_ip)
+           call wr_header_file (outcd(i))
+
+         end select
+
+      END IF
+   END DO   !i
+
+!prepare yearly cohort output
+! output of all selected yearly files
+do i = 1,outcy_n
+  if (outcy(i)%out_flag .ne. 0) then
+   unit_n = outcy(i)%unit_nr
+
+      select CASE (outcy(i)%kind_name)
+
+      CASE default
+         call open_file (outcy(i), help_ip)
+         call wr_header_file (outcy(i))
+
+      end select
+  END IF
+END DO   !i
+END subroutine prep_coh
+
+!**************************************************************
+
+SUBROUTINE prep_out_comp
+
+! preparation: compressed output of final results for each run
+USE data_simul
+USE data_soil
+USE data_stand
+USE data_out
+
+IMPLICIT NONE
+
+character(70) filename
+
+      filename   = trim(site_name(1))//'_B'//'.cmp'
+      unit_comp1 = getunit()
+      open(unit_comp1, file=trim(dirout)//filename, status='replace')
+      write (unit_comp1, '(A)') '#   Compressed output of start values for each run'
+      write (unit_comp1, 1000)
+      write (unit_comp1, 2000)
+
+      filename   = trim(site_name(1))//'_E'//'.cmp'
+      unit_comp2 = getunit()
+      open(unit_comp2, file=trim(dirout)//filename, status='replace')
+      write (unit_comp2, '(A)') '#   Compressed output of final results for each run'
+      write (unit_comp2, '(A, I5)') '#   Simulation time (years)', year
+      write (unit_comp2, 500)
+      write (unit_comp2, 1000)
+      write (unit_comp2, 2000)
+
+500  FORMAT ('#                          ||--------------------------------------------    final state    -------------------------------------------||---   mean annual values   ---||---  cumulative quantities  ---||-------------------  final state ',&
+             '-------------------||-----------------------------------------------------------------------------     mean annual values      ---------------------------------------------------------------------------------------------------------------', &
+             '-------------------------------------------------------------------------------------------------------------------------------|')
+1000 FORMAT ('#                            m2_m2    /ha      t DW/ha  t DW/ha       cm       cm  t DW/ha  t DW/ha  t DW/ha  t DW/ha  t DW/ha  t DW/ha     t C/ha    kg C/ha    kg C/ha   kg DW/ha   kg DW/ha    kg DW/ha  t C/ha  t C/ha  t C/ha    t C/ha',&
+             '    t C/ha    t C/ha   kg C/ha   kg C/ha   kg N/ha  kg N/ha  kg N/ha   kg C/ha   kg C/ha     mm     mm     mm     mm     mm     C     mm   kg N/ha', 189X,'   J_cm2            mm  kg N/ha')
+2000 FORMAT ('# ipnr site_id                LAI  nTree typ  Biomass  Biom._sv  Meddiam   Domhei   totfol    tottb   totsap   tothrt   totfrt   totcrt   mean_NPP   mean_NEP   mean_GPP c_Stem_inc   cumVs_ab cumVs_dead   C_sum C_d_stm   C_tot C_hum_tot',&
+             '  C_tot_40  C_hum_40    C_accu  C_litter  N_litter    N_min   Nleach  Soil_Res  Tot_Resp    PET    AET percol interc transp   temp   prec   N_depo  drIndAl      GDD    cwb_an fire_inde fire_indb     I_arid   I_lang    I_cout    ', &
+			 'I_wiss    I_mart    I_weck   I_reich     I_emb    CI_gor    CI_cur    CI_con   NTindex I_Nesterov I_Budyko     Rad    RedN dew/rime   Nupt  I_frost I_frost_sp  Ind_SHC' )
+
+END subroutine prep_out_comp
+
+!**************************************************************
+
+SUBROUTINE outyear (flagout)
+
+!yearly output
+  USE data_biodiv
+  USE data_climate
+  USE data_depo
+  USE data_evapo
+  USE data_inter
+  USE data_out
+  USE data_par
+  USE data_simul
+  USE data_soil
+  USE data_soil_cn
+  USE data_species
+  USE data_stand
+  USE data_manag
+  USE data_tsort
+  USE data_site
+  USE data_frost
+
+  IMPLICIT NONE
+
+  integer flagout    ! control of output
+                     ! 1 - output with outyear,
+                     ! 2 - output after management and mortality
+  integer i,j,k,ihelp
+  integer unit_n     ! output unit
+  real hconv         ! conversion factor from patchsize into ha
+ ! output variables of yearly C-balance in kg C/ha
+  real y_GPP,   &    ! yearly gross productioin
+       y_NPP,   &    ! yearly net primary productioin
+       y_NEP,   &    ! yearly net ecosystem productioin
+       y_autresp, &  ! yearly total resp of all cohorts and species
+       y_sumbio,  &  ! total biomass of all cohorts and all species
+       y_C_d_st,  &  ! C in stems of dead trees
+       y_sumvsab, &  ! C in total sum of volume of removed stems by management
+       y_C_tot, &    ! total soil C stock (OPM, humus and litter; whithout stems)
+       y_C_tot_es, & ! total C of ecosystem (soil, dead stems and biomass)
+       y_resps, &    ! yearly soil respiration
+       y_resptot     ! yearly total respiration
+ ! output variables of yearly C-balance in mol C/m2
+  real ym_GPP,   &   ! yearly gross productioin
+       ym_NPP,   &   ! yearly net primary productioin
+       ym_NEP,   &   ! yearly net ecosystem productioin
+       ym_autresp, & ! yearly total resp of all cohorts and species
+       ym_sumbio,  & ! total biomass of all cohorts and all species
+       ym_C_d_st,  & ! C in stems of dead trees
+       ym_sumvsab, & ! C in total sum of volume of removed stems by management
+       ym_C_tot, &   ! total soil C stock (OPM, humus and litter; whithout stems)
+       ym_C_tot_es,& ! total C of ecosystem (soil, dead stems and biomass)
+       ym_resps, &   ! yearly soil respiration
+       ym_resptot, & ! yearly total respiration
+       y_lai         ! LAI of stand without soil vegetation
+ ! output variables of litter file: share in total biomasses
+  real y_fol, y_tb, y_crt, y_frt, y_stem, y_totlit, y_C_lit, y_N_lit
+ ! output variables harvested trees
+  real      se_c_ha,  & ! sortiment element in C kg/ha
+            se_m3_ha    ! volume of sortiment element in m/ha
+  real Cbc_ap  ! output variable of biochar application
+  real help, h1, h2, h3, h4, q1, q2, q3, q4
+  real hdnlf, hdnlf_sp, xhelp, xhelp1
+  integer hdate_lf, hdate_lftot, hanzdlf
+  real  hsumtlf
+
+y_lai = 0.
+
+if ((flagout .eq. 1) .and. (.not.allocated(sout))) allocate (sout(nspecies))
+if (time.eq.0) then
+   hdnlf = 0.
+   hdnlf_sp = 0.
+   hdate_lf = 0.
+   hdate_lftot = 0.
+   hanzdlf = 0.
+   hsumtlf = 0.
+else
+   hdnlf = dnlf(time)
+   hdnlf_sp = dnlf_sp(time)
+   hdate_lf = date_lf(time)
+   hdate_lftot = date_lftot(time)
+   hanzdlf = anzdlf(time)
+   hsumtlf = sumtlf(time)
+end if
+
+! output of all selected files
+do i = 1,outy_n
+   if (outy(i)%out_flag .eq. flagout) then
+   unit_n = outy(i)%unit_nr
+
+      select CASE (outy(i)%kind_name)
+
+      CASE ('AET_mon','aet_mon')
+         q1 = aet_mon(1) + aet_mon(2) + aet_mon(3)
+         q2 = aet_mon(4) + aet_mon(5) + aet_mon(6)
+         q3 = aet_mon(7) + aet_mon(8) + aet_mon(9)
+         q4 = aet_mon(10) + aet_mon(11) + aet_mon(12)
+         if (time .gt.1) then
+            h1 = aet_dec + aet_mon(1) + aet_mon(2)
+         else
+            h1 = aet_mon(1) + aet_mon(2)
+         endif
+         h2 = aet_mon(3) + aet_mon(4) + aet_mon(5)
+         h3 = aet_mon(6) + aet_mon(7) + aet_mon(8)
+         h4 = aet_mon(9) + aet_mon(10) + aet_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') aet_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('c_bal')
+         hconv     = 10000./kpatchsize
+         y_NPP     = sumNPP * cpart                     ! kg DW --> kg C
+         y_NPP     = y_NPP * hconv                      ! kg C/patch --> kg C/ha
+         y_autresp = autresp * cpart * hconv            ! kg DW pro patch --> kg C/ha
+         y_resps   = resps_c * gm2_in_kgha              ! g/m2 --> kg/ha
+         y_resptot = y_resps + y_autresp
+         y_GPP     = y_NPP + y_autresp
+         y_NEP     = y_NPP - y_resps
+         y_C_d_st  = C_opm_stem * gm2_in_kgha
+         y_sumvsab = sumvsab * cpart                    ! kg DW /ha --> kg C
+         y_sumbio  = (sumbio+sumbio_out) * cpart                     ! kg DW /ha --> kg C/ha
+         y_C_tot   = C_tot * gm2_in_kgha * 0.001        ! g/m2 --> t/ha
+         y_C_tot_es= y_C_tot + y_C_d_st + y_sumbio
+         ym_NPP    = sumNPP * cpart                     ! kg DW --> kg C
+         ym_NPP    = ym_NPP * 1./kpatchsize             ! kg C/patch --> kg C/m2
+         ym_NPP    = ym_NPP * 1000. / Cmass             ! kg C --> mol C
+         ym_autresp= autresp * cpart * kgha_in_gm2 * hconv / Cmass    ! kg DW pro patch --> mol/m2
+         ym_resps  = resps_c /Cmass                     ! g/m2 --> mol/m2
+         ym_resptot= ym_resps + ym_autresp
+         ym_GPP    = ym_NPP + ym_autresp
+         ym_NEP    = ym_NPP - ym_resps
+         ym_C_d_st = C_opm_stem  /Cmass                       ! g/m2 --> mol/m2
+         ym_sumvsab= sumvsab * cpart * kgha_in_gm2 / Cmass  ! kg DW /ha --> mol/m2
+         ym_sumbio = sumbio * cpart * kgha_in_gm2 / Cmass   ! kg DW /ha --> mol/m2
+         ym_C_tot  = C_tot /Cmass                           ! g/m2 --> mol/m2
+         ym_C_tot_es= ym_C_tot + ym_C_d_st + ym_sumbio
+
+        gppsum = gppsum * gm2_in_kgha
+
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(10F10.1,9F10.2,11F10.1,F10.1)') y_GPP, y_NPP, y_NEP, y_autresp, y_resps, y_resptot, &
+               y_C_d_st, y_sumvsab, y_sumbio, y_C_tot_es, y_C_tot,  &
+               C_tot_1, C_hum_1, C_tot_40, C_hum_40, C_tot_80, C_hum_80, C_tot_100, C_hum_100, &                    
+               ym_GPP, ym_NPP, ym_NEP, ym_autresp, ym_resps, ym_resptot, &
+               ym_C_d_st, ym_sumvsab, ym_sumbio, ym_C_tot_es, ym_C_tot, gppsum
+
+      CASE ('Cbc')
+         if (flag_bc .gt. 0) then
+             WRITE(unit_n,'(I6)',advance='no') time_cur
+             do j=1,nlay
+               WRITE(unit_n,'(F10.3)',advance='no') C_bc(j)
+             END DO   !j
+             WRITE(unit_n,'(A)') ''
+         endif
+
+      CASE ('Chum')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') C_hum(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Copm')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') C_opm(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Copmfract')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do k=1,anrspec
+           j = nrspec(k)
+           xhelp = SUM(slit(j)%C_opm_frt)
+           xhelp1 = SUM(slit(j)%C_opm_crt)
+           WRITE(unit_n,'(I8,5F10.3)',advance='no') j, slit(j)%C_opm_fol, slit(j)%C_opm_tb, &
+                          xhelp, xhelp1, slit(j)%C_opm_stem
+         END DO   ! j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classd')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+            do k=1,nspecies
+             do j=1,num_class      
+		       WRITE(unit_n,'(I10)',advance='no') diam_class(j,k)
+              END DO
+            end do
+         WRITE(unit_n,'(A)') ''
+      CASE ('classage')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+            do k=1,nspecies
+             do j=1,num_class      
+		       WRITE(unit_n,'(I10)',advance='no') diam_class_age(j,k)
+              END DO
+            end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classmvol')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+            do k=1,nspecies
+             do j=1,num_class      
+		       WRITE(unit_n,'(f10.3)',advance='no') diam_class_mvol(j,k)
+              END DO
+            end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classd_h')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do k=1,nspecies
+          do j=1,num_class
+           WRITE(unit_n,'(f10.3)',advance='no') diam_class_h(j,k)
+          END DO
+         end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classdm')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do k=1,nspecies
+          do j=1,num_class
+           WRITE(unit_n,'(I10)',advance='no') diam_classm(j,k)
+          END DO
+         end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classdm_h')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do k=1,nspecies
+          do j=1,num_class
+           WRITE(unit_n,'(f10.3)',advance='no') diam_classm_h(j,k)
+          END DO
+         end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classh')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,num_class
+           WRITE(unit_n,'(I10)',advance='no') height_class(j)
+         END DO
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('classt')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do k=1,nspecies
+          do j=1,num_class
+ 		   WRITE(unit_n,'(I10)',advance='no') diam_class_t(j,k)
+          END DO
+         end do
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('clim')
+         help = co2 * 1000000.
+
+         WRITE(unit_n,'(2I5)',advance='no') time_cur
+         WRITE(unit_n,'(6F10.2, 6I10, 7F10.2, E12.4, F8.2, 6F10.2, 2F8.2, 3I8, F10.2, I8, F10.2)') med_air,sum_prec,med_rad, med_wind, help, gdday, &
+                                   days_summer, days_hot, days_ice, days_dry, days_hrain, days_snow, ind_arid_an, cwb_an, ind_lang_an, &
+								   ind_cout_an, ind_wiss_an, ind_mart_an, ind_mart_vp, ind_emb, ind_weck, ind_reich,   &
+								   con_gor, con_cur, con_con, ntindex, ind_bud, hdnlf, hdnlf_sp, hdate_lf, hdate_lftot, hanzdlf, hsumtlf, iday_vegper, ind_shc
+
+      CASE ('clim_temp')
+         q1 = (temp_mon(1) + temp_mon(2) + temp_mon(3)) / 3.
+         q2 = (temp_mon(4) + temp_mon(5) + temp_mon(6)) / 3.
+         q3 = (temp_mon(7) + temp_mon(8) + temp_mon(9)) / 3.
+         q4 = (temp_mon(10) + temp_mon(11) + temp_mon(12)) / 3.
+         if (time .gt.1) then
+            h1 = (temp_dec + temp_mon(1) + temp_mon(2)) / 3.
+         else
+            h1 = (temp_mon(1) + temp_mon(2)) / 2.
+         endif
+         h2 = (temp_mon(3) + temp_mon(4) + temp_mon(5)) / 3.
+         h3 = (temp_mon(6) + temp_mon(7) + temp_mon(8)) / 3.
+         h4 = (temp_mon(9) + temp_mon(10) + temp_mon(11)) / 3.
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') temp_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('clim_prec')
+         q1 = prec_mon(1) + prec_mon(2) + prec_mon(3)
+         q2 = prec_mon(4) + prec_mon(5) + prec_mon(6)
+         q3 = prec_mon(7) + prec_mon(8) + prec_mon(9)
+         q4 = prec_mon(10) + prec_mon(11) + prec_mon(12)
+         if (time .gt.1) then
+            h1 = prec_dec + prec_mon(1) + prec_mon(2)
+         else
+            h1 = prec_mon(1) + prec_mon(2)
+         endif
+         h2 = prec_mon(3) + prec_mon(4) + prec_mon(5)
+         h3 = prec_mon(6) + prec_mon(7) + prec_mon(8)
+         h4 = prec_mon(9) + prec_mon(10) + prec_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') prec_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('clim_rad')
+         q1 = (rad_mon(1) + rad_mon(2) + rad_mon(3)) / 3.
+         q2 = (rad_mon(4) + rad_mon(5) + rad_mon(6)) / 3.
+         q3 = (rad_mon(7) + rad_mon(8) + rad_mon(9)) / 3.
+         q4 = (rad_mon(10) + rad_mon(11) + rad_mon(12)) / 3.
+         if (time .gt.1) then
+            h1 = (rad_dec + rad_mon(1) + rad_mon(2)) / 3.
+         else
+            h1 = (rad_mon(1) + rad_mon(2)) / 2.
+         endif
+         h2 = (rad_mon(3) + rad_mon(4) + rad_mon(5)) / 3.
+         h3 = (rad_mon(6) + rad_mon(7) + rad_mon(8)) / 3.
+         h4 = (rad_mon(9) + rad_mon(10) + rad_mon(11)) / 3.
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') rad_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('clim_hum')
+         q1 = (hum_mon(1) + hum_mon(2) + hum_mon(3)) / 3.
+         q2 = (hum_mon(4) + hum_mon(5) + hum_mon(6)) / 3.
+         q3 = (hum_mon(7) + hum_mon(8) + hum_mon(9)) / 3.
+         q4 = (hum_mon(10) + hum_mon(11) + hum_mon(12)) / 3.
+         if (time .gt.1) then
+            h1 = (hum_dec + hum_mon(1) + hum_mon(2)) / 3.
+         else
+            h1 = (hum_mon(1) + hum_mon(2)) / 2.
+         endif
+         h2 = (hum_mon(3) + hum_mon(4) + hum_mon(5)) / 3.
+         h3 = (hum_mon(6) + hum_mon(7) + hum_mon(8)) / 3.
+         h4 = (hum_mon(9) + hum_mon(10) + hum_mon(11)) / 3.
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') hum_mon, q1, q2, q3, q4, h1, h2, h3, h4
+         
+      CASE ('indi')
+         WRITE(unit_n,'(2I5)',advance='no') time_cur
+         WRITE(unit_n,'(F10.2, 2(F8.2, 5I8), F10.1, I10, F8.2, 4I8 )') fire_indb, fire(1)%mean, fire(1)%frequ, &
+                                    fire(2)%mean, fire(2)%frequ, fire_indi_max, fire_indi_day, fire(3)%mean, (fire(3)%frequ(j), j=1,4)
+
+      CASE ('litter')
+         if (totfol .gt. 1E-6) then
+            y_fol = totfol_lit*100. / totfol
+         else
+            y_fol = -99.
+         endif
+         if (totfrt .gt. 1E-6) then
+            y_frt = totfrt_lit*100. / totfrt
+         else
+            y_frt = -99.
+         endif
+         if (tottb .gt. 1E-6) then
+            y_tb = tottb_lit*100. / tottb
+         else
+            y_tb = -99.
+         endif
+         if (totcrt .gt. 1E-6) then
+            y_crt = totcrt_lit*100. / totcrt
+         else
+            y_crt = -99.
+         endif
+         hconv = totsap + tothrt
+         if (hconv .gt. 1E-6) then
+            y_stem= totstem_lit*100. / hconv
+         else
+            y_stem = -99.
+         endif
+         y_totlit = totfol_lit + totfrt_lit + totcrt_lit + tottb_lit + totstem_lit
+         y_C_lit = (C_lit + C_lit_stem) * gm2_in_kgha
+         y_N_lit = (N_lit + N_lit_stem) * gm2_in_kgha
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(8E12.4,2(6E12.4),5F12.2)') totfol_lit,totfol_lit_tree,totfrt_lit,totfrt_lit_tree,totcrt_lit,tottb_lit,totstem_lit, y_totlit, &
+                                            C_lit_fol*gm2_in_kgha, C_lit_frt*gm2_in_kgha, C_lit_crt*gm2_in_kgha, &
+                                            C_lit_tb*gm2_in_kgha, C_lit_stem*gm2_in_kgha, y_C_lit, & 
+                                            N_lit_fol*gm2_in_kgha, N_lit_frt*gm2_in_kgha, N_lit_crt*gm2_in_kgha, &
+                                            N_lit_tb*gm2_in_kgha, N_lit_stem*gm2_in_kgha, y_N_lit 
+
+      CASE ('fcap_av')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') field_cap(j) - wilt_p(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('fcapv_av')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') f_cap_v(j) - wilt_p_v(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('GPP_mon')
+
+         q1 = GPP_mon(1) + GPP_mon(2) + GPP_mon(3)
+         q2 = GPP_mon(4) + GPP_mon(5) + GPP_mon(6)
+         q3 = GPP_mon(7) + GPP_mon(8) + GPP_mon(9)
+         q4 = GPP_mon(10) + GPP_mon(11) + GPP_mon(12)
+         if (time .gt.1) then
+            h1 = GPP_dec + GPP_mon(1) + GPP_mon(2)
+         else
+            h1 = GPP_mon(1) + GPP_mon(2)
+         endif
+         h2 = GPP_mon(3) + GPP_mon(4) + GPP_mon(5)
+         h3 = GPP_mon(6) + GPP_mon(7) + GPP_mon(8)
+         h4 = GPP_mon(9) + GPP_mon(10) + GPP_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') GPP_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('humusv')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') humusv(j)*100.
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NEE_mon')
+         q1 = NEE_mon(1) + NEE_mon(2) + NEE_mon(3)
+         q2 = NEE_mon(4) + NEE_mon(5) + NEE_mon(6)
+         q3 = NEE_mon(7) + NEE_mon(8) + NEE_mon(9)
+         q4 = NEE_mon(10) + NEE_mon(11) + NEE_mon(12)
+         if (time .gt.1) then
+            h1 = NEE_dec + NEE_mon(1) + NEE_mon(2)
+         else
+            h1 = NEE_mon(1) + NEE_mon(2)
+         endif
+         h2 = NEE_mon(3) + NEE_mon(4) + NEE_mon(5)
+         h3 = NEE_mon(6) + NEE_mon(7) + NEE_mon(8)
+         h4 = NEE_mon(9) + NEE_mon(10) + NEE_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') NEE_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('NPP_mon')
+         q1 = NPP_mon(1) + NPP_mon(2) + NPP_mon(3)
+         q2 = NPP_mon(4) + NPP_mon(5) + NPP_mon(6)
+         q3 = NPP_mon(7) + NPP_mon(8) + NPP_mon(9)
+         q4 = NPP_mon(10) + NPP_mon(11) + NPP_mon(12)
+         if (time .gt.1) then
+            h1 = NPP_dec + NPP_mon(1) + NPP_mon(2)
+         else
+            h1 = NPP_mon(1) + NPP_mon(2)
+         endif
+         h2 = NPP_mon(3) + NPP_mon(4) + NPP_mon(5)
+         h3 = NPP_mon(6) + NPP_mon(7) + NPP_mon(8)
+         h4 = NPP_mon(9) + NPP_mon(10) + NPP_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') NPP_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('Nbc')
+         if (flag_bc .gt. 0) then
+             WRITE(unit_n,'(I6)',advance='no') time_cur
+             do j=1,nlay
+               WRITE(unit_n,'(F10.3)',advance='no') N_bc(j)
+             END DO   !j
+             WRITE(unit_n,'(A)') ''
+         endif
+
+     CASE ('Nhum')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') N_hum(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Nopm')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') N_opm(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('manrec')
+         if (flag_manreal.eq.1) then
+              WRITE(unit_n,'(I6)',advance='no') time_cur-1
+              WRITE(unit_n,'(10x,A30,I6)')  maninf, meas
+         end if
+
+      CASE ('mansort')
+
+         if ((flag_manreal.eq.1.or.flag_deadsort.eq.1).and.maninf.ne.'tending'.and.maninf.ne.'brushing') then
+              ztim=>st%first
+              do
+                 IF (.not.ASSOCIATED(ztim)) exit
+                 if(time.eq.ztim%tim%year.and. (ztim%tim%stype.eq.'ab'.or.ztim%tim%stype.eq.'tb')) then
+
+                    se_m3_ha = (ztim%tim%vol/kpatchsize)*10000.   ! m/patchsize ---> m3/ha
+                    se_c_ha =  se_m3_ha*spar(ztim%tim%specnr)%prhos*1000000.*cpart   ! m/patchsize ---> kg C/ha
+                    write(unit_n,'(3I6,1x,A5,1x,F8.3,1x,f7.3,1x,f7.3,1x,f7.3,1x,f7.3,1x,f9.4,1x,f14.3,1x,i8,x,a4)') ztim%tim%year,&
+                    ztim%tim%count,ztim%tim%specnr,ztim%tim%ttype,ztim%tim%length,ztim%tim%dia,ztim%tim%diaor, ztim%tim%zapfd,&
+                    ztim%tim%zapfdor,se_m3_ha, se_c_ha,int(ztim%tim%tnum), ztim%tim%stype
+                 end if
+                 ztim=>ztim%next
+              end do
+              flag_manreal=0
+              flag_deadsort=0
+         else if (maninf.eq.'tending'.or.maninf.eq.'brushing') then
+              flag_manreal=0
+              maninf='       '
+         end if
+
+      CASE ('root')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') root_fr(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+	  CASE ('fr_loss')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') fr_loss(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+	  CASE ('redis')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') redis(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+	  
+	  CASE ('sdrought')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20I8)') s_drought
+
+      CASE ('soil')
+         help = -99.0
+         Cbc_ap = 0.
+         if (time .gt. 0) help = rnet_cum / recs(time)
+         if (flag_bc .gt. 0) then    
+            ihelp = y_bc_n - 1
+            if (y_bc_n .eq. 1) ihelp = y_bc_n
+            if (y_bc(ihelp) .eq. time) then
+                Cbc_ap = Cbc_ap + C_bc_appl(ihelp)
+            endif
+         endif
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(13F10.3,5F10.2,17F10.3,4F10.2)') med_air, sum_prec, int_cum_can, &
+               perc_cum, wupt_cum, wupt_r_c, tra_tr_cum, tra_sv_cum, wupt_e_c, aet_cum, wat_tot, gp_can_mean, &
+               N_min, N_tot, C_tot, N_an_tot, N_hum_tot, C_hum_tot, N_hum(1), C_hum(1), &
+               N_lit, C_lit, C_opm_fol, C_opm_frt, C_opm_crt, C_opm_tb, C_opm_stem, Nupt_c, &
+               Nleach_c, Ndep_cum, resps_c, pet_cum, int_cum_sveg, thick(1), dew_cum, help, N_bc_tot, C_bc_tot, Cbc_ap
+
+      CASE ('spec')
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         do j=1,nspecies
+            zeig=>pt%first
+            do while (associated(zeig))
+               if(zeig%coh%species.eq.j)then
+                  WRITE(unit_n,'(2F10.2,I10,F10.2)',advance='no') svar(j)%med_diam, &
+                    svar(j)%dom_height, svar(j)%sum_ntreea, svar(j)%sum_bio
+                  exit
+               END IF
+               zeig=>zeig%next
+            END DO
+         END DO
+         WRITE(unit_n,*) ' '
+
+      CASE('standsort')
+          if (outy(i)%out_flag .eq. 1)  then
+             outy(i)%out_flag = 2
+          else if (outy(i)%out_flag .eq. 2) then
+            ztim=>st%first
+            do
+              IF (.not.ASSOCIATED(ztim)) exit
+               if(ztim%tim%year.eq.time.and. ztim%tim%stype.eq.'vb') then
+                    se_m3_ha = (ztim%tim%vol/kpatchsize)*10000.   ! m/patchsize ---> m3/ha
+                    se_c_ha =  se_m3_ha*spar(ztim%tim%specnr)%prhos*1000000.*cpart   ! m/patchsize ---> kg C/ha
+                    write(unit_n,'(3I6,1x,A5,1x,F8.3,1x,f7.3,1x,f7.3,1x,f7.3,1x,f7.3,1x,f9.4,1x,f14.3,1x,i8)') ztim%tim%year,&
+                    ztim%tim%count,ztim%tim%specnr,ztim%tim%ttype,ztim%tim%length,ztim%tim%dia,ztim%tim%diaor, ztim%tim%zapfd,&
+                    ztim%tim%zapfdor,se_m3_ha, se_c_ha,int(ztim%tim%tnum)
+               end if
+               ztim=>ztim%next
+            end do
+         end if
+
+      CASE ('TER_mon')
+         q1 = TER_mon(1) + TER_mon(2) + TER_mon(3)
+         q2 = TER_mon(4) + TER_mon(5) + TER_mon(6)
+         q3 = TER_mon(7) + TER_mon(8) + TER_mon(9)
+         q4 = TER_mon(10) + TER_mon(11) + TER_mon(12)
+         if (time .gt.1) then
+            h1 = TER_dec + TER_mon(1) + TER_mon(2)
+         else
+            h1 = TER_mon(1) + TER_mon(2)
+         endif
+         h2 = TER_mon(3) + TER_mon(4) + TER_mon(5)
+         h3 = TER_mon(6) + TER_mon(7) + TER_mon(8)
+         h4 = TER_mon(9) + TER_mon(10) + TER_mon(11)
+         WRITE(unit_n,'(I6)',advance='no') time_cur
+         WRITE(unit_n,'(20F10.2)') TER_mon, q1, q2, q3, q4, h1, h2, h3, h4
+
+      CASE ('veg')
+         if (outy(i)%out_flag .eq. 1) then
+
+            vout%help_veg1(1) = anz_spec
+            vout%help_veg1(2) = anz_coh_act
+            vout%help_veg1(3) = anz_tree_ha
+
+            do k = 1, nspec_tree
+			  y_lai = y_lai + svar(k)%sum_lai
+			end do
+            vout%help_veg2(1) = y_lai
+            vout%help_veg2(2) = sumbio
+            vout%help_veg2(3) = sumnpp
+            vout%help_veg2(4) = med_diam
+            vout%help_veg2(5) = hdom
+            vout%help_veg2(6) = totfol
+            vout%help_veg2(7) = totsap
+            vout%help_veg2(8) = totfrt
+            vout%help_veg2(9) = tothrt
+            vout%help_veg2(10) = totsteminc
+            vout%help_veg2(11) = totstem_m3
+            vout%help_veg3    = crown_area/kpatchsize
+            outy(i)%out_flag = 2
+         else if (outy(i)%out_flag .eq. 2) then
+            WRITE(unit_n,'(I6)',advance='no') time_cur
+            WRITE(unit_n,'(3I10)',advance='no') vout%help_veg1
+            WRITE(unit_n,'(F10.3,2E12.3,2F12.3,14E12.3, 5F12.3)') vout%help_veg2, sumvsab, sumvsdead, &
+                                        vout%help_veg3, drIndAl, Ndem, gp_can_mean, gp_can_min, gp_can_max, mean_diam, mean_height, basal_area, sumvsdead_m3, totsteminc_m3
+            outy(i)%out_flag = 1
+         endif
+
+      CASE ('veg_in')
+         WRITE(unit_n,'(2I5)',advance='no') time_cur
+         WRITE(unit_n,'(3I10)',advance='no') anz_spec_in, anz_coh_in, anz_tree_in
+         WRITE(unit_n,'(F10.3,E12.3,2F12.3,E12.3)') LAI_in, sumbio_in, med_diam_in, hmean_in, totfol_in
+
+      CASE ('veg_out')
+         WRITE(unit_n,'(2I5)',advance='no') time_cur
+         WRITE(unit_n,'(3I10)',advance='no') anz_spec_out, anz_coh_out, anz_tree_out
+         WRITE(unit_n,'(F10.3,E12.3,2F12.3,E12.3)') LAI_out, sumbio_out, med_diam_out, hmean_out, totfol_out
+
+      CASE ('veg_be')
+          ! beech - veg file
+            call outveg (1, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_bi')
+          ! birch - veg file
+            call outveg (5, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_pi')
+          ! pine - veg file
+            call outveg (3, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_pc')
+          ! pinus contorta - veg file
+            if (nspec_tree .gt. 5) call outveg (6, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_pp')
+          ! pinus ponderosa - veg file
+            if (nspec_tree .gt. 6) call outveg (7, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_pt')
+          ! populus tremula - veg file
+            if (nspec_tree .gt. 7) call outveg (8, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_oa')
+          ! oak - veg file
+            call outveg (4, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_sp')
+          ! spruce - veg file
+            call outveg (2, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_ph')
+          ! aleppo pine - veg file
+            if (nspec_tree .gt. 8) call outveg (9, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_dg')
+          ! douglas fir - veg file
+            if (nspec_tree .gt. 9) call outveg (10, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_rb')
+          ! robinia - veg file
+            if (nspec_tree .gt. 10) call outveg (11, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_egl')
+          ! Eucalyptus globulus - veg file
+            if (nspec_tree .gt. 11) call outveg (12, outy(i)%out_flag, unit_n)
+      
+      CASE ('veg_egr')
+          ! Ecalyptus grandis - veg file
+            if (nspec_tree .gt. 12) call outveg (13, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_sveg')
+          ! ground vegetation - veg file
+            if (flag_sveg .gt. 0) call outveg (14, outy(i)%out_flag, unit_n)
+
+      CASE ('veg_mist')
+          ! Mistletoe (Viscum a.) - veg file
+            if (flag_dis .gt. 0) call outveg (15, outy(i)%out_flag, unit_n)
+
+      END SELECT
+   END IF
+END DO   !i
+
+if(flag_cohout==1 .or. flag_cohout==2) call coh_out_y (flagout)
+if (flagout .eq. 2) deallocate (sout)
+
+END subroutine outyear
+
+!**************************************************************
+
+SUBROUTINE outday (flagout)
+!daily output
+
+  USE data_biodiv
+  USE data_climate
+  USE data_depo
+  USE data_inter
+  USE data_evapo
+  USE data_inter
+  USE data_simul
+  USE data_stand
+  USE data_species
+  USE data_soil
+  USE data_soil_cn
+  USE data_soil_t
+  USE data_out
+
+  IMPLICIT NONE
+
+  integer flagout    ! control of output
+                     ! 1 - output with
+                     ! 2 - output
+  INTEGER i,j,jj,k
+  integer tt, month
+  INTEGER unit_n       ! output unit
+  REAL    xhelp, xhelp1
+
+! output of all selected files
+do i = 1,outd_n
+   if (outd(i)%out_flag .eq. flagout) then
+      unit_n = outd(i)%unit_nr
+
+      select CASE (outd(i)%kind_name)
+
+      CASE ('Cday')
+        j=iday
+                   WRITE(unit_n,'(2I6)',advance='no') j,time_cur
+                   WRITE(unit_n,'(13E12.4, F7.1)') phot_C, dailygrass_C, dailynetass_C, dailypotNPP_C, dailyNPP_C, NPP_day, GPP_day, Cout%NEE(j), &
+                                                   TER_day, dailyautresp_C, Cout%Resp_aut(j), respsoil, dailyrespfol_C, 100.*totFPARsum
+
+      CASE ('Chumd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') C_hum(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Copmd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') C_opm(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Copmfractd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do k=1,anrspec
+           j = nrspec(k)
+           xhelp = SUM(slit(j)%C_opm_frt)
+           xhelp1 = SUM(slit(j)%C_opm_crt)
+           WRITE(unit_n,'(I8,5F10.3)',advance='no') j, slit(j)%C_opm_fol, slit(j)%C_opm_tb, &
+                          xhelp, xhelp1, slit(j)%C_opm_stem
+         END DO   ! j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Cbcd')
+         if (flag_bc .gt. 0) then
+             WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+             do j=1,nlay
+               WRITE(unit_n,'(F10.3)',advance='no') C_bc(j)
+             END DO   !j
+             WRITE(unit_n,'(A)') ''
+         endif
+
+      CASE ('day')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         xhelp = (NO_dep + NH_dep)*1000.        ! g/m ==> mg/m
+         if (N_min > 100) then
+         continue
+         endif
+         WRITE(unit_n,'(21F10.3, F10.1, 3I7, I8, F8.3, 4F10.2, 4F10.3)',advance='no') airtemp,rad,prec,interc_can,snow,pet,aet, &
+               trans_dem,trans_tree,trans_sveg,gp_can,respsoil,Nleach,Nupt_d,N_min,N_an_tot,  &
+               xhelp,cover,LAI, Irelpool(0), totFPARcan, fire_indi, fire(2)%index, fire(1)%index, fire(3)%index, snow_day, &
+               drIndd, bucks_root, bucks_100, prec-pet, dptemp, dew_rime, Rnet_tot, rad_max
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('day_short')
+         call tzinda(tt,month,time_cur,iday)
+         WRITE(unit_n,'(2(I2,1X), I4, 2X)',advance='no') tt,month,time_cur
+         WRITE(unit_n,'(I8, F10.2)',advance='no') fire(2)%index, prec-pet
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NH4')
+         WRITE(unit_n,'(I6,I5,1X)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(E10.3)',advance='no') NH4(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NH4c')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+          ! convert gN/m2 into mgN/l
+		   xhelp = pNH4f * NH4(j) * 1000. / wats(j)
+           WRITE(unit_n,'(F10.4)',advance='no') xhelp
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NO3')
+         WRITE(unit_n,'(I6,I5,1X)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(E10.3)',advance='no') NO3(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NO3c')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+          ! convert gN/m2 into mgN/l
+		   xhelp = pNO3f * NO3(j) * 1000. / wats(j)
+           WRITE(unit_n,'(F10.4)',advance='no') xhelp
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Nhumd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') N_hum(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Nopmd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') N_opm(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('NOPMfract')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do k=1,anrspec
+           j = nrspec(k)
+           WRITE(unit_n,'(5F10.3)',advance='no') slit(j)%N_opm_fol, slit(j)%N_opm_tb, &
+                          slit(j)%N_opm_frt(1),  slit(j)%N_opm_crt(1),  slit(j)%N_opm_stem
+         END DO   ! j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Nuptd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(E10.2)',advance='no') Nupt(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('Nmind')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(E10.2)',advance='no') Nmin(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('perc')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') perc(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('specd')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         k = 0
+  do jj=1,anrspec
+       j = nrspec(jj)
+               if (k .gt. 0) WRITE(unit_n,'(A12)',advance='no') ''
+               WRITE(unit_n,'(A16,I8)',advance='no') spar(j)%species_short_name, j
+               WRITE(unit_n,'(4E12.3, F10.3)',advance='no') svar(j)%Ndem, svar(j)%Nupt, svar(j)%Ndemp, svar(j)%Nuptp, svar(j)%RedN
+               WRITE(unit_n,'(A)') ''
+               k = k+1
+         END DO   !j 
+
+      CASE ('temp')
+         WRITE(unit_n,'(2I6,F10.3)',advance='no') iday,time_cur, temps_surf
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') temps(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+	  
+	  CASE ('water')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') wats(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('watvol')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') watvol(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      CASE ('wat_res')
+             WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+             do j=1,nlay
+               WRITE(unit_n,'(F10.4)',advance='no') wat_res(j)
+             END DO   !j
+             WRITE(unit_n,'(A)') ''
+
+      CASE ('wupt')
+         WRITE(unit_n,'(2I6)',advance='no') iday,time_cur
+         do j=1,nlay
+           WRITE(unit_n,'(F10.3)',advance='no') wupt_r(j)
+         END DO   !j
+         WRITE(unit_n,'(A)') ''
+
+      end select
+  END IF
+END DO   !i
+
+if(flag_cohout .gt. 0) call coh_out_d (flagout)
+END subroutine outday
+
+!**************************************************************
+
+SUBROUTINE coh_out_d (flagout)
+! daily cohort output
+
+USE data_simul
+USE data_stand
+USE data_out
+USE data_par
+
+IMPLICIT NONE
+
+integer flagout    ! control of output
+                   ! 1 - output with
+                   ! 2 - output
+INTEGER i,j
+INTEGER unit_n       ! output unit
+logical lflag
+real help
+
+  ! output of all selected files
+  do i = 1,outcd_n
+     if (outcd(i)%out_flag .eq. flagout) then
+        unit_n = outcd(i)%unit_nr
+        WRITE(unit_n ,'(2I5)',advance='no') iday,time_cur
+
+        do j= 1,max_coh
+           zeig => pt%first
+           lflag = .FALSE.
+
+           do while (associated(zeig))
+              if (zeig%coh%ident .eq. j) then
+
+                 select CASE (outcd(i)%kind_name)
+                 CASE ('ass')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%assi
+
+                 CASE ('aevi')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%aev_i
+
+                  CASE ('ddi')
+                    WRITE(unit_n,'(F12.3)',advance='no') zeig%coh%drindd
+
+                 CASE ('dem')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%demand
+
+                 CASE ('dips')
+                    WRITE(unit_n,'(F12.3)',advance='no') zeig%coh%drindps
+
+                 CASE ('gp')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%gp
+
+                 CASE ('gsdps')
+                    WRITE(unit_n,'(F12.0)',advance='no') zeig%coh%ndaysps
+
+                 CASE ('intcap')
+                    help = SUM(zeig%coh%intcap)
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('interc')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%interc_st
+
+                 CASE ('Ndemc_d')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%Ndemc_d
+
+                 CASE ('Nuptc_d')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%Nuptc_d
+
+                 CASE ('N_fol')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%N_fol
+
+                 CASE ('N_pool')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%N_pool
+
+                 CASE ('RedNc')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%RedNc
+
+                 CASE ('resp')
+                    help = zeig%coh%resp * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('respaut')
+!                    help = zeig%coh%respaut * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                     help = zeig%coh%maintres * kg_in_g * cpart 
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('respbr')
+                    help = zeig%coh%respbr * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('respfol')
+                    help = zeig%coh%respfol * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('resphet')
+                    help = zeig%coh%resphet * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('respsap')
+                    help = zeig%coh%respsap * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('respfrt')
+                    help = zeig%coh%respfrt * kg_in_g * cpart   ! kg DW per tree ==> g C per tree
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('sup')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%supply
+
+                 CASE ('totfpar')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%totfpar
+
+                 end select
+                 lflag = .TRUE.
+                 exit
+              ELSE
+                 zeig => zeig%next
+              END IF
+
+           END DO
+
+           if (.not. lflag) WRITE(unit_n,'(F12.3)',advance='no') -99.9
+
+        END DO  !j
+
+        WRITE(unit_n,'(A)') ''
+
+     END IF  ! out_flag
+  END DO  !i
+END subroutine coh_out_d
+
+!**************************************************************
+
+SUBROUTINE coh_out_y (flagout)
+
+!yearly cohort output
+use data_simul
+use data_soil
+use data_stand
+use data_out
+use data_par
+
+implicit none
+
+integer flagout    ! control of cohort output
+                   ! 1 - output with outyear,
+                   ! 2 - output after management and mortality
+integer i,j,k
+integer unit_n       ! output unit
+logical lflag
+real help
+
+  ! output of all selected files
+  do i = 1,outcy_n
+     if (outcy(i)%out_flag .eq. flagout) then
+        unit_n = outcy(i)%unit_nr
+        WRITE(unit_n ,'(I5)',advance='no') time_cur
+
+        do j= 1,max_coh
+           zeig => pt%first
+           lflag = .FALSE.
+
+           do while (associated(zeig))
+              if (zeig%coh%ident .eq. j) then
+
+                 select CASE (outcy(i)%kind_name)
+                 CASE ('age')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%x_age
+
+                 CASE ('ahb')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_ahb
+
+                 CASE ('ahbasrel')
+                    if (zeig%coh%Asapw .gt. zero) then
+                        help = zeig%coh%x_ahb / zeig%coh%Asapw
+                    else
+                        help = 0.
+                    endif
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('ahc')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%ahc
+
+                 CASE ('ahcasrel')
+                    if (zeig%coh%Asapw .gt. zero) then
+                        help = zeig%coh%ahc / zeig%coh%Asapw
+                    else
+                        help = 0.
+                    endif
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('asapw')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%Asapw
+
+                 CASE ('atr')
+                    WRITE(unit_n,'(I12)',advance='no') int(zeig%coh%ntreea)
+
+                 CASE ('bioi')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%bio_inc
+
+                 CASE ('botlayer')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%botLayer
+
+                 CASE ('cpa')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%crown_area*int(zeig%coh%ntreea)
+
+                 CASE ('crt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_crt
+
+                 CASE ('daybb')
+                    WRITE(unit_n,'(I12)',advance='no') int(zeig%coh%day_bb)
+
+                 CASE ('dcrb')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%dcrb
+
+                 CASE ('diac')
+                    if( zeig%coh%ndaysgr.ne.0) then
+                        WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%drindal/zeig%coh%ndaysgr
+                    else
+                        WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%drindal
+                    end if
+
+                 CASE ('diam')
+                    WRITE(unit_n,'(f12.5)',advance='no') zeig%coh%diam
+          
+
+                 CASE ('dtr')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%ntreed
+
+                  CASE ('dwd')
+                       help =    zeig%coh%ntreed*(zeig%coh%x_sap + zeig%coh%x_hrt)
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('fol')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_fol
+
+                 CASE ('foli')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%fol_inc
+
+                 CASE ('frt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_frt
+				 
+				 CASE ('frti')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%frt_inc
+
+                 CASE ('frtrel')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%frtrel(1)
+
+                 CASE ('geff')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%geff
+
+                 CASE ('gfol')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%gfol
+
+                 CASE ('gfrt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%gfrt
+
+                 CASE ('grossass')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%grossass
+
+                 CASE ('gsap')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%gsap
+
+                 CASE ('gsd')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%ndaysgr
+
+                 CASE ('hbo')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_hbole
+
+                 CASE ('hea')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%x_health
+
+                 CASE ('hei')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%height
+
+                 CASE ('hrt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_hrt
+
+                 CASE ('leaf')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%t_leaf
+
+                 CASE ('maintres')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%maintres
+
+                 CASE ('nas')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%netass
+
+                 CASE ('npp')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%npp
+
+                 CASE ('Ndemc_c')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%Ndemc_c
+
+                 CASE ('Nuptc_c')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%Nuptc_c
+
+                 CASE ('Nfol')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%N_fol
+
+                 CASE ('Npool')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%N_pool
+
+                 CASE ('Nstr')
+                    if(zeig%coh%Ndemc_c.ne.0) then
+                        help = zeig%coh%Nuptc_c / zeig%coh%Ndemc_c
+                    else
+                        help = zeig%coh%Nuptc_c
+!                        help = 1
+                    end if
+                    WRITE(unit_n,'(E12.3)',advance='no') help
+
+                 CASE ('rdpt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_rdpt
+
+                 CASE ('rooteff')
+                    WRITE(unit_n,'(F12.4)',advance='no') zeig%coh%rooteff(1)
+				 
+				 CASE ('sap')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%x_sap
+
+                 CASE ('sfol')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%sfol
+
+                 CASE ('sfrt')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%sfrt
+
+                 CASE ('spn')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%species
+
+                 CASE ('ssap')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%ssap
+
+                 CASE ('stem')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%stem_inc
+
+                 CASE ('str')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%x_stress
+
+                 CASE ('tdb')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%dbio
+
+                 CASE ('trman')
+                    WRITE(unit_n,'(I12)',advance='no') int(zeig%coh%ntreem)
+
+                 CASE ('toplayer')
+                    WRITE(unit_n,'(I12)',advance='no') zeig%coh%topLayer
+
+                 CASE ('ttb')
+                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%totbio
+
+                 CASE ('watleft')
+                    WRITE(unit_n,'(F12.4)',advance='no') zeig%coh%watleft
+                    
+                 CASE ('yrw')
+                    WRITE(unit_n,'(F12.4)',advance='no') zeig%coh%jrb
+
+                 end select
+
+                 lflag = .TRUE.
+                 exit
+
+              ELSE
+                 zeig => zeig%next
+              END IF
+
+           END DO
+
+           if (.not. lflag) WRITE(unit_n,'(F12.3)',advance='no') -99.9
+
+        END DO  !j
+
+        WRITE(unit_n,'(A)') ''
+
+                 select CASE (outcy(i)%kind_name)
+                  CASE ('frtrel')
+                    do k=2,nroot_max
+                       WRITE(unit_n ,'(I2,3X)',advance='no') k
+                       do j= 1,max_coh
+                          zeig => pt%first
+                          lflag = .FALSE.
+                          do while (associated(zeig))
+                             if (zeig%coh%ident .eq. j) then
+                                WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%frtrel(k)
+                                lflag = .TRUE.
+                                exit
+                             ELSE
+                                zeig => zeig%next
+                             END IF
+                          END DO  ! zeig
+                          if (.not. lflag) WRITE(unit_n,'(F12.3)',advance='no') -99.9
+                        END DO  ! j
+                        WRITE(unit_n,'(A)') ''
+                    END DO   ! k
+                    WRITE(unit_n,'(A)') ''
+
+                  CASE ('frtrelc')
+                    do k=2,nroot_max
+                       WRITE(unit_n ,'(I2,3X)',advance='no') k
+                       do j= 1,max_coh
+                          zeig => pt%first
+                          lflag = .FALSE.
+                          do while (associated(zeig))
+                             if (zeig%coh%ident .eq. j) then
+                                WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%frtrelc(k)
+                                lflag = .TRUE.
+                                exit
+                             ELSE
+                                zeig => zeig%next
+                             END IF
+                          END DO  ! zeig
+                          if (.not. lflag) WRITE(unit_n,'(F12.3)',advance='no') -99.9
+                        END DO  ! j
+                        WRITE(unit_n,'(A)') ''
+                    END DO   ! k
+                    WRITE(unit_n,'(A)') ''
+
+					CASE ('rld')
+                    if (flag_wred .eq. 9) then
+                        do k=2,nroot_max
+                           WRITE(unit_n ,'(I2,3X)',advance='no') k
+                           do j= 1,max_coh
+                              zeig => pt%first
+                              lflag = .FALSE.
+                              do while (associated(zeig))
+                                 if (zeig%coh%ident .eq. j) then
+                                    WRITE(unit_n,'(E12.3)',advance='no') zeig%coh%rld(k)
+                                    lflag = .TRUE.
+                                    exit
+                                 ELSE
+                                    zeig => zeig%next
+                                 END IF
+                              END DO  ! zeig
+                              if (.not. lflag) WRITE(unit_n,'(F12.3)',advance='no') -99.9
+                            END DO  ! j
+                            WRITE(unit_n,'(A)') ''
+                        END DO   ! k
+                    endif
+                    WRITE(unit_n,'(A)') ''
+                 end select
+
+     endif  ! out_flag
+  enddo  !i
+END subroutine coh_out_y
+
+!**************************************************************
+
+SUBROUTINE out_wpm (flagout)
+
+use data_out
+use data_simul
+use data_wpm
+
+implicit none
+
+  integer flagout    ! control of output
+                     ! 0 - no output
+                     ! 1 - output at end of simulation
+  integer i,j,k
+  integer unit_n     ! output unit
+
+	integer dummy
+    dummy = 0.
+
+! output of all selected files
+do j = 1,oute_n
+   if (oute(j)%out_flag .eq. flagout) then
+   unit_n = oute(j)%unit_nr
+
+      select CASE (oute(j)%kind_name)
+
+	  CASE ('sea')
+	    	do i=1,size(years)
+		    write(unit_n,	'(I6, 30F10.2)') &
+						years(i),			&
+						sum_costs(1,i),		&
+						sum_costs(2,i),		&
+						sum_costs(3,i),		&
+						sum_costs(4,i),		&
+						fix(2)-fix(1),		&
+						sum_costs(5,i),		&
+						st_costs(1,i),		&
+						st_costs(2,i),		&
+						st_costs(3,i),		&
+						st_costs(4,i),		&
+						st_costs(5,i),		&
+						st_assets(1,i),		&
+						st_assets(2,i),		&
+						st_assets(3,i),		&
+						st_assets(4,i),		&
+						st_assets(5,i),		&
+						ms_costs(1,i),		&
+						ms_costs(2,i),		&
+						ms_costs(3,i),		&
+						ms_costs(4,i),		&
+						ms_costs(5,i),		&
+						ms_assets(1,i),		&
+						ms_assets(2,i),		&
+						ms_assets(3,i),		&
+						ms_assets(4,i),		&
+						ms_assets(5,i),		&
+						fix(1),				&
+						subsidy(1,i),		&
+						subsidy(1,i),		&
+						fix(2)										
+			end do
+	  case ('sea_npv')
+	  	do i=1,size(years)
+		  write(unit_n,	'(I6, 12F10.2)') &
+						years(i),		&
+						npv(1,i),		&
+						npv(2,i),		&
+						npv(3,i),		&
+						npv(4,i),		&
+						npv(5,i),		&
+						npv(6,i),		&
+						npv(7,i),		&
+						npv(8,i),		&
+						npv(9,i),		&
+						npv(10,i),		&
+						npv(11,i),		&
+						npv(12,i)
+		end do
+      CASE ('sea_ms')
+		    	do i=1,size(years)
+		    write(unit_n,	'(I6,43E10.3)')	&
+						years(i),			&
+						mansort_tg(1,1,i),	&
+						mansort_tg(1,2,i),	&
+						mansort_tg(1,3,i),	&
+						mansort_tg(1,6,i),	&
+						mansort_tg(1,7,i),	&
+						mansort_tg(1,8,i),	&
+						mansort_tg(1,9,i),	&
+						mansort_tg(1,10,i), &
+						mansort_tg(2,1,i),	&
+						mansort_tg(2,2,i),	&
+						mansort_tg(2,4,i),	&
+						mansort_tg(2,5,i),	&
+						mansort_tg(2,6,i),	&
+						mansort_tg(2,7,i),	&
+						mansort_tg(2,8,i),	&
+						mansort_tg(2,9,i),	&
+						mansort_tg(2,10,i), &
+						mansort_tg(3,1,i),	&
+						mansort_tg(3,2,i),	&
+						mansort_tg(3,3,i),	&
+						mansort_tg(3,4,i),	&
+						mansort_tg(3,5,i),	&
+						mansort_tg(3,6,i),	&
+						mansort_tg(3,7,i),	&
+						mansort_tg(3,8,i),	&
+						mansort_tg(3,9,i),	&
+						mansort_tg(3,10,i), &
+						mansort_tg(4,1,i),	&
+						mansort_tg(4,2,i),	&
+						mansort_tg(4,5,i),	&
+						mansort_tg(4,6,i),	&
+						mansort_tg(4,7,i),	&
+						mansort_tg(4,8,i),	&
+						mansort_tg(4,9,i),	&
+						mansort_tg(4,10,i), &
+						mansort_tg(5,1,i),	&
+						mansort_tg(5,2,i),	&
+						mansort_tg(5,5,i),	&
+						mansort_tg(5,6,i),	&
+						mansort_tg(5,7,i),	&
+						mansort_tg(5,8,i),	&
+						mansort_tg(5,9,i),	&
+						mansort_tg(5,10,i)
+			end do
+
+      CASE ('sea_st')
+		    	do i=1,size(years)
+		    write(unit_n,	'(I6,43E10.3)')	&
+						years(i),			&
+						standsort_tg(1,1,i),	&
+						standsort_tg(1,2,i),	&
+						standsort_tg(1,5,i),	&
+						standsort_tg(1,6,i),	&
+						standsort_tg(1,7,i),	&
+						standsort_tg(1,8,i),	&
+						standsort_tg(1,9,i),	&
+						standsort_tg(1,10,i),	&
+						standsort_tg(2,1,i),	&
+						standsort_tg(2,2,i),	&
+						standsort_tg(2,4,i),	&
+						standsort_tg(2,5,i),	&
+						standsort_tg(2,6,i),	&
+						standsort_tg(2,7,i),	&
+						standsort_tg(2,8,i),	&
+						standsort_tg(2,9,i),	&
+						standsort_tg(2,10,i),	&
+						standsort_tg(3,1,i),	&
+						standsort_tg(3,2,i),	&
+						standsort_tg(3,3,i),	&
+						standsort_tg(3,4,i),	&
+						standsort_tg(3,5,i),	&
+						standsort_tg(3,6,i),	&
+						standsort_tg(3,7,i),	&
+						standsort_tg(3,8,i),	&
+						standsort_tg(3,9,i),	&
+						standsort_tg(3,10,i),	&
+						standsort_tg(4,1,i),	&
+						standsort_tg(4,2,i),	&
+						standsort_tg(4,5,i),	&
+						standsort_tg(4,6,i),	&
+						standsort_tg(4,7,i),	&
+						standsort_tg(4,8,i),	&
+						standsort_tg(4,9,i),	&
+						standsort_tg(4,10,i),   &
+						standsort_tg(5,1,i),	&
+						standsort_tg(5,2,i),	&
+						standsort_tg(5,5,i),	&
+						standsort_tg(5,6,i),	&
+						standsort_tg(5,7,i),	&
+						standsort_tg(5,8,i),	&
+						standsort_tg(5,9,i),	&
+						standsort_tg(5,10,i)
+	    end do
+
+      CASE ('wpm')
+    	do i=1,size(years)
+		    write(unit_n,	'(I6,13E10.3, 1E11.3, 3E10.3)')	&
+						years(i),					&
+						sum_input(i),				&
+						use_categories(1)%value(i),	&
+						use_categories(2)%value(i),	&
+						use_categories(3)%value(i),	&
+						use_categories(4)%value(i),	&
+						use_categories(5)%value(i),	&
+						use_categories(6)%value(i),	&
+						use_categories(7)%value(i),	&
+						sum_use_cat(i),				&
+						burning(i),					&
+						landfill(i),				&
+						atmo_year(i),				&
+						atmo_cum(i),                    &
+						emission_har(i),		&
+						sub_energy(i),			&
+						sub_material(i),		&
+						sub_sum(i)
+	    end do
+
+      CASE ('wpm_inter')
+    	do i=1,size(years)
+		    write(unit_n,	'(I6,27E10.3)')	&
+						years(i),		&
+						pl(1,1,i),		&
+						pl(1,2,i),		&
+						pl(1,3,i),		&
+						pl(1,4,i),		&								
+						pl(1,5,i),		&							
+						pl(1,7,i),		&							
+						pl(2,1,i),		&
+						pl(2,2,i),		&
+						pl(2,3,i),		&
+						pl(2,4,i),		&							
+						pl(2,5,i),		&							
+						pl(2,6,i),		&							
+						pl(2,7,i),		&
+						pl(3,1,i),		&							
+						pl(3,2,i),		&
+						pl(3,3,i),		&
+						pl(3,4,i),		&								
+						pl(3,5,i),		&								
+						pl(3,6,i),		&							
+						pl(3,7,i),		&														
+						use_cat(1,i),	&
+						use_cat(2,i),	&
+						use_cat(3,i),	&
+						use_cat(4,i),	&
+						use_cat(5,i),	&
+						use_cat(6,i),	&
+						use_cat(7,i)
+	    end do
+
+      end select
+   endif
+enddo
+
+end subroutine out_wpm
+
+!**************************************************************
+
+SUBROUTINE out_scen
+USE data_simul
+USE data_out
+IMPLICIT NONE
+
+WRITE (unit_ctr,*) ip,'         ',deltaT,deltaPrec
+
+END subroutine out_scen
+
+!**************************************************************
+
+SUBROUTINE out_comp(unit_comp)
+
+! final result output for each run
+
+USE data_biodiv
+USE data_climate
+USE data_depo
+USE data_evapo
+USE data_inter
+USE data_manag
+USE data_out
+USE data_par
+USE data_simul
+USE data_site
+USE data_soil
+USE data_soil_cn
+USE data_species
+USE data_stand
+USE data_climate
+USE data_frost
+
+IMPLICIT NONE
+
+integer unit_comp
+integer help1, i
+real, dimension(31) ::  help2
+real    hconv        ! conversion factor from patchsize into ha
+! output variables of final results in kg/ha
+real   y_NPP,   &    ! mean net primary productioin
+       y_GPP,   &    ! mean yearly gross productioin
+       y_NEP,   &    ! mean yearly net ecosystem productioin
+       y_sumbio,  &  ! total biomass of all cohorts and all tree-species
+       y_sumbio_sv,& ! total biomass of all cohorts and all ground-vegetation-species
+       y_autresp, &  ! mean yearly total autotroph resp
+       y_resps, &    ! mean yearly soil respiration
+       y_resptot, &  ! mean yearly total respiration
+       y_C_accu,  &  ! mean yearly C accumualtion
+       y_RedN,    &  ! mean RedN of all species
+       y_lai         ! LAI of stand without soil vegetation
+real   C_sum         ! total C storage of the stand (biomass and soil)
+real   help_gdd
+character(20) idtext, datei
+character(150) htext
+character(1) aa
+
+call wclas(waldtyp)
+hconv        = 10000./kpatchsize
+y_NPP        = cum_sumNPP * hconv * cpart/year   ! kg DW/patch --> kg C/ha
+y_sumbio     = sumbio / 1000.                    ! kg DW / ha --> t DW/ha
+y_sumbio_sv  = sumbio_sv / 1000.                 ! kg DW / ha --> t DW/ha
+totfol       = totfol / 1000.                    ! kg / ha --> t/ha
+totsap       = totsap / 1000.                    ! kg / ha --> t/ha
+totfrt       = totfrt / 1000.                    ! kg / ha --> t/ha
+tothrt       = tothrt / 1000.                    ! kg / ha --> t/ha
+totcrt       = totcrt / 1000.                    ! kg / ha --> t/ha
+tottb        = tottb / 1000.                     ! kg / ha --> t/ha
+y_C_accu     = (C_tot - C_accu) * gm2_in_kgha / year  ! g C/m2 --> kg C/ha, mean
+C_lit_m      = C_lit_m * gm2_in_kgha / year      ! g/m2 --> kg/ha, mean
+N_lit_m      = N_lit_m * gm2_in_kgha / year      ! g/m2 --> kg/ha, mean
+N_min_m      = N_min_m * gm2_in_kgha / year      ! g/m2 --> kg/ha, mean
+Nupt_m       = Nupt_m * gm2_in_kgha / year       ! g/m2 --> kg/ha, mean
+Nleach_m     = Nleach_m * gm2_in_kgha / year     ! g/m2 --> kg/ha, mean
+y_resps      = resps_c_m * gm2_in_kgha / year    ! g C/m2 --> kg C/ha, mean
+y_autresp    = autresp_m * cpart * hconv / year
+y_resptot    = y_resps + y_autresp
+y_GPP        = y_NPP + y_autresp
+y_NEP        = y_NPP - y_resps                   ! kg C/ha
+y_NPP        = y_NPP / 1000.                     ! kg C /ha --> t C/ha
+dew_m        = dew_m / year
+AET_m        = AET_m / year
+pet_m        = pet_m / year
+interc_m_can = interc_m_can / year
+perc_m       = perc_m / year
+wupt_r_m     = wupt_r_m / year
+C_opm_stem   = C_opm_stem * gm2_in_kgha / 1000.  ! g C/m2 --> t C/ha
+if (.not.lcomp1) C_tot = SUM(C_opm) + SUM(C_hum) ! calculated again (litter at the end)
+C_tot        = C_tot * gm2_in_kgha / 1000.       ! g C/m2 --> t C/ha
+C_hum_tot    = C_hum_tot * gm2_in_kgha / 1000.   ! g C/m2 --> t C/ha
+med_air_all  = med_air_all / year
+
+med_rad_all  = med_rad_all / year
+mean_drIndAl = mean_drIndAl / year
+help_gdd    = gdday_all / year
+sum_prec_all = sum_prec_all / year
+Ndep_cum_all = Ndep_cum_all * gm2_in_kgha / year   ! g/m2 --> kg/ha, mean
+C_sum        = C_tot + (sumbio + cumsumvsab + cumsumvsdead) * cpart / 1000.    ! corrected due to C_opm_stem already in cumsumvsdead
+if(fire_indb_m.gt.0) then
+   fire_indb_m  = fire_indb_m / year       ! fire index Bruschek
+end if
+fire(2)%mean_m = fire(2)%mean_m / year     ! fire index east (Kaese M68)
+fire(3)%mean_m = fire(3)%mean_m / year 
+cwb_an_m     = cwb_an_m / year
+
+ind_arid_an_m = ind_arid_an_m / year
+ind_lang_an_m = ind_lang_an_m / year
+ind_cout_an_m = ind_cout_an_m / year
+ind_wiss_an_m = ind_wiss_an_m / year
+ind_mart_an_m = ind_mart_an_m / year
+ind_weck_m = ind_weck_m / year
+ind_reich_m = ind_reich_m / year
+ind_emb_m = ind_emb_m / year
+con_gor_m = con_gor_m / year
+con_cur_m = con_cur_m / year
+con_con_m = con_con_m / year
+
+ind_bud_m = ind_bud_m / year
+ind_shc_m = ind_shc_m / year
+
+if(time.gt.1) call frost_index_total
+
+ntindex =0.
+if(time.gt.1) then
+    tempmean_mo = tempmean_mo/year
+    call t_indices(tempmean_mo)
+end if
+
+y_lai  = 0.
+y_RedN = 0.
+do i = 1, nspec_tree
+  y_lai  = y_lai + svar(i)%sum_lai
+end do
+if (anz_RedN .gt. 0) y_RedN = RedN_mean / anz_RedN
+
+select case (flag_multi)
+
+case (4,5,8)
+   write (datei, '(A10)') adjustl(sitenum(ip))   ! standip can occur variable times, this ensures clear indetification
+   read (datei, '(A)') idtext
+
+case default
+   htext  = adjustr(site_name(ip))
+   idtext = adjustl(htext (131:150))   ! only write last 20 signs
+
+end select
+
+if(thin_dead .ne. 0) then
+    cumsumvsab = cumsumvsdead
+    cumsumvsdead = 0.
+end if
+
+if (time .le. 1) then
+   aa = 'B'
+else
+   aa = 'E'
+endif
+
+if(flag_end .eq.0) then
+        write (unit_comp, '(A, I5,1X, A20,F6.2,I7,I4,F9.2,E10.3, 8F9.2, F11.3, E11.3, 4E11.4, 3F8.2,4F10.2, F9.1, F9.3, 4F10.1, 7F7.1, 2F9.3, F9.1, 3F10.2, &
+                            7(1X,F9.2), E12.4, F8.2, 5F10.2, F8.2, 3F8.3,3X, 3f8.2)') &
+           aa, ip, idtext, y_lai, anz_tree_ha, waldtyp, y_sumbio, y_sumbio_sv, med_diam, hdom, totfol,tottb,totsap,tothrt,totfrt,totcrt, &
+           y_NPP, y_NEP, y_GPP, cumsteminc, cumsumvsab, cumsumvsdead, C_sum, C_opm_stem, C_tot, C_hum_tot,C_tot_40,C_hum_40, &
+           y_C_accu, C_lit_m, N_lit_m, N_min_m, Nleach_m, y_resps, y_resptot, pet_m, AET_m, perc_m, interc_m_can, wupt_r_m, med_air_all, &
+           sum_prec_all, Ndep_cum_all, mean_drIndAl, help_gdd, cwb_an_m, fire(2)%mean_m, fire_indb_m, ind_arid_an_m, ind_lang_an_m, ind_cout_an_m,  &
+		   ind_wiss_an_m, ind_mart_an_m, ind_weck_m, ind_reich_m, ind_emb_m, con_gor_m, con_cur_m, con_con_m, ntindex, fire(3)%mean_m, ind_bud_m, med_rad_all, y_RedN, dew_m, Nupt_m, mlfind, mlfind_sp, ind_shc_m
+else
+    help1 = 0
+    help2 = 0.0
+    write (unit_comp, '(A, I5,1X, A15,F6.2,I7,I4, 8F9.2, 6E11.4, 3F8.2, 3F10.2, F9.1, F9.3, 2F10.1, 6F7.1, F9.3)') &
+           aa, ip, idtext, help2(1), help1, help1, (help2(i), i=1,31)
+end if
+
+END subroutine out_comp
+
+!**************************************************************
+
+SUBROUTINE error_mess(ti,mess,val)
+
+USE data_out
+USE data_simul
+USE data_site
+
+IMPLICIT NONE
+
+INTEGER,intent(in) :: ti
+CHARACTER(LEN=*),intent(in) :: mess
+real,intent(in) :: val
+
+if (flag_multi .ne. 5) then
+   write (unit_err, *)
+   write (unit_err, '(A8,I5,1X, A20, A10,I5)') 'ip/site ', ip, stand_id, '     Year ',ti
+   write(unit_err,'(A)',advance='no') trim(mess)
+   write(unit_err,*) val
+endif
+
+END subroutine error_mess
+
+!**************************************************************
+
+SUBROUTINE stop_mess(ti,mess)
+
+USE data_out
+
+IMPLICIT NONE
+
+INTEGER,intent(in) :: ti
+CHARACTER(LEN=*),intent(in) :: mess
+
+WRITE(*,*) 'Program aborted in simulation year ',ti
+WRITE(*,*) trim(mess)
+WRITE(*,*) 'see error.log for reason'
+
+END subroutine stop_mess
+
+!**************************************************************
+
+SUBROUTINE open_file (varout, help_ip)
+
+! Open special output file
+
+USE data_simul
+USE data_out
+
+IMPLICIT NONE
+
+TYPE (out_struct)  :: varout
+INTEGER         help_ip
+
+CHARACTER(150) ::filename                ! complete name of output file
+
+filename = trim(site_name(help_ip))//'_'//trim(varout%kind_name)//'.out'//trim(anh)
+
+varout%unit_nr   = getunit()
+
+open(varout%unit_nr,file=trim(dirout)//filename,status='replace')
+
+END subroutine open_file
+
+!**************************************************************
+
+SUBROUTINE wr_header_file (varout)
+
+! Write header of special output file
+
+USE data_simul
+USE data_out
+
+IMPLICIT NONE
+
+TYPE (out_struct)  :: varout
+
+INTEGER         unit_n       ! output unit
+
+unit_n = varout%unit_nr
+WRITE(unit_n ,'(A)') trim(varout%f_line)
+WRITE(unit_n ,'(A)') trim(varout%s_line)
+WRITE(unit_n ,'(A)') trim(varout%header)
+
+END subroutine wr_header_file
+
+!**************************************************************
+
+SUBROUTINE outveg (nsp, out_flag, unit_n)
+
+! output of species values (files veg_species)
+
+  USE data_climate
+  USE data_simul
+  USE data_species
+  USE data_stand
+  USE data_out
+
+  IMPLICIT NONE
+
+  integer:: nsp        ! species number
+  integer:: out_flag   ! output flag
+  integer:: unit_n     ! output unit
+  real   :: dumvar=0.
+
+         if (out_flag .eq. 1) then
+
+            sout(nsp)%help_veg1(1) = nsp
+            sout(nsp)%help_veg1(2) = svar(nsp)%anz_coh
+            sout(nsp)%help_veg1(3) = svar(nsp)%sum_nTreeA
+
+            sout(nsp)%help_veg2(1) = svar(nsp)%sum_lai
+            sout(nsp)%help_veg2(2) = svar(nsp)%sum_bio
+            sout(nsp)%help_veg2(3) = svar(nsp)%sumNPP
+            sout(nsp)%help_veg2(4) = svar(nsp)%med_diam
+            sout(nsp)%help_veg2(5) = svar(nsp)%dom_height
+            sout(nsp)%help_veg2(6) = svar(nsp)%fol
+            sout(nsp)%help_veg2(7) = svar(nsp)%sap
+            sout(nsp)%help_veg2(8) = svar(nsp)%frt
+            sout(nsp)%help_veg2(9) = svar(nsp)%hrt
+            sout(nsp)%help_veg2(10)= svar(nsp)%totsteminc
+            sout(nsp)%help_veg2(11)= svar(nsp)%totstem_m3
+            sout(nsp)%help_veg3    = svar(nsp)%crown_area/kpatchsize
+			sout(nsp)%help_veg4    = svar(nsp)%sumvsdead*10000/kpatchsize
+			sout(nsp)%help_veg5    = svar(nsp)%sumvsdead_m3*10000/kpatchsize
+            sout(nsp)%help_veg6    = svar(nsp)%totsteminc_m3
+
+            out_flag = 2
+         else if (out_flag .eq. 2) then
+            WRITE(unit_n,'(I6)',advance='no') time_cur
+            WRITE(unit_n,'(3I10)',advance='no') sout(nsp)%help_veg1
+            WRITE(unit_n,'(F10.3,2E12.3,2F12.3,9E12.3, 4F12.3, I6, F6.0,3F12.3, 3F12.4)') sout(nsp)%help_veg2, svar(nsp)%sumvsab, sout(nsp)%help_veg4, &
+                                                         sout(nsp)%help_veg3, svar(nsp)%drIndAl, svar(nsp)%Ndem, svar(nsp)%Nupt, svar(nsp)%RedNm, &
+                                                         svar(nsp)%daybb, spar(nsp)%end_bb, svar(nsp)%mean_diam, svar(nsp)%mean_height, svar(nsp)%basal_area, sout(nsp)%help_veg5,sout(nsp)%help_veg6, svar(nsp)%mean_jrb
+            out_flag = 1
+         endif
+
+END SUBROUTINE outveg
+
+!**************************************************************
+
+SUBROUTINE outstore
+
+! store of output variables (multi run 4 and 8)
+USE data_climate
+USE data_depo
+USE data_evapo
+USE data_inter
+USE data_manag
+USE data_out
+USE data_par
+USE data_simul
+USE data_soil
+USE data_soil_cn
+USE data_stand
+USE data_biodiv
+USE data_frost
+
+IMPLICIT NONE
+
+real   C_sum, &      ! total C storage of the stand (biomass and soil)
+       hconv, help
+integer i, j, k, ipp
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' outstore '
+
+  if (flag_mult910) then
+    ipp = 1
+  else
+    ipp = ip
+  endif
+
+  hconv        = 10000./kpatchsize
+  do i = 1, nvar-1
+
+     select case (trim(outvar(i)))
+
+     case('above_biom')
+	     output_var(i,ipp,time)=(sumbio-totfrt-totcrt)/1000.	
+
+     case ('AET','aet')
+        output_var(i,ipp,time) = AET_cum
+
+     case ('AET_year','AETyear','aetyear','aet_year')  !  AET
+        outvar(i) = 'AET_year'
+        output_var(i,ipp,time) = AET_cum
+
+     case ('AET_mon','AETmon','aetmon','aet_mon')  ! monthly AET
+        outvar(i) = 'AET_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = AET_mon(j) 
+        enddo
+
+     case ('AET_week','AETweek','aetweek','aet_week')  ! weekly AET
+        outvar(i) = 'AET_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = AET_week(j) 
+        enddo
+ 
+     case ( 'anzdlf') ! number of days with forst  April - June
+         output_var(i,ipp,time) = anzdlf(time)
+     
+     case ( 'BA') ! basal area
+         output_var(i,ipp,time) = basal_area
+         
+
+     case ('C_accu','Caccu','c_accu')   ! C accumulation per year
+        if (time .eq. 1) then
+            help = C_tot - C_accu
+        else
+            help = C_tot - C_accu
+            do j = 1, time-1
+                help = help - output_var(i,ipp,j)*1000.*kgha_in_gm2
+            end do
+        endif
+        output_var(i,ipp,time) = help * gm2_in_kgha / 1000.  ! g C/m2 --> t C/ha
+ 
+     case ('C_d_stem','c_d_stem')
+        output_var(i,ipp,time) = C_opm_stem * gm2_in_kgha / 1000. 
+    
+     case ('chumtot','Chumtot','C_hum_tot')   ! total C in humus
+        output_var(i,ipp,time) = C_hum_tot * gm2_in_kgha / 1000.   ! g C/m2 --> t C/ha
+
+	 case('con_gor')
+     	     output_var(i,ipp,time)=con_gor
+			  
+	 case('con_cur')
+     	     output_var(i,ipp,time)=con_cur
+
+	 case('con_con')
+     	     output_var(i,ipp,time)=con_con
+
+     case ('ctot','Ctot','C_tot')   ! total soil C
+        output_var(i,ipp,time) = C_tot * gm2_in_kgha / 1000.       ! g C/m2 --> t C/ha
+
+     case ('csum','Csum','C_sum')   ! total C in ecosystem
+        output_var(i,ipp,time) = C_tot*gm2_in_kgha/1000. + (sumbio + cumsumvsab + cumsumvsdead) * cpart / 1000.   ! t/ha
+
+	 case('cwb')                    ! climatic water balance
+   	     output_var(i,ipp,time)=cwb_an
+
+     case ('cwbyear','cwb_year')  ! climatic water balance
+        outvar(i) = 'cwb_year'
+   	     output_var(i,ipp,time)=cwb_an
+
+     case ('cwbmon','cwb_mon')  ! monthly climatic water balance
+        outvar(i) = 'cwb_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = prec_mon(j) - pet_mon(j) 
+        enddo
+
+     case ('cwbweek','cwb_week')  ! weekly climatic water balance
+        outvar(i) = 'cwb_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = prec_week(j) - pet_week(j) 
+        enddo
+         
+     case ( 'date_lf') ! number of the day with the last late frost
+         output_var(i,ipp,time) = date_lf(time)
+               
+     case ( 'date_lft') ! number of the day with the last late frost
+         output_var(i,ipp,time) = date_lftot(time)
+
+     case('daybb_be')
+         output_var(i,ipp,time)= svar(1)%daybb
+
+     case('daybb_oa')
+         output_var(i,ipp,time)= svar(4)%daybb
+
+     case('daybb_bi')
+         output_var(i,ipp,time)= svar(5)%daybb
+
+      case ('dbh')
+        output_var(i,ipp,time) = mean_diam
+        
+    case ('dens')                 ! stem density
+       output_var(i,ipp,time) = anz_tree_ha
+
+     case ('dnlf')    ! number of frost days after start of vegetation period
+         output_var(i,ipp,time) = dnlf(time)
+         
+     case ('dnlf_sp') !  number of frost days after bud burst
+         output_var(i,ipp,time) = dnlf_sp(time)
+     
+     case ('drindal', 'drIndAl', 'drIndal', 'DrIndAl')   ! drought index for allocation calculation (cum.) for the whole stand [-], weighted by NPP
+        output_var(i,ipp,time) = drIndAl
+
+     case ('fire_indb')
+        output_var(i,ipp,time) = fire_indb
+
+     case ('fire_ind1')
+        output_var(i,ipp,time) = fire(1)%mean
+
+     case ('fire_ind2')
+        output_var(i,ipp,time) = fire(2)%mean
+
+     case ('fire_ind3')
+        output_var(i,ipp,time) = fire(3)%mean
+
+     case ('fire_ind1_c1')
+        output_var(i,ipp,time) = fire(1)%frequ(1)
+
+     case ('fire_ind1_c2')
+        output_var(i,ipp,time) = fire(1)%frequ(2)
+
+     case ('fire_ind1_c3')
+        output_var(i,ipp,time) = fire(1)%frequ(3)
+
+     case ('fire_ind1_c4')
+        output_var(i,ipp,time) = fire(1)%frequ(4)
+
+     case ('fire_ind1_c5')
+        output_var(i,ipp,time) = fire(1)%frequ(5)
+
+     case ('fire_ind2_c1')
+        output_var(i,ipp,time) = fire(2)%frequ(1)
+
+     case ('fire_ind2_c2')
+        output_var(i,ipp,time) = fire(2)%frequ(2)
+
+     case ('fire_ind2_c3')
+        output_var(i,ipp,time) = fire(2)%frequ(3)
+
+     case ('fire_ind2_c4')
+        output_var(i,ipp,time) = fire(2)%frequ(4)
+
+     case ('fire_ind2_c5')
+        output_var(i,ipp,time) = fire(2)%frequ(5)
+
+     case ('fire_ind3_c1')
+        output_var(i,ipp,time) = fire(3)%frequ(1)
+
+     case ('fire_ind3_c2')
+        output_var(i,ipp,time) = fire(3)%frequ(2)
+
+     case ('fire_ind3_c3')
+        output_var(i,ipp,time) = fire(3)%frequ(3)
+
+     case ('fire_ind3_c4')
+        output_var(i,ipp,time) = fire(3)%frequ(4)
+
+     case ('fire_ind3_c5')
+        output_var(i,ipp,time) = fire(3)%frequ(5)
+
+     case('fortyp')                ! forest type classified
+        call wclas(waldtyp)
+        output_var(i,ipp,time) = waldtyp
+
+     case ('gpp','GPP')             ! yearly GPP
+        output_var(i,ipp,time) = sumGPP * hconv/100.   ! g C/patch --> t C/ha
+
+     case ('GPP_year','GPPyear','gppyear','gpp_year')  ! GPP for each year
+        outvar(i) = 'GPP_year'
+        output_var(i,ipp,time) = sumGPP * hconv/100.   ! g C/patch --> t C/ha
+
+     case ('GPP_mon','GPPmon','gppmon','gpp_mon')  ! monthly GPP
+        outvar(i) = 'GPP_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = GPP_mon(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case ('GPP_week','GPPweek','gppweek','gpp_week')  ! weekly GPP
+        outvar(i) = 'GPP_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = GPP_week(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case ('height')
+        output_var(i,ipp,time) = hdom
+
+     case ('iday_vp')          ! yearly canopy interception
+        output_var(i,ipp,time) = iday_vegper
+
+	 case('ind_arid')
+	     	     output_var(i,ipp,time)=ind_arid_an
+
+	  case('ind_cout')
+	     	     output_var(i,ipp,time)=ind_cout_an
+
+	 case('ind_emb')
+	     	     output_var(i,ipp,time)=ind_emb
+
+	 case('ind_lang')
+	     	     output_var(i,ipp,time)=ind_lang_an	
+
+	 case('ind_mart')
+	     	     output_var(i,ipp,time)=ind_mart_an
+				 		  
+	 case('ind_reich')
+	     	     output_var(i,ipp,time)=ind_reich
+	
+	 case('ind_weck')
+	     	     output_var(i,ipp,time)=ind_weck	 
+ 
+	 case('ind_wiss')
+	     	     output_var(i,ipp,time)=ind_wiss_an	
+   
+     case ('int','interc')          ! yearly canopy interception
+        output_var(i,ipp,time) = int_cum_can
+
+     case ('lai','LAI')   
+            output_var(i,ipp,time) = LAImax
+
+     case ('NEE_mon','NEEmon','neemon','nee_mon')  ! monthly NEP
+        outvar(i) = 'NEE_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = NEE_mon(j)                                  ! g C/m
+        enddo
+
+     case ('NEP', 'nep')
+        outvar(i) = 'NEP'
+        output_var(i,ipp,time) = sumNPP * hconv * cpart/1000. -  resps_c * gm2_in_kgha/1000. ! kg DW/patch --> t C/ha
+ 
+     case ('NEP_year','NEPyear','nepyear','nep_year')  ! NEP of each year
+        outvar(i) = 'NEP_year'
+        output_var(i,ipp,time) = sumNPP * hconv * cpart/1000. -  resps_c * gm2_in_kgha/1000. ! kg DW/patch --> t C/ha
+
+     case ('NEP_mon','NEPmon','nepmon','nep_mon')  ! monthly NEP
+        outvar(i) = 'NEP_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = NPP_mon(j) * hconv/100. -  resps_mon(j) * gm2_in_kgha/1000. ! kg C/patch --> t C/ha
+        enddo
+
+     case ('NEP_week','NEPweek','nepweek','nep_week')  ! weekly NPP
+        outvar(i) = 'NEP_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = NPP_week(j) * hconv/100. -  resps_week(j) * gm2_in_kgha/1000. ! g C/patch --> t C/ha
+        enddo
+
+     case ('ndep','Ndep','N_dep')   ! yearly N deposition
+        output_var(i,ipp,time) = Ndep_cum        ! g N/m2
+
+     case('nleach', 'Nleach', 'N_leach')   ! Annual N leaching  kg N/ha
+        output_var(i,ipp,time) = N_min * gm2_in_kgha      ! g/m2 --> kg/ha, mean
+
+     case ('nmin','Nmin','N_min')   ! yearly N mineralization
+        output_var(i,ipp,time) = N_min * gm2_in_kgha      ! g/m2 --> kg/ha, mean
+
+     case ('npp','NPP')             ! NPP
+        output_var(i,ipp,time) = sumNPP * hconv * cpart/1000.   ! kg DW/patch --> t C/ha
+
+     case ('NPP_year','NPPyear','nppyear','npp_year')  ! NPP of each year
+        outvar(i) = 'NPP_year'
+        output_var(i,ipp,time) = sumNPP * hconv * cpart/1000.   ! kg DW/patch --> t C/ha
+
+     case ('NPP_mon','NPPmon','nppmon','npp_mon')  ! monthly NPP
+        outvar(i) = 'NPP_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = NPP_mon(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case ('NPP_week','NPPweek','nppweek','npp_week')  ! weekly NPP
+        outvar(i) = 'NPP_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = NPP_week(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case ('NTI', 'nti','NTindex','ntindex')                  ! Nonnen-Temperatur-Index
+        output_var(i,ipp,time) = ntindex
+
+     case ('perc')                  ! yearly percolation
+        output_var(i,ipp,time) = perc_cum
+
+     case ('perc_year')                  ! yearly percolation
+        outvar(i) = 'perc_year'
+        output_var(i,ipp,time) = perc_cum
+
+     case ('perc_mon', 'percmon')                      ! monthly percolation
+        outvar(i) = 'perc_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = perc_mon(j)
+        enddo
+
+     case ('perc_week', 'percweek')                    ! weekly percolation
+        outvar(i) = 'perc_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = perc_week(j)
+        enddo
+     
+     case ('PET','pet')                                ! potential evapotranspiration sum
+        output_var(i,ipp,time) = PET_cum
+
+     case ('PET_year','PETyear','pet_year','petyear')  ! potential evapotranspiration sum  of each year
+        outvar(i) = 'PET_year'
+        output_var(i,ipp,time) = PET_cum
+
+     case ('PET_mon','PETmon','pet_mon','petmon')     ! monthly potential evapotranspiration sum
+        outvar(i) = 'PET_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = PET_mon(j)
+        enddo
+
+     case ('PET_week','PETweek','pet_week','petweek') ! weekly potential evapotranspiration sum
+        outvar(i) = 'PET_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = PET_week(j)
+        enddo
+
+     case ('prec')                  ! yearly precipitation
+        output_var(i,ipp,time) = sum_prec
+
+     case ('prec_year', 'precyear')                  ! precipitation sum of each year 
+        outvar(i) = 'prec_year'
+        output_var(i,ipp,time) = sum_prec
+
+     case ('prec_mon', 'precmon')                  ! monthly precipitation sum
+        outvar(i) = 'prec_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = prec_mon(j)
+        enddo
+
+     case ('prec_week', 'precweek')                  ! weekly precipitation sum
+        outvar(i) = 'prec_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = prec_week(j)
+        enddo
+
+     case ('resps','respsoil')                           ! yearly soil respiration 
+        outvar(i) = 'resps'
+        output_var(i,ipp,time) = resps_c * gm2_in_kgha   ! g C/m2 --> kg C/ha, mean
+
+     case ('resps_year', 'respsyear')                  ! soil respiration of each year 
+        outvar(i) = 'resps_year'
+        output_var(i,ipp,time) = resps_c * gm2_in_kgha   ! g C/m2 --> kg C/ha, mean
+
+     case ('resps_mon', 'respsmon')                  ! monthly soil respiration
+        outvar(i) = 'resps_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = resps_mon(j) * gm2_in_kgha   ! g C/m2 --> kg C/ha
+        enddo
+
+     case ('resps_week', 'respsweek')                  ! weekly soil respiration
+        outvar(i) = 'resps_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = resps_week(j) * gm2_in_kgha   ! g C/m2 --> kg C/ha
+        enddo
+
+     case('steminc')
+        output_var(i,ipp,time)= totsteminc/1000.
+
+     case ('sumbio')                ! Biomass
+        output_var(i,ipp,time) = sumbio / 1000.      ! kg DW / ha --> t DW/ha
+
+     case ('sumtlf') ! temperature sum of days with frost April - June
+         output_var(i,ipp,time) = sumtlf(time)
+           
+     case ('temp')                  ! airtemp
+        output_var(i,ipp,time) = med_air
+
+     case ('temp_year', 'tempyear')                  ! mean yearly air temperature
+        outvar(i) = 'temp_year'
+        output_var(i,ipp,time) = med_air
+
+     case ('temp_mon', 'tempmon')                  ! mean monthly air temperature
+        outvar(i) = 'temp_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = temp_mon(j) ! Mittelung erfolgt schon in daily  (/ monrec(j))
+        enddo
+
+     case ('temp_week', 'tempweek')                  ! mean weekly air temperature
+        outvar(i) = 'temp_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = temp_week(j) / 7.
+        enddo
+
+     case ('TER','ter')             ! yearly TER
+        outvar(i) = 'TER'
+        output_var(i,ipp,time) = sumTER * hconv/100.   ! g C/patch --> t C/ha
+
+     case ('TER_year','TERyear','teryear','ter_year')  ! yearly TER
+        outvar(i) = 'TER_year'
+        output_var(i,ipp,time) = sumTER * hconv/100.   ! g C/patch --> t C/ha
+
+     case ('TER_mon','TERmon','termon','ter_mon')  ! monthly TER
+        outvar(i) = 'TER_mon'
+        k = output_var(i,1,0)
+        do j = 1, 12
+            output_varm(k,ipp,time,j) = TER_mon(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case ('TER_week','TERweek','terweek','ter_week')  ! weekly TER
+        outvar(i) = 'TER_week'
+        k = output_var(i,1,0)
+        do j = 1, 52
+            output_varw(k,ipp,time,j) = TER_week(j) * hconv/100.   ! g C/patch --> t C/ha
+        enddo
+
+     case('totstem')
+        output_var(i,ipp,time)= totstem_m3
+
+     case('vsab')
+        output_var(i,ipp,time)= sumvsab_m3
+
+     case('vsdead')
+        output_var(i,ipp,time)= sumvsdead_m3
+	
+     end select
+  enddo
+END SUBROUTINE outstore
+
+!**************************************************************
+
+SUBROUTINE out_var_file
+
+! writing of output variables (multi run 4 and 8)
+   use data_biodiv
+   use data_out
+   use data_simul
+   use data_site
+
+  IMPLICIT NONE
+
+  integer i, ii, j, k, unit_nr
+  real varerr
+  character(50) :: filename    ! complete name of output file
+  character(15) idtext, datei
+  real, dimension(12) :: helpf  
+  real, dimension(52) :: helpw  
+  character(30) :: helpvar
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' out_var_file '
+
+  do i = 1, nvar-1
+
+    helpvar = outvar(i)
+    call out_var_select(helpvar, varerr, unit_nr)
+
+    if (varerr .ne. 0.) then
+      select case (trim(outvar(i)))
+      case ('AET_week','cwb_week','GPP_week','NEP_week','NPP_week','perc_week','PET_week','temp_week','TER_week','prec_week','resps_week')  
+            write (unit_nr, '(A)') '#       Site          Week1       Week2       Week3       Week4       Week5       Week6       Week7       Week8       Week9      &
+      Week10      Week11      Week12      Week13      Week14      Week15      Week16      Week17      Week18      Week19      &
+      Week20      Week21      Week22      Week23      Week24      Week25      Week26      Week27      Week28      Week29      &
+      Week30      Week31      Week32      Week33      Week34      Week35      Week13      Week37      Week38      Week39      &
+      Week40      Week41      Week42      Week43      Week44      Week45      Week46      Week47      Week48      Week49      &
+      Week50      Week51      Week52'
+        do ip = 1, site_nr
+           write (datei, '(A10)') adjustl(sitenum(ip))
+           read (datei, '(A)') idtext
+           write (unit_nr, '(A15)', advance = 'no') idtext
+           ii = output_var(i,1,0)
+           helpw = 0.
+           do k = 1, 52
+             do j = 1, year
+                helpw(k) = helpw(k) + output_varw(ii,ip,j,k)
+             enddo
+             helpw(k) = helpw(k) / year
+           enddo
+              write (unit_nr, '(52(E12.4))', advance = 'no')  helpw
+           write (unit_nr, '(A)') ''
+        enddo
+        
+      case ('AET_mon','cwb_mon','GPP_mon','NEP_mon','NPP_mon','perc_mon','PET_mon','temp_mon','TER_mon','prec_mon','resps_mon')  
+        write (unit_nr, '(A)') '#       Site          Mean1       Mean2       Mean3       Mean       4&
+       Mean5       Mean6       Mean7       Mean8       Mean9      Mean10      Mean11      Mean12'
+        do ip = 1, site_nr
+           write (datei, '(A10)') adjustl(sitenum(ip))
+           read (datei, '(A)') idtext
+           write (unit_nr, '(A15)', advance = 'no') idtext
+           ii = output_var(i,1,0)
+           helpf = 0.
+           do k = 1, 12
+             do j = 1, year
+                helpf(k) = helpf(k) + output_varm(ii,ip,j,k)
+             enddo
+             helpf(k) = helpf(k) / year
+           enddo
+              write (unit_nr, '(12(E12.4))', advance = 'no')  helpf
+           write (unit_nr, '(A)') ''
+        enddo
+ 
+      case default
+        write (unit_nr, '(A)') '#       Site         Year 1      Year 2      Year 3      Year 4      Year 5   ...'
+        do ip = 1, site_nr
+           write (datei, '(A10)') adjustl(sitenum(ip))
+           read (datei, '(A)') idtext
+           write (unit_nr, '(A15)', advance = 'no') idtext
+           do j = 1, year
+              write (unit_nr, '(E12.4)', advance = 'no')  output_var(i,ip,j)
+           enddo
+           write (unit_nr, '(A)') ''
+        enddo
+      end select
+    else
+        write (*,*)
+        write (*,*) '***  4C-error - output of variables (out_var_file): ', trim(outvar(i)), ' not found'
+        write (*,*)
+        write (unit_err,*)
+        write (unit_err,*) '***  4C-error - no such output variable (out_var_file): ', trim(outvar(i))
+    endif
+    close(unit_nr)
+  enddo
+END SUBROUTINE out_var_file
+
+!**************************************************************
+
+SUBROUTINE out_var_select(varout, varerr, unit_nr)
+
+! selection of output variables and open files (multi run 4, 8, 9)
+   use data_biodiv
+   use data_out
+   use data_simul
+   use data_site
+
+  IMPLICIT NONE
+
+  integer unit_nr
+  real varerr
+  character(50) :: filename    ! complete name of output file
+  character(30) :: varout
+  character(15) idtext, datei
+
+if (flag_trace) write (unit_trace, '(I4,I10,A,F6.0,I4)') iday, time_cur, ' out_var_select '//varout, varerr, unit_nr
+
+     filename = trim(site_name1)//'_'//trim(varout)//'.out'    
+     unit_nr   = getunit()
+     open(unit_nr,file=trim(dirout)//filename,status='replace')
+     write (unit_nr, '(A)') '#  Output of '//varout
+     varerr = 0.
+
+     select case (trim(varout))
+      
+     case('anzdlf')
+       write(unit_nr, '(A)') '# number of days with frost April - June'
+       varerr = 1
+ 
+     case ('AET','aet')
+       write (unit_nr, '(A)') '#  Yearly actual evapotranspiration sum / mm'
+       varerr = 1.
+
+     case ('AET_year')
+       write (unit_nr, '(A)') '#  Annual actual evapotranspiration sum / mm'
+       varerr = 1.
+
+     case ('AET_mon','aet_mon','AETmon','aetmon')
+       write (unit_nr, '(A)') '#  Monthly actual evapotranspiration sum / mm'
+       varerr = 1.
+
+     case ('AET_week','aet_week','AETweek','aetweek')
+       write (unit_nr, '(A)') '#  Weekly actual evapotranspiration sum / mm'
+       varerr = 1.
+
+     case('above_biom')
+       write(unit_nr,'(A)') '# Total aboveground biomass / t DW/ha'
+       varerr = 1.	   
+
+     case('BA')
+       write(unit_nr,'(A)') '# Basal arera m'
+       varerr = 1.	
+       
+     case ('C_accu','Caccu','c_accu')   ! C accumulation per year
+       write (unit_nr, '(A)') '#  Soil carbon accumulation per year / t C/ha'
+       varerr = 1.
+     
+     case ('C_d_stem','c_d_stem')   ! C accumulation per year
+       write (unit_nr, '(A)') '#  carbon in dead trees / t C/ha'
+       varerr = 1.
+     
+     case ('C_hum_tot','C_humtot','chumtot','Chumtot')   ! total soil C
+       write (unit_nr, '(A)') '#  Total carbon in humus / t C/ha'
+       varerr = 1.
+
+     case ('C_sum','csum','Csum')   ! total C in ecosystem
+       write (unit_nr, '(A)') '#  Total carbon in ecosystem / t C/ha'
+       varerr = 1.
+
+     case ('C_tot','ctot','Ctot')   ! total soil C
+       write (unit_nr, '(A)') '#  Total carbon in soil / t C/ha'
+       varerr = 1.
+
+	 case('con_gor')
+       write(unit_nr,'(A)') '#  Continentality index Gorczynski'
+       varerr = 1.	   
+
+     case('con_cur')
+       write(unit_nr,'(A)') '#  Continentality index Currey'
+       varerr = 1.	 
+
+     case('con_con')
+       write(unit_nr,'(A)') '#  Continentality index Conrad'
+       varerr = 1.	 
+
+     case('cwb_year','cwb')
+       write(unit_nr,'(A)') '#  Annual climate water balance'
+       varerr = 1.	   
+
+     case('cwb_mon')
+       write(unit_nr,'(A)') '#  Monthly climate water balance'
+       varerr = 1.	   
+
+     case('cwb_week')
+       write(unit_nr,'(A)') '#  Weekly climate water balance'
+       varerr = 1.	   
+
+     case('date_lf')
+      write(unit_nr, '(A)') '# number of day of last late frost after start of vegetation period'
+      varerr = 1
+   
+     case('date_lft')
+       write(unit_nr, '(A)') '# number of day of last late frost'
+       varerr = 1
+
+     case('daybb_be')
+       write(unit_nr,'(A)') '#  Day of bud burst beech'
+       varerr = 1.
+
+     case('daybb_bi')
+       write(unit_nr,'(A)') '#  Day of bud burst betula'
+       varerr = 1.
+
+     case('daybb_oa')
+       write(unit_nr,'(A)') '#  Day of bud burst oak'
+       varerr = 1.
+     
+     case ('dbh')                   ! mean DBH 
+       write (unit_nr, '(A)') '# DBH / cm'
+       varerr = 1.
+
+     case ('dens')                 ! stem density /ha
+       write (unit_nr, '(A)') '#  Stem density per ha'
+       varerr = 1.
+
+     case('dnlf')
+       write(unit_nr, '(A)') '# number of frost days since start of vegetation period'
+       varerr = 1.
+ 
+     case('dnlf_sp')
+       write(unit_nr, '(A)') '# number of frost days since start of bud burst'
+       varerr = 1.
+
+     case ('drindal','drIndAl','drIndal','DrIndAl')   ! drought index for allocation calculation (cum.) for the whole stand [-], weighted by NPP
+       write (unit_nr, '(A)') '#  Drought index for allocation calculation'
+       varerr = 1.
+
+     case ('fire_indb')
+       write (unit_nr, '(A)') '# Fire index Bruschek'
+       varerr = 1.
+     
+     case ('fire_ind1')
+       write (unit_nr, '(A)') '# Fire index west'
+       varerr = 1.
+     
+     case ('fire_ind2')
+       write (unit_nr, '(A)') '# Fire index east'
+       varerr = 1.
+     
+     case ('fire_ind3')
+       write (unit_nr, '(A)') '# Fire index Nesterov'
+       varerr = 1.
+     
+     case ('fire_ind1_c1')
+       write (unit_nr, '(A)') '# Fire index west class 1'
+       varerr = 1.
+     
+     case ('fire_ind1_c2')
+       write (unit_nr, '(A)') '# Fire index west class 2'
+       varerr = 1.
+     
+     case ('fire_ind1_c3')
+       write (unit_nr, '(A)') '# Fire index west class 3'
+       varerr = 1.
+     
+     case ('fire_ind1_c4')
+       write (unit_nr, '(A)') '# Fire index west class 4'
+       varerr = 1.
+     
+     case ('fire_ind1_c5')
+       write (unit_nr, '(A)') '# Fire index west class 5'
+       varerr = 1.
+     
+     case ('fire_ind2_c1')
+       write (unit_nr, '(A)') '# Fire index east class 1'
+       varerr = 1.
+     
+     case ('fire_ind2_c2')
+       write (unit_nr, '(A)') '# Fire index east class 2'
+       varerr = 1.
+     
+     case ('fire_ind2_c3')
+       write (unit_nr, '(A)') '# Fire index east class 3'
+       varerr = 1.
+     
+     case ('fire_ind2_c4')
+       write (unit_nr, '(A)') '# Fire index east class 4'
+       varerr = 1.
+     
+     case ('fire_ind2_c5')
+       write (unit_nr, '(A)') '# Fire index east class 5'
+       varerr = 1.
+
+     case ('fire_ind3_c1')
+       write (unit_nr, '(A)') '# Fire index Nesterov class 1'
+       varerr = 1.
+     
+     case ('fire_ind3_c2')
+       write (unit_nr, '(A)') '# Fire index Nesterov class 2'
+       varerr = 1.
+     
+     case ('fire_ind3_c3')
+       write (unit_nr, '(A)') '# Fire index Nesterov class 3'
+       varerr = 1.
+     
+     case ('fire_ind3_c4')
+       write (unit_nr, '(A)') '# Fire index Nesterov class 4'
+       varerr = 1.
+     
+     case ('fire_ind3_c5')
+       write (unit_nr, '(A)') '# Fire index Nesterov class 5'
+       varerr = 1.
+
+     case ('fortyp')
+       write (unit_nr, '(A)') '# Forest classification'
+       varerr = 1.
+
+     case ('GPP')             ! GPP
+       write (unit_nr, '(A)') '#  Yearly gross primary production / t C/ha'
+       varerr = 1.
+
+     case ('GPP_year')             ! GPP
+       write (unit_nr, '(A)') '#  Annual gross primary production / t C/ha'
+       varerr = 1.
+
+     case ('GPP_mon')  ! monthly GPP
+       write (unit_nr, '(A)') '#  Monthly gross primary production / t C/ha'
+       varerr = 1.
+
+     case ('GPP_week')  ! weekly GPP
+       write (unit_nr, '(A)') '#  Weekly gross primary production / t C/ha'
+       varerr = 1.
+
+     case ('height')               ! height, in this case dominant height
+       write (unit_nr, '(A)') '# Height / cm'
+       varerr = 1.
+
+     case ('iday_vp')               
+       write (unit_nr, '(A)') '# start day of vegetation period'
+       varerr = 1.
+   
+     case('ind_arid')
+       write(unit_nr,'(A)') '# Aridity index (UNEP)'
+       varerr = 1.	   
+
+     case('ind_lang')
+       write(unit_nr,'(A)') '# Climate index Lang'
+       varerr = 1.	   
+
+     case('ind_cout')
+       write(unit_nr,'(A)') '# Climate index Coutange'
+       varerr = 1.	   
+
+     case('ind_emb')
+       write(unit_nr,'(A)') '# Climate index Emberger'
+       varerr = 1.	   
+
+     case('ind_mart')
+       write(unit_nr,'(A)') '# Climate index Martonne'
+       varerr = 1.	   
+
+     case('ind_reich')
+       write(unit_nr,'(A)') '# Climate index Reichel'
+       varerr = 1.	   
+
+     case('ind_weck')
+       write(unit_nr,'(A)') '# Climate index Weck'
+       varerr = 1.	   
+
+     case('ind_wiss')
+       write(unit_nr,'(A)') '# Climate index v. Wissmann'
+       varerr = 1.	   
+
+     case ('int','interc')          ! yearly canopy interception
+       write (unit_nr, '(A)') '#  Yearly canopy interception / mm'
+       varerr = 1.
+
+     case ('lai','LAI')          ! yearly canopy interception
+       write (unit_nr, '(A)') '#  Maximum LAI '
+       varerr = 1.
+	 
+	 case ('N_dep','ndep','Ndep')   ! yearly N deposition
+       write (unit_nr, '(A)') '#  Yearly N deposition / g N/m2'
+       varerr = 1.
+
+     case('N_leach', 'nleach', 'Nleach')
+       write(unit_nr,'(A)') '# Annual N leaching  kg N/ha'
+       varerr = 1.
+
+     case ('N_min','nmin','Nmin')   ! yearly N mineralization
+       write (unit_nr, '(A)') '#  Yearly N mineralization / kg N/ha'
+       varerr = 1.
+     
+     case ('nep','NEP')             ! NEP
+       write (unit_nr, '(A)') '#  Yearly net ecosystem production / t C/ha'
+       varerr = 1.
+     
+     case ('NEP_year')             ! NEP
+       write (unit_nr, '(A)') '#  Annual net ecosystem production / t C/ha'
+       varerr = 1.
+     
+     case ('NEP_mon')             ! monthly NEP
+       write (unit_nr, '(A)') '#  Monthly net ecosystem production / t C/ha'
+       varerr = 1.
+     
+     case ('NEP_week')             ! weekly NEP
+       write (unit_nr, '(A)') '#  Weekly net ecosystem production / t C/ha'
+       varerr = 1.
+
+     case ('NPP','npp')             ! NPP
+       write (unit_nr, '(A)') '#  Yearly net primary production / t C/ha'
+       varerr = 1.
+
+     case ('NPP_year')             ! NPP of each year 
+       write (unit_nr, '(A)') '#  Annual net primary production / t C/ha'
+       varerr = 1.
+
+     case ('NPP_mon')  ! monthly NPP
+       write (unit_nr, '(A)') '#  Monthly net primary production / t C/ha'
+       varerr = 1.
+
+     case ('NPP_week')  ! weekly NPP
+       write (unit_nr, '(A)') '#  Weekly net primary production / t C/ha'
+       varerr = 1.
+
+     case ('NTI', 'nti','NTindex','ntindex')                  ! Nonnen-Temperatur-Index
+       write (unit_nr, '(A)') '#  Nun temperature index'
+       varerr = 1.
+
+     case ('perc')                  ! yearly percolation
+       write (unit_nr, '(A)') '#  Yearly percolation / mm'
+       varerr = 1.
+
+     case ('perc_year')                  ! yearly percolation
+       write (unit_nr, '(A)') '#  Annual percolation / mm'
+       varerr = 1.
+
+     case ('perc_mon', 'percmon')                  ! monthly percolation
+       write (unit_nr, '(A)') '#  Monthly percolation / mm'
+       varerr = 1.
+
+     case ('perc_week', 'percweek')                  ! weekly percolation
+       write (unit_nr, '(A)') '#  Weekly percolation / mm'
+       varerr = 1.
+
+     case ('PET','pet')             ! PET
+       write (unit_nr, '(A)') '#  Yearly potential evapotranspiration / mm'
+       varerr = 1.
+
+     case ('PET_year')             ! PET
+       write (unit_nr, '(A)') '#  Annual potential evapotranspiration / mm'
+       varerr = 1.
+
+     case ('PET_mon')             ! PET
+       write (unit_nr, '(A)') '#  Monthly potential evapotranspiration / mm'
+       varerr = 1.
+
+     case ('PET_week')             ! PET
+       write (unit_nr, '(A)') '#  Weekly potential evapotranspiration / mm'
+       varerr = 1.
+
+     case ('prec')                  ! yearly precipitation
+       write (unit_nr, '(A)') '#  Yearly precipitation sum / mm'
+       varerr = 1.
+
+     case ('prec_year')                  ! yearly precipitation
+     write (unit_nr, '(A)') '#  Annual precipitation sum / mm'
+     varerr = 1.
+
+     case ('prec_mon', 'precmon')                  ! monthly precipitation sum
+       write (unit_nr, '(A)') '#  Monthly precipitation sum / mm'
+       varerr = 1.
+
+     case ('prec_week', 'precweek')                  ! weekly precipitation sum
+       write (unit_nr, '(A)') '#  Weekly precipitation sum / mm'
+       varerr = 1.
+
+     case ('resps', 'respsoil')                  ! yearly soil respiration
+       write (unit_nr, '(A)') '#  Yearly soil respiration / kg C/ha'
+       varerr = 1.
+
+     case ('resps_year')                  ! yearly soil respiration
+       write (unit_nr, '(A)') '#  Annual soil respiration / kg C/ha'
+       varerr = 1.
+
+     case ('resps_mon', 'respsmon')                  ! monthly soil respiration
+       write (unit_nr, '(A)') '#  Monthly soil respiration / kg C/ha'
+       varerr = 1.
+
+     case ('resps_week', 'respsweek')                  ! Weekly soil respiration
+       write (unit_nr, '(A)') '#  Weekly soil respiration / kg C/ha'
+       varerr = 1.
+
+     case('steminc')
+       write(unit_nr,'(A)') '#  Total annual stem increment t/ha'
+       varerr = 1.
+
+     case ('sumbio')                ! Biomass
+       write (unit_nr, '(A)') '#  Total Biomass / t DW/ha'
+      varerr = 1.
+
+     case('sumtlf')
+       write(unit_nr, '(A)') '# temperature sum of minimum temperature < 0 April - June'
+       varerr = 1
+
+     case ('temp')                  ! airtemp
+       write (unit_nr, '(A)') '#  Mean yearly air temperature / C'
+       varerr = 1.
+
+     case ('temp_year')                  ! airtemp
+       write (unit_nr, '(A)') '#  Mean annual air temperature / C'
+       varerr = 1.
+
+     case ('temp_mon', 'tempmon')                  ! mean monthly air temperature
+       write (unit_nr, '(A)') '#  Mean monthly air temperature / C'
+       varerr = 1.
+
+     case ('temp_week', 'tempweek')                  ! mean weekly air temperature
+       write (unit_nr, '(A)') '#  Mean weekly air temperature / C'
+       varerr = 1.
+
+     case ('TER')             ! TER
+       write (unit_nr, '(A)') '#  Yearly total ecosystem respiration / t C/ha'
+       varerr = 1.
+
+     case ('TER_year')             ! TER
+       write (unit_nr, '(A)') '#  Annual total ecosystem respiration / t C/ha'
+       varerr = 1.
+
+     case ('TER_mon')  ! monthly TER
+       write (unit_nr, '(A)') '#  Monthly total ecosystem respiration / t C/ha'
+       varerr = 1.
+
+     case ('TER_week')  ! weekly TER
+       write (unit_nr, '(A)') '#  Weekly total ecosystem respiration / t C/ha'
+       varerr = 1.
+
+     case('totstem')
+       write(unit_nr,'(A)') '#  Total annual stem volume m/ha'
+       varerr = 1.
+
+     case('vsdead')
+       write(unit_nr,'(A)') '#  Total annual dead stem volume m/ha (not in the litter pool)'
+       varerr = 1.
+
+     case('vsab')
+       write(unit_nr,'(A)') '#  Total annual harvested stem volume m/ha'
+       varerr = 1.
+     end select
+END SUBROUTINE out_var_select
+
+!**************************************************************

source_code/version_2.3_windows/partitio.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*    - Calculation of annual allocation of NPP (SR PARTITION)   *!
+!*    - Calculation of annual allocation of NPP of soil          *!
+!*         vegetation (PARTITION_SV                              *!
+!*    - Calculation of diameter at breast height (SR CALC_DBH)   *!
+!*                                                               *!
+!*                  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 PARTITION   *!
+!****************************!
+
+SUBROUTINE PARTITION( p )
+
+  !*** Declaration part ***!
+  USE data_out
+  USE data_par
+  USE data_stand
+  USE data_species
+  USE data_simul
+  USE data_manag
+  
+  IMPLICIT NONE
+
+  REAL   :: lambdaf = 0.,  &      ! partitioning functions
+            lambdas = 0.,  &
+            lambdar = 0.,  &
+            lambdac = 0.,  &
+            lambdaSum = 0.,&      ! sum of the above three lambdas
+            NPP = 0.,      &      ! annual NPP
+            F = 0.,        &      ! state variables: foliage,
+            S = 0.,        &      ! sapwood,
+            H = 0.,        &      ! heartwood
+            R = 0.,        &      ! fine roots,
+            B = 0.,        &      ! bole height,
+            Ahb = 0.,      &      ! cross sectional area heartwood at tree base
+            hs = 0.,       &      ! sapwood height
+            Ht = 0.,       &      ! total tree height
+            Asw = 0.,      &      ! cross sectional area of sapwood in bole
+            DBH = 0.,      &      ! tree diameter at breast height (DBH)
+            FNew, SNew,    &      ! new states
+            RNew, BNew,    &
+            HtNew,  &
+            HNew, Ahbnew,  &
+            sigmaf = 0.,   &      ! current leaf activity rate
+            sigman = 0.,   &      ! current root activity rate
+            ar = 0.,       &      ! aux vars for partitioning functions
+            as = 0.,       &
+            ac = 0.,       &
+            betar = 0.,    &
+            betas = 0.,    &
+            aux = 0.,      &
+            Fmax,          &      ! determines whether height growth or not
+            rsap,          &      ! auxiliary variable for height growth determination
+            growthrate            ! height growthrate depends on relative light regime in the middle of the canopy
+  REAL  ::  Sf,            &      ! senescence rates
+            Ss,            &
+            Sr,            &
+            Gf,            &      ! growth rates
+            Gs,            &
+            Gr
+ real ::    DBH_help
+  REAL  ::  leaf_N_conc,      &   ! last years N concentration in leaves gN kgDM
+            tbc_root_Ndemand, &   ! N demand for ghrowth of fine roots, branches and coarse roots g tree-1
+            Nredfak,          &   ! reduction factor for N allocation to fine roots, branches and coarse roots
+            nsc_get, nsc_plus, nsc_max,   & !nsc_get estimated NSC demand [kg DW/tree], nsc_plus realized NSC supply from storage for NPP [kg DW/tree], nsc_max [kg DW/tree] maximum=80%
+            nsc_sap_refill,nsc_tb_refill, & !calculated amount for refilling of the NSC-Pools [kg C/tree], subtracted from the NPP
+            nsc_crt_refill,nsc_all_refill, &  !
+            bioscost_sap, bioscost_tb,    & ! Biosynthesis cost [kg C/tree]
+            bioscost_crt, bioscost_all, max_for_refill
+            
+  logical        :: treegroup_decid, looptrue                        ! decidous or coniferous for flag_dis=1
+  integer, dimension(5) :: decidous = (/1, 4, 5, 8, 11/)   ! species numbers for decidous trees for flag_dis=1
+  integer               :: i, nrow_dis
+
+
+  TYPE(Coh_Obj) :: p        ! pointer to cohort list
+
+  REAL   :: term1,       &
+            a1, a2, a3,  &  ! coefficients of quadratic equation
+            x1 = 0.,     &
+            x2 = 0.         ! solutions of quadratic equation
+ 
+ real   ::  Fmax_old
+
+  ! if this cohort is mistletoe infected, reduce NPP by mistletoe-specific demand
+  ! demand is defined in PARTITION_MI. as mistletoe is always 1st cohort, the demand of mistletoe is calculated before the reduction here
+  if (p%coh%mistletoe.eq.1) then
+     p%coh%NPP = p%coh%NPP-(NPP_demand_mistletoe/p%coh%ntreea)
+  endif
+  ns   = p%coh%species
+  F    = p%coh%x_fol
+  Fmax = p%coh%Fmax
+  S    = p%coh%x_sap
+  R    = p%coh%x_frt
+  H    = p%coh%x_hrt
+  B    = p%coh%x_hbole
+  NPP  = p%coh%NPP
+  Ht   = p%coh%height
+  Ahb  = p%coh%x_Ahb
+  Sf   = p%coh%sfol
+  Ss   = p%coh%ssap
+  Sr   = p%coh%sfrt
+  hs   = p%coh%x_hsap
+  Asw  = p%coh%Asapw
+  Fmax_old = Fmax
+  
+  DBH_help = p%coh%diam
+
+  if (flag_end.eq.1) then
+         p%coh%notViable = .TRUE.
+         flag_end = 0
+  end if
+
+if(p%coh%notViable.neqv..TRUE.) then
+  select case (flag_folhei)
+  case (1,4)
+    spar(ns)%pha = spar(ns)%pha_v1 * spar(ns)%pha_v3 *     &
+        (F)**(-1-spar(ns)%pha_v3)/(spar(ns)%pha_v2+(F)**(-spar(ns)%pha_v3))**2.
+
+  case (2) 
+  
+     rsap=Asw/(Asw+Ahb)
+     spar(ns)%pha = 2.*spar(ns)%crown_a/(pi**0.5*(rsap*spar(ns)%pnus)**1.5*F**0.5)
+  
+  case (3)
+    ! this version only for tests and pine trees
+      spar(ns)%pha = (3500*(10.+F**0.9)-(0.9*3500.*F**0.9))/(10.+F**0.9)**2
+   
+  end select   ! flag_folhei 
+
+  ! only allocate if enough NPP is available
+  IF (NPP>1.0E-9) THEN
+  
+      select case (flag_folhei)
+      case (0)
+            growthrate=spar(ns)%pha*spar(ns)%pha_coeff1 + spar(ns)%pha*spar(ns)%pha_coeff2*(1./p%coh%IrelCan-1.)
+
+      case (1,3)
+            growthrate=spar(ns)%pha + spar(ns)%pha*(1./MAX(p%coh%IrelCan,0.25)-1.)
+      
+      case (2)
+            growthrate=spar(ns)%pha + spar(ns)%pha*(1.-p%coh%IrelCan)*5.
+
+      case (4)
+            growthrate=spar(ns)%pha *0.5/MAX(p%coh%IrelCan,0.25)
+      
+      end select   ! flag_folhei
+
+      sigmaf = NPP/F
+
+         ! calculate root activity based on drought index
+         ! test of a relationship which modifies fine root leaf ratio with shade tolerance:
+
+      IF (flag_sign.eq.1 .or. flag_sign.eq.11) THEN
+         term1 = spar(ns)%sigman * 10. * (((5.-spar(ns)%stol)*1.-p%coh%crown_area) / (5.-spar(ns)%stol)*1.)
+         sigman = amax1(term1,spar(ns)%sigman) * p%coh%drIndAl/p%coh%nDaysGr
+      ELSE
+         sigman = spar(ns)%sigman * p%coh%drIndAl / p%coh%nDaysGr
+      END IF
+      
+      if (flag_sign .eq. 0 .or. flag_sign .eq. 1) then  
+         ! auxiliary variables for fine roots
+         ar = spar(ns)%pcnr * sigmaf / sigman
+         betar = (Sr - R + ar*(F-Sf)) / NPP
+
+         ! auxiliary variables for sapwood
+         as = spar(ns)%prhos / spar(ns)%pnus
+         aux = 2.*(B+p%coh%deltaB) + Ht
+         betas = ( (as/3.)*(aux - growthrate*Sf) * (F-Sf) + Ss - S ) / NPP
+
+         ! solve quadratic equation for lambdaf
+         term1 = (1.+spar(ns)%alphac)
+         a1 = term1 * as/3. * growthrate * NPP
+         a2 = 1.0 + ar + term1 * as/3. * (aux + growthrate*(F-2.*Sf))
+         a3 = term1*betas + betar - 1.
+
+         x1 = (-a2 + SQRT( a2*a2 - 4.*a1*a3) ) / (2.*a1)
+         x2 = (-a2 - SQRT( a2*a2 - 4.*a1*a3) ) / (2.*a1)
+         lambdaf = x1
+    
+         if (lambdaf .le. 0. .or. lambdaf .gt. 1.) then
+            lambdaf = 0.5
+            lambdar = 0.5
+            lambdas = 0.
+            lambdac = 0.
+         else
+
+           ! calculate coefficients for sapwood and roots
+             lambdar = ar * lambdaf + betar;
+             lambdas = as/3. * (aux + growthrate*(F+lambdaf*NPP-2.*Sf)) * lambdaf + betas
+             lambdac = spar(ns)%alphac * lambdas    
+
+           ! check consistency of calculation, i.e. no negative values
+             IF(lambdas <  0. .or. lambdas .gt. 1.) THEN
+                lambdas = 0.
+                lambdac = 0.
+                lambdaf = (1.-betar)/(ar+1)
+                lambdar = 1.-lambdaf
+                
+                if (lambdaf .le. 0. .or. lambdaf .gt. 1.) then
+                    lambdaf = 0.5
+                    lambdar = 0.5
+
+                else if (lambdar<0) then
+                   lambdar=0.
+                   lambdaf=1.
+                end if
+
+             ELSE
+                ! reduced allocation schemes for lamdaf<0. or lamdar<0. still to be added
+                lambdaf = AMAX1( lambdaf, 0. )
+                lambdar = AMAX1( lambdar, 0. )
+
+                ! warrant that lambdaSum = 1 if balance can not be achieved this time step
+                lambdaSum = lambdaf + (1.+spar(ns)%alphac)*lambdas + lambdar
+                lambdaf   = lambdaf / lambdaSum
+                lambdas   = lambdas / lambdaSum
+                lambdar   = lambdar / lambdaSum
+                lambdac   = lambdac / lambdaSum
+                lambdaSum = lambdaf + (1.+spar(ns)%alphac)*lambdas + lambdar  ! for debugging only 
+
+             END IF
+         end if  ! lambdaf .le. 0.
+  
+     else   ! flag_sign = 10, 11
+         ! auxiliary variables for fine roots
+          ar    = spar(ns)%pcnr * sigmaf / sigman
+          betar = (Sr - ar*Sf) / NPP
+
+         ! auxiliary variables for sapwood
+          as    = spar(ns)%prhos / spar(ns)%pnus
+          betas = (Ss - 2.*as*hs*Sf ) / NPP
+
+         ! auxiliary variables for coarse roots, twigs and branches
+          ac    = spar(ns)%alphac
+
+         ! linear equation system in lamda(i)
+          term1   = 1. + ar + 2.*as*hs*(1+ac)
+          lambdaf = 1. - (1.+ac)*betas - betar  
+          lambdaf = lambdaf / term1  
+          lambdar = ar * lambdaf + betar
+          lambdas = 2.*as*hs * lambdaf + betas  
+          lambdac = ac * lambdas    
+
+         if (lambdaf .le. 0. .or. lambdaf .gt. 1.) then
+            lambdaf = 0.5
+            lambdar = 0.5
+            lambdas = 0.
+            lambdac = ac * lambdas    
+         else
+
+           ! calculate coefficients for sapwood and roots
+             lambdar = ar * lambdaf + betar;
+             lambdas = 2.*as*hs * lambdaf + betas  
+             lambdac = ac * lambdas    
+
+           ! check consistency of calculation, i.e. no negative values
+             IF(lambdas <  0. .or. lambdas .gt. 1.) THEN
+                lambdas = 0.
+                lambdac = 0.
+                lambdaf = (1.-betar)/(ar+1)
+                lambdar = 1.-lambdaf
+                
+                if (lambdaf .le. 0. .or. lambdaf .gt. 1.) then
+                    lambdaf = 0.5
+                    lambdar = 0.5
+
+                else if (lambdar<0) then
+                   lambdar=0.
+                   lambdaf=1.
+                end if
+
+             ELSE
+                ! reduced allocation schemes for lamdaf<0. or lamdar<0. still to be added
+                lambdaf = AMAX1( lambdaf, 0. )
+                lambdar = AMAX1( lambdar, 0. )
+
+                ! warrant that lambdaSum = 1 if balance can not be achieved this time step
+                lambdaSum = lambdaf + (1.+spar(ns)%alphac)*lambdas + lambdar
+                lambdaf   = lambdaf / lambdaSum
+                lambdas   = lambdas / lambdaSum
+                lambdar   = lambdar / lambdaSum
+                lambdac   = lambdac / lambdaSum
+                lambdaSum = lambdaf + (1.+spar(ns)%alphac)*lambdas + lambdar  ! for debugging only 
+
+             END IF
+         end if  ! lambdaf .le. 0.
+          
+      endif  ! flag_sign  
+  ELSE  
+
+     lambdaf   = 0.
+     lambdas   = 0.
+     lambdar   = 0.
+
+  END IF   ! IF NPP < 1.0E-09
+
+      ! gross growth rates of compartments
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+select case(flag_dis)
+     case (1)
+      looptrue = .False.
+      if (size(dis_year) .gt. 0) then
+      nrow_dis = size(dis_year)
+        do i=1,nrow_dis
+          if (time .eq. dis_year(i)) looptrue = .True.
+        enddo
+      endif
+      
+     case(2)
+     looptrue = .False.
+      if (size(dis_year) .gt. 0) then
+      nrow_dis = size(dis_year)
+        do i=1,nrow_dis
+          if (time .eq. dis_year(i)) looptrue = .True.
+        enddo
+      endif
+      nsc_sap_refill = 0.
+      nsc_tb_refill  = 0.
+      nsc_crt_refill = 0.
+      bioscost_sap = 0.
+      bioscost_tb = 0.
+      bioscost_crt = 0.
+      bioscost_all = 0.
+      if (NPP .gt. 0.001) then !is not working if NPP<=0
+      !first calculate the amount of carbon which is used to refill nsc storage
+      ! 0.128 cost of biosynthese (F. Stuart Chapin et al. 2011. &
+      ! Principles of terrestrial ecosystem ecology (page 159, table 6.1), Eglin et al. 2008. &  
+      ! Biochemical composition is not the main factor influencing variability in carbon isotope composition of tree rings)
+      nsc_sap_refill = AMAX1(0.00001,p%coh%x_nsc_sap_max - p%coh%x_nsc_sap) 
+      nsc_tb_refill  = AMAX1(0.00001,p%coh%x_nsc_tb_max - p%coh%x_nsc_tb) 
+      nsc_crt_refill = AMAX1(0.00001,p%coh%x_nsc_crt_max - p%coh%x_nsc_crt)
+      bioscost_sap = 0.128*nsc_sap_refill
+      bioscost_tb = 0.128*nsc_tb_refill
+      bioscost_crt = 0.128*nsc_crt_refill
+      nsc_all_refill = nsc_sap_refill + nsc_tb_refill + nsc_crt_refill
+      bioscost_all = bioscost_sap + bioscost_tb + bioscost_crt
+      max_for_refill = 0.5*cpart*NPP
+      
+      if (nsc_all_refill .gt. 0.1) then
+        if (nsc_all_refill .gt. max_for_refill) then ! the half can be used for refilling, 
+         nsc_sap_refill = AMIN1(nsc_sap_refill, max_for_refill)
+         max_for_refill = max_for_refill - nsc_sap_refill
+         if (max_for_refill .gt. 0.0001) then
+          nsc_tb_refill = AMIN1(nsc_tb_refill, max_for_refill)
+          max_for_refill = max_for_refill - nsc_tb_refill
+         endif
+         if (max_for_refill .gt. 0.0001) then
+          nsc_crt_refill = AMIN1(nsc_crt_refill, max_for_refill)
+          max_for_refill = max_for_refill - nsc_crt_refill
+         endif 
+         bioscost_sap = 0.128*nsc_sap_refill
+         bioscost_tb = 0.128*nsc_tb_refill
+         bioscost_crt = 0.128*nsc_crt_refill
+         nsc_all_refill = nsc_sap_refill + nsc_tb_refill + nsc_crt_refill
+         bioscost_all = bioscost_sap + bioscost_tb + bioscost_crt
+        endif  !nsc_all_refill .gt. max_for_refill 
+      
+      p%coh%biocost_all = bioscost_all * 2. !*2 is conversion from kg C to kg DW
+      
+      NPP             = AMIN1(NPP - nsc_all_refill*2. - bioscost_all*2., NPP)    !*2 is conversion from kg C to kg DW
+      if (NPP .lt. 0.001) NPP=0.001
+      p%coh%x_nsc_sap = AMIN1(p%coh%x_nsc_sap + nsc_sap_refill, p%coh%x_nsc_sap_max)
+      p%coh%x_nsc_tb  = AMIN1(p%coh%x_nsc_tb + nsc_tb_refill, p%coh%x_nsc_tb_max)
+      p%coh%x_nsc_crt = AMIN1(p%coh%x_nsc_crt + nsc_crt_refill, p%coh%x_nsc_crt_max)
+      endif !nsc_all_refill>0
+       
+      write(8612,150) time, p%coh%ident, p%coh%ntreea, p%coh%NPP, NPP, p%coh%x_nsc_sap, p%coh%x_nsc_tb, p%coh%x_nsc_crt, nsc_sap_refill, nsc_tb_refill, nsc_crt_refill, bioscost_all
+      150 FORMAT (I4,2X,I4,2X,F5.1,2X,9(F12.4,2X))
+      
+      !second if disturbance took place this year --> NSC is used and added to NPP
+      if(looptrue .eq. .True.) then   ! hier abaendern fuer die zeit der verminderten NPP
+      !first determine the amount to take from nsc-pool
+        nsc_get  = 0.
+        nsc_plus = 0.
+        if (dis_control(1,1) .eq. 1) nsc_get = p%coh%x_fol_loss + nsc_get
+        if (dis_control(4,1) .eq. 1) nsc_get = p%coh%x_frt_loss + nsc_get
+        if (dis_control(2,1) .eq. 1) nsc_get = p%coh%NPP * p%coh%drindAl + nsc_get
+        !if (dis_control(3,1) .eq. 1) nsc_get = p%coh%x_phloem_loss + nsc_get
+        nsc_max = (p%coh%x_nsc_sap + p%coh%x_nsc_tb + p%coh%x_nsc_crt)*2. !*2 Umrechnung von kg C/tree zu kg DW/tree 
+        nsc_plus = AMIN1(nsc_get,nsc_max)
+       
+        NPP  = NPP + nsc_plus
+        
+        !third update of nsc storage in the three compartements
+        p%coh%x_nsc_sap = AMAX1(p%coh%x_nsc_sap - nsc_plus*cpart/3.0, 0.00001) !cpart Umrechnung von kg DW/tree zu kg C/tree
+        p%coh%x_nsc_tb  = AMAX1(p%coh%x_nsc_tb - nsc_plus*cpart/3.0, 0.00001)
+        p%coh%x_nsc_crt = AMAX1(p%coh%x_nsc_crt - nsc_plus*cpart/3.0, 0.00001)
+      endif  ! end NSC surplus if disturbance year
+     
+     p%coh%NPP = NPP !update NPP value
+     
+     write(8613,160) time, p%coh%ident, p%coh%ntreea, NPP, nsc_max, nsc_get, nsc_plus, p%coh%x_nsc_sap, p%coh%x_nsc_tb, p%coh%x_nsc_crt
+     160 FORMAT (I4,2X,I4,2X,F5.1,2X,7(F12.4,2X))
+     
+     else
+     write(*,*)' Attention:: NPP<=0 --> NSC-POOL not working!!!'
+     endif   ! NPP>0
+  end select
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      Gf = lambdaf * NPP
+      Gr = lambdar * NPP
+      Gs = lambdas * NPP
+      p%coh%gfol = Gf
+      p%coh%gfrt = Gr
+      p%coh%gsap = Gs
+      p%coh%x_crt  = p%coh%x_crt + Gs*spar(ns)%alphac*spar(ns)%cr_frac
+      p%coh%x_tb   = p%coh%x_tb  + Gs*spar(ns)%alphac*(1.-spar(ns)%cr_frac)
+
+      ! update of state vector
+      select case (flag_dis)
+!	     case (1,2)
+!	       if (looptrue .eq. .True.) then
+!	        FNew  = F + Gf !im Schadjahr Seneszenz nicht nochmal abziehen
+!	        SNew  = S + Gs - Ss
+!           RNew  = R + Gr !im Schadjahr Seneszenz nicht nochmal abziehen
+!           Hnew  = H + Ss
+!           AhbNew= Ahb + Asw*spar(ns)%pss
+!          else
+!           FNew  = F + Gf - Sf
+!           SNew  = S + Gs - Ss
+!           RNew  = R + Gr - Sr
+!           Hnew  = H + Ss
+!            AhbNew= Ahb + Asw*spar(ns)%pss
+!           endif
+	     case (0,1,2)
+	     FNew  = F + Gf - Sf
+         SNew  = S + Gs - Ss
+         RNew  = R + Gr - Sr
+         Hnew  = H + Ss
+         AhbNew= Ahb + Asw*spar(ns)%pss
+      end select
+         
+    !   geffhelp = Gs/Fnew
+    ! check whether height growth or not
+
+      IF (lambdas == 0.OR.FNew<Fmax) THEN  ! treat special case where there is no height growth
+        HtNew = Ht
+      ELSE
+      ! height growth depending on the relative light regime in the middle of the canopy
+        HtNew = Ht + growthrate * (FNew-Fmax)
+        Fmax=FNew
+      ENDIF
+        BNew = B+p%coh%deltaB
+
+      ! copy back to original variables
+      p%coh%Fmax = Fmax
+      p%coh%x_fol  = FNew
+      p%coh%x_sap  = SNew
+      p%coh%x_frt  = RNew
+      p%coh%x_hrt  = HNew
+      p%coh%height = HtNew
+      p%coh%x_hbole= BNew
+      p%coh%x_Ahb  = AhbNew
+	  
+	  !Update of the maximum NSC storage capacity
+      select case(flag_dis)
+       case(2)
+         treegroup_decid = .False.
+            do i = 1, 5
+              if (decidous(i) .eq. p%coh%species) then
+               treegroup_decid = .True.
+               exit
+              endif
+            end do
+         If (treegroup_decid .eq. .True.) then
+           p%coh%x_nsc_sap_max = p%coh%x_sap * decid_sap_allo * cpart
+           p%coh%x_nsc_tb_max = p%coh%x_tb * decid_tb_allo * cpart
+           p%coh%x_nsc_crt_max = p%coh%x_crt * decid_crt_allo * cpart
+           p%coh%x_nsc_sap = AMIN1(p%coh%x_nsc_sap,p%coh%x_nsc_sap_max)  ! has to change because of carbon inconsistency carbon loss due to sap shrinking is not accounted
+           p%coh%x_nsc_tb = AMIN1(p%coh%x_nsc_tb,p%coh%x_nsc_tb_max) 
+           p%coh%x_nsc_crt = AMIN1(p%coh%x_nsc_crt,p%coh%x_nsc_crt_max)
+         endif
+         If (treegroup_decid .eq. .False.) then
+           p%coh%x_nsc_sap_max = p%coh%x_sap * conif_sap_allo * cpart
+           p%coh%x_nsc_tb_max = p%coh%x_tb * conif_tb_allo * cpart
+           p%coh%x_nsc_crt_max = p%coh%x_crt * conif_crt_allo * cpart
+           p%coh%x_nsc_sap = AMIN1(p%coh%x_nsc_sap,p%coh%x_nsc_sap_max)
+           p%coh%x_nsc_tb = AMIN1(p%coh%x_nsc_tb,p%coh%x_nsc_tb_max) 
+           p%coh%x_nsc_crt = AMIN1(p%coh%x_nsc_crt,p%coh%x_nsc_crt_max)
+         endif
+         write(8614,170) time, p%coh%ident, p%coh%ntreea, p%coh%x_nsc_sap_max, p%coh%x_nsc_tb_max, p%coh%x_nsc_crt_max
+         170 FORMAT (I4,2X,I4,2X,F5.1,2X,3(F12.4,2X))
+      end select  
+  
+  CALL CALC_DBH(BNew,Htnew,Snew,Hnew,Ahbnew,p%coh%Ahc,p%coh%ident,DBH,p%coh%dcrb,hs,Asw)
+  if (flag_end.eq.1) then
+      DBH = p%coh%diam
+      p%coh%notViable = .TRUE.
+      flag_end = 0
+  end if
+
+  ! Monitoring of current values
+  if (time_out .gt. 0 .and. flag_cohout .eq. 2) then
+     CALL OUT_ALL( p%coh%ident, p%coh%ntreea, NPP, DBH, growthrate,Fnew,Fmax_old,Htnew, lambdaf,lambdas,lambdar,lambdac,x1,x2,p%coh%x_nsc_sap_max, p%coh%x_nsc_tb_max, p%coh%x_nsc_crt_max, p%coh%x_nsc_sap, p%coh%x_nsc_tb, p%coh%x_nsc_crt)
+  endif
+
+
+  p%coh%x_hsap = hs
+  p%coh%diam   = DBH  !  This is the new value
+  p%coh%Asapw  = Asw
+
+  p%coh%jrb = (DBH-DBH_help)*10/2
+  
+  if(((DBH-DBH_help)*10/2).lt.0.) p%coh%jrb = 0.
+  
+  ! variables required by mortality submodel
+  p%coh%fol_inc  = Gf - Sf
+  p%coh%bio_inc  = NPP - Sf - (1.+spar(ns)%alphac)*Ss - Sr
+  p%coh%stem_inc = Gs         ! deltaH + deltaS = Ss + Gs - Ss
+  p%coh%frt_inc = Gr - Sr     ! fine root increment
+  p%coh%totBio = p%coh%x_fol + (1.+spar(ns)%alphac)*(p%coh%x_sap + p%coh%x_hrt) + p%coh%x_frt
+  p%coh%notViable = (FNew <= 0.) .OR. (SNew <= 0.) .OR.    &
+                    (RNew <= 0.) .OR. (Htnew <= Bnew)
+
+! Nitrogen dynamics:
+  leaf_N_conc = p%coh%N_fol/F
+
+! Simple model: all (sap)wood grows with CN-ratios of branches, twigs and coarse roots.  
+! When sapwood senesces N is reallocated and the new heart wood is at the level of stem CN-ratios.
+! Branches, twigs and coarse roots do not senesce
+
+! first step nitrogen related processes: N in litter, N-recallocation
+  p%coh%N_pool = p%coh%N_pool + Sf/F*p%coh%N_fol*spar(ns)%reallo_fol &
+                              + Sr*cpart/spar(ns)%cnr_frt*1000.* spar(ns)%reallo_frt &
+                              + Ss*cpart *1000. * (1/spar(ns)%cnr_tbc - 1/spar(ns)%cnr_stem)
+  p%coh%N_fol = p%coh%N_fol*(1-Sf/F)
+
+  ! New version: cpart = C:biomass = 0.5 (amod.par)
+  ! Summation, da Pool auch an anderen Stellen gefuellt wird
+   select case (flag_dis)
+	case (1,2)
+    p%coh%litC_fol  = p%coh%litC_fol +  p%coh%ntreea * Sf * cpart + p%coh%x_fol_loss * p%coh%ntreea * cpart
+    p%coh%litC_frt  = p%coh%litC_frt +  p%coh%ntreea * Sr * cpart + p%coh%x_frt_loss * p%coh%ntreea * cpart
+    case (0)
+    p%coh%litC_fol  = p%coh%litC_fol +  p%coh%ntreea * Sf * cpart
+    p%coh%litC_frt  = p%coh%litC_frt +  p%coh%ntreea * Sr * cpart
+  end select
+!  Sterblichkeit von sapwood fuert zu heartwood und nicht zur Litterproduktion
+!  p%coh%litC_tbc  = p%coh%litC_tbc +  p%coh%ntreea * spar(ns)%alphac*Ss * cpart
+
+  ! Species specific N content and reallocation factor (see species.par)
+  ! Caution: tbc mortallity is not a litter compartment; it is assigned as heartwood
+   p%coh%litN_fol  = p%coh%litN_fol + p%coh%ntreea * Sf * cpart * (1.-spar(ns)%reallo_fol) / spar(ns)%cnr_fol
+   p%coh%litN_frt  = p%coh%litN_frt +  p%coh%ntreea * Sr * cpart * (1.-spar(ns)%reallo_frt) / spar(ns)%cnr_frt
+
+  ! second step: allocation of N to new growth
+  ! before bud-break allocation to leaves is 50% of the N content of last years foliage
+  tbc_root_Ndemand = Gs*cpart *kg_in_g / spar(ns)%cnr_tbc + Gr* cpart/spar(ns)%cnr_frt*kg_in_g
+  IF(tbc_root_Ndemand + Gf*p%coh%med_sla*0.5 > p%coh%N_pool) THEN
+     if (tbc_root_Ndemand .gt. 1E-8) then
+        Nredfak = AMAX1((p%coh%N_pool-Gf*p%coh%med_sla*0.5) / tbc_root_Ndemand,0.)   ! Division by zero possible 
+     else
+        Nredfak = 0.
+     endif
+     tbc_root_Ndemand = tbc_root_Ndemand*Nredfak
+  ENDIF
+     p%coh%N_pool = p%coh%N_pool - tbc_root_Ndemand
+     IF(p%coh%N_pool < Gf*0.5*leaf_N_conc) THEN
+        p%coh%N_fol = p%coh%N_fol + p%coh%N_pool
+        p%coh%N_pool = 0.
+     ELSE
+        p%coh%N_fol = p%coh%N_fol + Gf*0.5*leaf_N_conc
+        p%coh%N_pool = p%coh%N_pool - Gf*0.5*leaf_N_conc
+     ENDIF
+end if
+
+END SUBROUTINE PARTITION
+
+!*******************************!
+!*   SUBROUTINE PARTITION_SV   *!
+!*******************************!
+
+SUBROUTINE PARTITION_SV( p )
+
+  !*** Declaration part ***!
+  USE data_par
+  USE data_stand
+  USE data_species
+  USE data_simul
+
+  IMPLICIT NONE
+
+  REAL   :: lambdaf = 0.,  &      ! partitioning functions
+            lambdas = 0.,  &
+            lambdar = 0.,  &
+            NPP = 0.,      &      ! annual NPP
+            F = 0.,        &      ! state variables: foliage,
+            S = 0.,        &      ! sapwood,
+            R = 0.,        &      ! fine roots,
+            Ht = 0.,       &      ! total tree height
+            FNew, SNew,    &      ! new states
+            RNew,          &
+            sigmaf = 0.,   &      ! current leaf activity rate
+            sigman = 0.           ! current root activity rate
+  REAL  ::  Sf,            &      ! senescence rates
+            Ss,            &
+            Sr,            &
+            Gf,            &      ! growth rates
+            Gs,            &
+            Gr
+
+  REAL  ::  FRsum
+
+  REAL  ::  tbc_root_Ndemand, &   ! N demand for ghrowth of fine roots, branches and coarse roots g tree-1
+            Nredfak               ! reduction factor for N allocation to fine roots, branches and coarse roots
+
+  REAL, EXTERNAL  ::  f_lf, df_lf, ddf_lf
+
+  INTEGER :: flag_SV_allo,  &
+             rnum
+
+  TYPE(Coh_Obj) :: p       ! pointer to cohort list
+
+  ns   = p%coh%species
+  F    = p%coh%x_fol
+  S    = p%coh%x_sap
+  R    = p%coh%x_frt
+  NPP  = p%coh%NPP
+  Ht   = p%coh%height
+  Sf   = p%coh%sfol
+  Ss   = p%coh%ssap
+  Sr   = p%coh%sfrt
+
+  ! choice of allocation model. 0 = constant allocation factors, 1 = allometric model
+  flag_SV_allo = 1
+
+  ! only allocate if enough NPP is available
+  IF (NPP>1.0E-9) THEN
+
+     ! calculate leaf activity based on net PS and leaf mass
+     sigmaf = NPP/F
+
+     ! calculate root activity based on drought index
+! test of a relationship which modifies fine root leaf ratio with shade tolerance
+      IF (flag_sign.eq.1) THEN
+         sigman = amax1(spar(ns)%sigman*10*(((5.-spar(ns)%stol)*1.-p%coh%crown_area)/(5.-spar(ns)%stol)*1.),spar(ns)%sigman) * p%coh%drIndAl / p%coh%nDaysGr
+      ELSE
+         sigman = spar(ns)%sigman * p%coh%drIndAl / p%coh%nDaysGr
+      END IF
+  M_avail=(NPP+F-Sf+R-Sr+S-Ss)/kpatchsize
+
+  IF(flag_SV_allo==0) THEN
+  ! the parameters pdiam in the species.par file are used for allocation fractions
+     lambdaf=spar(ns)%pdiam1
+     lambdar=spar(ns)%pdiam2
+     lambdas=spar(ns)%pdiam3 
+  ELSE  
+     FRsum=(F+R)/kpatchsize  
+     CALL newt (FRsum, f_lf, df_lf, ddf_lf, 1.e-6, 100, rnum)
+     IF(FRsum>M_avail .and. .not.flag_mult8910) CALL error_mess(time,'no solution found for allocation for groundvegetation cohort, rnum: ',real(rnum))
+     IF(rnum==-1) THEN
+        if (.not.flag_mult8910) CALL error_mess(time,'no solution found for allocation for groundvegetation cohort: ',real(p%coh%ident))
+        lambdaf=0.4
+        lambdar=0.4
+        lambdas=0.2 
+     ELSE
+        lambdaf=(FRsum)/M_avail/2.
+        lambdar=(FRsum)/M_avail/2.
+        lambdas=1.-lambdaf-lambdar
+     ENDIF
+  ENDIF 
+
+  END IF   ! IF NPP < 1.0E-09
+
+  ! gross growth rates of compartments
+
+  Gf = lambdaf * M_avail*kpatchsize -F +Sf
+  Gr = lambdar * M_avail*kpatchsize -R +Sr
+  Gs = lambdas * M_avail*kpatchsize -S +Ss
+
+! preliminary solution for permanent seeding
+  IF(lambdaf * M_avail < 1.e-4) THEN
+     Gf = Gf + 1.e-4*kpatchsize
+  ENDIF
+
+  p%coh%gfol = Gf
+  p%coh%gfrt = Gr
+  p%coh%gsap = Gs
+
+  ! update of state vector
+  FNew  = F + Gf - Sf
+  SNew  = S + Gs - Ss
+  RNew  = R + Gr - Sr
+  p%coh%x_fol  = FNew
+  p%coh%x_sap  = SNew
+  p%coh%x_frt  = RNew
+
+  ! determine litter production from plant turnover rates
+  ! first step nitrogen related processes: N in litter, N-recallocation
+  p%coh%N_pool = p%coh%N_pool + Sf/F*p%coh%N_fol*spar(ns)%reallo_fol &
+                              + Sr*cpart/spar(ns)%cnr_frt*1000.* spar(ns)%reallo_frt &
+                              + Ss*cpart *1000. * (1/spar(ns)%cnr_tbc - 1/spar(ns)%cnr_stem)
+  p%coh%N_fol = p%coh%N_fol*(1-Sf/F)
+
+  ! Summation, due to the filling of the pool at other points as well
+  p%coh%litC_fol  = p%coh%litC_fol +  p%coh%ntreea * Sf * cpart
+  p%coh%litC_frt  = p%coh%litC_frt +  p%coh%ntreea * Sr * cpart
+
+  ! New version with species specific N content and reallocation factor (see species.par) 
+  ! changed to 1-reallo 
+   p%coh%litN_fol  = p%coh%litN_fol + p%coh%ntreea * Sf * cpart * (1.-spar(ns)%reallo_fol) / spar(ns)%cnr_fol
+   p%coh%litN_frt  = p%coh%litN_frt +  p%coh%ntreea * Sr * cpart * (1.-spar(ns)%reallo_frt) / spar(ns)%cnr_frt
+
+  ! second step: allocation of N to new growth
+  ! before bud-break allocation to leaves is 50% of the N content of last years foliage
+  tbc_root_Ndemand = Gs*cpart *kg_in_g / spar(ns)%cnr_tbc + Gr* cpart/spar(ns)%cnr_frt*kg_in_g
+  IF(tbc_root_Ndemand + Gf*p%coh%med_sla*0.5 > p%coh%N_pool) THEN
+     if (tbc_root_Ndemand .gt. 1E-8) then
+        Nredfak = AMAX1((p%coh%N_pool-Gf*p%coh%med_sla*0.5) / tbc_root_Ndemand,0.)   ! Div. by zero possible !
+     else
+        Nredfak = 0.
+     endif
+     tbc_root_Ndemand = tbc_root_Ndemand*Nredfak
+  ENDIF
+     p%coh%N_pool = p%coh%N_pool - tbc_root_Ndemand
+
+    END SUBROUTINE PARTITION_SV
+
+!*******************************!
+!*   SUBROUTINE PARTITION_MI   *!
+!*******************************!
+
+SUBROUTINE PARTITION_MI( p )
+  !*** Declaration part ***!
+  USE data_par
+  USE data_stand
+  USE data_simul
+  IMPLICIT NONE
+  TYPE(Coh_Obj) :: p       ! pointer to cohort list
+  !no partitioning, foliage mass keeps constant
+  p%coh%x_fol  = p%coh%x_fol !  !FNew
+  p%coh%x_sap  = 0.!SNew
+  p%coh%x_frt  = 0.!RNew
+END SUBROUTINE PARTITION_MI
+
+!***************************!
+! FUNCTION f_lf            *!
+!***************************!
+
+REAL FUNCTION f_lf(x)
+  USE data_stand
+  USE data_plant
+  REAL :: x
+  f_lf = ksi*x**kappa + x - M_avail 
+END ! FUNCTION f_lf
+
+!***************************!
+! FUNCTION df_lf           *!
+!***************************!
+
+REAL FUNCTION df_lf(x)
+  USE data_stand
+  USE data_plant
+  REAL :: x
+  df_lf = ksi*kappa*x**(kappa-1.) + 1. 
+END ! FUNCTION df_lf
+
+!***************************!
+! FUNCTION ddf_lf          *!
+!***************************!
+
+REAL FUNCTION ddf_lf(x)
+  USE data_stand
+  USE data_plant
+  REAL :: x
+  ddf_lf = ksi*kappa*(kappa-1.)*x**(kappa-2.) 
+END ! FUNCTION ddf_lf
+
+!***************************!
+! SUBROUTINE CALC_DBH      *!
+!***************************!
+SUBROUTINE CALC_DBH(B, Ht, S, H, Ahb, Ahc, ident, dbh, dc, hs, Asw)
+
+  !*** Declaration part ***!
+
+USE data_par
+USE data_species
+USE data_simul
+
+IMPLICIT NONE
+
+INTEGER :: ident
+
+REAL :: Dc         ! diameter at crown base
+REAL :: B,   &     ! bole height,
+        Ht,  &     ! total tree height
+        S,   &     ! sapwood
+        H,   &     ! heartwood
+        hs,  &     ! sapwood height
+        D,   &     ! stem diameter at forest floor
+        DBH, &     ! tree diameter at breast height
+        Ahb, &     ! cross sectional area heartwood at tree base
+        Ahc, &     ! cross sectional area of heartwood at crown base
+        Asw, &     ! cross sectional area of sapwood in bole
+        discr, func, help, hp1, hp2,hp3, hp4
+REAL :: fp, fq,  & ! coefficients of quadratic equation
+        w1, w2,  & ! solutions of quadratic equation
+        precision  ! criterion for acceptance of solution
+real  :: sprhos    ! sapwood density [kg/cm3] 
+
+  !*** Calculation part ***!
+
+  precision = 1.e-5
+  sprhos = spar(ns)%prhos
+! calculate Diameters
+      hs = (2*B +Ht)/3.
+     Asw = S/(spar(ns)%prhos*hs)
+
+! if Bole height >= height trees are dead and calculations not required
+  IF(B .lt. Ht) THEN
+     select case (flag_volfunc) 
+     case (0)         
+        D   = SQRT( (S+H)*4. / (sprhos*hs*pi) )
+        IF (Ht<h_breast) THEN
+           DBH = 0.0
+        ELSEIF (Ht>h_breast.and.B<h_breast) then
+           DBH=D-(D/(Ht-B))*(h_breast-B)
+        ELSE
+           DBH=D
+        ENDIF
+
+     case (1)
+       D = SQRT((Ahb+Asw)*4./pi)
+     ! if Bole height = 0 then there is no need to calulate Diameter at crown base and Dc = D
+       IF(B.EQ.0.) THEN
+          Dc = D
+       ELSE
+          fp  = -2. * (B/Ht) * (3.*H/(sprhos*B)-Ahb)-Ahb*(B/Ht)**2.
+          fp  = -2. * B/Ht * (3.*H/(sprhos*B)-Ahb)-Ahb*(B/Ht)**2.
+          fq    = ((3.*H/(sprhos) - Ahb*B) / Ht)**2.
+          discr = fp**2./4.-fq
+          if (abs(discr) .lt. zero) then
+            discr = zero      ! avoid small values
+          endif
+         ! No solution
+          if(discr.lt.0) then
+            if (.not.flag_mult8910) then
+               CALL error_mess(time,'discriminant < 0 in calc_dbh for cohort: ',real(ident))
+               CALL stop_mess(time,'discriminant < 0 in calc_dbh ')
+               CALL error_mess(time,'stop in calc_dbh for stand No: ',real(ip))
+               CALL error_mess(time,'heart wood mass H: ',H)
+               CALL error_mess(time,'bole height b: ',b)
+               CALL error_mess(time,'height Ht: ',Ht)
+               CALL error_mess(time,'ave. sapwood height hs: ',hs)
+               CALL error_mess(time,'sapwood area Asw: ',Asw)
+               CALL error_mess(time,'heartwood area at stem base Ahb: ',Ahb)
+            endif
+            flag_end = 1
+            return
+          end if
+
+          discr = SQRT(discr)
+          w1    = -fp/2. + discr
+          w2    = -fp/2. - discr
+1313      hp1 = SQRT(w1*Ahb)
+          hp2 = (Ahb+SQRT(w1*Ahb))*B
+          hp3 = (w1*Ht + (Ahb+SQRT(w1*Ahb))*B)
+          help = (sprhos/3.) * (w1*Ht + (Ahb+SQRT(w1*Ahb))*B)
+          func  = (sprhos/3.) * (w1*Ht + (Ahb+SQRT(w1*Ahb))*B) - H
+          hp4= H* precision
+          IF(abs(func) <= H * precision) THEN
+            Ahc = w1
+            if (.not.flag_mult8910) then
+                CALL error_mess(time,' positive root is a solution in calc_dbh for cohort: ',real(ident))
+                CALL error_mess(time,'stop in calc_dbh for stand No: ',real(ip))
+                CALL error_mess(time,'function: ',func)
+            endif
+            flag_end = 1
+            return
+          ELSE
+           func  = (sprhos/3.) * (w2*Ht + (Ahb+SQRT(w2*Ahb))*B) - H
+           IF(abs(func) <= H * precision) THEN
+              Ahc = w2
+           ELSE
+            IF(precision.LT.1e-2) THEN
+               precision = precision*10.
+               GOTO 1313
+                if (.not.flag_mult8910) then
+                   CALL error_mess(time,'no valid solution found in calc_dbh for heartwood geometry for cohort: ',real(ident))
+                   CALL error_mess(time,': heart wood mass, H = ',H)
+                   CALL error_mess(time,': precision requirement = ',precision)
+                   CALL error_mess(time,'iteration in stand No: ',real(ip))
+                endif           
+            ELSE
+                if (.not.flag_mult8910) then
+                   CALL error_mess(time,'no valid solution found in calc_dbh for heartwood geometry for cohort: ',real(ident))
+                   CALL stop_mess(time,'no valid solution found in calc_dbh for heartwood geometry')
+                   CALL error_mess(time,'species No: ',real(ns))
+                   CALL error_mess(time,'stop in calc_dbh for stand No: ',real(ip))
+                   CALL error_mess(time,'precision requirement H*precision ',H*precision)
+                   CALL error_mess(time,'heart wood mass H: ',H)
+                   CALL error_mess(time,'bole height b: ',b)
+                   CALL error_mess(time,'height Ht: ',Ht)
+                   CALL error_mess(time,'ave. sapwood height hs: ',hs)
+                   CALL error_mess(time,'sapwood area Asw: ',Asw)
+                   CALL error_mess(time,'heartwood area at stem base Ahb: ',Ahb)
+                endif           
+               flag_end = 1
+              return
+            ENDIF
+           ENDIF
+          ENDIF
+          Dc  = SQRT((Ahc+Asw)*4./pi)
+       END IF
+       if (Ht<=h_breast) then
+           DBH = 0.0
+       else if (Ht>h_breast.and.B<h_breast) then
+           DBH=Dc*(Ht-h_breast)/(Ht-B)
+       else
+           DBH=D-(D-Dc)*h_breast/B
+       end if
+     end select
+  ELSE
+       if (.not.flag_mult8910) then
+           CALL error_mess(time,'no calculation of heartwood geometry for cohort (Bole height >= height trees are dead): ',real(ident))
+           CALL error_mess(time,'bole height: ',b)
+           CALL error_mess(time,'height: ',Ht)
+       endif
+  END IF ! if B > Ht
+
+END SUBROUTINE CALC_DBH

source_code/version_2.3_windows/pheno.f

+!*****************************************************************!
+!*                                                               *!
+!*                    4C  Simulation Model                       *!
+!*                                                               *!
+!*                                                               *!    
+!*                    Subroutines for:                           *!
+!*       Simulation of processes at subannual resolution         *!
+!*                                                               *!
+!* Contains subroutines:                                         *!
+!*                                                               *!
+!* - pheno_ini                                                   *!
+!* - pheno_begin                                                 *!
+!* - pheno_count                                                 *!
+!* - pheno_shed                                                  *!
+!*                                                               *!
+!*  functions:                                                   *!
+!*    triangle                                                   *!
+!*                                                               *!
+!*                  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 pheno_ini
+
+  USE data_climate
+  USE data_simul
+  USE data_site
+  USE data_species
+  USE data_stand
+
+  IMPLICIT NONE
+
+  integer i, j
+  integer leapyear
+  real atemp, hh, htemp
+  real triangle
+  real, external :: daylength
+
+  leaves_on = .false.
+  all_leaves_on = 0
+  phen_flag=1  ! CANOPY is calculated once at the beginning of each year
+
+! Initialising of all species is done at the beginning, since if species information wouldnt be initialised
+ IF(time==1) THEN
+    do i=1,nspec_tree
+        ns = i
+        IF(spar(ns)%Phmodel==1) THEN
+            svar(ns)%Pro = 0.
+            svar(ns)%Inh = 1.
+        ELSE
+            svar(ns)%Pro   = 0.
+            svar(ns)%Inh   = 0.
+            svar(ns)%Tcrit = 0.
+        END IF
+
+!   initialize pheno state variables with climate from the actual year
+        do j = spar(ns)%end_bb+1, 365
+
+          atemp = tp(j, 1)
+          hh = DAYLENGTH(j,lat)
+          SELECT CASE(ns)
+          CASE(1,8)
+          !Fagus
+            ! Promotor-Inhibitor model 11
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa*  &
+                     triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,atemp)*  &
+                              (1-svar(ns)%Inh)*hh/24 - &
+                              spar(ns)%PPb*svar(ns)%Pro*(24-hh)/24
+
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa*  &
+                      triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,atemp)*  &
+                      svar(ns)%Inh*hh/24
+
+          CASE(4)
+          ! Quercus
+            ! Promotor-Inhibitor model 12
+                     htemp = triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,atemp)
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa * htemp *     &
+                              (1-svar(ns)%Inh) * hh/24
+
+                      htemp = triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,atemp)
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa * htemp * &
+                                     svar(ns)%Inh * hh/24 + spar(ns)%PPb*(24-hh)/24
+
+          CASE(5, 11)
+          ! Betula, Robinia
+                  IF(spar(ns)%Phmodel==1) THEN
+                  ! Promotor-Inhibitor model 2
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa*  &
+                     triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,atemp)*  &
+                              (1-svar(ns)%Inh) - spar(ns)%PPb*svar(ns)%Pro*(24-hh)/24
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa*  &
+                      triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,atemp)*svar(ns)%Inh
+
+                  END IF
+
+          END SELECT
+        enddo  ! j   
+     Enddo    ! nspec_tree
+ END IF
+
+! latest day of bud burst 30. of June (DOY 181+leapyear(time_cur))
+  do i=1, anrspec
+     ns = nrspec(i)
+	 if(ns.le.nspec_tree) then 
+         IF(spar(ns)%phmodel==4) THEN
+            svar(ns)%daybb = svar(ns)%ext_daybb
+         ELSE
+            svar(ns)%daybb = 181 + leapyear(time_cur)
+         ENDIF
+     end if
+  END DO    ! anrspec
+
+end SUBROUTINE pheno_ini
+
+!*******************************************************************
+
+SUBROUTINE pheno_begin
+! calculation of day_bb, latest day of bud burst 30. june (DOY 181)
+  USE data_simul
+  USE data_species
+  USE data_stand
+  USE data_climate
+  USE data_site
+  IMPLICIT NONE
+
+  REAL triangle
+  INTEGER leapyear
+  real hh, htemp
+  integer i
+  
+  hh = dlength
+  do i=1, anrspec
+     ns = nrspec(i)
+
+if (iday .ge.364) then
+continue
+endif
+
+    if(ns.le.nspec_tree .OR. ns.eq.nspec_tree+2) then       !either tree or mistletoe
+    ! Pheno model
+      select Case (spar(ns)%Phmodel)
+      Case(0)   ! no model
+          !Picea, Pinus, Mistletoe
+
+              IF(iday.EQ.1) THEN
+                  svar(ns)%daybb = iday
+                  phen_flag      = 1
+                  leaves_on      = .TRUE.
+              ENDIF
+      
+      Case(1)
+     ! Phenology starts after leaf coloring/shedding and ends not later than 30. June
+        IF (iday > spar(ns)%end_bb+1 .OR. iday <= svar(ns)%daybb) THEN
+
+          SELECT CASE(ns)
+          CASE(1,8)
+          !Fagus
+            ! Promotor-Inhibitor model 11
+
+                     htemp = triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,airtemp)
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa * htemp * &
+                              (1-svar(ns)%Inh) * dlength/24 - &
+                              spar(ns)%PPb*svar(ns)%Pro * (24-dlength)/24
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa*&
+                      triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,airtemp)*&
+                      svar(ns)%Inh*dlength/24
+
+                      IF (svar(ns)%Pro >= 1) THEN
+                          svar(ns)%daybb=iday
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      ELSE IF (svar(ns)%Pro < 1 .AND. iday==svar(ns)%daybb) THEN
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      END IF
+          CASE(4)
+          ! Quercus
+            ! Promotor-Inhibitor model 12
+
+                  all_leaves_on=0
+
+                    if (svar(ns)%Inh .gt. 1.) then
+                        continue
+                        svar(ns)%Inh = 1.
+                    endif   
+                    if (svar(ns)%Pro .lt. 0.) then
+                        continue
+                        svar(ns)%Pro = 0.
+                     endif
+                     htemp = triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,airtemp)
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa * htemp *     &
+                              (1-svar(ns)%Inh) * dlength/24
+                     htemp = triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,airtemp)
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa * htemp * &
+                                     svar(ns)%Inh * dlength/24 + spar(ns)%PPb*(24-dlength)/24
+
+                      IF (svar(ns)%Pro >= 1) THEN
+                          svar(ns)%daybb=iday
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      ELSE IF (svar(ns)%Pro < 1 .AND. iday==svar(ns)%daybb) THEN
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      END IF
+   
+          CASE(5, 11)
+          ! Betula, Robinia
+
+                  all_leaves_on=0
+
+                  IF(spar(ns)%Phmodel==1) THEN
+                  ! Promotor-Inhibitor model 2
+
+                     svar(ns)%Pro = svar(ns)%Pro + spar(ns)%PPa*  &
+                     triangle(spar(ns)%PPtmin,spar(ns)%PPtopt,spar(ns)%PPtmax,airtemp)*  &
+                              (1-svar(ns)%Inh) - spar(ns)%PPb*svar(ns)%Pro*(24-dlength)/24
+                      svar(ns)%Inh = svar(ns)%Inh - spar(ns)%PIa*  &
+                      triangle(spar(ns)%PItmin,spar(ns)%PItopt,spar(ns)%PItmax,airtemp)*svar(ns)%Inh
+
+                      IF (svar(ns)%Pro >= 1) THEN
+                          svar(ns)%daybb=iday
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      ELSE IF (svar(ns)%Pro < 1 .AND. iday==svar(ns)%daybb) THEN
+                          phen_flag = 1
+                          leaves_on=.TRUE.
+                      END IF
+                  END IF
+
+          END SELECT 
+        Endif 
+        
+      Case(2)   
+      ! Cannel-Smith model
+
+        IF(iday >= 305 + leapyear(time_cur) .OR. iday <= svar(ns)%daybb) THEN
+          IF(airtemp < spar(ns)%CSTbC) THEN
+              svar(ns)%Inh = svar(ns)%Inh + 1
+              svar(ns)%Tcrit = spar(ns)%CSa + spar(ns)%CSb*LOG(svar(ns)%Inh)
+          END IF
+
+          IF(airtemp > spar(ns)%CSTbT .AND. iday >= 32 .AND. iday <= svar(ns)%daybb) THEN
+              svar(ns)%Pro = svar(ns)%Pro + airtemp - spar(ns)%CSTbT;
+          END IF
+
+          IF(svar(ns)%Pro > svar(ns)%Tcrit) THEN
+              svar(ns)%daybb=iday
+              phen_flag = 1
+              leaves_on=.TRUE.
+          ELSE IF (svar(ns)%Pro < svar(ns)%Tcrit .AND. iday==svar(ns)%daybb) THEN
+              phen_flag = 1
+              leaves_on=.TRUE.
+          END IF
+        END IF
+        
+      Case(3)
+      ! Temperature sum model
+
+          SELECT CASE(ns)
+          CASE(11)
+          ! Robinia
+            IF(iday >= spar(ns)%Lstart .AND. iday <= svar(ns)%daybb) THEN
+              IF(airtemp > spar(ns)%LTbT) THEN
+                  svar(ns)%Pro = svar(ns)%Pro + airtemp
+              END IF
+
+              IF(svar(ns)%Pro > spar(ns)%LTcrit) THEN
+                  svar(ns)%daybb=iday
+                  phen_flag = 1
+                  leaves_on=.TRUE.
+              ELSE IF (svar(ns)%Pro < spar(ns)%LTcrit .AND. iday==svar(ns)%daybb) THEN
+                  phen_flag = 1
+                  leaves_on=.TRUE.
+              END IF
+            END IF
+
+          CASE default
+            IF(iday >= spar(ns)%Lstart .AND. iday <= svar(ns)%daybb) THEN
+              IF(airtemp > spar(ns)%LTbT) THEN
+                  svar(ns)%Pro = svar(ns)%Pro + airtemp - spar(ns)%LTbT
+              END IF
+
+              IF(svar(ns)%Pro > spar(ns)%LTcrit) THEN
+                  svar(ns)%daybb=iday
+                  phen_flag = 1
+                  leaves_on=.TRUE.
+              ELSE IF (svar(ns)%Pro < spar(ns)%LTcrit .AND. iday==svar(ns)%daybb) THEN
+                  phen_flag = 1
+                  leaves_on=.TRUE.
+              END IF
+            END IF
+          END SELECT 
+
+      Case(4)
+      ! externally prescribed day of budburst
+        IF(iday==svar(ns)%daybb) THEN
+              phen_flag = 1
+              leaves_on=.TRUE.
+         
+        END IF 
+
+      Case default
+
+          IF(iday.EQ.1) THEN
+              svar(ns)%daybb=iday
+              phen_flag=1
+              leaves_on=.TRUE.
+          ENDIF
+      end select  
+
+	else if(iday==svar(ns)%daybb) then
+		     phen_flag = 1
+		     leaves_on=.TRUE.
+	end if
+
+  END DO
+
+    zeig=>pt%first    
+    do while (associated(zeig))
+        ns = zeig%coh%species 
+        zeig%coh%day_bb = svar(ns)%daybb
+        zeig=>zeig%next
+    enddo
+
+END SUBROUTINE pheno_begin
+
+!*******************************************************************
+
+SUBROUTINE pheno_count
+USE data_simul
+USE data_species
+USE data_stand
+IMPLICIT NONE
+
+zeig=>pt%first
+DO
+   if(.not. associated(zeig)) exit
+    ! vegetation period per PS-time step and per season
+    IF((iday >= zeig%coh%day_bb) .AND. (iday <= spar(zeig%coh%species)%end_bb)) THEN
+        zeig%coh%nDaysPS = zeig%coh%nDaysPS + 1. ! set to 0 in npp
+        zeig%coh%nDaysGr = zeig%coh%nDaysGr + 1. ! set to 0 year_ini
+    END IF
+
+    zeig=>zeig%next
+
+END DO
+
+END SUBROUTINE pheno_count
+
+!*******************************************************************
+
+SUBROUTINE pheno_shed
+
+  USE data_simul
+  USE data_species
+  USE data_stand
+
+  IMPLICIT NONE
+
+  integer i
+
+  leaves_on=.FALSE.
+  all_leaves_on=1
+  DO i=1, anrspec
+     ns = nrspec(i)
+     
+         IF(iday == spar(ns)%end_bb +1) THEN
+            phen_flag=1
+            all_leaves_on=0
+
+            ! reset pheno state variable
+            IF(spar(ns)%Phmodel==1) THEN
+                svar(ns)%Pro = 0.
+                svar(ns)%Inh = 1.
+            ELSE
+                svar(ns)%Pro   = 0.
+                svar(ns)%Inh   = 0.
+                svar(ns)%Tcrit = 0.
+            END IF
+         ELSE IF((iday < svar(ns)%daybb) .OR. (iday > spar(ns)%end_bb)) THEN
+             all_leaves_on=0
+         ELSE IF((iday >= svar(ns)%daybb) .AND. (iday <= spar(ns)%end_bb)) THEN
+             leaves_on=.TRUE.
+         END IF
+  END DO
+END SUBROUTINE pheno_shed
+
+!*******************************************************************
+
+FUNCTION triangle(min,opt,max,x)
+
+  REAL :: min,opt,max,x,triangle
+
+  IF( min <= x .AND. x <= opt) THEN
+      triangle = (x - min)/(opt - min)
+  ELSE IF( opt < x .AND. x <= max) THEN
+      triangle = (max - x)/(max - opt)
+  ELSE
+      triangle = 0
+  END IF
+
+END FUNCTION triangle
+
+FUNCTION leapyear(year)
+    INTEGER :: year,leapyear
+
+    IF( MOD(year,400)==0 .OR. ( MOD(year,100)/=0 .AND. MOD(year,4)==0 )) THEN
+        leapyear = 1
+    ELSE
+        leapyear = 0
+    END IF
+
+END FUNCTION leapyear
+

source_code/version_2.3_windows/planting.f

+!*****************************************************************!
+!*                                                               *!
+!*                      4C (FORESEE)                             *!
+!*                                                               *!
+!*                                                               *!
+!*             Subroutines for planting                          *!
+!*                                                               *!
+!*             contains:                                         *!
+!*             SR planting                                       *!
+!*             function sapwood                                  *!
+!*             SR gener_coh                                      *!
+!*                                                               *!
+!*   comment: planting is controlled by the flag flag_reg,       *!
+!*            soe standardized planting ensembles are definded   *!
+!*                                                               *!
+!*                  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 planting
+ USE data_stand
+ USE data_simul
+ USE data_species
+ USE data_soil
+ USE data_help
+ USE data_plant
+ USE data_manag
+ use data_wpm
+
+ IMPLICIT NONE
+ integer    :: nplant,       &
+               taxid,        &
+               i,j,nr,       &
+               taxnum,       &
+               outunit, ctrlunit
+ real       :: age,          &
+               pl_height,    &
+               sdev,         &
+               plhmin,       &
+               rsap,         &
+               hbc,           &
+               bhd,           &
+               cform,         &
+               hlp_lai,       &
+               rednpl_sh
+
+real         :: rtflsp, sapwood, height, plots
+integer, dimension(nspec_tree) :: infhelp
+character(80)          :: infile
+character              :: text
+ CHARACTER :: source
+integer                :: inunit,ios
+integer                :: parunit
+integer                :: nkoh, nplanth, numb
+
+REAL p0(nspec_tree),p1(nspec_tree),p2(nspec_tree),p3(nspec_tree),p4(nspec_tree), &
+       c1(nspec_tree),c2(nspec_tree),ku_a0(nspec_tree),ku_a1(nspec_tree),ku_a2(nspec_tree),&
+       ku_b0(nspec_tree),ku_b1(nspec_tree),ku_b2(nspec_tree),ku_c0(nspec_tree),&
+       ku_c1(nspec_tree),ku_c2(nspec_tree),wei_k1(nspec_tree),wei_k2(nspec_tree)
+real      :: crown_base, crown_base_eg
+TYPE(cohort)    ::tree_ini
+
+real corr_la
+real      :: troot2
+
+real, dimension(20)   :: hhei
+
+external sapwood
+external rtflsp
+ do i =1,nspec_tree
+    infhelp(i) = infspec(i)
+ end do
+
+   parunit=GETUNIT()
+    OPEN (parunit, FILE='input/generreg.par', STATUS='old')
+   DO i=1,nspec_tree
+      READ (parunit,*) p0(i),p1(i),p2(i),p3(i),p4(i),c1(i),c2(i),ku_a0(i),ku_a1(i),ku_a2(i), &
+           ku_b0(i),ku_b1(i),ku_b2(i),ku_c0(i),ku_c1(i),ku_c2(i),wei_k1(i),wei_k2(i)
+   ENDDO
+   CLOSE(parunit)
+
+
+!*********************** sea **************************************
+	plant_year = time
+	flag_plant = flag_reg
+!******************************************************************
+
+ rednpl_sh = 1.
+! modification uf number of planted trees in the case of shelterwood management
+ if(flag_shelter.eq.1) rednpl_sh = 0.7
+
+ taxid = 0
+ if( flag_reg .ge.10) quspec = 1
+
+ if(flag_reg.ge.10.and.flag_reg.lt. 30) then
+
+  ! planting of mono-species stands
+
+     select case(flag_reg)
+
+       case(10)
+    ! planting pine
+         taxnum = 3
+       case(11)
+    ! planting beech
+        taxnum = 1
+       case(12)
+    ! planting oak
+        taxnum =4
+       case(13)
+    ! planting spruce
+        taxnum = 2
+       case(14)
+    ! planting birch
+        taxnum = 5
+       case(15)
+    ! planting aspen
+       taxnum = 8
+       case(16)
+    ! planting aleppo pine
+       taxnum = 9
+      case(17)
+	! planting douglas fir
+	    taxnum =10
+      case(18)
+	! planting black locust
+	    taxnum =11
+
+      case(20)
+! reading planting data from file and generating tree cohorts
+
+        inunit=getunit()
+        write(*,'(a)') ' *** Planting of small trees ***'
+        write(*,'(A)',advance='no')' Input directory and file for planting: '
+        read (*,'(A)') infile
+        open (inunit,FILE=trim(infile),STATUS='old')
+! read head of data-file
+       outunit=getunit()
+       open(outunit, FILE=TRIM(treefile(ip)),STATUS='replace')
+       ctrlunit = getunit() +1
+       OPEN (ctrlunit,FILE=TRIM(site_name(ip))//'.initctrl',STATUS='replace')
+       plots=10000.
+        do
+            read(inunit,*) text
+            if(text .ne. '!')then
+               backspace(inunit);exit
+            endif
+        enddo
+! modification AB  19.9.11
+      CALL header(outunit,infile,source,cform,rsap,flag_volfunc,kpatchsize)
+
+        do
+           READ(inunit,*,IOSTAT=ios)numb, nplant ,taxid,pl_height, age, bhd, hbc
+           if(ios<0) exit
+           height = pl_height
+! Modification (Alexander Borys), generating of nkoh cohorts from given data, 19.9.11
+		   nkoh =10
+		   do i = 1, nkoh
+                  hhei(i) = height*(0.8 + (i-1)*0.025)
+		   end do  
+		    write(outunit,*) numb, plots
+
+           do i = 1, nkoh
+             pl_height = hhei(i)*100.
+			 height = hhei(i)
+             if(taxid.eq.12.or. taxid.eq.13) then
+! Eucalyptus
+		         hbc = crown_base_eg(height, bhd)
+		     else	      
+                 hbc=crown_base(height,c1(taxid),c2(taxid),bhd)
+		     end if
+			 nplanth = int(nplant/nkoh)
+			 rsap = 0.5
+             source = 'd'
+             cform=1;hlp_lai=0
+             corr_la = 1.
+             call treeini(outunit,ctrlunit,taxid,source,bhd,height,hbc,nplanth,cform,rsap,int(age),hlp_lai,corr_la)
+             max_coh = max_coh + 1
+   ! initialise tree_ini with zero
+              call coh_initial (tree_ini)
+
+             tree_ini%ident =  max_coh
+             tree_ini%species = taxid
+             tree_ini%ntreea = nplant
+             tree_ini%ntreed = 0.
+             tree_ini%nta = tree_ini%ntreea
+             tree_ini%x_age = age
+             tree_ini%x_hbole = hbc
+             tree_ini%resp = 0.
+             tree_ini%height = pl_height
+             tree_ini%x_sap = x_sap
+             tree_ini%x_fol = x_fol
+             tree_ini%x_frt = x_frt
+             tree_ini%x_hrt = x_hrt
+             tree_ini%x_ahb = x_ahb
+             tree_ini%x_crt = (tree_ini%x_sap + tree_ini%x_hrt) * spar(taxid)%alphac*spar(taxid)%cr_frac
+             tree_ini%x_tb = (tree_ini%x_sap + tree_ini%x_hrt) * spar(taxid)%alphac*(1.-spar(taxid)%cr_frac)
+
+! Borys
+             tree_ini%diam = bhd
+             tree_ini%med_sla = spar(taxid)%psla_min + spar(taxid)%psla_a*0.5
+             tree_ini%t_leaf = tree_ini%med_sla* tree_ini%x_fol                              ! [m-2]
+             tree_ini%ca_ini = tree_ini%t_leaf
+             tree_ini%crown_area = tree_ini%ca_ini
+! initialize pheno state variables
+    IF(spar(tree_ini%species)%Phmodel==1) THEN
+       tree_ini%P=0
+       tree_ini%I=1
+    ELSE
+       tree_ini%P=0
+       tree_ini%I=0
+       tree_ini%Tcrit=0
+    END IF
+
+    IF(nplant.ne.0.) then
+       IF (.not. associated(pt%first)) THEN
+          ALLOCATE (pt%first)
+          pt%first%coh = tree_ini
+          NULLIFY(pt%first%next)
+
+!     root distribution
+        call root_depth (1, pt%first%coh%species, pt%first%coh%x_age, pt%first%coh%height, pt%first%coh%x_frt, pt%first%coh%x_crt, nr, troot2, pt%first%coh%x_rdpt, pt%first%coh%nroot)
+        pt%first%coh%nroot = nr
+        do j=1,nr
+           pt%first%coh%rooteff = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           pt%first%coh%rooteff = 0.   ! layers with no roots
+        enddo
+
+      ELSE
+          ALLOCATE(zeig)
+          zeig%coh = tree_ini
+          zeig%next => pt%first
+          pt%first => zeig
+
+!     root distribution
+        call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+        zeig%coh%nroot = nr
+        do j=1,nr
+           zeig%coh%rooteff = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           zeig%coh%rooteff = 0.   ! layers with no roots
+        enddo
+
+      END IF   !  associated
+      anz_coh=anz_coh+1
+    END IF  ! nplant
+       
+	   end do   ! nkoh
+	   end do
+        close(inunit)
+        close (outunit)
+      close (ctrlunit)
+        return
+      
+      end select
+
+! liocourt management with regeneration if flag_mg = 44
+if(flag_mg.eq.44) then
+
+  do i= 1, M_numclass
+     taxid = m_specpl(spec_lic,i)
+	 age = m_pl_age(spec_lic,i)
+     pl_height = m_plant_height(spec_lic,i)
+	 plhmin = m_plant_hmin(spec_lic,i)
+     nplant = m_numplant(spec_lic,i) * kpatchsize/10000 
+     sdev = m_hsdev(spec_lic,i)
+     call gener_coh(taxid, age, pl_height, plhmin, nplant,sdev)
+  end do
+else
+     taxid = taxnum
+     age = pl_age(taxnum)
+     pl_height = plant_height(taxnum)
+     plhmin = plant_hmin(taxnum)
+
+!  number of seedling from data_plant
+     nplant = rednpl_sh*nint(numplant(taxnum)*kpatchsize/10000)
+! number of seedlings from seedrate
+      if(flag_reg.eq.15.or.flag_reg.eq.16.or.flag_reg.eq.18) nplant = spar(taxnum)%seedrate*kpatchsize
+     sdev = hsdev(taxnum)
+     call gener_coh(taxid, age, pl_height, plhmin, nplant,sdev)
+end if
+
+ else
+  ! planting of mixed stands
+  ! mixture given by ara<meters in data_plant
+   if(flag_reg.eq.9) then
+      do i = 1,nspec_tree
+         if (infspec(i).eq.1 .and. infhelp(i).eq.1) then
+               taxid = i
+               age = pl_age(taxid)
+               pl_height = plant_height(taxid)
+               plhmin = plant_hmin(taxid)
+               nplant = rednpl_sh*nint(npl_mix(taxid)*kpatchsize/10000)
+               sdev = hsdev(taxid)
+               call gener_coh(taxid, age, pl_height, plhmin, nplant,sdev)
+               infhelp(i) = 0
+          end if
+      end do  ! i
+  else if(flag_reg.lt.9.or.flag_reg.gt.30) then
+     infspec = 0
+     npl_mix = 0
+
+     select case (flag_reg)
+! planting of well definded mixtures of pine and oak
+       case(8)
+           infspec(3)=1
+           infspec(4)=1
+           npl_mix(3) = 9000.
+           npl_mix(4) = 1000.
+       case(7)
+           infspec(3)=1
+           infspec(4)=1
+           npl_mix(3) = 7000.
+           npl_mix(4) = 3000.
+       case(6)
+           infspec(3)=1
+           infspec(4)=1
+            npl_mix(3) = 5000.
+            npl_mix(4) =  5000.
+       case(5)
+           infspec(3)=1
+           infspec(4)=1
+           npl_mix(3) = 3000.
+           npl_mix(4) = 7000.
+       case(4)
+           infspec(3)=1
+           infspec(4)=1
+           npl_mix(3) = 2000.
+           npl_mix(4) = 8000.
+       case(33)
+           infspec(2) = 1
+           infspec(3) = 1
+           npl_mix(2) = 5000.
+           npl_mix(3) = 5000.
+     end select
+     do i =1,nspec_tree
+         infhelp(i) = infspec(i)
+     end do
+     do i = 1,nspec_tree
+         if (infspec(i).eq.1 .and. infhelp(i).eq.1) then
+
+               taxid = i
+               age = pl_age(taxid)
+               pl_height = plant_height(taxid)
+               plhmin = plant_hmin(taxid)
+               nplant = rednpl_sh*nint(npl_mix(taxid)*kpatchsize/10000)
+               sdev = hsdev(taxid)
+               call gener_coh(taxid, age, pl_height, plhmin, nplant,sdev)
+               infhelp(i) = 0
+          end if
+     end do  ! i
+ end if
+ end if
+
+END SUBROUTINE planting
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!         gener_coh
+!        SR for planting seedling cohorts
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE gener_coh(taxid,age,pl_height,plhmin, nplant,sdev)
+
+ USE data_simul
+ USE data_stand
+ USE data_par
+ USE data_species
+ USE data_soil
+ USE data_help
+ USE data_plant
+ USE data_manag
+ 
+ IMPLICIT NONE
+ integer    :: nplant,       &
+               taxid,        &
+               nclass,       &
+               i,j,nr
+ real       :: age,          &
+               pl_height,    &
+               sdev,         &
+               plhmin,       &
+			   plhmax,       &
+			   plhinc,       &
+               help,         &
+               nstot,        &
+               hhelp,x1,x2,xacc,shelp
+real         :: rtflsp, sapwood
+real         :: troot2
+
+real, dimension(:), save, allocatable   :: hei,     &
+                                     nschelp
+
+integer,dimension(:),allocatable  :: nsc
+TYPE(cohort)    ::tree_ini
+
+external sapwood
+external rtflsp
+
+flag_standup = 2   ! call stand_balance and root_distribution later
+
+! number of classes
+  nclass = nint(plhmin + (pl_height-plhmin))
+! Liocourt management 
+ if(flag_reg.eq.17) nclass = 20
+ if(flag_reg.eq.11 .and. flag_mg.eq.44) nclass = 1
+ if(flag_reg.eq.18) nclass =20
+ if (flag_reg.eq.15)    nclass = 20
+  allocate(hei(nclass))
+  allocate(nschelp(nclass))
+  allocate(nsc(nclass))
+
+   plhmax = pl_height + (pl_height-plhmin)
+   plhinc = (plhmax-plhmin)/nclass
+   nstot = 0
+   help =  (1/(sqrt(2*pi)*sdev))
+   do i = 1, nclass
+   if ( nclass.eq.1) then 
+         hei(i) = pl_height
+   else
+! height per class
+          hei(i) = plhmin + (i-1)
+          nschelp(i) = help*exp(-((hei(i)-pl_height)**2)/(2*(sdev)**2))
+          nstot = nstot + nschelp (i)
+    end if
+   end do
+   do i = 1,nclass
+   if(nclass.eq.1) then
+        nsc(i) = nplant *kpatchsize/10000
+    else
+         nsc(i) = nint((nschelp(i)*nplant/nstot) + 0.5)
+    end if
+   end do
+
+   do i = 1,nclass
+
+     max_coh = max_coh + 1
+! initialise tree_ini with zero
+   call coh_initial (tree_ini)
+
+   tree_ini%ident =  max_coh
+   tree_ini%species = taxid
+   tree_ini%ntreea = nsc(i)
+   tree_ini%nta = tree_ini%ntreea
+   tree_ini%x_age = age
+   tree_ini%height = hei(i)
+
+    hhelp =  tree_ini%height
+
+    IF (taxid.ne.2) tree_ini%x_sap = exp(( LOG(hhelp)-LOG(spar(taxid)%pheight1))/spar(taxid)%pheight2)/1000000.
+    IF (taxid.eq.2) THEN
+        x1 = 1.
+        x2 = 2.
+        xacc=(1.0e-10)*(x1+x2)/2
+        heihelp = tree_ini%height
+        hnspec = taxid
+        shelp=rtflsp(sapwood,x1,x2,xacc)
+        tree_ini%x_sap = (10**shelp)/1000000         !  transformation mg ---> kg
+    ENDIF
+
+! Leaf mass
+    tree_ini%x_fol = (spar(taxid)%seeda*(tree_ini%x_sap** spar(taxid)%seedb))   ![kg]
+    tree_ini%Fmax = tree_ini%x_fol
+! Fine root mass rough estimate
+     tree_ini%x_frt = tree_ini%x_fol
+! cross sectional area of heartwood
+     tree_ini%x_crt = (tree_ini%x_sap + tree_ini%x_hrt) * spar(taxid)%alphac*spar(taxid)%cr_frac
+     tree_ini%x_tb = (tree_ini%x_sap + tree_ini%x_hrt) * spar(taxid)%alphac*(1.-spar(taxid)%cr_frac)
+
+    tree_ini%med_sla = spar(taxid)%psla_min + spar(taxid)%psla_a*0.5
+    tree_ini%t_leaf = tree_ini%med_sla* tree_ini%x_fol                              ! [m-2]
+    tree_ini%ca_ini = tree_ini%t_leaf
+    tree_ini%crown_area = tree_ini%ca_ini
+!   1 fr Vincent kint, 2 oakchain
+    tree_ini%underst = 2
+!   initialize pheno state variables
+    IF(spar(tree_ini%species)%Phmodel==1) THEN
+       tree_ini%P=0
+       tree_ini%I=1
+    ELSE
+       tree_ini%P=0
+       tree_ini%I=0
+       tree_ini%Tcrit=0
+    END IF
+
+    IF(nsc(i).ne.0.) then
+       IF (.not. associated(pt%first)) THEN
+          ALLOCATE (pt%first)
+          pt%first%coh = tree_ini
+          NULLIFY(pt%first%next)
+        call root_depth (1, pt%first%coh%species, pt%first%coh%x_age, pt%first%coh%height, pt%first%coh%x_frt, pt%first%coh%x_crt, nr, troot2, pt%first%coh%x_rdpt, pt%first%coh%nroot)
+        pt%first%coh%nroot = nr
+        do j=1,nr
+           pt%first%coh%rooteff(j) = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           pt%first%coh%rooteff(j) = 0.   ! layers with no roots
+        enddo
+
+      ELSE
+          ALLOCATE(zeig)
+          zeig%coh = tree_ini
+          zeig%next => pt%first
+          pt%first => zeig
+        call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+        zeig%coh%nroot = nr
+        do j=1,nr
+           zeig%coh%rooteff(j) = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           zeig%coh%rooteff(j) = 0.   ! layers with no roots
+        enddo
+
+      END IF
+      anz_coh=anz_coh+1
+    END IF
+
+end do
+
+   deallocate(hei)
+  deallocate(nschelp)
+  deallocate(nsc)
+
+END SUBROUTINE gener_coh
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    weight
+!     seed mass function
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+function sapwood (x)
+
+use data_help
+use data_species
+
+real     :: x
+real     :: p1,p2,p3
+
+p1 = spar(hnspec)%pheight1
+p2 = spar(hnspec)%pheight2
+p3 = spar(hnspec)%pheight3
+
+sapwood = p3*(x**2) + p2*x +p1-alog10(heihelp)
+
+end function sapwood

source_code/version_2.3_windows/prand.f

+!*****************************************************************!
+!*                                                               *!
+!*                      4C (FORESEE)                             *!
+!*                                                               *!
+!*                                                               *!
+!* returns a random number N drawn from a Poisson distribution   *!
+!* with expected value U. I is a seed for                        *!
+!* the random number generator                                   *!
+!*                                                               *!
+!*                  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 PRAND(U,N)
+
+      REAL UTOP
+      PARAMETER(UTOP=188.)
+      INTEGER N
+      REAL P,R,Q,U
+
+! function declarations
+
+      REAL    RAND
+
+      IF(U.GT.UTOP)STOP 'Failure in PRAND: expected value too high'
+      P=EXP(-U)
+      Q=P
+      R=RAND()
+      N=0
+100   IF(Q.GE.R)RETURN
+      N=N+1
+      P=P*U/N
+      Q=Q+P
+      GOTO 100
+
+END subroutine prand   

source_code/version_2.3_windows/prepglob.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*                                                               *!
+!* Contains the following subroutines:                           *!
+!*                                                               *!
+!* PREPARE_GLOBAL: general preparation of simulation             *!
+!*                 contains internal subroutines:                *!
+!*                 TOPMENU: main menu                            *!
+!*                 EDITSIM: edit simulation file names           *!
+!*                                                               *!
+!*                  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 prepare_global
+
+use data_simul
+use data_out
+use data_species
+use data_stand
+use data_site
+use data_tsort
+use data_climate
+
+implicit none
+
+character  anf
+logical ex
+
+! main menu
+
+DO
+  call topmenu
+
+ if (anf == '2') then
+
+    call editsim
+    call testfile(simfile,ex)
+    if(ex .eqv. .false.) cycle
+    call readsim
+     if (flag_mult910) print *,'  Check the data from file:'
+
+  ELSE if (anf == '1' .or. anf == ' ') then
+
+    call testfile(simfile,ex)
+    if(ex .eqv. .false.) cycle
+    call readsim
+     if (flag_mult910) print *,'  Check the data from file:'
+
+  end if
+
+  if (ex .eqv. .true.) exit
+
+end DO
+
+call outtest
+
+contains
+
+!---------------------------------------------------------------
+
+SUBROUTINE topmenu
+
+print *,'  ****************************************************'
+print *,'  ****************  Welcome to 4C  *******************'
+print *,'  ****************************************************'
+print *,' '
+print *,'  1 <Enter>.. Start with default simulation control: ',trim(simfile)
+print *,' '
+print *,'  2...........Edit simulation control file name'
+print *,' '
+print *,'  ****************************************************'
+write(*,'(A)',advance='no') '  Make your choice: '
+read(*,'(A)') anf
+
+END subroutine topmenu
+
+!-----------------------------------------------------------------------------
+
+SUBROUTINE editsim
+
+     open(1000,file='user')
+
+    write(1000,'(A,A,A)',advance='no') ' Simulation control file (default= ',trim(simfile),'): '
+    read (*,'(A)') simfile
+    if (simfile == ' ') then
+        simfile = 'test0.sim'
+    end if
+
+end subroutine editsim
+
+!-----------------------------------------------------------------------------
+
+END subroutine prepare_global
+
+!**************************************************************
+
+

source_code/version_2.3_windows/prepsite.f

+!*****************************************************************!
+!*                                                               *!
+!*                     4C (FORESEE)                              *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines:                               *!
+!*             PREPARE_SITE and PREPARE_CLIMATE                  *!
+!*                                                               *!
+!* Contains subroutines:                                         *!
+!*                                                               *!
+!* PREPARE_SITE:                                                 *!
+!*            preparation of site specific simulation parameters *!
+!*                                                               *!
+!*            contains internal subroutines:                     *!
+!*            SITEMENU: choice of inputs                         *!
+!*            EDITFILE: edit filenames                           *!
+!*            READSOIL: input of soil parameter                  *!
+!*            READCN: input of C-N-parameter                     *!
+!*            READVALUE: input of start values for               *!
+!*                       soil water and C-N-modeling             *!
+!*            ALLOC_SOIL: allocate soil variables                *!
+!*            STAND_BAL_INI: allocate and init stand variables   *!
+!*            CONTROL_FILE: saving all parameters                *!
+!*                          and start conditions for each site   *!
+!*                                                               *!
+!* READDEPO:  reading deposition data                            *!
+!* READREDN:  reading values of redN                             *!
+!* READLIT:   reading initialisation data of litter fractions    *!
+!*                                                               *!
+!* PREPARE_CLIMATE: reading of site specific climate input data  *!
+!*                  from file                                    *!
+!*                  contains internal subroutines:               *!
+!*                  READ_DWD                                     *!
+!*                  READ_CLI                                     *!
+!*                  CLIMFILL                                     *!
+!*                                                               *!
+!* STORE_PARA:      multi run - restore of changed parameter     *!
+!*                                                               *!
+!*                  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 prepare_site
+
+! input of site specific data
+
+  use data_climate
+  use data_inter
+  use data_manag
+  use data_mess
+  use data_out
+  use data_par
+  use data_simul
+  use data_site
+  use data_soil
+  use data_soil_cn
+  use data_species
+  use data_stand
+  use data_tsort
+  use data_frost
+
+
+implicit none
+integer i,ios,help, help_ip
+character a
+character :: text
+character(10)  :: helpsim, text2
+logical:: ex=.TRUE.
+real parerr
+real, external :: avg_sun_incl
+character(100)  :: helpx
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' prepare_site'
+
+WRITE(helpsim,'(I4)') anz_sim
+read(helpsim,*) anh
+
+
+IF(site_nr==1) THEN
+    help_ip=site_nr
+ELSE
+    help_ip=ip
+END IF
+
+! Initialization of climate data
+IF (flag_clim==1 .or. ip==1 .or. flag_multi .eq.5) THEN
+    call prepare_climate
+END IF
+
+if (flag_end .gt. 0) return
+ios=0; help=0
+do
+  if (ip==1 .and. flag_mult9) then
+   if (flag_trace) write (unit_trace, '(I4,I10,A,I3,A5,L5)') iday, time_cur, ' prepare_site ip=',ip,'  ex=',ex  
+    call readspec
+    call readsoil  ! reading soil parameter
+    IF (flag_end .gt.0) return
+    if (flag_soilin .eq. 0) call readvalue  ! Initialization of simulation start values for soil layers
+    
+    ! biochar
+    if (flag_bc .gt. 0) call bc_appl
+    
+    ! Deposition data
+    call readdepo
+
+    ! Input redN
+    if (flag_multi .ne. 4 .or. flag_multi .ne. 8 ) call readredN
+
+    flag_mult9 = .FALSE.
+  else
+   if (flag_trace) write (unit_trace, '(I4,I10,A,I3,A5,L5)') iday, time_cur, ' prepare_site ip=',ip,'  ex=',ex   
+
+    ! Deposition data
+    call readdepo
+
+    select case (flag_multi)
+    case (1,6)
+       call readspec
+       if (flag_soilin .eq. 0) call readvalue  ! Initialization of simulation start values for soil layers
+       call readredN           ! Input redN
+       call readsoil  ! reading soil parameter   
+       
+       do
+          jpar = jpar + 1
+             if (vpar(jpar) .gt. -90.0) then
+                helpx = simpar(jpar)
+                call store_para(vpar(jpar), helpx, parerr)
+                IF (parerr .ne. 1.) then
+                   CALL  error_mess(time,'parameter variation: '//trim(simpar(jpar))//' not found',vpar(jpar))
+                   write (*,*) '***  parameter variation: ', trim(simpar(jpar)), ' not found,   see error log'
+                endif
+             else
+                exit
+             endif
+       enddo
+    
+    ! biochar
+      if (flag_bc .gt. 0 .or. flag_decomp .gt. 100) call bc_appl
+
+    case (2,4)
+
+
+       call readsoil  ! reading soil parameter
+       if (flag_soilin .eq. 0) call readvalue  ! Initialization of simulation start values for soil layers
+
+    case (5)
+       call readspec   
+       call readsoil  
+       if (flag_soilin .eq. 0) call readvalue  ! Initialization of simulation start values for soil layers
+       call readredN                           ! Input redN
+
+    case (7)
+       call assign_co2par      
+       call readsoil                           ! reading soil parameter
+       if (flag_soilin .eq. 0) call readvalue  ! Initialization of simulation start values for soil layers
+       call readredN                           ! Input redN
+
+    case (8, 9, 10)
+
+       call readsoil         ! reading soil parameter
+       IF (flag_end .gt.0) return
+       call readredN         ! Input redN or test resp.
+    end select
+  endif
+exit
+enddo
+
+! Setting flag_inth and prec_stad_red from flag_int
+if (flag_int .lt. 1000) then
+    flag_inth = flag_int
+else
+  ! Conversion character ==> number and vice versa  
+    write (helpsim,'(I4)') flag_int
+    text2 = helpsim(2:2)
+    read (text2,*) flag_inth
+    text2 = helpsim(3:4)
+    read (text2,*) prec_stand_red
+endif
+
+if (.not.flag_mult8910) then
+    unit_soil = getunit()
+    open (unit_soil,file=trim(dirout)//trim(site_name(help_ip))//'_soil.ini'//anh,status='replace')
+    WRITE (unit_soil,'(2A)') '! Soil initialisation, site name: ',site_name(help_ip)
+endif
+
+call stand_bal_ini !allocation of stand summation variables
+
+! Initialization of CO2
+call assign_co2par
+! Initialisation litter compartments
+call readlit
+! Initialization of soil model with profile data
+call soil_ini    ! Aufruf ohne s_cn_ini
+! Initialization disturbances
+IF (flag_dis .eq. 1 .or. flag_dis .eq. 2) CALL dist_ini
+! Initialization of stand
+call prepare_stand
+IF (flag_end .gt.0) return
+! calculation of latitude in radians
+xlat = lat/90.*pi*0.5
+! calculation of average sun inclination
+avg_incl = AVG_SUN_INCL(lat)   ! degrees
+beta=avg_incl*PI/180           ! radians
+! read externally prescribed bud burst days
+CALL readbudb
+! Initialization management
+IF(flag_mg.ne.0.and. flag_mg.ne.5) call manag_ini
+IF(flag_mg.eq. 5) then
+    thin_dead = 1
+    allocate(thin_flag1(nspec_tree))
+	thin_flag1  = 0
+end if	  
+! Initialization of output file per site
+call prep_out
+call stand_balance
+call CROWN_PROJ
+call standup
+call root_ini   ! initialisation of root distribution
+call s_cn_ini
+
+! Initialization of soil temperature model with stand data
+call s_t_ini
+
+! control file for saving simulation environment
+! output of first Litter-Input at start
+if(flag_mult8910 .and. (anz_sim .gt. 1)) then
+    continue
+else 
+    IF ((ip .eq. 1 .or. flag_multi .eq. 1 .or. flag_multi .eq. 6) .and. (time_out .ne. -2) ) call control_file
+endif
+
+! hand over of the litter-initialising
+call litter
+if ((flag_decomp .eq. 20) .or. (flag_decomp .eq. 21)) then
+    call testfile(valfile(ip),ex)
+    if (ex .eqv. .true.) then
+       ios = 0
+       unit_litter = getunit()
+       open(unit_litter,file=valfile(ip),status='old',action='read')
+       if (flag_multi .ne. 9) print *,' *** Open file of litter input data ',valfile(ip),'...'
+           do
+              read(unit_litter,*) text
+              IF(text .ne. '!')then
+                 backspace(unit_litter);exit
+              endif
+           enddo
+    endif
+endif
+call cn_inp
+
+! read flux data
+if (flag_eva .gt.10) call evapo_ini
+      ! yearly output
+      IF (time_out .gt. 0) THEN
+         IF (mod(time,time_out) .eq. 0) CALL outyear (1)
+         IF (mod(time,time_out) .eq. 0) CALL outyear (2)
+      ENDIF
+
+    contains
+
+!-------------------------------------------------------------------------------
+
+subroutine readsoil ! Input of soil parameter
+
+use data_par
+use data_soil_t
+use data_site
+
+implicit none
+
+integer :: inunit, helpnl, helpnr, ihelp
+real helpgrw, hlong, hlat
+character :: text
+character(30) :: hor, boart, helpid
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' readsoil'
+
+! Setting of flag_surf from flag_cond
+select case (flag_cond)
+
+    case (0,1,2,3)
+       flag_surf = 0
+
+    case (10,11,12,13)
+       flag_surf = 1
+
+    case (30,31,32,33)
+       flag_surf = 3
+       
+end select
+
+! Setting of flag_bc from flag_decomp
+if (flag_decomp .ge. 100) then
+    flag_decomp = flag_decomp - 100
+    flag_bc = 1
+else
+    flag_bc = 0
+endif
+
+call testfile(sitefile(ip),ex)
+IF (ex .eqv. .true.) then
+  inunit = getunit()
+  ios=0
+  open(inunit,file=sitefile(ip),iostat=ios,status='old',action='read')
+  if (.not.flag_mult8910) then
+      print *,'***** Reading soil parameter from file ',sitefile(ip),'...'
+      write (unit_err, *) 'Soil parameter from file   ',trim(sitefile(ip))
+  endif
+
+  do
+     read(inunit,*) text
+     IF(text .ne. '!')then
+        backspace(inunit)
+        exit
+     endif
+  enddo
+     
+  if (flag_multi .eq. 8.or. flag_multi.eq.5.or. flag_mult910) then  
+      read(inunit,*) text
+     IF((text .eq. 'N') .or. (text .eq. 'n'))then
+         flag_soilin = 3
+     else
+         flag_soilin = 2
+         backspace(inunit)
+     endif
+  else
+     read(inunit,*) text
+     IF((text .eq. 'N') .or. (text .eq. 'n'))then
+         flag_soilin = 1
+     else
+         flag_soilin = 0
+         backspace(inunit)
+     endif
+     soilid(ip) = valfile(ip)
+  endif
+  if ((text .eq. 'S') .or. (text .eq. 's'))then
+      flag_soilin = 4
+      read(inunit,*) text
+  endif
+  if (.not.flag_mult8910) then
+      write (unit_err, *) 'Soil identity number       ', trim(soilid(ip))
+      write (unit_err, *) 'Climate ID                 ', trim(clim_id(ip))
+  endif
+  
+  if (flag_soilin .eq. 1 .or. flag_soilin .ge. 3) then
+    flag_hum = 1
+  endif  
+  
+  if (flag_cond .ge. 40) then
+    flag_hum = 0
+  endif
+  
+  select case (flag_soilin)
+
+  case (0,1)   ! single files f. j. site
+
+     read (inunit,*,iostat=ios) long
+     read (inunit,*,iostat=ios) lat
+     read (inunit,*,iostat=ios) nlay
+     read (inunit,*,iostat=ios) nroot_max
+     read (inunit,*,iostat=ios) helpgrw
+     
+     if (helpgrw .gt. 1) then
+        grwlev = helpgrw
+     else
+        fakt   = helpgrw
+        grwlev = 1000.
+     endif
+     
+     read (inunit,*,iostat=ios) w_ev_d
+     read(inunit,*,iostat=ios) k_hum     ! mineralization constants of humus
+     read(inunit,*,iostat=ios) k_hum_r
+     read(inunit,*,iostat=ios) k_nit     ! nitrification constant
+
+     IF(help==0) call alloc_soil
+         read (inunit,*,iostat=ios) text
+         select case (flag_soilin)
+         case (0)      ! old input structure
+             do i = 1, nlay
+               read (inunit,*,iostat=ios) text
+               read (inunit,*,iostat=ios) thick(i),pv_v(i),dens(i),f_cap_v(i), &
+                     wilt_p_v(i),spheat(i),phv(i),wlam(i)
+             end do
+             skelv = 0.
+     
+         case(1)      ! new input structure
+             do i = 1, nlay
+               read (inunit,*,iostat=ios) helpnr, thick(i),pv_v(i),f_cap_v(i),wilt_p_v(i), &
+                     dens(i),spheat(i),phv(i),wlam(i),skelv(i), sandv(i),clayv(i),humusv(i),&
+                     C_hum(i), N_hum(i),NH4(i),NO3(i)
+                     if (flag_wurz .eq. 4 .or. flag_wurz .eq. 6) then
+                       if (phv(i) .le. 0.01) phv(i)=6.0         ! if flag_wurz 4 or 6 is used for calculation a pH-value is assumed
+                     endif
+             end do
+         end select  ! flag_soilin (0,1)
+     
+    if (.not.flag_mult8910) print *, ' '
+     IF (ios .ne.0) then
+          print *,' >>>FORESEE message: Error during reading soil data!'
+          WRITE(*,'(A)',advance='no') '  Stop program (y/n)? '
+          read *, a
+          IF ( a .eq. 'y' .or. a .eq. 'Y') then
+              print *, '  STOP program!'
+              stop
+          endif
+          IF (help==1)  call dealloc_soil
+          print *,'  Check your input choice!!!'
+      endif   ! ios
+
+  case (2)   ! all sites are read from one file; old structure
+     
+     ios = 0
+     do while (ios .eq. 0)
+         read (inunit,*,iostat=ios) helpid, helpnl, helpnr
+         if (trim(soilid(ip)) .ne. trim(helpid)) then
+            do i = 1, helpnl
+               read (inunit,*,iostat=ios) helpid
+            enddo
+         else
+            nlay      = helpnl
+            nroot_max = helpnr
+            if (help==0) call alloc_soil
+            do i = 1, nlay
+               read (inunit,*,iostat=ios) helpnl, hor, boart, depth(i), thick(i),pv_v(i),dens(i), &
+                    f_cap_v(i), wilt_p_v(i), spheat(i),phv(i),wlam(i), &
+                    C_hum(i), N_hum(i), NH4(i), NO3(i), temps(i)
+            enddo
+            lat = latitude(ip)
+			grwlev = gwtable(ip)
+            exit
+         endif
+     enddo
+
+     IF (ios .lt. 0) then
+       if (.not.flag_mult8910) print *,' >>>FORESEE message: soil_id ', soilid(ip), ' not found'
+       if (.not.flag_mult8910) print *,'  Check your input choice!!!'
+       if (help==1)  call dealloc_soil
+       CALL error_mess(time,"soil identificator not found "//adjustl(soilid(ip))//" ip No. ",real(help_ip))
+       flag_end = 5
+       return
+     ENDIF   ! ios
+
+     skelv = 0.
+
+  case (3)   ! all sites are read from one file; new structure
+     
+     ios = 0
+     do while (ios .eq. 0)
+         read (inunit,*,iostat=ios) helpid, helpnl, helpnr
+         if (trim(soilid(ip)) .ne. trim(helpid)) then
+            do i = 1, helpnl
+               read (inunit,*,iostat=ios) helpid
+            enddo
+         else
+            nlay      = helpnl
+            nroot_max = helpnr
+            if (help==0) call alloc_soil
+             do i = 1, nlay
+               read (inunit,*,iostat=ios) helpnr, hor, boart, depth(i), thick(i),pv_v(i),f_cap_v(i), &
+                     wilt_p_v(i),dens(i),spheat(i),phv(i),wlam(i),skelv(i), sandv(i), &
+                     clayv(i),humusv(i),C_hum(i), N_hum(i),NH4(i),NO3(i)
+                     if (flag_wurz .eq. 4 .or. flag_wurz .eq. 6) then
+                       if (phv(i) .le. 0.01) phv(i)=6.0         ! if flag_wurz 4 or 6 is used for calculation a pH-value is assumed
+                     endif
+             end do
+            lat = latitude(ip)
+			grwlev = gwtable(ip)
+            exit
+         endif
+     enddo
+     IF (ios .lt. 0) then
+       if (.not.flag_mult8910) print *,' >>>FORESEE message: soil_id ', soilid(ip), ' not found'
+       if (.not.flag_mult8910) print *,'  Check your input choice!!!'
+       if (help==1)  call dealloc_soil
+       CALL error_mess(time,"soil identificator not found "//adjustl(soilid(ip))//"ip No.",real(help_ip))
+       flag_end = 5
+       return
+     ENDIF   ! ios
+
+  case (4)   ! one file several sites
+
+     if (.not.flag_mult8910) print *,'   Reading soil model parameter from soil type file... ', soilid(ip)
+
+     ios = 0
+     do while (ios .eq. 0)
+         read (inunit,*,iostat=ios) helpid
+         if (trim(soilid(ip)) .ne. trim(helpid)) then
+            read (inunit,*,iostat=ios) text
+            read (inunit,*,iostat=ios) text
+            read (inunit,*,iostat=ios) helpnl
+            do i = 1, helpnl+6
+               read (inunit,*,iostat=ios) boart
+            enddo
+            read (inunit,*,iostat=ios) boart
+         else
+             read (inunit,*,iostat=ios) hlong
+             read (inunit,*,iostat=ios) hlat
+             read (inunit,*,iostat=ios) nlay
+             read (inunit,*,iostat=ios) nroot_max
+             read (inunit,*,iostat=ios) helpgrw
+             if (flag_multi .eq. 8.or. flag_multi.eq.5.or. flag_mult910) then
+                if (abs(latitude(ip)) .gt. 90.) lat = latitude(ip)
+			    grwlev = gwtable(ip)
+             else
+                 if (helpgrw .gt. 1) then
+                    grwlev = helpgrw
+                 else
+                    fakt   = helpgrw
+                    grwlev = 1000.
+                 endif
+                long = hlong
+                lat = hlat
+             endif  
+             read (inunit,*,iostat=ios) w_ev_d
+             read(inunit,*,iostat=ios) k_hum     ! mineralization constants of humus
+             read(inunit,*,iostat=ios) k_hum_r
+             read(inunit,*,iostat=ios) k_nit     ! nitrification constant
+
+             IF(help==0) call alloc_soil
+ 
+             read (inunit,*,iostat=ios) text
+              do i = 1, nlay
+               read (inunit,*,iostat=ios) helpnr, thick(i),pv_v(i),f_cap_v(i),wilt_p_v(i), &
+                     dens(i),spheat(i),phv(i),wlam(i),skelv(i), sandv(i),clayv(i),humusv(i),&
+                     C_hum(i), N_hum(i),NH4(i),NO3(i)
+                     if (flag_wurz .eq. 4 .or. flag_wurz .eq. 6) then
+                       if (phv(i) .le. 0.01) phv(i)=6.0         ! if flag_wurz 4 or 6 is used for calculation a pH-value is assumed
+                     endif
+             end do
+             IF (ios .ne.0) then
+                  print *,' >>>FORESEE message: Error during reading soil data!'    
+                  print *, ' Program stopped!'
+                  IF (help==1)  call dealloc_soil
+                  flag_end = 7
+                  return
+              endif   ! ios
+           exit
+         endif
+     enddo
+
+     if (.not.flag_mult8910) print *, ' '
+     IF (ios .lt. 0) then
+       if (.not.flag_mult8910) then
+           print *,' >>>FORESEE message: soil_id ', soilid(ip), ' not found'
+           print *,'  Check your input choice!!!'
+       endif
+       if (help==1)  call dealloc_soil
+       CALL error_mess(time,"soil identificator not found "//adjustl(soilid(ip))//"ip No.",real(help_ip))
+       flag_end = 5
+       return
+     ENDIF   ! ios
+
+  end select  ! flag_soilin
+  close(inunit)
+endif    ! ex
+
+if (nroot_max .lt. 0) then
+    do i=1, nlay
+        if (C_hum(i) .gt. zero) nroot_max = i
+    enddo
+endif
+if (.not.flag_mult8910) then
+    write (unit_err, *) 'Latitude                ',lat
+    write (unit_err,*)
+endif
+
+end subroutine readsoil
+
+!-------------------------------------------------------------------------
+
+subroutine readvalue ! Input of cn-parameters and start values for soil model
+
+integer :: inunit   
+character :: text
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' readvalue'
+
+call testfile(valfile(ip),ex)
+IF (ex .eqv. .true.) then
+   ios = 0
+   inunit = getunit()
+   open(inunit,file=valfile(ip),status='old',action='read')
+   if (.not.flag_mult8910) print *,' *** Reading initial soil values from file ',valfile(ip),'...'
+   do
+      read(inunit,*) text
+      IF(text .ne. '!')then
+         backspace(inunit);exit
+      endif
+   enddo
+ ! Soil temperature
+   read(inunit,*,iostat=ios) text
+   read(inunit,*,iostat=ios) (temps(i),i=1,nlay)
+ ! C-content of humus
+    read(inunit,*,iostat=ios) text
+    read(inunit,*,iostat=ios) (C_hum(i),i=1,nlay)
+ ! N-content of humus
+    read(inunit,*,iostat=ios) text
+    read(inunit,*,iostat=ios) (N_hum(i),i=1,nlay)
+ ! NH4-content
+    read(inunit,*,iostat=ios) text
+    read(inunit,*,iostat=ios) (NH4(i),i=1,nlay)
+ ! NO3-content
+    read(inunit,*,iostat=ios) text
+    read(inunit,*,iostat=ios) (NO3(i),i=1,nlay)
+endif
+
+IF (ios .ne. 0) then
+print *,' >>>FORESEE message: Error during reading start values!'
+WRITE(*,'(A)',advance='no') '  Stop program (y/n)? '
+read *, a
+  IF ( a .eq. 'y' .or. a .eq. 'Y') then
+  print *, '  STOP program!'
+  stop
+  ELSE
+  call dealloc_soil
+  print *,'  Check your input choice!!!'
+  end if
+endif
+close(inunit)
+
+end subroutine readvalue
+
+!--------------------------------------------------------------------------
+
+subroutine alloc_soil
+use data_soil_t
+use data_soil
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' alloc_soil'
+
+help=0
+allocate(thick(nlay))
+allocate(mid(nlay))
+allocate(depth(nlay))
+allocate(pv(nlay))
+allocate(pv_v(nlay))
+allocate(dens(nlay))
+allocate(f_cap_v(nlay))
+allocate(field_cap(nlay))
+allocate(wilt_p(nlay))
+allocate(wilt_p_v(nlay))
+allocate(vol(nlay))
+allocate(quarzv(nlay))
+allocate(sandv(nlay))
+allocate(BDopt(nlay))
+allocate(clayv(nlay))
+allocate(siltv(nlay))
+allocate(humusv(nlay))
+allocate(fcaph(nlay))
+allocate(wiltph(nlay))
+allocate(pvh(nlay))
+allocate(dmass(nlay))
+allocate(skelv(nlay))
+allocate(skelfact(nlay))
+allocate(spheat(nlay))
+allocate(phv(nlay))
+allocate(wlam(nlay))
+allocate(wats(nlay))
+allocate(watvol(nlay))
+allocate(wat_res(nlay))
+wat_res = 0.
+
+allocate(perc(nlay))
+allocate(wupt_r(nlay))
+allocate(wupt_ev(nlay))
+allocate(s_drought(nlay))
+allocate(root_fr(nlay))
+!allocate(dp_rfr(nlay))
+allocate(temps(nlay))
+allocate (C_opm(nlay))
+allocate (C_hum(nlay))
+allocate (C_opmfrt(nlay))
+allocate (C_opmcrt(nlay))
+allocate (N_opm(nlay))
+allocate (N_hum(nlay))
+allocate (N_opmfrt(nlay))
+allocate (N_opmcrt(nlay))
+allocate (NH4(nlay))
+allocate (NO3(nlay))
+allocate (Nupt(nlay))
+allocate (Nmin(nlay))
+allocate (rmin_phv(nlay))
+allocate (rnit_phv(nlay))
+allocate (cnv_opm(nlay))
+allocate (cnv_hum(nlay))
+allocate(slit(nspecies))
+allocate(slit_1(nspecies))
+
+if (flag_bc .gt. 0) then
+    allocate (C_bc(nlay))
+    allocate (N_bc(nlay))
+    C_bc = 0.
+    N_bc = 0.
+endif
+
+do i=1,nspecies
+slit(i)%C_opm_frt = 0.
+slit(i)%N_opm_frt = 0.
+slit(i)%C_opm_crt = 0.
+slit(i)%N_opm_crt = 0.
+slit(i)%C_opm_tb = 0.
+slit(i)%N_opm_tb = 0.
+slit(i)%C_opm_stem = 0.
+slit(i)%N_opm_stem = 0.
+enddo
+
+nlay2 = nlay+2
+mfirst = 1
+
+allocate (sh(mfirst:nlay2))
+allocate (sv(mfirst:nlay2))
+allocate (sb(mfirst:nlay2))
+allocate (sbt(mfirst:nlay2))
+allocate (t_cb(mfirst:nlay2))
+allocate (t_cond(mfirst:nlay2))
+allocate (h_cap(mfirst:nlay2))
+allocate (sxx(mfirst:nlay2))
+allocate (svv(mfirst:nlay2))
+allocate (svva(mfirst:nlay2))
+allocate (soh(mfirst:nlay2))
+allocate (son(mfirst:nlay2+1))
+help=1
+C_opm = 0
+allocate(fr_loss(nlay))
+allocate(redis(nlay))
+
+end subroutine alloc_soil
+
+!------------------------------------------------------------------
+subroutine stand_bal_ini
+
+use data_stand
+
+implicit none
+
+integer i   
+
+allocate(diam_class(num_class, nspecies)); diam_class=0
+allocate(diam_class_t(num_class, nspecies)); diam_class_t=0
+allocate(diam_class_h(num_class,nspecies)); diam_class_h=0
+allocate(diam_class_age(num_class,nspecies)); diam_class_age=0
+allocate(diam_class_mvol(num_class,nspecies)); diam_class_mvol=0
+allocate(diam_classm(num_class,nspecies)); diam_classm=0
+allocate(diam_classm_h(num_class,nspecies)); diam_classm_h=0
+allocate(height_class(num_class)); height_class =0
+
+! array of potential litter (dead stems and twigs/branches for the next years 
+allocate(dead_wood(nspec_tree))
+do i = 1,nspec_tree
+    allocate(dead_wood(i)%C_tb(lit_year))
+    allocate(dead_wood(i)%N_tb(lit_year))
+    allocate(dead_wood(i)%C_stem(lit_year))
+    allocate(dead_wood(i)%N_stem(lit_year))
+    dead_wood(i)%C_tb = 0.
+    dead_wood(i)%N_tb = 0.
+    dead_wood(i)%C_stem = 0.
+    dead_wood(i)%N_stem = 0.
+enddo
+
+end subroutine stand_bal_ini
+
+!--------------------------------------------------------------
+
+subroutine control_file ! saving simulation parameter and start conditions for each site
+real buckdepth  
+character(8) actdate
+character(10) acttime
+character(150) site_help
+integer help_ip,  j
+TYPE(Coh_Obj), Pointer :: help_coh  ! pointer to cohort list
+
+IF(site_nr==1) THEN
+    help_ip=site_nr
+ELSE
+    help_ip=ip
+END IF
+
+! Write soil initialisation file
+if (flag_mult8910) then
+    site_help = site_name1
+else
+    site_help = site_name(help_ip)
+endif
+
+if (.not.flag_mult8910 .or. (flag_mult8910 .and. anh .eq. "1") .or. (flag_mult8910 .and. time_out .gt. 0.)) then
+    if (.not.flag_mult8910) then
+        WRITE (unit_soil,'(26A)') 'Layer',' Depth(cm)',' F-cap(mm)',' F-cap(Vol%)','   Wiltp(mm)', &
+          ' Wiltp(Vol%)',' Pore vol.',' Skel.(Vol%)',' Density','  Spheat','      pH','    Wlam',    &
+          ' Water(mm)',' Water(Vol%)',' Soil-temp.',' C_opm g/m2', &
+          ' C_hum g/m2',' N_opm g/m2',' N_hum g/m2',' NH4 g/m2',' NO3 g/m2','  humus part',' d_mass g/m2', '  Clay','  Silt','  Sand'
+        do i = 1,nlay
+        WRITE (unit_soil,'(I5,2F10.2,3F12.2,F10.2,F12.2,4F8.2,F10.2,F12.2, 5F11.2,2F9.4,2E12.4, 3F6.1)') i,depth(i),field_cap(i),f_cap_v(i),wilt_p(i), &
+              wilt_p_v(i),pv_v(i), skelv(i)*100., dens(i),spheat(i),phv(i),wlam(i),   &
+              wats(i),watvol(i),temps(i),c_opm(i),c_hum(i),n_opm(i), n_hum(i),nh4(i),no3(i),humusv(i),dmass(i), clayv(i)*100., siltv(i)*100., sandv(i)*100.
+
+        end do
+    endif
+
+    ! Write control file
+    call date_and_time(actdate, acttime)
+    unit_ctr = getunit()
+    open(unit_ctr,file=trim(dirout)//trim(site_help)//'.ctr'//anh,status='replace')
+    WRITE(unit_ctr,'(2A)')     '*** Site name: ',site_name(help_ip)
+    WRITE(unit_ctr,'(2A)')     '    Appendix ' ,anh
+    WRITE(unit_ctr,'(A,F7.2)') '  Longitude: ', long
+    WRITE(unit_ctr,'(A,F7.2)') '  Latitude:  ', lat
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(10A)') '               ----   Version: v2.2   ---- '  
+    WRITE(unit_ctr,'(10A)') '  Date: ',actdate(7:8),'.',actdate(5:6),'.',actdate(1:4), &
+                            '  Time: ',acttime(1:2),':',acttime(3:4)
+    WRITE(unit_ctr,'(A,A)') '   Simulation control file:      ',trim(simfile)
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Data files:'
+    IF(flag_clim==1)then
+    WRITE(unit_ctr,'(A,A)') ' Climfile:                   ',trim(climfile(ip))
+    ELSE
+    WRITE(unit_ctr,'(A,A)') ' Climfile:                   ',trim(climfile(1))
+    endif
+    WRITE(unit_ctr,'(A,A)') ' Sitefile:                   ',trim(sitefile(help_ip))
+    WRITE(unit_ctr,'(A,A)') ' Start value file:           ',trim(valfile(help_ip))
+
+    ! Initialization of stand
+    IF( flag_multi==3 .OR. (site_nr>1 .AND. flag_stand>0) ) THEN
+    WRITE(unit_ctr,'(A,A)') ' Stand initialization:       ',trim(treefile(ip))
+    ELSE IF( ip==1 .AND. flag_stand>0) THEN
+    WRITE(unit_ctr,'(A,A)') ' Stand initialization:       ',trim(treefile(ip))
+    ELSE IF (flag_stand==0) THEN
+    WRITE(unit_ctr,'(A,A)') ' Stand initialization:       none'
+    endif
+    IF (lmulti) WRITE(unit_ctr,'(A,A)') ' Stand identificator: ', adjustl(standid(ip))
+    WRITE(unit_ctr,*) ' '
+    IF(flag_mg.ne.0 .and. flag_mg.ne.5) then
+    WRITE(unit_ctr,'(A,A)') ' Management control file:   ',trim(manfile(ip))
+    ELSE
+    WRITE(unit_ctr,'(A)') ' Management:                 none'
+    endif
+    WRITE(unit_ctr,'(A,A)') ' Deposition file:            ',trim(depofile(ip))
+    WRITE(unit_ctr,'(A,A)') ' N reduction file:           ',trim(redfile(ip))
+    WRITE(unit_ctr,'(A,A)') ' Litter initialisation file: ',trim(litfile(ip))
+    if (flag_stat .gt. 0) WRITE(unit_ctr,'(A,A)') ' File with measurements:     ',trim(mesfile(1))
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Soil description '
+    WRITE(unit_ctr,'(A,I3)') ' Number of soil layers:    ',nlay
+    WRITE(unit_ctr,'(A,I3)') ' Number of rooting layers: ',nroot_max
+    WRITE(unit_ctr,'(A,I3)') ' Ground water from layer:  ',nlgrw
+    WRITE(unit_ctr,'(A,F5.1)') ' Evaporation depth (cm):   ',w_ev_d
+    call bucket(bucks_100, bucks_root, buckdepth)
+    buckdepth = buckdepth/100
+    WRITE(unit_ctr,'(A,F5.2,A,F7.2)') ' Bucket size (mm), ', buckdepth,' m depth: ',bucks_100
+    WRITE(unit_ctr,'(A,F7.2)') ' Bucket size (mm) of rooting zone: ',bucks_root
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Soil water conditions'
+    WRITE(unit_ctr,'(12A)') 'Layer ','Depth(cm) ','F-cap(mm) ','F-cap(Vol%) ','Wiltp(mm) ', &
+      'Wiltp(Vol%) ','Pore vol. ','Density   ','Spheat  ','pH-value  ','   Wlam','   skel. '
+    do i = 1,nlay
+    WRITE(unit_ctr,'(I5,12F10.2)') i,depth(i),field_cap(i),f_cap_v(i),wilt_p(i), &
+       wilt_p_v(i),pv_v(i),dens(i),spheat(i),phv(i),wlam(i),skelv(i)
+    end do
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Soil initial values'
+    WRITE(unit_ctr,'(9A)') 'Layer ','Water-cont. ','Soil-temp. ','C_opm     ', &
+      'C_hum     ','N_opm     ','N_hum     ','NH4-cont. ','NO3-cont '
+    do i=1,nlay
+    WRITE(unit_ctr,'(I5, 2F10.2, 6F10.4)') i,wats(i),temps(i),c_opm(i),c_hum(i),n_opm(i), &
+      n_hum(i),nh4(i),no3(i)
+    end do
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '       N_tot       C_tot     N_antot    N_humtot    C_humtot   C_opm_fol   C_opm_tb   C_opm_frt   C_opm_crt   C_opm_stem '
+    WRITE(unit_ctr,'(10F12.4)') N_tot, C_tot, N_an_tot, N_hum_tot, C_hum_tot, C_opm_fol, C_opm_tb, C_opm_frt, C_opm_crt, C_opm_stem
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)',advance='no') 'Mineralization constant of humus - humus layer (k_hum): '
+    WRITE(unit_ctr,'(F10.5)') k_hum
+    WRITE(unit_ctr,'(A)',advance='no') 'Mineralization constant of humus - mineral soil (k_hum_r): '
+    WRITE(unit_ctr,'(F10.5)') k_hum_r
+    WRITE(unit_ctr,'(A)',advance='no') 'Nitrification constant (k_nit): '
+    WRITE(unit_ctr,'(F10.5)') k_nit
+    WRITE(unit_ctr,*) ' '
+    if (flag_bc .gt.0) then
+    WRITE(unit_ctr,'(A)') '*** Biochar application '
+    WRITE(unit_ctr,'(A)') '    year  C-content(%)  C/N-ratio  depth  mass(kg/ha dry mass)'
+      do j = 1, n_appl_bc
+      WRITE(unit_ctr,'(I7,F14.1, F11.1, I7, F18.1)') &
+            y_bc(j), cpart_bc(j), cnv_bc(j), bc_appl_lay(j), C_bc_appl(j)      
+      enddo
+    WRITE(unit_ctr,'(F10.5)')  
+    endif
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Stand initialisation'
+    WRITE(unit_ctr,'(A)')'  Coh      x_fol       x_frt       x_sap       x_hrt       x_Ahb     height   x_hbole  x_age      n     sp       DC          DBH'
+    help_coh => pt%first
+    DO WHILE (ASSOCIATED(help_coh))
+    WRITE(unit_ctr,'(I5,5f12.5,2f10.0,i7,f7.0,i7, 2f12.5)') help_coh%coh%ident, help_coh%coh%x_fol, help_coh%coh%x_frt, help_coh%coh%x_sap, help_coh%coh%x_hrt, &
+              help_coh%coh%x_Ahb, help_coh%coh%height, help_coh%coh%x_hbole, help_coh%coh%x_age, &
+              help_coh%coh%nTreeA,help_coh%coh%species, help_coh%coh%dcrb, help_coh%coh%diam
+    help_coh => help_coh%next
+    END DO
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Simulation control'
+    WRITE(unit_ctr,'(A66,I4)') 'Run option:                                                       ',flag_multi
+    WRITE(unit_ctr,'(A66,I4)') 'Start year:                                                       ',time_b
+    WRITE(unit_ctr,'(A66,I4)') 'Number of simulation years - year:                                ', year
+    WRITE(unit_ctr,'(A60,F12.1)') 'Patch size [m²] - kpatchsize:                                     ',kpatchsize
+    WRITE(unit_ctr,'(A60,F12.1)') 'Thickness of leaf layers - dz:                                    ',dz
+    WRITE(unit_ctr,'(A66,I4)') 'Time step for photosynthesis calculations (days) -    ns_pro:     ',ns_pro
+    WRITE(unit_ctr,'(A66,I4)') 'Mortality (0-OFF,1-ON stress, 2- ON stress+intr) -  flag_mort:    ',flag_mort
+    WRITE(unit_ctr,'(A66,I4)') 'Regeneration (0-OFF,1-ON, 2-weekly growth of seedl.) - flag_reg:  ',flag_reg
+    WRITE(unit_ctr,'(A66,I4)') 'use FORSKA for regeneration (0-OFF,1-ON) - flag_forska:           ',flag_lambda
+    WRITE(unit_ctr,'(A66,I4)') 'Stand initialization (0-no,1-from *.ini,2-generate) - flag_stand: ',flag_stand
+    WRITE(unit_ctr,'(A66,I4)') 'Ground vegetation initialization (0-no,1-generate) - flag_sveg:     ',flag_sveg
+    WRITE(unit_ctr,'(A66,I4)') 'Stand management (0-no,1-yes, 2 - seed once) - flag_mg:           ',flag_mg
+    WRITE(unit_ctr,'(A66,I4)') 'Disturbance (0-OFF, 1-ON ) - flag_dis:                            ',flag_dis
+    WRITE(unit_ctr,'(A66,I4)') 'Light absoption algorithm (1,2,3,4) - :                           ',flag_light
+    WRITE(unit_ctr,'(A66,I4)') 'Foliage-height relationship (0,1) - flag_folhei:                  ',flag_folhei
+    WRITE(unit_ctr,'(A66,I4)') 'Volume function trunc (0,1) - flag_volfunc:                       ',flag_volfunc
+    WRITE(unit_ctr,'(A66,I4)') 'Respiration model (0-0.5*NPP,1-organ specific) - flag_resp:       ',flag_resp
+    WRITE(unit_ctr,'(A66,I4)') 'Limitation (0-NO,1-water, 2-N, 3-water+N) - flag_limi:            ',flag_limi
+    WRITE(unit_ctr,'(A66,I4)') 'Flag for decomposition model - flag_decomp:                       ',flag_decomp
+    WRITE(unit_ctr,'(A66,I4)') 'Root spec. activity (0-const,1-varying) - flag_sign:              ',flag_sign
+    WRITE(unit_ctr,'(A66,I4)') 'Water uptake function soil (1,2,3,4) - flag_wred:                 ',flag_wred
+    WRITE(unit_ctr,'(A66,I4)') 'Root distribution - flag_wurz:                                    ',flag_wurz
+    WRITE(unit_ctr,'(A66,I4)') 'Heat conductance - flag_cond:                                     ',flag_cond
+    WRITE(unit_ctr,'(A66,I4)') 'Interception - flag_int:                                          ',flag_int
+    WRITE(unit_ctr,'(A66,I4)') 'Evapotranspiration - flag_eva:                                    ',flag_eva
+    WRITE(unit_ctr,'(A66,I4)') 'CO2 (0-constant,1-historic increase,2-step change)- flag_co2:     ',flag_co2
+    WRITE(unit_ctr,'(A66,I4)') 'Sort flag - flag_sort:                                            ',flag_sort
+    WRITE(unit_ctr,'(A66,I4)') 'wpm flag - flag_wpm:                                              ',flag_wpm
+    WRITE(unit_ctr,'(A66,I4)') 'Analysis of measurements - flag_stat:                             ',flag_stat
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A66,A)')  'Species parameter file:                                           ',trim(specfile(help_ip))
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '*** Species parameter description'
+    WRITE(unit_ctr,'(A51,I4)')   ' Species number: ', nspecies
+    WRITE(unit_ctr,'(A51,I4)')   ' Number of tree species: ', nspec_tree
+    WRITE(unit_ctr,*) '              ********** '
+    WRITE(unit_ctr,'(A25,A9,2X,A30)') 'Short Name', '  Spec-Nr', 'Latin Name                   '
+    WRITE(unit_ctr,*) ' '
+    do i=1,nspecies
+    WRITE(unit_ctr,'(A25,I9,2X,A30)') trim(spar(i)%species_short_name), i, spar(i)%species_name
+    enddo
+    WRITE(unit_ctr,*) '              ********** '
+    WRITE(unit_ctr,'(A51,15A16)')   ' Species name: ', (trim(spar(i)%species_short_name),i=1,nspecies)
+    WRITE(unit_ctr,1010) ' Maximal age - max_age: ', (spar(i)%max_age,i=1,nspecies)
+    WRITE(unit_ctr,1010) ' Stress rec. time - yrec: ', (spar(i)%yrec,i=1,nspecies)
+    WRITE(unit_ctr,1010) ' Shade tolerance - stol: ', (spar(i)%stol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Extinction coeff - pfext: ', (spar(i)%pfext,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Root activity rate - sigman: ', (spar(i)%sigman,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Respiration coeff - respcoeff: ', (spar(i)%respcoeff,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Growth resp. par. - prg: ', (spar(i)%prg,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Maint.resp.par./sapwood - prms: ', (spar(i)%prms,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Maint.resp.par./fineroot - prmr: ', (spar(i)%prmr,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Senesc.par. foliage - psf: ', (spar(i)%psf,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Senesc.par. sapwood - pss: ', (spar(i)%pss,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Senesc.par. fineroot - psr: ', (spar(i)%psr,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N/C ratio of biomass - pcnr: ', (spar(i)%pcnr,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N concentration of foliage - ncon_fol: ', (spar(i)%ncon_fol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N concentration of fine roots - ncon_frt: ', (spar(i)%ncon_frt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N concentration of coarse roots - ncon_crt: ', (spar(i)%ncon_crt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N concentration of twigs and branches - ncon_tbc: ', (spar(i)%ncon_tbc,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N concentration of stemwood - ncon_stem: ', (spar(i)%ncon_stem,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Reallocation parameter of foliage - reallo_fol: ', (spar(i)%reallo_fol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Reallocation parameter of fine root - reallo_frt: ', (spar(i)%reallo_frt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Ratio of coarse wood - alphac: ', (spar(i)%alphac,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Coarse root fraction of coarse wood - cr_frac: ', (spar(i)%cr_frac,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Sapwood density - prhos: ', (spar(i)%prhos,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Proport.const.(pipe mod.) - pnus: ', (spar(i)%pnus,i=1,nspecies)
+    IF(flag_folhei==0) THEN
+    WRITE(unit_ctr,1000) ' Height growth parameter - pha: ', (spar(i)%pha,i=1,nspecies)
+    ELSEIF(flag_folhei==1) THEN
+    WRITE(unit_ctr,1000) ' Height growth par. 1 - pha_v1: ', (spar(i)%pha_v1,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Height growth par. 2 - pha_v2: ', (spar(i)%pha_v2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Height growth par. 3 - pha_v3: ', (spar(i)%pha_v3,i=1,nspecies)
+    ELSE
+    WRITE(unit_ctr,'(A51,I3)')     ' non valid flag value - flag_folhei : ',flag_folhei
+    ENDIF
+    WRITE(unit_ctr,1000) ' Height growth parameter coeff 1 - pha_coeff1: ', (spar(i)%pha_coeff1,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Height growth parameter coeff 2 - pha_coeff2: ', (spar(i)%pha_coeff2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Crown radius - DBH ratio parameter a - crown_a: ', (spar(i)%crown_a,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Crown radius - DBH ratio parameter b - crown_b: ', (spar(i)%crown_b,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Crown radius - DBH ratio parameter c - crown_c: ', (spar(i)%crown_c,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Minimum specific leaf area - psla_min: ', (spar(i)%psla_min,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Light dep. specific leaf area - psla_a: ', (spar(i)%psla_a,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Efficiency parameter - phic: ', (spar(i)%phic,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' N content - pnc: ', (spar(i)%pnc,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' kco2_25: ', (spar(i)%kCO2_25,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' ko2_25: ', (spar(i)%kO2_25,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' CO2/O2 specif. value - pc_25: ', (spar(i)%pc_25,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Q10_kco2: ', (spar(i)%q10_kCO2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Q10_ko2: ', (spar(i)%q10_kO2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Q10_pc: ', (spar(i)%q10_pc,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Rd to Vm ratio - pb: ', (spar(i)%pb,i=1,nspecies)
+
+    WRITE(unit_ctr,1000) ' PIM: Inhibitor min temp. - PItmin: ', (spar(i)%PItmin,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Inhibitor opt temp. - PItopt: ', (spar(i)%PItopt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Inhibitor max temp. - PItmax: ', (spar(i)%PItmax,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Inhibitor scaling factor - PIa: ', (spar(i)%PIa,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Promotor min temp. - PPtmin: ', (spar(i)%PPtmin,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Promotor opt temp. - PPtopt: ', (spar(i)%PPtopt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Promotor max temp. - PPtmax: ', (spar(i)%PPtmax,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Promotor scaling factor - PPa: ', (spar(i)%PPa,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' PIM: Promotor scaling factor - PPb: ', (spar(i)%PPb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' CSM: chilling base temp. - CSTbC: ', (spar(i)%CSTbC,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' CSM: base temp. - CSTbT: ', (spar(i)%CSTbT,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' CSM: scaling factor - CSa: ', (spar(i)%CSa,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' CSM: scaling factor - CSb: ', (spar(i)%CSb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' TSM: base temp. - LTbT: ', (spar(i)%LTbT,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' TSM: critical temperature sum - LTcrit: ', (spar(i)%LTcrit,i=1,nspecies)
+    WRITE(unit_ctr,1010) ' TSM: start day after 1.11. - Lstart: ', (spar(i)%Lstart,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' usefd pheno model - Phmodel: ', (spar(i)%Phmodel,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' End day for phenology - end_bb: ', (spar(i)%end_bb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Fpar_mod - fpar_mod: ', (spar(i)%fpar_mod,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Intercep.cap. - ceppot_spec: ', (spar(i)%ceppot_spec,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' photosynthesis response to N-limitation - Nresp: ',  (spar(i)%Nresp,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Regeneration flag - regflag: ',  (spar(i)%regflag,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Seedrate: ',  (spar(i)%seedrate,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Seedmass: ',  (spar(i)%seedmass,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' Standard dev. of seedrate - seedsd: ',  (spar(i)%seedsd,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - seeda: ',  (spar(i)%seeda,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - seedb: ',  (spar(i)%seedb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pheight1: ',  (spar(i)%pheight1,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pheight2: ',  (spar(i)%pheight2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pheight3: ',  (spar(i)%pheight3,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pdiam1: ',  (spar(i)%pdiam1,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pdiam2: ',  (spar(i)%pdiam2,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' all. parameter - pdiam3: ',  (spar(i)%pdiam3,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' decomp. parameter foliage - k_opm_fol: ',  (spar(i)%k_opm_fol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' synth. parameter foliage - k_syn_fol: ',  (spar(i)%k_syn_fol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' decomp. parameter fine roots - k_opm_frt: ',  (spar(i)%k_opm_frt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' synth. parameter fine roots - k_syn_frt: ',  (spar(i)%k_syn_frt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' decomp. parameter coarse roots - k_opm_crt: ',  (spar(i)%k_opm_crt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' synth. parameter coarse roots - k_syn_crt: ',  (spar(i)%k_syn_crt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' decomp. parameter twigs/branches - k_opm_tb: ',  (spar(i)%k_opm_tb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' synth. parameter twigs/branches - k_syn_tb: ',  (spar(i)%k_syn_tb,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' decomp. parameter stem - k_opm_stem: ',  (spar(i)%k_opm_stem,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' synth. parameter dtem - k_syn_stem: ',  (spar(i)%k_syn_stem,i=1,nspecies)
+
+    WRITE(unit_ctr,1000)
+    WRITE(unit_ctr,1000) ' spec_rl: ',  (spar(i)%spec_rl,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' tbase: ',  (spar(i)%tbase,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' topt: ',  (spar(i)%topt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' bdmax_coef: ',  (spar(i)%bdmax_coef,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' porcrit_coef: ',  (spar(i)%porcrit_coef,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' ph_opt_max: ',  (spar(i)%ph_opt_max,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' ph_opt_min: ',  (spar(i)%ph_opt_min,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' ph_max: ',  (spar(i)%ph_max,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' ph_min : ',  (spar(i)%ph_min ,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' v_growth: ',  (spar(i)%v_growth,i=1,nspecies)
+
+    WRITE(unit_ctr,1000)
+    WRITE(unit_ctr,1000) ' C/N ratio of foliage - cnr_fol: ', (spar(i)%cnr_fol,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' C/N ratio of fine roots - cnr_frt: ', (spar(i)%cnr_frt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' C/N ratio of coarse roots - cnr_crt: ', (spar(i)%cnr_crt,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' C/N ratio of twigs and branches - cnr_tbc: ', (spar(i)%cnr_tbc,i=1,nspecies)
+    WRITE(unit_ctr,1000) ' C/N ratio of stemwood - cnr_stem: ', (spar(i)%cnr_stem,i=1,nspecies)
+
+    WRITE(unit_ctr,1000)
+    WRITE(unit_ctr,1000) ' Reduction factor - RedN: ', (svar(i)%RedN, i=1,nspecies)
+
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,'(A)') '******   Model parameter   ******'
+    WRITE(unit_ctr,1020) 'Optimum ratio of ci to ca [-] - Lambda: ',lambda
+    WRITE(unit_ctr,1020) 'Molar mass of carbon [g/mol] - Cmass: ',Cmass
+    WRITE(unit_ctr,1020) 'Minimum conductance [mol/(m2*d)] - gmin: ',gmin
+    WRITE(unit_ctr,1020) 'Shape of PS response curve - ps: ',ps
+    WRITE(unit_ctr,1020) 'Slope of N function at 20 °C [g(N) (mymol s-1)-1] - pn: ',pn
+    WRITE(unit_ctr,1020) 'Minimum N content [g/g] - nc0: ',nc0
+    WRITE(unit_ctr,1020) 'C3 quantum efficiency - qco2: ',qco2
+    WRITE(unit_ctr,1020) 'Scaling parameter - qco2a: ',qco2a
+    WRITE(unit_ctr,1020) 'Partial pressure of oxygen (kPa) - o2: ',o2
+    WRITE(unit_ctr,1020) 'Atmospheric CO2 content (mol/mol) - co2: ',co2_st
+    WRITE(unit_ctr,1020) 'Albedo of the canopy - pfref: ',pfref
+    WRITE(unit_ctr,1020) 'Part of C in biomass [-] - cpart: ',cpart
+    WRITE(unit_ctr,1020) 'Ratio of molecular weights of water and air - rmolw: ',rmolw
+    WRITE(unit_ctr,1020) 'Universal gas constant [J/mol/K] = [Pa/m3/K] - R_gas: ',R_gas
+    WRITE(unit_ctr,1020) 'von Karman''s constant [-] - c_karman: ',c_karman
+    WRITE(unit_ctr,1020) 'Specific heat of air at const. pressure [J/g/K] - c_air: ',c_air
+    WRITE(unit_ctr,1020) 'Psychrometer constant [hPa/K] - psycro: ',psycro
+    WRITE(unit_ctr,1020) 'Breast height for inventory measurements [cm] - h_breast: ',h_breast
+    WRITE(unit_ctr,1020) 'Height for sapling allometry - h_sapini: ',h_sapini
+    WRITE(unit_ctr,1020) 'Min. diff. b. height of crown base and breast height- h_bo_br_diff: ',h_bo_br_diff
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of CO2 scenario - p1_co2: ',p1_co2
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of CO2 scenario - p2_co2: ',p2_co2
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of CO2 scenario - p3_co2: ',p3_co2
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of CO2 scenario - p4_co2: ',p4_co2
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of CO2 scenario - p5_co2: ',p5_co2
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of historical CO2 scenario - p1_co2h: ',p1_co2h
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of historical CO2 scenario - p2_co2h: ',p2_co2h
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of historical CO2 scenario - p3_co2h: ',p3_co2h
+    WRITE(unit_ctr,1020) 'Parameter variable for calculation of historical CO2 scenario - p4_co2h: ',p4_co2h
+    WRITE(unit_ctr,1020) 'Threshold of air temperature for snow accumulation [°C] - temp_snow:    ',temp_snow
+    WRITE(unit_ctr,1020) 'Parameter for calculation of transpiration demand  - alfm:              ',alfm
+    WRITE(unit_ctr,1020) 'Parameter for calculation of transpiration demand [mol/(m2*d)] - gpmax: ',gpmax 
+    WRITE(unit_ctr,1020) 'Parameter for growing degree day calculation - thr_gdd: ',thr_gdd
+    
+    IF (flag_multi==2) THEN
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,*) 'runs with climate scenarios produced by adding summands to every daily temperature'
+    WRITE(unit_ctr,*) 'and modifying every single precipitation value by a multiplicand'
+    WRITE(unit_ctr,*) 'run ident      deltaT     delta P factor'
+    ENDIF
+
+    !   mangament parameter adaptation management
+
+    IF (flag_mg.eq.2. .and. flag_reg .eq. 0) then
+    WRITE(unit_ctr,*) ' '
+    WRITE(unit_ctr,*) '***Managment parameter case flag_mg = 2 (user specified)  ***'
+    WRITE(unit_ctr,'(A35,4F15.5)')  'height for management control(cm)', ho1,ho2,ho3,ho4
+    WRITE(unit_ctr,'(A35,5I15)')  'management flags thr1-thr5' , thr1,thr2, thr3,thr4,thr5
+    WRITE(unit_ctr,'(A35,F15.5)')   'height for directional felling', thr6
+    WRITE(unit_ctr,'(A35,I15)')   'measure at rotation', thr7
+    WRITE(unit_ctr,'(A35,I15)')   'regeneration measure', mgreg
+    WRITE(unit_ctr,'(A35,F15.5)')  'lower/upper limit of height(cm)', limit
+    WRITE(unit_ctr,'(A35,I15)')  'number of years between thinning',thinstep
+    WRITE(unit_ctr,'(A35,F15.5)') 'rel. value for directional felling', direcfel
+    WRITE(unit_ctr,'(A35,5F15.5)')'number of Zielbaeume(spec.)', (zbnr(i),i=1,nspec_tree)
+    WRITE(unit_ctr,'(A35,5F15.5)')'rel. value for tending of pl.',(tend(i), i =1,nspec_tree)
+    WRITE(unit_ctr,'(A35,5I15)')'rotation ',(rot(i), i =1,nspec_tree)
+    WRITE(unit_ctr,'(A35,5I15)')'age of nat./pl. regeneration',(regage(i), i =1,nspec_tree)
+    end IF
+
+    IF (flag_multi .ne. 2.and. flag_mg.ne.2 .and. flag_reg .eq.0) close(unit_ctr)
+endif  !  flag_mult8910
+
+1000 FORMAT (A51,15 F16.5)
+1010 FORMAT (A51,15 I16)
+1020 FORMAT(A70,F15.5)
+
+end subroutine control_file
+
+end subroutine prepare_site
+
+!******************************************************************************
+
+SUBROUTINE readbudb
+
+use data_simul
+use data_species
+use data_stand
+
+implicit none
+
+   DO ns=1,nspecies
+      IF(spar(ns)%phmodel==4) THEN
+         WRITE(*,*) 'Please type the day of budburst for 4C species number ',ns,':'
+         READ(*,*) svar(ns)%ext_daybb
+      ENDIF
+   ENDDO
+
+END subroutine readbudb
+
+!******************************************************************************
+
+SUBROUTINE readdepo
+
+use data_climate
+use data_depo
+use data_out
+use data_simul
+use data_site
+
+implicit none
+
+character  text
+integer  hx, unit_dep, i,j,ios, ii
+!integer  realrec
+integer  id,im,iy,itz1, itz2, hyear1, hyear2, hyear3, hy
+logical  ex
+real     hNO, hNH
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' readdepo'
+
+if (.not.allocated(NOd)) allocate (NOd (1:366,1:year))
+if (.not.allocated(NHd)) allocate (NHd (1:366, 1:year))
+
+! for areal usage standard/constant deposition is set as concentration:
+if (flag_multi .eq. 8 .or. flag_mult910) then
+    flag_depo = 2
+    NOd = NOdep(ip)       ! concentration mg/l
+    NHd = NHdep(ip)       ! concentration mg/l
+    return
+endif
+
+NOd = 0.
+NHd = 0.
+
+if (.not.flag_mult8910)  print *
+inquire (File = depofile(ip), exist = ex)  ! test whether file exists
+  IF(ex .eqv. .false.) then
+    if (.not.flag_mult8910) then
+        hx = 0
+        print *,' >>>FORESEE message: Cannot find deposition data - all data set to zero!'
+        CALL error_mess(hx,'Cannot find deposition data - all data set to ',REAL(hx))
+    endif
+  else
+    if (.not.flag_mult8910) print *, ' >>>FORESEE message: Now reading DEPOSITION data from file, please wait...'
+!   now read data from file
+    unit_dep = getunit()
+    OPEN (unit_dep,FILE=depofile(ip),IOSTAT=ios,STATUS='OLD',ACTION='READ')
+
+    flag_depo = 1
+    read(unit_dep,*) text
+    select case (text)
+    case ('C', 'c')     ! concentrations mg/l
+        flag_depo = 2
+        read(unit_dep,*) text
+
+    case ('Y', 'y')   ! Yearly constant deposition mg/m2
+        flag_depo = 3
+        read(unit_dep,*) text
+
+    case ('A', 'a')   ! Annual sum of deposition g/m2
+        flag_depo = 4
+        read(unit_dep,*) text
+    
+    end select
+
+    do
+      IF (text .ne. '!') then
+         backspace(unit_dep)
+     exit
+      endif
+      read(unit_dep,*) text
+    enddo
+
+!    assignment of dates
+!    fill in missing values with current values until current date
+!    fill in missing values at the end
+        hyear1 = 0
+        hyear2 = 0
+        hyear3 = 1
+        itz1 = 1
+        itz2 = 1
+        select case (flag_depo)
+        case(4)
+            do while ((ios .eq. 0) .and. (hyear1 .lt. year))
+                read(unit_dep,*,iostat=ios) iy, hNO, hNH
+                if (ios .eq.0) then
+                    if (iy .gt. time_b+year) then
+                        hyear1 = year
+                    else
+                        hyear1 = iy - time_b + 1
+                    endif
+                    if ((hyear1 .le. year) .and. (hyear1 .gt. 0)) then        ! save from simulation start year onwards
+                        do i = 1,366
+                            NOd(i,hyear1) = hNO * 1000./366.                  ! report of year [g/m2] in daily values [mg/m2] 
+                            NHd(i,hyear1) = hNH * 1000./366.
+                        enddo
+                        hy = hyear1-1
+                        do while ((hy .gt. hyear2) .and. (hy .gt. 0))  
+                            do i = 366, 1, -1
+                                NOd(i,hy) = hNO * 1000./366.
+                                NHd(i,hy) = hNH * 1000./366.
+                            enddo
+                            hy = hy - 1
+                        enddo
+                        hyear2 = hyear1
+                     endif   ! 0 < hyear1 < year
+               else  ! ios .ne. 0
+                    if (hyear1 .le. 0) then
+                        hyear1 = 1
+                        hyear2 = 1
+                    endif
+                    continue
+                endif  ! ios = 0
+            enddo
+                  
+        case default
+            do while ((ios .eq. 0) .and. (hyear1 .lt. year))
+                read(unit_dep,*,iostat=ios) id,im,iy, hNO, hNH
+                if (ios .eq.0) then
+                    call daintz(id,im,iy,itz1) 
+                    if (iy .gt. time_b+year) then
+                        hyear1 = year
+                    else
+                        hyear1 = iy - time_b + 1
+                    endif
+                    if ((hyear1 .le. year) .and. (hyear1 .gt. 0)) then        ! save from simulation start year onwards 
+                        NOd(itz1,hyear1) = hNO 
+                        NHd(itz1,hyear1) = hNH 
+
+                        select case (flag_depo)
+                        case(1,2)                     
+                            if (hyear1 .eq. hyear3) then
+                                if (itz1 .gt. 1) then
+                                    do i = itz1-1, itz2, -1
+                                        NOd(i,hyear1) = hNO
+                                        NHd(i,hyear1) = hNH
+                                    enddo
+                                endif
+                            else
+                                if (itz2 .lt. recs(hyear3)) then
+                                    do i = itz2+1, recs(hyear3)
+                                        NOd(i,hyear3) = hNO
+                                        NHd(i,hyear3) = hNH
+                                    enddo
+                                endif
+                                itz2 = 1
+                                if (itz1 .gt. 1) then
+                                    do i = itz1-1, itz2, -1
+                                        NOd(i,hyear1) = hNO
+                                        NHd(i,hyear1) = hNH
+                                    enddo
+                                endif
+                                hy = hyear1-1
+                                do while ((hy .gt. hyear3) .and. (hy .gt. 0))
+                                    do i = 366, 1, -1
+                                        NOd(i,hy) = hNO
+                                        NHd(i,hy) = hNH
+                                    enddo
+                                    hy = hy - 1
+                                enddo
+                            endif   ! hyear1 .eq. hyear3
+                            hyear3 = hyear1
+                            itz2   = itz1
+                            hyear2 = hyear3
+         
+                        case(3)                     ! fill in of constant year values
+                            do i = 1,366
+                                NOd(i,hyear1) = hNO
+                                NHd(i,hyear1) = hNH
+                            enddo
+                            hy = hyear1-1
+                            do while ((hy .gt. hyear2) .and. (hy .gt. 0))  
+                                do i = 366, 1, -1
+                                    NOd(i,hy) = hNO
+                                    NHd(i,hy) = hNH
+                                enddo
+                                hy = hy - 1
+                            enddo
+                            hyear2 = hyear1
+                            itz2 = 366
+                       end select   ! flag_depo 1-3
+                        
+                    endif   ! 0 < hyear1 < year
+                else  ! ios .ne. 0
+                    if (hyear1 .le. 0) then
+                        hyear1 = 1
+                        hyear2 = 1
+                    endif
+                    continue
+                endif  ! ios = 0
+            enddo
+        end select  ! flag_depo    
+
+!   fill in of the missing data at the end
+        select case (flag_depo)
+        case (3)
+            if (hyear1 .lt. year) then
+                hy = hyear1+1
+                do while (hy .le. year)  
+                    do i = 366, 1, -1
+                        NOd(i,hy) = hNO
+                        NHd(i,hy) = hNH
+                    enddo
+                    hy = hy + 1
+                enddo
+            else    ! if date is outside the simulation period, it will be completly filled in
+              do j = 1, year
+                do i = 1, 366   
+                    NOd(i,j) = hNO
+                    NHd(i,j) = hNH
+                enddo
+              enddo          
+            endif
+        
+        case default
+            if (hyear2 .le. year) then
+              if (itz2 .lt. recs(hyear2)) then
+                if (.not.flag_mult8910) then
+                    hx = iy
+                    CALL error_mess(hx,' Not enough data records in deposition file, iostat = ',REAL(ios))
+                    WRITE (unit_err,*) ' >>>FORESEE message: Fill next values with same data '
+                    WRITE (unit_err,'(A,2I4,A,2I4)')'                      from internal simulation time', itz2, hyear2, '   to', recs(hyear2), year
+                endif
+                do j = hyear2, year
+                    ii = 1
+                    if (j .eq. hyear2) ii = itz2
+                    do i = ii, 366
+                        NOd(i,j) = hNO
+                        NHd(i,j) = hNH
+                    enddo
+                enddo 
+              else
+                hy = hyear2+1
+                do while (hy .le. year)  
+                    do i = 366, 1, -1
+                        NOd(i,hy) = hNO
+                        NHd(i,hy) = hNH
+                    enddo
+                    hy = hy + 1
+                enddo
+              endif
+            else    ! if date is outside the simulation period, it will be completly filled in
+              do j = 1, year
+                do i = 1, 366   
+                    NOd(i,j) = hNO
+                    NHd(i,j) = hNH
+                enddo
+              enddo          
+            endif
+        end select
+    close (unit_dep)
+  endif
+
+  write (*,*)
+
+END subroutine readdepo
+
+
+!******************************************************************************
+
+SUBROUTINE readredN
+
+use data_out
+use data_site
+use data_species
+use data_stand
+use data_simul
+
+implicit none
+
+character  text
+integer  hx, unit_red, i,ios
+logical  ex
+
+if (.not.flag_mult8910) print *
+if (flag_multi .lt. 8) then
+  inquire (File = "./input/.", exist = ex)  ! test whether file exists
+  inquire (File = redfile(ip), exist = ex)  ! test whether file exists
+  IF(ex .eqv. .false.) then
+    print *,' >>>FORESEE message: Cannot find data of RedN - internal calculation'
+    hx = 0
+    CALL error_mess(hx,'Cannot find data of RedN - internal calculation ',REAL(hx))
+  else
+    print *, ' >>>FORESEE message: Now reading RedN data from file, please wait...'
+    unit_red = getunit()
+    OPEN (unit_red,FILE=redfile(ip),IOSTAT=ios,STATUS='OLD',ACTION='READ')
+
+    DO
+      READ(unit_red,*) text
+      IF (text .ne. '!') THEN
+         backspace(unit_red)
+         EXIT
+      ENDIF
+    ENDDO
+
+    read (unit_red,*,iostat=ios) (svar(i)%RedN, i=1,nspecies)
+    close (unit_red)
+  endif   ! ex
+else
+  do i = 1, nspecies
+    svar(i)%RedN = RedN_list(i, ip)
+  enddo
+endif   ! flag_multi
+
+IF(flag_limi==0 .OR. flag_limi==1) THEN
+   DO i=1,nspecies
+      svar(i)%RedN = 1.
+   ENDDO
+ENDIF
+
+do i = 1,nspecies
+    if (svar(i)%RedN .lt. 0) then       ! no values; internal calculation
+        if (flag_multi .lt. 8) then
+            print *,' >>>FORESEE message: Cannot find data of RedN - internal calculation for', spar(i)%species_short_name
+            write (unit_err, '(A,I3,1X,A)') 'Cannot find data of RedN - internal calculation for species ',i, spar(i)%species_short_name
+        endif
+        flag_redn = .TRUE.
+    endif
+enddo
+
+   if (.not.flag_mult8910) write (*,*)
+
+END subroutine readredN
+
+!******************************************************************************
+
+SUBROUTINE readlit
+
+!use data_climate
+use data_out
+use data_soil_cn
+use data_species
+use data_stand
+use data_simul
+
+implicit none
+
+character  text
+integer  unit_lit, i,ios
+integer  nspec_lit
+logical  ex
+real     help, hx
+real, dimension(22) :: helpin
+
+flag_lit = 0
+if (flag_mult8910) then
+    inquire (File = litfile(1), exist = ex)  ! test whether file exists
+else
+    print *
+    inquire (File = litfile(ip), exist = ex)  ! test whether file exists
+endif
+  IF(ex .eqv. .false.) then
+    if (.not.flag_mult8910) then
+        print *,' >>>FORESEE message: Cannot find data of litter initialisation - internal calculation'
+        hx = 0.
+        write (unit_err,*)
+        write (unit_err,*) 'Cannot find data of litter initialisation - internal calculation '
+    endif
+  else
+    if (.not.flag_mult8910) print *, ' >>>FORESEE message: Now reading litter initialisation data from file, please wait...'
+!   now read data from file
+    unit_lit = getunit()
+    OPEN (unit_lit,FILE=litfile(ip),IOSTAT=ios,STATUS='OLD',ACTION='READ')
+
+    do
+      read(unit_lit,*) text
+      IF (text .ne. '!') then
+         backspace(unit_lit)
+         exit
+      endif
+    enddo
+
+    helpin = 0.
+    slit%C_opm_fol = 0.
+    read (unit_lit,*) nspec_lit
+    read (unit_lit,*,iostat=ios) text, (slit(i)%C_opm_fol, i=1,nspec_lit)
+    read (unit_lit,*,iostat=ios) text, (slit(i)%C_opm_tb , i=1,nspec_lit)
+    read (unit_lit,*,iostat=ios) text, (slit(i)%C_opm_frt(1), i=1,nspec_lit)
+    read (unit_lit,*,iostat=ios) text, (slit(i)%C_opm_crt(1), i=1,nspec_lit)
+    read (unit_lit,*,iostat=ios) text, (slit(i)%C_opm_stem,i=1,nspec_lit)
+    flag_lit = 1
+
+    help = 0.
+    hx   = 1.
+    do i=1,nspecies
+       if (slit(i)%C_opm_fol .gt. 0) then       
+         totfol_lit  = totfol_lit  + slit(i)%C_opm_fol
+         totfrt_lit  = totfrt_lit  + slit(i)%C_opm_frt(1)
+         tottb_lit   = tottb_lit   + slit(i)%C_opm_tb
+         totcrt_lit  = totcrt_lit  + slit(i)%C_opm_crt(1)
+         totstem_lit = totstem_lit + slit(i)%C_opm_stem
+       else
+          hx = -1.
+       endif
+    enddo
+    help = totfol_lit
+
+    if ((help .gt. 0.) .or. (hx .gt. 0) .and. .not.flag_mult8910) then
+       CALL error_mess(0,'Using data of litter initialisation from file '//trim(litfile(ip)), hx)    
+    else
+      ! no values; internal calculation of litter initialisation
+        if (.not.flag_mult8910) then
+           print *,' >>>FORESEE message: No data of litter initialisation - internal calculation'
+           hx = 0.
+           CALL error_mess(0,'No data of litter initialisation - internal calculation ', hx)
+        endif
+       flag_lit = 0
+    endif
+    close (unit_lit)
+  endif   ! ex
+
+  if (.not.flag_mult8910) write (*,*)
+
+END subroutine readlit
+
+!******************************************************************************
+
+subroutine prepare_climate         
+! read climate file
+
+use data_climate
+use data_out
+use data_simul
+use data_stand
+
+implicit none
+
+type clifile     ! new data type for all climate parameters
+  integer :: day,mon,ye
+  real :: m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11
+end type clifile
+type (clifile), allocatable,dimension(:,:) :: climall !variable for data type climfile
+character(1) c
+character :: text
+integer :: i,j,ios, unit_cli
+integer :: realrec = 0
+integer :: repflag = 0
+logical :: ex
+
+if (.not.flag_mult8910) then
+    print *, ' '
+    print *, '  Input of climate data:    '
+endif
+
+call testfile(climfile(ip),ex) !input filename, test whether file exists
+ IF(ex .eqv. .false.) then
+ print *,' >>>FORESEE message: Cannot find climate data - program STOP!'
+ stop
+ endif
+ if (.not.flag_mult8910) print *, ' >>>FORESEE message: Now reading CLIMATE data from file, please wait...'
+!now read data from file
+unit_cli = getunit()
+OPEN (unit_cli,FILE=climfile(ip),IOSTAT=ios,STATUS='OLD',ACTION='READ')
+allocate (recs (1:year))
+allocate (dd (1:366,1:year));allocate (mm (1:366, 1:year))
+allocate (yy (1:year));allocate (tp (-2:366,1:year))
+allocate (hm (0:366,1:year));allocate (prc (0:366,1:year))
+allocate (prs (0:366,1:year));allocate (rd (0:366,1:year))
+allocate (tn (0:366,1:year))
+allocate (tx (0:366,1:year))
+allocate (vp (0:366,1:year))
+allocate (sdu (0:366,1:year))
+allocate (wd (0:366,1:year))
+allocate (sde (0:366,1:year))
+allocate (bw (0:366,1:year))
+
+dd = -99.9
+mm = -99.9
+yy = -99.9
+tn = -99.9
+tx = -99.9
+wd = -99.9    ! wind initialisation
+
+IF (index(climfile(ip),'.cli') .ne. 0) then
+    flag_climtyp = 1
+    do
+        read(unit_cli,*) text
+        IF (text .ne. '!') then
+           IF (text .eq. 'N') then
+              flag_climtyp = 2
+           else IF(text.eq.'T') then
+              flag_climtyp = 3
+           else
+              backspace(unit_cli)
+              exit
+           endif
+        endif
+    enddo
+else if (index(climfile(ip),'.txt') .ne. 0) then
+    flag_climtyp = 4
+else
+   flag_climtyp = 5  
+end IF
+call read_cli
+close(unit_cli)
+if (flag_end .gt. 0) return
+
+
+IF (realrec < year .and. repflag == 0) then
+   year = realrec
+else
+   IF (repflag == 1) then
+      call climfill
+   end IF
+end IF
+med_rad1 = 0.
+do j = 1, year-1
+  tp(0,j+1) = tp(recs(j),j)
+  tp(-1,j+1)= tp(recs(j)-1,j)
+  tp(-2,j+1)= tp(recs(j)-2,j)
+  hm(0,j+1) = hm(recs(j),j);prc(0,j+1) = prc(recs(j),j);prs(0,j+1) = prs(recs(j),j)
+  rd(0,j+1) = rd(recs(j),j)
+  wd(0,j+1) = wd(recs(j),j)
+  bw(0,j+1) = bw(recs(j),j)
+  vp(0,j+1) = vp(recs(j),j)
+  sdu(0,j+1) = sdu(recs(j),j)
+  sde(0,j+1) = sde(recs(j),j)
+  tx(0,j+1) = tx(recs(j),j)
+  tn(0,j+1) = tn(recs(j),j)
+
+  if( yy(j) .eq.time_b) then
+    do i=1, recs(j)
+
+       med_rad1 = med_rad1 + rd(i, j)
+    end do
+    med_rad1 = med_rad1/recs(1)
+
+  end if
+end do
+tp(-2,1) = tp(1,1); tp(-1,1) = tp(1,1); tp(0,1) = tp(1,1)
+hm(0,1) = hm(1,1);prc(0,1) = prc(1,1);prs(0,1) = prs(1,1)
+rd(0,1) = rd(1,1)
+wd(0,1)=wd(1,1)
+vp(0,1) = vp(1,1)
+bw(0,1) = bw(1,1)
+tn(0,1) = tn(1,1)
+tx(0,1) = tx(1,1)
+sdu(0,1) =sdu(1,1)
+sde(0,1) = sde(1,1)
+
+contains
+
+!--------------------------------------------------------------
+
+subroutine read_dwd
+
+character(3) text
+integer help, help1, help2, help3
+allocate (climall (0:366,1:year))
+
+j=1
+c = 'n'
+do
+   IF (j > year) then
+      realrec = year
+      exit
+   end IF
+   if (.not.flag_mult8910) print *, 'Year ',j
+   read(unit_cli,*) text
+   if(text.ne.'ta ') then
+      backspace(unit_cli)
+   end if
+
+   do i = 1, 366
+      read (unit_cli,*,IOSTAT=ios) climall(i,j)
+
+     help2 = climall(i,j)%day
+     help3 = climall(i,j)%mon
+     help =  climall(i,j)%ye
+     help1 = climall(i-1,j)%ye
+     if (help.eq.2099 .and.help1.eq.2100.and. i.eq.366) then
+      end if
+   end do
+  IF (climall(365,j)%ye == climall(366,j)%ye) then
+      recs(j) = 366
+   else
+      backspace unit_cli
+      climall(366,j)%day = 0
+      climall(366,j)%mon = 0
+      climall(366,j)%ye = 0
+      recs(j) = 365
+	  help = help-1
+   end IF
+   IF (j < year .and. ios < 0 .and. c .eq. 'n') then
+      realrec = j
+      if (.not.flag_mult8910) then 
+          print *, ' >>>FORESEE message: Not enough climate data records in file!'
+          call error_mess(0,'read_cli: Not enough data records in climate file; number of complete years: ',real(realrec))
+          write(unit_err,'(A,I5)')' read_cli: Fill next values with same from first year, day: ',i_exit
+          write(unit_err,'(A,I5)')' read_cli: Fill next values with same data up to years:     ',year
+          repflag = 1
+          exit
+      endif
+    else if(j.eq.year.and.ios < 0) then
+	    realrec = year
+		exit
+   end IF
+
+   j=j+1
+    if(help.lt.time_b) j = j-1
+
+end do
+
+do j = 1, realrec
+  yy(j) = climall(1,j)%ye
+  do i = 1, recs(j)
+    dd(i,j) = climall(i,j)%day
+    mm(i,j) = climall(i,j)%mon
+    tx(i,j) = climall(i,j)%m1
+    tp(i,j) = climall(i,j)%m2
+    tn(i,j) = climall(i,j)%m3
+
+    prc(i,j) = climall(i,j)%m4
+    hm(i,j) = climall(i,j)%m5
+    prs(i,j) = climall(i,j)%m6
+    vp(i,j) = climall(i,j)%m7
+    sdu(i,j) = climall(i,j)%m8
+    bw(i,j) = climall(i,j)%m9
+    rd(i,j) = climall(i,j)%m10
+
+    wd(i,j) = climall(i,j)%m11
+  end do
+end do
+
+close(9)
+deallocate (climall) 
+end subroutine read_dwd
+
+!--------------------------------------------------------------
+
+subroutine read_cli
+
+implicit none
+
+integer  :: testtext, hp
+character(11) :: text2
+character(4) :: text
+
+testtext=0
+c      = 'n'
+j      = 1
+hp = 0
+read(unit_cli,'(A)') text2
+hp = index(text2,'.')  
+backspace(unit_cli)
+
+do
+    IF(j > year) exit
+
+    select case(flag_climtyp)
+    case (1)
+      do i=1,366
+        if (hp .gt. 0) then
+            read(unit_cli,*,iostat=ios) text2,tp(i,j),hm(i,j),prc(i,j),prs(i,j),rd(i,j)
+            text = text2(1:2)
+            write (text,'(A)') text2(1:2)
+            read (text,*) dd(i,j)
+            write (text,'(A)') text2(4:5)
+            read (text,*) mm(i,j)
+            write (text,'(A)') text2(7:10)
+            read (text,*) yy(j)
+        else
+            read(unit_cli,*,iostat=ios) dd(i,j),mm(i,j),yy(j),tp(i,j),hm(i,j),prc(i,j),prs(i,j),rd(i,j)
+        endif  ! hp
+        i_exit = i
+        if ((dd(i,j) .eq. 31) .and. (mm(i,j) .eq. 12)) then
+            recs(j) = i
+            write (*,*) 'Year ',j, yy(j)
+            realrec = j
+            if (j .eq. year) ios = -10 
+            exit
+        endif
+        if (ios .ne. 0) exit
+      end do
+
+    case (2)
+      do i=1,366
+        read(unit_cli,*) dd(i,j),mm(i,j),yy(j),&
+                                    tp(i,j),hm(i,j),prc(i,j),prs(i,j),rd(i,j),wd(i,j)
+        i_exit = i
+        if ((dd(i,j) .eq. 31) .and. (mm(i,j) .eq. 12)) then
+            recs(j) = i
+            write (*,*) 'Year ',j, yy(j)
+            realrec = j
+            if (j .eq. year) ios = -10 
+            exit
+        endif
+        if (ios .ne. 0) exit
+      end do
+
+    case (3)
+      do i=1,366
+        if (hp .gt. 0) then
+            read(unit_cli,*,iostat=ios) text2, &
+                                    tp(i,j),hm(i,j),prc(i,j),prs(i,j),rd(i,j),wd(i,j), tx(i,j),tn(i,j)
+            text = text2(1:2)
+            write (text,'(A)') text2(1:2)
+            read (text,*) dd(i,j)
+            write (text,'(A)') text2(4:5)
+            read (text,*) mm(i,j)
+            write (text,'(A)') text2(7:10)
+            read (text,*) yy(j)
+        else
+            read(unit_cli,*,iostat=ios) dd(i,j),mm(i,j),yy(j),&
+                                    tp(i,j),hm(i,j),prc(i,j),prs(i,j),rd(i,j),wd(i,j), tx(i,j),tn(i,j)
+       endif
+        i_exit = i
+        if ((dd(i,j) .eq. 31) .and. (mm(i,j) .eq. 12)) then
+            recs(j) = i
+            write (*,*) 'Year ',j, yy(j)
+            realrec = j
+            if (j .eq. year) ios = -10 
+            exit
+        endif
+        if (ios .ne. 0) exit
+      end do
+
+    case (4)   ! suffix 'txt'
+      if (j .eq. 1 .and. testtext.eq.0) then
+          read(unit_cli,*) text
+          testtext = 1
+      end if    
+      do i=1,366
+        read(unit_cli,*,iostat=ios) dd(i,j),mm(i,j),yy(j),&
+                                     tx(i,j),tp(i,j),tn(i,j),prc(i,j),hm(i,j),prs(i,j),rd(i,j),wd(i,j)
+        i_exit = i
+        if ((dd(i,j) .eq. 31) .and. (mm(i,j) .eq. 12)) then
+            recs(j) = i
+            write (*,*) 'Year ',j, yy(j)
+            realrec = j
+            if (j .eq. year) ios = -10 
+            exit
+        endif
+        if (ios .ne. 0) exit
+      end do
+    
+    case (5 )
+      call read_dwd  
+      exit
+
+    end select
+
+    IF (realrec .lt. year .and. ios .ne. 0 .and. c .eq. 'n') then
+        if (dd(i_exit,j) .gt. 0)  i_exit = i_exit+1
+        if (i_exit .ge. 365) i_exit = 1
+        repflag = 1
+        if (.not.flag_mult8910) then
+            print *, ' >>>FORESEE message: Not enough data records in file'
+            print *, ' IOSTAT = ', ios
+
+            WRITE (*,'(A,I5)') ' >>>FORESEE message: Fill next values with same data from day number', i_exit
+            CALL error_mess(0,'read_cli: Not enough data records in meteorology file; number of complete years: ',real(realrec))
+            write(unit_err,'(A,I5)')' read_cli: Fill next values with same from first year, day: ',i_exit
+            write(unit_err,'(A,I5)')' read_cli: Fill next values with same data up to years:     ',year
+            exit
+        endif
+
+    end if
+  if (ios .ne. 0) exit
+  if (yy(j) .ge. time_b) then
+      if ((j .eq. 1) .and. (yy(j) .gt. time_b)) then
+        CALL error_mess(0,'read_cli: No climate data in meteorology file for year ',real(time_b))
+        flag_end = 6
+        return
+      endif
+      j = j+1
+  endif
+end do
+
+end subroutine read_cli
+
+!--------------------------------------------------------------
+
+subroutine climfill
+
+integer istart
+
+istart = i_exit 
+if(istart.eq.0) istart =istart +1
+do j=realrec+1,year
+   print *,'Year ',j
+   yy(j)=yy(j-realrec)
+   recs(j)=recs(j-realrec)
+   do i=istart,366
+      dd(i,j) = dd(i,j-realrec)
+      mm(i,j) = mm(i,j-realrec)
+      tp(i,j) = tp(i,j-realrec)
+      hm(i,j)  = hm(i,j-realrec)
+      prc(i,j) = prc(i,j-realrec)
+      prs(i,j) = prs(i,j-realrec)
+      rd(i,j)  = rd(i,j-realrec)
+      wd(i,j)  = wd(i,j-realrec)
+      tx(i,j) = tx(i,j-realrec)
+      tn(i,j) = tn(i,j-realrec)
+   end do
+end do
+
+end subroutine climfill
+
+END subroutine prepare_climate
+
+!**************************************************************
+
+SUBROUTINE store_para(hpara, simpara, parerr)
+
+use data_simul
+use data_out
+use data_par
+use data_species
+use data_soil_cn
+use data_stand
+use data_tsort
+implicit none
+
+integer  inum
+real  hpara, parerr
+character(100):: simpara, hchar1 
+integer, external :: array_num
+
+if (flag_trace) write (unit_trace, '(I4,I10,A)') iday, time_cur, ' store_para'
+
+parerr = 0.
+if (trim(simpara) .eq. 'year') then
+   year=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'time_b') then
+    time_b=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'kpatchsize') then
+    kpatchsize=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'dz') then
+    dz=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'ns_pro') then
+    ns_pro=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_mort') then
+    flag_mort=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_reg') then
+    flag_reg=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_stand') then
+    flag_stand=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_sveg') then
+    flag_sveg=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_mg') then
+    flag_mg=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_dis') then
+    flag_dis=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_light') then
+    flag_light=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_folhei') then
+    flag_folhei=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_volfunc') then
+    flag_volfunc=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_resp') then
+    flag_resp=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_limi') then
+    flag_limi=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_sign') then
+    flag_sign=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_decomp') then
+    flag_decomp=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_wred') then
+    flag_wred=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_wurz') then
+    flag_wurz=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_cond') then
+    flag_cond=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_int') then
+    flag_int=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_eva') then
+    flag_eva=hpara
+   parerr = 1.
+   return
+endif
+if ((trim(simpara) .eq. 'flag_co2') .or.(trim(simpara) .eq. 'flag_CO2')) then
+    flag_co2=hpara
+   parerr = 1.
+   return
+endif
+if (adjustl(trim(simpara)) .eq. 'flag_sort') then
+    flag_sort  = hpara
+    parerr = 1.
+    return
+endif
+if (adjustl(trim(simpara)) .eq. 'flag_wpm') then
+    flag_wpm  = hpara
+    parerr = 1.
+    return
+endif
+if (trim(simpara) .eq. 'time_out') then
+    time_out=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_dayout') then
+    flag_dayout=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_cohout') then
+    flag_cohout=hpara
+   parerr = 1.
+   return
+endif
+if (trim(simpara) .eq. 'flag_sum') then
+    flag_sum=hpara
+   parerr = 1.
+   return
+endif
+
+if (trim(simpara) .eq. 'k_hum') then
+    k_hum=hpara
+    parerr = 1.
+    return
+endif
+
+if (trim(simpara) .eq. 'k_hum_r') then
+    k_hum_r=hpara
+    parerr = 1.
+    return
+endif
+
+if (trim(simpara) .eq. 'k_nit') then
+    k_nit=hpara
+    parerr = 1.
+    return
+endif
+if (adjustl(trim(simpara)) .eq. 'alfm') then
+    alfm   = hpara
+    parerr = 1.
+    return
+endif
+if (adjustl(trim(simpara)) .eq. 'gpmax') then
+    gpmax  = hpara
+    parerr = 1.
+    return
+endif
+if (adjustl(trim(simpara)) .eq. 'alfm') then
+    alfm  = hpara
+    parerr = 1.
+    return
+endif
+
+! Species parameter
+hchar1 = adjustl(simpara)
+inum = array_num(hchar1)
+if (hchar1(1:9) .eq. 'k_opm_fol') then
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%k_opm_fol  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:9) .eq. 'k_opm_frt') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%k_opm_frt  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:9) .eq. 'k_syn_fol') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%k_syn_fol  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:9) .eq. 'k_syn_frt') then
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%k_syn_frt  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:3) .eq. 'psf') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%psf  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:7) .eq. 'Phmodel') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%Phmodel  = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if ((hchar1(1:4) .eq. 'pnus') .or. (hchar1(1:4) .eq. 'Pnus')) then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%pnus = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if ((hchar1(1:4) .eq. 'RedN') .or. (hchar1(1:4) .eq. 'redn')) then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    svar(inum)%RedN = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:4) .eq. 'prms') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%prms = hpara
+        parerr = 1.
+        return
+	endif
+endif
+if (hchar1(1:4) .eq. 'prmr') then
+    inum = array_num(hchar1)
+	if (inum .gt. 0 .and. inum .le. nspecies) then
+	    spar(inum)%prmr = hpara
+        parerr = 1.
+        return
+	endif
+endif
+
+END subroutine store_para
+
+!**************************************************************
+
+integer FUNCTION array_num(string)
+
+! reads the field numbre out of an array and hands it back as integer
+
+implicit none
+
+integer ipos1, ipos2, inum
+character (100) string
+character (10) help, hchar
+
+    ipos1 = scan(string, '(' )
+    ipos2 = scan(string, ')' )
+	ipos1 = ipos1+1
+	ipos2 = ipos2-1
+	hchar = string(ipos1:ipos2)
+    write(help,'(A3)') hchar
+    read(help,*) inum
+    array_num = inum
+
+end function array_num

source_code/version_2.3_windows/prepstand.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                Stand initialisation                           *!
+!*                                                               *!
+!*          CONTAINS SUBROUTINES :                               *!
+!*              PREPARE_STAND                                    *!
+!*              internal subroutines:                            *!
+!*                  SLA_INI                                      *!
+!*                                                               *!
+!*              CALC_INT                                         *!
+!*              CALC_WEIBLA                                      *!
+!*              READ_STAND (treeunit)                            *!
+!*              COH_INITIAL (coh)                                *!
+!*              CREATE_MISTLETOE                                 *!
+!*              CREATE_SOILVEG                                   *!
+!*                                                               *!
+!*              CONTAiNS FUNCTIONS :                             *!
+!*              SURVAGE                                          *!
+!*                                                               *!
+!*                  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 prepare_stand
+
+  USE data_simul
+  USE data_site
+  USE data_stand
+  USE data_species
+  use data_climate
+  use data_par
+  USE data_manag
+
+  IMPLICIT NONE
+
+  CHARACTER      :: a, with_storage
+  CHARACTER(30)  :: text
+  CHARACTER(50)  :: test_stand_id
+  INTEGER        :: ios,treeunit
+  LOGICAL        :: exs, lstin
+  INTEGER        :: help_ip, test_vf
+  REAL           :: test_patchsize, xx
+
+
+  REAL help_height_top  ! auxiliary var. for setting mistletoe height at uppermost crown layer
+  INTEGER which_cohort
+  INTEGER nr_infect_trees
+  INTEGER nr_mist_per_tree
+  INTEGER i
+  TYPE(Coh_Obj), Pointer :: p  ! pointer to cohort list
+
+  IF(site_nr==1) THEN
+      help_ip=site_nr
+  ELSE
+      help_ip=ip
+  END IF
+
+  pt = neu()
+  anz_coh=0
+  max_coh=0
+  ios = -1
+  nr_mist_per_tree=0
+
+  IF(flag_stand>0) then
+
+    exs = .false.
+    stand_id = standid(help_ip)
+    ! reading stand information from treefile
+    inquire (File = treefile(help_ip), exist = exs)
+    IF((exs .eqv. .false.) .or. (flag_stand==2)) then
+      IF(exs .eqv. .false.) write(*,*) '  Stand initialization file not exists!'
+      IF(flag_stand==2) write(*,*)'  Stand initialization with new file'
+      write(*,'(A)',advance='no') '  Creating new file (y/n): '
+      READ *, a
+      IF(a.eq.'y'.or. a.eq.'Y') CALL initia
+
+    ! planting of small trees
+      if(flag_reg.eq.20) then
+         call planting
+         flag_reg=100
+      end if
+      flag_stand=1
+      exs=.true.
+    ENDIF
+    ! read values from treefile
+    IF (exs.eqv. .true.)  then
+       treeunit=getunit()
+       OPEN(treeunit,file=treefile(help_ip),action='read', pad='YES')  !!!! NSC implementation for ini-file
+       READ(treeunit,'(A1,2X,I1,1F12.0)',iostat=ios)with_storage
+       backspace treeunit
+       if(with_storage .eq. 'C') then  !flag_dis .eq. 2 .and. 
+          READ(treeunit,'(A1,2X,I1,1F12.0)',iostat=ios)with_storage,test_vf, test_patchsize
+          call read_stand_with_nsc (treeunit)
+          CLOSE(treeunit)
+          kpatchsize = test_patchsize
+          anz_coh       = max_coh
+          coh_ident_max = anz_coh
+        else
+          READ(treeunit,'(I1,F12.0)',iostat=ios) test_vf, test_patchsize
+  !       write(8888,*) ip, test_vf, flag_volfunc
+          if(flag_multi.ne.4 .or. (flag_multi.eq.4.and.ip.eq.1) .or. (flag_multi.eq.8.and.ip.eq.1)) then
+            IF(test_vf.NE.flag_volfunc) THEN
+              if (.not.flag_mult8910) then
+                CALL error_mess(time,"volume function in sim-file and the one used for initialisation do not match",REAL(flag_volfunc))
+                CALL error_mess(time,"volume function (flag_volfunc) is set to",REAL(test_vf))
+              endif
+             flag_volfunc = test_vf
+            ENDIF
+          endif
+         IF(test_patchsize .GT. 0.) THEN
+           lmulti = .FALSE.
+           IF(test_patchsize.NE.kpatchsize) THEN
+             if (.not.flag_mult8910) then
+               CALL error_mess(time,"patch size in sim-file and the one used for initialisation do not match",kpatchsize)
+               CALL error_mess(time,"value in ini-file",test_patchsize)
+               CALL error_mess(time,"value in sim-file",kpatchsize)
+             endif
+           kpatchsize = test_patchsize
+           ENDIF
+          ELSE
+            lmulti = .TRUE.
+         ENDIF
+          do
+           READ(treeunit,'(A)',iostat=ios) a
+            IF (a .ne. '!') exit
+          end do
+          backspace treeunit
+          ! generation of mistletoe cohort; mistletoe cohort need to be generated BEFORE tree cohorts as otherwise the light model becomes messy
+          if (flag_dis.eq.1) then
+            do i= 1, dis_row_nr
+             if (dis_type(i) .eq. 'M') then
+               if (flag_mistle.eq.0) then        !set #of mist. only once
+                print *,"!! Note, implementation of mistletoe is restricted to trees of Pinus sylvestris"
+                nr_mist_per_tree = dis_rel(i)
+                flag_mistle=1                          ! flag indicating mistletoes
+                call create_mistletoe  ! initialisation of Mistletoe
+               endif
+              anz_coh = max_coh
+             endif
+            enddo
+          endif
+       
+          lstin = .TRUE.
+          if(flag_multi.eq.4 .or. flag_multi.eq.8) stand_id = standid(help_ip)
+            do while (lstin)
+              IF (lmulti) THEN
+               read(treeunit,*,iostat=ios) test_stand_id,  test_patchsize,text
+               IF (ios .lt. 0) then
+                if (.not.flag_mult8910) then
+                   CALL error_mess(time,"stand identificator not found"//adjustl(stand_id)//"ip No.",real(help_ip))
+                   write (*,*) '*** PREPSTAND:  program aborted'
+                   write (*,*) '                stand identificator',stand_id,'  not found'
+                   write (*,'(A, 2x,A)') '                 in initialisation file',treefile(help_ip)
+                endif
+               flag_end = 2
+               return
+               ENDIF
+               IF (test_stand_id .ne. stand_id) THEN
+                 read (treeunit,*) xx
+                   do while (xx .gt. -90.0)
+                    read (treeunit,*) xx
+                   enddo  ! xx
+                ELSE
+                 lstin = .FALSE.
+                 kpatchsize = test_patchsize
+                 call read_stand (treeunit)
+               END IF ! stand_id
+              ELSE
+               lstin = .FALSE.
+               call read_stand (treeunit)
+              END IF    ! lmulti
+            end do      ! lstin
+       CLOSE(treeunit)
+       anz_coh       = max_coh
+       coh_ident_max = anz_coh
+       endif !w/o storage
+    ENDIF    !exs.eqv. .true.
+  END IF     !if stand >0
+
+!if treefile not exists and not created:
+IF(ios .ne. 0 .or. exs .eqv. .false.)THEN
+  if (.not.flag_mult8910) PRINT *,' >>> No Stand Initialization possible '
+  flag_stand=0
+END IF
+
+! Setting of height and number of mistletoe
+if (flag_mistle.ne.0) then
+    help_height_top=1.
+    p=>pt%first
+    DO WHILE (ASSOCIATED(p))
+        if (p%coh%species.eq.3 .AND. p%coh%height.gt.help_height_top) then  !only on Pinus
+            help_height_top=p%coh%height
+            which_cohort=p%coh%ident
+            nr_infect_trees=p%coh%nTreeA
+        end if
+        p=>p%next
+    end do
+
+    p=>pt%first
+    DO WHILE (ASSOCIATED(p))
+        if (p%coh%species.eq.nspec_tree+2) then
+            p%coh%height  = help_height_top               !upper crown
+            p%coh%x_hbole = p%coh%height-50.              !lower crown
+            p%coh%nTreeA = nr_infect_trees*nr_mist_per_tree             !number of mistletoes
+        end if
+        if (p%coh%ident.eq.which_cohort) then             !mark uppermost tree cohort with flag mistletoe
+            p%coh%mistletoe=1
+        end if
+        p=>p%next
+    end do
+end if ! end set height/number of mistletoe
+
+! Soil Vegetation
+if (flag_sveg .gt. 0) then
+   call create_soilveg  ! initialisation of ground vegetation
+   anz_coh = max_coh
+endif
+
+IF(flag_stand>0) CALL sla_ini
+IF(flag_stand>0) CALL stand_bal_spec
+CALL calc_int
+CALL calc_weibla
+if(flag_mg.ne.33) call overstorey
+
+contains
+
+SUBROUTINE sla_ini
+
+ USE data_stand
+ USE data_species
+
+ IMPLICIT NONE
+ TYPE(Coh_Obj), Pointer :: p  ! pointer to cohort list
+
+ p => pt%first
+
+ DO WHILE (ASSOCIATED(p))
+     ns=p%coh%species
+     p%coh%med_sla=spar(ns)%psla_min+spar(ns)%psla_a*0.5
+     p%coh%t_leaf = p%coh%med_sla * p%coh%x_fol
+     p =>p%next
+ END DO
+end subroutine sla_ini
+
+end subroutine prepare_stand
+
+!*************************************************************************
+
+subroutine calc_int  !  calculation of intrinsic mortality rate
+
+use data_species
+implicit none
+INTEGER j
+
+do j=1,nspecies
+spar(j)%intr = -log(0.01)/spar(j)%max_age
+end do
+end subroutine calc_int
+
+!*************************************************************************
+
+subroutine calc_weibla
+!   calculation of parameter lamda for Weibull-distribution of sress mortality
+
+use data_species
+implicit none
+INTEGER j
+REAL survage
+
+do j=1,nspecies
+spar(j)%weibla = -log(0.01)/(survage(j)**weibal)
+end do
+
+end subroutine calc_weibla
+
+!*************************************************************************
+
+REAL function survage(ispec)
+!  calculation of survival time per species depending on shade tolerance class stol
+
+use data_species
+implicit none
+INTEGER :: ispec
+
+IF(spar(ispec)%stol.eq.1) survage=20.
+IF (spar(ispec)%stol.eq.2) survage=40.
+IF (spar(ispec)%stol.eq.3) survage=60.
+IF (spar(ispec)%stol.eq.4) survage=80.
+IF (spar(ispec)%stol.eq.5) survage=100.
+end function
+
+!*************************************************************************
+
+SUBROUTINE read_stand (treeunit)
+
+!  Read of stand initialisation
+
+  USE data_par
+  USE data_simul
+  USE data_species
+  USE data_stand
+
+  IMPLICIT NONE
+
+  TYPE(cohort)   :: coh_ini
+  REAL           :: hdquo   ! help variable for stress initilization
+  INTEGER        :: ios,treeunit, loc, i
+  logical        :: treegroup_decid
+  integer, dimension(5) :: decidous = (/1, 4, 5, 8, 11/)
+
+              do
+                call coh_initial (coh_ini)
+                READ(treeunit,'(5f12.5,2f10.0,i7, f10.0,i7, f9.5, f12.5)',iostat=ios) coh_ini%x_fol, coh_ini%x_frt, coh_ini%x_sap, coh_ini%x_hrt, &
+                    coh_ini%x_Ahb, coh_ini%height, coh_ini%x_hbole, coh_ini%x_age, &
+                    coh_ini%nTreeA,coh_ini%species, coh_ini%dcrb, coh_ini%diam
+                IF(ios<0 .or. coh_ini%x_fol .lt. -90.0) exit
+
+                coh_ini%nTreeD = 0.
+                coh_ini%x_crt = (coh_ini%x_sap + coh_ini%x_hrt) * spar(coh_ini%species)%alphac*spar(coh_ini%species)%cr_frac
+                coh_ini%x_tb = (coh_ini%x_sap + coh_ini%x_hrt) * spar(coh_ini%species)%alphac*(1.-spar(coh_ini%species)%cr_frac)
+
+				!NSC Speicher initialisieren
+				!hier neue version auslesen
+                treegroup_decid = .False.
+                do i = 1, 5
+                  if (decidous(i) .eq. coh_ini%species) then
+                  treegroup_decid = .True.
+                  exit
+                  endif
+                end do
+                If (treegroup_decid .eq. .True.) then
+                coh_ini%x_nsc_sap = coh_ini%x_sap * decid_sap_allo * cpart !*0.5 umrechnung von kg DW zu kg C
+                coh_ini%x_nsc_sap_max = coh_ini%x_nsc_sap
+                coh_ini%x_nsc_tb = coh_ini%x_tb * decid_tb_allo * cpart
+                coh_ini%x_nsc_tb_max = coh_ini%x_nsc_tb
+                coh_ini%x_nsc_crt = coh_ini%x_crt * decid_crt_allo * cpart
+                coh_ini%x_nsc_crt_max = coh_ini%x_nsc_crt
+                endif
+                If (treegroup_decid .eq. .False.) then
+                coh_ini%x_nsc_sap = coh_ini%x_sap * conif_sap_allo * cpart
+                coh_ini%x_nsc_sap_max = coh_ini%x_nsc_sap
+                coh_ini%x_nsc_tb = coh_ini%x_tb * conif_tb_allo * cpart
+                coh_ini%x_nsc_tb_max = coh_ini%x_nsc_tb
+                coh_ini%x_nsc_crt = coh_ini%x_crt * conif_crt_allo * cpart
+                coh_ini%x_nsc_crt_max = coh_ini%x_nsc_crt
+                endif
+				
+                coh_ini%ident = max_coh + 1
+                coh_ini%Fmax = coh_ini%x_fol
+                coh_ini%x_health = 0
+                coh_ini%x_hsap = 0.
+                ns  = coh_ini%species
+                coh_ini%N_fol=coh_ini%x_fol*spar(coh_ini%species)%ncon_fol     ! kg * mg/g --> g
+                 if (coh_ini%dcrb.eq.0..and.coh_ini%diam.eq.0..and.coh_ini%height.gt.h_sapini) then
+                  CALL CALC_DBH(coh_ini%x_hbole,coh_ini%height,coh_ini%x_sap,coh_ini%x_hrt,coh_ini%x_Ahb,coh_ini%Ahc,coh_ini%ident,coh_ini%diam,coh_ini%dcrb,coh_ini%x_hsap,coh_ini%asapw)
+                else
+                  coh_ini%x_hsap = (2*coh_ini%x_hbole + coh_ini%height)/3.
+                  coh_ini%Asapw = coh_ini%x_sap/(spar(coh_ini%species)%prhos*coh_ini%x_hsap)
+                end if
+
+ ! Stress calculation
+                IF (coh_ini%diam.ne. 0.) THEN
+                  hdquo = coh_ini%height/ (coh_ini%diam*100)
+                  IF (hdquo.gt. 1. .and. (coh_ini%x_age .gt. 10..and. coh_ini%x_age .lt.50) ) THEN
+                    coh_ini%x_stress =  coh_ini%x_age/2
+                  ELSE IF ( hdquo.gt. 1. .and. coh_ini%x_age .gt.50) THEN
+                    coh_ini%x_stress =  coh_ini%x_age*3./7.
+                  ELSE
+                    coh_ini%x_stress = 0.
+                  END IF
+                ELSE
+                  coh_ini%x_stress = 0.
+                END IF  ! coh_ini
+
+                coh_ini%x_stress = 0.
+                coh_ini%nta = coh_ini%nTreeA
+
+                IF (.not. associated(pt%first)) THEN
+                  max_coh = 0
+                  allocate(pt%first)
+                  pt%first%coh = coh_ini
+                  nullify(pt%first%next)
+                ELSE
+                  allocate(zeig)
+                  zeig%coh = coh_ini
+                  zeig%next => pt%first
+                  pt%first => zeig
+                END IF
+                max_coh = max_coh + 1
+              enddo
+
+END SUBROUTINE read_stand
+
+!*************************************************************************
+
+SUBROUTINE read_stand_with_nsc (treeunit)
+
+!  Read of stand initialisation
+
+  USE data_par
+  USE data_simul
+  USE data_species
+  USE data_stand
+
+
+  IMPLICIT NONE
+
+  TYPE(cohort)   :: coh_ini
+  REAL           :: hdquo   ! help variable for stress initilization
+  INTEGER        :: ios,treeunit, loc, i
+  logical        :: treegroup_decid
+  integer, dimension(5) :: decidous = (/1, 4, 5, 8, 11/)
+  character      :: a
+
+              do
+               READ(treeunit,'(A)',iostat=ios) a
+               IF (a .ne. '!') exit
+              end do
+              backspace treeunit
+              do
+                call coh_initial (coh_ini)
+!                READ(treeunit,'(5f12.5,2f10.0,i7, f7.0,i7, 2f12.5)',iostat=ios) coh_ini%x_fol, coh_ini%x_frt, coh_ini%x_sap, coh_ini%x_hrt, &
+                READ(treeunit,'(5f12.5,2f10.0,i7,f7.0,i7, 5f12.5)',iostat=ios) coh_ini%x_fol, coh_ini%x_frt, coh_ini%x_sap, coh_ini%x_hrt, &
+                    coh_ini%x_Ahb, coh_ini%height, coh_ini%x_hbole, coh_ini%x_age, &
+                    coh_ini%nTreeA,coh_ini%species, coh_ini%dcrb, coh_ini%diam, coh_ini%x_nsc_tb, coh_ini%x_nsc_crt, coh_ini%x_nsc_sap 
+
+                IF(ios<0 .or. coh_ini%x_fol .lt. -90.0) exit
+
+                coh_ini%nTreeD = 0.
+                coh_ini%x_crt = (coh_ini%x_sap + coh_ini%x_hrt) * spar(coh_ini%species)%alphac*spar(coh_ini%species)%cr_frac
+                coh_ini%x_tb = (coh_ini%x_sap + coh_ini%x_hrt) * spar(coh_ini%species)%alphac*(1.-spar(coh_ini%species)%cr_frac)
+
+				!hier nur den NSC Max-Speicher initialisieren
+				!hier neue version auslesen
+                treegroup_decid = .False.
+                do i = 1, 5
+                  if (decidous(i) .eq. coh_ini%species) then
+                  treegroup_decid = .True.
+                  exit
+                  endif
+                end do
+                If (treegroup_decid .eq. .True.) then
+                coh_ini%x_nsc_sap_max = coh_ini%x_sap * decid_sap_allo * cpart !*0.5 umrechnung von kg DW zu kg C
+                coh_ini%x_nsc_tb_max = coh_ini%x_tb * decid_tb_allo * cpart
+                coh_ini%x_nsc_crt_max = coh_ini%x_crt * decid_crt_allo * cpart
+                endif
+                If (treegroup_decid .eq. .False.) then
+                coh_ini%x_nsc_sap_max = coh_ini%x_sap * conif_sap_allo * cpart
+                coh_ini%x_nsc_tb_max = coh_ini%x_tb * conif_tb_allo * cpart
+                coh_ini%x_nsc_crt_max = coh_ini%x_crt * conif_crt_allo * cpart
+                endif
+!      IF(coh_ini%species==3.and.coh_ini%height.le.900) then
+!      coh_ini%x_stress  =6
+!      ELSE IF(coh_ini%species==1.and.coh_ini%height.le.2500) then
+!      coh_ini%x_stress  =25
+!      ELSE
+!      coh_ini%x_stress = 0
+!      ENDIF
+                coh_ini%ident = max_coh + 1
+                coh_ini%Fmax = coh_ini%x_fol
+                coh_ini%x_health = 0
+                coh_ini%x_hsap = 0.
+                ns  = coh_ini%species
+                coh_ini%N_fol=coh_ini%x_fol*spar(coh_ini%species)%ncon_fol     ! kg * mg/g --> g
+            ! calculate diameter at breast height and pipe length by call of subroutine in partitio
+                 if (coh_ini%dcrb.eq.0..and.coh_ini%diam.eq.0..and.coh_ini%height.gt.h_sapini) then
+!                if (coh_ini%dcrb.eq.0..and.coh_ini%diam.eq.0..and.coh_ini%height.gt.137.) then
+                  CALL CALC_DBH(coh_ini%x_hbole,coh_ini%height,coh_ini%x_sap,coh_ini%x_hrt,coh_ini%x_Ahb,coh_ini%Ahc,coh_ini%ident,coh_ini%diam,coh_ini%dcrb,coh_ini%x_hsap,coh_ini%asapw)
+                else
+                  coh_ini%x_hsap = (2*coh_ini%x_hbole + coh_ini%height)/3.
+                  coh_ini%Asapw = coh_ini%x_sap/(spar(coh_ini%species)%prhos*coh_ini%x_hsap)
+                end if
+
+ ! Stress calculation
+                IF (coh_ini%diam.ne. 0.) THEN
+                  hdquo = coh_ini%height/ (coh_ini%diam*100)
+                  IF (hdquo.gt. 1. .and. (coh_ini%x_age .gt. 10..and. coh_ini%x_age .lt.50) ) THEN
+                    coh_ini%x_stress =  coh_ini%x_age/2
+                  ELSE IF ( hdquo.gt. 1. .and. coh_ini%x_age .gt.50) THEN
+                    coh_ini%x_stress =  coh_ini%x_age*3./7.
+                  ELSE
+                    coh_ini%x_stress = 0.
+                  END IF
+                ELSE
+                  coh_ini%x_stress = 0.
+                END IF  ! coh_ini
+! provisorisch stress auf Null setzen
+                coh_ini%x_stress = 0.
+
+                coh_ini%nta = coh_ini%nTreeA
+
+                IF (.not. associated(pt%first)) THEN
+                  max_coh = 0
+                  allocate(pt%first)
+                  pt%first%coh = coh_ini
+                  nullify(pt%first%next)
+                ELSE
+                  allocate(zeig)
+                  zeig%coh = coh_ini
+                  zeig%next => pt%first
+                  pt%first => zeig
+                END IF
+                max_coh = max_coh + 1
+              enddo
+
+END SUBROUTINE read_stand_with_nsc
+
+!*************************************************************************
+
+
+
+SUBROUTINE coh_initial (coh_ini)
+
+  USE data_simul
+  USE data_soil
+  USE data_stand
+  USE data_species
+
+  IMPLICIT NONE
+
+  TYPE(cohort)   :: coh_ini
+
+        coh_ini%nTreeA = 0.
+        coh_ini%nTreeD = 0.
+        coh_ini%nTreeM = 0.
+        coh_ini%nTreet = 0.
+        coh_ini%nta    = 0.
+        coh_ini%mistletoe = 0
+
+        coh_ini%x_age  = 0.
+        coh_ini%x_fol  = 0.
+        coh_ini%x_sap  = 0.
+        coh_ini%x_frt  = 0.
+        coh_ini%x_hrt  = 0.
+        coh_ini%x_crt  = 0.
+        coh_ini%x_tb   = 0.
+        coh_ini%x_hsap = 0.
+        coh_ini%x_hbole= 0.
+        coh_ini%x_Ahb  = 0.
+
+        coh_ini%x_stress = 0
+        coh_ini%x_health = 0
+
+        coh_ini%bes     = 0.
+        coh_ini%med_sla = 0.
+        coh_ini%Fmax    = 0
+        coh_ini%totBio  = 0.
+        coh_ini%Dbio    = 0.
+        coh_ini%height  = 0.
+        coh_ini%deltaB  = 0.
+        coh_ini%dcrb    = 0.
+        coh_ini%diam    = 0.
+        coh_ini%assi    = 0.
+        coh_ini%LUE     = 0.
+        coh_ini%resp    = 0.
+        coh_ini%netAss  = 0.
+        coh_ini%NPP     = 0.
+        coh_ini%weekNPP = 0.
+        coh_ini%NPPpool = 0.
+        coh_ini%t_Leaf  = 0.
+        coh_ini%geff    = 0.
+        coh_ini%Asapw   = 0.
+        coh_ini%crown_area = 0.
+
+        coh_ini%BG        = 0.
+        coh_ini%leafArea  = 0.
+        coh_ini%sleafArea = 0.
+        coh_ini%FPAR      = 0.
+        coh_ini%antFPAR   = 0.
+        coh_ini%Irel      = 0.
+
+        coh_ini%totFPAR  = 0
+        coh_ini%IrelCan  = 0
+        coh_ini%botLayer = 0
+        coh_ini%topLayer = 0
+        coh_ini%survp    = 0.
+        coh_ini%rel_fol  = 0.
+        coh_ini%gfol     = 0.
+        coh_ini%gfrt     = 0.
+        coh_ini%gsap     = 0.
+        coh_ini%sfol     = 0.
+        coh_ini%sfrt     = 0.
+        coh_ini%ssap     = 0.
+        coh_ini%grossass = 0.
+        coh_ini%maintres = 0.
+        coh_ini%respsap  = 0.
+        coh_ini%respfrt  = 0.
+        coh_ini%respbr   = 0.
+
+        coh_ini%height_ini = 0.
+        coh_ini%ca_ini     = 0.
+
+        coh_ini%rel_dbh_cl = 0
+        coh_ini%underst    = 0
+
+        coh_ini%fol_inc     = 0.
+        coh_ini%fol_inc_old = 0.
+        coh_ini%bio_inc     = 0.
+        coh_ini%stem_inc    = 0.
+        coh_ini%frt_inc     = 0.
+        coh_ini%notViable   = .FALSE.
+
+        coh_ini%intcap   = 0.
+        coh_ini%prel     = 0.
+        coh_ini%interc   = 0.
+        coh_ini%prelCan  = 0.
+        coh_ini%interc_st= 0.
+        coh_ini%aev_i    = 0.
+        coh_ini%demand   = 0.
+        coh_ini%supply   = 0.
+        coh_ini%watuptc  = 0.
+        coh_ini%gp       = 0.
+        coh_ini%drIndd   = 0.
+        coh_ini%drIndPS  = 0.
+        coh_ini%drIndAl  = 0.
+        coh_ini%nDaysGr  = 0
+        coh_ini%isGrSDay = .false.
+
+        coh_ini%litC_fol  = 0.
+        coh_ini%litC_fold = 0.
+        coh_ini%litN_fol  = 0.
+        coh_ini%litN_fold = 0.
+        coh_ini%litC_frt  = 0.
+        coh_ini%litC_frtd = 0.
+        coh_ini%litN_frt  = 0.
+        coh_ini%litN_frtd = 0.
+        coh_ini%litC_stem = 0.
+        coh_ini%litN_stem = 0.
+        coh_ini%litC_tb   = 0.
+        coh_ini%litC_crt  = 0.
+        coh_ini%litC_tbcd = 0.
+        coh_ini%litN_tb   = 0.
+        coh_ini%litN_crt  = 0.
+        coh_ini%litN_tbcd = 0.
+        coh_ini%Nuptc_c   = 0.
+        coh_ini%Nuptc_d   = 0.
+        coh_ini%Ndemc_d   = 0.
+        coh_ini%RedNc     = 1.
+        coh_ini%N_pool    = 0.
+        coh_ini%N_fol     = 0.
+        coh_ini%wat_mg    = 0.   ! soley forflag_wred=9
+
+        coh_ini%nroot   = 0
+        coh_ini%shelter = 0
+		coh_ini%day_bb  = 0
+        coh_ini%x_nsc_sap = 0.
+        coh_ini%x_nsc_tb = 0.
+        coh_ini%x_nsc_crt = 0.
+        coh_ini%x_nsc_sap_max = 0.
+        coh_ini%x_nsc_tb_max = 0.
+        coh_ini%x_nsc_crt_max = 0.
+		
+      if (coh_ini%species .ne. nspec_tree+2) then  ! no root allocation for mistletoe
+        allocate (coh_ini%frtrel(nlay))
+        allocate (coh_ini%frtrelc(nlay))
+        if (flag_wred .eq. 9) then
+            allocate (coh_ini%rld(nlay))
+            coh_ini%rld  = 0.
+		endif
+		allocate (coh_ini%rooteff(nlay))
+	    coh_ini%frtrel  = 0.
+		coh_ini%rooteff = 0.
+      end if   ! end exclude mistletoe
+END SUBROUTINE coh_initial
+!*************************************************************************
+SUBROUTINE create_mistletoe
+  USE data_plant
+  USE data_simul
+  USE data_species
+  USE data_stand
+  USE data_climate
+  USE data_soil
+  USE data_species
+  USE data_par
+  IMPLICIT NONE
+  TYPE(cohort)   :: coh_ini
+  real            :: help_height_top, help_height_bot
+  REAL, EXTERNAL  ::  fi_lf, dfi_lf, ddfi_lf
+
+ ! initialising of cohort of mistletoe
+ call coh_initial (coh_ini)
+ ! set mistletoe here to 20 m height, will be changed after, when cohorts of trees will be initialised
+ help_height_top=2000 
+ help_height_bot=help_height_top-50 
+ ! following values are from sample calcul. of 10 year old V.austr. from Pfiz 2010
+ coh_ini%ident      = max_coh + 1
+ coh_ini%species    = nspec_tree+2    ! Species = species after all tree species and ground veg.
+ coh_ini%nTreeA     = 1               ! #of mistletoes, to be read-in in management file
+ coh_ini%nTreeD     = 0               ! dead trees
+ coh_ini%nta        = coh_ini%nTreeA  ! alive trees internal calc.
+ coh_ini%x_age      = 10
+ coh_ini%x_fol      = mistletoe_x_fol ! fol biomass per tree [kg DW/tree], 1 Viscum (10years) see Pfiz 2010
+ coh_ini%x_sap      = 0.              ! set near-zero for partitioning
+ coh_ini%x_frt      = 0.              ! set near-zero for partitioning
+ coh_ini%height     = help_height_top ! highest_layer   ! highest_layer of all cohorts
+ coh_ini%x_hbole    = help_height_bot !
+ coh_ini%med_sla    = 0.              ! average cohort specific leaf area [m2/kg] is being calculated internal
+ coh_ini%Fmax       = 0               ! anual change of leaf biomass, for now: now change
+ coh_ini%crown_area = 0.0189          ! max. projected crown area (m2) per individuum, calculated from Pfiz 2010
+ coh_ini%t_leaf     = coh_ini%med_sla* coh_ini%x_fol      !leaf area per tree [m2]  !
+ coh_ini%day_bb     = 1               ! evergreen
+! no partitioning of NPP into stem/leaf etc.
+! no root allocation
+ allocate(zeig)
+  zeig%coh = coh_ini
+  zeig%next => pt%first
+  pt%first => zeig
+ max_coh = max_coh + 1
+END SUBROUTINE create_mistletoe
+
+    !*************************************************************************
+
+SUBROUTINE create_soilveg
+
+!  Read of stand initialisation
+
+  USE data_plant
+  USE data_simul
+  USE data_species
+  USE data_stand
+  USE data_climate
+  USE data_soil
+
+  IMPLICIT NONE
+
+  TYPE(cohort)   :: coh_ini
+
+  real            :: lai_help, irel_help, FRsum
+  integer         :: age_stand, nr, j
+  integer         :: flag_SV_allo, rnum
+  real			  :: troot2
+
+  REAL, EXTERNAL  ::  fi_lf, dfi_lf, ddfi_lf
+  
+  age_stand = 0
+  lai_help = 0.
+  irel_help = 0.
+  call wclas(waldtyp)
+
+	   zeig=>pt%first
+       
+	   DO WHILE (ASSOCIATED(zeig))
+	     ns = zeig%coh%species
+	     lai_help = lai_help + zeig%coh%ntreea*zeig%coh%x_fol* spar(ns)%psla_min
+		  age_stand = MAX(zeig%coh%x_age,age_stand)
+		 zeig=>zeig%next
+       end do
+
+   IF((flag_stand==0 .or. age_stand .le. 5) .AND. flag_sveg ==2) THEN
+      NPP_est = 10.  
+   ELSE if(age_stand.le.5) then
+      if(ns.eq.4) then
+	     NPP_est = 5
+	   else
+	      NPP_est = 10.
+	   end if
+   ELSE if(flag_reg.ne.0) then
+         NPP_est = 10
+   ELSE
+      lai_help = lai_help/kpatchsize
+      irel_help = exp(-0.5*lai_help)
+      if( svar(nspec_tree+1)%RedN .lt.0.) then
+	         NPP_est = irel_help * med_rad1 * 365./100. *0.5
+	   else
+             NPP_est = irel_help * med_rad1 * 365./100. *0.5 * svar(nspec_tree+1)%RedN
+      end if
+  ENDIF
+
+     call coh_initial (coh_ini)
+
+       coh_ini%species = nspec_tree+1    ! numbre of species determined automatically
+         ns = coh_ini%species
+         flag_SV_allo=1
+  IF(flag_SV_allo==0) THEN
+  ! the parameters pdiam in the species.par file are used for allocation fractions
+         coh_ini%x_sap = spar(ns)%pdiam3 * NPP_est/1000.*kpatchsize
+		   coh_ini%x_fol = spar(ns)%pdiam1 * NPP_est/1000.*kpatchsize
+		   coh_ini%x_frt = spar(ns)%pdiam2 * NPP_est/1000.*kpatchsize    
+  ELSE  
+     FRsum=0.8*NPP_est/1000.    ! start value as fraction of NPP in kg DM m-2   
+     CALL newt (FRsum, fi_lf, dfi_lf, ddfi_lf, 0.001, 100, rnum)
+     IF(rnum==-1) THEN
+        if (.not.flag_mult8910) CALL error_mess(time,'no solution found for allocation for groundvegetation cohort: ',real(ns))
+         coh_ini%x_sap = spar(ns)%pdiam3 * NPP_est/1000.*kpatchsize
+		   coh_ini%x_fol = spar(ns)%pdiam1 * NPP_est/1000.*kpatchsize
+		   coh_ini%x_frt = spar(ns)%pdiam2 * NPP_est/1000.*kpatchsize    
+     ELSE
+         coh_ini%x_sap = (ksi*FRsum**kappa)*kpatchsize
+		   coh_ini%x_fol = (FRsum/2.)*kpatchsize
+		   coh_ini%x_frt = (FRsum/2.)*kpatchsize    
+     ENDIF
+  ENDIF 
+
+         coh_ini%height  = 60.
+         coh_ini%x_age   = 1
+         coh_ini%nTreeA  = 1
+         coh_ini%ident   = max_coh + 1
+         coh_ini%Fmax    = coh_ini%x_fol
+         coh_ini%med_sla = spar(coh_ini%species)%psla_min + spar(coh_ini%species)%psla_a*irel_help
+         coh_ini%t_leaf  = coh_ini%med_sla* coh_ini%x_fol      ! [m2]
+
+         coh_ini%nta     = coh_ini%nTreeA
+         coh_ini%ca_ini  = kpatchsize
+         coh_ini%day_bb  = 100            ! assumption budding on 8.April 
+
+! root allocation
+                IF (.not. associated(pt%first)) THEN
+                  max_coh = 0
+                  allocate(pt%first)
+                  pt%first%coh = coh_ini
+                  nullify(pt%first%next)
+				  call root_depth (1, pt%first%coh%species, pt%first%coh%x_age, pt%first%coh%height, pt%first%coh%x_frt, pt%first%coh%x_crt, nr, troot2, pt%first%coh%x_rdpt, pt%first%coh%nroot)
+                  pt%first%coh%nroot = nr
+                  do j=1,nr
+                        pt%first%coh%rooteff = 1.   ! assumption for the first use
+                  enddo
+                  do j=nr+1, nlay
+                       pt%first%coh%rooteff = 0.   ! layers with no roots
+                  enddo
+
+                ELSE
+                  allocate(zeig)
+                  zeig%coh = coh_ini
+                  zeig%next => pt%first
+                  pt%first => zeig
+				  call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+                  zeig%coh%nroot = nr
+                  do j=1,nr
+                          zeig%coh%rooteff = 1.   ! assumption for the first use
+                  enddo
+                   do j=nr+1, nlay
+                      zeig%coh%rooteff = 0.   ! layers with no roots
+                   enddo
+
+                END IF
+                max_coh = max_coh + 1
+
+END SUBROUTINE create_soilveg
+
+!*************************************************************************
+
+!***************************!
+! FUNCTION fi_lf           *!
+!***************************!
+
+REAL FUNCTION fi_lf(x)
+  USE data_stand
+  USE data_plant
+  USE data_species
+  REAL :: x
+  fi_lf = spar(nspec_tree+1)%pss*ksi*x**kappa + (spar(nspec_tree+1)%psf+spar(nspec_tree+1)%psr)/2.*x - NPP_est/1000.
+END ! FUNCTION fi_lf
+
+!***************************!
+! FUNCTION dfi_lf          *!
+!***************************!
+
+REAL FUNCTION dfi_lf(x)
+  USE data_stand
+  USE data_plant
+  USE data_species
+  REAL :: x
+  dfi_lf = spar(nspec_tree+1)%pss*ksi*kappa*x**(kappa-1.) + (spar(nspec_tree+1)%psf+spar(nspec_tree+1)%psr)/2. 
+END ! FUNCTION dfi_lf
+
+!***************************!
+! FUNCTION ddfi_lf         *!
+!***************************!
+
+REAL FUNCTION ddfi_lf(x)
+  USE data_stand
+  USE data_plant
+  USE data_species
+  REAL :: x
+  ddfi_lf = spar(nspec_tree+1)%pss*ksi*kappa*(kappa-1.)*x**(kappa-2.) 
+END ! FUNCTION ddfi_lf

source_code/version_2.3_windows/rand.f

+!*****************************************************************!
+!*                                                               *!
+!*                4C (FORSEE) Simulation Model                   *!
+!*                                                               *!
+!*                                                               *!
+!*              Function:                                        *!
+!* Algorithm as described in APPL. STATIST. 31:2 (1982)          *!
+!*      The function returns a pseudo-random number uniformly    *!
+!*      distributed between 0 and 1.                             *!
+!*                                                               *!
+!*                  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                *!
+!*                                                               *!
+!*****************************************************************!
+REAL FUNCTION RAND()
+
+      INTEGER IE,IM,IG
+
+! IE, IM and IG should be set to integer values between
+! 1 and 30000 before the first entry.
+
+      COMMON /RANDOM/ IE,IM,IG
+      IE=171*MOD(IE,177)-2* (IE/177)
+      IM=172*MOD(IM,176)-35*(IM/176)
+      IG=170*MOD(IG,178)-63*(IG/178)
+
+      IF (IE.LT.0)IE=IE+30269
+      IF (IM.LT.0)IM=IM+30307
+      IF (IG.LT.0)IG=IG+30323
+
+      RAND = AMOD(FLOAT(IE) /30269.0+FLOAT(IM)/30307.0+ FLOAT(IG) /30323.0,1.0)
+               
+      RETURN
+
+END function rand

source_code/version_2.3_windows/read_spec.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*      readspec:   Read species parameters from file            *!
+!*                                                               *!
+!*                  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 readspec
+
+! input of species data from file
+
+use data_par
+use data_simul
+use data_species
+use data_stand
+use data_soil_cn
+use data_soil
+implicit none
+integer i,ios,nowunit
+character text
+logical ex
+
+nowunit=getunit()
+     if (.not.flag_mult8910) then
+         print *,' '
+         print *,' >>>foresee message: now reading species parameter file...'
+     endif
+
+do
+  call testfile(specfile(ip),ex)
+  if (.not.flag_mult8910) print *,' '
+  if(ex .eqv. .false.) cycle
+  exit
+end do
+
+open(nowunit, FILE=trim(specfile(ip)), ACTION="READ")
+do
+  read(nowunit,'(A)') text
+  if (text .ne. '!') then
+    exit
+  end if
+end do
+backspace nowunit
+
+  read(nowunit,*) text, nspecies
+  read(nowunit,*) text, nspec_tree
+  
+  if(.not.allocated(spar)) allocate(spar(nspecies))
+  if(.not.allocated(svar)) allocate(svar(nspecies))
+  if(.not.allocated(nrspec)) allocate(nrspec(nspecies))
+  nrspec = 0
+
+! read intermediate lines
+  do
+    read(nowunit,'(A)') text
+    if (text .ne. '!') then
+        exit
+    end if
+  end do
+  backspace nowunit
+
+  do i=1,nspecies
+    read(nowunit,*) text,spar(i)%species_name
+    if (text .ne. '!') then
+ 	    svar(i)%daybb      = 0
+	    svar(i)%ext_daybb  = 0
+	    svar(i)%sum_nTreeA = 0
+	    svar(i)%anz_coh    = 0
+	    svar(i)%RedN       = -99.0
+	    svar(i)%RedNm      = 0.0
+	    svar(i)%med_diam   = 0.0
+	    svar(i)%dom_height = 0.0
+	    svar(i)%drIndAl    = 0.0
+	    svar(i)%sumNPP     = 0.0
+	    svar(i)%sum_bio    = 0.0
+	    svar(i)%sum_lai    = 0.0
+	    svar(i)%act_sum_lai= 0.0
+	    svar(i)%fol        = 0.0
+	    svar(i)%hrt        = 0.0
+	    svar(i)%sap        = 0.0
+	    svar(i)%frt        = 0.0
+	    svar(i)%totsteminc = 0.0
+	    svar(i)%totstem_m3 = 0.0
+	    svar(i)%sumvsab    = 0.0
+        svar(i)%sumvsdead     = 0.0
+        svar(i)%sumvsdead_m3 = 0.
+	    svar(i)%crown_area = 0.0
+	    svar(i)%Ndem       = 0.0
+	    svar(i)%basal_area = 0.0
+	    svar(i)%sumvsab    = 0.0
+    else
+        write (*,*) '! *** not enough species in ', specfile(ip), (i-1),' of ', nspecies 
+        call errorfile (specfile(ip), 0, nowunit)
+        call error_mess(time, 'not enough species in '//specfile(ip), real(i-1))
+        exit
+    endif
+  enddo
+
+! read intermediate lines
+  read(nowunit,'(A)') text
+  if (text .ne. '!') then
+      do
+        read(nowunit,'(A)') text
+        if (text .eq. '!') then
+            do
+              read(nowunit,'(A)') text
+              if (text .ne. '!') then
+                exit
+              end if
+            end do
+            exit
+        end if
+      end do
+  else
+    do
+      read(nowunit,'(A)') text
+      if (text .ne. '!') then
+        exit
+      end if
+    end do
+  endif
+  backspace nowunit
+
+  read(nowunit,*) text,(spar(i)%species_short_name,i=1,nspecies)  ! read abbreviated names
+  read(nowunit,*) text,(spar(i)%max_age,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%yrec,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%stol,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pfext, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%sigman,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%respcoeff,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%prg,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%prms,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%prmr,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%psf,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pss,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%psr,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pcnr,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ncon_fol,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ncon_frt,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ncon_crt,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ncon_tbc,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ncon_stem,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%reallo_fol,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%reallo_frt,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%alphac,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%cr_frac,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%prhos,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pnus,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha_coeff1,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha_coeff2,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha_v1,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha_v2,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pha_v3,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%crown_a,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%crown_b,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%crown_c,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%psla_min,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%psla_a,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%phic,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pnc,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%kCO2_25,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%kO2_25,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pc_25,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%q10_kCO2,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%q10_kO2,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%q10_pc,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pb,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PItmin,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PItopt,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PItmax,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PIa,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PPtmin,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PPtopt,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PPtmax,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PPa,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%PPb,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%CSTbC,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%CSTbT,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%CSa,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%CSb,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%LTbT,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%LTcrit,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%Lstart,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%Phmodel,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%end_bb,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%fpar_mod,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ceppot_spec,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%Nresp,i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%regflag, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%seedrate, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%seedmass, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%seedsd, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%seeda, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%seedb, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pheight1, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pheight2, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pheight3, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pdiam1, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pdiam2, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%pdiam3, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_opm_fol , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_syn_fol , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_opm_frt , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_syn_frt , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_opm_crt , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_syn_crt , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_opm_tb  , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_syn_tb  , i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_opm_stem, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%k_syn_stem, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%spec_rl, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%tbase, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%topt, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%bdmax_coef, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%porcrit_coef, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ph_opt_max, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ph_opt_min, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ph_max, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%ph_min, i=1,nspecies)
+  read(nowunit,*) text,(spar(i)%v_growth, i=1,nspecies)
+
+ios = 0
+call errorfile (specfile(ip), ios, nowunit)
+
+do i=1,nspecies
+   spar(i)%cnr_fol  = cpart / (spar(i)%ncon_fol  / 1000.)
+   spar(i)%cnr_frt  = cpart / (spar(i)%ncon_frt  / 1000.)
+   spar(i)%cnr_crt  = cpart / (spar(i)%ncon_crt  / 1000.)
+   spar(i)%cnr_tbc  = cpart / (spar(i)%ncon_tbc  / 1000.)
+   spar(i)%cnr_stem = cpart / (spar(i)%ncon_stem / 1000.)
+enddo
+
+close(nowunit)
+
+end subroutine  readspec
+!------------------------------------------------------------------------
+
+
+

source_code/version_2.3_windows/readsim.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*    - READSIM:   Read simulation options from file             *!
+!*    - ALLOFILE:  Allocate simulation files                     *!
+!*    - READCON                                                  *!
+!*                                                               *!
+!*                  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 readsim
+
+! read simulation options from file
+
+use data_mess
+use data_out
+use data_par
+use data_simul
+use data_species
+use data_stand
+use data_site
+use data_tsort
+use data_climate
+
+
+implicit none
+
+logical ex
+integer i, ios, ios1, nowunit, nowunit1, k, anzclim, j, l, helpi, helpw, helpy, ihelp, ilen
+integer ltsunit
+character:: a, ttext
+character (150) tspec, tname, tclim, tval, tsite, tman, ttree, tdepo, tred, tlit, tsoilid, &
+                    pathdir1, pathdir2,pathdir3, pathdir4, pathdir5, pathdir6, pathdir7, &
+                    climszen, siteall, climall,site_name_all
+character(50), dimension(:), allocatable:: site_name_ad
+character(50), dimension(:), allocatable:: climfile_ad
+character(50), dimension(:), allocatable:: sitefile_ad
+character(50), dimension(:), allocatable:: manfile_ad
+character(50), dimension(:), allocatable:: treefile_ad
+character(50), dimension(:), allocatable:: wpmfile_ad
+character(50), dimension(:), allocatable:: depofile_ad
+character(50), dimension(:), allocatable:: redfile_ad
+character(50), dimension(:), allocatable:: litfile_ad
+character(150):: text 
+character(50) :: istand 
+character(10) :: helpsim, text4 
+integer :: spec1, spec2, tm
+real  :: h1, h2
+ 
+real, dimension(:), allocatable:: clim_long, clim_lat, clim_height    ! coordinates and height of climate stations
+character(10), dimension(:), allocatable:: climnum
+character(50), dimension(:), allocatable:: clim_nam
+
+    nowunit = getunit()
+    ios  = 0
+    nvar = 0
+
+    call testfile(simfile,ex)
+    if(ex .eqv. .false.) return
+    open(nowunit,file=simfile,iostat=ios,status='old',action='read')
+
+    read(nowunit,*,iostat=ios) flag_multi
+    
+    if(flag_multi .ge. 1) then      
+        read(nowunit,*,iostat=ios) site_nr
+
+        if(flag_multi .eq. 9 .or. flag_multi .eq. 10) then
+            flag_mult910 = .True.
+        else
+            flag_mult910 = .False.
+        endif
+        
+        if((flag_mult910 .or. flag_multi .eq. 8) .and. (site_nr .gt.1)) then
+            flag_mult8910 = .True.
+        else
+            flag_mult8910 = .False.
+        endif
+
+		repeat_number = site_nr
+              allocate(sitenum(site_nr))
+              allocate(clim_id(site_nr))
+              allocate(soilid(site_nr))
+              allocate(gwtable(site_nr))
+              allocate(NOdep(site_nr))
+              allocate(NHdep(site_nr))
+              clim_id = "xxx"
+              NOdep = 0.
+              NHdep = 0.
+    endif
+
+    select case (flag_multi)
+    case (1, 4)
+        flag_clim = 1
+    case (7, 8, 9, 10)
+        flag_clim = 1
+        flag_trace = .FALSE.
+    case default
+        flag_clim = 0
+    end select
+
+    read(nowunit,*,iostat=ios) ! skip comment line 'simulation specifications'
+    read(nowunit,*,iostat=ios) year
+    read(nowunit,*,iostat=ios) time_b
+    read(nowunit,*,iostat=ios) kpatchsize
+    read(nowunit,*,iostat=ios) dz
+    read(nowunit,*,iostat=ios) ns_pro
+    read(nowunit,*,iostat=ios) ! skip comment line 'choice of model options'
+    read(nowunit,*,iostat=ios) flag_mort
+    read(nowunit,*,iostat=ios) flag_reg
+    read(nowunit,*,iostat=ios) flag_lambda
+    read(nowunit,*,iostat=ios) flag_stand
+    read(nowunit,*,iostat=ios) flag_sveg
+    read(nowunit,*,iostat=ios) flag_mg
+    read(nowunit,*,iostat=ios) flag_dis
+    read(nowunit,*,iostat=ios) flag_light
+    read(nowunit,*,iostat=ios) flag_folhei
+    read(nowunit,*,iostat=ios) flag_volfunc
+    read(nowunit,*,iostat=ios) flag_resp
+    read(nowunit,*,iostat=ios) flag_limi
+    read(nowunit,*,iostat=ios) flag_decomp
+    read(nowunit,*,iostat=ios) flag_sign
+    read(nowunit,*,iostat=ios) flag_wred
+    read(nowunit,*,iostat=ios) flag_wurz
+    read(nowunit,*,iostat=ios) flag_cond
+    read(nowunit,*,iostat=ios) flag_int
+    read(nowunit,*,iostat=ios) flag_eva
+    read(nowunit,*,iostat=ios) flag_co2
+    read(nowunit,*,iostat=ios) flag_sort
+    read(nowunit,*,iostat=ios) flag_wpm
+    read(nowunit,*,iostat=ios) flag_stat
+    read(nowunit,*,iostat=ios) ! skip comment line 'output specifications'
+    read(nowunit,*,iostat=ios) time_out
+
+    ! test lamda_ts
+
+   if(flag_lambda.eq.1) then
+       allocate(lambda_ts(168,3))
+       ltsunit=getunit()
+       open (ltsunit,file='input/lambdats_oak_pine.par', IOSTAT=ios,status='old')
+       read (ltsunit,*), text, spec1, spec2
+       !write(4567,*)text, spec1,spec2
+     
+    do j=1,168
+       read(ltsunit,*) tm, h1, h2
+       
+  
+             lambda_ts(j,1)= tm
+             lambda_ts(j,2) = h1
+             lambda_ts(j,3) = h2
+!             write(4567,*) lambda_ts(j,1), lambda_ts(j,2), lambda_ts(j,3)
+                
+       end do
+       
+   end if   
+!     define name of yearly output variables
+      nyvar = 1
+      read(nowunit,*,iostat=ios) outy_file(nyvar)
+      do while (trim(outy_file(nyvar)) .ne. 'end')
+         nyvar = nyvar + 1
+         read(nowunit,*) outy_file(nyvar)
+      enddo
+
+     read(nowunit,*,iostat=ios) flag_dayout
+!     define name of daily output variables
+      ndvar = 1
+      read(nowunit,*) outd_file(ndvar)
+      do while (trim(outd_file(ndvar)) .ne. 'end')
+          ndvar = ndvar + 1
+          read(nowunit,*) outd_file(ndvar)
+      enddo
+
+    read(nowunit,*,iostat=ios) flag_cohout
+!     define name of cohort output variables
+      ncvar = 1
+      read(nowunit,*) outc_file(ncvar)
+      do while (trim(outc_file(ncvar)) .ne. 'end')
+         ncvar = ncvar + 1
+         read(nowunit,*) outc_file(ncvar)
+      enddo
+      
+    read(nowunit,*,iostat=ios) flag_sum
+    read(nowunit,*,iostat=ios) ! skip comment line 'input'
+
+    if (.not.flag_mult910) call allofile
+
+ SELECT CASE(flag_multi)
+ CASE (0,1,2,3,6)
+      jpar = 0
+      DO i=1,site_nr
+        if(i .gt. 1)then
+          read(nowunit,*,iostat=ios) ! skip comment line 'run number'
+          do
+             jpar = jpar + 1
+             read(nowunit,*) vpar(jpar), simpar(jpar)
+             if (vpar(jpar) .lt. -90.0) exit
+          enddo
+        endif
+
+        read(nowunit,'(A)',iostat=ios) specfile(i)
+        read(nowunit,'(A)') site_name(i)
+        read(nowunit,'(A)') climfile(i)
+        read(nowunit,'(A)') sitefile(i)
+        read(nowunit,'(A)') valfile(i)
+        read(nowunit,'(A)') treefile(i)
+        read(nowunit,'(A)') standid(i)
+        read(nowunit,'(A)') manfile(i)
+        read(nowunit,'(A)') depofile(i)
+        read(nowunit,'(A)') redfile(i)
+        read(nowunit,'(A)',iostat=ios) litfile(i)
+        
+      ! fill clim_id   
+        clim_id(i) = climfile(i)
+      ios1=-1
+      ! measurements
+	   if(flag_multi.ne.2) then
+        if (ios .eq. 0) read(nowunit,'(A)',iostat=ios1) text
+        if (ios1 .eq. 0) then
+            if (flag_stat .gt. 0 .and. i .eq. 1) then
+               allocate (mesfile(anz_mesf)) 
+               mesfile(1) = text
+               ttext = adjustl(text)
+               if (ttext .eq. '!' .or. ttext .eq. '*') then
+                  backspace (nowunit)
+               else
+                  if (.not.flag_mult8910) write (*, '(A, I3,A,A)')' >>>foresee message: site_nr ',i,'; filename of measurements:  ', trim(mesfile(1))
+               endif 
+            else
+               ttext = adjustl(text)
+               if (ttext .eq. '!' .or. ttext .eq. '*') backspace (nowunit)
+            endif
+        endif
+        end if
+     if (.not.flag_mult8910) print *, ' >>>foresee message: site_nr ',i,'; input of filenames completed'
+      end DO
+
+ CASE (4, 5, 8)
+      allocate(latitude(site_nr))
+      allocate(RedN_list(15, site_nr))
+      RedN_list = -99.9
+      read(nowunit,'(A)',iostat=ios) specfile(1)
+      read(nowunit,'(A)') site_name(1)
+      read(nowunit,'(A)') treefile(1)
+      read(nowunit,'(A)') manfile(1)
+      read(nowunit,'(A)') siteall       !   control xxx.con
+      read(nowunit,'(A)') climall       ! climate stations with coordination
+      read(nowunit,'(A)') pathdir1      ! path for climate scenarios 
+      read(nowunit,'(A)') pathdir2      ! path for soil file xxx.sop or name of total soil file (flag_multi=8)
+      read(nowunit,'(A)') climszen      ! labeling climate scenarios
+      if (flag_multi .eq. 8.or.flag_multi.eq.5) read(nowunit,*) text   ! BRB / BAWUE / DEU
+      if (.not.flag_mult8910) print *, ' >>>foresee message: Input of filenames completed'
+
+      site_name1   = site_name(1)
+!  define name of output variables
+      nvar = 1
+      read(nowunit,*) outvar(nvar)
+      do while (trim(outvar(nvar)) .ne. 'end')
+         nvar = nvar + 1
+         read(nowunit,*) outvar(nvar)
+      enddo
+      if (nvar .gt. 1) allocate(output_var(nvar,site_nr,0:year))
+
+          helpw = 0
+          helpi = 0
+          do i = 1, nvar-1
+             select case (trim(outvar(i)))
+
+              case ('AET_mon','AETmon','aetmon','aet_mon','cwb_mon','cwbmon','PET_mon','PETmon','petmon','pet_mon', &
+                    'GPP_mon','GPPmon','gppmon','gpp_mon','NEP_mon','NEPmon','nepmon','nep_mon','NPP_mon','NPPmon','nppmon','npp_mon', &
+                    'perc_mon','percmon','temp_mon','tempmon','prec_mon','precmon', 'resps_mon','respsmon','TER_mon','TERmon','ter_mon','termon')  
+                flag_cum = 1
+                helpi    = helpi + 1
+                output_var(i,1,0) = 1.*helpi              ! field numbre of monthly value
+
+              case ('AET_week','AETweek','aetweek','aet_week','cwb_week','cwbweek','PET_week','PETweek','petweek','pet_week', &
+                    'GPP_week','GPPweek','gppweek','gpp_week','NEP_week','NEPweek','nepweek','nep_week','NPP_week','NPPweek','nppweek','npp_week', &
+                    'perc_week','percweek','temp_week','tempweek','prec_week','precweek', 'resps_week','respsweek', 'TER_week','TERweek','ter_week','terweek')  
+                flag_cum = 1
+                helpw    = helpw + 1
+                output_var(i,1,0) = 1.*helpw              ! field numbre of weekly values
+
+             end select   ! outvar
+      
+          enddo
+          if (helpi .gt. 0) then
+             allocate(output_varm(helpi,site_nr,year,12))
+          endif
+          if (helpw .gt. 0) then
+             allocate(output_varw(helpw,site_nr,year,52))
+          endif
+
+      call errorfile(simfile, ios, nowunit)
+
+!  reading file with description of climate stations used
+      allocate(climnum(3000))
+      allocate(clim_long(3000))
+      allocate(clim_lat(3000))
+      allocate(clim_height(3000))
+      allocate(clim_nam(3000))
+
+      call testfile(climall,ex)
+      if (ex .eqv. .false.) return
+      nowunit1 = getunit()
+      ios1 = 0
+      open(nowunit1,file=climall,iostat=ios,status='old',action='read')
+      k=1
+      do
+         READ(nowunit1,'(A)',iostat=ios1) a
+         IF (a .ne. '!') exit
+
+      end do
+      backspace nowunit1
+
+      do
+          read(nowunit1,*,iostat=ios1) climnum(k), clim_long(k),clim_lat(k),    &
+                                    clim_height(k)  
+          if(ios1 .lt. 0) exit
+          k = k+1
+      end do
+      anzclim = k-1
+      ios1 = 0
+
+      call errorfile(climall, ios1, nowunit1)
+
+! reading control file with site-id, climate-id, soil-id, gwtabe-id
+      call testfile(siteall,ex)
+      if (ex .eqv. .false.) return
+      nowunit1 = getunit()
+      open(nowunit1,file=siteall,iostat=ios1,status='old',action='read')
+      do
+         READ(nowunit1,'(A)',iostat=ios1) a
+         IF (a .ne. '!') exit
+
+      end do
+      backspace nowunit1
+!      if (flag_multi .eq. 8) read(nowunit1,*) text   ! BRB / BAWUE / DEU
+ 
+      select case (trim(text))
+      case ('BRB')
+        flag_climnam = 1
+      case ('BAWUE')
+        flag_climnam = 2
+      case ('DEU')
+        flag_climnam = 3
+	  case ('REMO')
+	    flag_climnam = 4
+	  case('WETTREG')
+	    flag_climnam =5
+      end select
+
+      do i=1,site_nr
+          select case (flag_multi)
+          case (4)
+             read(nowunit1,*,iostat=ios1) sitenum(i), clim_id(i), soilid(i), gwtable(i)
+             flag_climnam = 1
+            
+             sitefile(i) =trim(pathdir2)//'wbuek'//trim(soilid(i))//'.sop'
+             valfile(i)  =trim(pathdir2)//'wbuek'//trim(soilid(i))//'.soi'
+             standid(i)   = sitenum(i)
+
+          case (5,8)
+             call readcon(i, nowunit1)  
+             soilid(i) = adjustl(soilid(i))
+             ihelp = len(trim(soilid(i)))
+             sitefile(i) = trim(pathdir2)
+               if( flag_climnam.eq.3) then
+			      climfile(i) = trim(pathdir1)//trim(clim_id(i))//trim(climszen)//'.dat'
+			   end if
+               if(flag_climnam.eq.4) then
+			      climfile(i) = trim(pathdir1)//'gp_'//trim(clim_id(i))//'_'//trim(climszen)//'.txt'
+			   end if
+
+               if(flag_climnam.eq.5) then
+			      climfile(i) = trim(pathdir1)//trim(clim_id(i))//'_'//trim(climszen)//'.dat'
+               end if
+		  end select
+
+
+         do j = 1,anzclim
+           if(clim_id(i).eq.climnum(j)) then
+             select case (flag_climnam)
+ 
+             case (1)    ! WK
+                if(flag_climtyp .eq. 5) then
+                   climfile(i) = trim(pathdir1)//trim(clim_nam(j))//trim(climszen)//'.dat'
+                else
+                   climfile(i) = trim(pathdir1)//trim(clim_nam(j))//trim(climszen)//'.cli'
+                end if
+
+             case (2)    ! Klara
+                climfile(i) = trim(pathdir1)//trim(climnum(j))//trim(climszen)//'.dat'
+             end select
+             latitude(i) = clim_lat(j)
+             exit
+           end if
+           if (j .eq. anzclim) then
+              write (unit_err,*) '***  4C-error - searching in file:', trim(climall)
+              write (unit_err,*) '                no climate station found for climate id: ', clim_id(i)
+              write (unit_err,*) 
+           endif
+         end do
+
+!          fill in sitefile
+         site_name(i) = site_name(1)
+         specfile(i)  = specfile(1)
+         treefile(i)  = treefile(1)
+         manfile(i)   = manfile(1)
+         depofile(i)  = 'dummy.dep'
+         redfile      = 'dummy.red'
+         litfile      = 'dummy.lit'
+      enddo
+
+      if ((.not.flag_mult8910) .and. (ios1 .lt. 0)) print *, 'no information for site number ', i
+      call errorfile(siteall, ios1, nowunit1)
+
+      deallocate(climnum)
+      deallocate(clim_long)
+      deallocate(clim_lat)
+      deallocate(clim_height)
+      deallocate(clim_nam)
+
+      close(nowunit1)
+
+!  variation of flag_multi= 5, especially for SILVISTRAT
+ CASE (7)
+
+      allocate(site_name_ad(site_nr))
+      allocate(climfile_ad(site_nr))
+      allocate(sitefile_ad(site_nr))
+      allocate(manfile_ad(site_nr))
+      allocate(treefile_ad(site_nr))
+      allocate(depofile_ad(site_nr))
+      allocate(redfile_ad(site_nr))
+      allocate(litfile_ad(site_nr))
+      
+      allocate(fl_co2(site_nr))
+
+      read(nowunit,'(A)',iostat=ios) specfile(1)
+      read(nowunit,'(A)') site_name_all
+      read(nowunit,'(A)') siteall
+      read(nowunit,'(A)') pathdir1    ! path climate file
+      read(nowunit,'(A)') pathdir2    ! path soil file
+      read(nowunit,'(A)') pathdir3    ! path treeini file
+      read(nowunit,'(A)') pathdir4    ! path management file
+      read(nowunit,'(A)') pathdir5    ! path deposition file
+      read(nowunit,'(A)') pathdir6    ! path RedN file
+      read(nowunit,'(A)') pathdir7    ! path litter file
+
+      call errorfile(simfile, ios, nowunit)
+
+! reading control file with site-id,name, climate scenario, soil-id, man-file, treeini-file, dep-file
+
+      call testfile(siteall,ex)
+      if (ex .eqv. .false.) return
+
+      nowunit1 = getunit()
+
+      open(nowunit1,file=siteall,iostat=ios1,status='old',action='read')
+      do
+         READ(nowunit1,'(A)',iostat=ios1) a
+         IF (a .ne. '!') exit
+
+      end do
+      backspace nowunit1
+
+      do i=1,site_nr
+         read(nowunit1,*,iostat=ios1) sitenum(i),site_name_ad(i), climfile_ad(i),sitefile_ad(i),treefile_ad(i), &
+                                      manfile_ad(i),depofile_ad(i),redfile_ad(i),litfile_ad(i), fl_co2(i) 
+         specfile(i) = specfile(1)
+         standid(i)  = sitenum(i)
+         site_name(i)= trim(site_name_all)//trim(site_name_ad(i))
+         climfile(i) = trim(pathdir1)//trim(climfile_ad(i))
+         sitefile(i) = trim(pathdir2)//trim(sitefile_ad(i))
+         treefile(i) = trim(pathdir3)//trim(treefile_ad(i))
+         manfile(i)  = trim(pathdir4)//trim(manfile_ad(i))
+         depofile(i) = trim(pathdir5)//trim(depofile_ad(i))
+         redfile(i)  = trim(pathdir6)//trim(redfile_ad(i))
+         litfile(i)  = trim(pathdir7)//trim(litfile_ad(i))
+
+      enddo
+       call errorfile(siteall, ios1, nowunit1)
+
+       deallocate(site_name_ad)
+       deallocate(climfile_ad)
+       deallocate(sitefile_ad)
+       deallocate(manfile_ad)
+       deallocate(treefile_ad)
+       deallocate(depofile_ad)
+       deallocate(redfile_ad)
+       deallocate(litfile_ad)
+	   if (allocated(wpmfile_ad)) deallocate(wpmfile_ad)
+
+      close(nowunit1)
+
+ CASE (9, 10)
+
+ ! read once only per climate station 
+    allocate(sitefile(site_nr))
+    allocate(climfile(site_nr))
+    allocate(treefile(site_nr))
+    allocate(manfile(site_nr))
+    allocate(standid(site_nr))
+    allocate(latitude(site_nr))
+    allocate(site_name(site_nr))
+    allocate(RedN_list(15, site_nr))
+    RedN_list = -99.9
+
+ ! read once only
+    allocate(specfile(1))
+    allocate(depofile(1))
+    allocate(redfile(1))
+    allocate(litfile(1))
+    allocate(valfile(1))
+
+      read(nowunit,'(A)',iostat=ios) specfile(1)
+      read(nowunit,'(A)') site_name(1)
+      read(nowunit,'(A)') treefile(1)
+      read(nowunit,'(A)') manfile(1)
+      read(nowunit,'(A)') siteall       ! control file xxx.con
+      read(nowunit,'(A)') climall       ! climate station with coordiantes
+      read(nowunit,'(A)') pathdir1      ! path of climate scenarios
+      read(nowunit,'(A)') pathdir2      ! path of soil file xxx.sop or name of total soil file (flag_multi=8)
+      read(nowunit,'(A)') climszen      ! labeling climate scenarios
+      read(nowunit,'(A)') text          ! degree of climate scenarios
+      read(nowunit,*) nrreal            ! amount of realisations/implementations
+
+      if (.not.flag_mult8910) print *, ' >>>foresee message: Input of filenames completed'
+
+      depofile(1)  = 'dummy.dep'
+      redfile(1)   = 'dummy.red'
+      litfile(1)   = 'dummy.lit'
+      site_name    = site_name(1)
+      site_name1   = site_name(1)
+
+      ilen   = len(trim(text))
+      text   = adjustl(text)
+      nrclim = 0                     
+      do while (ilen .gt. 0)
+          nrclim = nrclim + 1
+          ihelp = scan(text, ' ')
+          typeclim(nrclim) = adjustl(text(1:ihelp-1))
+          text = adjustl(text(ihelp:))
+          ilen = len(trim(text))
+      enddo
+  
+  ! processing of nrreal realisations/implementations of climate scenarios
+      site_anz = nrreal * nrclim * site_nr
+      allocate(climszenfile(site_nr, nrclim, nrreal))
+
+!  define name of output variables
+      nvar = 1
+      read(nowunit,*) outvar(nvar)
+      do while (trim(outvar(nvar)) .ne. 'end')
+         nvar = nvar + 1
+         read(nowunit,*) outvar(nvar)
+      enddo
+
+      if (nvar .gt. 1)  then
+          allocate(output_var(nvar-1,1,0:year))
+          allocate(output_unit(nvar-1))
+          allocate(climszenres(nvar-1,site_nr,nrclim,nrreal))
+          output_unit     = -99
+          output_unit_all = -99
+
+          helpy = 0
+          helpi = 0
+          helpw = 0
+          do i = 1, nvar-1
+
+             select case (trim(outvar(i)))
+
+              case ('AET_year','AETyear','aetyear','aet_year','cwb_year','cwbyear','PET_year','PETyear','petyear','pet_year', &
+                    'GPP_year','GPPyear','gppyear','gpp_year','NEP_year','NEPyear','nepyear','nep_year','NPP_year','NPPyear','nppyear','npp_year', &
+                    'perc_year','percyear','temp_year','tempyear','prec_year','precyear', 'resps_year','respsyear','TER_year','TERyear','ter_year','teryear')  
+                flag_cum = 1
+                helpy    = helpy + 1
+                output_var(i,1,0) = 1.*helpy              ! field numbre of yearly values
+
+              case ('AET_mon','AETmon','aetmon','aet_mon','cwb_mon','cwbmon','PET_mon','PETmon','petmon','pet_mon', &
+                    'GPP_mon','GPPmon','gppmon','gpp_mon','NEP_mon','NEPmon','nepmon','nep_mon','NPP_mon','NPPmon','nppmon','npp_mon', &
+                    'perc_mon','percmon','temp_mon','tempmon','prec_mon','precmon', 'resps_mon','respsmon','TER_mon','TERmon','ter_mon','termon')  
+                flag_cum = 1
+                helpi    = helpi + 1
+                output_var(i,1,0) = 1.*helpi              ! field numbre of monthly values
+
+              case ('AET_week','AETweek','aetweek','aet_week','cwb_week','cwbweek','PET_week','PETweek','petweek','pet_week', &
+                    'GPP_week','GPPweek','gppweek','gpp_week','NEP_week','NEPweek','nepweek','nep_week','NPP_week','NPPweek','nppweek','npp_week', &
+                    'perc_week','percweek','temp_week','tempweek','prec_week','precweek', 'resps_week','respsweek', 'TER_week','TERweek','ter_week','terweek')  
+                flag_cum = 1
+                helpw    = helpw + 1
+                output_var(i,1,0) = 1.*helpw              ! field numbre of weekly values
+
+             end select   ! outvar
+      
+          enddo
+          if (helpy .gt. 0) then
+             allocate(climszenyear(helpy,site_nr,nrclim,nrreal,year))
+          endif
+          if (helpi .gt. 0) then
+             allocate(climszenmon(helpi,site_nr,nrclim,nrreal,12))
+             allocate(output_varm(helpi,1,year,12))
+          endif
+          if (helpw .gt. 0) then
+             allocate(climszenweek(helpw,site_nr,nrclim,nrreal,52))
+             allocate(output_varw(helpw,1,year,52))
+          endif
+      endif   ! nvar
+
+      call errorfile(simfile, ios, nowunit)
+
+!  reading file with description of climate stations used
+      allocate(climnum(3000))
+      allocate(clim_long(3000))
+      allocate(clim_lat(3000))
+      allocate(clim_height(3000))
+      allocate(clim_nam(3000))
+
+      call testfile(climall,ex)
+      if (ex .eqv. .false.) return
+      nowunit1 = getunit()
+      ios1 = 0
+      open(nowunit1,file=climall,iostat=ios,status='old',action='read')
+      k=1
+      do
+         READ(nowunit1,'(A)',iostat=ios1) a
+         IF (a .ne. '!') exit
+
+      end do
+      backspace nowunit1
+
+      do
+          read(nowunit1,*,iostat=ios1) climnum(k), clim_long(k),clim_lat(k), clim_height(k)
+          if(ios1 .lt. 0) exit
+          k = k+1
+      end do
+      anzclim = k-1
+      ios1 = 0
+
+      call errorfile(climall, ios1, nowunit1)
+      
+! reading control file with site-id, climate-id, soil-id, gwtabe-id
+
+      call testfile(siteall,ex)
+      if (ex .eqv. .false.) return
+      nowunit1 = getunit()
+      open(nowunit1,file=siteall,iostat=ios1,status='old',action='read')
+      do
+         READ(nowunit1,'(A)',iostat=ios1) a
+         IF (a .ne. '!') exit
+      end do
+      backspace nowunit1
+
+      do i=1,site_nr
+         call readcon(i, nowunit1)  
+         
+         sitefile(i) = trim(pathdir2)
+		 if(i.gt.1) treefile(i)= treefile(1)
+		 if(i.gt.1) manfile(i) = manfile(1)
+         k = 1
+         do while (clim_id(i).ne.climnum(k)) 
+             k = k + 1
+             if (k .gt. anzclim) then
+                write (unit_err,*)
+                write (unit_err,*) ' >>>foresee message: Climate ID ', trim(clim_id(i)), ' not in file ',trim(climall)
+                write (unit_err,*) '                     Site number ',sitenum(i)
+                write (*,*)
+                write (*,*) ' >>>foresee message: Climate ID ', trim(clim_id(i)), ' not in file ',trim(climall)
+                write (*,*) '                     Site number ',sitenum(i)
+                print *,' Program will stop!'
+                flag_end = 4
+                return
+             endif
+         enddo
+      latitude(i) = clim_lat(k)
+         do l = 1, nrclim
+            do j = 1, nrreal
+                write (helpsim,'(I5)') j
+                read (helpsim,*) text4
+			    select case (flag_multi)
+			    case (9)
+			        climszenfile(i,l,j) = trim(pathdir1)//trim(typeclim(l))//'/real_'//trim(text4)//'/'//trim(clim_id(i))//trim(climszen)//'.dat'
+			    case (10)
+			        if (j .lt. 10) then
+			            text4 = '00'//text4
+			        else if (j .lt. 100)   then
+			            text4 = '0'//text4
+			        endif
+			        climszenfile(i,l,j) = trim(pathdir1)//'/q'//trim(text4)//'/'//trim(clim_id(i))//trim(climszen)//'.dat'
+                end select
+            enddo   !j
+         end do   !l
+      enddo
+
+      if ((.not.flag_mult8910) .and. (ios1 .lt. 0)) print *, 'no information for site number ', i
+      call errorfile(siteall, ios1, nowunit1)
+
+      deallocate(climnum)
+      deallocate(clim_long)
+      deallocate(clim_lat)
+      deallocate(clim_height)
+      deallocate(clim_nam)
+
+      close(nowunit1)
+
+ END SELECT
+
+    jpar = 0  ! reset jpar for restore
+
+    if(flag_multi .eq. 2)then
+              read (nowunit,*) step_sum_T,n_T_downsteps,n_T_upsteps
+              read (nowunit,*) step_fac_P,n_P_downsteps,n_P_upsteps
+
+              site_nr = (1+n_T_downsteps+n_T_upsteps) * (1+n_P_downsteps+n_P_upsteps)
+		      repeat_number = site_nr
+
+              tspec   = specfile(1)
+              tname   = site_name(1)
+              tclim   = climfile(1)
+              tsite   = sitefile(1)
+              tval    = valfile(1)
+              ttree   = treefile(1)
+              tman    = manfile(1)
+              tdepo   = depofile(1)
+              tred    = redfile(1)
+              tlit    = litfile(1)
+              istand  = standid(1)
+              tsoilid = soilid(1)
+
+              deallocate (specfile)
+              deallocate (site_name)
+              deallocate (climfile)
+              deallocate (clim_id)
+              deallocate (sitefile)
+              deallocate (valfile)
+              deallocate (treefile)
+              deallocate (manfile)
+              deallocate (depofile)
+              deallocate (redfile)
+              deallocate (litfile)
+			  deallocate (wpmfile)
+              deallocate (standid)
+              deallocate (soilid)
+              allocate (specfile(site_nr))
+              allocate (site_name(site_nr))
+              allocate (climfile(site_nr))
+              allocate (clim_id(site_nr))
+              allocate (sitefile(site_nr))
+              allocate (valfile(site_nr))
+              allocate (treefile(site_nr))
+              allocate (manfile(site_nr))
+              allocate (depofile(site_nr))
+              allocate (standid(site_nr))
+              allocate (soilid(site_nr))
+              allocate (redfile(site_nr))
+              allocate (litfile(site_nr))
+			  allocate (wpmfile(site_nr))
+
+              specfile  = tspec
+              site_name = tname
+              climfile  = tclim
+              sitefile  = tsite
+              valfile   = tval
+              treefile  = ttree
+              manfile   = tman
+              depofile  = tdepo
+              redfile   = tred
+              litfile   = tlit
+              standid   = istand
+              soilid    = tsoilid
+
+       call errorfile(simfile, ios, nowunit)
+
+    endif   ! flag_multi = 2
+close(nowunit)
+
+END subroutine readsim
+
+!**************************************************************
+
+SUBROUTINE allofile
+
+use data_simul
+
+implicit none
+
+    allocate(site_name(site_nr))
+    allocate(climfile(repeat_number))
+    allocate(sitefile(site_nr))
+    allocate(valfile(site_nr))
+    allocate(treefile(repeat_number))
+    allocate(standid(repeat_number))
+    allocate(manfile(repeat_number))
+    allocate(depofile(repeat_number))
+    allocate(redfile(repeat_number))
+    allocate(litfile(repeat_number))
+	allocate(wpmfile(repeat_number))
+    allocate(specfile(repeat_number))
+
+end subroutine allofile
+
+!**************************************************************
+
+SUBROUTINE readcon (ii, unitnum)
+
+use data_depo
+use data_out
+use data_par
+use data_simul
+use data_site
+
+implicit none
+
+integer ii, ihelp, unitnum, ios1, ilen, helpi
+character(150):: text  
+character(10):: helpsim, text4 
+
+         read(unitnum,'(A)',iostat=ios1) text     
+        ! text disassemble
+        ! sitenum
+          ilen  = len(trim(text))
+          text  = adjustl(text)
+          ihelp = verify(text, charset)      
+          text4 = adjustl(text(1:ihelp-1))
+          sitenum(ii) = text4
+          text  = adjustl(text(ihelp+1:))
+          ilen  = len(trim(text))
+          ihelp = scan(text, charset)
+          text  = text(ihelp:)
+          ihelp = verify(text, charset)
+          clim_id(ii) = adjustl(text(1:ihelp-1))
+          text  = adjustl(text(ihelp+1:))
+          ilen  = len(trim(text))
+          ihelp = scan(text, charset)
+          text  = text(ihelp:)
+          ihelp = verify(text, charset)
+          soilid(ii) = adjustl(text(1:ihelp-1))
+        ! gwtable
+          text  = adjustl(text(ihelp+1:))
+          ilen  = len(trim(text))
+          ihelp = scan(text, charset)
+          text  = text(ihelp:)
+          ihelp = verify(text, charset)
+          text4 = adjustl(text(1:ihelp-1))
+          write (helpsim,'(A)') text4
+          read (helpsim,*) gwtable(ii)
+        ! standid 
+          text  = adjustl(text(ihelp+1:))
+          ilen  = len(trim(text))
+          ihelp = scan(text, charset)
+          text  = text(ihelp:)
+          ihelp = verify(text, charset)
+          text4 = adjustl(text(1:ihelp-1))
+          standid(ii) = text4
+        ! deposition
+          text = adjustl(text(ihelp+1:))
+          ilen  = len(trim(text))
+          if (ilen .gt. 0) then
+              text  = adjustl(text)
+              ihelp = verify(text, charset)
+              text4 = adjustl(text(1:ihelp-1))
+              write (helpsim,'(A)') text4
+              read (helpsim,*) NOdep(ii)     ! hand over in readdepo as concentration
+              text  = adjustl(text(ihelp+1:))
+              ilen  = len(trim(text))
+              ihelp = scan(text, charset)
+              text  = text(ihelp:)
+              ihelp = verify(text, charset)
+              text4 = adjustl(text(1:ihelp-1))
+              write (helpsim,'(A)') text4
+              read (helpsim,*) NHdep(ii)     ! hand over in readdepo as concentration
+            ! RedN 
+              text = adjustl(text(ihelp+1:))
+              ilen = len(trim(text))
+              do while (ilen .gt. 0)
+                  ihelp = verify(text, charset)
+                  text4 = adjustl(text(1:ihelp-1))
+                  write (helpsim,'(A)') text4
+                  read (helpsim,*) helpi
+                  text = adjustl(text(ihelp+1:))
+                  ihelp = verify(text, charset)
+                  text4 = adjustl(text(1:ihelp-1))
+                  write (helpsim,'(A)') text4
+                  read (helpsim,*) RedN_list(helpi, ii)
+                  text = adjustl(text(ihelp+1:))
+                  ilen = len(trim(text))
+              enddo
+          else
+              NOdep(ii) = 0.
+              NHdep(ii) = 0.
+          endif
+
+End SUBROUTINE readcon

source_code/version_2.3_windows/root.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*                   Root distribution                           *!
+!*                                                               *!
+!* - ROOT_DISTR                                                  *!
+!* - ROOT_EFF                                                    *!
+!* - ROOT_DEPTH                                                  *!
+!* - ROOT_INI                                                    *!
+!* - DEALLOC_ROOT                                                *!
+!* - ROOTC_NEW (nicht benutzt wegen Problemen bei Verkettung)    *!
+!* - CR_DEPTH                                                    *!
+!*                                                               *!
+!*                  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 root_distr
+
+! Calculation of root distribution for each cohorte
+
+use data_simul
+use data_soil
+use data_stand
+use data_par
+use data_species
+
+implicit none
+
+integer specn     ! species type (number)
+integer i, j, nj, k, jlay
+integer nr        ! aux. var. for nroot (rooting depth)
+integer rkind     ! kind of calculation of root depth
+real    frtrel_1, frtrel_j  ! rel fine root fraction of previous layer
+real    frtrel_s  ! Sum of fine root fractions
+real    radius    ! radius of cylyndric space created by roots of the root length density 
+
+real beta         ! base of power
+real help
+real alpha, b	! Parameters for Arora function
+real troot2				! theoretical root biomass of population (coarse and fine roots) only for Arora funktion spereated according to cohorts [kg/m]
+real :: part_coef=0.0	! Verteilungskoeffizient um Verhltnis zwischen fr_loss und redis zu bestimmen
+real, dimension (1:nlay) :: fr_loss1, valspace, frtrelcoh	    !auxiliary vectors
+
+rkind = rdepth_kind
+
+if ((anz_tree + anz_sveg) .eq. 0) return
+select case (flag_wurz)
+
+case (0)
+   root_fr = 0.
+   zeig => pt%first
+   do while (associated(zeig))
+
+      call root_depth (rkind, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+      zeig%coh%nroot = nr
+      zeig%coh%frtrel = thick/depth(nr)
+      specn = zeig%coh%species
+
+	  do j = 1, nr
+         root_fr(j) = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+      enddo
+      do j = nr+1, nlay
+         zeig%coh%frtrel(j) = 0.
+      enddo
+      zeig%coh%rooteff = 0.   ! zero after use
+      zeig => zeig%next
+   enddo
+
+case (1)    ! Funktion
+   root_fr = 0.
+   zeig => pt%first
+   do while (associated(zeig))
+      call root_depth (rkind, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot) !nderung MG: bergabe von Grob und Feinwurzelmasse an root_depth
+      zeig%coh%nroot = nr
+      specn = zeig%coh%species
+      if (specn .eq. 2 .or. specn .eq. 3) then
+         beta = 0.976
+      else
+         beta = 0.966
+      endif
+	  frtrel_1        = 1.
+      zeig%coh%frtrel = 0.
+      do j=1,nr
+         frtrel_j           = beta ** depth(j)
+         zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+         frtrel_1           = frtrel_j
+      enddo
+      frtrel_s = SUM(zeig%coh%frtrel)
+      frtrel_s = 1./frtrel_s
+      do j=1,nr
+ !     scaling of root distribution
+         zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+         root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+      enddo
+
+      zeig%coh%rooteff = 0.   ! zero after use
+      zeig => zeig%next
+   enddo
+
+case (2)    ! read/use default distribution; not changed 
+
+   root_fr = 0.
+   zeig => pt%first
+   do while (associated(zeig))
+      if (zeig%coh%frtrel(1) .gt. 0.) then
+          do j = 1,nroot_max
+            root_fr(j) = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+          enddo
+      else
+           root_fr = 0.
+              call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot) 
+              zeig%coh%nroot = nr
+              specn = zeig%coh%species
+              if (specn .eq. 2 .or. specn .eq. 3) then
+                 beta = 0.98
+              else
+                 beta = 0.967
+              endif
+
+	          frtrel_1        = 1.
+              zeig%coh%frtrel = 0.
+              do j=1,nr
+                 frtrel_j           = beta ** depth(j)
+                 zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+                 frtrel_1           = frtrel_j
+              enddo
+              frtrel_s = SUM(zeig%coh%frtrel)
+              frtrel_s = 1./frtrel_s
+              do j=1,nr
+                 zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+                 root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+              enddo
+
+      endif
+
+      zeig%coh%rooteff = 0.   ! zero after use
+      zeig => zeig%next
+   enddo
+
+case (3)
+root_fr = 0.
+rkind=5
+
+zeig => pt%first
+   do while (associated(zeig))
+	  call root_depth (rkind, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot) !nderung MG: bergabe von Grob und Feinwurzelmasse an root_depth
+      zeig%coh%nroot = nr
+      specn = zeig%coh%species      
+	  alpha=0.7
+	  if (specn .eq. 2 .or. specn .eq. 3 .or. specn .eq. 6 .or. specn .eq. 7) then
+         b = 7.95
+      else
+         b = 10.91
+      endif
+ 
+	  frtrel_1        = 1.
+      zeig%coh%frtrel = 0.
+      do j=1,nr
+!        root distribution (Arora et al., 2003)
+         frtrel_j           = exp((-b/troot2**alpha)*(depth(j)/100))
+         zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+         frtrel_1           = frtrel_j		 
+	  enddo
+      frtrel_s = SUM(zeig%coh%frtrel)
+      frtrel_s = 1./frtrel_s
+      do j=1,nr
+ !     scaling of root distribution
+         zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+         root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA		 
+	  enddo
+
+      zeig%coh%rooteff = 0.   ! zero after use
+      zeig => zeig%next
+   enddo
+
+case(4)		! TRAP-model Rasse et al. (2001)
+root_fr = 0.
+rkind   = 6
+fr_loss1= 0
+k       = 0
+
+zeig => pt%first
+   do while (associated(zeig))
+	k=k+1
+	zeig%coh%x_rdpt=gr_depth(k)  
+    specn = zeig%coh%species
+  if (specn .eq. 12) then
+  continue
+  endif
+	call root_depth (rkind, specn, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+	zeig%coh%nroot = nr
+	
+	frtrel_1        = 1.
+    zeig%coh%frtrel = 0.
+      do j=1,nr
+         if (j .eq. 1) then
+		  zeig%coh%frtrel(j) = (zeig%coh%x_rdpt**3-(zeig%coh%x_rdpt-depth(j))**3)/zeig%coh%x_rdpt**3
+		   elseif (j .eq. nr) then
+		    zeig%coh%frtrel(j)= frtrel_1 
+		     else
+			  zeig%coh%frtrel(j) = ((zeig%coh%x_rdpt-depth(j-1))**3-((zeig%coh%x_rdpt-depth(j))**3))/zeig%coh%x_rdpt**3
+         endif
+		 frtrel_1 = frtrel_1-zeig%coh%frtrel(j)		 
+	  enddo
+	frtrel_s = SUM(zeig%coh%frtrel)
+    frtrel_s = 1./frtrel_s
+	zeig%coh%frtrel = zeig%coh%frtrel * frtrel_s
+	
+	fr_loss1 = zeig%coh%frtrel
+	fr_loss  = zeig%coh%frtrel*svar(specn)%Smean(1:nlay)
+	fr_loss  = part_coef*(fr_loss1-fr_loss)
+	redis    = zeig%coh%frtrel*svar(specn)%Smean(1:nlay)
+	redis    = part_coef*(fr_loss1-redis)
+
+	do j=1,nr
+ !     scaling of root distribution
+       if (sum(svar(specn)%Smean(1:nr)) .lt. 0.0001) then
+       zeig%coh%frtrel(j) = 0.
+       else
+       zeig%coh%frtrel(j) = zeig%coh%frtrel(j)*svar(specn)%Smean(j)+(sum(redis)*svar(specn)%Smean(j)/sum(svar(specn)%Smean(1:nr)))
+       endif
+	enddo
+
+	  frtrel_s = SUM(zeig%coh%frtrel)
+      if (frtrel_s .lt. 1.E-6) then
+          do j=1,nr
+             zeig%coh%frtrel(j) = 0
+	      enddo
+      else
+          frtrel_s = 1./frtrel_s
+          do j=1,nr
+   !     scaling of root distribution
+             zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+             root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA		 
+	      enddo
+      endif
+			
+	zeig%coh%rooteff = 0. 
+	zeig => zeig%next
+   enddo
+
+case(5)
+root_fr = 0.
+rkind=5
+   zeig => pt%first
+   do while (associated(zeig))
+
+
+      call root_depth (rkind, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot) !nderung MG: bergabe von Grob und Feinwurzelmasse an root_depth
+      zeig%coh%nroot = nr
+      specn = zeig%coh%species
+      if (specn .eq. 2 .or. specn .eq. 3) then
+         beta = 0.98
+      else
+         beta = 0.967
+      endif
+
+ 
+	  frtrel_1        = 1.
+      zeig%coh%frtrel = 0.
+      do j=1,nr
+!       root distribution (Jackson et al., 1996): beta ** depth
+         frtrel_j           = beta ** depth(j)
+         zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+         frtrel_1           = frtrel_j
+      enddo
+      frtrel_s = SUM(zeig%coh%frtrel)
+      frtrel_s = 1./frtrel_s
+      do j=1,nr
+ !     scaling of root distribution
+         zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+         root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+      enddo
+
+      zeig%coh%rooteff = 0.   ! zero after use
+      zeig => zeig%next
+   enddo
+
+case(6)
+
+root_fr = 0.
+rkind=7
+   zeig => pt%first
+   k=1
+   do while (associated(zeig))
+	  
+	  zeig%coh%x_rdpt=gr_depth(k)
+      call root_depth (rkind, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt,zeig%coh%nroot) !nderung MG: bergabe von Grob und Feinwurzelmasse an root_depth
+      
+	  if (time .le. 1) then
+	   root_lay(k)=nr
+	  else
+	   root_lay(k)=root_lay(k)+nr
+	  endif
+	  
+	  if (root_lay(k) .gt. nroot_max) root_lay(k) = nroot_max
+	  
+	  zeig%coh%nroot=root_lay(k)
+	  nr=root_lay(k)
+	  
+      specn = zeig%coh%species
+      if (specn .eq. 2 .or. specn .eq. 3) then
+         beta = 0.98
+      else
+         beta = 0.967
+      endif
+
+ 
+	  frtrel_1        = 1.
+      zeig%coh%frtrel = 0.
+      do j=1,nr
+!       root distribution (Jackson et al., 1996): beta ** depth
+         frtrel_j           = beta ** depth(j)
+         zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+         frtrel_1           = frtrel_j
+      enddo
+      frtrel_s = SUM(zeig%coh%frtrel)
+      frtrel_s = 1./frtrel_s
+      do j=1,nr
+ !     scaling of root distribution
+         zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+         root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+      enddo
+
+      zeig%coh%rooteff = 0.   ! zero after use
+	  k=k+1
+      zeig => zeig%next
+   enddo
+
+case (7)    ! Funktion nach Jackson (1996) mit fester Tiefe
+   root_fr = 0.
+   nr = nroot_max
+   zeig => pt%first
+   do while (associated(zeig))
+
+      zeig%coh%nroot = nroot_max
+      specn = zeig%coh%species
+      if (specn .eq. 2 .or. specn .eq. 3) then
+         beta = 0.98
+      else
+         beta = 0.967
+      endif
+
+	  frtrel_1        = 1.
+      zeig%coh%frtrel = 0.
+      do j=1,nr
+!       root distribution (Jackson et al., 1996): beta ** depth
+         frtrel_j           = beta ** depth(j)
+         zeig%coh%frtrel(j) = frtrel_1 - frtrel_j
+         frtrel_1           = frtrel_j
+      enddo
+      frtrel_s = SUM(zeig%coh%frtrel)
+      frtrel_s = 1./frtrel_s
+      do j=1,nr
+ !     scaling of root distribution
+         zeig%coh%frtrel(j) = zeig%coh%frtrel(j) * frtrel_s
+         root_fr(j)         = root_fr(j) + zeig%coh%frtrel(j) * zeig%coh%ntreeA
+      enddo
+
+      zeig%coh%rooteff = 0.   ! zero after use
+
+      zeig => zeig%next
+   enddo
+
+end select
+
+root_fr = root_fr / (anz_tree + anz_sveg)   ! normieren
+zeig => pt%first
+do while (associated(zeig))
+    help = zeig%coh%x_frt * zeig%coh%ntreea
+    do jlay = 1, nroot_max
+        if (root_fr(jlay) .gt. zero) then 
+            zeig%coh%frtrelc(jlay) = zeig%coh%frtrel(jlay) * help / (root_fr(jlay) * totfrt_p)  ! mass of root part of total cohort in a layer
+        else
+            zeig%coh%frtrelc(jlay) = 0.
+        endif
+    enddo
+    zeig => zeig%next
+enddo
+
+if (flag_wred .eq. 9) then
+
+   !Calculation of root length density
+   zeig => pt%first
+   do while (associated(zeig))
+        if (specn .le. nspec_tree) then
+            radius = (zeig%coh%diam/6.)*100.     ! formula bhd [cm]/6 yield radius in [m] so *100 (aus Wagner 2005)
+            valspace = pi * radius**2 * thick
+        else
+            valspace = kpatchsize * 100*100 * thick
+        endif                                                  !circular cylinder 
+    
+        frtrelcoh = zeig%coh%frtrel * zeig%coh%x_frt * zeig%coh%ntreea          
+    
+        if (zeig%coh%ntreea .gt. 0 .AND. minval(valspace(1:nr)) .gt. 0.) then
+            zeig%coh%rld = (frtrelcoh*1000*spar(specn)%spec_rl*100)/(valspace* zeig%coh%ntreea)   !in cm root length /cm3 volume
+	    else
+            zeig%coh%rld = -99
+        endif
+       
+      zeig => zeig%next
+   enddo
+endif
+
+if (allocated(wat_root)) wat_root=0.
+
+END	subroutine root_distr
+
+!**************************************************************
+
+SUBROUTINE root_eff
+
+! Calculation of root efficiency in dependence of water and N uptake
+use data_soil
+use data_soil_cn
+use data_stand
+
+implicit none
+
+integer i,j
+integer nr    ! layer number of root depth
+real hroot    ! root depth
+real fdc      ! discounting function describing transport resistance
+real gw, gN   ! accounting functions of water resp. N uptake
+real glimit   ! limitation constant for use of rooting layer
+
+glimit = 0.   ! min. assumption
+
+   i = 1
+   zeig => pt%first
+   do while (associated(zeig))
+      nr = zeig%coh%nroot
+      do j = 1,nr
+         fdc   = 50./depth(j)
+         if (zeig%coh%supply .gt. 1e-06) then
+            gw = xwatupt(i,j)/zeig%coh%supply
+            gw = gw / thick(j)
+         else
+		    gw = 0.
+		 endif
+
+         gw = xwatupt(i,j)     
+         zeig%coh%rooteff(j) = zeig%coh%rooteff(j) + gw
+      enddo
+      zeig%coh%watuptc = zeig%coh%watuptc + zeig%coh%supply
+      i = i + 1
+      zeig => zeig%next
+   enddo
+
+END	subroutine root_eff
+
+!**************************************************************
+
+SUBROUTINE root_depth(rkind, specn, agec, heightc, froot, croot, nr, troot2, crdepth, nrooth)
+
+use data_simul
+use data_soil
+use data_soil_cn
+use data_stand
+
+implicit none
+
+! input:
+integer rkind ! kind of calculation of root depth
+integer specn ! species number
+integer agec  ! tree age
+integer nrooth ! for case(7)
+
+real heightc, froot, croot					! tree height of cohort, fine and coarse root mass[kg]/ tree 
+real troot, troot1,troot2, troot_stand		! total root mass 1./tree 2./ha according to  cohorts 3. /m according to cohorts Kohorten 4./ha of 4C
+real :: wat_demand							! query whether one cohort was unable to cover water demand with the from root penetrated soil layer 
+real rootingdepth, crdepth				    ! rooting depth nach Arora function in [m]
+real alpha, b								! parameter for Arorafunction	
+! output:
+integer nr                                  ! last root layer
+
+integer i,j
+real hc, wtiefe
+real, dimension(4,3):: rdepth  ! effective rooting depth depending on tree age and soil texture
+! data from Raissi et al. (2001)
+data rdepth /85, 130, 175, 95, 140, 185, 135, 180, 225, 90, 110, 135/
+
+select case (rkind)
+
+case (1)
+ ! nroot depending on tree height and soil profile depth
+   nr = 1
+   do j=1,nlay
+      if (heightc .ge. depth(j)) nr = j
+   enddo
+   if (nr .gt. nroot_max) nr = nroot_max
+   crdepth = depth(nr)
+
+case (2)
+ ! fixed nroot for all adult cohorts
+   if (agec .lt. 10) then
+     nr = 1
+     wtiefe=depth(nroot_max)/(1+exp(1.5-0.55*real(agec)))		! logicla function to determin root depth [cm] until age 10	
+		do j=1,nlay
+			if (wtiefe .ge. depth(j)) nr = j
+		enddo
+     if (nr .gt. nroot_max) nr = nroot_max
+   else
+     nr = nroot_max
+   endif
+    crdepth = depth(nr)
+
+case (3)
+ ! nroot depending on root efficiency
+   nr = nlay  
+   crdepth = depth(nr)
+
+case (4)
+ ! nroot depending on soil texture and age
+   if (agec .lt. 15) then
+      i = 1
+   else if (agec .gt. 45) then
+      i = 3
+   else
+      i = 2
+   endif
+
+   nr = 1
+   if (heightc .gt. rdepth(s_typen,i)) then
+      hc = rdepth(s_typen,i)
+   else
+      hc = heightc
+   endif
+   do j=1,nlay
+      if (hc .ge. depth(j)) nr = j
+   enddo
+   if (nr .gt. nroot_max) nr = nroot_max
+
+case (5)
+	alpha=0.7
+	if (specn .eq. 2 .or. specn .eq. 3 .or. specn .eq. 6 .or. specn .eq. 7) then
+         b = 7.95
+      else
+         b = 10.91
+      endif
+	
+	troot=froot+croot
+	troot1=troot*anz_tree_ha        ! total root biomass per ha if population of a cohort is soley comprised of trees
+	troot_stand=totfrt+totcrt		! total root biomass per ha calculated by 4C
+	troot2=troot1/10000				! conversion to m
+	rootingdepth=(3*troot2**alpha)/b	!Arora function
+		nr = 1
+		do j=1,nlay
+			if (rootingdepth*100 .ge. depth(j)) nr = j
+		enddo
+   if (nr .gt. nroot_max) nr = nroot_max
+    crdepth = depth(nr)
+
+case (6)	!Calculation in soil.f in cr_depth
+
+     if (crdepth .eq.0) then
+	    ! nroot depending on soil texture and age
+       if (agec .lt. 15) then
+          i = 1
+       else if (agec .gt. 45) then
+          i = 3
+       else
+          i = 2
+       endif
+
+       nr = 1
+       if (heightc .gt. rdepth(s_typen,i)) then
+          crdepth = rdepth(s_typen,i)
+       else
+          crdepth = heightc
+       endif
+   
+     endif
+
+     do j=1,nlay
+	    if (depth(j) .le. crdepth) nr=j
+     enddo
+     if (nr .gt. nroot_max) nr = nroot_max
+
+case (7)	!further growth only if next layer bears water
+	wat_demand=maxval(wat_root)
+	if (time .le. 1) then
+	 crdepth=30.0
+	 do j=1,nlay
+	  if (depth(j) .le. 30.) nr=j
+	 enddo
+	else
+      if (wat_demand .gt. 0) then
+	   nr=1
+	  else
+	   nr=0
+	  endif
+	endif
+
+   if (nr .gt. nroot_max) nr = nroot_max
+    crdepth = depth(nr)
+end select
+
+if (crdepth < 0.) then
+continue
+endif
+
+END	subroutine root_depth
+
+!**************************************************************
+
+SUBROUTINE root_ini
+
+! Allocation and initialisation of root distribution
+
+use data_simul
+use data_soil
+use data_species
+use data_stand
+
+implicit none
+
+integer i, j, nj, rkind, hspec, ios
+integer unit_root
+integer nr        ! aux. var. for nroot (rooting depth)
+real    frtrel_j, frtrel_1  ! rel fine root fraction of previous layer
+real    frtrel_s  ! Sum of fine root fractions
+real hfrt, help, troot2
+real, allocatable, dimension(:,:):: hd,hr
+integer, allocatable, dimension(:):: nlspec
+character text
+character (150) file_root
+
+logical :: pruefer=.false.
+
+root_fr = 0.
+  if (wlam(3) .gt. 0.4) then
+     s_typen = 1     ! sand
+  else if (wlam(3) .le. 0.15) then
+     s_typen = 4     ! clay
+  else if (wlam(3) .gt. 0.25) then
+     s_typen = 3     ! silt
+  else
+     s_typen = 2     ! loam
+  endif
+
+  if (nroot_max .lt. 0) then
+     nroot_max = 1
+     rkind = 4
+  else
+     rkind = 2
+  endif
+  rdepth_kind = rkind
+
+select case (flag_wurz)
+
+case (0,1,5)
+   if (anz_tree .gt. 0 .or. (anz_tree.eq.0 .and. flag_sveg .eq.1)) call root_distr
+
+case (3,4,6)
+    !intercept the case that the ground vegetatuin is already initialised but no trees have been initialised so cohorts are not finalised
+    if (anz_tree.eq.0 .and. flag_sveg .eq.1) then
+	    if (.not. allocated(wat_root)) then
+	     allocate(wat_root(anz_coh))
+	     wat_root=0.
+	     allocate(root_lay(anz_coh))
+         root_lay=0
+         allocate(gr_depth(anz_coh))
+         gr_depth=0.
+	     Pruefer=.true.
+	    endif
+    else
+        if (Pruefer .OR. (.not. allocated(wat_root))) then
+	     if (Pruefer) deallocate(wat_root)
+	     allocate(wat_root(anz_coh))
+	     wat_root=0.
+	     if (Pruefer) deallocate(root_lay)
+	     allocate(root_lay(anz_coh))
+         root_lay=0
+         if (Pruefer) deallocate(gr_depth)
+	     allocate(gr_depth(anz_coh))
+         gr_depth=0.
+         Pruefer=.false.
+	    endif
+    endif
+    if (anz_tree .gt. 0 .or. (anz_tree.eq.0 .and. flag_sveg .eq.1)) call root_distr
+
+case (2)
+! read root distribution once in the beginning alone
+   write (*,*)
+   write (*,'(A)', advance='no') 'Define root distribution, name of input file: '
+   read (*,'(A)') file_root
+   unit_root = getunit()
+   open (unit_root, file=trim(file_root), status='unknown')
+   allocate (hd(0:40, 1:nspecies))
+   allocate (hr(0:40, 1:nspecies))
+   allocate (nlspec(nspecies))
+
+   do
+       read (unit_root,'(A)') text
+       if (text .ne. '!') then
+            backspace(unit_root);exit
+       endif
+   enddo
+
+   ios    = 0
+   hd     = 0.
+   hr     = 0.
+   nlspec = 0
+   do while (ios .ge. 0)
+       j = 1
+       read (unit_root, *, iostat=ios) hspec
+       if (ios .lt. 0) exit
+       read (unit_root, *, iostat=ios) hd(1,hspec), hr(1,hspec)
+       do while (hd(j,hspec) .ge. 0.)
+          nlspec(hspec) = j
+          j = j+1
+          read (unit_root, *, iostat=ios) hd(j,hspec), hr(j,hspec)
+       enddo
+       if (hd(j,hspec) .lt. depth(nlay)) hd(j,hspec) = depth(nlay)
+   enddo
+   close (unit_root)
+
+   zeig => pt%first
+   do while (associated(zeig))
+
+      ns = zeig%coh%species
+      zeig%coh%frtrel = 0.
+
+  ! rel. root distribution of cohorts to species allocated
+     if (nlspec(ns) .gt. 0) then
+
+         frtrel_j = 0.
+         hfrt = 0.
+         j= 1
+         do while (hd(j,ns) .lt. depth(1))
+            hfrt = hfrt + hr(j,ns)
+            j = j+1
+         enddo
+            frtrel_j           = hr(j,ns) / (hd(j,ns)-hd(j-1,ns))
+            hfrt               = hfrt + frtrel_j * (depth(1)-hd(j-1,ns))
+            zeig%coh%frtrel(1) = hfrt
+            nj = j
+
+         do i=2,nlay
+             hfrt = 0.
+             do j = nj,nlspec(ns)+1
+                if (hd(j,ns) .lt. depth(i)) then
+                    frtrel_j = hr(j,ns) / (hd(j,ns)-hd(j-1,ns))
+                    hfrt     = hfrt + frtrel_j * (hd(j,ns)-depth(i-1))
+                else
+                    if (depth(i-1) .gt. hd(j-1,ns)) then
+                        help = depth(i)-depth(i-1)
+                    else
+                        help = depth(i)-hd(j-1,ns)
+                    endif
+                    frtrel_j = hr(j,ns) / (hd(j,ns)-hd(j-1,ns))
+                    hfrt     = hfrt + frtrel_j * help
+                    nj = j
+                    exit
+                endif
+             enddo
+
+             zeig%coh%frtrel(i) = hfrt
+          enddo
+     else
+
+            continue
+     endif
+
+      frtrel_s  = SUM(zeig%coh%frtrel)
+      zeig%coh%rooteff   = 0.
+      zeig => zeig%next
+   enddo
+   rdepth_kind = 2
+end select
+
+END	subroutine root_ini
+
+!**************************************************************
+
+SUBROUTINE dealloc_root
+
+use data_simul
+use data_stand
+
+if (flag_wurz .eq. 1) then
+   zeig => pt%first
+   do while (associated(zeig))
+
+      deallocate (zeig%coh%frtrel)
+      deallocate (zeig%coh%rooteff)
+
+      zeig => zeig%next
+   enddo
+endif
+
+END	subroutine dealloc_root
+
+!**************************************************************
+
+SUBROUTINE rootc_new (zeig1)
+
+! root initialisation of a new cohort
+
+use data_stand
+use data_soil
+
+implicit none
+
+type(coh_obj), pointer   :: zeig1     ! pointer variable for cohorts
+real troot2
+integer j, nr
+
+        allocate (zeig1%coh%frtrel(nlay))
+        allocate (zeig1%coh%rooteff(nlay))
+        zeig1%coh%frtrel  = 0.      ! initialisation
+        call root_depth (1, zeig1%coh%species, zeig1%coh%x_age, zeig1%coh%height, zeig1%coh%x_frt, zeig1%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+        zeig1%coh%nroot = nr
+        do j=1,nr
+           zeig1%coh%rooteff = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           zeig1%coh%rooteff = 0.   ! layers with no roots
+        enddo
+
+END	subroutine rootc_new
+
+!**************************************************************
+
+SUBROUTINE cr_depth 
+
+! Calculation of the rooting depth after Rasse et al. 2001 
+
+use data_soil
+use data_stand
+use data_simul
+use data_climate
+use data_species
+
+implicit none
+real :: vcr		! growth rate rootdepth [cm]
+integer :: j,k
+
+vcr=0.
+
+select case (flag_wurz)
+
+case(4,6)
+zeig => pt%first
+ k=1
+ do while (associated(zeig))
+  	do j=1,nlay
+	 if (zeig%coh%x_rdpt .lt. depth(j)) then
+	  if (zeig%coh%x_age .le. 100) then
+		if (j .eq. 1) then
+        vcr=spar(zeig%coh%species)%v_growth*((100-real(zeig%coh%x_age))/100)*svar(zeig%coh%species)%Rstress(j)
+	    zeig%coh%x_rdpt=zeig%coh%x_rdpt+(vcr/recs(time))
+		gr_depth(k)=zeig%coh%x_rdpt
+		exit
+	    else
+	    vcr=spar(zeig%coh%species)%v_growth*((100-real(zeig%coh%x_age))/100)*svar(zeig%coh%species)%Rstress(j)
+	    zeig%coh%x_rdpt=zeig%coh%x_rdpt+(vcr/recs(time))
+	    gr_depth(k)=zeig%coh%x_rdpt
+		exit
+	    endif
+	   endif
+	  endif
+	enddo
+  
+  if (zeig%coh%x_rdpt .gt. depth(nroot_max)) zeig%coh%x_rdpt = depth(nroot_max)
+  k=k+1	  
+  zeig => zeig%next
+ enddo
+end select
+
+END subroutine cr_depth
+
+!*******************************************************************************
+

source_code/version_2.3_windows/script1.rc

+// Generated by ResEdit 1.5.9
+// Copyright (C) 2006-2011
+// http://www.resedit.net
+
+#include <windows.h>
+#include <commctrl.h>
+#include <richedit.h>
+#include "4C_dialogs.h"
+
+
+
+
+//
+// Bitmap resources
+//
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDB_BITMAP1        BITMAP         "4c_logo_klein.bmp"
+
+
+
+//
+// Dialog resources
+//
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_coh_daily DIALOG 100, 0, 540, 213
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_DAILYCOH_BUTTON_OK, 380, 190, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_OUTF, 439, 190, 50, 14
+    GROUPBOX        "", IDC_STATIC_year, 10, 10, 510, 170
+    AUTOCHECKBOX    "", IDC_CHECK_y1, 26, 30, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y2, 26, 45, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y3, 26, 60, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y4, 26, 75, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y5, 25, 90, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y6, 26, 105, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y7, 26, 120, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y8, 26, 135, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y9, 26, 150, 271, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y10, 26, 165, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y11, 295, 30, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y12, 295, 45, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y13, 295, 60, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y14, 295, 75, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y15, 295, 90, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y16, 295, 105, 217, 8
+    LTEXT           "  Choose daily cohort output files  ", IDC_STATIC_yfile, 25, 10, 107, 8, SS_LEFT
+    AUTOCHECKBOX    "", IDC_CHECK_y17, 295, 120, 217, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y18, 295, 135, 217, 8
+    PUSHBUTTON      "Select all", ID_DAILYCOH_BUTTON_SELECT, 321, 190, 50, 14
+    PUSHBUTTON      "Deselect all", ID_DAILYCOH_BUTTON_DESELECT, 262, 190, 50, 14
+    AUTOCHECKBOX    "", IDC_CHECK_y19, 295, 150, 217, 8
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_coh_yearly DIALOG 0, 0, 718, 318
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_YEARLYCOH_BUTTON_OK, 559, 290, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_OUTF, 625, 290, 50, 14
+    GROUPBOX        "", IDC_STATIC_year, 15, 10, 683, 275
+    AUTOCHECKBOX    "", IDC_CHECK_y1, 21, 30, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y2, 20, 45, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y3, 21, 60, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y4, 21, 75, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y5, 21, 90, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y6, 21, 105, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y7, 21, 120, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y8, 21, 135, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y9, 21, 150, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y10, 21, 165, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y11, 21, 180, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y12, 21, 195, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y13, 21, 210, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y14, 21, 225, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y15, 21, 240, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y16, 21, 255, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y17, 21, 270, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y18, 244, 30, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y19, 244, 45, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y20, 244, 60, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y21, 244, 75, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y22, 244, 90, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y23, 244, 105, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y24, 244, 120, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y25, 244, 135, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y26, 244, 150, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y27, 244, 165, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y28, 244, 180, 222, 8
+    LTEXT           "  Choose yearly cohort output files  ", IDC_STATIC_yfile, 30, 10, 111, 8, SS_LEFT
+    AUTOCHECKBOX    "", IDC_CHECK_y29, 244, 195, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y30, 244, 210, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y31, 244, 225, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y32, 244, 240, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y33, 244, 255, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y34, 244, 270, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y35, 465, 30, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y36, 465, 45, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y37, 465, 60, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y38, 465, 75, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y39, 465, 90, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y40, 465, 105, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y41, 465, 120, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y42, 465, 135, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y43, 465, 150, 222, 8
+    PUSHBUTTON      "Select all", ID_YEARLYCOH_BUTTON_SELECT, 493, 290, 50, 14
+    PUSHBUTTON      "Deselect all", ID_YEARLYCOH_BUTTON_DESELECT, 427, 290, 50, 14
+    AUTOCHECKBOX    "", IDC_CHECK_y44, 465, 165, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y45, 465, 178, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y46, 465, 193, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y47, 465, 210, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y48, 465, 225, 222, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y49, 465, 240, 222, 13
+    AUTOCHECKBOX    "", IDC_CHECK_y50, 465, 255, 222, 13
+    AUTOCHECKBOX    "", IDC_CHECK_y51, 465, 270, 222, 13
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_ctr DIALOG 100, 0, 280, 349
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_CTR_BUTTON_OK, 147, 319, 50, 14
+    PUSHBUTTON      "Cancel", IDCANCEL, 207, 319, 50, 14
+    LTEXT           "Edit simulation control file", IDC_STATIC_simul, 15, 14, 91, 11, SS_LEFT
+    GROUPBOX        "Run option control", IDC_STATIC_runo, 15, 30, 241, 173
+    LTEXT           "Run option", IDC_STATIC_runv, 23, 47, 36, 8, SS_LEFT
+    LTEXT           "Number of runs", IDC_STATIC_runnr, 23, 68, 49, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_runv, 69, 47, 175, 98, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    EDITTEXT        IDC_EDIT_runnr, 162, 67, 40, 12, ES_AUTOHSCROLL
+    LTEXT           "Number of simulation years", IDC_STATIC_yearn, 23, 89, 85, 8, SS_LEFT
+    LTEXT           "Start year", IDC_STATIC_start, 23, 111, 31, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_yearn, 162, 89, 40, 14, ES_AUTOHSCROLL
+    EDITTEXT        IDC_EDIT_start, 162, 111, 40, 14, ES_AUTOHSCROLL
+    LTEXT           "Patch size [m]", IDC_STATIC_patch, 23, 134, 47, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_patch, 162, 134, 40, 14, ES_AUTOHSCROLL
+    LTEXT           "Thickness of foliage layers [cm]", IDC_STATIC_thickf, 23, 158, 100, 8, SS_LEFT
+    LTEXT           "Time step photosynthesis calculations [d]", IDC_STATIC_timeph, 23, 184, 130, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_thickf, 162, 157, 40, 14, ES_AUTOHSCROLL
+    EDITTEXT        IDC_EDIT_timeph, 162, 180, 40, 14, ES_AUTOHSCROLL
+    GROUPBOX        "Run flags control", IDC_STATIC_runo3, 15, 214, 240, 93
+    COMBOBOX        IDC_COMBO_runv3, 65, 235, 101, 98, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "Run number", IDC_STATIC_runv3, 23, 238, 40, 8, SS_LEFT
+    DEFPUSHBUTTON   "Set Flags", ID_CTR_BUTTON_FLAGS, 177, 281, 65, 14
+    DEFPUSHBUTTON   "Set Files", ID_CTR_BUTTON_FILES, 177, 258, 65, 14
+    DEFPUSHBUTTON   "Apply", ID_CTR_BUTTON_RUNNR, 213, 66, 30, 14
+    DEFPUSHBUTTON   "Change Output Id", ID_CTR_BUTTON_IDS, 178, 235, 64, 14
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_daily DIALOG 0, 0, 568, 221
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_DAILY_BUTTON_OK, 408, 195, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_OUTF, 471, 195, 50, 14
+    GROUPBOX        "", IDC_STATIC_day, 11, 14, 534, 171
+    AUTOCHECKBOX    "", IDC_CHECK_y1, 37, 30, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y2, 37, 45, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y3, 37, 60, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y4, 37, 75, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y5, 37, 90, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y6, 37, 105, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y7, 37, 120, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y8, 37, 135, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y9, 37, 150, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y10, 37, 165, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y11, 284, 30, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y12, 284, 45, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y13, 284, 60, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y14, 284, 75, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y15, 284, 90, 240, 8
+    LTEXT           "  Choose daily output files  ", IDC_STATIC_yfile, 22, 15, 85, 8, SS_LEFT
+    AUTOCHECKBOX    "", IDC_CHECK_y16, 284, 105, 240, 8
+    PUSHBUTTON      "Select all", ID_DAILY_BUTTON_SELECT, 345, 195, 50, 14
+    PUSHBUTTON      "Deselect all", ID_DAILY_BUTTON_DESELECT, 282, 195, 50, 14
+    AUTOCHECKBOX    "", IDC_CHECK_y17, 284, 120, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y18, 284, 135, 240, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y19, 284, 150, 240, 8
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_default_dir DIALOG 10, 100, 320, 99
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_DEFAULT_DIR_BUTTON_OK, 138, 79, 50, 14
+    LTEXT           "Default input and output directories", IDC_STATIC_4C, 15, 4, 216, 9, SS_LEFT
+    LTEXT           "Input directory", IDC_STATIC_dirin, 16, 31, 51, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_DIR_IN, 81, 27, 210, 12, ES_AUTOHSCROLL | ES_MULTILINE
+    LTEXT           "Output directory", IDC_STATIC_dirout, 16, 56, 51, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_DIR_OUT, 81, 52, 210, 12, ES_AUTOHSCROLL | ES_MULTILINE
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_files DIALOG 100, 0, 310, 330
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_FILES_BUTTON_OK, 189, 307, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_FILES, 251, 307, 50, 14
+    GROUPBOX        "Model input files", IDC_STATIC_files, 7, 10, 295, 209
+    LTEXT           "Species parameter file", IDC_STATIC_specpar, 16, 51, 70, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_specpar, 109, 53, 146, 12, ES_AUTOHSCROLL | ES_MULTILINE
+    PUSHBUTTON      "Browse", IDC_BUTTON_specpar, 259, 54, 35, 12, WS_GROUP
+    LTEXT           "Soil parameter file", IDC_STATIC_sop, 16, 69, 56, 8, SS_LEFT
+    LTEXT           "Soil initialisation file", IDC_STATIC_soi, 16, 87, 60, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_sop, 109, 70, 146, 12, ES_AUTOHSCROLL
+    EDITTEXT        IDC_EDIT_soi, 109, 87, 146, 12, ES_AUTOHSCROLL
+    LTEXT           "Stand initialisation file", IDC_STATIC_ini, 13, 238, 68, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_ini, 107, 235, 145, 14, ES_AUTOHSCROLL
+    GROUPBOX        "", IDC_STATIC_ini1, 7, 222, 295, 73
+    LTEXT           "Stand identifier", IDC_STATIC_standid, 15, 256, 48, 8, SS_LEFT
+    PUSHBUTTON      "Browse", IDC_BUTTON_ini, 259, 235, 35, 12, WS_GROUP
+    LTEXT           "Management file", IDC_STATIC_man, 16, 107, 53, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_man, 109, 104, 146, 12, ES_AUTOHSCROLL
+    LTEXT           "Deposition data file", IDC_STATIC_dep, 16, 123, 61, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_dep, 109, 121, 146, 12, ES_AUTOHSCROLL
+    LTEXT           " N-reduction ( RedN) file", IDC_STATIC_red, 16, 141, 77, 8, SS_LEFT
+    LTEXT           "Litter intilisation file", IDC_STATIC_lit, 16, 158, 59, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_red, 109, 139, 146, 12, ES_AUTOHSCROLL
+    EDITTEXT        IDC_EDIT_lit, 109, 155, 146, 12, ES_AUTOHSCROLL
+    PUSHBUTTON      "Browse", IDC_BUTTON_sop, 259, 71, 35, 12, WS_GROUP
+    PUSHBUTTON      "Browse", IDC_BUTTON_soi, 259, 88, 35, 12, WS_GROUP
+    PUSHBUTTON      "Browse", IDC_BUTTON_man, 259, 105, 35, 12, WS_GROUP
+    PUSHBUTTON      "Browse", IDC_BUTTON_dep, 259, 123, 35, 12, WS_GROUP
+    PUSHBUTTON      "Browse", IDC_BUTTON_red, 259, 139, 35, 12, WS_GROUP
+    PUSHBUTTON      "Browse", IDC_BUTTON_lit, 259, 156, 35, 12, WS_GROUP
+    LTEXT           "Climate data file", IDC_STATIC_cli, 17, 32, 70, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_cli, 110, 34, 146, 12, ES_AUTOHSCROLL | ES_MULTILINE
+    PUSHBUTTON      "Browse", IDC_BUTTON_cli, 260, 35, 35, 12, WS_GROUP
+    COMBOBOX        IDC_COMBO_standid, 106, 254, 85, 77, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "WPM spinup intilisation file", IDC_STATIC_spinup, 15, 177, 84, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_wpm, 109, 174, 146, 12, ES_AUTOHSCROLL
+    PUSHBUTTON      "Browse", IDC_BUTTON_wpm, 259, 175, 35, 12, WS_GROUP
+    EDITTEXT        IDC_EDIT_standid, 106, 273, 76, 14, ES_AUTOHSCROLL
+    LTEXT           "Measurement file", IDC_STATIC_mes, 16, 194, 54, 8, SS_LEFT
+    EDITTEXT        IDC_EDIT_mes, 110, 191, 146, 12, ES_AUTOHSCROLL
+    PUSHBUTTON      "Browse", IDC_BUTTON_mes, 260, 191, 35, 12, WS_GROUP
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_flags DIALOGEX 100, 0, 580, 297
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+EXSTYLE WS_EX_TOOLWINDOW
+CAPTION "4C"
+FONT 8, "MS Sans Serif", 0, 0, 1
+{
+    DEFPUSHBUTTON   "OK", ID_FLAGS_BUTTON_OK, 443, 263, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_FLAGS, 509, 262, 50, 14
+    LTEXT           "Mortality flag (flag_mort) ", IDC_STATIC_mort, 18, 33, 77, 8, SS_LEFT
+    LTEXT           "Regeneration flag (flag_reg) ", IDC_STATIC_reg, 18, 50, 90, 8, SS_LEFT
+    LTEXT           "Use FORSKA factors (flag_forska)", IDC_STATIC_forska, 18, 67, 113, 13, WS_TABSTOP | NOT WS_GROUP | SS_LEFT
+    LTEXT           "Stand initialization flag (flag_stand)", IDC_STATIC_stand, 18, 84, 109, 8, WS_TABSTOP | NOT WS_GROUP | SS_LEFT
+    LTEXT           "Soil vegetation flag (flag_sveg)", IDC_STATIC_sveg, 18, 101, 98, 8, SS_LEFT
+    LTEXT           "Management flag (flag_mg)", IDC_STATIC_mg, 18, 118, 86, 8, SS_LEFT
+    LTEXT           "Disturbance flag (flag_dis)", IDC_STATIC_dis, 18, 135, 82, 8, SS_LEFT
+    LTEXT           "Ligth algorithm number (flag_light)", IDC_STATIC_light, 18, 152, 106, 8, SS_LEFT
+    LTEXT           "Foliage-height relationship (flag_folhei)", IDC_STATIC_folhei, 18, 169, 120, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_mort, 143, 33, 133, 42, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_reg, 143, 50, 133, 116, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL
+    COMBOBOX        IDC_COMBO_forska, 143, 67, 133, 25, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "Volume function (flag_volfunc)", IDC_STATIC_volfunc, 18, 186, 96, 8, SS_LEFT
+    LTEXT           "Respiration flag (flag_resp)", IDC_STATIC_resp, 18, 203, 84, 8, SS_LEFT
+    LTEXT           "Limitation flag (flag_limi)", IDC_STATIC_limi, 18, 220, 74, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_stand, 143, 84, 133, 54, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_sveg, 143, 101, 133, 48, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_mg, 143, 118, 133, 78, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_dis, 143, 135, 133, 32, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_light, 143, 152, 133, 55, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_folhei, 143, 169, 133, 53, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_volfunc, 143, 186, 133, 63, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "Decomposition model (flag_decomp) ", IDC_STATIC_decomp, 308, 33, 117, 8, SS_LEFT
+    LTEXT           "Root activity function flag (flag_sign)", IDC_STATIC_sign, 308, 50, 115, 8, SS_LEFT
+    LTEXT           "Soil water uptake flag (flag_wred)", IDC_STATIC_wred, 308, 67, 106, 8, SS_LEFT
+    LTEXT           "Root distribution flag (flag_wurz)", IDC_STATIC_wurz, 308, 84, 101, 8, SS_LEFT
+    LTEXT           "Heat conductance flag (flag_cond)", IDC_STATIC_cond, 308, 101, 111, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_resp, 143, 203, 133, 64, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_limi, 143, 220, 133, 65, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_decomp, 431, 33, 133, 54, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_sign, 431, 50, 133, 67, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_wred, 431, 67, 133, 61, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_wurz, 431, 84, 133, 64, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_cond, 431, 101, 133, 78, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_int, 431, 118, 133, 75, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_eva, 431, 135, 133, 78, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "Interception flag (flag_int)", IDC_STATIC_int, 308, 118, 80, 8, SS_LEFT
+    LTEXT           "Evapotranspiration flag (flag_eva)", IDC_STATIC_eva, 308, 135, 106, 8, SS_LEFT
+    LTEXT           "Assortment flag (flag_sort)", IDC_STATIC_sort, 308, 169, 82, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_CO2, 431, 152, 133, 51, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_sort, 431, 169, 133, 48, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    GROUPBOX        "Model specification", IDC_STATIC_model, 0, 15, 564, 239
+    LTEXT           "wpm flag (flag_wpm)", IDC_STATIC_wpm, 307, 186, 65, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_wpm, 431, 186, 133, 64, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "Statistical analysis flag (flag_stat)", IDC_STATIC_stat, 307, 203, 104, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_stat, 431, 203, 133, 48, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    LTEXT           "CO2 flag (flag_CO2)", IDC_STATIC_CO2, 308, 152, 64, 8, SS_LEFT
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_ids DIALOG 100, 0, 130, 78
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_IDS_BUTTON_OK, 10, 55, 50, 14
+    GROUPBOX        "Output File Identifiers", IDC_STATIC_model, 6, 14, 111, 35
+    EDITTEXT        IDC_EDIT_ID, 14, 29, 95, 14, ES_AUTOHSCROLL
+    PUSHBUTTON      "Cancel", ID_CANCEL_IDS, 67, 55, 50, 14
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_main DIALOGEX 300, 50, 245, 268
+STYLE DS_3DLOOK | DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU
+EXSTYLE WS_EX_CLIENTEDGE | WS_EX_STATICEDGE
+CAPTION "4C"
+FONT 8, "MS Sans Serif", 0, 0, 1
+{
+    GROUPBOX        "", IDC_STATIC_year, 5, 6, 233, 258, 0, WS_EX_STATICEDGE
+    CTEXT           "Forest Growth Model 4C   PIK   2016", IDC_STATIC_4C, 25, 53, 82, 23, SS_CENTER
+    DEFPUSHBUTTON   "Start 4C", ID_START_4C, 103, 233, 56, 14
+    PUSHBUTTON      "Exit 4C", IDSTOP, 174, 233, 50, 14
+    GROUPBOX        "Simulation Control", IDC_STATIC_Control, 20, 126, 207, 68
+    AUTORADIOBUTTON "Start simulation", IDC_RADIO_start, 35, 148, 121, 10
+    AUTORADIOBUTTON "Edit control file", IDC_RADIO_edit, 35, 166, 62, 10
+    CONTROL         "", IDC_REBAR1, REBARCLASSNAME, WS_TABSTOP | 0x00000401, 4294967294, 4294967295, 249, 4, WS_EX_DLGMODALFRAME | WS_EX_ACCEPTFILES | WS_EX_STATICEDGE
+    CONTROL         IDB_BITMAP1, IDC_STATIC_pic, WC_STATIC, SS_BITMAP, 123, 14, 100, 104
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_out DIALOG 100, 0, 293, 212
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "Start simulation", ID_START, 89, 182, 56, 14
+    PUSHBUTTON      "Exit 4C", IDCANCEL, 226, 182, 50, 14
+    LTEXT           "Choice of output files", IDC_STATIC, 15, 18, 67, 8, SS_LEFT
+    PUSHBUTTON      "Yearly output", IDC_BUTTON_yearly, 207, 37, 50, 14
+    PUSHBUTTON      "Daily output", IDC_BUTTON_daily, 207, 60, 50, 14
+    PUSHBUTTON      "Cohorts yearly", IDC_BUTTON_coh_yearly, 207, 84, 50, 14
+    PUSHBUTTON      "Cohorts daily", IDC_BUTTON_coh_daily, 207, 108, 50, 14
+    GROUPBOX        "", IDC_STATIC_choice_out, 8, 7, 268, 164
+    LTEXT           "Summation output", IDC_STATIC_SUM, 19, 145, 58, 8, SS_LEFT
+    COMBOBOX        IDC_COMBO_sum, 88, 142, 165, 74, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_SORT
+    DEFPUSHBUTTON   "Back", ID_OUT_BUTTON_BACK, 161, 182, 50, 14
+    DEFPUSHBUTTON   "Save changes", ID_SAVE, 17, 182, 56, 14
+    COMBOBOX        IDC_COMBO_yearly, 14, 37, 181, 77, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_daily, 13, 60, 181, 77, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_coh_yearly, 13, 85, 181, 77, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+    COMBOBOX        IDC_COMBO_coh_daily, 13, 109, 181, 77, WS_TABSTOP | WS_VSCROLL | CBS_DROPDOWN | CBS_AUTOHSCROLL | CBS_SORT
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_4C_yearly DIALOG 100, 0, 606, 352
+STYLE DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU
+CAPTION "4C"
+FONT 8, "MS Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", ID_YEARLY_BUTTON_OK, 455, 327, 50, 14
+    PUSHBUTTON      "Cancel", ID_CANCEL_OUTF, 519, 327, 50, 14
+    GROUPBOX        "", IDC_STATIC_year, 7, 15, 573, 302
+    AUTOCHECKBOX    "", IDC_CHECK_y1, 21, 30, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y2, 21, 45, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y3, 21, 60, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y4, 21, 75, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y5, 21, 90, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y6, 21, 105, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y7, 21, 120, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y8, 21, 135, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y9, 21, 150, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y10, 21, 165, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y11, 21, 180, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y12, 21, 195, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y13, 21, 210, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y14, 21, 225, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y15, 21, 240, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y16, 21, 255, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y17, 21, 270, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y18, 21, 285, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y19, 21, 300, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y20, 294, 30, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y21, 294, 45, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y22, 294, 60, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y23, 294, 75, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y24, 294, 90, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y25, 294, 105, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y26, 294, 120, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y27, 294, 135, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y28, 294, 150, 270, 8
+    LTEXT           "  Choose yearly output files  ", IDC_STATIC_yfile, 21, 14, 89, 8, SS_LEFT
+    AUTOCHECKBOX    "", IDC_CHECK_y29, 294, 165, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y30, 294, 180, 270, 8
+    PUSHBUTTON      "Select all", ID_YEARLY_BUTTON_SELECT, 391, 327, 50, 14
+    PUSHBUTTON      "Deselect all", ID_YEARLY_BUTTON_DESELECT, 327, 327, 50, 14
+    AUTOCHECKBOX    "", IDC_CHECK_y31, 294, 195, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y32, 294, 210, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y33, 294, 225, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y34, 294, 240, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y35, 294, 255, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y36, 294, 270, 270, 8
+    AUTOCHECKBOX    "", IDC_CHECK_y37, 294, 285, 270, 8
+}
+
+
+
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+IDD_DIALOG1 DIALOG 0, 0, 186, 95
+STYLE DS_3DLOOK | DS_CENTER | DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU
+CAPTION "Dialog"
+FONT 8, "Microsoft Sans Serif"
+{
+    DEFPUSHBUTTON   "OK", IDOK, 129, 7, 50, 14
+    PUSHBUTTON      "Cancel", IDCANCEL, 129, 24, 50, 14
+}
+
+
+
+//
+// Version Information resources
+//
+LANGUAGE LANG_GERMAN, SUBLANG_GERMAN
+VS_VERSION_INFO VERSIONINFO
+    FILEVERSION     1,0,0,0
+    PRODUCTVERSION  0,0,0,0
+    FILEOS          VOS_NT_WINDOWS32
+    FILETYPE        VFT_APP
+    FILESUBTYPE     VFT2_UNKNOWN
+    FILEFLAGSMASK   0x0000003F
+    FILEFLAGS       0x00000000
+{
+    BLOCK "StringFileInfo"
+    {
+        BLOCK "080904B0"
+        {
+            VALUE "Comments", "\0"
+            VALUE "CompanyName", "Potsdam-Institut fr Klimafolgenforschung\0"
+            VALUE "FileDescription", "FORESEE - Forest Ecosystems in a changing Environment\0"
+            VALUE "FileVersion", "0.99e\0"
+            VALUE "InternalName", "4C\0"
+            VALUE "LegalCopyright", "Copyright  2004\0"
+            VALUE "LegalTrademarks", "\0"
+            VALUE "OriginalFilename", "4C.exe\0"
+            VALUE "PrivateBuild", "\0"
+            VALUE "ProductName", "4C - PIK\0"
+            VALUE "ProductVersion", "0.99e\0"
+            VALUE "SpecialBuild", "\0"
+        }
+    }
+    BLOCK "VarFileInfo"
+    {
+        VALUE "Translation", 0x0809, 0x04B0
+    }
+}

source_code/version_2.3_windows/seed_multi.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*         SR   SEED_multi                                       *!
+!*                                                               *!
+!*        including SR/Function                                  *!
+!*         function rtflsp    (regula falsi solving equation)    *!
+!*         function weight                                       *!
+!*         function weight1                                      *!
+!*                                                               *!
+!*   generation of a variety of seedling cohorts for             *!
+!*   one seed number according to seedmass distribution          *!
+!*   (for given mean value and standard deviation)               *!
+!*                                                               *!
+!*                  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 seed_multi(nseed,nsp)
+
+USE data_species
+use data_stand
+use data_help
+use data_par
+use data_soil
+use data_simul
+
+IMPLICIT NONE
+integer    :: nseed, nseedha, nsclass , k, j, nr
+integer,dimension(:),allocatable  :: nsc
+
+real, dimension(:), allocatable   :: msc,      &
+                                     shooth,   &
+                                     nschelp
+integer    :: nsp
+REAL       :: shoot
+REAL       :: ms, msclass, x1,x2,xacc,shelp, nshelp,ntot,help
+REAL	   :: troot2
+
+real       :: standdev
+real       :: rtflsp, weight
+
+TYPE(cohort)    ::tree_ini
+
+external weight
+external rtflsp
+
+if(nseed.eq.0) return
+ standdev = spar(nsp)%seedsd*1000.
+ hnspec = nsp
+ ms = spar(nsp)%seedmass *1000.        ! g ---> mg
+ nseedha = nseed
+ nshelp = nseedha/10000.
+
+! calculation of seed class number
+ if(flag_reg.eq.3) then
+     nsclass = int(100.*nshelp**0.6)
+ else if(flag_reg.eq.30) then
+  nsclass = int(10.*nshelp**0.6)+1
+ end if
+allocate(nsc(nsclass))
+allocate(nschelp(nsclass))
+allocate(msc(nsclass))
+allocate(shooth(nsclass))
+
+! seed weight and number of seeds per class
+  msclass = 6.*standdev/nsclass
+  ntot = 0
+  help =  (1/(sqrt(2*pi)*standdev))
+  do k=1, nsclass
+
+        msc(k) = (ms - 3.*standdev) + msclass*(k-1)
+        nschelp(k) = help*exp(-((msc(k)-ms)**2)/(2*(standdev)**2))
+        ntot = ntot + nschelp(k)
+
+  end do
+
+  do k= 1,nsclass
+
+       nsc(k) = nint((nschelp(k)*nseedha/ntot) + 0.5)
+
+  end do
+! calculation of shoot weight per seed class and initilization
+
+  do k = 1,nsclass
+
+    mschelp = msc(k)/1000000.      ! mg ---> kg
+    x1 = 0.
+    x2 = 0.1
+    xacc=(1.0e-10)*(x1+x2)/2
+    
+! solve mass equation; determine root
+    shelp=rtflsp(weight,x1,x2,xacc)
+    shooth(k)= shelp
+    max_coh = max_coh + 1
+
+    call coh_initial (tree_ini)
+
+    tree_ini%ident =  max_coh
+    tree_ini%species = nsp
+    tree_ini%ntreea = nsc(k)
+    tree_ini%nta = nsc(k)
+    shoot = shooth(k)
+    tree_ini%x_sap = shoot                                ! [kg]
+    shoot = shoot * 1000.                                  ! [g]
+    tree_ini%x_fol= (spar(nsp)%seeda*(tree_ini%x_sap** spar(nsp)%seedb))   ![kg]
+    tree_ini%x_frt = tree_ini%x_fol                                          ! [kg]
+! Leder
+    tree_ini%x_hrt = 0.
+    tree_ini%med_sla = spar(nsp)%psla_min + spar(nsp)%psla_a*0.5
+    tree_ini%t_leaf = tree_ini%med_sla* tree_ini%x_fol                              ! [m-2]
+    tree_ini%ca_ini = tree_ini%t_leaf
+    tree_ini%crown_area = tree_ini%ca_ini
+    tree_ini%underst = 1
+
+! tranformation of shoot biomass kg --> mg
+
+    if(nsp.ne.2)tree_ini%height = spar(nsp)%pheight1*(shoot*1000.)**spar(nsp)%pheight2      ! [cm] berechnet aus shoot biomass (mg)
+! Leder
+
+    if(nsp.eq.2) tree_ini%height = 10**(spar(nsp)%pheight1+ spar(nsp)%pheight2*LOG10(shoot*1000.)+ &
+                              spar(nsp)%pheight3*(LOG10(shoot*1000.))**2)
+       IF(nsc(k).ne.0.) then
+       IF (.not. associated(pt%first)) THEN
+          ALLOCATE (pt%first)
+          pt%first%coh = tree_ini
+          NULLIFY(pt%first%next)
+!     root distribution
+        call root_depth (1, pt%first%coh%species, pt%first%coh%x_age, pt%first%coh%height, pt%first%coh%x_frt, pt%first%coh%x_crt, nr, troot2, pt%first%coh%x_rdpt, pt%first%coh%nroot)
+        pt%first%coh%nroot = nr
+        do j=1,nr
+           pt%first%coh%rooteff = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           pt%first%coh%rooteff = 0.   ! layers with no roots
+        enddo
+       ELSE
+           
+          ALLOCATE(zeig)
+          zeig%coh = tree_ini
+          zeig%next => pt%first
+          pt%first => zeig
+
+          call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
+        zeig%coh%nroot = nr
+        do j=1,nr
+           zeig%coh%rooteff = 1.   ! assumption for the first use
+        enddo
+        do j=nr+1, nlay
+           zeig%coh%rooteff = 0.   ! layers with no roots
+        enddo
+
+      END IF
+      anz_coh=anz_coh+1
+    END IF
+  end do
+
+deallocate(nsc)
+deallocate(nschelp)
+deallocate(msc)
+deallocate(shooth)
+
+END SUBROUTINE  seed_multi
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    weight: seed mass function
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function weight (x)
+
+use data_help
+use data_species
+
+implicit none
+
+real     :: x
+real     :: p1,p2,  weight
+
+p1 = spar(hnspec)%seeda
+p2 = spar(hnspec)%seedb
+
+weight = p1*2*(x**p2) + x - 0.7*mschelp
+
+end function weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    weight1: coarse root mass function
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function weight1 (x)
+
+use data_help
+use data_species
+
+real     :: x
+real     :: p1,p2
+
+p1 = spar(hnspec)%seeda
+p2 = spar(hnspec)%seedb
+
+weight1 = p1*(x**p2) + x - mschelp
+
+end function weight1
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!      rtflsp: regula falsi solving euation
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+FUNCTION rtflsp(func,x1,x2,xacc)
+  INTEGER MAXIT
+  REAL rtflsp,x1,x2,xacc,func
+  EXTERNAL func
+  PARAMETER (MAXIT=30)
+  INTEGER j
+  REAL del,dx,f,fh,fl,swap,xh,xl
+  fl=func(x1)
+  fh=func(x2)
+  if(fl.lt.0.)then
+        xl=x1
+        xh=x2
+  else
+        xl=x2
+        xh=x1
+        swap=fl
+        fl=fh
+        fh=swap
+   endif
+   dx=xh-xl
+   do j=1,MAXIT
+        rtflsp=xl+dx*fl/(fl-fh)
+        f=func(rtflsp)
+
+        if(f.lt.0.) then
+          del=xl-rtflsp
+          xl=rtflsp
+          fl=f
+        else
+          del=xh-rtflsp
+          xh=rtflsp
+          fh=f
+        endif
+        dx=xh-xl
+        if(abs(del).lt.xacc.or.f.eq.0.)return
+   end do
+END function rtflsp
\ No newline at end of file

source_code/version_2.3_windows/sim_ini.f

+!*****************************************************************!
+!*                                                               *!
+!*              4C (FORESEE) Simulation Model                    *!
+!*                                                               *!
+!*                                                               *!
+!*                    Subroutines for:                           *!
+!*    - Simulation initialisation (SIM_INI)                      *!
+!*                                                               *!
+!*                  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 sim_ini
+
+use data_biodiv
+use data_climate
+use data_depo
+use data_evapo
+use data_inter
+use data_manag
+use data_simul
+use data_site
+use data_stand
+use data_soil
+use data_soil_cn
+use data_species
+use data_par
+use data_frost
+
+implicit none
+
+type(Coh_Obj), pointer :: p  ! pointer to cohort list
+
+anz_sim  = anz_sim + 1
+time     = 0
+time_cur = time_b - 1    ! before Sim.-Start in year_ini time_cur=time_cur+1
+iday     = 0
+
+act_thin_year = 1
+flag_cum  = 0
+flag_lit  = 0
+flag_sens = 0
+flag_redn = .FALSE.
+
+lai=0.
+gp_can    = 0.
+sumbio    = 0.
+totfrt    = 0.
+sumNPP    = 0.
+nppsum    = 0.
+gppsum    = 0.
+cum_sumNPP= 0.
+NEE_mon   = 0.
+NPP_mon   = 0.
+autresp   = 0.
+autresp_m = 0.
+anrspec   = 0
+anz_coh   = 0
+anz_spec  = 0
+anz_tree  = 0
+med_diam  = 0.
+hdom      = 0.
+mean_drIndAl = 0.
+
+med_air    = 0.
+med_rad    = 0.
+med_air_cm = 0.
+med_air_wm = 0.
+med_air_ms = 0.
+med_air_mj = 0.
+med_wind   = 0.
+temp_mon   = 0.
+prec_mon   = 0.
+sum_prec   = 0.
+sum_prec_ms= 0.;
+sum_prec_mj= 0.
+gdday = 0.
+days_summer = 0
+days_hot    = 0
+days_ice    = 0
+days_dry    = 0
+days_hrain  = 0
+days_rain   = 0
+days_rain_mj= 0
+days_snow   = 0
+days_wof = 0
+gdday_all = 0.
+med_air_all  = 0.
+sum_prec_all = 0.
+med_rad_all = 0.
+int_cum_can  = 0.
+int_cum_sveg = 0.
+interc_m_can = 0.
+interc_m_sveg= 0.
+perc_cum    = 0.
+perc_mon    = 0.
+wupt_cum    = 0.
+wupt_r_c    = 0.
+wupt_e_c    = 0.
+tra_tr_cum  = 0.
+tra_sv_cum  = 0.
+dew_m       = 0.
+aet_cum     = 0.
+pet_cum     = 0.
+pet_m		= 0.
+AET_m       = 0.
+wupt_r_m    = 0.
+perc_m      = 0.
+wat_tot     = 0.
+gp_can_mean = 0.
+gp_can_max  = 0.
+snow        = 0.
+snow_day    = 0
+totFPARcan  = 0.
+Rnet_cum    = 0.
+
+! fire index
+fire(1)%mean_m = 0
+fire(2)%mean_m = 0
+fire(3)%mean_m = 0
+fire_indb_m    = 0
+
+ind_arid_an = 0.
+ind_lang_an = 0.
+ind_cout_an = 0.
+ind_wiss_an = 0.
+ind_mart_an = 0.
+ind_mart_vp = 0.
+ind_emb		= 0.
+ind_weck	= 0.
+ind_reich	= 0.
+con_gor		= 0.
+con_cur		= 0.
+con_con		= 0.
+cwb_an		= 0.
+cwb_an_m    = 0.
+ind_bud     = 0.
+ind_shc     = 0.
+
+ind_arid_an_m = 0.
+ind_lang_an_m = 0.
+ind_cout_an_m = 0.
+ind_wiss_an_m = 0.
+ind_mart_an_m = 0.
+ind_mart_vp_m = 0.
+ind_emb_m     = 0.
+ind_weck_m    = 0.
+ind_reich_m   = 0.
+con_gor_m     = 0.
+con_cur_m     = 0.
+con_con_m     = 0.
+ind_bud_m     = 0.
+ind_shc_m     = 0.
+ntindex       = 0.
+
+tempmean_mo = 0
+
+aet_dec  = 0.
+temp_dec = 0.
+prec_dec = 0.
+rad_dec  = 0.
+hum_dec  = 0.
+
+! frost index
+if(flag_climtyp .ge. 3) then
+ ! calculation for airtemp_min > -90. 
+    tminmay=0
+    lfind=0
+    dlfabs=0.
+    tminmay_sp=0
+    dlfabs_sp=0.
+    flag_tveg=0
+else
+    tminmay=-99
+    lfind=-99
+    dlfabs=-99.
+    tminmay_sp=-99
+    dlfabs_sp=-99.
+    flag_tveg=-99
+endif
+
+
+!! initialisation of root distribution
+RedN_mean = 0.
+anz_RedN  = 0
+N_min     = 0.
+N_min_m   = 0.
+resps_c   = 0.
+resps_c_m = 0.
+resps_mon = 0.
+N_tot     = 0.
+N_an_tot  = 0.
+N_hum_tot = 0.
+C_tot     = 0.
+C_hum_tot = 0.
+N_lit     = 0.
+C_lit     = 0.
+Nupt_c    = 0.
+Nupt_m    = 0.
+C_accu      = 0.
+Nleach_c    = 0.
+Nleach_m    = 0.
+N_lit_m     = 0.
+C_lit_m     = 0.
+totfol_lit  = 0.
+totfol_lit_tree = 0.
+totfrt_lit  = 0.
+totfrt_lit_tree = 0.
+tottb_lit   = 0.
+totcrt_lit  = 0.
+totstem_lit = 0.
+C_opm_fol   = 0.
+C_opm_frt   = 0.
+C_opm_crt   = 0.
+C_opm_tb    = 0.
+C_opm_stem  = 0.
+N_opm_stem  = 0.
+N_opm_fol   = 0.
+N_opm_frt   = 0.
+N_opm_crt   = 0.
+N_opm_tb    = 0.
+Ndep_cum    = 0.
+Ndep_cum_all= 0.
+if (flag_multi .ne. 8) then
+    if ((flag_multi .ne. 2) .or. (ip .le. 1)) then
+        NOdep(ip) = 0.
+        NHdep(ip) = 0.
+    endif
+endif
+
+flag_bc = 0
+totsteminc   = 0.
+cumsteminc   = 0.
+cumsumvsdead = 0.
+cumsumvsab   = 0.
+sumvsdead    = 0.
+sumvsab      = 0.
+
+p => pt%first
+do while (associated(p))
+  p%coh%N_pool  = 0.
+
+  p => p%next
+enddo  ! p (cohorts)
+
+allocate(dayfract(ns_pro))
+
+!  fields for frost index
+allocate(dnlf(year))
+allocate(tminmay_ann(year))
+allocate(date_lf(year))
+allocate(date_lftot(year))
+allocate(dnlf_sp(year))
+allocate (anzdlf(year))
+allocate (sumtlf(year))
+
+dnlf_sp=0
+dnlf = 0
+tminmay_ann = 0.
+date_lf = 0
+date_lftot = 0
+anzdlf = 0.
+sumtlf = 0.
+
+end subroutine sim_ini
\ No newline at end of file