!
!
!
! This module provides a fortran interface for working with the "C" fwrap<type> 
! opaque pointers.  These pointers have the fortran representation Integer(FW_POINTER).
! There is no distinguishing of type in the pointer and all of the fortran routines are very
! low level by calling the "C" functions directly so there is no type,argument or bounds checking.
! Therefore care should be used when using these methods.  See the function  array<type>  in module
! varcontainer_mod.f90 for obtaining an fwrap<type> pointer from a VarContainer.
!
! A short example
!   use varcontainer_mod
!   integer :: fvar(fw_pointer)    ! will hold fwrap<Float32> instance
!   type(cVarContainer) :: box     ! a cVarContainer instance
!   integer :: ishape(5)           ! will hold shape
!
!   call init_cvc(box)
!   call new_cvc("mybox",box,ier)  ! make a new box
!   call add0Float32(box, "myvar", 2, (/3,5/), ier)   ! add one two dimensional real*4 variable
!
!   call arrayFloat32(box,"myvar",fvar,ier)           ! get an fwrap<Float32> pointer to this variable
!   call setFloat32(fvar,2,4,3.14159)                 ! set value at myvar(2,4)
!   call shapeFloat32(fvar,ishape)                    ! get shape
!   print *, 'rank(fvar)  = ', rankFloat32(fvar)      ! print out rank
!   print *, 'shape(fvar) = ', ishape(1:2)            ! only first two elements were filled
!   print *, 'fvar[2,4]   = ', getFloat32(fvar,2,4)   ! get value at myvar(2,4)
!
! The fortran module routines are defined for each type (Int32, Float32, Float64, Logical32),
!
!   Return the rank
!     int rank<type>(fwrap)
!      fwrap = fwrap<type> opaque pointer as integer(fw_pointer)
!
!   Return the shape
!     shape<type>(fwrap, shape)
!      fwrap = fwrap<type> opaque pointer as integer(fw_pointer)
!      shape = integer array must have at least rank elements (not checked)
!
!   Index into the array and return the <type> value.  You must use the correct number of indices
!   for the rank of the function.
!     <type> get<type>(fwrap)         -> scalar
!     <type> get<type>(fwrap,i)       -> rank 1
!     <type> get<type>(fwrap,i,j)     -> rank 2
!     <type> get<type>(fwrap,i,j,k)   -> rank 3
!     <type> get<type>(fwrap,i,j,k,m) -> rank 4
!        fwrap   = fwrap<type> opaque pointer as integer(fw_pointer)
!        i,j,k,m = indices into array -- like fortran
!
!   Index into the array and set the <type> value.  You must use the correct number of indices
!   for the rank of the function.
!     set<type>(fwrap,value)         -> scalar
!     set<type>(fwrap,i,value)       -> rank 1
!     set<type>(fwrap,i,j,value)     -> rank 2
!     set<type>(fwrap,i,j,k,value)   -> rank 3
!     set<type>(fwrap,i,j,k,m,value) -> rank 4
!        fwrap   = fwrap<type> opaque pointer as integer(fw_pointer)
!        i,j,k,m = indices into array -- like fortran
!        value   = a scalar of type <type>
!
!   You can also access data from the fwrap<type> pointer through the low level "C" functions wich are callable 
!   from fortran. If these functions fail, you will crash.  There is no bounds, shape or type checking on 
!   the "get","set" methods so you should use the method with the right number of arguments for your variable.
!   The <ctype> are the "C" types ip32,fp32,fp64,lp32.  The "get","set" methods starting with "fw_" have the
!   same indexing as fortran.  There are also "get","set" methods starting with "cw_" which have the same index
!   order as fortran but start from 0 instead of 1.  The "cw_" methods avoid the subtraction of 1 from
!   each fortran index which is required when computing an array element.
!       int  fw_<ctype>rank(fwrap) -> returns the rank
!       void fw_<ctype>shape(fwrap, ishape) -> returns the shape in ishape[*]
!       <ctype> fw_<ctype>get(fwrap)        -> return the value in a rank 0 variable
!       <ctype> fw_<ctype>get(fwrap,i)      -> return the value in a rank 1 variable
!       <ctype> fw_<ctype>get(fwrap,i,j)    -> return the value in a rank 2 variable .. and so on to rank 4
!       void    fw_<ctype>set(fwrap, v)     -> set the value in a rank 0 variable
!       void    fw_<ctype>set(fwrap,i, v)   -> set the value in a rank 1 variable
!       void    fw_<ctype>set(fwrap,i,j, v) -> set the value in a rank 2 variable .. and so on to rank 4
!
!
module fwrap_mod
  integer, parameter :: FW_POINTER=2    ! length of the storage for this pointer

  ! -------------- Int32 -------------
  interface rankInt32
     function fw_ip32rank(fwrap) result(rank)
       integer :: fwrap(*)  ! opaque aip_32 pointer
       integer :: rank
     end function fw_ip32rank
  end interface

  interface shapeInt32
     subroutine fw_ip32shape(fwrap,shape)
       integer :: fwrap(*)           ! opaque aip_32 pointer
       integer :: shape(*)           ! shape
     end subroutine fw_ip32shape
  end interface

  interface getInt32
     function fw_ip32get0(fwrap) result(value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer*4 :: value         ! returned result
     end function fw_ip32get0

     function fw_ip32get1(fwrap,i) result(value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i             ! indices
       integer*4 :: value         ! returned result
     end function fw_ip32get1

     function fw_ip32get2(fwrap,i,j) result(value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j           ! indices
       integer*4 :: value         ! returned result
     end function fw_ip32get2

     function fw_ip32get3(fwrap,i,j,k) result(value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j,k         ! indices
       integer*4 :: value         ! returned result
     end function fw_ip32get3

     function fw_ip32get4(fwrap,i,j,k,m) result(value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j,k,m       ! indices
       integer*4 :: value         ! returned result
     end function fw_ip32get4
  end interface

  interface setInt32
     subroutine fw_ip32set0(fwrap,value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer*4 :: value         ! set value
     end subroutine fw_ip32set0

     subroutine fw_ip32set1(fwrap,i,value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i             ! indices
       integer*4 :: value         ! set value
     end subroutine fw_ip32set1

     subroutine fw_ip32set2(fwrap,i,j,value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j           ! indices
       integer*4 :: value         ! set value
     end subroutine fw_ip32set2

     subroutine fw_ip32set3(fwrap,i,j,k,value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j,k         ! indices
       integer*4 :: value         ! set value
     end subroutine fw_ip32set3

     subroutine fw_ip32set4(fwrap,i,j,k,m,value)
       integer   :: fwrap(*)      ! opaque aip_32 pointer
       integer   :: i,j,k,m       ! indices
       integer*4 :: value         ! set value
     end subroutine fw_ip32set4
  end interface


  ! -------------- Float32 -------------
  interface rankFloat32
     function fw_fp32rank(fwrap) result(rank)
       integer :: fwrap(*)  ! opaque afp_32 pointer
       integer :: rank
     end function fw_fp32rank
  end interface

  interface shapeFloat32
     subroutine fw_fp32shape(fwrap,shape)
       integer :: fwrap(*)           ! opaque afp_32 pointer
       integer :: shape(*)           ! shape
     end subroutine fw_fp32shape
  end interface

  interface getFloat32
     function fw_fp32get0(fwrap) result(value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       real*4 :: value         ! returned result
     end function fw_fp32get0

     function fw_fp32get1(fwrap,i) result(value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i             ! indices
       real*4 :: value         ! returned result
     end function fw_fp32get1

     function fw_fp32get2(fwrap,i,j) result(value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j           ! indices
       real*4 :: value         ! returned result
     end function fw_fp32get2

     function fw_fp32get3(fwrap,i,j,k) result(value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j,k         ! indices
       real*4 :: value         ! returned result
     end function fw_fp32get3

     function fw_fp32get4(fwrap,i,j,k,m) result(value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j,k,m       ! indices
       real*4 :: value         ! returned result
     end function fw_fp32get4
  end interface

  interface setFloat32
     subroutine fw_fp32set0(fwrap,value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       real*4 :: value         ! set value
     end subroutine fw_fp32set0

     subroutine fw_fp32set1(fwrap,i,value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i             ! indices
       real*4 :: value         ! set value
     end subroutine fw_fp32set1

     subroutine fw_fp32set2(fwrap,i,j,value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j           ! indices
       real*4 :: value         ! set value
     end subroutine fw_fp32set2

     subroutine fw_fp32set3(fwrap,i,j,k,value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j,k         ! indices
       real*4 :: value         ! set value
     end subroutine fw_fp32set3

     subroutine fw_fp32set4(fwrap,i,j,k,m,value)
       integer   :: fwrap(*)      ! opaque afp_32 pointer
       integer   :: i,j,k,m       ! indices
       real*4 :: value         ! set value
     end subroutine fw_fp32set4
  end interface


  ! -------------- Float64 -------------
  interface rankFloat64
     function fw_fp64rank(fwrap) result(rank)
       integer :: fwrap(*)  ! opaque afp_64 pointer
       integer :: rank
     end function fw_fp64rank
  end interface

  interface shapeFloat64
     subroutine fw_fp64shape(fwrap,shape)
       integer :: fwrap(*)           ! opaque afp_64 pointer
       integer :: shape(*)           ! shape
     end subroutine fw_fp64shape
  end interface

  interface getFloat64
     function fw_fp64get0(fwrap) result(value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       real*8 :: value         ! returned result
     end function fw_fp64get0

     function fw_fp64get1(fwrap,i) result(value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i             ! indices
       real*8 :: value         ! returned result
     end function fw_fp64get1

     function fw_fp64get2(fwrap,i,j) result(value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j           ! indices
       real*8 :: value         ! returned result
     end function fw_fp64get2

     function fw_fp64get3(fwrap,i,j,k) result(value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j,k         ! indices
       real*8 :: value         ! returned result
     end function fw_fp64get3

     function fw_fp64get4(fwrap,i,j,k,m) result(value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j,k,m       ! indices
       real*8 :: value         ! returned result
     end function fw_fp64get4
  end interface

  interface setFloat64
     subroutine fw_fp64set0(fwrap,value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       real*8 :: value         ! set value
     end subroutine fw_fp64set0

     subroutine fw_fp64set1(fwrap,i,value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i             ! indices
       real*8 :: value         ! set value
     end subroutine fw_fp64set1

     subroutine fw_fp64set2(fwrap,i,j,value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j           ! indices
       real*8 :: value         ! set value
     end subroutine fw_fp64set2

     subroutine fw_fp64set3(fwrap,i,j,k,value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j,k         ! indices
       real*8 :: value         ! set value
     end subroutine fw_fp64set3

     subroutine fw_fp64set4(fwrap,i,j,k,m,value)
       integer   :: fwrap(*)      ! opaque afp_64 pointer
       integer   :: i,j,k,m       ! indices
       real*8 :: value         ! set value
     end subroutine fw_fp64set4
  end interface


  ! -------------- Logical32 -------------
  interface rankLogical32
     function fw_lp32rank(fwrap) result(rank)
       integer :: fwrap(*)  ! opaque alp_32 pointer
       integer :: rank
     end function fw_lp32rank
  end interface

  interface shapeLogical32
     subroutine fw_lp32shape(fwrap,shape)
       integer :: fwrap(*)           ! opaque alp_32 pointer
       integer :: shape(*)           ! shape
     end subroutine fw_lp32shape
  end interface

  interface getLogical32
     function fw_lp32get0(fwrap) result(value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       logical*4 :: value         ! returned result
     end function fw_lp32get0

     function fw_lp32get1(fwrap,i) result(value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i             ! indices
       logical*4 :: value         ! returned result
     end function fw_lp32get1

     function fw_lp32get2(fwrap,i,j) result(value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j           ! indices
       logical*4 :: value         ! returned result
     end function fw_lp32get2

     function fw_lp32get3(fwrap,i,j,k) result(value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j,k         ! indices
       logical*4 :: value         ! returned result
     end function fw_lp32get3

     function fw_lp32get4(fwrap,i,j,k,m) result(value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j,k,m       ! indices
       logical*4 :: value         ! returned result
     end function fw_lp32get4
  end interface

  interface setLogical32
     subroutine fw_lp32set0(fwrap,value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       logical*4 :: value         ! set value
     end subroutine fw_lp32set0

     subroutine fw_lp32set1(fwrap,i,value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i             ! indices
       logical*4 :: value         ! set value
     end subroutine fw_lp32set1

     subroutine fw_lp32set2(fwrap,i,j,value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j           ! indices
       logical*4 :: value         ! set value
     end subroutine fw_lp32set2

     subroutine fw_lp32set3(fwrap,i,j,k,value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j,k         ! indices
       logical*4 :: value         ! set value
     end subroutine fw_lp32set3

     subroutine fw_lp32set4(fwrap,i,j,k,m,value)
       integer   :: fwrap(*)      ! opaque alp_32 pointer
       integer   :: i,j,k,m       ! indices
       logical*4 :: value         ! set value
     end subroutine fw_lp32set4
  end interface

  private :: fort_getchar0, fort_getchar1, fort_getchar2, fort_getchar3, fort_getchar4
  private :: fort_setchar0, fort_setchar1, fort_setchar2, fort_setchar3, fort_setchar4
  
  !
  ! use name getCharArg where the character result is in the argument list
  ! when fortran 2008 is available, add getChar for a function which returns a character result
  !
  interface getCharArg
    module procedure fort_getchar0, fort_getchar1, fort_getchar2, fort_getchar3, fort_getchar4
  end interface

  interface setChar
    module procedure fort_setchar0, fort_setchar1, fort_setchar2, fort_setchar3, fort_setchar4
  end interface

contains
  
  !
  ! ------------------ frankChar --------------
  ! rank of container Character variable ignoring the first dimension
  !
  function frankChar(fwrap) result(rank)
    interface 
      function fw_charrank(fwrap) result(rank)
        integer :: fwrap(*)  ! opaque alp_32 pointer
        integer :: rank
      end function fw_charrank
    end interface
    
    integer :: fwrap(*)  ! opaque alp_32 pointer
    integer :: rank
    
    rank = max(0,fw_charrank(fwrap)-1)
  end function frankChar

  !
  ! ------------------ flenChar --------------
  ! length of container Character variable which is considered to be the first dimension
  !
  function flenChar(fwrap) result(length)
    interface 
      function fw_charrank(fwrap) result(rank)
        integer :: fwrap(*)  ! opaque alp_32 pointer
        integer :: rank
      end function fw_charrank
    end interface
    
    integer :: fwrap(*)  ! opaque alp_32 pointer
    integer :: length
    integer :: rank
    integer :: ishape(6)          ! raw shape
    
    rank = fw_charrank(fwrap)
    if (rank==0) then
      length=1
    else
      call fw_charshape(fwrap,ishape)
      length = ishape(1)
    end if
  end function flenChar

  !
  ! ------------------ fshapeChar --------------
  ! shape of container Character variable ignoring the first dimension
  !
  subroutine fshapeChar(fwrap,shape)
    interface 
      function fw_charrank(fwrap) result(rank)
        integer :: fwrap(*)  ! opaque alp_32 pointer
        integer :: rank
      end function fw_charrank
    end interface
    
    integer :: fwrap(*)           ! opaque alp_32 pointer
    integer :: shape(*)           ! shape
    integer :: rank               ! rank including length
    integer :: ishape(6)          ! raw shape
    
    rank = fw_charrank(fwrap)
    if (rank<=1) return        ! no string shape
    
    call fw_charshape(fwrap,ishape)
    do i=2,rank
      shape(i-1)=ishape(i)
    end do
  end subroutine fshapeChar

  subroutine fort_getchar0(fwrap,value)
    integer,intent(in)            :: fwrap(*)   ! opaque acp_char pointer
    character(len=*),intent(out)  :: value      ! returned value
    call fw_charget0(fwrap, len(value), value)
  end subroutine fort_getchar0

  subroutine fort_getchar1(fwrap,i,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i          ! indices
    character(len=*),intent(out) :: value      ! returned value
    call fw_charget1(fwrap, i, len(value), value)
  end subroutine fort_getchar1

  subroutine fort_getchar2(fwrap,i,j,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j        ! indices
    character(len=*),intent(out) :: value      ! returned value
    call fw_charget2(fwrap, i, j, len(value), value)
  end subroutine fort_getchar2

  subroutine fort_getchar3(fwrap,i,j,k,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j,k      ! indices
    character(len=*),intent(out) :: value      ! returned value
    call fw_charget3(fwrap, i, j, k, len(value), value)
  end subroutine fort_getchar3

  subroutine fort_getchar4(fwrap,i,j,k,m,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j,k,m    ! indices
    character(len=*),intent(out) :: value      ! returned value
    call fw_charget4(fwrap, i, j, k, m, len(value), value)
  end subroutine fort_getchar4
  
  subroutine fort_setchar0(fwrap,value)
    integer,intent(in)            :: fwrap(*)   ! opaque acp_char pointer
    character(len=*),intent(in)   :: value      ! returned value
    call fw_charset0(fwrap, len(value), value)
  end subroutine fort_setchar0

  subroutine fort_setchar1(fwrap,i,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i          ! indices
    character(len=*),intent(in)  :: value      ! returned value
    call fw_charset1(fwrap, i, len(value), value)
  end subroutine fort_setchar1

  subroutine fort_setchar2(fwrap,i,j,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j        ! indices
    character(len=*),intent(in)  :: value      ! returned value
    call fw_charset2(fwrap, i, j, len(value), value)
  end subroutine fort_setchar2

  subroutine fort_setchar3(fwrap,i,j,k,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j,k      ! indices
    character(len=*),intent(in)  :: value      ! returned value
    call fw_charset3(fwrap, i, j, k, len(value), value)
  end subroutine fort_setchar3

  subroutine fort_setchar4(fwrap,i,j,k,m,value)
    integer,intent(in)           :: fwrap(*)   ! opaque acp_char pointer
    integer,intent(in)           :: i,j,k,m    ! indices
    character(len=*),intent(in)  :: value      ! returned value
    call fw_charset4(fwrap, i, j, k, m, len(value), value)
  end subroutine fort_setchar4
  
end module fwrap_mod
