!
! This file is part of FBUF - Fortran BUFfers For Accelerators
! Copyright 2018 Pietro Bonfa'
! License: GPLv2
!
!--
!
!==================================================================
!==================================================================
! *DO NOT EDIT*: automatically generated from devxlib_buffers.jf90
!==================================================================
!==================================================================
!
#include<devxlib_macros.h>
#include<devxlib_defs.h>
!
!> The **Buffers** module.
!
module {{modulename}}
  !
#if defined(__DXL_CUDAF)
  use cudafor
#elif defined(__DXL_OPENACC)
  use openacc
#elif defined(__DXL_OPENMP_GPU)
  use omp_lib
#endif
  use iso_fortran_env, only : real64

  implicit none
  !
  integer, parameter :: LLI = selected_int_kind(15)

  TYPE :: Node
#if defined(__DXL_CUDAF)
     BYTE, POINTER {% if (attributes) %}, {{attributes}} {% endif %} :: space(:)
#else
     BYTE, POINTER                 :: space(:)
#endif
     LOGICAL             :: locked
     TYPE(Node), POINTER :: Next
  END TYPE Node
  !
  private
  !
  TYPE(Node), POINTER  :: Head => null()
  !
  public :: {{typename}}
  !

!> The main **fbuf** class.
  type :: {{typename}}
     logical :: verbose = .false.
     !
   contains
     procedure :: init                     !< Initialize the class selecting buffers dimension and number per type.\
     final :: clean

     procedure :: reinit
     procedure :: dealloc

     generic, public :: lock_buffer => &
{%- for item in interfaces %}
                        lock_buffer_{{item.subname}}{% if not loop.last %}, &{% endif %}           !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor%}
     !
{%- for item in interfaces %}
     procedure, private :: lock_buffer_{{item.subname}}           !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor %}
     !
     generic, public :: release_buffer => &
{%- for item in interfaces %}
                        release_buffer_{{item.subname}}{% if not loop.last %}, &{% endif %}        !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor %}
     !
{%- for item in interfaces %}
     procedure, private :: release_buffer_{{item.subname}}           !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor %}
     !
     generic, public :: prepare_buffer => &
{%- for item in interfaces %}
                        prepare_buffer_{{item.subname}}{% if not loop.last %}, &{% endif %}        !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor %}
     !
{%- for item in interfaces %}
     procedure, private :: prepare_buffer_{{item.subname}}           !< Releases a {{item.vtype}} {{item.vrankname}} buffer
{%- endfor %}
     !
     procedure, private :: lock_space
     procedure, private :: prepare_space
     procedure, private :: release_space
     procedure, public  :: dump_status
     procedure, public  :: print_report
  end type

  
  
contains
  !> Initialize the class selecting the device type.
  subroutine init(this, info, verbose)
    use iso_c_binding
    implicit none
    class({{typename}}),  intent(inout) :: this     !< The class.
    integer,       intent(out) :: info    !< Error reporting.
                                          !<  0: ok
                                          !< -1: generic error
    logical, optional, intent(in) :: verbose
    !
    this%verbose = .false.
    if (present(verbose)) this%verbose = verbose

    if (this%verbose) write (*, *) "[{{modulename}}] Initializing buffers"
    NULLIFY (Head)
    info = 0
    !
  end subroutine init
  !
  subroutine clean(this)
    implicit none
    type({{typename}}) :: this     !< The class.
    call this%dealloc()
  end subroutine clean
  !
  subroutine dealloc(this)
    use iso_c_binding
    implicit none
    class({{typename}}) :: this     !< The class.
    integer :: i, info
    TYPE(Node), POINTER  :: temp
#if defined(__DXL_OPENMP_GPU)
    integer(c_int) :: omp_device
    type(c_ptr)    :: cloc
#endif
    i = 0
    DO WHILE (ASSOCIATED(head))
