FEDEM Solver  R8.0
Source code of the dynamics solver
Data Types | Functions/Subroutines | Variables
sysmatrixtypemodule Module Reference

Module with data types and utility subroutines for system matrices. More...

Data Types

type  skylinestoragetype
 Data type for skyline matrix storage. More...
 
type  sparsestoragetype
 Data type for sparse matrix storage (SPR solver). More...
 
type  gsfstoragetype
 Data type for sparse matrix storage (GSF solver). More...
 
type  pardisostoragetype
 Data type for sparse matrix storage (PARDISO solver). More...
 
type  sysmatrixtype
 Data type for a system coefficient matrix. More...
 
interface  reallocate
 Reallocates a data object. More...
 
interface  check
 Performs consistency checking of a data object. More...
 
interface  writeobject
 Standard routine for writing an object to file. More...
 

Functions/Subroutines

logical function isallocated (this)
 Checks if a system matrix object is allocated or not. More...
 
subroutine nullifysysmatrix (this)
 Initializes a system matrix object. More...
 
subroutine sharematrixstructure (this, that, needsFactorization, newType, ierr)
 Lets one system matrix object share the data structure of another. More...
 
subroutine allocatesysmatrix (sysMat, ierr, lpu, chName)
 Allocates storage for a system matrix. More...
 
subroutine deallocatesysmatrix (this, ierr)
 Deallocates all dynamic arrays for a system matrix object. More...
 
subroutine, private reallocatesysmat (label, this, newAlloc, ierr)
 Allocates, reallocates or deallocates a system matrix object. More...
 
subroutine, private reallocateskyline (label, this, newAlloc, ierr)
 Allocates, reallocates or deallocates a skyline storage object. More...
 
subroutine, private reallocatesparse (label, this, nspar, ierr)
 Allocates, reallocates or deallocates a sparse storage object. More...
 
subroutine, private reallocategsf (label, this, newAlloc, ierr)
 Allocates, reallocates or deallocates a GSF storage object. More...
 
subroutine, private reallocatepardiso (label, this, newAlloc, ierr)
 Allocates, reallocates or deallocates a Pardiso storage object. More...
 
subroutine, private checksysmatstorage (sysMat, mpar, lpu, ierr)
 Performs consistency checking of a system matrix storage structure. More...
 
subroutine, private checkskylinestorage (skyline, mpar, lpu, ierr)
 Performs consistency checking of the skyline data structure. More...
 
subroutine, private checksparsestorage (sparse, mpar, lpu, ierr)
 Performs consistency checking of the sparse data structure. More...
 
subroutine, private checkpardisostorage (sparse, lpu, ierr)
 Performs consistency checking of the sparse data structure. More...
 
subroutine, private checkgsfstorage (gsf, lpu, ierr)
 Performs consistency checking of the GSF data structure. More...
 
integer function checkgsfinfo (INFO, gsf)
 Inspects the GSF error flag and outputs the error messages, if any. More...
 
subroutine convertsysmat (this, fullMat, ndim, startRow, ksa, ierr)
 Converts the given system matrix into a full rectangular matrix. More...
 
subroutine, private writesysmat (this, mpar, io, text, nelL, complexity)
 Standard routine for writing an object to file. More...
 
subroutine writesysmat2 (this, io, text, complexity)
 Standard routine for writing an object to file. More...
 
subroutine, private writeskymat (matrix, skyline, io, nelLin, complexity)
 Writes out a skyline matrix, column by column. More...
 
subroutine, private writesparsemat (matrix, sparse, io, nelLin, complexity)
 Writes out a sparse matrix, row by row. More...
 
subroutine, private writesparsestructure (this, io, complexity, label)
 Standard routine for writing an object to file. More...
 
subroutine, private writepardisomat (matrix, sparse, io, nelLin, complexity)
 Writes out a sparse matrix, row by row. More...
 
subroutine extractdiagonal (this, diag, ierr)
 Extracts the diagonal elements from the given system matrix. More...
 
subroutine savesysmat (this, name, nWord, iFile, ierr)
 Saves the given system matrix to temporary file. More...
 
