!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 FE² problems",
!   DOI: https://doi.org/10.1016/j.cma.2021.113886
!   N. Lange, G. Huetter, B. Kiefer: "A monolithic hyper ROM FE² method with
!                                     clustered training at finite deformations"
!   DOI: https://doi.org/10.1016/j.cma.2023.116522
!
! Further information on the implementation, structure of the source code,
! examples and tutorials can be found in the file doc/documentation.pdf
! 
!=============================================================================

MODULE type_meshparameters
    !this modul declares an object named meshparameters, which bundels all
    !information that defines the microscopic mesh; it has the methods
    !read_data, get_pointer and deallocate_data

    USE ABQinterface
    USE type_analysisparameters
    
    PRIVATE::To_upper
    PUBLIC
    
    TYPE element
        
        !JTYPE=UEL formulation specific number, NDOFEL=number of dof of an element,
        !NNODE=number of nodes per element,NPROPS=number of real properties,
        !NJPROP=number of integer properties,NSVARS=number of element state variables
        !NELEM=total number of elements in the definition
        INTEGER,POINTER:: JTYPE,NNODE,NDOFEL,NPROPS,NJPROP,NSVARS,NELEM
        !unique element identification number (so that the UEL can access data 
        !through Abaqus allocatable array via this ID)
        INTEGER(KIND=4),DIMENSION(:),POINTER:: JELEM
        !real properties of the element (usually material properties, user defined)
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: PROPS
        !gives for every element dof [node nbr,node dof]
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: element_dof
        !gives the connection between global and local node for all elements in the type
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: element_to_node
        !gives the connection between global and local dof
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: element_dof_to_global_dof
        !integer properties of the element
        INTEGER(KIND=4),DIMENSION(:),POINTER:: JPROPS
        !gives the connection between the position of the local and global SVARS
        INTEGER(KIND=4),DIMENSION(:),POINTER:: local_to_global_SVARS
        ![entry in element rhs,which global rhs (1=residual,2=reaction), 
        !entry in global rhs] -> always 3 rows
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: rhs_to_global
        !multiplication factors
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: rhs_to_global_factor
        !elem_rhs_to_global_column(i) is the first column where to start with
        !sorting in local rhs to global elem_rhs_to_global_column(i-1) is the
        !last one. This array has nElem+1 entries
        INTEGER(KIND=4),DIMENSION(:),POINTER:: rhs_to_global_column
        ![entry in element AMATRX (i,j),which global matrix of derivatives
        !((1,1)=d_residual_d_local_dofs,(2,1)=d_residual_d_global_dofs,
        !(2,1)=d_reactions_d_local_dofs,(2,2)=d_reactions_d_global dofs),entry in
        !global system matrix (m,n)] ->always 6 rows
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: AMATRX_to_global
        !multiplication factors
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: AMATRX_to_global_factor
        !elem_AMATRX_to_global_column(i) is the first column where to start with
        !sorting in local AMATRX to global matrices
        !elem_AMATRX_to_global_column(i+1)-1 is the last one. This array has
        !nElem+1 entries
        INTEGER(KIND=4),DIMENSION(:),POINTER:: AMATRX_to_global_column
        !multiplication factor usually ==1.0, but in hyperintegration different
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: multiplication_factor
        !ROM Modes and equations of one Element, to enable more efficient 
        !multiplications when assembling the ROM stiffness and rhs
        REAL(KIND=AbqRK),DIMENSION(:,:,:),POINTER:: ROM_modes, Equations
        !==1 if any nodal dof is constraint, ==0 if not
        INTEGER(KIND=4),DIMENSION(:),POINTER:: constraint_element_dof
        !some only temporary matrices needed to be handed into the element
        REAL(KIND=AbqRK),DIMENSION(:,:),ALLOCATABLE::RHS,AMATRX,DU,COORDS,&
                                                     temp_matrix1,temp_matrix2
        REAL(KIND=AbqRK),DIMENSION(:),ALLOCATABLE::SVARS,U,V,A
        
    END TYPE element
    
    TYPE meshparameters
    
        INTEGER:: rve_number !rve label
        !-----------------------mesh parameters--------------------------------
        INTEGER,POINTER:: dimens,nNodes,nNonZero_reduced,nRows_reduced,&
                          ndof_n_max,nEquations,n_ROM_modes,n_active_elements,&
                          nElem_types,n_Reaction_force_dof,n_additional_dof,&
                          n_additional_hyper_outputs,NSVARS_total,&
                          n_Element_reals,n_Element_ints
        !Equation_n_members contains the number of members of each equation
        ![1,n_1+1,n_1+n2+1,...,n_1+n2+...+nN+1] -> Size is nEquations+1
        INTEGER(KIND=4),DIMENSION(:),POINTER:: Equation_n_members
        INTEGER(KIND=4):: ID_Equation_n_members=1
        !Equation's for enforcing the constraints 0=A*X_a+B*X_b+C*X_c...
        !Equation_factors contains all multipliers [A,B,C,....] -> Size is
        !Equation_n_members(nEquations+1)-1
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: Equation_factors
        INTEGER(KIND=4):: ID_Equation_factors=2
        !Equation_members contains the members [X_a,X_b,X_c,...] -> Size is
        !Equation_n_members(nEquations+1)-1
        INTEGER(KIND=4),DIMENSION(:),POINTER:: Equation_members
        INTEGER(KIND=4):: ID_Equation_members=3
        !CSR definition array for reduced FE sysstemmatrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: rowIndex_reduced
        INTEGER(KIND=4):: ID_rowIndex_reduced=4
        !CSR definition array for reduced FE sysstemmatrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: columnIndex_reduced
        INTEGER(KIND=4):: ID_columnIndex_reduced=5
        !coordinates of the Mesh
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: Coordinates_global
        INTEGER(KIND=4):: ID_Coordinates_global=6
        !volume of the RVE (including holes, pores etc.)
        REAL(KIND=AbqRK),POINTER:: RVE_Volume
        INTEGER(KIND=4):: ID_RVE_Volume=7
        !permutation matrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: perm
        INTEGER(KIND=4):: ID_perm=8
        !array containing the modes for the reduced order modeling
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: ROM_modes
        INTEGER(KIND=4):: ID_ROM_modes=9
        !ID of scalar array (array containing scalars)
        INTEGER(KIND=4):: ID_scalars=10
        !array containing the elements real parameters
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: Element_Reals
        INTEGER(KIND=4):: ID_Element_Reals=11
        !Integer Properties needed to define the elements
        INTEGER(KIND=4),DIMENSION(:),POINTER:: Element_Ints
        INTEGER(KIND=4):: ID_Element_Ints=12
        !element type as defined above
        TYPE(element),DIMENSION(:),ALLOCATABLE:: Elements
        !gives connection to all elements that are active [element type,label]
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: active_elements
        INTEGER(KIND=4):: ID_active_elements=13
        !connection reduced dof <-> global dof label [label,node dof]
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: reduced_dof_to_global_dof
        INTEGER(KIND=4):: ID_reduced_dof_to_global_dof=14
        !array which contains the (unreduced) dof lables at which the
        !macro measure is put into the global micro solution array at the UMAT call
        INTEGER(KIND=4),DIMENSION(:),POINTER:: macro_measure_to_micro_DOF
        INTEGER(KIND=4):: ID_macro_measure_to_micro_DOF=15
        !reference volume of the elements needed only in the training process
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: ref_Volume_elements
        INTEGER(KIND=4):: ID_ref_Volume_elements=16
        !total number of arrays +1
        INTEGER(KIND=4):: ID_total=17
        
        CONTAINS
        
            PROCEDURE:: read_data => read_data_procedure
            PROCEDURE:: get_pointer => get_pointer_procedure
            PROCEDURE:: deallocate_data => deallocate_data_procedure

    END TYPE meshparameters
    
    PRIVATE:: read_data_procedure,get_pointer_procedure,deallocate_data_procedure
    
CONTAINS

