GetSpc.f90

Go to the documentation of this file.

!==============================================================================
!===============================================================
SUBROUTINE getspc(nspc, doFFT)
    use filelistmodule
    use filehandlingmodule
    use loggermodule
    !    use GFT
    ! CALL modules for TYPEdefinitions>---------------------------------------------------------------
    use all_par, only: maxhc, birht, maxspc, a1, a2, c1, c2, kn1, kn2, &
            alpha_all,  maxlc, &
            spec, speccl, htmax, hcwidth, seedsdifferent, mathgtdifferent, &
            dispersaldifferent, mastseeding, &
            tabsepoutput,  &
            readdispersalkernel   
    
    IMPLICIT NONE
    
    ! Passed variables>--------------------------------------------------------------------------------
    LOGICAL, INTENT(IN)  :: doFFT     ! dispersal with FFT or direct?
    
    INTEGER, INTENT(out) :: nspc      ! number of species[=spec]
    
    ! Local variables>---------------------------------------------------------------------------------
    INTEGER :: err, & ! I/O error handling
            ht, & ! height index for calculating seedsproduced per height class      ! DSP
            i, & ! looping variable for species and immigration dates
            ltcl       
    REAL    ::  sumprop, &     ! sum to calculate proportion of seedper height class (of max)    ! DSP
            swidth, &     ! step width for scaling seedfraction along height classes        ! DSP
            seedMaxAge, &     ! maximum seed ager
            lih, lidep
    
    character*1 :: tab
    character(len=100) :: nameLong
    character(len=100) :: nameShort
    LOGICAL     :: finish 
    
    ! Here the SUBROUTINEstarts>**********************************************************************
    finish = .false.
    !----- <First, open file for reading species parameter and kernel informations>
    if (readdispersalkernel) then
        call openfiler(dispersalkernel_file, err) ! closed (this l. 292)
        if (err /= 0) then
            call logerror("Could not open dispersal kernel file: "//dispersalkernel_file%path)
            error stop
        end if
    end if
    
    call openfilew(dispersalkernelnew_file, err) ! closed (this l. 290)
    if (err /= 0) then
        call logerror("Could not open new dispersal kernel file: "//dispersalkernelnew_file%path)
        error stop
    end if
    !-----  Read the species parameters  --------------------------------------------- 
    call openfiler(species_file, err) ! closed (this l. 288)
    if (err /= 0) then
        call logerror("Could not open species-pars file: "//species_file%path)
        error stop
    end if
    
    read (species_file%unit, "(A)") ! Skip header
    
    nspc = 0
    read_spec: do i = 1, maxspc
        !----- Read data strings into object spec
        nspc = nspc + 1
        read (species_file%unit, *, iostat=err) &
                namelong, nameshort, spec(i)%stb, spec(i)%stn, spec(i)%kdmax, &
                spec(i)%khmax, spec(i)%kamax, spec(i)%kg, spec(i)%kddmin, spec(i)%kddmax, spec(i)%kwit, &
                spec(i)%kdrt, spec(i)%kGermDrSens, spec(i)%kntol, spec(i)%kbrow, spec(i)%klighs, spec(i)%kligha, spec(i)%klq, &
                spec(i)%kimm, spec(i)%resld, spec(i)%ploto, spec(i)%par0, spec(i)%par1, spec(i)%par2, &
                spec(i)%minmat, &
                spec(i)%seedGerm, spec(i)%seedLoss, seedmaxage, &
                spec(i)%period, spec(i)%maxseed, spec(i)%dispFac, spec(i)%alfa1, spec(i)%alfa2, &
                spec(i)%repFac
        spec(i)%nl = trim(namelong)
        spec(i)%ns = trim(nameshort)
        
        spec(i)%nb = i
        !----- If EOF, then exit the read loop
        exit_loop: if (err /= 0) then
        nspc = nspc - 1
        exit read_spec
    end if exit_loop
    end do read_spec
    write (logmessage, '(A,I4,A)')  "Read ", nspc, " species from "//species_file%path
    call loginfo(logmessage)
    spec%maxdhm = real(spec%kdmax)/100.0
    spec%maxgro = real(spec%kg)/100.0
    
    defmort: do i = 1, nspc
        spec(i)%cmort = 4.605/real(spec(i)%kamax) ! tree const. mortality is derived from maximum tree age
        spec(i)%seedSurv = 0.05**(1.0/seedmaxage) ! seed survival is derived from maximum age
    end do defmort
    
    !-----  Derive additional species properties from parameters and put them into spec and specCl>
    
    spec%tb = 2.0
    where (spec%stb == "C") spec%tb = 1   
    !----- get critical light threshold for establishment for the species from the parameter klighs  
    spec%lthres = (0.1*real(spec%klighs)) - 0.4
    where (spec%klighs < 5) spec%lthres = 0.025*real(spec%klighs - 1.0)
    where (spec%lthres < 0.0) spec%lthres = 0.0      
    !----- calculate for each species the light dependence value in the light classes   
    do i = 1, nspc
        do ltcl = 1, maxlc
            lih = real(ltcl*(ltcl + 1))/real(maxlc*(maxlc + 1)) ! available light in light class
            call contlightdep(lih, spec(i)%kligha, lidep)       ! dependence of the adults of the species on this light
            speccl(i)%lightDepA(ltcl) = lidep
            call contlightdep(lih, spec(i)%klighs, lidep)       ! dependence for the establishment of the species on this light
            speccl(i)%lightDepE(ltcl) = lidep
        end do ! ltcl
    end do ! i species
    !----- <Calculate absolute MAX height over all trees>
    htmax = maxval(spec%khmax)
    
    hcwidth = (real(htmax) - birht)/real(maxhc - 1)    !----- height class width;  Heike's version
    
    !----- <Calculate absolute MAX height class of one species>
    spec%maxhtc = min(floor(real(maxhc - 1)* &
            (real(spec%khmax) - birht)/(real(htmax) - birht) + 1.0), maxhc) !----- Heike's version
    
    !----- Set values to the coefficients for LA & BIOMASS calculations
    a1 = (/exp(-2.5), exp(-2.3), exp(-2.9), exp(-1.8), exp(-1.5)/)
    a2 = (/1.4, 1.4, 1.7, 1.4, 1.6/)
    c1 = (/0.45, 0.35/)
    c2 = (/6.0, 12.0/)
    
    kn1 = (/-0.016, -0.022, -0.016/)
    kn2 = (/2.245, 30.605, 43.973/)
    
 
    !----- min. maturation height, is read from parameter file
    if (.NOT. mathgtdifferent) &
            spec%minmat = birht + 0.8*(spec%khmax - birht)
    
    !----- This is converting the minmat variable into a REAL number of classproportion
    spec%mathcp = ((real(maxhc - 1)*(spec%minmat - birht)/(real(htmax) - birht)) + 1.0)
    
    !----- derive several other properties for species
    
    speciesproperties: do i = 1, nspc
        !----- This is setting up the fraction of seeds produced by height class of the potential maximum
        !-----  max. seed number, dispersal distance and mast seeding period are set to standard values, if these scenarios are not used
        if (.NOT. seedsdifferent) &
                spec(i)%maxseed = 10000.0*spec(i)%khmax/htmax          !----- read from parameterfile
        if (.NOT. dispersaldifferent) spec(i)%alfa1 = alpha_all
        if (.NOT. mastseeding) spec(i)%period = 1.0
        
        sumprop = 0.0
        speccl(i)%seedprod = 0.0
        
        !----- Here the amount of seeds produced in each height class per tree is calculated (ask Nick for details...)
        if (spec(i)%mathcp > real(spec(i)%maxhtc)) then
            spec(i)%mathcp = spec(i)%maxhtc        
        end if
        swidth = 11.0/real(spec(i)%maxhtc - floor(spec(i)%mathcp) + 1) !----- stepwidth to scale grad. of htcl
   
        init_sdht: do ht = floor(spec(i)%mathcp), spec(i)%maxhtc
            !----- range between 0 = 10 for x along height classes (ranging fromminmat to maxhtc); divided by
            !----- 100.0 to scale from 0.1 to 1.0; ((ht-1)*swidth)=x of y=(10.+(.9*x**2))/100; scaled by sum!!
            speccl(i)%seedprod(ht) = (10.+(.9*((real(ht - floor(spec(i)%mathcp))*swidth)**2)))/100.0
            sumprop = sumprop + speccl(i)%seedprod(ht)
        end do init_sdht
        
        speccl(i)%seedprod = speccl(i)%seedprod/sumprop
        
        ! ----- Calculates and stores  dispersal kernel for this species  
        
    end do speciesproperties ! i species, index i
    do i = 1, nspc
                CALL calculateandstoredispersalkernelofspecies(i, dofft) 
 
   end do   ! i species, index i
 
 !   Write out read in parameters as a control  
    if (tabsepoutput) then
        tab = char(9)
    else
        tab = ','
    end if
    
    call openfilew(speciesout_file, err) ! closed (this l. 289)
    if (err /= 0) then
        call logerror("Could not create species output file: "//speciesout_file%path)
        error stop
    end if
    write (speciesout_file%unit, "(A)") 'Species'//tab//'Abbrv'//tab//'sType/B'//tab//'sType/N'//tab//'kDMax'//tab// &
            'kHMax'//tab//'kAMax'//tab//'kG'//tab//'kDDMin'//tab//'kDD75'//tab// &
            'kWiT'//tab//'kDrT'//tab//'kGermDrSens'//tab//'kNTol'//tab//'kbrow'//tab//'klighs'//tab// &
            'kligha'//tab//'klq'//tab//'kimm'//tab//'resID'//tab//'ploto'//tab// &
            'par0'//tab//'par1'//tab//'par2'//tab//'inmat'//tab//'seedGerm'//tab// &
            'seedLoss'//tab//'seedMaxAge'//tab//'period'//tab//'maxseed'//tab//'dispFac'//tab// &
            'alfa1'//tab//'alfa2'//tab//'repFac'//tab//'red'//tab//'green'//tab//'blue'
    do i = 1, nspc
        write (speciesout_file%unit, '(3(A,A1),8(I6,A1),2(F18.6,A1),11(I8,A1),10(F18.6,A1),2(I8,A1),1(I8))') &
                spec(i)%nl, tab, spec(i)%ns, tab, &
                spec(i)%stb, tab, spec(i)%stn, tab, spec(i)%kdmax, tab, &
                spec(i)%khmax, tab, spec(i)%kamax, tab, spec(i)%kg, tab, spec(i)%kddmin, tab, spec(i)%kddmax, tab, &
                spec(i)%kwit, tab, spec(i)%kdrt, tab, spec(i)%kGermDrSens,tab, spec(i)%kntol, tab, &
                spec(i)%kbrow, tab, spec(i)%klighs, tab, &
                spec(i)%kligha, tab, spec(i)%klq, tab, spec(i)%kimm, tab, spec(i)%resld, tab, spec(i)%ploto, tab, &
                spec(i)%par0, tab, spec(i)%par1, tab, spec(i)%par2, tab, spec(i)%minmat, tab, spec(i)%seedGerm, tab, &
                spec(i)%seedLoss, tab, seedmaxage, tab, spec(i)%period, tab, spec(i)%maxseed, tab, &
                spec(i)%dispFac, tab, spec(i)%alfa1, tab, spec(i)%alfa2, tab, spec(i)%repFac, tab, &
                spec(i)%red, tab, spec(i)%green, tab, spec(i)%blue
    end do
    
 ! close the files
    call closefile(species_file)
    call closefile(speciesout_file)
    call closefile(dispersalkernelnew_file)
    if (readdispersalkernel) then
        call closefile(dispersalkernel_file)
    end if
    !----- Immigration input
    call readimmigrationdata(nspc)
    
end SUBROUTINE getspc