subroutine restoresysmat (this, name, nWord, iFile, ierr)
 Restores the given system matrix from temporary file. More...
 
subroutine asmsparse (EM, MEEN, MEQN, MPMCEQ, MMCEQ, TTCC, A, IA, JA, B, ierr)
 Adds matrix elements corresponding to free and constrained DOFs. More...
 

Variables

integer, parameter nbp_p = 8
 Number of bytes in a pointer variable. More...
 
integer, parameter diagonalmatrix_p = 0
 Diagonal format. More...
 
integer, parameter skylinematrix_p = 1
 Skyline format. More...
 
integer, parameter sparsematrix_p = 2
 Sparse format using SPR solver. More...
 
integer, parameter densematrix_p = 3
 Dense format using LAPACK solver. More...
 
integer, parameter outofcore_p = 4
 Sparse format using GSF solver. More...
 
integer, parameter pardiso_p = 5
 Sparse format using PARDISO. More...
 
character(len=18), dimension(0:5), parameter matrixtype_p = (/ 'diagonal matrix ', 'skyline matrix ', 'sparse matrix ', 'dense matrix ', 'out of core matrix', 'sparse matrix ' /)
 System matrix type springs. More...
 
integer(ik), parameter nspar_p = 60_ik
 Size of control array MSPAR. More...
 
type(error_flag), pointer, save gsfinfo
 Error flag for the GSF solver. More...
 

Detailed Description

Module with data types and utility subroutines for system matrices.

This module contains data types representing system matrices with various storage schemes, and associated utility subroutines for data access. In order of increased memory usage, the following formats are covered:

Function/Subroutine Documentation

◆ allocatesysmatrix()

subroutine sysmatrixtypemodule::allocatesysmatrix ( type(sysmatrixtype), intent(inout)  sysMat,
integer, intent(inout)  ierr,
integer, intent(in), optional  lpu,
character(len=*), intent(in), optional  chName 
)

Allocates storage for a system matrix.

Parameters
sysMatThe sysmatrixtypemodule::sysmatrixtype object to allocate for
ierrError flag
[in]lpuFile unit number for res-file output
[in]chNameHeading for storage requirement print

The storage requirement is optionally written out to lpu

Author
Knut Morten Okstad
Date
4 Mar 2003
Here is the caller graph for this function:

◆ asmsparse()

subroutine sysmatrixtypemodule::asmsparse ( real(dp), dimension(:,:), intent(in)  EM,
integer, dimension(:), intent(in)  MEEN,
integer, dimension(:), intent(in)  MEQN,
integer, dimension(:), intent(in)  MPMCEQ,
integer, dimension(:), intent(in)  MMCEQ,
real(dp), dimension(:), intent(in)  TTCC,
real(dp), dimension(:), intent(inout)  A,
integer, dimension(:), intent(in)  IA,
integer, dimension(:), intent(in)  JA,
real(dp), dimension(:), intent(inout), optional  B,
integer, intent(out)  ierr 
)

Adds matrix elements corresponding to free and constrained DOFs.

Parameters
[in]EMThe element matrix to add
[in]MEENMatrix of element equation numbers
[in]MEQNMatrix of equation numbers
[in]MPMCEQMatrix of pointers to constraint equations
[in]MMCEQMatrix of constraint equations
[in]TTCCTable of constraint equation coefficients
ASystem matrix coefficients
[in]IAIndex to to the start of each column in A
[in]JARow indices of A
BRight-hand-side vector
[out]IERRError flag

The elements corresponding to free and constrained DOFs of the element matrix EM is added to the sparse system matrix {A,IA,JA} and the associated right-hand-side vector B.

Author
Knut Morten Okstad
Date
12 Feb 2016
Here is the caller graph for this function:

◆ checkgsfinfo()

integer function sysmatrixtypemodule::checkgsfinfo ( type(error_flag), pointer  INFO,
type(gsfstoragetype), intent(in), optional  gsf 
)

Inspects the GSF error flag and outputs the error messages, if any.