SUBROUTINE read_data_procedure(para,analysis)
    
    IMPLICIT NONE
    
    !Declares an Equation object, where the members are the (unreduced)
    !degrees of freedom and the factors correspond to a linear equation by:
    ! 0 = member(1)*factor(1) + member(1)*factor(1) + ... + member(n)*factor(n)
    
    TYPE Equation
        INTEGER(KIND=4),DIMENSION(:),ALLOCATABLE:: member
        REAL(KIND=AbqRK),DIMENSION(:),ALLOCATABLE:: factor
    END TYPE Equation
    
    CLASS(meshparameters)::para
    TYPE(analysisparameters)::analysis
    !dummy arrays
    INTEGER(KIND=4), DIMENSION(:),POINTER:: array_int
    INTEGER(KIND=4):: io_error,error
    REAL(KIND=AbqRK),DIMENSION(:),ALLOCATABLE::temp_real
    REAL(KIND=AbqRK),DIMENSION(1),TARGET::dummy_factor
    REAL(KIND=AbqRK),DIMENSION(:),POINTER::pointer_factor_i,pointer_factor_j
    INTEGER(KIND=4), DIMENSION(:),ALLOCATABLE:: node_dof_to_reduced_dof,micro_macro
    INTEGER(KIND=4), DIMENSION(:),POINTER:: int_pointer1
    INTEGER(KIND=4), DIMENSION(:,:),POINTER:: int_pointer2
    REAL(KIND=AbqRK), DIMENSION(:),POINTER:: real_pointer1
    REAL(KIND=AbqRK), DIMENSION(:,:,:),POINTER:: real_pointer3
    INTEGER, DIMENSION(:),ALLOCATABLE,TARGET::  dummy_target
    INTEGER(KIND=4),DIMENSION(:,:),ALLOCATABLE::Reaction_force_dof,Additional_dof,coupling_temp
    INTEGER(KIND=4),DIMENSION(:),ALLOCATABLE::dummy_active_elements
    INTEGER(KIND=4),DIMENSION(:),POINTER::pointer_i,pointer_j
    LOGICAL,DIMENSION(:,:),ALLOCATABLE::coupling,sparsity_structure
    TYPE(Equation),DIMENSION(:),ALLOCATABLE,TARGET:: Equations
    !Name of directory in which Abaqus is stared
    CHARACTER*256  OUTDIR
    !lenght of name of this directory
    INTEGER:: LENOUTDIR
    !name of the current abaqus JOB
    CHARACTER*256 JOBNAME
    !lenght of that name
    INTEGER:: LENJOBNAME
    !Label of the RVE
    CHARACTER(LEN=1000):: rve_number_str
    !integer with information-> RVE definition existing
    INTEGER:: active_RVE_definitions
    !RVE information
    CHARACTER(LEN=100):: description
    CHARACTER(LEN=1):: line_test
    INTEGER:: e,k,l,i,j,o,p,n,n1,n2,i1,i2,j1,j2,unit_numer,n_terms
    CHARACTER(LEN=500),DIMENSION(2):: line
    CHARACTER(LEN=100),DIMENSION(100):: Keywords
    CHARACTER(LEN=40),DIMENSION(9),PARAMETER:: NecessaryKeywords=['*PART','*REACTION_FORCE_DOF','*COUPLING','*USER_ELEMENTS',&
                                                                '*NODE','*EQUATIONS','*ELEMENT_TO_NODE','*RVE_VOLUME','*END_OF_FILE']
    CHARACTER(LEN=40),DIMENSION(1),PARAMETER:: NecessaryKeywords_ROM=['*ROM_MODES']
    CHARACTER(LEN=40),DIMENSION(1),PARAMETER:: NecessaryKeywords_hyperreduction=['*ACTIVE_ELEMENTS']
    CHARACTER(LEN=40),DIMENSION(8),PARAMETER:: NecessaryKeywords_elements=['*ELEMENT','*ELEMENT_DOF','*END_OF_ELEMENT','*NSVARS','*PROPS','*NNODE',&
                                                                           '*N_ADDITIONAL_HYPER_OUTPUTS','*JPROPS']
    CHARACTER(LEN=100),DIMENSION(SIZE(NecessaryKeywords_elements)):: Keywords_element
    
    
    !-----------get string of RVE number through internal read------------
    WRITE(rve_number_str,*) para%rve_number
    
    !---------------get the current directory name------------------------
    
    CALL GETOUTDIR( OUTDIR, LENOUTDIR )!get directory name and length
    CALL GETJOBNAME( JOBNAME, LENJOBNAME ) !get job name and and length
    
    !----------------read data from file micromesh.FE---------------------
    
    !---------------open file with mesh information-----------------------
    unit_numer=101
    OPEN(unit=unit_numer,file=OUTDIR(1:LENOUTDIR)//'/'//JOBNAME(1:LENJOBNAME)//'.FE'//&
    TRIM(ADJUSTL(rve_number_str)),status='old',action='read',iostat = io_error)
    
    IF (io_error==0) THEN
    
        !integer mesh parameters
        CALL AbaqusArrayCreate(array_int,-para%ID_total*para%rve_number+para%ID_scalars,[15],0)
        !set the pointers to the integer array
        para%dimens                     => array_int(1)
        para%nNodes                     => array_int(2)
        para%nNonZero_reduced           => array_int(3)
        para%nRows_reduced              => array_int(4)
        para%ndof_n_max                 => array_int(5)
        para%nEquations                 => array_int(6)
        para%n_ROM_modes                => array_int(7)
        para%n_active_elements          => array_int(8)
        para%nElem_types                => array_int(9)
        para%n_Reaction_force_dof       => array_int(10)
        para%n_additional_dof           => array_int(11)
        para%n_additional_hyper_outputs => array_int(12)
        para%NSVARS_total               => array_int(13)
        para%n_Element_reals            => array_int(14)
        para%n_Element_ints             => array_int(15)

        Keywords=''
        k=1 !running index
        error=0
        
        ReadInputile: DO WHILE (.TRUE.) !do until the end of file is reached
            
            IF (error/=0) EXIT ReadInputile
            
            READ(unit_numer,*,iostat=error) line
            
            CALL To_upper(line(1)) !convert to upper cases
            
            IF (line(1)(1:1)=='*' .AND. line(1)(2:2)/='*') THEN !Keyword detected
            
                Keywords(k)=TRIM(line(1))
                
                IF (ANY(Keywords(1:k-1)==Keywords(k))) THEN
                    CLOSE (unit=unit_numer) !close file
                    CALL STDB_ABQERR(-3_AbqIK,  'Error: Keyword %S appeared twice in the Inputfile %S',&
                                        0_AbqIK,0.0_AbqRK,[Keywords(k),OUTDIR(1:LENOUTDIR)//'/'//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                        TRIM(ADJUSTL(rve_number_str))])
                END IF
                
                SELECT CASE(Keywords(k)) !select the current statement
                CASE('*PART') !output information about the RVE
                    CALL STDB_ABQERR(1_AbqIK,  'RVE-Nr. %I : '//line(2),[para%rve_number], 0.0_AbqRK, ' ')
                CASE('*REACTION_FORCE_DOF') !macroscopic dofs which reaction response shall be output incl. derivative
                    READ(line(2)(3:),*) para%n_Reaction_force_dof !number of dofs
                    ALLOCATE(Reaction_force_dof(2,para%n_Reaction_force_dof)) 
                    READ(unit_numer,*,iostat=error) Reaction_force_dof
                    IF (error/=0) EXIT ReadInputile
                CASE('*ADDITIONAL_DOF') !additional macroscopic dofs whose reaction response is not of interest
                    READ(line(2)(3:),*) para%n_additional_dof
                    ALLOCATE(Additional_dof(2,para%n_additional_dof))
                    READ(unit_numer,*,iostat=error) Additional_dof
                    IF (error/=0) EXIT ReadInputile
                CASE('*COUPLING') !specifiy if between node_dof_i and between node_dof_j a coupling has to be respected in
                                    !the system of equations
                    READ(line(2)(6:),*) para%ndof_n_max !maximum number of dof a node can have (must not be active at every node!)
                    ALLOCATE(coupling(para%ndof_n_max,para%ndof_n_max),coupling_temp(para%ndof_n_max,para%ndof_n_max));
                    READ(unit_numer,*,iostat=error) coupling_temp
                    IF (error/=0) EXIT ReadInputile
                    coupling=TRANSPOSE(coupling_temp)
                CASE('*USER_ELEMENTS') !now a number of nElem_types element type definitions follow
                    READ(line(2)(3:),*) para%nElem_types
                    IF (para%nElem_types<1) THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. Number of Element types'//&
                                'must be greater equal 1.',0_AbqIK, 0.0_AbqRK,' ')
                    END IF
                    ALLOCATE(para%Elements(para%nElem_types))
                    DO i=1,para%nElem_types
                        Keywords_element=''
                        n=1
                        READ(unit_numer,*,iostat=error) line
                        IF (error/=0) EXIT ReadInputile
                        CALL To_upper(line(1)) !convert to upper cases
                        IF (line(1)(1:8)/='*ELEMENT') THEN
                            CLOSE (unit=unit_numer) !close file
                            CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element type %I '//&
                                'first Keyword was not *ELEMENT.',[i], 0.0_AbqRK,' ')
                        ELSE
                            Keywords_element(n)='*ELEMENT'
                            READ(line(1)(9:),*) i1
                            IF (i1>para%nElem_types) THEN
                                CLOSE (unit=unit_numer) !close file
                                CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. An Element type got label %I '//&
                                'but only %I slots are requested.',[i1,para%nElem_types], 0.0_AbqRK,' ')
                            END IF
                            IF (ASSOCIATED(para%Elements(i1)%JTYPE)) THEN
                                CLOSE (unit=unit_numer) !close file
                                CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. An Element type got label %I '//&
                                'and element type with this label was already defined.',[i1,para%nElem_types], 0.0_AbqRK,' ')
                            END IF
                            ALLOCATE(para%Elements(i1)%JTYPE,para%Elements(i1)%NNODE,para%Elements(i1)%NDOFEL,&
                                     para%Elements(i1)%NPROPS,para%Elements(i1)%NJPROP,para%Elements(i1)%NSVARS,&
                                     para%Elements(i1)%NELEM)
                            para%Elements(i1)%element_to_node=>NULL()
                            READ(line(2)(6:),*) para%Elements(i1)%JTYPE
                        END IF
                        read_Element_type: DO WHILE (.TRUE.)
                            READ(unit_numer,*,iostat=error) line
                            IF (error/=0) EXIT ReadInputile
                            CALL To_upper(line(1)) !convert to upper cases
                            n=n+1
                            IF (n>SIZE(NecessaryKeywords_elements)) THEN
                                CLOSE (unit=unit_numer) !close file
                                CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element type %I '//&
                                'more Keywords than allowed were specified.',[i1], 0.0_AbqRK,' ')
                            END IF
                            Keywords_element(n)=TRIM(line(1))
                            SELECT CASE(Keywords_element(n))
                            CASE('*ELEMENT_DOF')
                                READ(line(2)(3:),*) para%Elements(i1)%NDOFEL
                                ALLOCATE(para%Elements(i1)%element_dof(2,para%Elements(i1)%NDOFEL))
                                READ(unit_numer,*,iostat=error) para%Elements(i1)%element_dof
                                IF (error/=0) EXIT ReadInputile
                            CASE('*NNODE')
                                READ(line(2)(3:),*) para%Elements(i1)%NNODE
                            CASE('*NSVARS')
                                READ(line(2)(3:),*) para%Elements(i1)%NSVARS
                            CASE('*PROPS')
                                READ(line(2)(3:),*) para%Elements(i1)%NPROPS
                                ALLOCATE(para%Elements(i1)%PROPS(para%Elements(i1)%NPROPS))
                                IF (para%Elements(i1)%NPROPS>0) THEN
                                    READ(unit_numer,*,iostat=error) para%Elements(i1)%PROPS
                                    IF (error/=0) EXIT ReadInputile
                                END IF
                            CASE('*JPROPS')
                                READ(line(2)(3:),*) para%Elements(i1)%NJPROP
                                ALLOCATE(para%Elements(i1)%JPROPS(para%Elements(i1)%NJPROP))
                                IF (para%Elements(i1)%NJPROP>0) THEN
                                    READ(unit_numer,*,iostat=error) para%Elements(i1)%JPROPS
                                    IF (error/=0) EXIT ReadInputile
                                END IF
                            CASE('*N_ADDITIONAL_HYPER_OUTPUTS')
                                READ(line(2)(3:),*) o
                                IF (para%n_additional_hyper_outputs==0) THEN
                                    para%n_additional_hyper_outputs=o
                                ELSE IF (para%n_additional_hyper_outputs/=o) THEN
                                    CLOSE (unit=unit_numer) !close file
                                    CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                    TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. All element types'//&
                                    'shall produce the same number of additional hyper outputs.',0_AbqIK, 0.0_AbqRK,' ')
                                END IF
                            CASE('*END_OF_ELEMENT')
                                BACKSPACE(unit_numer)
                                EXIT read_Element_type
                            CASE DEFAULT
                                CLOSE (unit=unit_numer) !close file
                                CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element type %I '//&
                                'unknown Keywords %S was found.',[i1], 0.0_AbqRK,[Keywords_element(n)])
                            END SELECT
                            !add the additional hyper outputs to the number of state variables in the case of training
                            IF (analysis%training .AND. analysis%ROM_projection) THEN
                                para%Elements(i1)%NSVARS=para%Elements(i1)%NSVARS+para%n_additional_hyper_outputs+1
                            END IF
                        END DO read_Element_type
                        DO j=1,SIZE(NecessaryKeywords_elements)
                            IF (NOT(ANY(Keywords_element==NecessaryKeywords_elements(j)))) THEN
                                CLOSE (unit=unit_numer) !close file
                                CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element type %I '//&
                                'the Keyword %S was not specified.',[i1], 0.0_AbqRK,[NecessaryKeywords_elements(j)])
                            END IF
                        END DO
                    END DO
                    READ(unit_numer,*,iostat=error) line(1)
                    CALL To_upper(line(1)) !convert to upper cases
                    IF (line(1)(1:21)/='*END_OF_USER_ELEMENTS') THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The User Element definitions were not'//&
                            'ended by an END_OF_USER_ELEMENTS statement.',[i], 0.0_AbqRK,' ')
                    END IF
                CASE('*NODE')
                    READ(line(2)(8:),*) para%dimens !get dimension 2=2D 3=3D
                    para%nNodes=0 !at first count the number of nodes
                    DO WHILE(.TRUE.)
                        READ(unit_numer,*,iostat=error) line_test
                        IF (line_test/='*') THEN
                            para%nNodes=para%nNodes+1
                        ELSE
                            EXIT
                        END IF
                    END DO
                    DO i=1,para%nNodes+1 !go back to the first line with coordinates
                        BACKSPACE(unit_numer)
                    END DO
                    READ(unit_numer,*,iostat=error) line_test
                        BACKSPACE(unit_numer)
                    CALL AbaqusArrayCreate(para%Coordinates_global,-para%ID_total*para%rve_number+para%ID_Coordinates_global,[para%dimens,para%nNodes],0.0_AbqRK)
                    READ(unit_numer,*,iostat=error) para%Coordinates_global !finally read the coordinates
                    IF (error/=0) EXIT ReadInputile
                CASE('*ELEMENT_TO_NODE')
                    READ(line(2)(3:),*) n
                    IF (n/=para%nElem_types) THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The number of Element types'//&
                                ' and actual element to node assignments is not equal.',0_AbqIK, 0.0_AbqRK,' ')
                    END IF
                    IF (NOT(ANY(Keywords(1:k)=='*USER_ELEMENTS'))) THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The user Elements must be'//&
                                'be defined before the element to node assignments.',0_AbqIK, 0.0_AbqRK,' ')
                    END IF
                    DO i=1,para%nElem_types
                        READ(unit_numer,*,iostat=error) line
                        IF (error/=0) EXIT ReadInputile
                        CALL To_upper(line(1)) !convert to upper cases
                        IF (line(1)(1:28)/='*ELEMENT_TO_NODE_ASSIGNMENTS') THEN
                            CLOSE (unit=unit_numer) !close file
                            CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element assignment %I'//&
                                'the first Keyword was not *ELEMENT_TO_NODE_ASSIGNMENTS.',[i], 0.0_AbqRK,' ')
                        END IF
                        READ(line(1)(29:),*) i1
                        IF (i1>para%nElem_types) THEN
                            CLOSE (unit=unit_numer) !close file
                            CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. There is an Element assignment %I '//&
                            'but only %I slots are requested.',[i1,para%nElem_types], 0.0_AbqRK,' ')
                        ELSE IF (ASSOCIATED(para%Elements(i1)%element_to_node)) THEN
                            CLOSE (unit=unit_numer) !close file
                            CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. There is an Element assignment %I '//&
                            'that was already defined.',[i1], 0.0_AbqRK,' ')
                        END IF
                        READ(line(2)(3:),*) para%Elements(i1)%NELEM
                        ALLOCATE(para%Elements(i1)%element_to_node(para%Elements(i1)%NNODE,para%Elements(i1)%NELEM))
                        READ(unit_numer,*,iostat=error) para%Elements(i1)%element_to_node !finally read the element to node connection
                        IF (error/=0) EXIT ReadInputile
                        READ(unit_numer,*,iostat=error) line(1)
                        IF (error/=0) EXIT ReadInputile
                        CALL To_upper(line(1)) !convert to upper cases
                        IF (line(1)(1:35)/='*END_OF_ELEMENT_TO_NODE_ASSIGNMENTS') THEN
                            CLOSE (unit=unit_numer) !close file
                            CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. In Element assignment %I'//&
                                'the last Keyword was not *END_OF_ELEMENT_TO_NODE_ASSIGNMENTS.',[i], 0.0_AbqRK,' ')
                        END IF
                        !unique element ID number
                        ALLOCATE(para%Elements(i1)%JELEM(para%Elements(i1)%NELEM))
                    END DO
                    READ(unit_numer,*,iostat=error) line(1)
                    CALL To_upper(line(1)) !convert to upper cases
                    IF (line(1)(1:23)/='*END_OF_ELEMENT_TO_NODE') THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The Element assignments were not'//&
                            ' ended by an END_OF_ELEMENT_TO_NODE statement.',[i], 0.0_AbqRK,' ')
                    END IF
                CASE('*EQUATIONS')
                    READ(line(2)(3:),*) para%nEquations !read number of equations
                    CALL AbaqusArrayCreate(para%Equation_n_members,-para%ID_total*para%rve_number+para%ID_Equation_n_members,[para%nEquations+1],0)
                    para%Equation_n_members(1)=1
                    ALLOCATE(Equations(para%nEquations))
                    DO i=1,para%nEquations !get the equation factors and members
                        READ(unit_numer,*,iostat=error) line
                        IF (error/=0) EXIT ReadInputile
                        CALL To_upper(line(1)) !convert to upper cases
                        IF (line(1)(1:9)/='*EQUATION') THEN
                            error=1
                            IF (error/=0) EXIT ReadInputile
                        END IF
                        READ(line(2)(3:),*) n_terms
                        para%Equation_n_members(i+1)=para%Equation_n_members(i)+n_terms
                        ALLOCATE(Equations(i)%member(n_terms)); ALLOCATE(Equations(i)%factor(n_terms)); ALLOCATE(temp_real(n_terms*3))
                        READ(unit_numer,*,iostat=error) temp_real
                        IF (error/=0) EXIT ReadInputile
                        DO n=1,n_terms
                            Equations(i)%member(n)=(int(temp_real(3*(n-1)+1))-1)*para%ndof_n_max+int(temp_real(3*(n-1)+2))
                            Equations(i)%factor(n)=temp_real(3*n)
                        END DO
                        Equations(i)%factor=Equations(i)%factor*(-1.0_AbqRK/Equations(i)%factor(1))
                        DEALLOCATE(temp_real)
                    END DO
                    CALL AbaqusArrayCreate(para%Equation_factors,-para%ID_total*para%rve_number+para%ID_Equation_factors,[para%Equation_n_members(para%nEquations+1)-1],0.0_AbqRK)
                    CALL AbaqusArrayCreate(para%Equation_members,-para%ID_total*para%rve_number+para%ID_Equation_members,[para%Equation_n_members(para%nEquations+1)-1],0)
                    DO i=1,para%nEquations
                        para%Equation_factors(para%Equation_n_members(i):para%Equation_n_members(i+1)-1)=Equations(i)%factor
                        para%Equation_members(para%Equation_n_members(i):para%Equation_n_members(i+1)-1)=Equations(i)%member
                    END DO
                    READ(unit_numer,*,iostat=error) line(1)
                    CALL To_upper(line(1)) !convert to upper cases
                    IF (line(1)(1:17)/='*END_OF_EQUATIONS') THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The Equation definitions were not'//&
                            'ended by an END_OF_EQUATIONS statement.',[i], 0.0_AbqRK,' ')
                    END IF
                CASE('*RVE_VOLUME')
                    CALL AbaqusArrayCreate(real_pointer1,-para%ID_total*para%rve_number+para%ID_RVE_Volume,[1],0.0_AbqRK)
                    para%RVE_Volume=>real_pointer1(1)
                    READ(line(2)(3:),*) para%RVE_Volume
                CASE('*ROM_MODES')
                    IF (analysis%ROM_projection) THEN !only when being in ROM mode
                        READ(line(2)(3:),*) para%nRows_reduced !number of unknowns in the reduced system of equations == number rows in the reduced basis
                        para%n_ROM_modes=0
                        DO WHILE(.TRUE.) !get the number of modes
                            READ(unit_numer,*,iostat=error) line_test
                            IF (error/=0) EXIT ReadInputile
                            IF (line_test/='*') THEN
                                para%n_ROM_modes=para%n_ROM_modes+1
                            ELSE
                                EXIT
                            END IF
                        END DO
                        DO i=1,para%n_ROM_modes+1 !go back in the file
                            BACKSPACE(unit_numer)
                        END DO
                        CALL AbaqusArrayCreate(para%ROM_modes,-para%ID_total*para%rve_number+para%ID_ROM_modes,[para%nRows_reduced,para%n_ROM_modes],0.0_AbqRK)
                        READ(unit_numer,*,iostat=error) para%ROM_modes !read the reduced basis
                        IF (error/=0) EXIT ReadInputile
                    ELSE IF (analysis%ROM_projection) THEN
                        DO WHILE (.TRUE.)
                            READ(unit_numer,*,iostat=error) line_test
                            IF (line_test=='*') THEN
                                BACKSPACE(unit_numer)
                                EXIT
                            END IF
                        END DO
                    END IF
                CASE('*ACTIVE_ELEMENTS')
                    IF (NOT(ANY(Keywords(1:k)=='*ELEMENT_TO_NODE'))) THEN
                        CLOSE (unit=unit_numer) !close file
                        CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found. The user Elements must be'//&
                                'be defined before the active element definition.',0_AbqIK, 0.0_AbqRK,' ')
                    END IF
                    IF (analysis%hyperintegration) THEN
                        READ(line(2)(3:),*) para%n_active_elements !number of dofs
                        ALLOCATE(dummy_active_elements(para%n_active_elements))
                        READ(unit_numer,*,iostat=error) dummy_active_elements
                        IF (error/=0) EXIT ReadInputile
                        CALL AbaqusArrayCreate(para%active_elements,-para%ID_total*para%rve_number+para%ID_active_elements,[2,para%n_active_elements],0)
                        DO i=1,para%n_active_elements
                            n=0
                            DO j=1,para%nElem_types
                                IF (dummy_active_elements(i)<=n+para%Elements(j)%NELEM) THEN
                                    para%active_elements(1,i)=j
                                    para%active_elements(2,i)=dummy_active_elements(i)-n
                                    EXIT
                                ELSE
                                    n=n+para%Elements(j)%NELEM
                                END IF
                            END DO
                        END DO
                        DO i=1,para%nElem_types
                            ALLOCATE(para%Elements(i)%multiplication_factor(para%Elements(i)%NELEM))
                        END DO
                        ALLOCATE(temp_real(para%n_active_elements))
                        READ(unit_numer,*,iostat=error) temp_real
                        IF (error/=0) EXIT ReadInputile
                        DO i=1,para%n_active_elements
                            para%Elements(para%active_elements(1,i))%multiplication_factor(para%active_elements(2,i))=temp_real(i)
                        END DO 
                        DEALLOCATE(temp_real)
                    END IF
                CASE('*END_OF_FILE')
                    error=0
                    EXIT ReadInputile
                CASE DEFAULT
                    CLOSE (unit=unit_numer) !close file
                    CALL STDB_ABQERR(-3_AbqIK,  'The unrecognized keyword '//Keywords(k)//' has been found in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                            TRIM(ADJUSTL(rve_number_str))//' inputfile.', 0_AbqIK , 0.0_AbqRK, ' ')
                END SELECT
                
                k=k+1
                
            END IF
        END DO ReadInputile
        
        CLOSE (unit=unit_numer) !close file
        
        IF (error/=0) THEN
            CALL STDB_ABQERR(-3_AbqIK,  'An unknown readerror in the inputfile '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                             ' has been found and seems to be connected with the Keyword '//Keywords(k)//'.', 0_AbqIK , 0.0_AbqRK, ' ')
        END IF

        !check the inputfile
        !check IF there has been an error in reading the file
        DO i=1,SIZE(NecessaryKeywords)
            IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords(i)))) THEN
                CALL STDB_ABQERR(-3_AbqIK,  'An unknown error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been detected. Keyword %S is missing.', 0_AbqIK , 0.0_AbqRK,[NecessaryKeywords(i)])
            END IF
        END DO
        IF (analysis%ROM_projection) THEN
            DO i=1,SIZE(NecessaryKeywords_ROM)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_ROM(i)))) THEN
                    CALL STDB_ABQERR(-3_AbqIK,  'An unknown error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                    TRIM(ADJUSTL(rve_number_str))//' inputfile has been detected. Keyword %S is missing.', 0_AbqIK , 0.0_AbqRK,[NecessaryKeywords_ROM(i)])
                END IF
            END DO
        END IF
        IF (analysis%hyperintegration==1) THEN
            DO i=1,SIZE(NecessaryKeywords_hyperreduction)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_hyperreduction(i)))) THEN
                    CALL STDB_ABQERR(-3_AbqIK,  'An unknown error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                    TRIM(ADJUSTL(rve_number_str))//' inputfile has been detected. Keyword %S is missing.', 0_AbqIK , 0.0_AbqRK,[NecessaryKeywords_hyperreduction(i)])
                END IF
            END DO
        END IF
        
        !---------------------------------set up the system of equations-------------------------------------------------------
        
        !at first go through all elements and look if a (micro) dof is possibly active (micro_macro==1 (active micro dof) micro_macro==2 (active macro dof) micro_macro<0 (inactive micro dof abs(Equation)))
        ALLOCATE(micro_macro(para%nNodes*para%ndof_n_max)); micro_macro=0
        DO k=1,para%nElem_types
            ALLOCATE(para%Elements(k)%element_dof_to_global_dof(para%Elements(k)%NDOFEL,para%Elements(k)%NELEM))
            DO e=1,para%Elements(k)%NELEM
                DO i=1,para%Elements(k)%NDOFEL
                    para%Elements(k)%element_dof_to_global_dof(i,e)=(para%Elements(k)%element_to_node(para%Elements(k)%element_dof(1,i),e)-1)*para%ndof_n_max+para%Elements(k)%element_dof(2,i)
                    micro_macro(para%Elements(k)%element_dof_to_global_dof(i,e))=1
                END DO
            END DO
        END DO

        !now go through all equations and remove the first dof from the set of active dofs and write in the equation number with negative sign
        DO e=1,para%nEquations
            micro_macro(Equations(e)%member(1))=-e
        END DO
        
        !now that it is known which micro dofs are active, number them in steps of one
        ALLOCATE(node_dof_to_reduced_dof(para%nNodes*para%ndof_n_max)); node_dof_to_reduced_dof=0
        i1=1
        DO i=1,para%nNodes*para%ndof_n_max
            IF (micro_macro(i)==1) THEN
                node_dof_to_reduced_dof(i)=i1
                i1=i1+1
            END IF
        END DO
        
        !write the inverse relation to reduced_dof_to_global_dof
        para%nRows_reduced=i1-1
        CALL AbaqusArrayCreate(para%reduced_dof_to_global_dof,-para%ID_total*para%rve_number+para%ID_reduced_dof_to_global_dof,[2,para%nRows_reduced],0)
        DO i=1,para%nNodes
            DO j=1,para%ndof_n_max
                i1=(i-1)*para%ndof_n_max+j
                i2=node_dof_to_reduced_dof(i1)
                IF (i2>0) THEN
                    para%reduced_dof_to_global_dof(1,i2)=i1
                    para%reduced_dof_to_global_dof(2,i2)=j
                END IF
            END DO
        END DO

        !give the macroscopic DOF whose reaction force has to be output a label
        i1=1
        DO i=1,para%n_Reaction_force_dof
            i2=(Reaction_force_dof(1,i)-1)*para%ndof_n_max+Reaction_force_dof(2,i)
            node_dof_to_reduced_dof(i2)=i1
            micro_macro(i2)=2
            i1=i1+1
        END DO
        
        !For FE2MODULE give a connection between the macroscopic values and the global_nodal_solution
        CALL AbaqusArrayCreate(para%macro_measure_to_micro_DOF,-para%ID_total*para%rve_number+para%ID_macro_measure_to_micro_DOF,[para%n_Reaction_force_dof+para%n_additional_dof],0)
        i1=1
        DO i=1,para%n_Reaction_force_dof
            i2=(Reaction_force_dof(1,i)-1)*para%ndof_n_max+Reaction_force_dof(2,i)
            para%macro_measure_to_micro_DOF(i1)=i2
            i1=i1+1
        END DO

        IF (ALLOCATED(Additional_dof)) THEN
            DO i=1,para%n_additional_dof
                i2=(Additional_dof(1,i)-1)*para%ndof_n_max+Additional_dof(2,i)
                para%macro_measure_to_micro_DOF(i1)=i2
                i1=i1+1
            END DO
        END IF
        
        !dummies needed for setting up the system of equations
        dummy_factor=1.0_AbqRK
        ALLOCATE(dummy_target(para%nNodes*para%ndof_n_max))
        FORALL(i=1:para%nNodes*para%ndof_n_max) dummy_target(i)=i

        IF (.NOT. analysis%hyperintegration) THEN
            
            !in a not hyper integrated simulation set all elements active
            para%n_active_elements=0
            DO i=1,para%nElem_types
                para%n_active_elements=para%n_active_elements+para%Elements(i)%NELEM
            END DO
            CALL AbaqusArrayCreate(para%active_elements,-para%ID_total*para%rve_number+para%ID_active_elements,[2,para%n_active_elements],0)
            n=1
            DO i=1,para%nElem_types
                DO j=1,para%Elements(i)%NELEM
                    para%active_elements(1,n)=i
                    para%active_elements(2,n)=j
                    n=n+1
                END DO
            END DO

            !at first go through all elements, to see how many numbers the array will comprise and get the sparsity structure
            DO i=1,para%nElem_types
                ALLOCATE(para%Elements(i)%rhs_to_global_column(para%Elements(i)%NELEM+1))
                ALLOCATE(para%Elements(i)%AMATRX_to_global_column(para%Elements(i)%NELEM+1))
            END DO

            ALLOCATE(sparsity_structure(para%nRows_reduced,para%nRows_reduced)); sparsity_structure=.false.
            DO k=1,para%nElem_types
                n1=1
                n2=1
                DO e=1,para%Elements(k)%NELEM
                    para%Elements(k)%rhs_to_global_column(e)=n1
                    para%Elements(k)%AMATRX_to_global_column(e)=n2
                    DO i=1,para%Elements(k)%NDOFEL
                        i1=para%Elements(k)%element_dof_to_global_dof(i,e)
                        IF (node_dof_to_reduced_dof(i1)>0) THEN !active nodal degree of freedom
                            pointer_i=>dummy_target(i1:i1)
                        ELSE !driven nodal degree of freedom -> point to equation degree of freedom
                            pointer_i=>Equations(ABS(micro_macro(i1)))%member(2:)
                        END IF
                        DO i2=1,SIZE(pointer_i) !loop over whole element matrix of derivatives
                            IF (micro_macro(pointer_i(i2))<0) THEN
                                CALL STDB_ABQERR(-3_AbqIK,  'In Equation %I an error occured: Already excluded DOF detected.', ABS(micro_macro(pointer_i(i2))) , 0.0_AbqRK, ' ')
                            ELSE IF (.NOT. (micro_macro(pointer_i(i2))==0)) THEN
                                n1=n1+1
                            END IF
                            DO j=1,para%Elements(k)%NDOFEL
                                j1=para%Elements(k)%element_dof_to_global_dof(j,e)
                                IF (coupling(para%Elements(k)%element_dof(2,i),para%Elements(k)%element_dof(2,j))) THEN
                                    IF (node_dof_to_reduced_dof(j1)>0) THEN !active nodal degree of freedom
                                        pointer_j=>dummy_target(j1:j1)
                                    ELSE !driven nodal degree of freedom -> point to equation degree of freedom
                                        pointer_j=>Equations(ABS(micro_macro(j1)))%member(2:)
                                    END IF
                                    DO j2=1,SIZE(pointer_j) !check if matrix contributions are relevant
                                        IF (micro_macro(pointer_i(i2))==1) THEN
                                            IF (micro_macro(pointer_j(j2))==1) THEN
                                                IF ((node_dof_to_reduced_dof(pointer_j(j2))>=node_dof_to_reduced_dof(pointer_i(i2))) .OR. (.NOT. analysis%symmetric_matrix)) THEN !only take upper triangle of matrix if assumed symmetric
                                                    sparsity_structure(node_dof_to_reduced_dof(pointer_i(i2)),node_dof_to_reduced_dof(pointer_j(j2)))=.true. !set entry active in sparse matrix
                                                    n2=n2+1
                                                END IF
                                            ELSE IF (micro_macro(pointer_j(j2))==2) THEN
                                                IF (.NOT. analysis%symmetric_matrix) THEN
                                                    n2=n2+1
                                                END IF
                                            END IF
                                        ELSE IF (micro_macro(pointer_i(i2))==2) THEN
                                            IF (micro_macro(pointer_j(j2))==1) THEN
                                                n2=n2+1
                                            ELSE IF (micro_macro(pointer_j(j2))==2) THEN
                                                n2=n2+1
                                            END IF
                                        END IF
                                    END DO
                                END IF
                            END DO
                        END DO
                    END DO
                END DO
                para%Elements(k)%rhs_to_global_column(para%Elements(k)%NELEM+1)=n1
                para%Elements(k)%AMATRX_to_global_column(para%Elements(k)%NELEM+1)=n2
            END DO
            
            !finally get structure of sparse Matrix in CSR Format
            !at first get the number of nonzero entries in the matrix
            para%nNonZero_reduced=0
            DO i=1,para%nRows_reduced
                DO j=1,para%nRows_reduced
                    IF (sparsity_structure(i,j)) THEN
                        para%nNonZero_reduced=para%nNonZero_reduced+1
                    END IF
                END DO
            END DO
            
            CALL AbaqusArrayCreate(para%rowIndex_reduced,-para%ID_total*para%rve_number+para%ID_rowIndex_reduced,[para%nRows_reduced+1],0)
            CALL AbaqusArrayCreate(para%columnIndex_reduced,-para%ID_total*para%rve_number+para%ID_columnIndex_reduced,[para%nNonZero_reduced],0)

            !now get rowIndex_reduced and columnIndex_reduced
            n=1
            DO i=1,para%nRows_reduced
                para%rowIndex_reduced(i)=n
                DO j=1,para%nRows_reduced
                    IF (sparsity_structure(i,j)) THEN
                        para%columnIndex_reduced(n)=j
                        n=n+1
                    END IF
                END DO
            END DO
            para%rowIndex_reduced(para%nRows_reduced+1)=n
            DEALLOCATE(sparsity_structure)

            !now again go through all the elements to get the actual element matrices to global matrices connection
            DO i=1,para%nElem_types
                ALLOCATE(para%Elements(i)%rhs_to_global(3,para%Elements(i)%rhs_to_global_column(para%Elements(i)%NELEM+1)-1))
                ALLOCATE(para%Elements(i)%rhs_to_global_factor(para%Elements(i)%rhs_to_global_column(para%Elements(i)%NELEM+1)-1))
                ALLOCATE(para%Elements(i)%AMATRX_to_global(6,para%Elements(i)%AMATRX_to_global_column(para%Elements(i)%NELEM+1)-1))
                ALLOCATE(para%Elements(i)%AMATRX_to_global_factor(para%Elements(i)%AMATRX_to_global_column(para%Elements(i)%NELEM+1)-1))
            END DO
            
            DO k=1,para%nElem_types
                n1=1
                n2=1
                DO e=1,para%Elements(k)%NELEM
                    DO i=1,para%Elements(k)%NDOFEL
                        i1=para%Elements(k)%element_dof_to_global_dof(i,e)
                        IF (node_dof_to_reduced_dof(i1)>0) THEN !active nodal degree of freedom
                            pointer_i=>dummy_target(i1:i1)
                            pointer_factor_i=>dummy_factor
                        ELSE !driven nodal degree of freedom -> point to equation degree of freedom
                            pointer_i=>Equations(ABS(micro_macro(i1)))%member(2:)
                            pointer_factor_i=>Equations(ABS(micro_macro(i1)))%factor(2:)
                        END IF
                        DO i2=1,SIZE(pointer_i) !loop over whole element matrix of derivatives
                            IF (.NOT. (micro_macro(pointer_i(i2))==0)) THEN
                                para%Elements(k)%rhs_to_global(:,n1)=[i,micro_macro(pointer_i(i2)),node_dof_to_reduced_dof(pointer_i(i2))]
                                para%Elements(k)%rhs_to_global_factor(n1)=pointer_factor_i(i2)
                                n1=n1+1
                            END IF
                            DO j=1,para%Elements(k)%NDOFEL
                                j1=para%Elements(k)%element_dof_to_global_dof(j,e)
                                IF (coupling(para%Elements(k)%element_dof(2,i),para%Elements(k)%element_dof(2,j))) THEN
                                    IF (node_dof_to_reduced_dof(j1)>0) THEN !active nodal degree of freedom
                                        pointer_j=>dummy_target(j1:j1)
                                        pointer_factor_j=>dummy_factor
                                    ELSE !driven nodal degree of freedom -> point to equation degree of freedom
                                        pointer_j=>Equations(ABS(micro_macro(j1)))%member(2:)
                                        pointer_factor_j=>Equations(ABS(micro_macro(j1)))%factor(2:)
                                    END IF
                                    DO j2=1,SIZE(pointer_j) !check if matrix contributions are relevant
                                        IF (micro_macro(pointer_i(i2))==1) THEN
                                            IF (micro_macro(pointer_j(j2))==1) THEN
                                                IF ((node_dof_to_reduced_dof(pointer_j(j2))>=node_dof_to_reduced_dof(pointer_i(i2))) .OR. (.NOT. analysis%symmetric_matrix)) THEN !only take upper triangle of matrix if assumed symmetric
                                                    para%Elements(k)%AMATRX_to_global(:,n2)=[i,j,1,1,FINDLOC(para%columnIndex_reduced(para%rowIndex_reduced(node_dof_to_reduced_dof(pointer_i(i2))):para%rowIndex_reduced(node_dof_to_reduced_dof(pointer_i(i2))+1)-1),node_dof_to_reduced_dof(pointer_j(j2)),DIM=1)+para%rowIndex_reduced(node_dof_to_reduced_dof(pointer_i(i2)))-1,1]
                                                    para%Elements(k)%AMATRX_to_global_factor(n2)=pointer_factor_i(i2)*pointer_factor_j(j2)
                                                    n2=n2+1
                                                END IF
                                            ELSE IF (micro_macro(pointer_j(j2))==2) THEN
                                                IF (.NOT. analysis%symmetric_matrix) THEN
                                                    para%Elements(k)%AMATRX_to_global(:,n2)=[i,j,1,2,node_dof_to_reduced_dof(pointer_i(i2)),node_dof_to_reduced_dof(pointer_j(j2))]
                                                    para%Elements(k)%AMATRX_to_global_factor(n2)=pointer_factor_i(i2)*pointer_factor_j(j2)
                                                    n2=n2+1
                                                END IF
                                            END IF
                                        ELSE IF (micro_macro(pointer_i(i2))==2) THEN
                                            IF (micro_macro(pointer_j(j2))==1) THEN
                                                para%Elements(k)%AMATRX_to_global(:,n2)=[i,j,2,1,node_dof_to_reduced_dof(pointer_i(i2)),node_dof_to_reduced_dof(pointer_j(j2))]
                                                para%Elements(k)%AMATRX_to_global_factor(n2)=pointer_factor_i(i2)*pointer_factor_j(j2)
                                                n2=n2+1
                                            ELSE IF (micro_macro(pointer_j(j2))==2) THEN
                                                para%Elements(k)%AMATRX_to_global(:,n2)=[i,j,2,2,node_dof_to_reduced_dof(pointer_i(i2)),node_dof_to_reduced_dof(pointer_j(j2))]
                                                para%Elements(k)%AMATRX_to_global_factor(n2)=pointer_factor_i(i2)*pointer_factor_j(j2)
                                                n2=n2+1
                                            END IF
                                        END IF
                                    END DO
                                END IF
                            END DO
                        END DO
                    END DO
                END DO
            END DO

            !permutationmatrix for reducing the bandwitdh
            IF (.NOT. analysis%ROM_projection) THEN
                CALL STDB_ABQERR(1_AbqIK,  'The solver reports for RVE-Nr. %I : ',[para%rve_number], 0.0_AbqRK, ' ')
                CALL AbaqusArrayCreate(para%perm,-para%ID_total*para%rve_number+para%ID_perm,[para%nRows_reduced],0)
            END IF
        
        END IF
        
        IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) THEN
            
            DO k=1,para%nElem_types
                ALLOCATE(para%Elements(k)%constraint_element_dof(para%Elements(k)%NELEM)); para%Elements(k)%constraint_element_dof=0
                ALLOCATE(para%Elements(k)%ROM_modes(para%Elements(k)%NDOFEL,para%n_ROM_modes,para%Elements(k)%NELEM)); para%Elements(k)%ROM_modes=0.0_AbqRK
                ALLOCATE(para%Elements(k)%Equations(para%Elements(k)%NDOFEL,para%n_Reaction_force_dof,para%Elements(k)%NELEM)); para%Elements(k)%Equations=0.0_AbqRK
            END DO
                        
            DO n=1,para%n_active_elements
                k=para%active_elements(1,n)
                e=para%active_elements(2,n)
                DO i=1,para%Elements(k)%NDOFEL
                    i1=para%Elements(k)%element_dof_to_global_dof(i,e)
                    IF (node_dof_to_reduced_dof(i1)>0) THEN !active nodal degree of freedom
                        pointer_i=>dummy_target(i1:i1)
                        pointer_factor_i=>dummy_factor
                    ELSE !driven nodal degree of freedom -> point to equation degree of freedom
                        pointer_i=>para%Equation_members(para%Equation_n_members(ABS(micro_macro(i1)))+1:para%Equation_n_members(ABS(micro_macro(i1))+1)-1)
                        pointer_factor_i=>para%Equation_factors(para%Equation_n_members(ABS(micro_macro(i1)))+1:para%Equation_n_members(ABS(micro_macro(i1))+1)-1)
                    END IF
                    DO i1=1,SIZE(pointer_i)
                        IF (micro_macro(pointer_i(i1))==1) THEN
                            para%Elements(k)%ROM_modes(i,:,e)=para%Elements(k)%ROM_modes(i,:,e)+para%ROM_modes(node_dof_to_reduced_dof(pointer_i(i1)),:)*pointer_factor_i(i1)
                        ELSE IF (micro_macro(pointer_i(i1))==2) THEN
                            para%Elements(k)%Equations(i,node_dof_to_reduced_dof(pointer_i(i1)),e)=pointer_factor_i(i1)
                            para%Elements(k)%constraint_element_dof(e)=1
                        END IF
                    END DO
                END DO
            END DO
            
        END IF
        
        !give the connection between the position of the local and global SVARS
        DO k=1,para%nElem_types
            ALLOCATE(para%Elements(k)%local_to_global_SVARS(para%Elements(k)%NELEM))
        END DO
        
        para%NSVARS_total=0
        DO i=1,para%n_active_elements
            k=para%active_elements(1,i)
            e=para%active_elements(2,i)
            para%Elements(k)%local_to_global_SVARS(e)=para%NSVARS_total+1
            para%NSVARS_total=para%NSVARS_total+para%Elements(k)%NSVARS
        END DO
        
        !allocate memory for all element information and write the data into it
        para%n_Element_ints=0
        para%n_Element_reals=0
        DO i=1,para%nElem_types
        
            !Integers
            
            para%n_Element_ints =para%n_Element_ints+7+&
                                 SIZE(para%Elements(i)%element_dof)+SIZE(para%Elements(i)%element_to_node)+&
                                 SIZE(para%Elements(i)%element_dof_to_global_dof)+SIZE(para%Elements(i)%JELEM)+&
                                 SIZE(para%Elements(i)%JPROPS)+SIZE(para%Elements(i)%local_to_global_SVARS)
            IF (.NOT. analysis%hyperintegration) para%n_Element_ints=para%n_Element_ints+SIZE(para%Elements(i)%rhs_to_global_column)+SIZE(para%Elements(i)%rhs_to_global)+&
                                                                     SIZE(para%Elements(i)%AMATRX_to_global_column)+SIZE(para%Elements(i)%AMATRX_to_global)
            IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) para%n_Element_ints=para%n_Element_ints+SIZE(para%Elements(i)%constraint_element_dof)
            
            !Reals
            
            para%n_Element_reals=para%n_Element_reals+SIZE(para%Elements(i)%PROPS)
            IF (.NOT. analysis%hyperintegration) para%n_Element_reals=para%n_Element_reals+SIZE(para%Elements(i)%rhs_to_global_factor)+SIZE(para%Elements(i)%AMATRX_to_global_factor)
            IF (analysis%hyperintegration) para%n_Element_reals=para%n_Element_reals+SIZE(para%Elements(i)%multiplication_factor)
            IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) para%n_Element_reals=para%n_Element_reals+SIZE(para%Elements(i)%ROM_modes)+SIZE(para%Elements(i)%Equations)
            
        END DO
        
        CALL AbaqusArrayCreate(para%Element_Ints,-para%ID_total*para%rve_number+para%ID_Element_Ints,[para%n_Element_ints],0)
        CALL AbaqusArrayCreate(para%Element_Reals,-para%ID_total*para%rve_number+para%ID_Element_Reals,[para%n_Element_reals],0.0_AbqRK)
        
        n1=1
        n2=1
        DO i=1,para%nElem_types
            
            !Integers
            
            para%Element_Ints(n1)   =   para%Elements(i)%JTYPE;     DEALLOCATE(para%Elements(i)%JTYPE);     para%Elements(i)%JTYPE=>para%Element_Ints(n1);  n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NNODE;     DEALLOCATE(para%Elements(i)%NNODE);     para%Elements(i)%NNODE=>para%Element_Ints(n1);  n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NDOFEL;    DEALLOCATE(para%Elements(i)%NDOFEL);    para%Elements(i)%NDOFEL=>para%Element_Ints(n1); n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NPROPS;    DEALLOCATE(para%Elements(i)%NPROPS);    para%Elements(i)%NPROPS=>para%Element_Ints(n1); n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NJPROP;    DEALLOCATE(para%Elements(i)%NJPROP);    para%Elements(i)%NJPROP=>para%Element_Ints(n1); n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NSVARS;    DEALLOCATE(para%Elements(i)%NSVARS);    para%Elements(i)%NSVARS=>para%Element_Ints(n1); n1=n1+1
            para%Element_Ints(n1)   =   para%Elements(i)%NELEM;     DEALLOCATE(para%Elements(i)%NELEM);     para%Elements(i)%NELEM=>para%Element_Ints(n1);  n1=n1+1
            
            int_pointer2(1:SIZE(para%Elements(i)%element_dof,1),1:SIZE(para%Elements(i)%element_dof,2))=>para%Element_Ints(n1:);                                    int_pointer2=para%Elements(i)%element_dof
            DEALLOCATE(para%Elements(i)%element_dof);               para%Elements(i)%element_dof=>int_pointer2;                                                     n1=n1+SIZE(para%Elements(i)%element_dof)
                
            int_pointer2(1:SIZE(para%Elements(i)%element_dof_to_global_dof,1),1:SIZE(para%Elements(i)%element_dof_to_global_dof,2))=>para%Element_Ints(n1:);        int_pointer2=para%Elements(i)%element_dof_to_global_dof
            DEALLOCATE(para%Elements(i)%element_dof_to_global_dof); para%Elements(i)%element_dof_to_global_dof=>int_pointer2;                                       n1=n1+SIZE(para%Elements(i)%element_dof_to_global_dof)
            
            int_pointer2(1:SIZE(para%Elements(i)%element_to_node,1),1:SIZE(para%Elements(i)%element_to_node,2))=>para%Element_Ints(n1:);                            int_pointer2=para%Elements(i)%element_to_node
            DEALLOCATE(para%Elements(i)%element_to_node);           para%Elements(i)%element_to_node=>int_pointer2;                                                 n1=n1+SIZE(para%Elements(i)%element_to_node)
                                    
            int_pointer1(1:SIZE(para%Elements(i)%JELEM))=>para%Element_Ints(n1:);                                                                                   int_pointer1=para%Elements(i)%JELEM                     
            DEALLOCATE(para%Elements(i)%JELEM);                     para%Elements(i)%JELEM=>int_pointer1;                                                           n1=n1+SIZE(para%Elements(i)%JELEM)
            
            int_pointer1(1:SIZE(para%Elements(i)%JPROPS))=>para%Element_Ints(n1:);                                                                                  int_pointer1=para%Elements(i)%JPROPS                     
            DEALLOCATE(para%Elements(i)%JPROPS);                    para%Elements(i)%JPROPS=>int_pointer1;                                                          n1=n1+SIZE(para%Elements(i)%JPROPS)
                                    
            int_pointer1(1:SIZE(para%Elements(i)%local_to_global_SVARS))=>para%Element_Ints(n1:);                                                                   int_pointer1=para%Elements(i)%local_to_global_SVARS
            DEALLOCATE(para%Elements(i)%local_to_global_SVARS);     para%Elements(i)%local_to_global_SVARS=>int_pointer1;                                           n1=n1+SIZE(para%Elements(i)%local_to_global_SVARS)
            
            IF (.NOT. analysis%hyperintegration) THEN
            
            int_pointer1(1:SIZE(para%Elements(i)%rhs_to_global_column))=>para%Element_Ints(n1:);                                                                    int_pointer1=para%Elements(i)%rhs_to_global_column
            DEALLOCATE(para%Elements(i)%rhs_to_global_column);      para%Elements(i)%rhs_to_global_column=>int_pointer1;                                            n1=n1+SIZE(para%Elements(i)%rhs_to_global_column)
                                    
            int_pointer2(1:SIZE(para%Elements(i)%rhs_to_global,1),1:SIZE(para%Elements(i)%rhs_to_global,2))=>para%Element_Ints(n1:);                                int_pointer2=para%Elements(i)%rhs_to_global
            DEALLOCATE(para%Elements(i)%rhs_to_global);             para%Elements(i)%rhs_to_global=>int_pointer2;                                                   n1=n1+SIZE(para%Elements(i)%rhs_to_global)
                                    
            int_pointer1(1:SIZE(para%Elements(i)%AMATRX_to_global_column))=>para%Element_Ints(n1:);                                                                 int_pointer1=para%Elements(i)%AMATRX_to_global_column
            DEALLOCATE(para%Elements(i)%AMATRX_to_global_column);   para%Elements(i)%AMATRX_to_global_column=>int_pointer1;                                         n1=n1+SIZE(para%Elements(i)%AMATRX_to_global_column)
                                    
            int_pointer2(1:SIZE(para%Elements(i)%AMATRX_to_global,1),1:SIZE(para%Elements(i)%AMATRX_to_global,2))=>para%Element_Ints(n1:);                          int_pointer2=para%Elements(i)%AMATRX_to_global
            DEALLOCATE(para%Elements(i)%AMATRX_to_global);          para%Elements(i)%AMATRX_to_global=>int_pointer2;                                                n1=n1+SIZE(para%Elements(i)%AMATRX_to_global)
            
            END IF
            
            IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) THEN                     
                                        
            int_pointer1(1:SIZE(para%Elements(i)%constraint_element_dof))=>para%Element_Ints(n1:);                                                                  int_pointer1=para%Elements(i)%constraint_element_dof
            DEALLOCATE(para%Elements(i)%constraint_element_dof);    para%Elements(i)%constraint_element_dof=>int_pointer1;                                          n1=n1+SIZE(para%Elements(i)%constraint_element_dof)
                                        
            END IF                      
                                    
            !Reals                      
                                    
            real_pointer1(1:SIZE(para%Elements(i)%PROPS))=>para%Element_Reals(n2:);                                                                                 real_pointer1=para%Elements(i)%PROPS
            DEALLOCATE(para%Elements(i)%PROPS);                     para%Elements(i)%PROPS=>real_pointer1;                                                          n2=n2+SIZE(para%Elements(i)%PROPS)
            
            IF (.NOT. analysis%hyperintegration) THEN
            
            real_pointer1(1:SIZE(para%Elements(i)%rhs_to_global_factor))=>para%Element_Reals(n2:);                                                                  real_pointer1=para%Elements(i)%rhs_to_global_factor
            DEALLOCATE(para%Elements(i)%rhs_to_global_factor);      para%Elements(i)%rhs_to_global_factor=>real_pointer1;                                            n2=n2+SIZE(para%Elements(i)%rhs_to_global_factor)
                                    
            real_pointer1(1:SIZE(para%Elements(i)%AMATRX_to_global_factor))=>para%Element_Reals(n2:);                                                               real_pointer1=para%Elements(i)%AMATRX_to_global_factor
            DEALLOCATE(para%Elements(i)%AMATRX_to_global_factor);   para%Elements(i)%AMATRX_to_global_factor=>real_pointer1;                                        n2=n2+SIZE(para%Elements(i)%AMATRX_to_global_factor)
            
            END IF
            
            IF (analysis%hyperintegration) THEN
            
            real_pointer1(1:SIZE(para%Elements(i)%multiplication_factor))=>para%Element_Reals(n2:);                                                                 real_pointer1=para%Elements(i)%multiplication_factor
            DEALLOCATE(para%Elements(i)%multiplication_factor);     para%Elements(i)%rhs_to_global_factor=>real_pointer1;                                           n2=n2+SIZE(para%Elements(i)%multiplication_factor)
            
            END IF
            
            IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) THEN
                
            real_pointer3(1:SIZE(para%Elements(i)%ROM_modes,1),1:SIZE(para%Elements(i)%ROM_modes,2),1:SIZE(para%Elements(i)%ROM_modes,3))=>para%Element_Reals(n2:); real_pointer3=para%Elements(i)%ROM_modes
            DEALLOCATE(para%Elements(i)%ROM_modes);                 para%Elements(i)%ROM_modes=>real_pointer3;                                                      n2=n2+SIZE(para%Elements(i)%ROM_modes)
            
            real_pointer3(1:SIZE(para%Elements(i)%Equations,1),1:SIZE(para%Elements(i)%Equations,2),1:SIZE(para%Elements(i)%Equations,3))=>para%Element_Reals(n2:); real_pointer3=para%Elements(i)%Equations
            DEALLOCATE(para%Elements(i)%Equations);                 para%Elements(i)%Equations=>real_pointer3;                                                      n2=n2+SIZE(para%Elements(i)%Equations)
                
            END IF
            
        END DO
        
        !allocate memory for the reference volume of the elements needed in the hyper ROM training process
        IF (analysis%training .AND. analysis%ROM_projection) THEN
            CALL AbaqusArrayCreate(para%ref_Volume_elements,-para%ID_total*para%rve_number+para%ID_ref_Volume_elements,[para%n_active_elements],0.0_AbqRK)
        END IF
        
        !mark the RVE definition as active
        analysis%active_RVE_definitions=analysis%active_RVE_definitions+1
        
    END IF
    
