source: branches/publications/ORCHIDEE_CAN_r2290/src_stomate/stomate_stand_structure.f90 @ 5242

! =================================================================================================================================
! MODULE       : stomate_stand_structure
!
! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
!
! LICENCE      : IPSL (2006)
! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
!
!>\BRIEF         Initialize and update density, crown area.
!!
!!\n DESCRIPTION: None
!!
!! RECENT CHANGE(S): None
!!
!! REFERENCE(S) :
!!
!! SVN          :
!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_prescribe.f90 $
!! $Date: 2013-01-04 16:50:56 +0100 (Fri, 04 Jan 2013) $
!! $Revision: 1126 $
!! \n
!_ ================================================================================================================================

MODULE stomate_stand_structure

  ! modules used:

  USE ioipsl_para
  USE stomate_data
  USE pft_parameters
  USE constantes
  USE function_library, ONLY:wood_to_height_eff, wood_to_dia_eff, wood_to_cv_eff, wood_to_cn_eff 

  IMPLICIT NONE

  ! private & public routines

  PRIVATE
  PUBLIC stand_structure_clear, derive_biomass_quantities

    ! first call
    LOGICAL, SAVE                                    :: firstcall = .TRUE.
    
CONTAINS

! =================================================================================================================================
!! SUBROUTINE   : stand_structure_clear
!!
!>\BRIEF        : Set the firstcall flag back to .TRUE. to prepare for the next simulation.
!_=================================================================================================================================

  SUBROUTINE stand_structure_clear
    firstcall=.TRUE.
  END SUBROUTINE stand_structure_clear


!! ================================================================================================================================
!! SUBROUTINE   :derive_biomass_quantities
!!
!>\BRIEF        Use the basal areabiomass and number density to derive various
!!              distributions of the trees in a single grid point for
!!              all vegetation types
!!
!! DESCRIPTION  : I have chosen to do this for a single grid point instead of 
!!                the whole map or a single grid point and single PFT because
!!                of the compromise between speed (subroutine overhead) and
!!                flexibility
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): ::height_dist, ::diameter_dist, ::cn_area_dist, ::cn_vol_dist
!!
!! REFERENCE(S) : 
!!
!! FLOWCHART : None
!! \n
!_ ================================================================================================================================

  SUBROUTINE derive_biomass_quantities(npts, nvm, ncirc, circ_class_n, &
       circ_class_biomass, values)

  !! 0 Variable and parameter declaration 
  
    !! 0.1 Input variables
    INTEGER,INTENT(IN)                                      :: npts               !! Number of pixels
    INTEGER,INTENT(IN)                                      :: nvm                !! Number of PFT types
    INTEGER,INTENT(IN)                                      :: ncirc              !! Number of circumference classes
    REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), &
         INTENT(IN)                                         :: circ_class_biomass !! Biomass of the componets of the model  
                                                                                  !! tree within a circumference
                                                                                  !! class @tex $(gC ind^{-1})$ @endtex
    REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(IN) &
                                                            :: circ_class_n       !! Number of trees within each circumference
                                                                                  !! class @tex $(m^{-2})$ @endtex

    !! 0.2 Output variables

    REAL(r_std),DIMENSION(npts,nvm,ncirc,ndist_types),INTENT(OUT)  &
                                                            :: values             !! An array which holds data for
                                                                                  !! various canopy parameters 


    !! 0.3 Modified variables

    !! 0.4 Local variables

    INTEGER(i_std)                                          :: ipts, ivm, icir, &
                                                                       idist_type !! index (unitless)
!_ ================================================================================================================================

    IF (bavard.GE.2) WRITE(numout,*) 'Entering derive_biomass_quantities'

    ! zero everything
    values(:,:,:,:)=zero

    DO ipts=1,npts
       DO ivm=1,nvm

          IF (.NOT. is_tree(ivm)) CYCLE

          ! compute the new mean values

          ! for the height
          values(ipts,ivm,:,iheight)=&
               wood_to_height_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)

          ! for the crown area
          values(ipts,ivm,:,icnarea)=&
               wood_to_cn_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)

          ! for the stem diameter
          values(ipts,ivm,:,idiameter)=&
               wood_to_dia_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)

          ! for the crown volume
          values(ipts,ivm,:,icnvol)=&
               wood_to_cv_eff(circ_class_biomass(ipts,ivm,:,:,icarbon),ivm)

          ! these next two assume the crowns are ellipsoids...since we are 
          ! interested in spheres at the moment, we just set the two crown
          ! diameters to be equal for the verticle crown diameter
          DO icir=1,ncirc
             values(ipts,ivm,icir,icndiaver)=&
                  2.0_r_std*(3.0_r_std*values(ipts,ivm,icir,icnvol)/&
                  (4.0_r_std*pi))**(un/3.0_r_std)
          ENDDO

          ! for the horizontal crown diameter
          values(ipts,ivm,:,icndiahor)=values(ipts,ivm,:,icndiaver)

       ENDDO ! loop over PFT

    ENDDO ! loop over points

    IF (bavard.GE.2) WRITE(numout,*) 'Leaving derive_biomass_quantities'

 END SUBROUTINE derive_biomass_quantities


END MODULE stomate_stand_structure