Parameters
[in]gsfThe sysmatrixtypemodule::gsfstoragetype to check
INFOError handling object from the GSF package
Returns
Negative value if an error was detected, otherwise zero
Author
Knut Morten Okstad
Date
17 Jul 2005
Here is the caller graph for this function:

◆ checkgsfstorage()

subroutine, private sysmatrixtypemodule::checkgsfstorage ( type(gsfstoragetype), intent(in)  gsf,
integer, intent(in)  lpu,
integer, intent(out)  ierr 
)
private

Performs consistency checking of the GSF data structure.

Parameters
[in]gsfThe sysmatrixtypemodule::gsfstoragetype to check
[in]lpuFile unit number for res-file output
[out]ierrError flag
Author
Knut Morten Okstad
Date
13 Sep 2004
Here is the caller graph for this function:

◆ checkpardisostorage()

subroutine, private sysmatrixtypemodule::checkpardisostorage ( type(pardisostoragetype), intent(in)  sparse,
integer, intent(in)  lpu,
integer, intent(out)  ierr 
)
private

Performs consistency checking of the sparse data structure.

Parameters
[in]sparseThe sysmatrixtypemodule::pardisostoragetype to check
[in]lpuFile unit number for res-file output
[out]ierrError flag
Author
Knut Morten Okstad
Date
10 Feb 2016
Here is the caller graph for this function:

◆ checkskylinestorage()

subroutine, private sysmatrixtypemodule::checkskylinestorage ( type(skylinestoragetype), intent(in)  skyline,
integer, dimension(:), intent(in)  mpar,
integer, intent(in)  lpu,
integer, intent(out)  ierr 
)
private

Performs consistency checking of the skyline data structure.

Parameters
[in]skylineThe sysmatrixtypemodule::skylinestoragetype to check
[in]mparMatrix of parameters
[in]lpuFile unit number for res-file output
[out]ierrError flag
Author
Bjorn Haugen
Date
24 Sep 1998
Here is the caller graph for this function:

◆ checksparsestorage()

subroutine, private sysmatrixtypemodule::checksparsestorage ( type(sparsestoragetype), intent(in)  sparse,
integer, dimension(:), intent(in)  mpar,
integer, intent(in)  lpu,
integer, intent(out)  ierr 
)
private

Performs consistency checking of the sparse data structure.

Parameters
[in]sparseThe sysmatrixtypemodule::sparsestoragetype to check
[in]mparMatrix of parameters
[in]lpuFile unit number for res-file output
[out]ierrError flag
Author
Bjorn Haugen
Date
24 Sep 1998
Here is the caller graph for this function:

◆ checksysmatstorage()

subroutine, private sysmatrixtypemodule::checksysmatstorage ( type(sysmatrixtype), intent(in)  sysMat,
integer, dimension(:), intent(in)  mpar,
integer, intent(in)  lpu,
integer, intent(out)  ierr 
)
private

Performs consistency checking of a system matrix storage structure.

Parameters
[in]sysMatThe sysmatrixtypemodule::sysmatrixtype object to check
[in]mparMatrix of parameters
[in]lpuFile unit number for res-file output
[out]ierrError flag
Author
Knut Morten Okstad
Date
26 Feb 2003

◆ convertsysmat()

subroutine sysmatrixtypemodule::convertsysmat ( type(sysmatrixtype), intent(in)  this,
real(dp), dimension(:,:), intent(out)  fullMat,
integer, intent(in)  ndim,
integer, intent(in)  startRow,
integer, intent(in)  ksa,
integer, intent(out)  ierr 
)

Converts the given system matrix into a full rectangular matrix.

Parameters
[in]thisThe sysmatrixtypemodule::sysmatrixtype object to convert
[out]fullMatRectangular matrix representation of this
[in]ndimMax dimension on fullMat
[in]startRowFirst row in fullMat to insert reactangular matrix
[in]ksaSign of converted matrix
[out]ierrError flag
Author
Knut Morten Okstad
Date
30 Jul 2003
Here is the caller graph for this function:

◆ deallocatesysmatrix()

subroutine sysmatrixtypemodule::deallocatesysmatrix ( type(sysmatrixtype), intent(inout)  this,
integer, intent(inout), optional  ierr 
)