#if defined (__DXL_CUDAF)
{% if attributes == 'device' %}
        IF ( ASSOCIATED(head%space) ) DEALLOCATE(head%space)
{% else %}
        IF ( ASSOCIATED(head%space) ) info = cudaFreeHost(c_loc(head%space))
{% endif %}
#elif defined(__DXL_OPENMP_GPU)
{% if attributes == 'device' %}
        omp_device = omp_get_default_device()
        IF ( ASSOCIATED(head%space) ) THEN
           cloc = c_loc(head%space(1))
           call omp_target_free(cloc, omp_device)
        ENDIF
{% else %}
        error stop 'Pinned memory not yet available'
{% endif %}
#else
        IF ( ASSOCIATED(head%space) ) DEALLOCATE(head%space)
#endif
        temp => head
        head => head%next
        DEALLOCATE(temp)
        i = i + 1
    END DO
    NULLIFY (Head)
    if (this%verbose) write (*, '("[{{modulename}}] Cleaned ", I2, " buffers")') i
  end subroutine dealloc
  !
  subroutine reinit(this, info)
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)  :: this     !< The class.
    integer, intent(out) :: info !< 0 -> ok ; -n -> failed, n buffers still allocated
    integer :: l
    TYPE(Node), POINTER  :: temp

    temp => Head
    l = 0
    DO WHILE (ASSOCIATED(temp))
        if (temp%locked) l = l + 1
        temp => temp%Next
    END DO
    IF ( l > 0 ) THEN
        info = -l
        return
    ELSE
        CALL this%dealloc()
        info = 0
    END IF
    !
  end subroutine reinit
  !
  subroutine dump_status(this)
    class({{typename}}), intent(inout)     :: this     !< The class.
    TYPE(Node), POINTER  :: temp
    integer :: i
    i = 1
    temp => Head
    write (*, *) "Buffer status ================="
    write (*, *) "          n        size Locked"
    DO WHILE (ASSOCIATED(temp))
        write (*,'(I12, I12, L7)') i, SIZE(TemP%space, kind=LLI), TemP%locked
        TemP => TemP%Next
        i = i + 1
    END DO
    write (*, *) "-------------------------------"
  end subroutine dump_status
  !
  subroutine print_report(this, unit)
    class({{typename}}), intent(inout)     :: this     !< The class.
    INTEGER, OPTIONAL, intent(in)          :: unit
    !
    TYPE(Node), POINTER  :: temp
    integer(kind=LLI) :: tsz
    integer :: i, l
    i = 0
    l = 0
    tsz = 0
    temp => Head
    DO WHILE (ASSOCIATED(temp))
        tsz = tsz + SIZE(temp%space, kind=LLI)
        if (temp%locked) l = l + 1
        temp => temp%Next
        i = i + 1
    END DO
    if ( present (unit) ) then
        write(unit,'("[{{modulename}}] Currently allocated ",(es12.2)," Mbytes, locked: ",(I4)," /",(I4) )') &
              REAL(tsz)/1048576, l, i
    else
        write(*   ,'("[{{modulename}}] Currently allocated ",(es12.2)," Mbytes, locked: ",(I4)," /",(I4) )') &
              REAL(tsz)/1048576, l, i
    end if
  end subroutine print_report
  !
  subroutine lock_space(this, d, cloc, info)
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)     :: this     !< The class.
    integer(kind=LLI), intent(in)          :: d
#if defined(__DXL_CUDAF)
    type({{pointer_type}}), intent(inout)  :: cloc
#else
    type(c_ptr), intent(inout)             :: cloc
#endif
    integer, intent(out)                   :: info
#if defined(__DXL_OPENMP_GPU)
    integer(c_int)                         :: omp_device !< OpenMP default device
