!*****************************************************************!
!*                                                               *!
!*        4C (FORESEE)                                           *!
!*                                                               *!
!*       SR gen_one_coh for:                                     *!
!*       planting of small trees given by *.pla                  *!
!*       used in prep_stand                                      *!
!*       SR is called by flag_reg=20                             *!
!*                                                               *!
!*                  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 gen_one_coh(taxid,age,pl_height,nplant)
 USE data_stand
 USE data_simul
 USE data_species
 USE data_soil
 USE data_help
 USE data_plant
 USE data_manag
 IMPLICIT NONE
 integer    :: nplant,       &
               taxid,        &
               j,nr
 real       :: age,          &
               pl_height,    &
               hhelp,x1,x2,xacc,shelp
real         :: rtflsp, sapwood
real		 :: troot2

TYPE(cohort)    ::tree_ini

external sapwood
external rtflsp

   call coh_initial (tree_ini)
   max_coh = max_coh + 1
   tree_ini%ident =  max_coh
   tree_ini%species = taxid
   tree_ini%ntreea = nplant
   tree_ini%nta = tree_ini%ntreea
   tree_ini%x_age = age
   tree_ini%height = pl_height
   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
! solve  equation for calculation of sapwood from height; determine root
        heihelp = tree_ini%height
        shelp=rtflsp(sapwood,x1,x2,xacc)
        tree_ini%x_sap = (10**shelp)/1000000         !  transformation mg ---> kg
    ENDIF

! leaf matter 
    tree_ini%x_fol = (spar(taxid)%seeda*(tree_ini%x_sap** spar(taxid)%seedb))   ![kg]

! fine root matter rough estimate
     tree_ini%x_frt = tree_ini%x_fol

! cross sectional area of heartwood
    tree_ini%x_crt = tree_ini%x_sap * spar(tree_ini%species)%alphac*spar(tree_ini%species)%cr_frac
    tree_ini%x_tb = tree_ini%x_sap * spar(tree_ini%species)%alphac*(1.-spar(tree_ini%species)%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

! 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
      anz_coh=anz_coh+1
    END IF

END SUBROUTINE gen_one_coh