END SUBROUTINE read_data_procedure


SUBROUTINE get_pointer_procedure(para,analysis)
    !get pointer to the mesh definition arrays

    IMPLICIT NONE

    CLASS(meshparameters)::para
    TYPE(analysisparameters),INTENT(IN)::analysis
    INTEGER, DIMENSION(:),POINTER:: array_int
    REAL(KIND=AbqRK), DIMENSION(:),POINTER:: array_real
    INTEGER:: n1,n2,i,i1
    
    !-check if the RVE meshdata has been read before, if not stop the analysis-
    IF (para%rve_number>analysis%active_RVE_definitions .OR. para%rve_number<1) THEN
        CALL STDB_ABQERR(-3_AbqIK, 'RVE Definition Nr. accessed by the UMAT'//&
             ' has no information!!',0, 0.0_AbqRK, ' ')
    END IF    

    CALL AbaqusArrayAccess(array_int,-para%ID_total*para%rve_number+para%ID_scalars,[15])
    
    para%dimens                     => array_int(1)
    para%nNodes                     => array_int(2)
    para%nNonZero_reduced           => array_int(3)
    para%nRows_reduced              => array_int(4)
    para%ndof_n_max                 => array_int(5)
    para%nEquations                 => array_int(6)
    para%n_ROM_modes                => array_int(7)
    para%n_active_elements          => array_int(8)
    para%nElem_types                => array_int(9)
    para%n_Reaction_force_dof       => array_int(10)
    para%n_additional_dof           => array_int(11)
    para%n_additional_hyper_outputs => array_int(12)
    para%NSVARS_total               => array_int(13)
    para%n_Element_reals            => array_int(14)
    para%n_Element_ints             => array_int(15)
    
    CALL AbaqusArrayAccess(para%Equation_n_members,-para%ID_total*para%rve_number+para%ID_Equation_n_members,[para%nEquations+1])
    
    CALL AbaqusArrayAccess(para%Equation_factors,-para%ID_total*para%rve_number+para%ID_Equation_factors,[para%Equation_n_members(para%nEquations+1)-1])
    
    CALL AbaqusArrayAccess(para%Equation_members,-para%ID_total*para%rve_number+para%ID_Equation_members,[para%Equation_n_members(para%nEquations+1)-1])
    
    CALL AbaqusArrayAccess(para%Coordinates_global,-para%ID_total*para%rve_number+para%ID_Coordinates_global,[para%dimens,para%nNodes])
    
    CALL AbaqusArrayAccess(para%active_elements,-para%ID_total*para%rve_number+para%ID_active_elements,[2,para%n_active_elements])
    
    CALL AbaqusArrayAccess(array_real,-para%ID_total*para%rve_number+para%ID_RVE_Volume,[1])
    para%RVE_Volume=>array_real(1)
    
    CALL AbaqusArrayAccess(para%reduced_dof_to_global_dof,-para%ID_total*para%rve_number+para%ID_reduced_dof_to_global_dof,[2,para%nRows_reduced])
    
    CALL AbaqusArrayAccess(para%macro_measure_to_micro_DOF,-para%ID_total*para%rve_number+para%ID_macro_measure_to_micro_DOF,[para%n_Reaction_force_dof+para%n_additional_dof])
    
    IF (.NOT. analysis%hyperintegration) THEN !full integration
    
        CALL AbaqusArrayAccess(para%rowIndex_reduced,-para%ID_total*para%rve_number+para%ID_rowIndex_reduced,[para%nRows_reduced+1])
        
        CALL AbaqusArrayAccess(para%columnIndex_reduced,-para%ID_total*para%rve_number+para%ID_columnIndex_reduced,[para%nNonZero_reduced])
        
    END IF
    
    IF (.NOT. analysis%ROM_projection) THEN !full simulation
    
        CALL AbaqusArrayAccess(para%perm,-para%ID_total*para%rve_number+para%ID_perm,[para%nRows_reduced])
        
    ELSE !ROM simulation
    
        CALL AbaqusArrayAccess(para%ROM_modes,-para%ID_total*para%rve_number+para%ID_ROM_modes,[para%nRows_reduced,para%n_ROM_modes])
        
    END IF
    
    IF (analysis%training .AND. analysis%ROM_projection) THEN
        CALL AbaqusArrayAccess(para%ref_Volume_elements,-para%ID_total*para%rve_number+para%ID_ref_Volume_elements,[para%n_active_elements])
    END IF
    
    CALL AbaqusArrayAccess(para%Element_Ints,-para%ID_total*para%rve_number+para%ID_Element_Ints,[para%n_Element_ints])
    CALL AbaqusArrayAccess(para%Element_Reals,-para%ID_total*para%rve_number+para%ID_Element_Reals,[para%n_Element_reals])
    
    n1=1
    n2=1
    ALLOCATE(para%Elements(para%nElem_types))
    DO i=1,para%nElem_types
        
        !Integers
        
        para%Elements(i)%JTYPE      =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NNODE      =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NDOFEL     =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NPROPS     =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NJPROP     =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NSVARS     =>   para%Element_Ints(n1); n1=n1+1
        para%Elements(i)%NELEM      =>   para%Element_Ints(n1); n1=n1+1
        
        para%Elements(i)%element_dof(1:2,1:para%Elements(i)%NDOFEL)                                                     =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%element_dof)
        para%Elements(i)%element_dof_to_global_dof(1:para%Elements(i)%NDOFEL,1:para%Elements(i)%NELEM)                  =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%element_dof_to_global_dof)
        para%Elements(i)%element_to_node(1:para%Elements(i)%NNODE,1:para%Elements(i)%NELEM)                             =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%element_to_node)
        para%Elements(i)%JELEM(1:para%Elements(i)%NELEM)                                                                =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%JELEM)
        para%Elements(i)%JPROPS(1:para%Elements(i)%NJPROP)                                                              =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%JPROPS)
        para%Elements(i)%local_to_global_SVARS(1:para%Elements(i)%NELEM)                                                =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%local_to_global_SVARS)
        IF (.NOT. analysis%hyperintegration) THEN
        para%Elements(i)%rhs_to_global_column(1:para%Elements(i)%NELEM+1)                                               =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%rhs_to_global_column)
        para%Elements(i)%rhs_to_global(1:3,1:para%Elements(i)%rhs_to_global_column(para%Elements(i)%NELEM+1)-1)         =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%rhs_to_global)
        para%Elements(i)%AMATRX_to_global_column(1:para%Elements(i)%NELEM+1)                                            =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%AMATRX_to_global_column)
        para%Elements(i)%AMATRX_to_global(1:6,1:para%Elements(i)%AMATRX_to_global_column(para%Elements(i)%NELEM+1)-1)   =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%AMATRX_to_global)
        END IF
        IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) THEN
        para%Elements(i)%constraint_element_dof(1:para%Elements(i)%NELEM)                                               =>para%Element_Ints(n1:);   n1=n1+SIZE(para%Elements(i)%constraint_element_dof)
        END IF
        
        !Reals
        
        para%Elements(i)%PROPS(1:para%Elements(i)%NPROPS)                                                               =>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%PROPS)
        IF (.NOT. analysis%hyperintegration) THEN
        para%Elements(i)%rhs_to_global_factor(1:para%Elements(i)%rhs_to_global_column(para%Elements(i)%NELEM+1)-1)      =>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%rhs_to_global_factor)
        para%Elements(i)%AMATRX_to_global_factor(1:para%Elements(i)%AMATRX_to_global_column(para%Elements(i)%NELEM+1)-1)=>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%AMATRX_to_global_factor)
        END IF
        IF (analysis%hyperintegration) THEN
        para%Elements(i)%multiplication_factor(1:para%Elements(i)%NELEM)                                                =>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%multiplication_factor)
        END IF
        IF (analysis%hyperintegration .OR. (analysis%training .AND. analysis%ROM_projection)) THEN
        para%Elements(i)%ROM_modes(1:para%Elements(i)%NDOFEL,1:para%n_ROM_modes,1:para%Elements(i)%NELEM)               =>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%ROM_modes)
        para%Elements(i)%Equations(1:para%Elements(i)%NDOFEL,1:para%n_Reaction_force_dof,1:para%Elements(i)%NELEM)      =>para%Element_Reals(n2:);  n2=n2+SIZE(para%Elements(i)%Equations) 
        END IF
        
        !some only temporary matrices that need to be handed into the element
        ALLOCATE(para%Elements(i)%SVARS(para%Elements(i)%NSVARS))
        ALLOCATE(para%Elements(i)%U(para%Elements(i)%NDOFEL))
        ALLOCATE(para%Elements(i)%V(para%Elements(i)%NDOFEL))
        ALLOCATE(para%Elements(i)%A(para%Elements(i)%NDOFEL))
        ALLOCATE(para%Elements(i)%RHS(para%Elements(i)%NDOFEL,1))
        ALLOCATE(para%Elements(i)%AMATRX(para%Elements(i)%NDOFEL,para%Elements(i)%NDOFEL))
        ALLOCATE(para%Elements(i)%DU(para%Elements(i)%NDOFEL,1))
        ALLOCATE(para%Elements(i)%COORDS(para%dimens,para%Elements(i)%NNODE))
        IF (analysis%hyperintegration) THEN
            ALLOCATE(para%Elements(i)%temp_matrix1(para%Elements(i)%NDOFEL,para%n_ROM_modes))
            ALLOCATE(para%Elements(i)%temp_matrix2(para%Elements(i)%NDOFEL,para%n_Reaction_force_dof))
        END IF
        
    END DO   
     
