!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
! 
!=============================================================================

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 ABQSMA
    USE type_analysisparameters
    
    PRIVATE::To_upper
    PUBLIC

    TYPE meshparameters
    
        INTEGER:: rve_number !rve label
        !-----------------------mesh parameters--------------------------------
        INTEGER,POINTER:: dimens,nnodes_e,ndof_e,n_STATEV_elem,nElem,nNodes,&
                          nNonZero_reduced,nRows_reduced,ndof_n,JTYPE,&
                          ndof_macro,nEquations,n_ROM_modes,&
                          n_matdef,n_PROPS_max,NGP_hyper,NGP_local,NTENS,n_elem_to_hyper
        !'equation's for enforcing the constraints
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: Equations
        INTEGER(KIND=4):: ID_Equations=1
        !connection master reduced dof <-> global master node label
        INTEGER(KIND=4),DIMENSION(:),POINTER:: master_reduced_to_global
        INTEGER(KIND=4):: ID_master_reduced_to_global=2
        !CSR definition array for reduced stiffnessmatrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: rowIndex_reduced
        INTEGER(KIND=4):: ID_rowIndex_reduced=3
        !CSR definition array for reduced stiffnessmatrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: columnIndex_reduced
        INTEGER(KIND=4):: ID_columnIndex_reduced=4
        !coordinates of the Mesh
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: COORDSGLOBAL
        INTEGER(KIND=4):: ID_COORDSGLOBAL=5
        !element connection :element dof <-> global dof label
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: element_to_global_dof
        INTEGER(KIND=4):: ID_element_to_global_dof=6
        !element connection :element dof <-> reduced system dof
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: element_to_reduced_dof
        INTEGER(KIND=4):: ID_element_to_reduced_dof=7
        !element stiffnessmatrix to k_matrix_values
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: values_to_global_reduced
        INTEGER(KIND=4):: ID_values_to_global_reduced=8
        !conntection element <-> material label
        INTEGER(KIND=4),DIMENSION(:),POINTER:: element_to_material
        INTEGER(KIND=4):: ID_element_to_material=9
        !connection: node label <-> slave label
        INTEGER(KIND=4),DIMENSION(:),POINTER:: global_node_to_slave_node
        INTEGER(KIND=4):: ID_global_node_to_slave_node=10
        !volume of the RVE (including holes, pores etc.)
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: RVE_Volume
        INTEGER(KIND=4):: ID_RVE_Volume=11
        !permutation matrix
        INTEGER(KIND=4),DIMENSION(:),POINTER:: perm
        INTEGER(KIND=4):: ID_perm=12
        !array containing the modes for the reduced order modeling
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: ROM_modes
        INTEGER(KIND=4):: ID_ROM_modes=13
        !ID of scalar array (array containing scalars)
        INTEGER(KIND=4):: ID_scalars=14
        !array containing a set of materialparameters in each row
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: PROPS
        INTEGER(KIND=4):: ID_PROPS=15
        !array containing the Bmatrices of the hyperreduced integration
        !points, or all IPs in training mode
        REAL(KIND=AbqRK),DIMENSION(:,:),POINTER:: B_Matrices
        INTEGER(KIND=4):: ID_B_Matrices=16
        !Array containing the integration point weights of hyperreduced int.
        REAL(KIND=AbqRK),DIMENSION(:),POINTER:: IP_Weights
        INTEGER(KIND=4):: ID_IP_Weights=17
        !Array containing the connection between local and global int. points
        INTEGER(KIND=4),DIMENSION(:,:),POINTER:: integration_points
        INTEGER(KIND=4):: ID_integration_points=18
        !connection hyper element label to global element (set with all elements)
        INTEGER(KIND=4),DIMENSION(:),POINTER:: elem_to_hyper
        INTEGER(KIND=4):: ID_elem_to_hyper=19
        !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_elem, equations_elem
        INTEGER(KIND=4):: ID_ROM_modes_elem=20, ID_equations_elem=21
        !total number of arrays +1
        INTEGER(KIND=4):: ID_total=22
        
        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

    CLASS(meshparameters)::para
    TYPE(analysisparameters)::analysis
    !dummy arrays
    INTEGER, DIMENSION(:),POINTER:: array_int
    REAL(KIND=AbqRK), DIMENSION(:),POINTER:: array_real
    INTEGER:: io_error , read_error,error
    REAL(KIND=AbqRK),DIMENSION(:,:),ALLOCATABLE::prop_new,prop_old
    !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(100):: description
    INTEGER:: e,k,i,j,elem,n_matdef,n_PROPS_max,n,n1,n2,i1,i2,i3,j1,j2,j3,unit_numer
    CHARACTER(len=500),DIMENSION(2):: line
    CHARACTER(len=100),DIMENSION(100):: Keywords
    CHARACTER(len=40),DIMENSION(15),PARAMETER:: NecessaryKeywords=['*PART','*DIMENSION','*ELEMENTNODES','*NODEDOF','*NDOF_MACRO',&
                                                                   '*ELEMENTTYPE','*NODE','*ELEMENT_TO_GLOBAL_DOF','*ELEMENT_TO_REDUCED_DOF',&
                                                                   '*EQUATIONS','*ELEMENT_TO_MATERIAL','*RVE_VOLUME','*MASTER_REDUCED_TO_GLOBAL',&
                                                                   '*GLOBAL_NODE_TO_SLAVE_NODE','*NGP_LOCAL']
    CHARACTER(len=40),DIMENSION(3),PARAMETER:: NecessaryKeywords_SYMM=['*COLUMNINDEX_REDUCED','*ROWINDEX_REDUCED','*VALUES_TO_GLOBAL_REDUCED']
    CHARACTER(len=40),DIMENSION(3),PARAMETER:: NecessaryKeywords_UNSYMM=['*COLUMNINDEX_REDUCED_UNSYMM','*ROWINDEX_REDUCED_UNSYMM',&
                                                                          '*VALUES_TO_GLOBAL_REDUCED_UNSYMM']
    CHARACTER(len=40),DIMENSION(1),PARAMETER:: NecessaryKeywords_ROM=['*ROM_MODES']
    CHARACTER(len=40),DIMENSION(2),PARAMETER:: NecessaryKeywords_hyperreduction=['*INTEGRATION_POINTS','*IP_WEIGHTS']
                                                                          
    !get string of RVE number through internal read
    WRITE(rve_number_str,*) para%rve_number
    
    !------------------read meshinformation-------------------------------------
    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,[19],0)
        !set the pointers to the integer array
        para%dimens                 => array_int(1)
        para%nnodes_e               => array_int(2)
        para%ndof_e                 => array_int(3)
        para%ndof_n                 => array_int(4)
        para%ndof_macro             => array_int(5)
        para%nElem                  => array_int(6)
        para%nNodes                 => array_int(7)
        para%JTYPE                  => array_int(8)
        para%nRows_reduced          => array_int(9)
        para%nNonZero_reduced       => array_int(10)
        para%nEquations             => array_int(11)
        para%n_STATEV_elem          => array_int(12)
        para%n_ROM_modes            => array_int(13)
        para%n_matdef               => array_int(14)
        para%n_PROPS_max            => array_int(15)
        para%NGP_hyper              => array_int(16)
        para%NTENS                  => array_int(17)
        para%NGP_local              => array_int(18)
        para%n_elem_to_hyper        => array_int(19)

        read_error=0 !reports whether there was any error during the READ process
        Keywords=''
        k=1 !running index
                    
        DO WHILE (.true.) !do until the end of file is reached
                    
            READ(unit_numer,*,iostat=error) line

            IF (error/=0) THEN
            
                EXIT
            
            ELSE
            
                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))
                    
                    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('*DIMENSION')
                        READ(line(2)(3:),*) para%dimens
                    CASE('*ELEMENTNODES')
                        READ(line(2)(3:),*) para%nnodes_e
                    CASE('*NODEDOF')
                        READ(line(2)(3:),*) para%ndof_n
                    CASE('*NDOF_MACRO')
                        READ(line(2)(3:),*) para%ndof_macro
                    CASE('*ELEMENTTYPE') 
                        READ(line(2),*) para%JTYPE
                    CASE('*NGP_LOCAL') 
                        READ(line(2)(3:),*) para%NGP_local
                    CASE('*NODE')
                        READ(line(2)(3:),*) para%nNodes
                        CALL AbaqusArrayCreate(para%COORDSGLOBAL,-para%ID_total*para%rve_number+para%ID_COORDSGLOBAL,[para%nNodes*para%ndof_n],0.0_AbqRK)
                        DO i=1,para%nNodes
                            IF (error==0) READ(unit_numer,*,iostat=error) para%COORDSGLOBAL((i-1)*para%dimens+1:i*para%dimens)
                        END DO
                    CASE('*ELEMENT_TO_GLOBAL_DOF')
                        READ(line(2)(3:),*) para%nElem
                        para%ndof_e=para%nnodes_e*para%ndof_n
                        CALL AbaqusArrayCreate(para%element_to_global_dof,-para%ID_total*para%rve_number+para%ID_element_to_global_dof,[para%ndof_e,para%nElem],0)
                        DO i=1,para%nElem
                            IF (error==0) READ(unit_numer,*,iostat=error) para%element_to_global_dof(:,i)
                        END DO
                    CASE('*ELEMENT_TO_REDUCED_DOF')
                        READ(line(2)(3:),*) para%nElem
                        para%ndof_e=para%nnodes_e*para%ndof_n
                        CALL AbaqusArrayCreate(para%element_to_reduced_dof,-para%ID_total*para%rve_number+para%ID_element_to_reduced_dof,[para%ndof_e,para%nElem],0)
                        DO i=1,para%nElem
                            IF (error==0) READ(unit_numer,*,iostat=error) para%element_to_reduced_dof(:,i)
                        END DO
                    CASE('*EQUATIONS')
                        READ(line(2)(3:),*) para%nEquations
                        CALL AbaqusArrayCreate(para%Equations,-para%ID_total*para%rve_number+para%ID_Equations,[(2+para%ndof_macro),para%nEquations],0.0_AbqRK)
                        DO i=1,para%nEquations
                            IF (error==0) READ(unit_numer,*,iostat=error) para%Equations(:,i)
                        END DO
                    CASE('*ELEMENT_TO_MATERIAL')
                        READ(line(2)(3:),*) para%nElem
                        CALL AbaqusArrayCreate(para%element_to_material,-para%ID_total*para%rve_number+para%ID_element_to_material,[para%nElem],0)
                        READ (unit_numer,*,iostat=error) para%element_to_material
                    CASE('*RVE_VOLUME')
                        CALL AbaqusArrayCreate(para%RVE_Volume,-para%ID_total*para%rve_number+para%ID_RVE_Volume,[1],0.0_AbqRK)
                        READ(line(2)(3:),*) para%RVE_Volume(1)
                    CASE('*COLUMNINDEX_REDUCED')
                        IF (analysis%symmetric_matrix) THEN
                            READ(line(2)(3:),*) para%nNonZero_reduced
                            CALL AbaqusArrayCreate(para%columnIndex_reduced,-para%ID_total*para%rve_number+para%ID_columnIndex_reduced,[para%nNonZero_reduced],0)
                            READ(unit_numer,*,iostat=error) para%columnIndex_reduced
                        ELSE
                            READ(unit_numer,*) !skip this line
                        END IF
                    CASE('*COLUMNINDEX_REDUCED_UNSYMM')
                        IF (.NOT. analysis%symmetric_matrix) THEN
                            READ(line(2)(3:),*) para%nNonZero_reduced
                            CALL AbaqusArrayCreate(para%columnIndex_reduced,-para%ID_total*para%rve_number+para%ID_columnIndex_reduced,[para%nNonZero_reduced],0)
                            READ(unit_numer,*,iostat=error) para%columnIndex_reduced
                        ELSE
                            READ(unit_numer,*) !skip this line
                        END IF
                    CASE('*ROWINDEX_REDUCED')
                        IF (analysis%symmetric_matrix) THEN
                            READ(line(2)(3:),*) para%nRows_reduced
                            para%nRows_reduced=para%nRows_reduced-1
                            CALL AbaqusArrayCreate(para%rowIndex_reduced,-para%ID_total*para%rve_number+para%ID_rowIndex_reduced,[para%nRows_reduced+1],0)
                            READ(unit_numer,*,iostat=error) para%rowIndex_reduced
                        ELSE
                            READ(unit_numer,*) !skip this line
                        END IF
                    CASE('*ROWINDEX_REDUCED_UNSYMM')
                        IF (.NOT. analysis%symmetric_matrix) THEN
                            READ(line(2)(3:),*) para%nRows_reduced
                            para%nRows_reduced=para%nRows_reduced-1
                            CALL AbaqusArrayCreate(para%rowIndex_reduced,-para%ID_total*para%rve_number+para%ID_rowIndex_reduced,[para%nRows_reduced+1],0)
                            READ(unit_numer,*,iostat=error) para%rowIndex_reduced
                        ELSE
                            READ(unit_numer,*) !skip this line
                        END IF
                    CASE('*VALUES_TO_GLOBAL_REDUCED')
                        READ(line(2)(3:),*) para%nElem
                        IF (analysis%symmetric_matrix) THEN
                            CALL AbaqusArrayCreate(para%values_to_global_reduced,-para%ID_total*para%rve_number+para%ID_values_to_global_reduced,[para%ndof_e**2,para%nElem],0)
                            DO i=1,para%nElem
                                IF (error==0) READ(unit_numer,*,iostat=error) para%values_to_global_reduced(:,i)
                            END DO
                        ELSE
                            DO i=1,para%nElem
                                READ(unit_numer,*) !skip this line
                            END DO
                        END IF
                    CASE('*VALUES_TO_GLOBAL_REDUCED_UNSYMM')
                        READ(line(2)(3:),*) para%nElem
                        IF (.NOT. analysis%symmetric_matrix) THEN
                            CALL AbaqusArrayCreate(para%values_to_global_reduced,-para%ID_total*para%rve_number+para%ID_values_to_global_reduced,[para%ndof_e**2,para%nElem],0)
                            DO i=1,para%nElem
                                IF (error==0) READ(unit_numer,*,iostat=error) para%values_to_global_reduced(:,i)
                            END DO
                        ELSE
                            DO i=1,para%nElem
                                READ(unit_numer,*) !skip this line
                            END DO
                        END IF
                    CASE('*MASTER_REDUCED_TO_GLOBAL')
                        READ(line(2)(3:),*) para%nRows_reduced
                        CALL AbaqusArrayCreate(para%master_reduced_to_global,-para%ID_total*para%rve_number+para%ID_master_reduced_to_global,[para%nRows_reduced],0)
                        READ(unit_numer,*,iostat=error) para%master_reduced_to_global
                    CASE('*GLOBAL_NODE_TO_SLAVE_NODE')
                        CALL AbaqusArrayCreate(para%global_node_to_slave_node,-para%ID_total*para%rve_number+para%ID_global_node_to_slave_node,[para%nNodes*para%ndof_n],0)
                        READ(unit_numer,*,iostat=error) para%global_node_to_slave_node
                    CASE('*USER_MATERIAL')
                    para%n_PROPS_max=0
                        READ(line(2)(3:),*) para%n_matdef
                        DO i=1,para%n_matdef
                            READ(unit_numer,*,iostat=error) line
                            CALL To_upper(line(1)) !convert to upper cases
                            IF (line(1)(1:9)/='*MATERIAL') THEN
                                read_error=1
                            END IF
                            READ(line(1)(11:),*) n_matdef !materialdefinition number
                            READ(line(2)(3:),*) n_PROPS_max !number of properties of material slot 
                            IF (n_matdef>para%n_matdef) THEN
                                read_error=1
                                EXIT
                            END IF
                            IF (n_PROPS_max+1>para%n_PROPS_max) para%n_PROPS_max=n_PROPS_max+1
                            IF (ALLOCATED(prop_new)) DEALLOCATE(prop_new)
                            ALLOCATE(prop_new(para%n_matdef,para%n_PROPS_max))
                            IF (ALLOCATED(prop_old)) prop_new(:,1:SIZE(prop_old,2))=prop_old
                            prop_new(n_matdef,1)=n_PROPS_max
                            READ(unit_numer,*,iostat=error) prop_new(n_matdef,2:n_PROPS_max+1)
                            IF (ALLOCATED(prop_old)) DEALLOCATE(prop_old);ALLOCATE(prop_old(para%n_matdef,para%n_PROPS_max))
                            prop_old=prop_new
                        END DO
                        CALL AbaqusArrayCreate(para%PROPS,-para%ID_total*para%rve_number+para%ID_PROPS,[para%n_matdef,para%n_PROPS_max],0.0_AbqRK)
                        para%PROPS=prop_new
                        IF (ALLOCATED(prop_new)) DEALLOCATE(prop_new)
                        IF (ALLOCATED(prop_old)) DEALLOCATE(prop_old)
                        !------------------------get n_STATEV_elem------------------------------
    
                        !get n_STATEV_elem (number of sol. dep. state variables of one micro element)
                        n2=0
                        DO i=1,para%n_matdef
                            CALL GET_n_STATEV_elem(n1,para%JTYPE,para%PROPS(i,2:int(para%PROPS(i,1)+1)),para%PROPS(i,1),para%NTENS)
                            IF (n1>n2) n2=n1
                        END DO
                        para%n_STATEV_elem=n2
                    CASE('*ROM_MODES')
                        READ(line(2)(3:),*) para%n_ROM_modes
                        IF (analysis%solving_process==1) THEN
                            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)
                            DO i=1,para%n_ROM_modes
                                IF (error==0) READ(unit_numer,*,iostat=error) para%ROM_modes(:,i)
                            END DO
                        ELSE IF (analysis%solving_process==0) THEN
                            DO i=1,para%n_ROM_modes
                                READ(unit_numer,*) !skip this line
                            END DO
                        END IF
                    CASE('*INTEGRATION_POINTS')
                        IF (analysis%hyperintegration) THEN
                            CALL AbaqusArrayCreate(para%integration_points,-para%ID_total*para%rve_number+para%ID_integration_points,[para%NGP_local,para%nElem],0)
                            READ(unit_numer,*,iostat=error) para%integration_points
                        ELSE
                            READ(unit_numer,*)
                        END IF
                    CASE('*IP_WEIGHTS')
                        READ(line(2)(3:),*) para%NGP_hyper
                        IF (analysis%hyperintegration) THEN
                            CALL AbaqusArrayCreate(para%IP_Weights,-para%ID_total*para%rve_number+para%ID_IP_Weights,[para%NGP_hyper],0.0_AbqRK)
                            READ(unit_numer,*,iostat=error) para%IP_Weights
                        ELSE
                            READ(unit_numer,*) !skip this line
                        END IF
                    CASE DEFAULT
                        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 IF
        END DO
        
        CLOSE (unit=unit_numer) !close file
        
        IF (analysis%training==1) THEN
            IF (ASSOCIATED(para%B_Matrices) .OR. ASSOCIATED(para%IP_Weights) .OR. ASSOCIATED(para%integration_points)) THEN
                CALL STDB_ABQERR(-3_AbqIK,  'RVE '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' already trained.', 0_AbqIK , 0.0_AbqRK, ' ')
            END IF
        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)))) read_error=1
        END DO
        IF (analysis%symmetric_matrix==1) THEN
            DO i=1,SIZE(NecessaryKeywords_SYMM)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_SYMM(i)))) read_error=1
            END DO
        ELSE
            DO i=1,SIZE(NecessaryKeywords_UNSYMM)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_UNSYMM(i)))) read_error=1
            END DO
        END IF
        IF (analysis%solving_process==1) THEN
            DO i=1,SIZE(NecessaryKeywords_ROM)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_ROM(i)))) read_error=1
            END DO
        END IF
        IF (analysis%hyperintegration==1) THEN
            DO i=1,SIZE(NecessaryKeywords_hyperreduction)
                IF (NOT(ANY(Keywords(1:k)==NecessaryKeywords_hyperreduction(i)))) read_error=1
            END DO
        END IF

        !display an error and stop the simulation IF an error has been reported
        IF (read_error==1) CALL STDB_ABQERR(-3_AbqIK,  'An error in the '//JOBNAME(1:LENJOBNAME)//'.FE'//&
                                TRIM(ADJUSTL(rve_number_str))//' inputfile has been found.', 0_AbqIK , 0.0_AbqRK, ' ')
        
        IF (analysis%hyperintegration) THEN
            CALL AbaqusArrayCreate(para%B_Matrices,-para%ID_total*para%rve_number+para%ID_B_Matrices,[para%NGP_hyper,para%NTENS*para%ndof_e],0.0_AbqRK)
            para%n_elem_to_hyper=0
            DO e=1,para%nElem
                IF (ANY(para%integration_points(:,e)>0)) para%n_elem_to_hyper=para%n_elem_to_hyper+1
            END DO
            CALL AbaqusArrayCreate(para%elem_to_hyper,-para%ID_total*para%rve_number+para%ID_elem_to_hyper,[para%n_elem_to_hyper],0)
            elem=0
            DO e=1,para%nElem
                IF (ANY(para%integration_points(:,e)>0)) THEN
                   elem=elem+1
                   para%elem_to_hyper(elem)=e
                END IF
            END DO
        ELSE
            para%NGP_hyper=para%nElem*para%NGP_local
            CALL AbaqusArrayCreate(para%B_Matrices,-para%ID_total*para%rve_number+para%ID_B_Matrices,[para%NGP_hyper,para%NTENS*para%ndof_e],0.0_AbqRK)
            CALL AbaqusArrayCreate(para%IP_Weights,-para%ID_total*para%rve_number+para%ID_IP_Weights,[para%NGP_hyper],0.0_AbqRK)
            CALL AbaqusArrayCreate(para%integration_points,-para%ID_total*para%rve_number+para%ID_integration_points,[para%NGP_local,para%nElem],0)
            i=1
            DO e=1,para%nElem
                DO k=1,para%NGP_local
                    para%integration_points(k,e)=i
                    i=i+1
                END DO
            END DO
            para%n_elem_to_hyper=para%nElem
            CALL AbaqusArrayCreate(para%elem_to_hyper,-para%ID_total*para%rve_number+para%ID_elem_to_hyper,[para%n_elem_to_hyper],0)
            FORALL(i=1:para%nElem) para%elem_to_hyper(i)=i
        END IF
        
        !permutationmatrix for reducing the bandwitdh
        IF (analysis%solving_process==0) 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
        
        !mark the RVE definition as active
        analysis%active_RVE_definitions(1)=analysis%active_RVE_definitions(1)+1
        
        !in hyperreduced simulation compute ROM_modes_elem and equations_elem needed for assemble
        IF  (analysis%solving_process==1)  THEN
            CALL AbaqusArrayCreate(para%ROM_modes_elem,-para%ID_total*para%rve_number+para%ID_ROM_modes_elem,[para%ndof_e,para%n_ROM_modes,para%n_elem_to_hyper],0.0_AbqRK)
            CALL AbaqusArrayCreate(para%equations_elem,-para%ID_total*para%rve_number+para%ID_equations_elem,[para%ndof_e,para%ndof_macro,para%n_elem_to_hyper],0.0_AbqRK)
            
            DO elem=1,para%n_elem_to_hyper
                e=para%elem_to_hyper(elem)
                DO i=1,para%ndof_e
                    i1=para%element_to_reduced_dof(i,e)
                    i2=para%element_to_global_dof(i,e)
                    i3=para%global_node_to_slave_node(i2)
                    IF (i1/=0) para%ROM_modes_elem(i,:,elem)=para%ROM_modes(ABS(i1),:) !ROM Mode of element dof
                    IF (i3>0) para%equations_elem(i,:,elem)=para%Equations(3:,i3) !equations of element dof
                END DO
            END DO
        END IF
        
    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
    
    !-check if the RVE meshdata has been read before, if not stop the analysis-
    IF (para%rve_number>analysis%active_RVE_definitions(1) .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,[19])
        
    para%dimens                 => array_int(1)
    para%nnodes_e               => array_int(2)
    para%ndof_e                 => array_int(3)
    para%ndof_n                 => array_int(4)
    para%ndof_macro             => array_int(5)
    para%nElem                  => array_int(6)
    para%nNodes                 => array_int(7)
    para%JTYPE                  => array_int(8)
    para%nRows_reduced          => array_int(9)
    para%nNonZero_reduced       => array_int(10)
    para%nEquations             => array_int(11)
    para%n_STATEV_elem          => array_int(12)
    para%n_ROM_modes            => array_int(13)
    para%n_matdef               => array_int(14)
    para%n_PROPS_max            => array_int(15)
    para%NGP_hyper              => array_int(16)
    para%NTENS                  => array_int(17)
    para%NGP_local              => array_int(18)
    para%n_elem_to_hyper        => array_int(19)
    
    CALL AbaqusArrayAccess(para%RVE_Volume,-para%ID_total*para%rve_number+para%ID_RVE_Volume,[1])
    
    CALL AbaqusArrayAccess(para%COORDSGLOBAL,-para%ID_total*para%rve_number+para%ID_COORDSGLOBAL,[para%nNodes*para%dimens])
    
    CALL AbaqusArrayAccess(para%master_reduced_to_global,-para%ID_total*para%rve_number+para%ID_master_reduced_to_global,[para%nRows_reduced])
    
    CALL AbaqusArrayAccess(para%element_to_global_dof,-para%ID_total*para%rve_number+para%ID_element_to_global_dof,[para%ndof_e,para%nElem])
    
    CALL AbaqusArrayAccess(para%element_to_reduced_dof,-para%ID_total*para%rve_number+para%ID_element_to_reduced_dof,[para%ndof_e,para%nElem])
    
    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])
    
    CALL AbaqusArrayAccess(para%values_to_global_reduced,-para%ID_total*para%rve_number+para%ID_values_to_global_reduced,[para%ndof_e**2,para%nElem])
    
    CALL AbaqusArrayAccess(para%Equations,-para%ID_total*para%rve_number+para%ID_Equations,[(2+para%ndof_macro),para%nEquations])
    
    CALL AbaqusArrayAccess(para%element_to_material,-para%ID_total*para%rve_number+para%ID_element_to_material,[para%nElem])
    
    CALL AbaqusArrayAccess(para%global_node_to_slave_node,-para%ID_total*para%rve_number+para%ID_global_node_to_slave_node,[para%nNodes*para%ndof_n])
    
    CALL AbaqusArrayAccess(para%PROPS,-para%ID_total*para%rve_number+para%ID_PROPS,[para%n_matdef,para%n_PROPS_max])
    
    IF (analysis%solving_process==0) THEN
        CALL AbaqusArrayAccess(para%perm,-para%ID_total*para%rve_number+para%ID_perm,[para%nRows_reduced])
    ELSE IF (analysis%solving_process==1) THEN
        CALL AbaqusArrayAccess(para%ROM_modes,-para%ID_total*para%rve_number+para%ID_ROM_modes,[para%nRows_reduced,para%n_ROM_modes])
        CALL AbaqusArrayAccess(para%ROM_modes_elem,-para%ID_total*para%rve_number+para%ID_ROM_modes_elem,[para%ndof_e,para%n_ROM_modes,para%n_elem_to_hyper])
        CALL AbaqusArrayAccess(para%equations_elem,-para%ID_total*para%rve_number+para%ID_equations_elem,[para%ndof_e,para%ndof_macro,para%n_elem_to_hyper])
    END IF
    
    CALL AbaqusArrayAccess(para%elem_to_hyper,-para%ID_total*para%rve_number+para%ID_elem_to_hyper,[para%n_elem_to_hyper])
    CALL AbaqusArrayAccess(para%B_Matrices,-para%ID_total*para%rve_number+para%ID_B_Matrices,[para%NGP_hyper,para%NTENS*para%ndof_e])
    CALL AbaqusArrayAccess(para%IP_Weights,-para%ID_total*para%rve_number+para%ID_IP_Weights,[para%NGP_hyper])
    CALL AbaqusArrayAccess(para%integration_points,-para%ID_total*para%rve_number+para%ID_integration_points,[para%NGP_local,para%nElem])
    
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
    TYPE(analysisparameters),INTENT(IN)::analysis
        
    CALL AbaqusArrayDelete(para%Equations,-para%ID_total*para%rve_number+para%ID_Equations)
    CALL AbaqusArrayDelete(para%master_reduced_to_global,-para%ID_total*para%rve_number+para%ID_master_reduced_to_global)
    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)
    CALL AbaqusArrayDelete(para%COORDSGLOBAL,-para%ID_total*para%rve_number+para%ID_COORDSGLOBAL)
    CALL AbaqusArrayDelete(para%element_to_global_dof,-para%ID_total*para%rve_number+para%ID_element_to_global_dof)
    CALL AbaqusArrayDelete(para%element_to_reduced_dof,-para%ID_total*para%rve_number+para%ID_element_to_reduced_dof)
    CALL AbaqusArrayDelete(para%values_to_global_reduced,-para%ID_total*para%rve_number+para%ID_values_to_global_reduced)
    CALL AbaqusArrayDelete(para%element_to_material,-para%ID_total*para%rve_number+para%ID_element_to_material)
    CALL AbaqusArrayDelete(para%global_node_to_slave_node,-para%ID_total*para%rve_number+para%ID_global_node_to_slave_node)
    CALL AbaqusArrayDelete(para%RVE_Volume,-para%ID_total*para%rve_number+para%ID_RVE_Volume)
    CALL AbaqusArrayDelete(para%PROPS,-para%ID_total*para%rve_number+para%ID_PROPS)
    IF (analysis%solving_process==0) THEN
        CALL AbaqusArrayDelete(para%perm,-para%ID_total*para%rve_number+para%ID_perm)
    ELSE IF (analysis%solving_process==1) THEN
        CALL AbaqusArrayDelete(para%ROM_modes,-para%ID_total*para%rve_number+para%ID_ROM_modes)
        CALL AbaqusArrayDelete(para%ROM_modes_elem,-para%ID_total*para%rve_number+para%ID_ROM_modes_elem)
        CALL AbaqusArrayDelete(para%equations_elem,-para%ID_total*para%rve_number+para%ID_equations_elem)
    END IF
    CALL AbaqusArrayDelete(para%elem_to_hyper,-para%ID_total*para%rve_number+para%ID_elem_to_hyper)
    CALL AbaqusArrayDelete(para%B_Matrices,-para%ID_total*para%rve_number+para%ID_B_Matrices)
    CALL AbaqusArrayDelete(para%IP_Weights,-para%ID_total*para%rve_number+para%ID_IP_Weights)
    CALL AbaqusArrayDelete(para%integration_points,-para%ID_total*para%rve_number+para%ID_integration_points)
    CALL AbaqusArrayDelete(array_int,-para%ID_total*para%rve_number+para%ID_scalars)
    
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
