Report.f90

Go to the documentation of this file.

!==============================================================================
!
!  Name   :  Report
!
!  Remarks:  contains the SUBROUTINE
!
!            Report (<LocalDynOneTimeStep<DistrLocalDynThisTime<TimeLoop<TreeMig)
!
!==============================================================================
! design          : H. Lischke, N. Zimmermann
! author(s)       : H. Lischke, N. Zimmermann
! implementation  : H. Lischke, N. Zimmermann
! cleaner         : T.J. Loeffler
! copyright       : (c) 1999, 03 by H. Lischke
!==============================================================================
 
!===================================================================== 
!===============================================================
SUBROUTINE report(nspc, year, lat, lon)
    ! <CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------
    use all_par, only: stategrid, seedrain, spec, speccl, tabsepoutput, pltsiz, writeoutput, maxhc, &
                       stockability, reportintervals, simustartyear, &
                       latrealstart, lonrealstart, cellsidelength, unitofspatialdata, pi, &
                       maxlc, ltprf
    use filelistmodule, only: &
            biodiv_nc, biomass_nc, number_nc, seed_nc, ingrowth_nc, npp_nc, basalarea_nc, antagonist_nc, &
            pollen_nc, lai_nc, light_nc, heightstruct_nc,&
            biodivoutfile, biomassoutfile, numberoutfile, seedoutfile, ingrowthoutfile, nppoutfile, basareaoutfile, &
            antaoutfile, pollenoutfile, laioutfile, lightdistrperhcloutfile, heightstructoutfiles
            
  
    IMPLICIT NONE
 
    ! <Passed variables>--------------------------------------------------------------------------------
    INTEGER, INTENT(in)    :: nspc, year, lat, lon     ! Passed number of species, year of calculation
 
    ! <Local variables>---------------------------------------------------------------------------------
    INTEGER :: height, &  ! loop-counter
               i     , &  ! loop-counter
               rpti
    REAL :: bio(nspc), &  ! species biomass
            num(nspc), &  ! species number
            basalArea(nspc), &  ! basal area
            pollen(nspc), pol4perc(nspc), &  ! pollen amount and 4*percent
            sumpollen, &
            sumbio, sumbasalarea, diversity, &
            sumnumber, sumseeds, sumantagon, sumingrowth, &
            BiodivIndex, sumnumbh(0:maxhc), lai(nspc), sumlai, rbio, yr, rlat, rlon, totNPP, num_i
 
    character*1 :: tab
 
    ! <Here the SUBROUTINE starts>**********************************************************************
 
    rlat = (lat - 1)*cellsidelength/unitofspatialdata + latrealstart
    rlon = (lon - 1)*cellsidelength/unitofspatialdata + lonrealstart
    !----- Calculate NPP
   ! totLAI = 0.
    do i = 1, nspc
        sumbio = 0
        do height = 1, spec(i)%maxhtc
            rbio = (stategrid(lat, lon)%sp(i)%numin(height))*(speccl(i)%bioin(height))
            sumbio = sumbio + rbio
        end do !height
        stategrid(lat, lon)%sp(i)%NPP = sumbio - stategrid(lat, lon)%sp(i)%specTotalBiomass
        stategrid(lat, lon)%sp(i)%specTotalBiomass = sumbio
        totnpp = totnpp + stategrid(lat, lon)%sp(i)%NPP
    end do
 