END SUBROUTINE get_pointer_procedure


SUBROUTINE deallocate_data_procedure(para,analysis)
    !deallocate the mesh definiting arrays
    
    IMPLICIT NONE

    CLASS(meshparameters)::para
    INTEGER, DIMENSION(:),POINTER:: array_int
    REAL(KIND=AbqRK), DIMENSION(:),POINTER:: array_real
    TYPE(analysisparameters),INTENT(IN)::analysis
    
    CALL AbaqusArrayDelete(array_int,-para%ID_total*para%rve_number+para%ID_scalars)
    CALL AbaqusArrayDelete(para%Equation_n_members,-para%ID_total*para%rve_number+para%ID_Equation_n_members)
    CALL AbaqusArrayDelete(para%Equation_factors,-para%ID_total*para%rve_number+para%ID_Equation_factors)
    CALL AbaqusArrayDelete(para%Equation_members,-para%ID_total*para%rve_number+para%ID_Equation_members)
    CALL AbaqusArrayDelete(para%Coordinates_global,-para%ID_total*para%rve_number+para%ID_Coordinates_global)
    CALL AbaqusArrayDelete(para%active_elements,-para%ID_total*para%rve_number+para%ID_active_elements)
    CALL AbaqusArrayDelete(array_real,-para%ID_total*para%rve_number+para%ID_RVE_Volume)
    CALL AbaqusArrayDelete(para%reduced_dof_to_global_dof,-para%ID_total*para%rve_number+para%ID_reduced_dof_to_global_dof)
    CALL AbaqusArrayDelete(para%macro_measure_to_micro_DOF,-para%ID_total*para%rve_number+para%ID_macro_measure_to_micro_DOF)
    IF (.NOT. analysis%hyperintegration) THEN !full integration
        CALL AbaqusArrayDelete(para%rowIndex_reduced,-para%ID_total*para%rve_number+para%ID_rowIndex_reduced)
        CALL AbaqusArrayDelete(para%columnIndex_reduced,-para%ID_total*para%rve_number+para%ID_columnIndex_reduced)
    END IF
    IF (.NOT. analysis%ROM_projection) THEN !full simulation
        CALL AbaqusArrayDelete(para%perm,-para%ID_total*para%rve_number+para%ID_perm)
    ELSE !ROM simulation
        CALL AbaqusArrayDelete(para%ROM_modes,-para%ID_total*para%rve_number+para%ID_ROM_modes)
    END IF
    CALL AbaqusArrayDelete(para%Element_Ints,-para%ID_total*para%rve_number+para%ID_Element_Ints)
    CALL AbaqusArrayDelete(para%Element_Reals,-para%ID_total*para%rve_number+para%ID_Element_Reals)
    IF (analysis%training .AND. analysis%ROM_projection) THEN
        CALL AbaqusArrayDelete(para%ref_Volume_elements,-para%ID_total*para%rve_number+para%ID_ref_Volume_elements)
    END IF
    
END SUBROUTINE deallocate_data_procedure

SUBROUTINE To_upper(str)
   !this subroutine converts a string with upper and lower cases to a purely
   !upper case expression
   
   IMPLICIT NONE
   
   CHARACTER(*), INTENT(IN OUT) :: str
   INTEGER :: i
    
   DO i = 1, LEN(str)
   SELECT CASE(str(i:i))
       CASE("a":"z")
       str(i:i) = ACHAR(IACHAR(str(i:i))-32)
   END SELECT
   END DO 
     
END SUBROUTINE To_upper

END MODULE type_meshparameters