#endif
    !
    integer(kind=LLI) :: r, tsz, sz
    TYPE(Node), POINTER  :: temp, good
    INTEGER :: i, good_one_idx
    !
    r   = 0
    tsz = 0
    i   = 1
    !
    ! Find the smallest usable buffer
    good_one_idx = 0
    temp => Head
    NULLIFY(good)
    DO WHILE (ASSOCIATED(temp))
        sz = SIZE(TemP%space, kind=LLI)
        IF ( ( sz >= d ) .and. (TemP%locked .eqv. .false.) ) THEN
            IF ( good_one_idx >= 1 ) THEN
                IF ( sz - d < r) THEN
                    good => temp
                    r = SIZE(TemP%space, kind=LLI) - d
                    good_one_idx = i
                END IF
            ELSE
                good_one_idx = i
                good => temp
                r = sz - d
            END IF
            info = 0
        END IF
        !
        tsz = tsz + sz
        i = i + 1
        !
        TemP => TemP%Next
    END DO
    !
    ! Allocate a new buffer
    IF ( good_one_idx == 0 ) THEN
        ALLOCATE (good)
#if defined(__DXL_CUDAF)
{%- if attributes == 'device' %}
        ALLOCATE (good%space(d), stat=info)
{%- else %}
        info = cudaMallocHost(cloc, int(d))
        CALL c_f_pointer( cloc, good%space, [ d ] )
        !ALLOCATE (good%space(d), stat=info)
{%- endif %}
#elif defined(__DXL_OPENMP_GPU)
{%- if attributes == 'device' %}
        omp_device = omp_get_default_device()
        cloc = omp_target_alloc(d, omp_device)
        IF (c_associated(cloc)) THEN
           CALL c_f_pointer( cloc, good%space, [ d ] )
           info = 0
        ELSE
           info = -10000
        ENDIF
{%- else %}
        error stop 'Pinned memory not yet available'
{%- endif %}
#else
        ALLOCATE (good%space(d), stat=info)
#endif
        good%Next   => Head
        Head        => good
        tsz         = tsz + d
        if (this%verbose) write (*, '("[{{modulename}}] Created new buffer")')
    ELSE
        if (this%verbose) write (*, '("[{{modulename}}] Locked buffer", I4)') good_one_idx
    END IF
    !
    if (this%verbose) &
         write(*,'("[{{modulename}}] Currently allocated ",(es12.2)," Mbytes")') &
             REAL(tsz)/1048576 ! 1024/1024
    !
    good%locked = .true.
#if defined(__DXL_CUDAF)
{%- if attributes == 'device' %}
    cloc = c_devloc(good%space)
{%- else %}
    cloc = c_loc(good%space)
{%- endif %}
#elif defined(__DXL_OPENMP_GPU)
{%- if attributes == 'device' %}
    cloc = c_loc(good%space(1))
{%- else %}
    error stop 'Pinned memory not yet available'
{% endif %}
#else
    cloc = c_loc(good%space(1))
#endif
    !
  end subroutine lock_space
  !
  subroutine prepare_space(this, d, info)
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)     :: this     !< The class.
    integer(kind=LLI), intent(in)          :: d
    integer, intent(out)                   :: info
    !
#if defined(__DXL_CUDAF)
    type({{pointer_type}}) :: cloc
#elif defined(__DXL_OPENMP_GPU)
    type(c_ptr)    :: cloc
#endif
    integer(kind=LLI) :: r, tsz, sz
    TYPE(Node), POINTER  :: temp, good
    INTEGER :: i, good_one_idx
#if defined(__DXL_OPENMP_GPU)
    integer(c_int)                         :: omp_device !< OpenMP default device
#endif
    !
    r   = 0
    tsz = 0
    i   = 1
    !
    ! Find the smallest usable buffer
    good_one_idx = 0
    temp => Head
    NULLIFY(good)
    DO WHILE (ASSOCIATED(temp))
        sz = SIZE(TemP%space, kind=LLI)
        IF ( ( sz >= d ) .and. (TemP%locked .eqv. .false.) ) THEN
            good_one_idx = i
            info = 0
        END IF
        !
        tsz = tsz + sz
        i = i + 1
        !
        TemP => TemP%Next
    END DO
    !
    ! Allocate a new buffer if needed
    IF ( good_one_idx == 0 ) THEN
        ALLOCATE (good)
