!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 Standard compatible 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.
!  For an easyer call an interface is used, so independently from the shape or
!  data type the routines can be called with AbaqusArrayCreate, AbaqusArrayAccess
!  and AbaqusArrayDelete.
!
!=============================================================================

MODULE ABQSMA

USE iso_c_binding
USE ABQINTERFACE, ONLY: AbqRK,AbqIK

IMPLICIT NONE

PRIVATE

PUBLIC:: AbaqusArrayCreate,AbaqusArrayAccess,AbaqusArrayDelete

      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

      
      !interfaces to the subroutine versions which return FORTRAN Standard compliant Pointers
      
      INTERFACE AbaqusArrayCreate
        MODULE PROCEDURE SMAIntArrayCreateFortran1D
        MODULE PROCEDURE SMAIntArrayCreateFortran2D
        MODULE PROCEDURE SMAIntArrayCreateFortran1D_dp
        MODULE PROCEDURE SMAIntArrayCreateFortran2D_dp
        MODULE PROCEDURE SMAFloatArrayCreateFortran1D
        MODULE PROCEDURE SMAFloatArrayCreateFortran2D  
        MODULE PROCEDURE SMAFloatArrayCreateFortran3D  
        MODULE PROCEDURE SMAFloatArrayCreateFortran5D   
      END INTERFACE AbaqusArrayCreate
      
      INTERFACE AbaqusArrayAccess
        MODULE PROCEDURE SMAIntArrayAccessFortran1D
        MODULE PROCEDURE SMAIntArrayAccessFortran2D
        MODULE PROCEDURE SMAIntArrayAccessFortran1D_dp
        MODULE PROCEDURE SMAIntArrayAccessFortran2D_dp
        MODULE PROCEDURE SMAFloatArrayAccessFortran1D
        MODULE PROCEDURE SMAFloatArrayAccessFortran2D
        MODULE PROCEDURE SMAFloatArrayAccessFortran3D
        MODULE PROCEDURE SMAFloatArrayAccessFortran5D
      END INTERFACE AbaqusArrayAccess
      
      INTERFACE AbaqusArrayDelete
        MODULE PROCEDURE SMAIntArrayDeleteFortran1D
        MODULE PROCEDURE SMAIntArrayDeleteFortran2D
        MODULE PROCEDURE SMAIntArrayDeleteFortran1D_dp
        MODULE PROCEDURE SMAIntArrayDeleteFortran2D_dp
        MODULE PROCEDURE SMAFloatArrayDeleteFortran1D
        MODULE PROCEDURE SMAFloatArrayDeleteFortran2D
        MODULE PROCEDURE SMAFloatArrayDeleteFortran3D
        MODULE PROCEDURE SMAFloatArrayDeleteFortran5D
      END INTERFACE AbaqusArrayDelete