!----- Calculate av. biomasses
    yr = year + simustartyear
    rpti = 1
    do i=1,10  ! determine current report interval
        if (yr >= reportintervals(i,2) .and.  yr <= reportintervals(i,3) )  then
            rpti=reportintervals(i,1)
            exit
        end if 
    end do
    if (((mod(year, rpti) == 0)) .AND. (stockability(lat, lon) > 0.0)) then
        sumbio = 0
        sumnumber = 0
        sumseeds = 0
        sumantagon = 0
        sumpollen = 0
        sumingrowth = 0
        sumnumbh = 0
        sumlai = 0
        sumbasalarea =0
        !----- Calculate biomass and density sums over species in heights and total
        byspc: do i = 1, nspc
            bio(i) = 0
            num(i) = 0
            pollen(i) = 0
            lai(i) = 0
            basalarea(i) = 0
 
            do height = 1, spec(i)%maxhtc
                num_i = stategrid(lat, lon)%sp(i)%numin(height)
                num(i)           = num(i)           + num_i 
                bio(i)           = bio(i)           + num_i *   speccl(i)%bioin(height)
                lai(i)           = lai(i)           + num_i *   speccl(i)%lain(height)/833.0
                basalarea(i)     = basalarea(i)     + num_i * ((speccl(i)%diaIn(height)/2 )**2) * pi * 10000./833.
                pollen(i)        = pollen(i)        + num_i *   speccl(i)%seedprod(height) * spec(i)%repFac
                sumnumbh(height) = sumnumbh(height) + num_i 
             end do
 
            !            sumseeds   = sumseeds + stateGrid(lat,lon)%sp(i)%seedBank
            sumseeds = sumseeds + seedrain(lat, lon)%sp(i)%newseeds
            sumingrowth = sumingrowth + stategrid(lat, lon)%sp(i)%ingrowth
            sumantagon = sumantagon + stategrid(lat, lon)%sp(i)%antagonist
            sumbio = sumbio + bio(i)
            sumnumber = sumnumber + num(i)
            sumpollen = sumpollen + pollen(i)
            sumlai = sumlai + lai(i)
            sumbasalarea =sumbasalarea + basalarea(i)
        end do byspc
 
        !----- Calculate pollen percent
        if (abs(sumpollen) < 1.e-20) then
            pol4perc = 0.0
        else
            pol4perc = 100.0*pollen/sumpollen
        end if
 
        if (tabsepoutput) then
            tab = char(9)
        else
            tab = ','
        end if
        if(writeoutput%netcdf) then
            !----- write values of diversity  
            if (writeoutput%biodiv) then
                diversity = biodivindex(nspc, bio, sumbio)
                biodiv_nc%values2D(lon, lat) = diversity
            end if
    
            !----- write values of biomass (t/ha) per species
            if (writeoutput%biomass) then
                do i=1,nspc
                    biomass_nc%values3D(i,lon, lat) = bio(i)
                end do
                biomass_nc%values3D(nspc+1,lon, lat) = sumbio
            end if
            !----- write values of density (1/patchsize) per species 
            if (writeoutput%number) then
                do i=1,nspc
                    number_nc%values3D(i,lon, lat) = num(i)*10000/pltsiz
                end do
                number_nc%values3D(nspc+1,lon, lat) = sumnumber*10000/pltsiz   ! number per ha
            end if
            !----- write values of the seed numbers in seed bank (1/patchsize) per species
            if (writeoutput%seeds) then
                do i=1,nspc
                    seed_nc%values3D(i,lon, lat) = stategrid(lat, lon)%sp(i)%sb
                end do
                seed_nc%values3D(nspc+1,lon, lat) = sumseeds
            end if
            !----- write values of ingrowth (1/patchsize) per species 
            if (writeoutput%ingrowth) then
                do i=1,nspc
                    ingrowth_nc%values3D(i,lon, lat) = stategrid(lat,lon)%sp(i)%ingrowth
                end do
                ingrowth_nc%values3D(nspc+1,lon, lat) = sumingrowth
            end if
            !----- write values of the NPP (t/ha) per species
            if (writeoutput%NPP) then
                do i=1,nspc
                    npp_nc%values3D(i,lon, lat) = stategrid(lat, lon)%sp(i)%NPP
                end do
                npp_nc%values3D(nspc+1,lon, lat) = totnpp
            end if
            !----- write values of basal area (m2/ha) per species
            if (writeoutput%basalArea) then
                do i=1,nspc
                    basalarea_nc%values3D(i,lon, lat) = basalarea(i)
                end do
                basalarea_nc%values3D(nspc+1,lon, lat) = sumbasalarea
            end if
            !----- write values of antagonists
            if (writeoutput%antagonists) then
                do i=1,nspc
                    antagonist_nc%values3D(i,lon, lat) = stategrid(lat, lon)%sp(i)%antagonist
                end do
                antagonist_nc%values3D(nspc+1,lon, lat) = sumantagon
            end if
            !----- write values of pollen percents
            if (writeoutput%pollen) then
                do i=1,nspc
                    pollen_nc%values3D(i,lon, lat) = pol4perc(i)
                end do
                pollen_nc%values3D(nspc+1,lon, lat) = sumpollen
            end if
            !----- write values of lai (m^2/m^2) per species
            if (writeoutput%lai) then
                do i=1,nspc
                    lai_nc%values3D(i,lon, lat) = lai(i)
                end do
                lai_nc%values3D(nspc+1,lon, lat) = sumlai
            end if
            !----- write values of light distributions (fraction in lightclasses)
            if (writeoutput%light) then
                do height = 1, maxhc+1
                    do i=1,maxlc
                        light_nc%values4D(height, i, lon, lat) = ltprf(height-1,i)
                    end do
                end do
            end if
            !----- write values of height structure
            if (writeoutput%hstruct) then
                do i = 1, nspc
                    sumnumbh(0) = sumnumbh(0) + stategrid(lat, lon)%sp(i)%numin(0)
                end do
                do height = 0, maxhc
                    do i=1,nspc
                        heightstruct_nc(height+1)%values3D(i,lon, lat) = stategrid(lat, lon)%sp(i)%numin(height)
                    end do
                    heightstruct_nc(height+1)%values3D(nspc+1,lon, lat) = sumnumbh(height)
                end do
            end if
        else ! not netcdf
            !----- Output of diversity  
            if (writeoutput%biodiv) then
                diversity = biodivindex(nspc, bio, sumbio)
                write (biodivoutfile%unit, 100) lat, tab, lon, tab, year, tab, diversity
            end if
    
            !----- Output of biomass (t/ha) per species
            if (writeoutput%biomass) then
                write (biomassoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (bio(i), tab, i=1, nspc), sumbio
            end if
            !----- Output of density (1/patchsize) per species 
            if (writeoutput%number) then
                write (numberoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (num(i)*10000/pltsiz, tab, i=1, nspc), sumnumber*10000/pltsiz   ! number per ha
            end if
            !----- output of the seed numbers in seed bank (1/patchsize) per species
            if (writeoutput%seeds) then
                write (seedoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (stategrid(lat, lon)%sp(i)%sb, tab, i=1, nspc), sumseeds
            end if
             !----- output of the ingrowth (1/patchsize) per species 
            if (writeoutput%ingrowth) then
                write(ingrowthoutfile%unit,100)   lat, tab, lon, tab, year, tab, &
                   (stategrid(lat,lon)%sp(i)%ingrowth , tab, i=1,nspc), sumingrowth
             end if
            !----- output of the NPP (t/ha) per species
             if (writeoutput%NPP) then
                 write (nppoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                     (stategrid(lat, lon)%sp(i)%NPP, tab, i=1, nspc), totnpp
             end if
           !----- output of the basal area (m2/ha) per species
            if (writeoutput%basalArea) then
                write (basareaoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (basalarea(i), tab, i=1, nspc), sumbasalarea
            end if
            !----- output of the antagonists
            if (writeoutput%antagonists) then
                write (antaoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (stategrid(lat, lon)%sp(i)%antagonist, tab, i=1, nspc), sumantagon
            end if
            !----- output of the pollen percents
            if (writeoutput%pollen) then
                write (pollenoutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (pol4perc(i),tab, i=1,nspc), sumpollen
            end if
            !----- output of the lai (m^2/m^2) per species
            if (writeoutput%lai) then
                write (laioutfile%unit, 100) lat, tab, lon, tab, year, tab, &
                    (lai(i), tab, i=1, nspc), sumlai
            end if
    
            !----- output of the height structure (1/patchsize)
            if (writeoutput%hstruct) then
                do i = 1, nspc
                    sumnumbh(0) = sumnumbh(0) + stategrid(lat, lon)%sp(i)%numin(0)
                end do
                do height = 0, maxhc
                    write (heightstructoutfiles(height + 1)%unit, 100) lat, tab, lon, tab, year, tab, &
                        (stategrid(lat, lon)%sp(i)%numin(height), tab, i=1, nspc), sumnumbh(height)
                end do
            end if
        
            !----- output of the light distributions (fraction in lightclasses)
            if (writeoutput%light) then
                do height = 0, maxhc
                    write (lightdistrperhcloutfile%unit, 101) lat, tab, lon, tab, year, tab, height, tab,&
                        (ltprf(height,i), tab, i=1, maxlc)    
                end do
            end if
        end if
        
    end if
100 FORMAT(3(i5, a1), 60(e13.7, a1))
101 FORMAT(4(i5, a1), 40(e13.7, a1))
end SUBROUTINE report