#if defined(__DXL_CUDAF)
{%- if attributes == 'device' %}
        ALLOCATE (good%space(d), stat=info)
{%- else %}
        info = cudaMallocHost(cloc, int(d))
        CALL c_f_pointer( cloc, good%space, [ d ] )
{%- endif %}
#elif defined(__DXL_OPENMP_GPU)
{%- if attributes == 'device' %}
        omp_device = omp_get_default_device()
        cloc = omp_target_alloc(d, omp_device)
        CALL c_f_pointer( cloc, good%space, [ d ] )
{%- else %}
        error stop 'Pinned memory not yet available'
{%- endif %}
#else
        ALLOCATE (good%space(d), stat=info)
#endif
        good%locked = .false.
        good%Next   => Head
        Head        => good
        tsz         = tsz + d
        if (this%verbose) write (*, '("[{{modulename}}] Created new buffer")')
    ELSE
        if (this%verbose) write (*, '("[{{modulename}}] Good buffer found: ", I4)') good_one_idx
    END IF
    !
    if (this%verbose) &
         write (*, '("[{{modulename}}] Currently allocated ",(es12.2)," Mbytes")') &
              REAL(tsz)/1048576 ! 1024/1024
    !
  end subroutine prepare_space
  !
  subroutine release_space(this, cloc, info)
#if defined(__DXL_CUDAF)
    {{cudamod}}
#endif
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)  :: this     !< The class.
#if defined(__DXL_CUDAF)
    type({{pointer_type}}), intent(in) :: cloc
#else
    type(c_ptr), intent(in) :: cloc
#endif
    integer, intent(out)            :: info    
    !
    TYPE(Node), POINTER  :: temp
#if defined(__DXL_CUDAF)
    type({{pointer_type}}) :: clocint
#else
    type(c_ptr)            :: clocint
#endif
    !
    integer :: i
    info = -1
    i = 1
    temp => head
    DO WHILE (ASSOCIATED(temp))
#if defined(__DXL_OPENMP_GPU)
{%- if attributes == 'device' %}
        clocint = c_loc(TemP%space(1))
        IF ( C_ASSOCIATED(cloc, clocint) ) THEN
            TemP%locked=.false.
            info = 0
            EXIT
        END IF
{%- else %}
        error stop 'Pinned memory not yet available'
{%- endif %}
#else
#if defined(__DXL_CUDAF)
{%- if attributes == 'device' %}
        IF ( cloc == c_devloc(TemP%space) ) THEN
{%- else %}
        clocint = c_loc(TemP%space(1))
        IF ( C_ASSOCIATED(cloc, clocint) ) THEN
{%- endif %}
#else
        clocint = c_loc(TemP%space(1))
        IF ( C_ASSOCIATED(cloc, clocint) ) THEN
#endif
            TemP%locked=.false.
            info = 0
            EXIT
        END IF
#endif
        i = i + 1
        TemP => TemP%Next
    END DO
    if (this%verbose) write (*, '("[{{modulename}}] Released buffer ", I4)') i
  end subroutine release_space
  !
{% for item in interfaces %}
  !> Get or allocate a buffer for an {{ item.vtype }} {{ item.vrankname }}.
  subroutine lock_buffer_{{ item.subname }}(this, p, {{ item.vsize }}{% if item.rank == 1%}_{% endif %}, info)
#if defined(__DXL_CUDAF)
    {{cudamod}}
#endif
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)  :: this     !< The class.
    {{ item.vtype }}, pointer, intent(out) :: p({{ item.ranks }})   !< Pointer possibly set to access buffer
    integer,       intent(in) :: {{ item.vsize }}{% if item.rank > 1%}{{ item.vsizedims }}{% else %}_{% endif %}   !< {{ item.vrankname }} dimension
    integer,       intent(out) :: info    !<  0: ok
                                          !< -1: no buffers left, allocating space
                                          !< -2: unexpected error, no memory left
                                          !< other values come form allocate stat
