!DEC$ FREEFORM
!=============================================================================
! Monolithic FE^2
! Nils Lange, Geralf Huetter, Bjoern Kiefer
!   Nils.Lange@imfd.tu-freiberg.de, Geralf.Huetter@imfd.tu-freiberg.de, 
!   Bjoern.Kiefer@imfd.tu-freiberg.de
! distributed under CC BY-NC-SA 4.0 license
! (https://creativecommons.org/licenses/by-nc-sa/4.0/)
! Reference: 
!   N. Lange, G. Huetter, B. Kiefer: "An efficient monolithic solution scheme for FE2 problems",
!   https://arxiv.org/abs/2101.01802
!
! Further information on the implementation, structure of the source code,
! examples and tutorials can be found in the file doc/documentation.pdf
! 
! Description: Adaption of SMA* interfaces (SMAAspUserArrays.hdr) 
!  for thread-safe allocatable arrays, which only work with Cray Pointers,
!  to a interface for Fortran pointers in a module.
!  At first a Fortran cray Pointer [Pointer(pt_x,x)] !is received via an
!  SMA Routine (for example SMAIntArrayCreate). Then the Location of this 
!  Pointer in the C format is accessed by C_LOC(x). Finally, the pointer 
!  is converted to the Fortran Format by the intrinsic subroutine C_F_POINTER.
!
!=============================================================================

MODULE ABQSMA

USE iso_c_binding
USE ABQINTERFACE

IMPLICIT NONE

      INTERFACE

         FUNCTION SMAIntArrayCreate( ID, SIZE, INITVAL )  ! -- Create an array or resize it
           INTEGER(KIND=8) :: SMAIntArrayCreate ! returns a pointer to the newly allocated array 
           INTEGER(KIND=4) :: ID        ! Arbitrary integer chosen by the user, used later to locate this array
           INTEGER(KIND=4) :: SIZE      ! max value is INT_MAX ( 2,147,483,647 ) 
           INTEGER(KIND=4) :: INITVAL   ! initial value to initialize each value in the array with
         END FUNCTION SMAIntArrayCreate   

         FUNCTION SMAIntArrayAccess(ID) ! -- Access an array 
           INTEGER(KIND=8) :: SMAIntArrayAccess  ! -- Returns an address that can be associated with a Fortran pointer
           INTEGER(KIND=4) :: ID        ! Array ID
         END FUNCTION SMAIntArrayAccess


         FUNCTION SMAIntArraySize(ID)   ! -- Return the current size of the array as the number of integers
           INTEGER(KIND=8) :: SMAIntArraySize 
           INTEGER(KIND=4) :: ID        ! Array ID
         END FUNCTION SMAIntArraySize   

         SUBROUTINE SMAIntArrayDelete(ID) ! -- Delete an array with the given ID
            INTEGER(KIND=4) :: ID         ! Array ID
         END SUBROUTINE SMAIntArrayDelete  


         FUNCTION SMAFloatArrayAccess( ID ) ! -- Get an address that can be associated with a Fortran pointer
           INTEGER(KIND=8) :: SMAFloatArrayAccess  ! -- Returns an address that can be associated with a Fortran pointer
	       INTEGER(KIND=4) :: ID       ! Array ID
         END FUNCTION SMAFloatArrayAccess 

         FUNCTION SMAFloatArraySize( ID )  ! -- Return the current size of the array as the number of floats
           INTEGER(KIND=8) :: SMAFloatArraySize 
           INTEGER(KIND=4) :: ID        ! Array ID
         END FUNCTION SMAFloatArraySize

         SUBROUTINE SMAFloatArrayDelete( ID ) 
            INTEGER(KIND=4) :: ID       ! Array ID
         END SUBROUTINE SMAFloatArrayDelete 


      END INTERFACE

      INTERFACE SMAFloatArrayCreate

         INTEGER*8 FUNCTION SMAFloatArrayCreateSP( ID, SIZE, INITVAL ) ! returns a pointer to the newly allocated array
           INTEGER(KIND=4),INTENT(IN) :: ID         ! Arbitrary integer chosen by the user, used later to locate this array
           INTEGER(KIND=4),INTENT(IN) :: SIZE       ! max value is INT_MAX ( 2,147,483,647 ) 
           REAL(KIND=4),   INTENT(IN) :: INITVAL    ! initial value for each element of the array (SINGLE PRECISION)
         END FUNCTION SMAFloatArrayCreateSP 


         INTEGER*8 FUNCTION SMAFloatArrayCreateDP( ID, SIZE, INITVAL ) ! returns a pointer to the newly allocated array
           INTEGER(KIND=4),INTENT(IN) :: ID         ! Arbitrary integer chosen by the user, used later to locate this array
           INTEGER(KIND=4),INTENT(IN) :: SIZE       ! max value is INT_MAX ( 2,147,483,647 ) 
           REAL(KIND=8),   INTENT(IN) :: INITVAL    ! initial value for each element of the array (DOUBLE PRECISION)
         END FUNCTION SMAFloatArrayCreateDP 

      END INTERFACE SMAFloatArrayCreate

CONTAINS


	SUBROUTINE SMAIntArrayCreateFortran(Array, ID, SIZE, INITVAL )
		
           INTEGER,POINTER:: Array(:)
           INTEGER:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE
           INTEGER(KIND=4),INTENT(IN) :: INITVAL

           pt_x=SMAIntArrayCreate( ID, SIZE, INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAIntArrayCreateFortran
    
    SUBROUTINE SMAIntArrayCreateFortran_dp(Array, ID, SIZE, INITVAL )
		
           INTEGER(KIND=8),POINTER:: Array(:)
           INTEGER:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE
           INTEGER(KIND=8),INTENT(IN) :: INITVAL

           pt_x=SMAFloatArrayCreateDP( ID, SIZE, REAL(INITVAL,8) )
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAIntArrayCreateFortran_dp
	
	
	SUBROUTINE SMAIntArrayAccessFortran1D(Array, ID, SIZE )

           INTEGER,POINTER:: Array(:)
           INTEGER:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE
           
           pt_x=SMAIntArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAIntArrayAccessFortran1D
    
    SUBROUTINE SMAIntArrayAccessFortran1D_dp(Array, ID, SIZE )

           INTEGER(KIND=8),POINTER:: Array(:)
           INTEGER:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE
           
           pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAIntArrayAccessFortran1D_dp

	
	
	SUBROUTINE SMAIntArrayAccessFortran2D(Array, ID, SIZE )

           INTEGER,POINTER:: Array(:,:)
           INTEGER:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),DIMENSION(2),INTENT(IN) :: SIZE

           pt_x=SMAIntArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAIntArrayAccessFortran2D
	
	
	SUBROUTINE SMAIntArrayDeleteFortran(ID)
            INTEGER(KIND=4),INTENT(IN) :: ID
            
            CALL SMAIntArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran
    
    SUBROUTINE SMAIntArrayDeleteFortran_dp(ID)
            INTEGER(KIND=4),INTENT(IN) :: ID
            
            CALL SMAFloatArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran_dp  

	
	
	SUBROUTINE SMAFloatArrayCreateFortran(Array, ID, SIZE, INITVAL )

           REAL(KIND=AbqRK),POINTER:: Array(:)
           REAL(KIND=AbqRK):: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE
           REAL(KIND=AbqRK),INTENT(IN) :: INITVAL

           pt_x=SMAFloatArrayCreate( ID, SIZE, INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAFloatArrayCreateFortran
    
    
    SUBROUTINE SMAFloatArrayCreateFortran2D(Array, ID, SIZE, INITVAL )

           REAL(KIND=AbqRK),POINTER:: Array(:,:)
           REAL(KIND=AbqRK):: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN),DIMENSION(2) :: SIZE
           REAL(KIND=AbqRK),INTENT(IN) :: INITVAL

           pt_x=SMAFloatArrayCreate( ID, SIZE(1)*SIZE(2), INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAFloatArrayCreateFortran2D
	
	
	SUBROUTINE SMAFloatArrayAccessFortran1D(Array, ID, SIZE )

           REAL(KIND=AbqRK),POINTER:: Array(:)
           REAL(KIND=AbqRK):: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN) :: SIZE

           pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array,(/SIZE/))
           
	END SUBROUTINE SMAFloatArrayAccessFortran1D


	SUBROUTINE SMAFloatArrayAccessFortran2D(Array, ID, SIZE )

           REAL(KIND=AbqRK),POINTER:: Array(:,:)
           REAL(KIND=AbqRK):: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN),DIMENSION(2) :: SIZE

		   pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAFloatArrayAccessFortran2D
	
	
	SUBROUTINE SMAFloatArrayDeleteFortran( ID ) 
			INTEGER(KIND=4) :: ID
			
			CALL SMAFloatArrayDelete( ID )
			
    END SUBROUTINE SMAFloatArrayDeleteFortran 


END MODULE ABQSMA