CONTAINS

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

           pt_x=SMAIntArrayCreate( ID, SIZE(1), INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAIntArrayCreateFortran1D
    
    SUBROUTINE SMAIntArrayCreateFortran2D(Array, ID, SIZE, INITVAL )
    
           INTEGER(KIND=4),POINTER:: Array(:,:)
           INTEGER,TARGET:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),DIMENSION(:),INTENT(IN) :: SIZE
           INTEGER(KIND=4),INTENT(IN) :: INITVAL

           pt_x=SMAIntArrayCreate( ID, SIZE(1)*SIZE(2), INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAIntArrayCreateFortran2D

    
    SUBROUTINE SMAIntArrayCreateFortran1D_dp(Array, ID, SIZE, INITVAL )
		
           INTEGER(KIND=8),POINTER:: Array(:)
           INTEGER,TARGET:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),DIMENSION(:),INTENT(IN) :: SIZE
           INTEGER(KIND=8),INTENT(IN) :: INITVAL

           pt_x=SMAFloatArrayCreateDP( ID, SIZE(1), REAL(INITVAL,8) )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAIntArrayCreateFortran1D_dp
    
    SUBROUTINE SMAIntArrayCreateFortran2D_dp(Array, ID, SIZE, INITVAL )

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

           pt_x=SMAFloatArrayCreateDP( ID, SIZE(1)*SIZE(2), REAL(INITVAL,8) )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAIntArrayCreateFortran2D_dp

	SUBROUTINE SMAIntArrayAccessFortran1D(Array, ID, SIZE )

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

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

           pt_x=SMAIntArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAIntArrayAccessFortran2D

    SUBROUTINE SMAIntArrayAccessFortran1D_dp(Array, ID, SIZE )

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

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

	SUBROUTINE SMAIntArrayDeleteFortran1D(Array,ID)
            
            INTEGER(KIND=4),INTENT(IN) :: ID
            INTEGER,POINTER:: Array(:)
            
            CALL SMAIntArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran1D
    
    SUBROUTINE SMAIntArrayDeleteFortran2D(Array,ID)
            
            INTEGER(KIND=4),INTENT(IN) :: ID
            INTEGER,POINTER:: Array(:,:)
            
            CALL SMAIntArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran2D
    
    SUBROUTINE SMAIntArrayDeleteFortran1D_dp(Array,ID)
    
            INTEGER(KIND=8),POINTER:: Array(:)
            INTEGER(KIND=4),INTENT(IN) :: ID
            
            CALL SMAFloatArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran1D_dp
    
    SUBROUTINE SMAIntArrayDeleteFortran2D_dp(Array,ID)
    
            INTEGER(KIND=8),POINTER:: Array(:,:)
            INTEGER(KIND=4),INTENT(IN) :: ID
            
            CALL SMAFloatArrayDelete(ID)
            
    END SUBROUTINE SMAIntArrayDeleteFortran2D_dp


	SUBROUTINE SMAFloatArrayCreateFortran1D(Array, ID, SIZE, INITVAL )

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

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

           REAL(KIND=AbqRK),POINTER:: Array(:,:)
           REAL(KIND=AbqRK),TARGET:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN),DIMENSION(:) :: 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 SMAFloatArrayCreateFortran3D(Array, ID, SIZE, INITVAL )

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

           pt_x=SMAFloatArrayCreate( ID, SIZE(1)*SIZE(2)*SIZE(3), INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAFloatArrayCreateFortran3D
    
    SUBROUTINE SMAFloatArrayCreateFortran5D(Array, ID, SIZE, INITVAL )

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

           pt_x=SMAFloatArrayCreate( ID, SIZE(1)*SIZE(2)*SIZE(3)*SIZE(4)*SIZE(5), INITVAL )
           CALL C_F_POINTER(C_LOC(x), Array,SIZE)
           
	END SUBROUTINE SMAFloatArrayCreateFortran5D

	SUBROUTINE SMAFloatArrayAccessFortran1D(Array, ID, SIZE )

           REAL(KIND=AbqRK),POINTER:: Array(:)
           REAL(KIND=AbqRK),TARGET:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),DIMENSION(:),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),TARGET:: x
           POINTER(pt_x,x)
           INTEGER(KIND=4),INTENT(IN) :: ID
           INTEGER(KIND=4),INTENT(IN),DIMENSION(:) :: SIZE

		   pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAFloatArrayAccessFortran2D
    
    SUBROUTINE SMAFloatArrayAccessFortran3D(Array, ID, SIZE )

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

		   pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAFloatArrayAccessFortran3D
    
    SUBROUTINE SMAFloatArrayAccessFortran5D(Array, ID, SIZE )

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

		   pt_x=SMAFloatArrayAccess(ID)
           CALL C_F_POINTER(C_LOC(x), Array, SIZE)
           
	END SUBROUTINE SMAFloatArrayAccessFortran5D
	
	SUBROUTINE SMAFloatArrayDeleteFortran1D(Array, ID )
    
			INTEGER(KIND=4) :: ID
			REAL(KIND=AbqRK),POINTER:: Array(:)
			CALL SMAFloatArrayDelete( ID )
			
    END SUBROUTINE SMAFloatArrayDeleteFortran1D
    
    SUBROUTINE SMAFloatArrayDeleteFortran2D(Array, ID )
    
			INTEGER(KIND=4) :: ID
			REAL(KIND=AbqRK),POINTER:: Array(:,:)
			CALL SMAFloatArrayDelete( ID )
			
    END SUBROUTINE SMAFloatArrayDeleteFortran2D
    
    SUBROUTINE SMAFloatArrayDeleteFortran3D(Array, ID )
    
			INTEGER(KIND=4) :: ID
			REAL(KIND=AbqRK),POINTER:: Array(:,:,:)
			CALL SMAFloatArrayDelete( ID )
			
    END SUBROUTINE SMAFloatArrayDeleteFortran3D
    
    SUBROUTINE SMAFloatArrayDeleteFortran5D(Array, ID )
    
			INTEGER(KIND=4) :: ID
			REAL(KIND=AbqRK),POINTER:: Array(:,:,:,:,:)
			CALL SMAFloatArrayDelete( ID )
			
    END SUBROUTINE SMAFloatArrayDeleteFortran5D

END MODULE ABQSMA