#if defined(__DXL_CUDAF)
{%- if (attributes) %}
    attributes({{attributes}}) :: p
{%- endif %}
#endif
    integer(kind=LLI) :: d
#if defined(__DXL_CUDAF)
    type({{pointer_type}}) :: cloc
#else
    type(c_ptr) :: cloc
#endif
    !
    {{ item.vtype }} :: dummy
    {%- if item.rank == 1%}
    integer :: {{ item.vsize }}(1)
    {{ item.vsize }}(1) = {{ item.vsize }}_
    {%- endif %}
    !
    d = PRODUCT({{ item.vsize }})
    d = d*SIZEOF(dummy)
    !
    ! Free and simple compatibility with zero dimension buffers.
    IF ( d == 0 ) d = 1
    !
    CALL this%lock_space(d, cloc, info)
    CALL c_f_pointer( cloc, p, {{ item.vsize }} )

  end subroutine lock_buffer_{{ item.subname }}
{% endfor %}
  !
{% for item in interfaces %}
  !> Release the buffer corresponding to pointer p, if associated with a buffer. Otherwise just deallocates.
  subroutine release_buffer_{{ item.subname }}(this, p, info)
#if defined(__DXL_CUDAF)
    {{cudamod}}
#endif
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)  :: this     !< The class.
    {{ item.vtype }}, pointer, intent(inout) :: p({{ item.ranks }})   !< Pointer possibly pointing to buffer space
    integer, intent(out)            :: info
#if defined(__DXL_CUDAF)
{%- if (attributes) %}
    attributes({{attributes}}) :: p
{%- endif %}
#endif

#if defined(__DXL_CUDAF)
{% if attributes == 'device' %}
    CALL this%release_space(c_devloc(p), info)
{% else %}
    CALL this%release_space(c_loc(p), info)
{% endif %}
#else
    CALL this%release_space(c_loc(p({% for i in range(item.rank) %} lbound(p, {{ i+1 }}){% if not loop.last %}, {% endif %}{% endfor %})), info)
#endif
  end subroutine release_buffer_{{ item.subname }}
{% endfor %}
  !
{% for item in interfaces %}
  !> 
  subroutine prepare_buffer_{{ item.subname }}(this, p, {{ item.vsize }}{% if item.rank == 1%}_{% endif %}, info)
#if defined(__DXL_CUDAF)
    {{cudamod}}
#endif
    use iso_c_binding
    implicit none
    class({{typename}}), intent(inout)  :: this     !< The class.
    {{ item.vtype }}, pointer, intent(out) :: p({{ item.ranks }})   !< Pointer (only used for assesing type)
    integer,       intent(in) :: {{ item.vsize }}{% if item.rank > 1%}{{ item.vsizedims }}{% else %}_{% endif %}   !< {{ item.vrankname }} dimension
    integer,       intent(out) :: info    !<  0: ok
                                          !< -1: no buffers left, allocating space
                                          !< -2: unexpected error, no memory left
                                          !< other values come form allocate stat
#if defined(__DXL_CUDAF)
{%- if (attributes) %}
    attributes({{attributes}}) :: p
{%- endif %}
#endif
    integer(kind=LLI) :: d
#if defined(__DXL_CUDAF)
    type({{pointer_type}}) :: cloc
#else
    type(c_ptr) :: cloc
#endif
    !
    {{ item.vtype }} :: dummy
    {%- if item.rank == 1%}
    integer :: {{ item.vsize }}(1)
    {{ item.vsize }}(1) = {{ item.vsize }}_
    {%- endif %}
    !
    d = PRODUCT({{ item.vsize }})
    d = d*SIZEOF(dummy)
    !
    CALL this%prepare_space(d, info)
    !
  end subroutine prepare_buffer_{{ item.subname }}
{% endfor %}

end module {{modulename}}