Deallocates all dynamic arrays for a system matrix object.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to deallocate
ierrError flag
Author
Knut Morten Okstad
Date
4 Mar 2003
Here is the caller graph for this function:

◆ extractdiagonal()

subroutine sysmatrixtypemodule::extractdiagonal ( type(sysmatrixtype), intent(inout)  this,
real(dp), dimension(:), intent(out)  diag,
integer, intent(out)  ierr 
)

Extracts the diagonal elements from the given system matrix.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to extract from
[out]diagDiagonal elements of the matrix
[out]ierrError flag
Author
Knut Morten Okstad
Date
23 Mar 2004
Here is the caller graph for this function:

◆ isallocated()

logical function sysmatrixtypemodule::isallocated ( type(sysmatrixtype), intent(in)  this)

Checks if a system matrix object is allocated or not.

Parameters
[in]thisThe sysmatrixtypemodule::sysmatrixtype object to check
Here is the caller graph for this function:

◆ nullifysysmatrix()

subroutine sysmatrixtypemodule::nullifysysmatrix ( type(sysmatrixtype), intent(out)  this)

Initializes a system matrix object.

Parameters
[out]thisThe sysmatrixtypemodule::sysmatrixtype object to nullify
Author
Knut Morten Okstad
Date
4 Mar 2003
Here is the caller graph for this function:

◆ reallocategsf()

subroutine, private sysmatrixtypemodule::reallocategsf ( character(len=*), intent(in)  label,
type(gsfstoragetype), pointer  this,
logical, intent(in), optional  newAlloc,
integer, intent(inout), optional  ierr 
)
private

Allocates, reallocates or deallocates a GSF storage object.

Parameters
[in]labelText label used for logging of dynamic memory use
thisThe sysmatrixtypemodule::gsfstoragetype object to allocate
[in]newAllocIf .true., a new system matrix is allocated
ierrError flag

If reallocated, the existing contents is lost.

Author
Knut Morten Okstad
Date
8 Sep 2004
Here is the caller graph for this function:

◆ reallocatepardiso()

subroutine, private sysmatrixtypemodule::reallocatepardiso ( character(len=*), intent(in)  label,
type(pardisostoragetype), pointer  this,
logical, intent(in), optional  newAlloc,
integer, intent(inout), optional  ierr 
)
private

Allocates, reallocates or deallocates a Pardiso storage object.

Parameters
[in]labelText label used for logging of dynamic memory use
thisThe sysmatrixtypemodule::pardisostoragetype object to allocate
[in]newAllocIf .true., a new system matrix is allocated
ierrError flag

If reallocated, the existing contents is lost.

Author
Knut Morten Okstad
Date
10 Feb 2016
Here is the caller graph for this function:

◆ reallocateskyline()

subroutine, private sysmatrixtypemodule::reallocateskyline ( character(len=*), intent(in)  label,
type(skylinestoragetype), pointer  this,
logical, intent(in), optional  newAlloc,
integer, intent(inout), optional  ierr 
)
private

Allocates, reallocates or deallocates a skyline storage object.

Parameters
[in]labelText label used for logging of dynamic memory use
thisThe sysmatrixtypemodule::skylinestoragetype object to allocate
[in]newAllocIf .true., a new system matrix is allocated
ierrError flag

If reallocated, the existing contents is lost.

Author
Knut Morten Okstad
Date
20 Jan 2003
Here is the caller graph for this function:

◆ reallocatesparse()

subroutine, private sysmatrixtypemodule::reallocatesparse ( character(len=*), intent(in)  label,
type(sparsestoragetype), pointer  this,
integer(ik), intent(in), optional  nspar,
integer, intent(inout), optional  ierr 
)
private

Allocates, reallocates or deallocates a sparse storage object.

Parameters
[in]labelText label used for logging of dynamic memory use
thisThe sysmatrixtypemodule::sparsestoragetype object to allocate
[in]nsparSize of the control array mspar
ierrError flag

If reallocated, the existing contents is lost.

Author
Knut Morten Okstad
Date
20 Jan 2003
Here is the caller graph for this function:

◆ reallocatesysmat()

subroutine, private sysmatrixtypemodule::reallocatesysmat ( character(len=*), intent(in)  label,
type(sysmatrixtype), pointer  this,
logical, intent(in), optional  newAlloc,
integer, intent(inout), optional  ierr 
)
private

Allocates, reallocates or deallocates a system matrix object.

Parameters
[in]labelText label used for logging of dynamic memory use
thisThe sysmatrixtypemodule::sysmatrixtype object to allocate
newAllocIf .true., a new system matrix is allocated
ierrError flag

If reallocated, the existing contents is lost.

Author
Knut Morten Okstad
Date
27 Feb 2003

◆ restoresysmat()

subroutine sysmatrixtypemodule::restoresysmat ( type(sysmatrixtype), intent(inout)  this,
character(len=*), intent(in)  name,
integer(i8), intent(in)  nWord,
integer, intent(inout)  iFile,
integer, intent(out)  ierr 
)

Restores the given system matrix from temporary file.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to restore
[in]nameName tag of matrix
[in]nWordNumber of real words in the matrix to restore
[in]iFileFile handle to restore from
[out]ierrError flag
Author
Knut Morten Okstad
Date
21 Sep 2004
Here is the caller graph for this function:

◆ savesysmat()

subroutine sysmatrixtypemodule::savesysmat ( type(sysmatrixtype), intent(in)  this,
character(len=*), intent(in)  name,
integer(i8), intent(in)  nWord,
integer, intent(out)  iFile,
integer, intent(out)  ierr 
)

Saves the given system matrix to temporary file.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to save
[in]nameName tag of matrix
[in]nWordNumber of real words in the matrix to save
[out]iFileHandle of the file the matrix is written to
[out]ierrError flag
Author
Knut Morten Okstad
Date
21 Sep 2004
Here is the caller graph for this function:

◆ sharematrixstructure()

subroutine sysmatrixtypemodule::sharematrixstructure ( type(sysmatrixtype), intent(out)  this,
type(sysmatrixtype), intent(in)  that,
logical, intent(in), optional  needsFactorization,
integer, intent(in), optional  newType,
integer, intent(out), optional  ierr 
)

Lets one system matrix object share the data structure of another.

Parameters
[out]thisThe sysmatrixtypemodule::sysmatrixtype object to share data structures from
[in]thatThe sysmatrixtypemodule::sysmatrixtype object to initialize data structures from
[in]needsFactorizationIf .true., this is going to be factorized
[in]newTypeMatrix type of this
[out]ierrError flag
Author
Knut Morten Okstad
Date
20 Mar 2003
Here is the caller graph for this function:

◆ writepardisomat()

subroutine, private sysmatrixtypemodule::writepardisomat ( real(dp), dimension(:), intent(in)  matrix,
type(pardisostoragetype), intent(in)  sparse,
integer, intent(in)  io,
integer, intent(in), optional  nelLin,
integer, intent(in), optional  complexity 
)
private

Writes out a sparse matrix, row by row.

Parameters
[in]matrixThe values of the sparse matrix
[in]sparsesysmatrixtypemodule::pardisostoragetype object associated with the matrix
[in]ioFile unit number to write to
[in]nelLinNumber of lines per matrix to write
[in]complexityIf present, the value indicates the amount of print
Author
Knut Morten Okstad
Date
10 Feb 2016

◆ writeskymat()

subroutine, private sysmatrixtypemodule::writeskymat ( real(dp), dimension(:), intent(in)  matrix,
type(skylinestoragetype), intent(in)  skyline,
integer, intent(in)  io,
integer, intent(in), optional  nelLin,
integer, intent(in), optional  complexity 
)
private

Writes out a skyline matrix, column by column.

Parameters
[in]matrixThe values of the skyline matrix
[in]skylinesysmatrixtypemodule::skylinestoragetype object associated with the matrix
[in]ioFile unit number to write to
[in]nelLinNumber of lines per matrix to write
[in]complexityIf present, the value indicates the amount of print
Author
Knut Morten Okstad
Date
27 Aug 2001

◆ writesparsemat()

