AllocateAreasAndKernels.f90

Go to the documentation of this file.

!==============================================================================
!===============================================================
SUBROUTINE allocateareas
    use all_par, only: newseedsincell, currstateincell, bioclimdata, maxspc, &
                       stockability, seedrain, stategrid, &
               !>avbio, 
                       stocksum, stocksumcum, &
                       landcoverfilter, oldbioclim, newbioclim, maxlat, maxlon
    use loggermodule, only: loginfo
    IMPLICIT NONE
    INTEGER :: alloc_st
    character(len=500) :: errormsg
 
    call loginfo("Allocating areas...")
 
    allocate (seedrain(1:maxlat, 1:maxlon), stat=alloc_st, errmsg=errormsg)
    call checkalloc(alloc_st, errormsg, "seedrain")
 
    allocate (stockability(1:maxlat, 1:maxlon), stat=alloc_st, errmsg=errormsg)
    call checkalloc(alloc_st, errormsg, "stockability")
    stockability = 0
 
    allocate (landcoverfilter(1:maxlat, 1:maxlon), stat=alloc_st, errmsg=errormsg)
    call checkalloc(alloc_st, errormsg, "landcoverfilter")
    landcoverfilter = 0
 
    allocate (stocksum(1:maxlat), stat=alloc_st)
    call checkalloc(alloc_st, errormsg, "stocksum")
    stocksum = 0
 
    allocate (stocksumcum(1:maxlat), stat=alloc_st)
    call checkalloc(alloc_st, errormsg, "stocksumcum")
    stocksumcum = 0
 
!      allocate (avbio(1:maxlat, 1:maxlon, 1:maxspc, 0:3), stat=alloc_st)
!      call CheckAlloc(alloc_st, errormsg, "avbio")
!      avbio = 0
 
    allocate (stategrid(1:maxlat, 1:maxlon), stat=alloc_st)
    call checkalloc(alloc_st, errormsg, "stateGrid")
 
 
    allocate (oldbioclim%bc(1:maxlat, 1:maxlon), stat=alloc_st)
    call checkalloc(alloc_st, errormsg, "oldBioClim%bc")
 
    allocate (newbioclim%bc(1:maxlat, 1:maxlon), stat=alloc_st)
    call checkalloc(alloc_st, errormsg, "newBioClim%bc")
end SUBROUTINE allocateareas
 
! ==============================================================================
! ===============================================================
SUBROUTINE allocatekernel(rad, vartxt)
    use all_par, only: kernel, kernelfine, kernel1, kernel2
    use loggermodule, only: logwarning
    IMPLICIT NONE
    !  REAL, allocatable, INTENT(out):: kernel(:,:)
    INTEGER, INTENT(in) :: rad
    character*10, INTENT(in):: vartxt
    INTEGER :: alloc_st
    character(len=500) :: errormsg
 
    select case (vartxt)
    case ("kernel     ")
        if (allocated(kernel)) deallocate (kernel)
        allocate (kernel(-rad:rad, -rad:rad), stat=alloc_st, errmsg=errormsg)
        kernel = 0
    case ("kernel1    ")
        if (allocated(kernel1)) deallocate (kernel1)
        allocate (kernel1(-rad:rad, -rad:rad), stat=alloc_st, errmsg=errormsg)
        kernel1 = 0
    case ("kernel2    ")
        if (allocated(kernel2)) deallocate (kernel2)
        allocate (kernel2(-rad:rad, -rad:rad), stat=alloc_st, errmsg=errormsg)
        kernel2 = 0
    case ("kernelFine")
        if (allocated(kernelfine)) deallocate (kernelfine)
        allocate (kernelfine(-rad:rad, -rad:rad), stat=alloc_st, errmsg=errormsg)
        kernelfine = 0
    case default
        call logwarning("Cannot allocate "//trim(vartxt)//". Not defined!>")
    end select
    call checkalloc(alloc_st, errormsg, vartxt)    
end SUBROUTINE allocatekernel
 
!==============================================================================
SUBROUTINE allocatespeckernel(rad, ispec)
    use all_par, only: spec
    IMPLICIT NONE
    !  REAL, allocatable, INTENT(out):: kernel(:,:)
    INTEGER, INTENT(in) :: rad, ispec
    INTEGER :: alloc_st
    character*17 :: vartxt
    character(len=500) :: errormsg
 
    if (allocated(spec(ispec)%kernel)) deallocate (spec(ispec)%kernel)
    allocate (spec(ispec)%kernel(-rad:rad, -rad:rad), stat=alloc_st, errmsg=errormsg)
    vartxt = "species "//char(ispec)//" kernel"
    call checkalloc(alloc_st, errormsg, vartxt)
    spec(ispec)%kernel(-rad:rad, -rad:rad) = 0
end SUBROUTINE allocatespeckernel
 
! ==============================================================================
! ===============================================================
SUBROUTINE allocatespectransformedkernel( ispec)
    use all_par, only: spec
    IMPLICIT NONE
    !  REAL, allocatable, INTENT(out):: kernel(:,:)
    INTEGER, INTENT(in) ::  ispec
    INTEGER :: alloc_st 
    character*17 :: vartxt
    character(len=500) :: errormsg
 
    if (allocated(spec(ispec)%kernel_FT)) deallocate (spec(ispec)%kernel_FT)
    allocate (spec(ispec)%kernel_FT(0 : spec(ispec)%maxlatExt/2, 1 : spec(ispec)%maxlonExt), stat=alloc_st, errmsg=errormsg)
    vartxt = "species "//char(ispec)//" transformed kernel"
    call checkalloc(alloc_st, errormsg, vartxt)
    spec(ispec)%kernel_FT(0:spec(ispec)%maxlatExt/2, 1:spec(ispec)%maxlonExt) = 0.
end SUBROUTINE allocatespectransformedkernel
 
! ==============================================================================
! ===============================================================
SUBROUTINE checkalloc(alloc_st, errormsg, txt)
    use loggermodule, only: logerror
    IMPLICIT NONE
    INTEGER, INTENT(in) :: alloc_st
    character(len=*), INTENT(in):: errormsg
    character(len=*), INTENT(in):: txt
    if (alloc_st /= 0) then
        call logerror("Could not allocate '"//trim(txt)//"', "//trim(errormsg))
        error stop
    end if
end SUBROUTINE checkalloc
! done