subroutine, private sysmatrixtypemodule::writesparsemat ( real(dp), dimension(:), intent(in)  matrix,
type(sparsestoragetype), intent(in)  sparse,
integer, intent(in)  io,
integer, intent(in), optional  nelLin,
integer, intent(in), optional  complexity 
)
private

Writes out a sparse matrix, row by row.

Parameters
[in]matrixThe values of the sparse matrix
[in]sparsesysmatrixtypemodule::sparsestoragetype object associated with the matrix
[in]ioFile unit number to write to
[in]nelLinNumber of lines per matrix to write
[in]complexityIf present, the value indicates the amount of print
Author
Knut Morten Okstad
Date
11 Mar 2003

◆ writesparsestructure()

subroutine, private sysmatrixtypemodule::writesparsestructure ( type(sparsestoragetype), intent(in)  this,
integer, intent(in)  io,
integer, intent(in), optional  complexity,
character(*), intent(in), optional  label 
)
private

Standard routine for writing an object to file.

Parameters
[in]thisThe sysmatrixtypemodule::sparsestoragetype object to write
[in]ioFile unit number to write to
[in]complexityIf present, the value indicates the amount of print
[in]labelIf present, print out as matrix label
Author
Knut Morten Okstad
Date
25 Apr 2003
Here is the caller graph for this function:

◆ writesysmat()

subroutine, private sysmatrixtypemodule::writesysmat ( type(sysmatrixtype), intent(inout)  this,
integer, dimension(:), intent(in)  mpar,
integer, intent(in)  io,
character(len=*), intent(in), optional  text,
integer, intent(in), optional  nelL,
integer, intent(in), optional  complexity 
)
private

Standard routine for writing an object to file.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to write
[in]mparMatrix of parameters
[in]ioFile unit number to write to
[in]textIf present, write as heading
[in]nelLNumber of matrix elements to write per line
[in]complexityIf present, the value indicates the amount of print
Author
Knut Morten Okstad
Date
26 Feb 2003

◆ writesysmat2()

subroutine sysmatrixtypemodule::writesysmat2 ( type(sysmatrixtype), intent(in)  this,
integer, intent(in)  io,
character(len=*), intent(in), optional  text,
integer, intent(in), optional  complexity 
)

Standard routine for writing an object to file.

Parameters
thisThe sysmatrixtypemodule::sysmatrixtype object to write
[in]ioFile unit number to write to
[in]textIf present, write as heading
[in]complexityIf present, the value indicates the amount of print

This subroutine only writes the data structure for sparse matrix.

Author
Knut Morten Okstad
Date
26 Feb 2003

Variable Documentation

◆ densematrix_p

integer, parameter sysmatrixtypemodule::densematrix_p = 3

Dense format using LAPACK solver.

◆ diagonalmatrix_p

integer, parameter sysmatrixtypemodule::diagonalmatrix_p = 0

Diagonal format.

◆ gsfinfo

type(error_flag), pointer, save sysmatrixtypemodule::gsfinfo

Error flag for the GSF solver.

◆ matrixtype_p

character(len=18), dimension(0:5), parameter sysmatrixtypemodule::matrixtype_p = (/ 'diagonal matrix ', 'skyline matrix ', 'sparse matrix ', 'dense matrix ', 'out of core matrix', 'sparse matrix ' /)

System matrix type springs.

◆ nbp_p

integer parameter sysmatrixtypemodule::nbp_p = 8

Number of bytes in a pointer variable.

◆ nspar_p

integer(ik), parameter sysmatrixtypemodule::nspar_p = 60_ik

Size of control array MSPAR.

◆ outofcore_p

integer, parameter sysmatrixtypemodule::outofcore_p = 4

Sparse format using GSF solver.

◆ pardiso_p

integer, parameter sysmatrixtypemodule::pardiso_p = 5

Sparse format using PARDISO.

◆ skylinematrix_p

integer, parameter sysmatrixtypemodule::skylinematrix_p = 1

Skyline format.

◆ sparsematrix_p

integer, parameter sysmatrixtypemodule::sparsematrix_p = 2

Sparse format using SPR solver.