diff --git a/CMakeLists.txt b/CMakeLists.txt index 800609607..94924e7a5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -18,6 +18,7 @@ cmake_minimum_required(VERSION 3.20.0 FATAL_ERROR) set(PROJECT_NAME "easifemClasses") project(${PROJECT_NAME}) + enable_language(Fortran C CXX) set(VERSION_MAJOR "24") diff --git a/src/modules/AbstractDomain/CMakeLists.txt b/src/modules/AbstractDomain/CMakeLists.txt new file mode 100644 index 000000000..aae80c3b2 --- /dev/null +++ b/src/modules/AbstractDomain/CMakeLists.txt @@ -0,0 +1,19 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} PRIVATE ${src_path}/AbstractDomain_Class.F90) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 new file mode 100644 index 000000000..c4dc43f57 --- /dev/null +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -0,0 +1,1723 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! update: +! - 12 Nov 2021 +! - 4 Nov 2022 +! summary: This module contains methods for domain data type + +MODULE AbstractDomain_Class +USE GlobalData, ONLY: DFP, I4B, LGT +USE BaseType, ONLY: CSRSparsity_, CSRMatrix_, BoundingBox_ +USE String_Class, ONLY: String +USE AbstractMesh_Class, ONLY: AbstractMesh_ +USE HDF5File_Class, ONLY: HDF5File_ +USE tomlf, ONLY: toml_table +USE TxtFile_Class, ONLY: TxtFile_ +USE ExceptionHandler_Class, ONLY: e +USE Kdtree2_Module, ONLY: Kdtree2_, Kdtree2Result_ + +IMPLICIT NONE +PRIVATE + +PUBLIC :: AbstractDomain_ +PUBLIC :: AbstractDomainPointer_ +PUBLIC :: AbstractDomainDeallocate +PUBLIC :: AbstractDomainSetSparsity + +CHARACTER(*), PARAMETER :: modName = "AbstractDomain_Class" + +!---------------------------------------------------------------------------- +! AbstractDomain_ +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-31 +! summary: AbstractDomain_ contains finite element mesh data of a domain +! +!{!pages/docs-api/AbstractDomain/AbstractDomain_.md!} + +TYPE, ABSTRACT :: AbstractDomain_ + PRIVATE + LOGICAL(LGT) :: showTime = .FALSE. + !! set to true if you want to show time taken by various routines. + LOGICAL(LGT) :: isInitiated = .FALSE. + !! flag + TYPE(String) :: engine + !! Engine used for generating the meshes + INTEGER(I4B) :: majorVersion = 0 + !! Major version + INTEGER(I4B) :: minorVersion = 0 + !! Minor version + REAL(DFP) :: version = 0.0_DFP + !! Version MajorVersion.MinorVersion + INTEGER(I4B) :: nsd = 0_I4B + !! number of spatial dimension + INTEGER(I4B) :: maxNptrs = 0 + !! Largest node number in the domain + INTEGER(I4B) :: minNptrs = 0 + !! Smallest node number in the domain + INTEGER(I4B) :: tNodes = 0 + !! Total number of nodes in the mesh + LOGICAL(I4B) :: isNodeNumberSparse = .FALSE. + !! True if node numbers are not continuous + INTEGER(I4B) :: maxElemNum = 0 + !! Largest element number in the domain + INTEGER(I4B) :: minElemNum = 0 + !! Smallest element number in the domain + LOGICAL(LGT) :: isElemNumberSparse = .FALSE. + !! True if element numbers are sparse + INTEGER(I4B) :: tEntitiesForNodes = 0 + !! Total number of entities required for reading nodes + INTEGER(I4B) :: tEntitiesForElements = 0 + !! Total number of entities required for reading elements + INTEGER(I4B) :: tElements(0:3) = [0, 0, 0, 0] + !! Total number of elements inside the domain + !! tElements( 0 ) = total number of point elements + !! tElements( 1 ) = total number of line elements + !! tElements( 2 ) = total number of surface elements + !! tElements( 3 ) = total number of volume/cell elements + INTEGER(I4B) :: tEntities(0:3) = [0, 0, 0, 0] + !! Total number of entities inside the domain + !! tEntities( 0 ) = total number of point mesh entities, mesh of Points + !! tEntities( 1 ) = total number of line mesh entities, mesh of Edge + !! tEntities( 2 ) = total number of surface mesh entities, mesh Boundary + !! tEntities( 3 ) = total number of volume mesh entities, Omega + REAL(DFP), ALLOCATABLE :: nodeCoord(:, :) + !! Nodal coordinates in XiJ format + !! Number of rows are 3, and number of columns is total nodes + + CLASS(AbstractMesh_), POINTER :: meshVolume => NULL() + !! meshVolume list of meshes of volume entities + CLASS(AbstractMesh_), POINTER :: meshSurface => NULL() + !! meshSurface list of meshes of surface entities + CLASS(AbstractMesh_), POINTER :: meshCurve => NULL() + !! meshCurve list of meshes of curve entities + CLASS(AbstractMesh_), POINTER :: meshPoint => NULL() + !! meshPoint list of meshes of point entities + CLASS(AbstractMesh_), POINTER :: mesh => NULL() + !! mesh points to meshVolume for nsd = 3 + !! mesh points to meshSurface for nsd = 2 + !! mesh points to meshCurve for nsd = 1 + !! mesh points to meshPoint for nsd = 0 + + TYPE(Kdtree2_), POINTER :: kdtree => NULL() + TYPE(Kdtree2Result_), ALLOCATABLE :: kdresult(:) + + TYPE(CSRSparsity_) :: meshMap + !! Sparse mesh data in CSR format +CONTAINS + PRIVATE + + ! CONSTRUCTOR: + ! @ConstructorMethods + PROCEDURE, PUBLIC, PASS(obj) :: Initiate => obj_Initiate + !! Initiate an instance of domain + PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => obj_Deallocate + !! Deallocate data stored inside an instance of domain + PROCEDURE, PUBLIC, PASS(obj) :: DeallocateKdtree => obj_DeallocateKdtree + + ! IO: + ! @IOMethods + PROCEDURE, PASS(obj) :: IMPORT => obj_Import + !! Initiates an instance of domain by importing data from meshfile + !! TODO Add an export method to [[obj_]] class + PROCEDURE, PASS(obj) :: ImportFromToml1 => obj_ImportFromToml1 + PROCEDURE, PASS(obj) :: ImportFromToml2 => obj_ImportFromToml2 + GENERIC, PUBLIC :: ImportFromToml => ImportFromToml1, & + & ImportFromToml2 + !! Initiates an instance of domain by importing meshfile name from + !! Toml file + PROCEDURE, PUBLIC, PASS(obj) :: Display => obj_Display + !! TODO Add a display method to [[obj_]] class + PROCEDURE, PUBLIC, PASS(obj) :: DisplayDomainInfo => & + & obj_DisplayDomainInfo + + ! GET: + ! @GetMethods + + PROCEDURE, PUBLIC, PASS(obj) :: IsNodePresent => obj_IsNodePresent + !! Check if a node is present or node in domain + + PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => obj_IsElementPresent + !! Check if an element is present or node in domain + + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => obj_GetConnectivity + !! Get the vertex connectivity + + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity_ => obj_GetConnectivity_ + !! Get the vertex connectivity + + PROCEDURE, PUBLIC, PASS(obj) :: GetNNE => obj_GetNNE + !! Get number of nodes(vertex) in element, size of connectivity + + PROCEDURE, PASS(obj) :: GetNodeToElements1 => obj_GetNodeToElements1 + !! Get the list of elements connnected to a specified node + PROCEDURE, PASS(obj) :: GetNodeToElements2 => obj_GetNodeToElements2 + !! Get the list of elements connnected to many specified nodes + GENERIC, PUBLIC :: GetNodeToElements => & + & GetNodeToElements1, & + & GetNodeToElements2 + !! Generic method to get node to element data + + PROCEDURE, PASS(obj) :: GetNodeToElements1_ => obj_GetNodeToElements1_ + !! Get the list of elements connnected to a specified node + PROCEDURE, PASS(obj) :: GetNodeToElements2_ => obj_GetNodeToElements2_ + !! Get the list of elements connnected to many specified nodes + GENERIC, PUBLIC :: GetNodeToElements_ => & + & GetNodeToElements1_, & + & GetNodeToElements2_ + !! Generic method to get node to element data + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalNodes => obj_GetTotalNodes + !! returns the total number of nodes in the domain, mesh, or part of mesh + PROCEDURE, PASS(obj) :: obj_tNodes1 + !! Returns the total nodes in domain + PROCEDURE, PASS(obj) :: obj_tNodes2 + !! Returns the total nodes in a dimension + GENERIC, PUBLIC :: OPERATOR(.tNodes.) => & + & obj_tNodes1, obj_tNodes2 + !! Generic method for Getting total nodes + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalElements => obj_GetTotalElements + !! returns the total number of Elements in domain, mesh, or part of mesh + + PROCEDURE, PRIVATE, PASS(obj) :: obj_tElements1, obj_tElements2 + !! returns total number of elements in domain, mesh, or part of domain + GENERIC, PUBLIC :: OPERATOR(.tElements.) => obj_tElements1, & + & obj_tElements2 + !! return total number of elements in domain, mesh, or part of domain + + PROCEDURE, PASS(obj) :: GetLocalNodeNumber1 => obj_GetLocalNodeNumber1 + PROCEDURE, PASS(obj) :: GetLocalNodeNumber2 => obj_GetLocalNodeNumber2 + GENERIC, PUBLIC :: & + & GetLocalNodeNumber => & + & GetLocalNodeNumber1, & + & GetLocalNodeNumber2 + PROCEDURE, PASS(obj) :: obj_GetGlobalNodeNumber1 + !! Returns the global node number of a local node number + PROCEDURE, PASS(obj) :: obj_GetGlobalNodeNumber2 + !! Returns the global node number of a local node number + GENERIC, PUBLIC :: GetGlobalNodeNumber => & + & obj_GetGlobalNodeNumber1, & + & obj_GetGlobalNodeNumber2 + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalEntities => obj_GetTotalEntities + !! This routine returns total number of meshes of given dimension + + PROCEDURE, PUBLIC, PASS(obj) :: GetMeshPointer => obj_GetMeshPointer1 + + PROCEDURE, PASS(obj) :: GetNodeCoord1 => obj_GetNodeCoord + !! This routine returns the nodal coordinate in rank2 array + PROCEDURE, PASS(obj) :: GetNodeCoord2 => obj_GetNodeCoord2 + !! This routine returns the nodal coordinate in rank2 array + PROCEDURE, PASS(obj) :: GetNodeCoord3 => obj_GetNodeCoord3 + !! This routine returns the nodal coordinate in rank2 array + GENERIC, PUBLIC :: GetNodeCoord => GetNodeCoord1, GetNodeCoord2, & + GetNodeCoord3 + !! Generic method which returns the nodal coordinates + + PROCEDURE, PUBLIC, PASS(obj) :: GetNodeCoordPointer => & + & obj_GetNodeCoordPointer + !! This routine returns the pointer to nodal coordinate + + PROCEDURE, PUBLIC, PASS(obj) :: GetNearestNode1 => obj_GetNearestNode1 + PROCEDURE, PUBLIC, PASS(obj) :: GetNearestNode2 => obj_GetNearestNode2 + GENERIC, PUBLIC :: GetNearestNode => & + GetNearestNode1, GetNearestNode2 + + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs => obj_GetNptrs + !! returns node number, this is a function + + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs_ => obj_GetNptrs_ + !! returns node number, this is subroutine + + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrsInBox => obj_GetNptrsInBox + !! Get node numbers in the box + + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrsInBox_ => obj_GetNptrsInBox_ + !! Get node numbers in box with allocation + + PROCEDURE, PUBLIC, PASS(obj) :: GetInternalNptrs => & + & obj_GetInternalNptrs + !! returns internal node number + + PROCEDURE, PUBLIC, PASS(obj) :: GetBoundingBox => obj_GetBoundingBox + !! returns bounding box + + PROCEDURE, PUBLIC, PASS(obj) :: GetNSD => obj_GetNSD + !! Returns the spatial dimension of each physical entities + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMeshFacetData => & + & obj_GetTotalMeshFacetData + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial => obj_GetTotalMaterial1 + !! Get total number of materials + + PROCEDURE, PUBLIC, PASS(obj) :: GetUniqueElemType => & + & obj_GetUniqueElemType + !! Returns the unique element type in each mesh + !! The size of returned integer vector can be different from + !! the total number of meshes present in domain. + + PROCEDURE, PUBLIC, PASS(obj) :: GetParam => obj_GetParam + + ! SET: + ! @SetMethods + PROCEDURE, PUBLIC, PASS(obj) :: SetShowTime => obj_SetShowTime + !! Set showTime option + + PROCEDURE, PASS(obj) :: SetSparsity1 => obj_SetSparsity1 + PROCEDURE, NOPASS :: SetSparsity2 => obj_SetSparsity2 + GENERIC, PUBLIC :: SetSparsity => SetSparsity1, SetSparsity2 + + PROCEDURE, PUBLIC, PASS(obj) :: SetTotalMaterial => obj_SetTotalMaterial + !! set the total number of materials + + PROCEDURE, PUBLIC, PASS(obj) :: SetMaterial => obj_SetMaterial + !! set the material + + PROCEDURE, PASS(obj) :: SetNodeCoord1 => obj_SetNodeCoord1 + !! setNodeCoord + GENERIC, PUBLIC :: SetNodeCoord => SetNodeCoord1 + + PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => obj_SetQuality + + ! SET: + ! @MeshDataMethods + PROCEDURE, PUBLIC, PASS(obj) :: InitiateKdtree => obj_InitiateKdtree + !! initiate the kdtree structure + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToElements => & + & obj_InitiateNodeToElements + !! Initiate node to element data + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToNodes => & + & obj_InitiateNodeToNodes + !! Initiate node to node data + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateElementToElements => & + & obj_InitiateElementToElements + !! Initiate element to element data + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateBoundaryData => & + & obj_InitiateBoundaryData + !! Initiate element to element data + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateFacetElements => & + & obj_InitiateFacetElements + !! Initiate element to element data + + PROCEDURE, PUBLIC, PASS(obj) :: InitiateExtraNodeToNodes => & + & obj_InitiateExtraNodeToNodes + !! Initiate extra node to nodes information for edge based methods + + PROCEDURE, PUBLIC, PASS(obj) :: SetFacetElementType => & + & obj_SetFacetElementType + !! Set facet element of meshes + + PROCEDURE, PUBLIC, PASS(obj) :: SetMeshmap => & + & obj_SetMeshmap + PROCEDURE, PUBLIC, PASS(obj) :: SetMeshFacetElement => & + & obj_SetMeshFacetElement + + PROCEDURE, PUBLIC, PASS(obj) :: SetDomainFacetElement => & + & obj_SetDomainFacetElement + !! Set facet element of meshes + +END TYPE AbstractDomain_ + +!---------------------------------------------------------------------------- +! AbstractDomainPointer +!---------------------------------------------------------------------------- + +TYPE :: AbstractDomainPointer_ + CLASS(AbstractDomain_), POINTER :: ptr => NULL() +END TYPE AbstractDomainPointer_ + +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: Initiate the instance of [[AbstractDomain_]] object + +INTERFACE + MODULE SUBROUTINE obj_Initiate(obj, hdf5, group) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! AbstractDomainData object + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + !! HDF5 file + CHARACTER(*), INTENT(IN) :: group + !! Group name (directory name) + END SUBROUTINE obj_Initiate +END INTERFACE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: Deallocate data stored in AbstractDomain object + +INTERFACE AbstractDomainDeallocate + MODULE SUBROUTINE obj_Deallocate(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! AbstractDomain object + END SUBROUTINE obj_Deallocate +END INTERFACE AbstractDomainDeallocate + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-10 +! summary: Deallocate kdtree related data + +INTERFACE + MODULE SUBROUTINE obj_DeallocateKdtree(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! AbstractDomain object + END SUBROUTINE obj_DeallocateKdtree +END INTERFACE + +!---------------------------------------------------------------------------- +! Import@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: Construct an instance of domain by importing data from mesh + +INTERFACE + MODULE SUBROUTINE obj_Import(obj, hdf5, group) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + CHARACTER(*), INTENT(IN) :: group + END SUBROUTINE obj_Import +END INTERFACE + +!---------------------------------------------------------------------------- +! ImportFromToml@IOMethods +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2024-03-28 +! summary: Initiate an instance of domain by importing meshfile name from +! Toml file +! +! NOTE: default meshfile name is "mesh.h5" +! and default group in hdf5 is "" +! +! NOTE: meshfile (hdf5) is internally initiated and is deallocated +! after initiation of domain + +INTERFACE + MODULE SUBROUTINE obj_ImportFromToml1(obj, table) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + TYPE(toml_table), INTENT(INOUT) :: table + END SUBROUTINE obj_ImportFromToml1 +END INTERFACE + +!---------------------------------------------------------------------------- +! ImportFromToml1@IOMethods +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2023-12-20 +! summary: Initiate an instance of domain by importing meshfile name from +! Toml file +! +! NOTE: default meshfile name is "mesh.h5" +! and default group in hdf5 is "" +! +! NOTE: meshfile (hdf5) is internally initiated and is deallocated +! after initiation of domain + +INTERFACE + MODULE SUBROUTINE obj_ImportFromToml2(obj, tomlName, afile, filename, & + & printToml) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: tomlName + TYPE(TxtFile_), OPTIONAL, INTENT(INOUT) :: afile + CHARACTER(*), OPTIONAL, INTENT(IN) :: filename + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: printToml + END SUBROUTINE obj_ImportFromToml2 +END INTERFACE + +!---------------------------------------------------------------------------- +! Display@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the domain + +INTERFACE + MODULE SUBROUTINE obj_Display(obj, msg, unitno) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: msg + INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno + END SUBROUTINE obj_Display +END INTERFACE + +!---------------------------------------------------------------------------- +! DisplayDomainInfo@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the domain + +INTERFACE + MODULE SUBROUTINE obj_DisplayDomainInfo(obj, msg, unitno) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: msg + INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno + END SUBROUTINE obj_DisplayDomainInfo +END INTERFACE + +!---------------------------------------------------------------------------- +! IsNodePresent@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: Returns true if the global node number is present + +INTERFACE + MODULE FUNCTION obj_IsNodePresent(obj, globalNode, islocal) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + LOGICAL(LGT) :: ans + END FUNCTION obj_IsNodePresent +END INTERFACE + +!---------------------------------------------------------------------------- +! IsElementPresent@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-12 +! update: 2021-11-12 +! summary: Returns true if the element number is present inside the domain + +INTERFACE + MODULE FUNCTION obj_IsElementPresent(obj, globalElement, dim, & + & islocal) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + !! Element number + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! Dimension, if dim is present then + !! if dim=0, then search is performed in meshPoint + !! if dim=1, then search is performed in meshCurve + !! if dim=2, then search is performed in meshSurface + !! if dim=3, then search is performed in meshVolume + !! The default value of dim is obj%nsd + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + LOGICAL(LGT) :: ans + END FUNCTION obj_IsElementPresent +END INTERFACE + +!---------------------------------------------------------------------------- +! GetConnectivity@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-12 +! summary: Returns the connectivity vector of a given element number + +INTERFACE + MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + !! Global element number + !! Make sure globalElement is present + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! Dimension, if dim is present then + !! if dim=0, then search is performed in meshPoint + !! if dim=1, then search is performed in meshCurve + !! if dim=2, then search is performed in meshSurface + !! if dim=3, then search is performed in meshVolume + !! The default value of dim is obj%nsd + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! vertex connectivity + END FUNCTION obj_GetConnectivity +END INTERFACE + +!---------------------------------------------------------------------------- +! GetConnectivity@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-12 +! summary: Returns the connectivity vector of a given element number + +INTERFACE + MODULE SUBROUTINE obj_GetConnectivity_(obj, globalElement, ans, tsize, & + dim, islocal) + CLASS(AbstractDomain_), INTENT(IN) :: obj + !! + INTEGER(I4B), INTENT(IN) :: globalElement + !! Global element number + !! Make sure globalElement is present + INTEGER(I4B), INTENT(INOUT) :: ans(:) + !! vertex connectivity + INTEGER(I4B), INTENT(OUT) :: tsize + !! total size + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! Dimension, if dim is present then + !! if dim=0, then search is performed in meshPoint + !! if dim=1, then search is performed in meshCurve + !! if dim=2, then search is performed in meshSurface + !! if dim=3, then search is performed in meshVolume + !! The default value of dim is obj%nsd + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_GetConnectivity_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNNE@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-12 +! summary: Returns the connectivity vector of a given element number + +INTERFACE + MODULE FUNCTION obj_GetNNE(obj, globalElement, dim, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + !! Global element number + !! Make sure globalElement is present + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! Dimension, if dim is present then + !! if dim=0, then search is performed in meshPoint + !! if dim=1, then search is performed in meshCurve + !! if dim=2, then search is performed in meshSurface + !! if dim=3, then search is performed in meshVolume + !! The default value of dim is obj%nsd + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + INTEGER(I4B) :: ans + !! vertex connectivity + END FUNCTION obj_GetNNE +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node +! +!# Introduction +! +! For obj%nsd = 3, we use meshVolume +! For obj%nsd = 2, we use meshSurface +! For obj%nsd = 1, we use meshCurve +! for obj%nsd = 0, we use meshPoint + +INTERFACE + MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! we can init the node to element data if necessary + INTEGER(I4B), INTENT(IN) :: globalNode + INTEGER(I4B), ALLOCATABLE :: ans(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END FUNCTION obj_GetNodeToElements1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node +! +!# Introduction +! +! For obj%nsd = 3, we use meshVolume +! For obj%nsd = 2, we use meshSurface +! For obj%nsd = 1, we use meshCurve +! for obj%nsd = 0, we use meshPoint + +INTERFACE + MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! we can init the node to element data if necessary + INTEGER(I4B), INTENT(IN) :: globalNode(:) + INTEGER(I4B), ALLOCATABLE :: ans(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END FUNCTION obj_GetNodeToElements2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node +! +!# Introduction +! +! For obj%nsd = 3, we use meshVolume +! For obj%nsd = 2, we use meshSurface +! For obj%nsd = 1, we use meshCurve +! for obj%nsd = 0, we use meshPoint + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToElements1_(obj, ans, tsize, & + globalNode, islocal) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! We can init the node to element + INTEGER(I4B), INTENT(INOUT) :: ans(:) + !! node to elements, it should be atleast tsize long + INTEGER(I4B), INTENT(OUT) :: tsize + !! actual size of ans, it is returned by this routine + INTEGER(I4B), INTENT(IN) :: globalNode + !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! is true it means globalNode is actually local node + END SUBROUTINE obj_GetNodeToElements1_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node +! +!# Introduction +! +! For obj%nsd = 3, we use meshVolume +! For obj%nsd = 2, we use meshSurface +! For obj%nsd = 1, we use meshCurve +! for obj%nsd = 0, we use meshPoint + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToElements2_(obj, ans, tsize, & + globalNode, islocal) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! We can ionit the node to element data + INTEGER(I4B), INTENT(INOUT) :: ans(:) + !! node to elements, it should be atleast tsize long + INTEGER(I4B), INTENT(OUT) :: tsize + !! actual size of ans, it is returned by this routine + INTEGER(I4B), INTENT(IN) :: globalNode(:) + !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! is true it means globalNode is actually local node + END SUBROUTINE obj_GetNodeToElements2_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalNodes@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: Returns the total number of nodes in the domain +! +!# Introduction +! +! This function returns the total number of nodes in a given mesh entity +! The mesh entity is given by its ID and its dimension. +! +! - `entityNum` should not be out of bound +! - `entityNum` is currently not used +! +! Note: If both `dim` and `entityNum` is present then (in future) this +! routine will returns the total nodes in that entity only. + +INTERFACE + MODULE FUNCTION obj_GetTotalNodes(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! dimension of the mesh entity + !! - `dim=0` denotes mesh of point entities + !! - `dim=1` denotes mesh of curve entities + !! - `dim=2` denotes mesh of surface entities + !! - `dim=3` denotes mesh of volume entities + !! If dim is not present then this routine returns obj%tNodes + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalNodes +END INTERFACE + +!---------------------------------------------------------------------------- +! tNodes@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 28 June 2021 +! summary: Returns the total number of nodes in the domain +! +!# Introduction +! +! This function returns the total number of nodes in a given mesh entity +! The mesh entity is given by its ID and its dimension. +! Here, opt = [dim, entityNum] +! +! This function is used for defining an operator [[.tNodes.]] +! +! +! - `dim=0` denotes mesh of point entities +! - `dim=1` denotes mesh of curve entities +! - `dim=2` denotes mesh of surface entities +! - `dim=3` denotes mesh of volume entities +! - `entityNum` should not be out of bound + +INTERFACE + MODULE FUNCTION obj_tNodes1(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B) :: ans + END FUNCTION obj_tNodes1 +END INTERFACE + +!---------------------------------------------------------------------------- +! tNodes@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 28 June 2021 +! summary: Returns the total number of nodes in the domain + +INTERFACE + MODULE FUNCTION obj_tNodes2(obj) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_tNodes2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 28 June 2021 +! summary: Returns the total number of elements in the domain +! +!# Introduction +! +! This function returns the total number of elements in +! +! - entire AbstractDomain +! - selected region of domain +! - The mesh selection can be made by specifying the `dim` and `entityNum` +! +!@note +!@endnote +! +!@warn +! `entityNum` should not be out of bound +!@endwarn +! +!@todo +! +! TODO: Use entityNum in AbstractDomain_GetTotalElements +! +!@endtodo + +INTERFACE + MODULE FUNCTION obj_GetTotalElements(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! dimension of mesh entities + !! `dim=0` denotes mesh of point entities + !! `dim=1` denotes mesh of curve entities + !! `dim=2` denotes mesh of surface entities + !! `dim=3` denotes mesh of volume entities + !! If dim is not present then sum of obj%tElements is returned + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalElements +END INTERFACE + +!---------------------------------------------------------------------------- +! tElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-13 +! summary: Returns total elements in domain + +INTERFACE + MODULE FUNCTION obj_tElements1(obj) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_tElements1 +END INTERFACE + +!---------------------------------------------------------------------------- +! tElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-13 +! summary: Returns total elements in given dimension + +INTERFACE + MODULE FUNCTION obj_tElements2(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B) :: ans + END FUNCTION obj_tElements2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetLocalNodeNumber@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: Returns local node number of a global node number + +INTERFACE + MODULE FUNCTION obj_GetLocalNodeNumber1(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + !! Global node number in mesh of obj%nsd dimension + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + INTEGER(I4B) :: ans + !! Local node number in mesh of obj%nsd dimension + END FUNCTION obj_GetLocalNodeNumber1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetLocalNodeNumber@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: Returns local node number of a global node number + +INTERFACE + MODULE FUNCTION obj_GetLocalNodeNumber2(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + INTEGER(I4B) :: ans(SIZE(globalNode)) + END FUNCTION obj_GetLocalNodeNumber2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalNodeNumber@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: Returns local node number of a global node number + +INTERFACE + MODULE FUNCTION obj_GetGlobalNodeNumber1(obj, localNode) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: localNode + INTEGER(I4B) :: ans + END FUNCTION obj_GetGlobalNodeNumber1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalNodeNumber@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: Returns local node number of a global node number + +INTERFACE + MODULE FUNCTION obj_GetGlobalNodeNumber2(obj, localNode) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: localNode(:) + INTEGER(I4B) :: ans(SIZE(localNode)) + END FUNCTION obj_GetGlobalNodeNumber2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalEntities@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: This function returns the total number of entities +! +!# Introduction +! +! This function returns the total number of mesh +! +! - `dim=0` returns the total number of mesh of point entities +! - `dim=1` returns the total number of mesh of curve entities +! - `dim=2` returns the total number of mesh of surface entities +! - `dim=3` returns the total number of mesh of volume entities + +INTERFACE + MODULE FUNCTION obj_GetTotalEntities(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalEntities +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMeshPointer@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 23 July 2021 +! summary: This rotuine returns mesh pointer +! +!# Introduction +! +! This returns the mesh Entity pointer. +! - dim is the dimension of the mesh; dim=0,1,2,3 corresponds to the point, +! curve, surface, volume meshes. +! - tag, is the number of mesh +! entityNum is not used here + +INTERFACE + MODULE FUNCTION obj_GetMeshPointer1(obj, dim) RESULT(Ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + !! dimension of mesh entity + CLASS(AbstractMesh_), POINTER :: ans + END FUNCTION obj_GetMeshPointer1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeCoord@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 23 July 2021 +! summary: This routine returns the nodal coordinates +! +!# Introduction +! - This routine returns the nodal coordinates in the form of rank2 array. +! - The nodal coordinates are in XiJ, the columns of XiJ denotes the node +! number, and the rows correspond to the component. + +INTERFACE + MODULE SUBROUTINE obj_GetNodeCoord(obj, nodeCoord) + CLASS(AbstractDomain_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) + !! make sure nodeCoord is allocated + END SUBROUTINE obj_GetNodeCoord +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeCoord@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 23 July 2021 +! summary: This routine returns the nodal coordinates +! +!# Introduction +! - This routine returns the nodal coordinates in the form of rank2 array. +! - The nodal coordinates are in XiJ, the columns of XiJ denotes the node +! number, and the rows correspond to the component. + +INTERFACE + MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode, & + & islocal) + CLASS(AbstractDomain_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) + !! It should be allocated by the user. + !! SIZE(nodeCoord, 1) should be atleast obj%nsd + !! Size(nodeCoord, 2) is equal to the size(globalNode) + INTEGER(I4B), INTENT(IN) :: globalNode(:) + !! global node numbers (pointer to nodeCoord) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! if islocal is true then we do not find local node nubmers + !! in this case globalNode implies local node + END SUBROUTINE obj_GetNodeCoord2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeCoord@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-11 +! summary: This routine returns the nodal coordinates +! +!# Introduction +! - This routine returns the nodal coordinates +! - globalNode is global node (pointer to nodeCoord) +! - if islocal is true then globalNode is local node + +INTERFACE + MODULE SUBROUTINE obj_GetNodeCoord3(obj, nodeCoord, globalNode, & + & islocal) + CLASS(AbstractDomain_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: nodeCoord(:) + !! It should be allocated by the user. + !! SIZE(nodeCoord, 1) should be atleast nsd + INTEGER(I4B), INTENT(IN) :: globalNode + !! globalNode number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! if true then globalnode above is local node + END SUBROUTINE obj_GetNodeCoord3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNearestNode@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-11 +! summary: Get nearest node + +INTERFACE + MODULE SUBROUTINE obj_GetNearestNode1(obj, qv, x, globalNode) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + REAL(DFP), INTENT(IN) :: qv(:) + !! Query vector + REAL(DFP), INTENT(INOUT) :: x(:) + !! node coord of nearest node + INTEGER(I4B), INTENT(OUT) :: globalNode + !! globalNode number + END SUBROUTINE obj_GetNearestNode1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNearestNode@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-11 +! summary: Get nearest node + +INTERFACE + MODULE SUBROUTINE obj_GetNearestNode2(obj, qv, x, globalNode, nn) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + REAL(DFP), INTENT(IN) :: qv(:) + !! Query vector + REAL(DFP), INTENT(INOUT) :: x(:, :) + !! node coord of nearest node + !! the size(x, 2) should be atleast nn + INTEGER(I4B), INTENT(INOUT) :: globalNode(:) + !! globalNode number, size of globalNode should be atleast nn + INTEGER(I4B), INTENT(IN) :: nn + !! number of nearest points + END SUBROUTINE obj_GetNearestNode2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeCoordPointer@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 23 July 2021 +! summary: This routine returns the pointer to nodal coordinates +! +!# Introduction +! - This routine returns the pointer to nodal coordinates in the form of +! rank2 array. +! - The nodal coordinates are in XiJ, the columns of XiJ denotes the node +! number, and the rows correspond to the component. + +INTERFACE + MODULE FUNCTION obj_GetNodeCoordPointer(obj) RESULT(ans) + CLASS(AbstractDomain_), TARGET, INTENT(IN) :: obj + REAL(DFP), POINTER :: ans(:, :) + END FUNCTION obj_GetNodeCoordPointer +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2 Sept 2021 +! summary: this routine returns the global node number +! +!# Introduction +! This routine returns the global node number +! xidim is the dimension of the mesh + +INTERFACE + MODULE FUNCTION obj_GetNptrs(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + !! dim = [0, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION obj_GetNptrs +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2 Sept 2021 +! summary: this routine returns the global node number +! +!# Introduction +! This routine returns the global node number +! xidim is the dimension of the mesh + +INTERFACE + MODULE SUBROUTINE obj_GetNptrs_(obj, nptrs, dim) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + INTEGER(I4B), INTENT(IN) :: dim + !! dim = 0 meshPoint is called + !! dim=1 meshCurve is called + !! dim=2, meshSurface is called + !! dim=~3, meshVolume is called + END SUBROUTINE obj_GetNptrs_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2 Sept 2021 +! summary: this routine returns the global node number in a box + +INTERFACE + MODULE SUBROUTINE obj_GetNptrsInBox(obj, box, nptrs, isStrict) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! If Kdtree is not init then we init it + INTEGER(I4B), ALLOCATABLE, INTENT(INOUT) :: nptrs(:) + TYPE(BoundingBox_), INTENT(IN) :: box + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isStrict + !! Default is true + !! If it is true the returned points are strictly inside or on the + !! box, but not outside of it + !! This is because we use radius of bounding box to find the points + !! this is over estimation. + END SUBROUTINE obj_GetNptrsInBox +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2 Sept 2021 +! summary: this routine returns the global node number in a box + +INTERFACE + MODULE SUBROUTINE obj_GetNptrsInBox_(obj, box, nptrs, tnodes, isStrict) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + !! If Kdtree is not init then we init it + TYPE(BoundingBox_), INTENT(IN) :: box + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + !! it should allocated, size of nptrs should be .ge. tnodes + INTEGER(I4B), INTENT(INOUT) :: tnodes + !! total nodes found + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isStrict + !! Default is true + !! If it is true the returned points are strictly inside or on the + !! box, but not outside of it + !! This is because we use radius of bounding box to find the points + !! this is over estimation. + END SUBROUTINE obj_GetNptrsInBox_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetInternalNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2 Sept 2021 +! summary: this routine returns the global node number +! +!# Introduction +! This routine returns the global node number +! xidim is the dimension of the mesh + +INTERFACE + MODULE FUNCTION obj_GetInternalNptrs(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + !! dim = [0, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION obj_GetInternalNptrs +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNSD@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 21 Sept 2021 +! summary: This routine returns the number of spatial dimensions + +INTERFACE + MODULE FUNCTION obj_GetNSD(obj) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_GetNSD +END INTERFACE + +!---------------------------------------------------------------------------- +! GetBoundingBox@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 13 Oct 2021 +! summary: Returns bounding box + +INTERFACE + MODULE FUNCTION obj_GetBoundingBox(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + !! dimension of the mesh + !! if dim is not present then nodeCoord in domain is + !! used for computing the bounding box + TYPE(BoundingBox_) :: ans + END FUNCTION obj_GetBoundingBox +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalMeshFacetData@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 24 May 2022 +! summary: returns size of meshFacetData + +INTERFACE + MODULE FUNCTION obj_GetTotalMeshFacetData(obj, imeshFacetData) & + & RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(IN) :: imeshFacetData + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalMeshFacetData +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalMaterial@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-12-09 +! update: 2021-12-09 +! summary: Returns the materials id of a given medium + +INTERFACE + MODULE FUNCTION obj_GetTotalMaterial1(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalMaterial1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetUniqueElemType@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-23 +! summary: Returns only the unique elements in the meshes of domain + +INTERFACE + MODULE FUNCTION obj_GetUniqueElemType(obj, dim) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION obj_GetUniqueElemType +END INTERFACE + +!---------------------------------------------------------------------------- +! GetParam@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Get the PARAMETER + +INTERFACE + MODULE SUBROUTINE obj_GetParam(obj, isInitiated, engine, majorVersion, & + minorVersion, version, nsd, maxNptrs, minNptrs, tNodes, isNodeNumberSparse, & + maxElemNum, minElemNum, isElemNumberSparse, tEntitiesForNodes, & + tEntitiesForElements, tElements, tEntities, nodeCoord, meshVolume, & + meshSurface, meshCurve, meshPoint, meshMap) + CLASS(AbstractDomain_), INTENT(IN) :: obj + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isInitiated + CHARACTER(*), OPTIONAL, INTENT(INOUT) :: engine + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: majorVersion + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: minorVersion + REAL(DFP), OPTIONAL, INTENT(OUT) :: version + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: nsd + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: maxNptrs + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: minNptrs + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tNodes + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isNodeNumberSparse + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: maxElemNum + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: minElemNum + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isElemNumberSparse + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tEntitiesForNodes + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tEntitiesForElements + INTEGER(I4B), OPTIONAL, INTENT(INOUT) :: tElements(0:3) + INTEGER(I4B), OPTIONAL, INTENT(INOUT) :: tEntities(0:3) + REAL(DFP), OPTIONAL, INTENT(INOUT) :: nodeCoord(:, :) + CLASS(AbstractMesh_), POINTER, OPTIONAL, INTENT(INOUT) :: meshVolume + CLASS(AbstractMesh_), POINTER, OPTIONAL, INTENT(INOUT) :: meshSurface + CLASS(AbstractMesh_), POINTER, OPTIONAL, INTENT(INOUT) :: meshCurve + CLASS(AbstractMesh_), POINTER, OPTIONAL, INTENT(INOUT) :: meshPoint + TYPE(CSRSparsity_), OPTIONAL, INTENT(INOUT) :: meshMap + END SUBROUTINE obj_GetParam +END INTERFACE + +!---------------------------------------------------------------------------- +! SetShowTime@SetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-10 +! summary: Set the showTime + +INTERFACE + MODULE SUBROUTINE obj_SetShowTime(obj, VALUE) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + LOGICAL(LGT), INTENT(IN) :: VALUE + END SUBROUTINE obj_SetShowTime +END INTERFACE + +!---------------------------------------------------------------------------- +! SetSparsity@setMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-31 +! summary: Set sparsity in [[CSRMatrix_]] from [[AbstractDomain_]] + +INTERFACE + MODULE SUBROUTINE obj_SetSparsity1(obj, mat) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + END SUBROUTINE obj_SetSparsity1 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetSparsity@setMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 12 Oct 2021 +! summary: Set sparsity in [[CSRMatrix_]] from [[AbstractDomain_]] + +INTERFACE AbstractDomainSetSparsity + MODULE SUBROUTINE obj_SetSparsity2(domains, mat) + CLASS(AbstractDomainPointer_), INTENT(INOUT) :: domains(:) + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + END SUBROUTINE obj_SetSparsity2 +END INTERFACE AbstractDomainSetSparsity + +!---------------------------------------------------------------------------- +! SetTotalMaterial@setMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-12-09 +! update: 2021-12-09 +! summary: + +INTERFACE + MODULE SUBROUTINE obj_SetTotalMaterial(obj, dim, n) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), INTENT(IN) :: n + END SUBROUTINE obj_SetTotalMaterial +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMaterial@setMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-12-09 +! update: 2021-12-09 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetMaterial(obj, dim, entityNum, & + & medium, material) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: dim + !! dimension of the mesh + INTEGER(I4B), INTENT(IN) :: entityNum + !! entity number + INTEGER(I4B), INTENT(IN) :: medium + !! medium number (like soil, water) + INTEGER(I4B), INTENT(IN) :: material + !! type of medium like clay, sand, water1, water2 + END SUBROUTINE obj_SetMaterial +END INTERFACE + +!---------------------------------------------------------------------------- +! SetNodeCoord@SetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-02-24 +! summary: Set the node coordinate of the domain + +INTERFACE + MODULE SUBROUTINE obj_SetNodeCoord1(obj, nodeCoord, scale, & + & addContribution) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + REAL(DFP), INTENT(IN) :: nodeCoord(:, :) + !! nodal coordinate in xij Format + REAL(DFP), OPTIONAL, INTENT(IN) :: scale + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution + END SUBROUTINE obj_SetNodeCoord1 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetQuality@SetMethods +!---------------------------------------------------------------------------- + +INTERFACE + MODULE SUBROUTINE obj_SetQuality(obj, measures, max_measures, & + & min_measures, dim, entityNum) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: measures(:) + REAL(DFP), INTENT(OUT) :: max_measures(:) + REAL(DFP), INTENT(OUT) :: min_measures(:) + INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim + INTEGER(I4B), OPTIONAL, INTENT(IN) :: entityNum + END SUBROUTINE obj_SetQuality +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateKdtree@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-10 +! summary: Initiate the kd tree + +INTERFACE + MODULE SUBROUTINE obj_InitiateKdtree(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateKdtree +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateNodeToElements@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the node-to-elements data in mesh of domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateNodeToElements(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateNodeToElements +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateNodeToNodes@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the node-to-nodes data in mesh of domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateNodeToNodes(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateNodeToNodes +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateElementToElements@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the element-to-element data in mesh of domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateElementToElements(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateElementToElements +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateBoundaryData@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the boundarydata info in mesh of domain +! +!# Introduction +! +! This routine sets the boundary data info in mesh of domain. +! This routine calls `InitiateBoundarydata` on each mesh +! Then, it calls SetFacetElementType() on domain object. + +INTERFACE + MODULE SUBROUTINE obj_InitiateBoundaryData(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateBoundaryData +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateFacetElements@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the facet elements data in mesh of domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateFacetElements(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateFacetElements +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateExtraNodeToNodes@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 4 Nov 2022 +! summary: This routine sets the node-to-nodes data in mesh of domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateExtraNodeToNodes(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_InitiateExtraNodeToNodes +END INTERFACE + +!---------------------------------------------------------------------------- +! SetFacetElementType@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 14 April 2022 +! summary: This routine sets the domain boundary element for cells and faces +! +!# Introduction +! +! The boudnary element of mesh may not be domain boundary element. This +! is because mesh does not have information of surrounding mesh. Therefore +! for mesh methods there is no distinction between boundary element +! and domain-boundary-element. And mesh-method set all of its boundary-elem +! to domain-elem. +! +! This methods correctly identifies the domain-boundary-element from +! mesh boundary-element. +! In this way mesh-boundary-element, which are not domain-boundary-element +! can be treated as the interface element between two meshes. +! +! This methods needs following information: +! +!- boundary element data should be initiated for each mesh, this means +! a call to InitiateBoundaryElementData is necessary + +INTERFACE + MODULE SUBROUTINE obj_SetFacetElementType(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetFacetElementType +END INTERFACE + +!---------------------------------------------------------------------------- +! SetAbstractDomainFacetElement@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 14 April 2022 +! summary: This routine sets the domain boundary element for cells and faces +! +!# Introduction +! +! This routine sets the domain boundary element for cells and faces. +! +! When we call [InitiateFacetElement](../Mesh/InitiateFacetElement.md) +! for mesh, +! we can only identify boundary-facet-elements (i.e., boundary elements +! of the mesh). +! Moreover, when we call +! [InitiateFacetElement](../Mesh/InitiateFacetElement.md) +! from mesh or domain, all the facet elements are tagged +! as `DOMAIN_BOUNDARY_ELEMENT`. +! +! However, some of these boundary facet-elements will be located at the +! domain’s boundary. These facet elements are called `DOMAIN_BOUNDARY_ELEMENT`. +! +! Some of the facet elements will be at located at the interface of two +! mesh regions, these facet elements are called `BOUNDARY_ELEMENT`. +! +! This method correctly differentiates between `BOUNDARY_ELEMENT` and +! `DOMAIN_BOUNDARY_ELEMENT`. + +INTERFACE + MODULE SUBROUTINE obj_SetDomainFacetElement(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetDomainFacetElement +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMeshmap@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: This routine sets meshMap + +INTERFACE + MODULE SUBROUTINE obj_SetMeshmap(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetMeshmap +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMeshFacetElement@MeshDataMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: This routine sets meshFacetData + +INTERFACE + MODULE SUBROUTINE obj_SetMeshFacetElement(obj) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetMeshFacetElement +END INTERFACE + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END MODULE AbstractDomain_Class diff --git a/src/modules/AbstractKernel/src/AbstractKernel_Class.F90 b/src/modules/AbstractKernel/src/AbstractKernel_Class.F90 index dbada5f09..417d5eee0 100644 --- a/src/modules/AbstractKernel/src/AbstractKernel_Class.F90 +++ b/src/modules/AbstractKernel/src/AbstractKernel_Class.F90 @@ -151,6 +151,8 @@ MODULE AbstractKernel_Class !! algorithm INTEGER(I4B) :: vtkOutputFreq = 0 !! frequency of output with WriteData_vtk + INTEGER(I4B) :: hdfOutputFreq = 0 + !! frequency of output with WriteData_vtk TYPE(String) :: name !! This is the name of the kernel. It can be anything you want. TYPE(String) :: engine diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 9048124ff..8ed51fc21 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -18,7 +18,7 @@ MODULE AbstractMesh_Class USE GlobalData, ONLY: LGT, I4B, DFP USE Files, ONLY: HDF5File_, VTKFile_ -USE BaseType, ONLY: BoundingBox_, CSRMatrix_ +USE BaSetype, ONLY: BoundingBox_, CSRMatrix_ USE ExceptionHandler_Class, ONLY: e USE CPUTime_Class, ONLY: CPUTime_ USE ElemData_Class @@ -36,9 +36,22 @@ MODULE AbstractMesh_Class PUBLIC :: AbstractMeshDisplay PUBLIC :: AbstractMeshGetParam PUBLIC :: AbstractMeshImport +PUBLIC :: AbstractMeshGetFacetConnectivity CHARACTER(*), PARAMETER :: modName = "AbstractMesh_Class" +#ifdef MAX_NODE_TO_NODE +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_NODE = MAX_NODE_TO_NODE +#else +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_NODE = 256 +#endif + +#ifdef MAX_NODE_TO_ELEM +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_ELEM = MAX_NODE_TO_ELEM +#else +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_ELEM = 128 +#endif + !---------------------------------------------------------------------------- ! AbstractMesh_ !---------------------------------------------------------------------------- @@ -64,10 +77,10 @@ MODULE AbstractMesh_Class LOGICAL(LGT) :: isElementToElementsInitiated = .FALSE. !! Element to elements mapping LOGICAL(LGT) :: isEdgeConnectivityInitiated = .FALSE. - !! This is set to true when edge connectivity is initiated + !! This is Set to true when edge connectivity is initiated !! See InitiateEdgeConnectivity method LOGICAL(LGT) :: isFaceConnectivityInitiated = .FALSE. - !! This is set to true when face connectivity is initiated + !! This is Set to true when face connectivity is initiated !! See InitiateFaceConnectivity method LOGICAL(LGT) :: isBoundaryDataInitiated = .FALSE. !! Boundary data @@ -128,17 +141,6 @@ MODULE AbstractMesh_Class !! y coordinate of centroid REAL(DFP) :: z = 0.0 !! z coordinate of centroid - INTEGER(I4B), ALLOCATABLE :: material(:) - !! materials mapped to the mesh - !! material(1) is the material id of medium 1 - !! material(2) is the material id of medium 2 - !! ... - !! material(n) is the material id of medium n - !! - !! For example, soil is a porous medium n = 1, - !! fluid is a medium n =2 - !! then material(1) denotes the type of soil => clay, sand, silt - !! and material(2) denotes the type of fluid, water, oil, air INTEGER(I4B), ALLOCATABLE :: boundingEntity(:) !! Bounding entity numbers of the current entity INTEGER(I4B), ALLOCATABLE :: local_elemNumber(:) @@ -235,7 +237,7 @@ MODULE AbstractMesh_Class & obj_DisplayMeshInfo !! Display mesh statistics - ! SET: + ! Set: ! @NodeDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToElements => & & obj_InitiateNodeToElements @@ -247,29 +249,29 @@ MODULE AbstractMesh_Class & obj_InitiateExtraNodetoNodes !! Initiate Node to nodes mapping (used in jump based FEM) - ! SET: + ! Set: ! @ElementDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateElementToElements => & & obj_InitiateElementToElements !! Initiate element to elements mapping - ! SET: + ! Set: ! @BoundaryDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateBoundaryData => & & obj_InitiateBoundaryData !! Initiate the boundary data - ! SET: + ! Set: ! @EdgeDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateEdgeConnectivity => & & obj_InitiateEdgeConnectivity - ! SET: + ! Set: ! @FaceDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateFaceConnectivity => & & obj_InitiateFaceConnectivity - ! SET: + ! Set: ! @FacetDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateFacetElements => & & obj_InitiateFacetElements @@ -295,9 +297,16 @@ MODULE AbstractMesh_Class PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs => obj_GetNptrs !! Returns the node number of mesh + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs_ => obj_GetNptrs_ + !! This is a subroutine which returns the node number of mesh + PROCEDURE, PUBLIC, PASS(obj) :: GetInternalNptrs => obj_GetInternalNptrs !! Returns a vector of internal node numbers + PROCEDURE, PUBLIC, PASS(obj) :: GetInternalNptrs_ => obj_GetInternalNptrs_ + !! Returns a vector of internal node numbers + !! subroutine version (no allocation) + PROCEDURE, PUBLIC, PASS(obj) :: GetBoundaryNptrs => obj_GetBoundaryNptrs !! Returns a vector of boundary node numbers @@ -310,6 +319,9 @@ MODULE AbstractMesh_Class !! Returns true if a node number is present GENERIC, PUBLIC :: isNodePresent => isNodePresent1, isNodePresent2 + PROCEDURE, PUBLIC, PASS(obj) :: GetNodeMask => obj_GetNodeMask + !! returns the mask for the present of node + PROCEDURE, PUBLIC, PASS(obj) :: isAnyNodePresent => obj_isAnyNodePresent !! Returns true if any of the node number is present @@ -356,6 +368,10 @@ MODULE AbstractMesh_Class & obj_GetConnectivity !! Returns node numbers in an element + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity_ => & + & obj_GetConnectivity_ + !! Returns node numbers in an element + PROCEDURE, PUBLIC, PASS(obj) :: GetNodeConnectivity => & & obj_GetNodeConnectivity !! Returns the node connectivity of the mesh elements @@ -396,10 +412,20 @@ MODULE AbstractMesh_Class !! Returns the local element number of a global element number PROCEDURE, PASS(obj) :: GetNodeToElements1 => obj_GetNodeToElements1 + !! Get list of elements surrounding a single nodes PROCEDURE, PASS(obj) :: GetNodeToElements2 => obj_GetNodeToElements2 + !! Get list of elements surrounding several nodes GENERIC, PUBLIC :: GetNodeToElements => & & GetNodeToElements1, GetNodeToElements2 - !! Returns the element attached to a given global node number + !! Generic method to get elements around node or nodes + + PROCEDURE, PASS(obj) :: GetNodeToElements1_ => obj_GetNodeToElements1_ + !! Get list of elements surrounding a single nodes (no alloc) + PROCEDURE, PASS(obj) :: GetNodeToElements2_ => obj_GetNodeToElements2_ + !! Get list of elements surrounding several nodes (no alloc) + GENERIC, PUBLIC :: GetNodeToElements_ => & + & GetNodeToElements1_, GetNodeToElements2_ + !! Generic method to get elements around node or nodes (no alloc) PROCEDURE, PASS(obj) :: GetNodeToNodes1 => obj_GetNodeToNodes1 !! Returns global node number connected to a given global node @@ -409,6 +435,14 @@ MODULE AbstractMesh_Class & GetNodeToNodes1, GetNodeToNodes2 !! Returns nodes connected to a given node number + PROCEDURE, PASS(obj) :: GetNodeToNodes1_ => obj_GetNodeToNodes1_ + !! Returns global node number connected to a given global node + PROCEDURE, PASS(obj) :: GetNodeToNodes2_ => obj_GetNodeToNodes2_ + !! Returns global node numbers connected to given global node numbers + GENERIC, PUBLIC :: GetNodeToNodes_ => & + & GetNodeToNodes1_, GetNodeToNodes2_ + !! Returns nodes connected to a given node number + PROCEDURE, PUBLIC, PASS(obj) :: GetElementToElements => & & obj_GetElementToElements !! Returns local element number connected to a given local @@ -448,13 +482,8 @@ MODULE AbstractMesh_Class !! Return the local facet id, so that we can Get reference element of !! the facet element - PROCEDURE, PASS(obj) :: obj_GetFacetConnectivity1 - !! Return the node nubmers in the facet element - PROCEDURE, PASS(obj) :: obj_GetFacetConnectivity2 - !! Return the node nubmers in the facet element of a cellElement - GENERIC, PUBLIC :: GetFacetConnectivity => & - & obj_GetFacetConnectivity1, & - & obj_GetFacetConnectivity2 + PROCEDURE, PUBLIC, PASS(obj) :: GetFacetConnectivity => & + & obj_GetFacetConnectivity !! Generic method to Get the connectivity of a facet element PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElementType => & @@ -473,11 +502,21 @@ MODULE AbstractMesh_Class & obj_GetXidimension !! Return the NSD - PROCEDURE, PUBLIC, PASS(obj) :: GetMaterial => obj_GetMaterial + PROCEDURE, PUBLIC, PASS(obj) :: GetMaterial1 => obj_GetMaterial1 + !! returns the material id of a given medium + + PROCEDURE, PUBLIC, PASS(obj) :: GetMaterial2 => obj_GetMaterial2 !! returns the material id of a given medium + !! this is a backward compatibility only + + GENERIC, PUBLIC :: GetMaterial => GetMaterial1, GetMaterial2 + !! Returns the material number - PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial => obj_GetTotalMaterial - !! returns the total material + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial1 => obj_GetTotalMaterial1 + !! returns the total materials in an element + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial2 => obj_GetTotalMaterial2 + !! returns the total material, this is a backward compatibility only + GENERIC, PUBLIC :: GetTotalMaterial => GetTotalMaterial1, GetTotalMaterial2 PROCEDURE, PUBLIC, PASS(obj) :: GetParam => obj_GetParam !! Get parameter of mesh @@ -491,40 +530,53 @@ MODULE AbstractMesh_Class PROCEDURE, PUBLIC, PASS(obj) :: GetMaxNodeNumber => obj_GetMaxNodeNumber !! Get maximum node number - ! SET: + ! Set: ! @SetMethods PROCEDURE, PUBLIC, PASS(obj) :: SetShowTime => obj_SetShowTime !! Set showTime option - PROCEDURE, PASS(obj) :: SetBoundingBox1 => obj_setBoundingBox1 + PROCEDURE, PASS(obj) :: SetBoundingBox1 => obj_SetBoundingBox1 !! Set the bounding box of the mesh - PROCEDURE, PASS(obj) :: SetBoundingBox2 => obj_setBoundingBox2 + PROCEDURE, PASS(obj) :: SetBoundingBox2 => obj_SetBoundingBox2 !! Set the bounding box from the given nodes, and local_nptrs - GENERIC, PUBLIC :: SetBoundingBox => setBoundingBox1, & + GENERIC, PUBLIC :: SetBoundingBox => SetBoundingBox1, & & SetBoundingBox2 !! Set the bounding box - PROCEDURE, PASS(obj) :: SetSparsity1 => obj_setSparsity1 + PROCEDURE, PASS(obj) :: SetSparsity1 => obj_SetSparsity1 !! Set the sparsity of sparse matrix - PROCEDURE, PASS(obj) :: SetSparsity2 => obj_setSparsity2 + PROCEDURE, PASS(obj) :: SetSparsity2 => obj_SetSparsity2 !! Set the sparsity of sparse matrix - PROCEDURE, PASS(obj) :: SetSparsity3 => obj_setSparsity3 + PROCEDURE, PASS(obj) :: SetSparsity3 => obj_SetSparsity3 !! Set the sparsity of sparse matrix - PROCEDURE, PASS(obj) :: SetSparsity4 => obj_setSparsity4 + PROCEDURE, PASS(obj) :: SetSparsity4 => obj_SetSparsity4 !! Set the sparsity of sparse matrix - GENERIC, PUBLIC :: SetSparsity => setSparsity1, setSparsity2, & - & SetSparsity3, setSparsity4 - !! Generic method for setting the sparsity + GENERIC, PUBLIC :: SetSparsity => SetSparsity1, SetSparsity2, & + & SetSparsity3, SetSparsity4 + !! Generic method for Setting the sparsity - PROCEDURE, PUBLIC, PASS(obj) :: SetTotalMaterial => obj_SetTotalMaterial + PROCEDURE, PASS(obj) :: SetTotalMaterial1 => obj_SetTotalMaterial1 !! Adding a material ID of a medium which is mapped to the mesh - PROCEDURE, PUBLIC, PASS(obj) :: SetMaterial => obj_setMaterial + PROCEDURE, PASS(obj) :: SetTotalMaterial2 => obj_SetTotalMaterial2 + !! Adding a material ID of a medium which is mapped to the mesh + GENERIC, PUBLIC :: SetTotalMaterial => SetTotalMaterial1, SetTotalMaterial2 + !! Generic method + + PROCEDURE, PASS(obj) :: SetMaterial1 => obj_SetMaterial1 !! Adding a material ID of a medium which is mapped to the mesh + PROCEDURE, PASS(obj) :: SetMaterial2 => obj_SetMaterial2 + !! Adding a material ID of a medium which is mapped to the mesh + !! This is for backward compatibility only + PROCEDURE, PASS(obj) :: SetMaterial3 => obj_SetMaterial3 + !! Set material to an element + GENERIC, PUBLIC :: SetMaterial => SetMaterial1, SetMaterial2, & + & SetMaterial3 + PROCEDURE, PUBLIC, PASS(obj) :: SetFacetElementType => & & obj_SetFacetElementType !! Set the facet element type of a given cell number - PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => obj_setQuality + PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => obj_SetQuality !! Set mesh quality END TYPE AbstractMesh_ @@ -617,7 +669,7 @@ END SUBROUTINE obj_InitiateDynamicDataStructure ! This routine Initiate the local_nptrs data in mesh. ! This routine also Sets the number of nodes in the mesh (tNodes) ! This routine allocate obj%nodeData -! This routine Set localNodeNum and globalNodeNum data inside the +! This routine Set localNodeNum and globalNode data inside the ! nodeData ! ! @@ -863,9 +915,10 @@ END SUBROUTINE obj_DisplayMeshInfo ! summary: Get number of nodes in element INTERFACE - MODULE FUNCTION obj_GetNNE(obj, globalElement) RESULT(ans) + MODULE FUNCTION obj_GetNNE(obj, globalElement, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans END FUNCTION obj_GetNNE END INTERFACE @@ -946,6 +999,22 @@ MODULE FUNCTION obj_GetNptrs(obj) RESULT(ans) END FUNCTION obj_GetNptrs END INTERFACE +!---------------------------------------------------------------------------- +! GetNptrs@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-29 +! summary: Returns the vector of global node numbers + +INTERFACE + MODULE SUBROUTINE obj_GetNptrs_(obj, nptrs, tsize) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tsize + END SUBROUTINE obj_GetNptrs_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetInternalNptrs@GetMethods !---------------------------------------------------------------------------- @@ -961,6 +1030,21 @@ MODULE FUNCTION obj_GetInternalNptrs(obj) RESULT(ans) END FUNCTION obj_GetInternalNptrs END INTERFACE +!---------------------------------------------------------------------------- +! GetInternalNptrs_@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-29 +! summary: Returns the vector of global node numbers of internal nodes + +INTERFACE + MODULE SUBROUTINE obj_GetInternalNptrs_(obj, nptrs) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + END SUBROUTINE obj_GetInternalNptrs_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetBoundaryNptrs@GetMethods !---------------------------------------------------------------------------- @@ -985,9 +1069,10 @@ END FUNCTION obj_GetBoundaryNptrs ! summary: This function returns true if given global node is a boundary node INTERFACE - MODULE FUNCTION obj_isBoundaryNode(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_isBoundaryNode(obj, globalNode, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isBoundaryNode END INTERFACE @@ -1001,9 +1086,10 @@ END FUNCTION obj_isBoundaryNode ! summary: Returns TRUE if a given global node number is present INTERFACE - MODULE FUNCTION obj_isNodePresent1(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_isNodePresent1(obj, globalNode, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isNodePresent1 END INTERFACE @@ -1017,13 +1103,32 @@ END FUNCTION obj_isNodePresent1 ! summary: Returns TRUE if a given global node number is present INTERFACE - MODULE FUNCTION obj_isNodePresent2(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_isNodePresent2(obj, globalNode, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans(SIZE(globalNode)) END FUNCTION obj_isNodePresent2 END INTERFACE +!---------------------------------------------------------------------------- +! GetNodeMask@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-09 +! summary: Returns a mask vector for presence of nodes + +INTERFACE + MODULE SUBROUTINE obj_GetNodeMask(obj, mask, local_nptrs) + CLASS(AbstractMesh_), INTENT(IN) :: obj + LOGICAL(LGT), INTENT(INOUT) :: mask(:) + !! the size of mask should be more than or equal to the maxNptrs + INTEGER(I4B), OPTIONAL, INTENT(IN) :: local_nptrs(:) + !! additional mapping + END SUBROUTINE obj_GetNodeMask +END INTERFACE + !---------------------------------------------------------------------------- ! isAnyNodePresent@GetMethods !---------------------------------------------------------------------------- @@ -1033,9 +1138,10 @@ END FUNCTION obj_isNodePresent2 ! summary: Returns TRUE if any global node number is present INTERFACE - MODULE FUNCTION obj_isAnyNodePresent(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_isAnyNodePresent(obj, globalNode, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isAnyNodePresent END INTERFACE @@ -1049,9 +1155,10 @@ END FUNCTION obj_isAnyNodePresent ! summary: Returns TRUE if any global node number is present INTERFACE - MODULE FUNCTION obj_isAllNodePresent(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_isAllNodePresent(obj, globalNode, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isAllNodePresent END INTERFACE @@ -1065,10 +1172,11 @@ END FUNCTION obj_isAllNodePresent ! summary: Returns TRUE if a given global Element number is present INTERFACE - MODULE FUNCTION obj_isElementPresent(obj, globalElement) & + MODULE FUNCTION obj_isElementPresent(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isElementPresent END INTERFACE @@ -1086,10 +1194,11 @@ END FUNCTION obj_isElementPresent ! A boundary element is one which contains a boundary node. INTERFACE - MODULE FUNCTION obj_isBoundaryElement(obj, globalElement) & + MODULE FUNCTION obj_isBoundaryElement(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isBoundaryElement END INTERFACE @@ -1110,10 +1219,11 @@ END FUNCTION obj_isBoundaryElement ! no connection with the other mesh. INTERFACE - MODULE FUNCTION obj_isDomainBoundaryElement(obj, globalElement) & + MODULE FUNCTION obj_isDomainBoundaryElement(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_isDomainBoundaryElement END INTERFACE @@ -1245,13 +1355,34 @@ END FUNCTION obj_GetBoundingBox2 ! summary: This routine returns global node numbers in a given global elem INTERFACE - MODULE FUNCTION obj_GetConnectivity(obj, globalElement) RESULT(ans) + MODULE FUNCTION obj_GetConnectivity(obj, globalElement, islocal) & + & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) END FUNCTION obj_GetConnectivity END INTERFACE +!---------------------------------------------------------------------------- +! GetConnectivity@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-12 +! summary: This routine returns global node numbers in a given global elem + +INTERFACE + MODULE SUBROUTINE obj_GetConnectivity_(obj, globalElement, ans, tsize, & + islocal) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + INTEGER(I4B), INTENT(INOUT) :: ans(:) + INTEGER(I4B), INTENT(OUT) :: tsize + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_GetConnectivity_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetNodeConnectivity@GetMethods !---------------------------------------------------------------------------- @@ -1288,9 +1419,11 @@ END SUBROUTINE obj_GetNodeConnectivity ! This function returns the local node numbers from global node numbers. INTERFACE - MODULE FUNCTION obj_GetLocalNodeNumber1(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetLocalNodeNumber1(obj, globalNode, islocal) & + & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans(SIZE(globalNode)) END FUNCTION obj_GetLocalNodeNumber1 END INTERFACE @@ -1304,9 +1437,11 @@ END FUNCTION obj_GetLocalNodeNumber1 ! summary: This routine returns the local node number from a global node number INTERFACE - MODULE FUNCTION obj_GetLocalNodeNumber2(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetLocalNodeNumber2(obj, globalNode, islocal) & + & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans END FUNCTION obj_GetLocalNodeNumber2 END INTERFACE @@ -1333,7 +1468,7 @@ END FUNCTION obj_GetGlobalNodeNumber1 !> authors: Vikas Sharma, Ph. D. ! date: 2024-01-27 -! summary: This routine returns the Global node number from a local node number +! summary: Returns the Global node number from a local node number INTERFACE MODULE FUNCTION obj_GetGlobalNodeNumber2(obj, localNode) RESULT(ans) @@ -1366,7 +1501,7 @@ END FUNCTION obj_GetGlobalElemNumber1 !> authors: Vikas Sharma, Ph. D. ! date: 2024-01-27 -! summary: This routine returns the Global node number from a local node number +! summary: Returns the Global node number from a local node number INTERFACE MODULE FUNCTION obj_GetGlobalElemNumber2(obj, LocalElement) RESULT(ans) @@ -1385,10 +1520,11 @@ END FUNCTION obj_GetGlobalElemNumber2 ! summary: This function returns the local element number INTERFACE - MODULE FUNCTION obj_GetLocalElemNumber1(obj, globalElement) & + MODULE FUNCTION obj_GetLocalElemNumber1(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans(SIZE(globalElement)) END FUNCTION obj_GetLocalElemNumber1 END INTERFACE @@ -1402,10 +1538,11 @@ END FUNCTION obj_GetLocalElemNumber1 ! summary: This function returns the local element number INTERFACE - MODULE FUNCTION obj_GetLocalElemNumber2(obj, globalElement) & + MODULE FUNCTION obj_GetLocalElemNumber2(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans END FUNCTION obj_GetLocalElemNumber2 END INTERFACE @@ -1429,11 +1566,13 @@ END FUNCTION obj_GetLocalElemNumber2 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode) RESULT(ans) - CLASS(AbstractMesh_), INTENT(IN) :: obj + MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) !! A vector of local element number END FUNCTION obj_GetNodeToElements1 @@ -1460,16 +1599,64 @@ END FUNCTION obj_GetNodeToElements1 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode) RESULT(ans) - CLASS(AbstractMesh_), INTENT(IN) :: obj + MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & + & RESULT(ans) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode(:) !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) !! A vector of local element number END FUNCTION obj_GetNodeToElements2 END INTERFACE +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToElements1_(obj, ans, tsize, & + globalNode, islocal) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(INOUT) :: ans(:) + !! node to elements, it should be atleast tsize long + INTEGER(I4B), INTENT(OUT) :: tsize + !! actual size of ans, it is returned by this routine + INTEGER(I4B), INTENT(IN) :: globalNode + !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! is true it means globalNode is actually local node + END SUBROUTINE obj_GetNodeToElements1_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToElements@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: returns the elements connected to a node + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToElements2_(obj, ans, tsize, & + globalNode, islocal) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(INOUT) :: ans(:) + !! node to elements, it should be atleast tsize long + INTEGER(I4B), INTENT(OUT) :: tsize + !! actual size of ans, it is returned by this routine + INTEGER(I4B), INTENT(IN) :: globalNode(:) + !! global node number + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + !! is true it means globalNode is actually local node + END SUBROUTINE obj_GetNodeToElements2_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetNodeToNodes@GetMethods !---------------------------------------------------------------------------- @@ -1492,11 +1679,12 @@ END FUNCTION obj_GetNodeToElements2 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToNodes1(obj, globalNode, includeSelf) & - & RESULT(ans) + MODULE FUNCTION obj_GetNodeToNodes1(obj, globalNode, includeSelf, & + & islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode LOGICAL(LGT), INTENT(IN) :: includeSelf + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) END FUNCTION obj_GetNodeToNodes1 END INTERFACE @@ -1524,15 +1712,83 @@ END FUNCTION obj_GetNodeToNodes1 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToNodes2(obj, globalNode, includeSelf) & - & RESULT(ans) + MODULE FUNCTION obj_GetNodeToNodes2(obj, globalNode, includeSelf, & + & islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) LOGICAL(LGT), INTENT(IN) :: includeSelf + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) END FUNCTION obj_GetNodeToNodes2 END INTERFACE +!---------------------------------------------------------------------------- +! GetNodeToNodes_@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-13 +! summary: Returns the node surrounding a node +! +!# Introduction +! This fucntion returns the vector of node numbers which surrounds a given +! node number `globalNode`. +! - If `includeSelf` is true then, in the returned vector of integer, +! node number globalNode is also present +!- If `includeSelf` is false then, in the returned vector of integer, +! node number `globalNode` is not present +! +!@note +! If the node number `globalNode` is not present in the mesh then the +! returned vector of integer has zero length +!@endnote + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToNodes1_(obj, globalNode, includeSelf, & + & ans, tsize, islocal) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), INTENT(IN) :: includeSelf + INTEGER(I4B), INTENT(INOUT) :: ans(:) + INTEGER(I4B), INTENT(OUT) :: tsize + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_GetNodeToNodes1_ +END INTERFACE + +!---------------------------------------------------------------------------- +! GetNodeToNodes@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Returns the node surrounding a node +! +!# Introduction +! +! This function returns the vector of node numbers which surrounds a given +! node number `globalNode`. +! - If `includeSelf` is true then, in the returned vector of integer, +! node number globalNode is also present +!- If `includeSelf` is false then, in the returned vector of integer, +! node number `globalNode` is not present +! +!@note +! If the node number `globalNode` is not present in the mesh then the +! returned vector of integer has zero length +!@endnote + +INTERFACE + MODULE SUBROUTINE obj_GetNodeToNodes2_(obj, globalNode, includeSelf, & + & ans, tsize, islocal) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), INTENT(IN) :: includeSelf + INTEGER(I4B), INTENT(INOUT) :: ans(:) + INTEGER(I4B), INTENT(OUT) :: tsize + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_GetNodeToNodes2_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetElementToElements@MeshDataMethods !---------------------------------------------------------------------------- @@ -1563,7 +1819,7 @@ END FUNCTION obj_GetNodeToNodes2 INTERFACE MODULE FUNCTION obj_GetElementToElements(obj, globalElement, & - & onlyElements) RESULT(ans) + & onlyElements, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalElement @@ -1573,6 +1829,7 @@ MODULE FUNCTION obj_GetElementToElements(obj, globalElement, & !! about the elements connected to element iel is given !! If onlyElements is present and it is TRUE then only the !! information about the elements connected to element iel is given + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:, :) !! list of elements surrounding elements END FUNCTION obj_GetElementToElements @@ -1606,10 +1863,11 @@ END FUNCTION obj_GetElementToElements !@endnote INTERFACE - MODULE FUNCTION obj_GetBoundaryElementData(obj, globalElement) & + MODULE FUNCTION obj_GetBoundaryElementData(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) END FUNCTION obj_GetBoundaryElementData END INTERFACE @@ -1668,11 +1926,30 @@ END FUNCTION obj_GetXidimension ! summary: Returns the materials id of a given medium INTERFACE - MODULE FUNCTION obj_GetMaterial(obj, medium) RESULT(ans) + MODULE FUNCTION obj_GetMaterial1(obj, medium, globalElement, islocal) & + RESULT(ans) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + INTEGER(I4B) :: ans + END FUNCTION obj_GetMaterial1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMaterial@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Returns the materials id of a given medium + +INTERFACE + MODULE FUNCTION obj_GetMaterial2(obj, medium) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: medium INTEGER(I4B) :: ans - END FUNCTION obj_GetMaterial + END FUNCTION obj_GetMaterial2 END INTERFACE !---------------------------------------------------------------------------- @@ -1684,10 +1961,28 @@ END FUNCTION obj_GetMaterial ! summary: Returns the materials id of a given medium INTERFACE - MODULE FUNCTION obj_GetTotalMaterial(obj) RESULT(ans) + MODULE FUNCTION obj_GetTotalMaterial1(obj, globalElement, islocal) & + RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B) :: ans - END FUNCTION obj_GetTotalMaterial + END FUNCTION obj_GetTotalMaterial1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMaterial@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Returns the materials id of a given medium + +INTERFACE + MODULE FUNCTION obj_GetTotalMaterial2(obj) RESULT(ans) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalMaterial2 END INTERFACE !---------------------------------------------------------------------------- @@ -1847,7 +2142,7 @@ END FUNCTION obj_GetLocalFacetID ! - facetElement is local facet element number INTERFACE - MODULE FUNCTION obj_GetFacetConnectivity1(obj, facetElement, & + MODULE FUNCTION AbstractMeshGetFacetConnectivity(obj, facetElement, & & elementType, isMaster) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement @@ -1860,7 +2155,7 @@ MODULE FUNCTION obj_GetFacetConnectivity1(obj, facetElement, & !! Currently, we do not support slave-cell for meshFacet because !! the slave of meshFacet lives in different instance of obj_ INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION obj_GetFacetConnectivity1 + END FUNCTION AbstractMeshGetFacetConnectivity END INTERFACE !---------------------------------------------------------------------------- @@ -1878,13 +2173,14 @@ END FUNCTION obj_GetFacetConnectivity1 ! - iface is the local face number in globalElement INTERFACE - MODULE FUNCTION obj_GetFacetConnectivity2(obj, globalElement, & - & iface) RESULT(ans) + MODULE FUNCTION obj_GetFacetConnectivity(obj, globalElement, & + & iface, islocal) RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), INTENT(IN) :: iface + LOGICAL(I4B), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION obj_GetFacetConnectivity2 + END FUNCTION obj_GetFacetConnectivity END INTERFACE !---------------------------------------------------------------------------- @@ -1896,10 +2192,11 @@ END FUNCTION obj_GetFacetConnectivity2 ! summary: Returns the facet element type of the cell element number INTERFACE - MODULE FUNCTION obj_GetFacetElementType(obj, globalElement) & + MODULE FUNCTION obj_GetFacetElementType(obj, globalElement, islocal) & & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) END FUNCTION obj_GetFacetElementType END INTERFACE @@ -2025,8 +2322,8 @@ END SUBROUTINE obj_InitiateNodeToElements !- This routine generate the node to nodes mapping !- In other words, it generates info of node-numbers in mesh ! surrounding a node number -!- This mapping is stored inside `obj%nodeData%globalNodeNum` -!- For a local node number i, obj%nodeData(i)%globalNodeNum denotes the +!- This mapping is stored inside `obj%nodeData%globalNode` +!- For a local node number i, obj%nodeData(i)%globalNode denotes the ! global node data surrounding the local node number. !- This list does not include self node. !- This methods needs node-to-elements data, therefore if this data @@ -2240,7 +2537,7 @@ END SUBROUTINE obj_SetBoundingBox2 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2283,7 +2580,7 @@ END SUBROUTINE obj_SetSparsity2 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2298,9 +2595,9 @@ END SUBROUTINE obj_SetSparsity2 MODULE SUBROUTINE obj_SetSparsity3(obj, colMesh, nodeToNode, mat, & & ivar, jvar) CLASS(AbstractMesh_), INTENT(INOUT) :: obj - !! [[Mesh_]] class + !! Abstract mesh class CLASS(AbstractMesh_), INTENT(INOUT) :: colMesh - !! [[Mesh_]] class + !! Abstract mesh class INTEGER(I4B), INTENT(IN) :: nodeToNode(:) !! Node to node connectivity between obj and colMesh TYPE(CSRMatrix_), INTENT(INOUT) :: mat @@ -2311,7 +2608,7 @@ END SUBROUTINE obj_SetSparsity3 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2324,7 +2621,7 @@ END SUBROUTINE obj_SetSparsity3 INTERFACE MODULE SUBROUTINE obj_SetSparsity4(obj, colMesh, nodeToNode, mat, & - & rowGlobalToLocalNodeNum, rowLBOUND, rowUBOUND, colGlobalToLocalNodeNum, & +& rowGlobalToLocalNodeNum, rowLBOUND, rowUBOUND, colGlobalToLocalNodeNum, & & colLBOUND, colUBOUND, ivar, jvar) CLASS(AbstractMesh_), INTENT(INOUT) :: obj !! [[Mesh_]] class @@ -2357,10 +2654,12 @@ END SUBROUTINE obj_SetSparsity4 ! summary: Set the materials id of a given medium INTERFACE - MODULE SUBROUTINE obj_SetTotalMaterial(obj, n) + MODULE SUBROUTINE obj_SetTotalMaterial1(obj, n, globalElement, islocal) CLASS(AbstractMesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: n - END SUBROUTINE obj_SetTotalMaterial + INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_SetTotalMaterial1 END INTERFACE !---------------------------------------------------------------------------- @@ -2372,11 +2671,72 @@ END SUBROUTINE obj_SetTotalMaterial ! summary: Set the materials id of a given medium INTERFACE - MODULE SUBROUTINE obj_SetMaterial(obj, medium, material) + MODULE SUBROUTINE obj_SetTotalMaterial2(obj, n) CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: n + END SUBROUTINE obj_SetTotalMaterial2 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMaterial@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-12-09 +! update: 2021-12-09 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetMaterial1(obj, entityNum, medium, material) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: entityNum + !! entity number INTEGER(I4B), INTENT(IN) :: medium + !! medium number (like soil, water) INTEGER(I4B), INTENT(IN) :: material - END SUBROUTINE obj_SetMaterial + !! type of medium like clay, sand, water1, water2 + END SUBROUTINE obj_SetMaterial1 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMaterial@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetMaterial2(obj, medium, material) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B), INTENT(IN) :: material + END SUBROUTINE obj_SetMaterial2 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMaterial@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-12-09 +! update: 2021-12-09 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetMaterial3(obj, medium, material, globalElement, & + islocal) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: medium + !! medium number (like soil, water) + INTEGER(I4B), INTENT(IN) :: material + !! type of medium like clay, sand, water1, water2 + INTEGER(I4B), INTENT(IN) :: globalElement + !! global element + LOGICAL(LGT), INTENT(IN) :: islocal + !! is global element local + !! we cannot keep it optional for unique interface + END SUBROUTINE obj_SetMaterial3 END INTERFACE !---------------------------------------------------------------------------- @@ -2389,11 +2749,12 @@ END SUBROUTINE obj_SetMaterial INTERFACE MODULE SUBROUTINE obj_SetFacetElementType(obj, globalElement, & - & iface, facetElementType) + & iface, facetElementType, islocal) CLASS(AbstractMesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), INTENT(IN) :: iface INTEGER(I4B), INTENT(IN) :: facetElementType + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal END SUBROUTINE obj_SetFacetElementType END INTERFACE diff --git a/src/modules/AbstractMesh/src/ElemData_Class.F90 b/src/modules/AbstractMesh/src/ElemData_Class.F90 index ff2a704af..19b8aa8b3 100644 --- a/src/modules/AbstractMesh/src/ElemData_Class.F90 +++ b/src/modules/AbstractMesh/src/ElemData_Class.F90 @@ -18,13 +18,12 @@ MODULE ElemData_Class USE GlobalData, ONLY: I4B, DFP, LGT, INT8 USE Display_Method, ONLY: Display -USE ReferenceElement_Method, ONLY: REFELEM_MAX_FACES => & - PARAM_REFELEM_MAX_FACES, & - REFELEM_MAX_POINTS => PARAM_REFELEM_MAX_POINTS, & - RefElemGetGeoParam, ElementName +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES, & + & PARAM_REFELEM_MAX_POINTS, RefElemGetGeoParam, ElementName USE ReferenceQuadrangle_Method, ONLY: HelpFaceData_Quadrangle, & & FaceShapeMetaData_Quadrangle USE SortUtility +USE ReallocateUtility IMPLICIT NONE PRIVATE @@ -41,13 +40,14 @@ MODULE ElemData_Class PUBLIC :: ElemData_SetID PUBLIC :: ElemData_Copy PUBLIC :: ElemData_GetGlobalFaceCon +PUBLIC :: ElemData_SetTotalMaterial INTEGER(I4B), PARAMETER, PUBLIC :: INTERNAL_ELEMENT = 1 INTEGER(I4B), PARAMETER, PUBLIC :: BOUNDARY_ELEMENT = -1 INTEGER(I4B), PARAMETER, PUBLIC :: DOMAIN_BOUNDARY_ELEMENT = -2 INTEGER(I4B), PARAMETER, PUBLIC :: GHOST_ELEMENT = -4 -INTEGER(I4B), PARAMETER :: MAX_NUM_OVERLAPPED_CONTINNUM = 4 +! INTEGER(I4B), PARAMETER :: MAX_NUM_OVERLAPPED_CONTINNUM = 4 INTERFACE Display MODULE PROCEDURE ElemData_Display @@ -85,7 +85,7 @@ MODULE ElemData_Class INTEGER(I4B) :: meshID = 0 !! ID of mesh to which the element belong !! This is a gmsh concept - INTEGER(INT8) :: material(MAX_NUM_OVERLAPPED_CONTINNUM) = 0 + INTEGER(INT8), ALLOCATABLE :: material(:) !! materials mapped to the mesh !! material(1) is the material-id (type of material) of medium 1 !! material(2) is the material-id (type of material) of medium 2 @@ -203,6 +203,11 @@ SUBROUTINE ElemData_Display(obj, msg, unitno) & unitno=unitno) CALL Display(ElementName(obj%name), "elementName: ", unitno=unitno) + ! display material if it is allocated + IF (ALLOCATED(obj%material)) THEN + CALL Display(obj%material, msg="material: ", unitno=unitno) + END IF + ! globalNodes IF (ALLOCATED(obj%globalNodes)) THEN CALL Display(obj%globalNodes, msg="globalNodes: ", unitno=unitno) @@ -276,7 +281,7 @@ SUBROUTINE ElemData_Deallocate(obj) obj%elementType = INTERNAL_ELEMENT obj%name = 0 obj%meshID = 0 - obj%material = 0 + IF (ALLOCATED(obj%material)) DEALLOCATE (obj%material) IF (ALLOCATED(obj%globalNodes)) DEALLOCATE (obj%globalNodes) IF (ALLOCATED(obj%globalEdges)) DEALLOCATE (obj%globalEdges) IF (ALLOCATED(obj%edgeOrient)) DEALLOCATE (obj%edgeOrient) @@ -286,13 +291,43 @@ SUBROUTINE ElemData_Deallocate(obj) IF (ALLOCATED(obj%boundaryData)) DEALLOCATE (obj%boundaryData) END SUBROUTINE ElemData_Deallocate +!---------------------------------------------------------------------------- +! SetTotalMaterial +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2024-04-12 +! summary: Set total number of materials +! +! this subroutine allocates materials in obj + +PURE SUBROUTINE ElemData_SetTotalMaterial(obj, n) + TYPE(ElemData_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: n + + ! internal variables + INTEGER(INT8), ALLOCATABLE :: temp_material(:) + INTEGER(I4B) :: n0 + + IF (ALLOCATED(obj%material)) THEN + n0 = SIZE(obj%material) + CALL Reallocate(temp_material, n0 + n) + temp_material(1:n0) = obj%material(1:n0) + CALL MOVE_ALLOC(from=temp_material, to=obj%material) + + ELSE + CALL Reallocate(obj%material, n) + END IF + +END SUBROUTINE ElemData_SetTotalMaterial + !---------------------------------------------------------------------------- ! ElemDataInitiate !---------------------------------------------------------------------------- PURE SUBROUTINE ElemDataSet(obj, globalElemNum, localElemNum, & & elementType, globalNodes, globalElements, boundaryData, globalEdges, & - & globalFaces, name, isActive, meshID) + & globalFaces, name, isActive, meshID, medium, material, materials) ! obj%elementData(ii)%globalElemNum = elemNumber(ii) ! obj%elementData(ii)%localElemNum = ii ! obj%elementData(ii)%globalNodes = connectivity(:, ii) @@ -319,6 +354,12 @@ PURE SUBROUTINE ElemDataSet(obj, globalElemNum, localElemNum, & LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isActive !! is element active INTEGER(I4B), OPTIONAL, INTENT(IN) :: meshID + INTEGER(I4B), OPTIONAL, INTENT(IN) :: medium + !! medium id like soil,water, etc + INTEGER(I4B), OPTIONAL, INTENT(IN) :: material + !! material like soil1, soil2, wate1, water2, etc + INTEGER(I4B), OPTIONAL, INTENT(IN) :: materials(:) + !! materials IF (PRESENT(globalElemNum)) obj%globalElemNum = globalElemNum IF (PRESENT(localElemNum)) obj%localElemNum = localElemNum @@ -331,6 +372,17 @@ PURE SUBROUTINE ElemDataSet(obj, globalElemNum, localElemNum, & IF (PRESENT(name)) obj%name = name IF (PRESENT(isActive)) obj%isActive = isActive IF (PRESENT(meshID)) obj%meshID = meshID + + ! set obj%material(medium) to material if present + IF (PRESENT(medium) .AND. PRESENT(material)) THEN + obj%material(medium) = INT(material, kind=INT8) + END IF + + ! set materials to obj%material if materials is present + IF (PRESENT(materials)) THEN + obj%material = INT(materials, kind=INT8) + END IF + END SUBROUTINE ElemDataSet !---------------------------------------------------------------------------- @@ -387,8 +439,8 @@ SUBROUTINE ElemData_GetGlobalFaceCon(obj, globalFaceCon, localFaceCon) INTEGER(I4B), INTENT(INOUT) :: globalFaceCon(:, :) INTEGER(I4B), OPTIONAL, INTENT(INOUT) :: localFaceCon(:, :) - INTEGER(I4B) :: tFaces, tNodes, localFaces0(4_I4B, REFELEM_MAX_FACES), & - & faceElemType(REFELEM_MAX_FACES), tFaceNodes(REFELEM_MAX_FACES), & + INTEGER(I4B) :: tFaces, tNodes, localFaces0(4_I4B, PARAM_REFELEM_MAX_FACES), & + & faceElemType(PARAM_REFELEM_MAX_FACES), tFaceNodes(PARAM_REFELEM_MAX_FACES), & & iface, face_temp(4), aint CALL RefElemGetGeoParam(elemType=obj%name, & diff --git a/src/modules/CMakeLists.txt b/src/modules/CMakeLists.txt index 34a2c4b11..66d666a52 100644 --- a/src/modules/CMakeLists.txt +++ b/src/modules/CMakeLists.txt @@ -105,6 +105,18 @@ include(${CMAKE_CURRENT_LIST_DIR}/MeshPointerVector/CMakeLists.txt) # MeshConnectivity # INCLUDE(${CMAKE_CURRENT_LIST_DIR}/MeshConnectivity/CMakeLists.txt) +# MeshFacetData +include(${CMAKE_CURRENT_LIST_DIR}/MeshFacetData/CMakeLists.txt) + +# AbstractDomain +include(${CMAKE_CURRENT_LIST_DIR}/AbstractDomain/CMakeLists.txt) + +# FEDomain +include(${CMAKE_CURRENT_LIST_DIR}/FEDomain/CMakeLists.txt) + +# FEDomainConnectivity +include(${CMAKE_CURRENT_LIST_DIR}/FEDomainConnectivity/CMakeLists.txt) + # Domain include(${CMAKE_CURRENT_LIST_DIR}/Domain/CMakeLists.txt) diff --git a/src/modules/Domain/CMakeLists.txt b/src/modules/Domain/CMakeLists.txt index a3740de65..97f39af87 100644 --- a/src/modules/Domain/CMakeLists.txt +++ b/src/modules/Domain/CMakeLists.txt @@ -1,4 +1,19 @@ -SET(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") -TARGET_SOURCES( - ${PROJECT_NAME} PRIVATE - ${src_path}/Domain_Class.F90) \ No newline at end of file +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} PRIVATE ${src_path}/Domain_Class.F90) diff --git a/src/modules/Domain/src/Domain_Class.F90 b/src/modules/Domain/src/Domain_Class.F90 index 8e16d79ab..869dd115f 100644 --- a/src/modules/Domain/src/Domain_Class.F90 +++ b/src/modules/Domain/src/Domain_Class.F90 @@ -33,6 +33,7 @@ MODULE Domain_Class USE HDF5File_Class USE tomlf, ONLY: toml_table USE TxtFile_Class +USE MeshFacetData_Class IMPLICIT NONE PRIVATE @@ -44,53 +45,6 @@ MODULE Domain_Class CHARACTER(*), PARAMETER :: modName = "Domain_Class" -!---------------------------------------------------------------------------- -! MeshFacetData_ -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 18 May 2022 -! summary: Data storage for mesh-facets -! -!# Introduction -! -! Mesh facet elements are located on mesh boundary which is connected to -! other mesh region. -! -! In this way, the `slaveCell` of a `meshFacet` is inside some other mesh. -! The information of `slaveCell` number will be accessed through the -! Halo of the mesh. -! -! The `halo` of the mesh will be stored inside the instance of `Mesh_` -! -! For each Halo (neighbouring mesh) we have an instance of MeshFacetData_. -! therefore, I have defined MeshFacetData_ as the collection of -! all meshfacets. - -TYPE MeshFacetData_ - INTEGER(I4B) :: masterMesh = 0 - INTEGER(I4B) :: slaveMesh = 0 - INTEGER(I4B), ALLOCATABLE :: masterCellNumber(:) - INTEGER(I4B), ALLOCATABLE :: slaveCellNumber(:) - INTEGER(I4B), ALLOCATABLE :: masterLocalFacetID(:) - INTEGER(I4B), ALLOCATABLE :: slaveLocalFacetID(:) - ! CLASS( Halo_ ), POINTER :: halo => NULL() -CONTAINS - PROCEDURE, PUBLIC, PASS(obj) :: Display => MeshFacetData_Display - PROCEDURE, PUBLIC, PASS(obj) :: Initiate => MeshFacetData_Initiate - PROCEDURE, PUBLIC, PASS(obj) :: isInitiated => MeshFacetData_isInitiated - PROCEDURE, PUBLIC, PASS(obj) :: Size => MeshFacetData_Size - ! PROCEDURE, PUBLIC, PASS( obj ) :: Set => MeshFacet_Set - ! PROCEDURE, PUBLIC, PASS( obj ) :: Size => MeshFacet_Size - ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveCellNumber => & - ! & MeshFacet_SetSlaveCellNumber - ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveLocalFacetID => & - ! & MeshFacet_SetSlaveLocalFacetID - ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveData => & - ! & MeshFacet_SetSlaveData - ! !! -END TYPE MeshFacetData_ - !---------------------------------------------------------------------------- ! Domain_ !---------------------------------------------------------------------------- @@ -361,51 +315,6 @@ MODULE SUBROUTINE Domain_Initiate(obj, hdf5, group) END SUBROUTINE Domain_Initiate END INTERFACE -!---------------------------------------------------------------------------- -! Initaite@ConstructorMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 20 May 2022 -! summary: Initiate an instance of MeshFacetData - -INTERFACE - MODULE SUBROUTINE MeshFacetData_Initiate(obj, n) - CLASS(MeshFacetData_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: n - END SUBROUTINE MeshFacetData_Initiate -END INTERFACE - -!---------------------------------------------------------------------------- -! Initaite@ConstructorMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 24 May 2022 -! summary: Returns true if MeshFacetData initiated - -INTERFACE - MODULE FUNCTION MeshFacetData_isInitiated(obj) RESULT(ans) - CLASS(MeshFacetData_), INTENT(IN) :: obj - LOGICAL(LGT) :: ans - END FUNCTION MeshFacetData_isInitiated -END INTERFACE - -!---------------------------------------------------------------------------- -! Initaite@ConstructorMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 24 May 2022 -! summary: Returns the size of MeshFacetData - -INTERFACE - MODULE FUNCTION MeshFacetData_Size(obj) RESULT(ans) - CLASS(MeshFacetData_), INTENT(IN) :: obj - INTEGER(I4B) :: ans - END FUNCTION MeshFacetData_Size -END INTERFACE - !---------------------------------------------------------------------------- ! Deallocate@ConstructorMethods !---------------------------------------------------------------------------- @@ -547,22 +456,6 @@ MODULE SUBROUTINE Domain_DisplayMeshFacetData(obj, msg, unitno) END SUBROUTINE Domain_DisplayMeshFacetData END INTERFACE -!---------------------------------------------------------------------------- -! Display@IOMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 20 May 2022 -! summary: Display mesh facet data - -INTERFACE - MODULE SUBROUTINE MeshFacetData_Display(obj, msg, unitno) - CLASS(MeshFacetData_), INTENT(IN) :: obj - CHARACTER(*), INTENT(IN) :: msg - INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno - END SUBROUTINE MeshFacetData_Display -END INTERFACE - !---------------------------------------------------------------------------- ! IsNodePresent@GetMethods !---------------------------------------------------------------------------- diff --git a/src/modules/FEDomain/CMakeLists.txt b/src/modules/FEDomain/CMakeLists.txt new file mode 100644 index 000000000..8fd347d8d --- /dev/null +++ b/src/modules/FEDomain/CMakeLists.txt @@ -0,0 +1,19 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} PRIVATE ${src_path}/FEDomain_Class.F90) diff --git a/src/modules/FEDomain/src/FEDomain_Class.F90 b/src/modules/FEDomain/src/FEDomain_Class.F90 new file mode 100644 index 000000000..759537e09 --- /dev/null +++ b/src/modules/FEDomain/src/FEDomain_Class.F90 @@ -0,0 +1,94 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! update: +! - 12 Nov 2021 +! - 4 Nov 2022 +! summary: This module contains methods for domain data type + +MODULE FEDomain_Class +USE AbstractDomain_Class, ONLY: AbstractDomain_ +USE HDF5File_Class, ONLY: HDF5File_ +USE ExceptionHandler_Class, ONLY: e + +IMPLICIT NONE +PRIVATE + +PUBLIC :: FEDomain_ +PUBLIC :: FEDomainPointer_ +PUBLIC :: FEDomain_Pointer + +CHARACTER(*), PARAMETER :: modName = "FEDomain_Class" + +!---------------------------------------------------------------------------- +! FEDomain_ +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: FEDomain_ contains finite element mesh data of a domain +! +!{!pages/docs-api/FEDomain/FEDomain_.md!} + +TYPE, EXTENDS(AbstractDomain_) :: FEDomain_ +END TYPE FEDomain_ + +!---------------------------------------------------------------------------- +! FEDomainPointer +!---------------------------------------------------------------------------- + +TYPE :: FEDomainPointer_ + CLASS(FEDomain_), POINTER :: ptr => NULL() +END TYPE FEDomainPointer_ + +!---------------------------------------------------------------------------- +! Final@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: Finalizer + +INTERFACE + MODULE SUBROUTINE obj_Final(obj) + TYPE(FEDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_Final +END INTERFACE + +!---------------------------------------------------------------------------- +! FEDomain_Pointer@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-28 +! summary: This function returns pointer to a newly constructed FEDomain obj + +INTERFACE FEDomain_Pointer + MODULE FUNCTION obj_Constructor_1(hdf5, group) RESULT(ans) + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + CHARACTER(*), INTENT(IN) :: group + CLASS(FEDomain_), POINTER :: ans + END FUNCTION obj_Constructor_1 +END INTERFACE FEDomain_Pointer + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END MODULE FEDomain_Class diff --git a/src/modules/FEDomainConnectivity/CMakeLists.txt b/src/modules/FEDomainConnectivity/CMakeLists.txt new file mode 100644 index 000000000..29f813ad4 --- /dev/null +++ b/src/modules/FEDomainConnectivity/CMakeLists.txt @@ -0,0 +1,21 @@ +# This program is a part of EASIFEM library Expandable And Scalable +# Infrastructure for Finite Element Methods htttps://www.easifem.com Vikas +# Sharma, Ph.D., vickysharma0812@gmail.com +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} + PRIVATE ${src_path}/FEDomainConnectivity_Class.F90) diff --git a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 new file mode 100644 index 000000000..2d35a596d --- /dev/null +++ b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 @@ -0,0 +1,1216 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: FEDomain connectivity class + +MODULE FEDomainConnectivity_Class +USE GlobalData, ONLY: LGT, DFP, I4B +USE AbstractMesh_Class +USE AbstractDomain_Class +USE ExceptionHandler_Class, ONLY: e + +IMPLICIT NONE + +PRIVATE + +PUBLIC :: FEDomainConnectivity_ +PUBLIC :: FEDomainConnectivityPointer_ +PUBLIC :: FEDomainConnectivityDeallocate + +CHARACTER(*), PARAMETER :: modName = "FEDomainConnectivity_Class" +INTEGER(I4B), PARAMETER :: pType = 1 +INTEGER(I4B), PARAMETER :: hType = 2 +INTEGER(I4B), PARAMETER :: rType = 3 +INTEGER(I4B), PARAMETER :: oversetType = 4 + +#ifdef MAX_NNE +INTEGER(I4B), PARAMETER :: PARAM_MAX_NNE = MAX_NNE +#else +INTEGER(I4B), PARAMETER :: PARAM_MAX_NNE = 128 +#endif + +#ifdef MAX_NODE_TO_ELEM +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_ELEM = MAX_NODE_TO_ELEM +#else +INTEGER(I4B), PARAMETER :: PARAM_MAX_NODE_TO_ELEM = 128 +#endif + +!---------------------------------------------------------------------------- +! FacetConnectivity_ +!---------------------------------------------------------------------------- + +TYPE :: FacetConnectivity_ + INTEGER(I4B) :: facetID = 0 + !! global element number of facet element in facet mesh + INTEGER(I4B) :: GlobalCellData(4, 2) = 0 + !! 1,1 --> Global element number of master cell + !! 2,1 --> master cell's local facet number connected to facet-elem + !! 3,1 --> master mesh dimension + !! 4,1 --> master mesh entity number + !! 1,2 --> Global element number of slave cell + !! 2,2 --> slave cell's local facet number connected to facet-elem + !! 3,2 --> slave mesh dimension + !! 4,2 --> slave mesh entity number +END TYPE FacetConnectivity_ + +!---------------------------------------------------------------------------- +! ElementConnectivity_ +!---------------------------------------------------------------------------- + +TYPE :: ElementConnectivity_ + INTEGER(I4B) :: masterGlobalElemNum = 0 + INTEGER(I4B) :: masterLocalFacetID = 0 + INTEGER(I4B) :: slaveGlobalElemNum = 0 + INTEGER(I4B) :: slaveLocalFacetID = 0 +END TYPE ElementConnectivity_ + +!---------------------------------------------------------------------------- +! FEDomainConnectivity_ +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-03-31 +! summary: This data type contains connectivity data between two [[domain_]] +! +!{!pages/docs-api/FEDomainConnectivity/FEDomainConnectivity_.md!} + +TYPE :: FEDomainConnectivity_ + PRIVATE + LOGICAL(LGT), PUBLIC :: isInitiated = .FALSE. + !! True if an instance of [[FEDomainConnectivity_]] is Initiated + LOGICAL(LGT), PUBLIC :: isFacetToCell = .FALSE. + !! True if FacetToCell data is allocated and Initiated + LOGICAL(LGT), PUBLIC :: isNodeToNode = .FALSE. + !! True if nodeToNode data is Initiate + LOGICAL(LGT), PUBLIC :: isCellToCell = .FALSE. + !! True if elemToElem data is Initiated + INTEGER(I4B), ALLOCATABLE :: nodeToNode(:) + !! Node to node connectivity + !! Size of NodeToNode is equal to the largest node number in + !! domain-1 or mesh-1 (depending upon how the data is Initiated) + !! NodeToNode(i) => global node number in domain-2, corresponding to + !! global node number `i` in domain-1 + INTEGER(I4B), ALLOCATABLE :: cellToCell(:) + !! Cell to cell connectivity + !! CellToCell(ielem) => global elem number in domain-2, + !! corresponding to + !! global node number `ielem` in domain-1 + INTEGER(I4B), ALLOCATABLE :: cellToCellExtraData(:, :) + !! Currently, cellToCellExtraData has two rows + !! the first row is dim + !! the second row is entityNum + !! the column represents the element number + !! example: iel1 in domain1 + !! cellToCell(iel) gives iel2 in domain2 + !! cellToCellExtraData(1, iel1) gives + !! dimension of mesh which contains iel2 + !! cellToCellExtraData(2, iel1) gives + !! entityNum of mesh which contains iel2 + !! In this way, + !! domain2%getFEMeshPointer(dim, entityNum) + !! can give us the pointer to the mesh + !! which contains the iel2 + TYPE(FacetConnectivity_), ALLOCATABLE :: facetToCell(:) + !! Facet connectivity, Facet to cell data + TYPE(ElementConnectivity_), ALLOCATABLE :: elemToElem(:) + !! ElemToElem connectivity data + +CONTAINS + PRIVATE + + ! CONSTRUCTOR: + ! @ConstructorMethods + PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => obj_Deallocate1 + !! Deallocate data stored in the object + FINAL :: obj_Final + !! finalizer + + ! SET: + ! @NodeMethods + + PROCEDURE, PASS(obj) :: InitiateNodeToNodeData1 => & + obj_InitiateNodeToNodeData1 + !! Initiate [[FEDomainConnectivity_:nodeToNode]] + GENERIC, PUBLIC :: InitiateNodeToNodeData => & + InitiateNodeToNodeData1 + !! Initiate [[FEDomainConnectivity_:nodeToNode]] + + PROCEDURE, PUBLIC, PASS(obj) :: GetNodeToNodePointer => & + & obj_GetNodeToNodePointer + !! Return pointer to the [[FEDomainConnectivity_:nodeToNode]] + + ! SET: + ! @CellMethods + + PROCEDURE, PUBLIC, PASS(obj) :: obj_InitiateCellToCellData1 + !! Initiates [[FEDomainConnectivity_:cellToCell]] data + GENERIC, PUBLIC :: InitiateCellToCellData => & + & obj_InitiateCellToCellData1 + !! Initiates [[FEDomainConnectivity_:cellToCell]] data + + PROCEDURE, PUBLIC, PASS(obj) :: GetCellToCellPointer => & + obj_GetCellToCellPointer + !! Return pointer to the [[FEDomainConnectivity_:CellToCell]] + PROCEDURE, PUBLIC, PASS(obj) :: GetDimEntityNum => & + & obj_GetDimEntityNum + !! Returns the dim and entity num of mesh which contains + !! the element (in domain2) which is connected to element + !! in domain 1. + + ! @FacetMethods + PROCEDURE, PASS(obj) :: obj_InitiateFacetToCellData1 + PROCEDURE, PASS(obj) :: obj_InitiateFacetToCellData2 + PROCEDURE, PASS(obj) :: obj_InitiateFacetToCellData3 + PROCEDURE, PASS(obj) :: obj_InitiateFacetToCellData4 + !! Initiate facet to cell connectivity + !! [[FEDomainConnectivity_:facetToCell]] + GENERIC, PUBLIC :: InitiateFacetToCellData => & + & obj_InitiateFacetToCellData1, & + & obj_InitiateFacetToCellData2, & + & obj_InitiateFacetToCellData3, & + & obj_InitiateFacetToCellData4 + !! Initiate facet to cell connectivity + !! [[FEDomainConnectivity_:facetToCell]] + + PROCEDURE, PASS(obj) :: MasterCellNumber1 => obj_MasterCellNumber1 + !! Return the masterCell number of a given facet + PROCEDURE, PASS(obj) :: MasterCellNumber2 => obj_MasterCellNumber2 + !! Return the masterCell numbers of given facet elements + PROCEDURE, PASS(obj) :: MasterCellNumber3 => obj_MasterCellNumber3 + !! Return the masterCell numbers of given facet elements + GENERIC, PUBLIC :: MasterCellNumber => & + & MasterCellNumber1, & + & MasterCellNumber2, & + & MasterCellNumber3 + + PROCEDURE, PUBLIC, PASS(obj) :: GetMasterCellNumber => & + obj_GetMasterCellNumber + + PROCEDURE, PUBLIC, PASS(obj) :: GetSlaveCellNumber => & + obj_GetSlaveCellNumber + + PROCEDURE, PASS(obj) :: SlaveCellNumber1 => obj_SlaveCellNumber1 + !! Return the SlaveCell number of a given facet + PROCEDURE, PASS(obj) :: SlaveCellNumber2 => obj_SlaveCellNumber2 + !! Return the SlaveCell numbers of given facet elements + PROCEDURE, PASS(obj) :: SlaveCellNumber3 => obj_SlaveCellNumber3 + !! Return the SlaveCell numbers of given facet elements + GENERIC, PUBLIC :: SlaveCellNumber => & + SlaveCellNumber1, & + SlaveCellNumber2, & + SlaveCellNumber3 + + PROCEDURE, PASS(obj) :: MasterFacetLocalID1 => obj_MasterFacetLocalID1 + !! Return the facet local id in cell element + PROCEDURE, PASS(obj) :: MasterFacetLocalID2 => obj_MasterFacetLocalID2 + !! Return the facet local id in cell element + PROCEDURE, PASS(obj) :: MasterFacetLocalID3 => obj_MasterFacetLocalID3 + !! Return the facet local id in cell element + GENERIC, PUBLIC :: MasterFacetLocalID => & + MasterFacetLocalID1, & + MasterFacetLocalID2, & + MasterFacetLocalID3 + !! Return the facet local id in cell element + + PROCEDURE, PUBLIC, PASS(obj) :: GetMasterFacetLocalID => & + obj_GetMasterFacetLocalID + + PROCEDURE, PASS(obj) :: SlaveFacetLocalID1 => obj_SlaveFacetLocalID1 + !! Return the facet local id in cell element + PROCEDURE, PASS(obj) :: SlaveFacetLocalID2 => obj_SlaveFacetLocalID2 + !! Return the facet local id in cell element + PROCEDURE, PASS(obj) :: SlaveFacetLocalID3 => obj_SlaveFacetLocalID3 + !! Return the facet local id in cell element + GENERIC, PUBLIC :: SlaveFacetLocalID => & + SlaveFacetLocalID1, & + SlaveFacetLocalID2, & + SlaveFacetLocalID3 + !! Return the facet local id in cell element + + PROCEDURE, PUBLIC, PASS(obj) :: GetSlaveFacetLocalID => & + obj_GetSlaveFacetLocalID + + PROCEDURE, PASS(obj) :: MasterDimTag1 => obj_MasterDimTag1 + !! (dim, entityNum) of Master cell + PROCEDURE, PASS(obj) :: MasterDimTag2 => obj_MasterDimTag2 + !! (dim, entityNum) of Master cell + PROCEDURE, PASS(obj) :: MasterDimTag3 => obj_MasterDimTag3 + !! (dim, entityNum) of Master cell + GENERIC, PUBLIC :: MasterDimTag => & + MasterDimTag1, & + MasterDimTag2, & + MasterDimTag3 + !! (dim, entityNum) of master cell + + PROCEDURE, PUBLIC, PASS(obj) :: GetMasterDimTag => obj_GetMasterDimTag + + PROCEDURE, PASS(obj) :: SlaveDimTag1 => obj_SlaveDimTag1 + !! (dim, entityNum) of Slave cell + PROCEDURE, PASS(obj) :: SlaveDimTag2 => obj_SlaveDimTag2 + !! (dim, entityNum) of Slave cell + PROCEDURE, PASS(obj) :: SlaveDimTag3 => obj_SlaveDimTag3 + !! (dim, entityNum) of Slave cell + GENERIC, PUBLIC :: SlaveDimTag => & + SlaveDimTag1, & + SlaveDimTag2, & + SlaveDimTag3 + !! (dim, entityNum) of Slave cell + + PROCEDURE, PUBLIC, PASS(obj) :: GetSlaveDimTag => obj_GetSlaveDimTag + + PROCEDURE, PRIVATE, PASS(obj) :: GlobalFacetID1 => obj_GlobalFacetID1 + !! global facet id of local facet id is returned + PROCEDURE, PRIVATE, PASS(obj) :: GlobalFacetID2 => obj_GlobalFacetID2 + !! global facet id of local facet id is returned + PROCEDURE, PRIVATE, PASS(obj) :: GlobalFacetID3 => obj_GlobalFacetID3 + !! global facet id of local facet id is returned + GENERIC, PUBLIC :: GlobalFacetID => & + & GlobalFacetID1, & + & GlobalFacetID2, & + & GlobalFacetID3 + !! global facet id of local facet id is returned + + PROCEDURE, PUBLIC, PASS(obj) :: GetGlobalFacetID => obj_GetGlobalFacetID + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalFacet => & + & obj_GetTotalFacet + !! returns size of facetToCell + PROCEDURE, PUBLIC, PASS(obj) :: DisplayFacetToCellData => & + & obj_DisplayFacetToCellData +END TYPE FEDomainConnectivity_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +TYPE :: FEDomainConnectivityPointer_ + CLASS(FEDomainConnectivity_), POINTER :: Ptr => NULL() +END TYPE FEDomainConnectivityPointer_ + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Deallocates the data stored in [[FEDomainConnectivity_]] +! +!# Introduction +! +! This subroutine deallocate the data stored in [[FEDomainConnectivity_]] +! + +INTERFACE + MODULE SUBROUTINE obj_Deallocate1(obj) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEMesh connectivity object + END SUBROUTINE obj_Deallocate1 +END INTERFACE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate a vector of FEDomainConnectivity_ + +INTERFACE FEDomainConnectivityDeallocate + MODULE SUBROUTINE obj_Deallocate2(obj) + TYPE(FEDomainConnectivity_), ALLOCATABLE, INTENT(INOUT) :: obj(:) + END SUBROUTINE obj_Deallocate2 +END INTERFACE FEDomainConnectivityDeallocate + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate a vector of FEDomainConnectivityPointer_ + +INTERFACE FEDomainConnectivityDeallocate + MODULE SUBROUTINE obj_Deallocate3(obj) + TYPE(FEDomainConnectivityPointer_), ALLOCATABLE, INTENT(INOUT) :: obj(:) + END SUBROUTINE obj_Deallocate3 +END INTERFACE FEDomainConnectivityDeallocate + +!---------------------------------------------------------------------------- +! Final@ConstructorMethods +!---------------------------------------------------------------------------- + +INTERFACE + MODULE SUBROUTINE obj_Final(obj) + TYPE(FEDomainConnectivity_), INTENT(INOUT) :: obj + END SUBROUTINE obj_Final +END INTERFACE + +!---------------------------------------------------------------------------- +! DisplayFacetToCellData@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Display FaceToCellData + +INTERFACE + MODULE SUBROUTINE obj_DisplayFacetToCellData(obj, msg, unitno) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: msg + INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno + END SUBROUTINE obj_DisplayFacetToCellData +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateNodeToNodeData@NodeMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-10 +! summary: Generate node to node connectivity +! +!# Introduction +! +! This subroutine generates the node to node connectivity between two domains +! +!@note +!In this routine nodeToNode connectivity info of all meshes in domain1 to +!all meshes in the domain2 will be generated! +!@endnote +! +! - `obj%nodeToNode` will be Initiated +! - `domain1` main domain +! - `domain2` secondary domain + +INTERFACE + MODULE SUBROUTINE obj_InitiateNodeToNodeData1(obj, domain1, domain2) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity object + CLASS(AbstractDomain_), INTENT(INOUT) :: domain1 + !! Primary domain, in nodeToNode(i), i denotes the + !! global node number in domain1 domain. + CLASS(AbstractDomain_), INTENT(INOUT) :: domain2 + !! Secondary domain => nodeToNode(i) denotes the + !! global node number in domain2 domain. + END SUBROUTINE obj_InitiateNodeToNodeData1 +END INTERFACE + +!---------------------------------------------------------------------------- +! getNodeToNodePointer@NodeMethods +!---------------------------------------------------------------------------- +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-10 +! update: 2021-11-10 +! summary: Returns the node to node connectivity info +! +!# Introduction +! +! This function returns the pointer +! to [[FEDomainConnectivity_:nodeToNode]] +! + +INTERFACE + MODULE FUNCTION obj_GetNodeToNodePointer(obj) RESULT(Ans) + CLASS(FEDomainConnectivity_), TARGET, INTENT(IN) :: obj + INTEGER(I4B), POINTER :: ans(:) + END FUNCTION obj_GetNodeToNodePointer +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateCellToCellData@NodeMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-10 +! update: 2021-11-10 +! summary: Generate cell to cell connectivity +! +!# Introduction +! +!This subroutine generates the cell to cell connectivity between +!two domains. +! +! - `obj%cellToCell` will be Initiated +! - `domain1` main domain +! - `domain2` secondary domain +! +!@note +!All **CELL** elements in domain-1 will be mapped to **CELL** +!elements in domain-2. +!@endnote +! +!@note +!If cellToCell(iel) is equal to zero then it means there is +!no element found in domain-2 corresponding to element number +!iel in domain-1. +!@endnote +! +!@note +!The size of [[FEDomainConnectivity_:cellToCell]] is the largest +!element number present in domain1. +!@endnote +! +!@todo +!TODO +!Currently, lowerbound and upper bound of cellToCell is 1 and +!domain1%maxElemNumber. In future it the lower bound will be +!domain1%minElemNumber. +!@endtodo +! +!@note +!Following points should be noted before calling this routine +! +! - This routine provides map between cell elements +!of one domain to cell elements of another domain. +! - The topology of the both elements should be the same +! - There is one to one mapping between elements of domain 1 +! and elements of domain2 +! - This routine works well for two domains of same region +! with same/different order. For example, domain of tri3 and domain +! of tri6 elements. +!@endnote + +INTERFACE + MODULE SUBROUTINE obj_InitiateCellToCellData1(obj, domain1, domain2) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity object + CLASS(AbstractDomain_), INTENT(INOUT) :: domain1 + !! Primary domain, in CellToCell(i), i denotes the + !! global element number in domain1 domain. + CLASS(AbstractDomain_), INTENT(INOUT) :: domain2 + !! Secondary domain => CellToCell(i) denotes the + !! global element number in domain2 domain. + END SUBROUTINE obj_InitiateCellToCellData1 +END INTERFACE + +!---------------------------------------------------------------------------- +! getCellToCellPointer@CellMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-10 +! update: 2021-11-10 +! summary: Returns pointer to cell-to-cell data +! +!# Introduction +! +! This function returns the pointer to [[FEDomainConnectivity_:CellToCell]] + +INTERFACE + MODULE FUNCTION obj_GetCellToCellPointer(obj) RESULT(Ans) + CLASS(FEDomainConnectivity_), TARGET, INTENT(IN) :: obj + INTEGER(I4B), POINTER :: ans(:) + END FUNCTION obj_GetCellToCellPointer +END INTERFACE + +!---------------------------------------------------------------------------- +! getDimEntityNum@CellMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-10 +! update: 2021-11-10 +! summary: Returns pointer to cell-to-cell data +! +!# Introduction +! +! This function returns the pointer to [[FEDomainConnectivity_:CellToCell]] + +INTERFACE + MODULE PURE FUNCTION obj_GetDimEntityNum(obj, globalElement) RESULT(Ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + INTEGER(I4B) :: ans(2) + END FUNCTION obj_GetDimEntityNum +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 14 March 2022 +! summary: This is a helper routine for obj_InitiateFacetToCellData1 +! +!# Introduction +! +! - This routine Initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - In this case facetFEMesh should be a boundary of cellFEMesh +! - This routine should not be used for internal boundary. + +INTERFACE + MODULE SUBROUTINE obj_InitiateFacetToCellData1(obj, facetFEMesh, & + cellFEMesh, dim, entityNum, isMaster) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity data + CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh + !! FEMesh of facet elements + CLASS(AbstractMesh_), INTENT(INOUT) :: cellFEMesh + !! Master mesh + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), INTENT(IN) :: entityNum + LOGICAL(LGT), INTENT(IN) :: isMaster + !! if true then cell FEMesh is master cell + !! if false then cell mesh is slave cell + END SUBROUTINE obj_InitiateFacetToCellData1 +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Generate the connectivity matrix between cell and facet mesh. +! +!# Introduction +! +! This subroutine generates the faceToCell connectivity data between +! between masterFEDomain, slaveFEDomain and faceFEMesh. +! +! In this case facetFEMesh should a boundary of masterFEDomain and slaveFEDomain +! In otherwords, facetFEMesh cannot represent the internal boundary. +! This routine calls `obj_InitiateFacetToCellData1` routine. + +INTERFACE + MODULE SUBROUTINE obj_InitiateFacetToCellData2(obj, facetFEMesh, & + masterFEDomain, slaveFEDomain) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEMesh connectivity data + CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh + !! FEMesh of facet elements + CLASS(AbstractDomain_), INTENT(INOUT) :: masterFEDomain + !! FEDomain of master elements + CLASS(AbstractDomain_), INTENT(INOUT) :: slaveFEDomain + !! FEDomain of slave elements + END SUBROUTINE obj_InitiateFacetToCellData2 +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 14 March 2022 +! summary: This is a helper routine for obj_InitiateFacetToCellData1 +! +!# Introduction +! +! - This routine Initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - In this case facetFEMesh can be an internal boundary of cellFEMesh + +INTERFACE + MODULE SUBROUTINE obj_InitiateFacetToCellData3(obj, facetFEMesh, & + cellFEMesh, dim, entityNum) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity data + CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh + !! FEMesh of facet elements + CLASS(AbstractMesh_), INTENT(INOUT) :: cellFEMesh + !! Master mesh + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), INTENT(IN) :: entityNum + END SUBROUTINE obj_InitiateFacetToCellData3 +END INTERFACE + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 14 March 2022 +! summary: This is a helper routine for obj_InitiateFacetToCellData1 +! +!# Introduction +! +! - This routine Initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - In this case facetFEMesh can be an internal boundary of cellFEMesh + +INTERFACE +MODULE SUBROUTINE obj_InitiateFacetToCellData4(obj, facetFEMesh, cellFEDomain) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity data + CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh + !! FEMesh of facet elements + CLASS(AbstractDomain_), INTENT(INOUT) :: cellFEDomain + !! Master mesh + END SUBROUTINE obj_InitiateFacetToCellData4 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns master cell number of given facet number +! +!# Introduction +! +! - Returns master cell number of given facet number +! - If cell number is zero it means facet element does not have a master cell + +INTERFACE + MODULE PURE FUNCTION obj_MasterCellNumber1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans + !! Cell number + END FUNCTION obj_MasterCellNumber1 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns master cell number of given facet number +! +!# Introduction +! +! - Returns master cell number of given facet number +! - if master cell number is zero it means facet element is an orphan + +INTERFACE + MODULE PURE FUNCTION obj_MasterCellNumber2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(SIZE(localElement)) + !! List of cell element numbers + END FUNCTION obj_MasterCellNumber2 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns master cell number of given facet number + +INTERFACE + MODULE PURE FUNCTION obj_MasterCellNumber3(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! List of cell element numbers + END FUNCTION obj_MasterCellNumber3 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns master cell number of given facet number (no allocation) + +INTERFACE + MODULE PURE SUBROUTINE obj_GetMasterCellNumber(obj, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(INOUT) :: VALUE(:) + !! List of cell element numbers + END SUBROUTINE obj_GetMasterCellNumber +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns slave cell number of given facet number +! +!# Introduction +! +! - Returns slave cell number of given facet number +! - If slave cell number is zero it means facet element is an orphan + +INTERFACE + MODULE PURE FUNCTION obj_SlaveCellNumber1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans + !! Cell number + END FUNCTION obj_SlaveCellNumber1 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns slave cell number of given facet number +! +!# Introduction +! +! - Returns slave cell number of given facet number +! - if slave cell number is zero it means facet element is an orphan + +INTERFACE + MODULE PURE FUNCTION obj_SlaveCellNumber2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(SIZE(localElement)) + !! List of cell element numbers + END FUNCTION obj_SlaveCellNumber2 +END INTERFACE + +!---------------------------------------------------------------------------- +! CellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns slave cell number of given facet number + +INTERFACE + MODULE PURE FUNCTION obj_SlaveCellNumber3(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! List of cell element numbers + END FUNCTION obj_SlaveCellNumber3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetSlaveCellNumber@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns slave cell number of given facet number + +INTERFACE + MODULE PURE SUBROUTINE obj_GetSlaveCellNumber(obj, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(INOUT) :: VALUE(:) + !! List of cell element numbers + END SUBROUTINE obj_GetSlaveCellNumber +END INTERFACE + +!---------------------------------------------------------------------------- +! masterFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in master cell element +! +!# Introduction +! +! Returns the local facet id in master cell element which is in contact with +! facet element + +INTERFACE + MODULE PURE FUNCTION obj_MasterFacetLocalID1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity object + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans + !! Local facet ID + END FUNCTION obj_MasterFacetLocalID1 +END INTERFACE + +!---------------------------------------------------------------------------- +! masterFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in master cell element +! +!# Introduction +! +! Returns the local facet id in master cell element which is in contact with +! facet element +! +!## Usage +! +!```fortran +! id = obj % FacetLocalID( FacetNum ) +!``` + +INTERFACE + MODULE PURE FUNCTION obj_MasterFacetLocalID2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(SIZE(localElement)) + !! List of local facet IDs + END FUNCTION obj_MasterFacetLocalID2 +END INTERFACE + +!---------------------------------------------------------------------------- +! masterFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in master cell element + +INTERFACE + MODULE PURE FUNCTION obj_MasterFacetLocalID3(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! List of local facet IDs + END FUNCTION obj_MasterFacetLocalID3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMasterFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in master cell element + +INTERFACE + MODULE PURE SUBROUTINE obj_GetMasterFacetLocalID(obj, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(INOUT) :: VALUE(:) + !! List of local facet IDs + END SUBROUTINE obj_GetMasterFacetLocalID +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in slave cell element +! +!# Introduction +! +! Returns the local facet id in slave cell element which is in contact with +! facet element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveFacetLocalID1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity object + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans + !! Local facet ID + END FUNCTION obj_SlaveFacetLocalID1 +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in slave cell element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveFacetLocalID2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(SIZE(localElement)) + !! List of local facet IDs + END FUNCTION obj_SlaveFacetLocalID2 +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in slave cell element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveFacetLocalID3(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! List of local facet IDs + END FUNCTION obj_SlaveFacetLocalID3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetSlaveFacetLocalID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local facet id in slave cell element + +INTERFACE + MODULE PURE SUBROUTINE obj_GetSlaveFacetLocalID(obj, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(INOUT) :: VALUE(:) + !! List of local facet IDs + END SUBROUTINE obj_GetSlaveFacetLocalID +END INTERFACE + +!---------------------------------------------------------------------------- +! masterDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in master cell element + +INTERFACE + MODULE PURE FUNCTION obj_MasterDimTag1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity object + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans(2) + !! dim, entityNum + END FUNCTION obj_MasterDimTag1 +END INTERFACE + +!---------------------------------------------------------------------------- +! masterDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in master cell element + +INTERFACE + MODULE PURE FUNCTION obj_MasterDimTag2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(2, SIZE(localElement)) + !! dim, entityNum + END FUNCTION obj_MasterDimTag2 +END INTERFACE + +!---------------------------------------------------------------------------- +! masterDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in master cell element + +INTERFACE + MODULE PURE FUNCTION obj_MasterDimTag3(obj, isTranspose) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + LOGICAL(LGT), INTENT(IN) :: isTranspose + INTEGER(I4B), ALLOCATABLE :: ans(:, :) + !! dim, entityNum + END FUNCTION obj_MasterDimTag3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMasterDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in master cell element + +INTERFACE + MODULE PURE SUBROUTINE obj_GetMasterDimTag(obj, isTranspose, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + LOGICAL(LGT), INTENT(IN) :: isTranspose + INTEGER(I4B), INTENT(INOUT) :: VALUE(:, :) + !! dim, entityNum + END SUBROUTINE obj_GetMasterDimTag +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in slave cell element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveDimTag1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity object + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans(2) + !! dim, entityNum + END FUNCTION obj_SlaveDimTag1 +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in slave cell element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveDimTag2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(2, SIZE(localElement)) + !! dim, entityNum + END FUNCTION obj_SlaveDimTag2 +END INTERFACE + +!---------------------------------------------------------------------------- +! slaveDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in slave cell element + +INTERFACE + MODULE PURE FUNCTION obj_SlaveDimTag3(obj, isTranspose) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + LOGICAL(LGT), INTENT(IN) :: isTranspose + INTEGER(I4B), ALLOCATABLE :: ans(:, :) + !! dim, entityNum + END FUNCTION obj_SlaveDimTag3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetSlaveDimTag@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the (dimtag, entityNum) in Slave cell element + +INTERFACE + MODULE PURE SUBROUTINE obj_GetSlaveDimTag(obj, isTranspose, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + LOGICAL(LGT), INTENT(IN) :: isTranspose + INTEGER(I4B), INTENT(INOUT) :: VALUE(:, :) + !! dim, entityNum + END SUBROUTINE obj_GetSlaveDimTag +END INTERFACE + +!---------------------------------------------------------------------------- +! GlobalFacetID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the local global facet id + +INTERFACE + MODULE PURE FUNCTION obj_GlobalFacetID1(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity object + INTEGER(I4B), INTENT(IN) :: localElement + !! Facet element number + INTEGER(I4B) :: ans + END FUNCTION obj_GlobalFacetID1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GlobalFacetID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the global facet id + +INTERFACE + MODULE PURE FUNCTION obj_GlobalFacetID2(obj, localElement) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(IN) :: localElement(:) + !! List of facet element numbers + INTEGER(I4B) :: ans(SIZE(localElement)) + END FUNCTION obj_GlobalFacetID2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GlobalFacetID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the global facet id + +INTERFACE + MODULE PURE FUNCTION obj_GlobalFacetID3(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION obj_GlobalFacetID3 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalFacetID@FacetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-04-08 +! summary: Returns the global facet id + +INTERFACE + MODULE PURE SUBROUTINE obj_GetGlobalFacetID(obj, VALUE) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + !! FEMesh connectivity data + INTEGER(I4B), INTENT(INOUT) :: VALUE(:) + END SUBROUTINE obj_GetGlobalFacetID +END INTERFACE + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE + MODULE PURE FUNCTION obj_GetTotalFacet(obj) RESULT(ans) + CLASS(FEDomainConnectivity_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalFacet +END INTERFACE + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END MODULE FEDomainConnectivity_Class diff --git a/src/modules/FEMesh/src/FEMesh_Class.F90 b/src/modules/FEMesh/src/FEMesh_Class.F90 index 8f2946f52..73da194b2 100755 --- a/src/modules/FEMesh/src/FEMesh_Class.F90 +++ b/src/modules/FEMesh/src/FEMesh_Class.F90 @@ -19,25 +19,19 @@ ! summary: `Mesh_Class` module contains data type for handling the mesh. MODULE FEMesh_Class -USE GlobalData -USE Basetype +USE GlobalData, ONLY: DFP, I4B, LGT, stdout, stderr USE String_Class, ONLY: String USE ExceptionHandler_Class, ONLY: e -USE NodeData_Class, ONLY: NodeData_, INTERNAL_NODE, BOUNDARY_NODE, & - & DOMAIN_BOUNDARY_NODE, GHOST_NODE, TypeNode -USE ElemData_Class, ONLY: ElemData_, INTERNAL_ELEMENT, BOUNDARY_ELEMENT, & - & DOMAIN_BOUNDARY_ELEMENT, GHOST_ELEMENT, TypeElem -USE FacetData_Class, ONLY: InternalFacetData_, BoundaryFacetData_ -USE AbstractMesh_Class +USE AbstractMesh_Class, ONLY: AbstractMesh_ IMPLICIT NONE PRIVATE -PUBLIC :: INTERNAL_NODE, BOUNDARY_NODE, DOMAIN_BOUNDARY_NODE, & - & GHOST_NODE, TypeNode +! PUBLIC :: INTERNAL_NODE, BOUNDARY_NODE, DOMAIN_BOUNDARY_NODE, & +! & GHOST_NODE, TypeNode -PUBLIC :: INTERNAL_ELEMENT, BOUNDARY_ELEMENT, DOMAIN_BOUNDARY_ELEMENT, & - & GHOST_ELEMENT, TypeElem +! PUBLIC :: INTERNAL_ELEMENT, BOUNDARY_ELEMENT, DOMAIN_BOUNDARY_ELEMENT, & +! & GHOST_ELEMENT, TypeElem PUBLIC :: FEMesh_ PUBLIC :: FEMeshPointer_ @@ -60,49 +54,7 @@ MODULE FEMesh_Class TYPE, EXTENDS(AbstractMesh_) :: FEMesh_ CONTAINS PRIVATE - - ! CONSTRUCTOR: - ! @ConstructorMethods FINAL :: obj_Final - !! mesh finalizer - - ! IO: - ! @IOMethods - ! NA - - ! GET: - ! @GetMethods - ! NA - - ! SET: - ! @NodeDataMethods - ! NA - - ! SET: - ! @ElementDataMethods - ! NA - - ! SET: - ! @BoundaryDataMethods - PROCEDURE, PUBLIC, PASS(obj) :: InitiateBoundaryData => & - & obj_InitiateBoundaryData - - ! SET: - ! @FacetDataMethods - PROCEDURE, PUBLIC, PASS(obj) :: InitiateFacetElements => & - & obj_InitiateFacetElements - !! Initiate boundary data - - ! SET: - ! @SetMethods - PROCEDURE, PASS(obj) :: SetSparsity1 => obj_setSparsity1 - PROCEDURE, PASS(obj) :: SetSparsity2 => obj_setSparsity2 - PROCEDURE, PASS(obj) :: SetSparsity3 => obj_setSparsity3 - PROCEDURE, PASS(obj) :: SetSparsity4 => obj_setSparsity4 - - PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => obj_setQuality - !! Set mesh quality - END TYPE FEMesh_ !---------------------------------------------------------------------------- @@ -159,189 +111,6 @@ MODULE SUBROUTINE FEMeshPointerDeallocate(obj) END SUBROUTINE FEMeshPointerDeallocate END INTERFACE DEALLOCATE -!---------------------------------------------------------------------------- -! InitiateBoundaryData@BoundaryDataMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: Initiate boundary data -! -!# Introduction -! -! This method construct the boundary element data. -! It marks elements of mesh as BOUNDARY_ELEMENT and INTERNAL_ELEMENT -! In this case boundary elements are those which contains the boundary node. -! Boundary node information is available by reading the mesh file, see -! mesh import method. -! It also forms `obj%elementData(ii)%boundaryData` -! -! This methods needs following information: -! -!- `ElementToElements` -!- `refelem` to construct the FacetElements - -INTERFACE - MODULE SUBROUTINE obj_InitiateBoundaryData(obj) - CLASS(FEMesh_), INTENT(INOUT) :: obj - !! mesh data - END SUBROUTINE obj_InitiateBoundaryData -END INTERFACE - -!---------------------------------------------------------------------------- -! InitiateFacetElements@FacetDataMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: Compute the total number of facet elements in the mesh -! -!# Introduction -! -! This routine needs following information: -! -!- `ElementToElements` -!- `BoundaryData` -! -! It makes following data -! -!- `InternalFacetData` -!- `BoundaryFacetData` -!- `FacetElementType` -! -! Note that at this point all boundaryFacet element are of type -! `DOMAIN_BOUNDARY_ELEMENT`. This information can be corrected only when -! we call SetFacetElementType from Domain_ class. This is because, -! at this point we only know that a boundary facet is a domain boundary -! element, as we have no information about the neighbouring mesh. - -INTERFACE - MODULE SUBROUTINE obj_InitiateFacetElements(obj) - CLASS(FEMesh_), INTENT(INOUT) :: obj - END SUBROUTINE obj_InitiateFacetElements -END INTERFACE - -!---------------------------------------------------------------------------- -! SetSparsity@SetMethod -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object -! -!# Introduction -! -! This routine Sets the sparsity pattern in [[CSRMatrix_]] object. - -INTERFACE - MODULE SUBROUTINE obj_SetSparsity1(obj, mat, localNodeNumber, lbound, & - & ubound) - CLASS(FEMesh_), INTENT(INOUT) :: obj - !! [[Mesh_]] class - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - !! [[CSRMatrix_]] object - INTEGER(I4B), INTENT(IN) :: lbound - INTEGER(I4B), INTENT(IN) :: ubound - INTEGER(I4B), INTENT(IN) :: localNodeNumber(lbound:ubound) - !! Global to local node number map - END SUBROUTINE obj_SetSparsity1 -END INTERFACE - -!---------------------------------------------------------------------------- -! SetSparsity@SetMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object - -INTERFACE - MODULE SUBROUTINE obj_SetSparsity2(obj, mat) - CLASS(FEMesh_), INTENT(INOUT) :: obj - !! Mesh_ class - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - !! CSRMatrix object - END SUBROUTINE obj_SetSparsity2 -END INTERFACE - -!---------------------------------------------------------------------------- -! SetSparsity@SetMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object - -INTERFACE - MODULE SUBROUTINE obj_SetSparsity3(obj, colMesh, nodeToNode, mat, & - & ivar, jvar) - CLASS(FEMesh_), INTENT(INOUT) :: obj - !! [[Mesh_]] class - CLASS(AbstractMesh_), INTENT(INOUT) :: colMesh - !! [[Mesh_]] class - INTEGER(I4B), INTENT(IN) :: nodeToNode(:) - !! Node to node connectivity between obj and colMesh - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - !! [[CSRMatrix_]] object - INTEGER(I4B), INTENT(IN) :: ivar - INTEGER(I4B), INTENT(IN) :: jvar - END SUBROUTINE obj_SetSparsity3 -END INTERFACE - -!---------------------------------------------------------------------------- -! SetSparsity@SetMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object - -INTERFACE - MODULE SUBROUTINE obj_SetSparsity4(obj, colMesh, nodeToNode, mat, & - & rowGlobalToLocalNodeNum, rowLBOUND, rowUBOUND, colGlobalToLocalNodeNum, & - & colLBOUND, colUBOUND, ivar, jvar) - CLASS(FEMesh_), INTENT(INOUT) :: obj - !! [[Mesh_]] class - CLASS(AbstractMesh_), INTENT(INOUT) :: colMesh - !! [[Mesh_]] class - INTEGER(I4B), INTENT(IN) :: nodeToNode(:) - !! node to node connectivity between obj and colMesh - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - !! [[CSRMatrix_]] object - INTEGER(I4B), INTENT(IN) :: rowLBOUND - INTEGER(I4B), INTENT(IN) :: rowUBOUND - INTEGER(I4B), INTENT(IN) :: rowGlobalToLocalNodeNum( & - & rowLBOUND:rowUBOUND) - !! Global to local node number map - INTEGER(I4B), INTENT(IN) :: colLBOUND - INTEGER(I4B), INTENT(IN) :: colUBOUND - INTEGER(I4B), INTENT(IN) :: colGlobalToLocalNodeNum( & - & colLBOUND:colUBOUND) - INTEGER(I4B), INTENT(IN) :: ivar - INTEGER(I4B), INTENT(IN) :: jvar - END SUBROUTINE obj_SetSparsity4 -END INTERFACE - -!---------------------------------------------------------------------------- -! SetQuality@setMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2024-03-17 -! summary: Set mesh quality - -INTERFACE - MODULE SUBROUTINE obj_SetQuality(obj, measures, max_measures, & - & min_measures, nodeCoord, local_nptrs) - CLASS(FEMesh_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: measures(:) - REAL(DFP), INTENT(OUT) :: max_measures(:) - REAL(DFP), INTENT(OUT) :: min_measures(:) - REAL(DFP), INTENT(IN) :: nodeCoord(:, :) - INTEGER(I4B), INTENT(IN) :: local_nptrs(:) - END SUBROUTINE obj_SetQuality -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/FPL/src/FPL_Method.F90 b/src/modules/FPL/src/FPL_Method.F90 index e50910117..6fe03dc75 100644 --- a/src/modules/FPL/src/FPL_Method.F90 +++ b/src/modules/FPL/src/FPL_Method.F90 @@ -630,7 +630,7 @@ SUBROUTINE fpl_Get_Bool(obj, prefix, key, VALUE) TYPE(ParameterList_), INTENT(IN) :: obj CHARACTER(*), INTENT(IN) :: prefix CHARACTER(*), INTENT(IN) :: key - LOGICAL(LGT), INTENT(OUT) :: VALUE + LOGICAL(LGT), INTENT(INOUT) :: VALUE ! Internal variable INTEGER(I4B) :: ierr TYPE(String) :: varname diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index 7258f63eb..3a16d5f5e 100755 --- a/src/modules/Mesh/src/Mesh_Class.F90 +++ b/src/modules/Mesh/src/Mesh_Class.F90 @@ -48,6 +48,7 @@ MODULE Mesh_Class PUBLIC :: DEALLOCATE PUBLIC :: meshPointerDeallocate PUBLIC :: MeshDisplay +PUBLIC :: MeshGetFacetConnectivity CHARACTER(*), PARAMETER :: modName = "Mesh_Class" @@ -72,6 +73,18 @@ MODULE Mesh_Class !! Reference element of the mesh (spatial) !! TODO: Change refelem to Type(ReferenceElement_) + INTEGER(I4B), ALLOCATABLE :: material(:) + !! materials mapped to the mesh + !! material(1) is the material id of medium 1 + !! material(2) is the material id of medium 2 + !! ... + !! material(n) is the material id of medium n + !! + !! For example, soil is a porous medium n = 1, + !! fluid is a medium n =2 + !! then material(1) denotes the type of soil => clay, sand, silt + !! and material(2) denotes the type of fluid, water, oil, air + CONTAINS PRIVATE @@ -118,6 +131,7 @@ MODULE Mesh_Class ! GET: ! @GetMethods + PROCEDURE, PUBLIC, PASS(obj) :: GetRefElemPointer => & & obj_GetRefElemPointer !! Returns pointer to the reference element @@ -126,14 +140,22 @@ MODULE Mesh_Class & obj_GetOrder !! Returns the order ofthe element of mesh - PROCEDURE, PASS(obj) :: obj_GetFacetConnectivity1 - !! Return the node nubmers in the facet element - PROCEDURE, PASS(obj) :: obj_GetFacetConnectivity2 + PROCEDURE, PUBLIC, PASS(obj) :: GetFacetConnectivity => & + & obj_GetFacetConnectivity !! Return the node nubmers in the facet element of a cellElement PROCEDURE, PUBLIC, PASS(obj) :: GetParam => obj_GetParam !! Get parameter of mesh + PROCEDURE, PUBLIC, PASS(obj) :: GetMaterial2 => obj_GetMaterial2 + !! returns the material id of a given medium + !! this is a backward compatibility only + + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial2 => & + obj_GetTotalMaterial2 + !! returns the total number of material this is for + !! backward compatibility only + ! SET: ! @SetMethods PROCEDURE, PASS(obj) :: SetSparsity1 => obj_setSparsity1 @@ -141,12 +163,17 @@ MODULE Mesh_Class PROCEDURE, PASS(obj) :: SetSparsity3 => obj_setSparsity3 PROCEDURE, PASS(obj) :: SetSparsity4 => obj_setSparsity4 - PROCEDURE, PUBLIC, PASS(obj) :: SetFacetElementType => & - & obj_SetFacetElementType - !! Set the facet element type of a given cell number PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => obj_setQuality !! Set mesh quality + PROCEDURE, PUBLIC, PASS(obj) :: SetTotalMaterial2 => & + obj_SetTotalMaterial2 + !! Set total materials in materials + + PROCEDURE, PUBLIC, PASS(obj) :: SetMaterial2 => & + obj_SetMaterial2 + !! Set total materials in materials + END TYPE Mesh_ !---------------------------------------------------------------------------- @@ -401,7 +428,7 @@ END FUNCTION obj_GetOrder ! - facetElement is local facet element number INTERFACE - MODULE FUNCTION obj_GetFacetConnectivity1(obj, facetElement, & + MODULE FUNCTION MeshGetFacetConnectivity(obj, facetElement, & & elementType, isMaster) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement @@ -414,7 +441,7 @@ MODULE FUNCTION obj_GetFacetConnectivity1(obj, facetElement, & !! Currently, we do not support slave-cell for meshFacet because !! the slave of meshFacet lives in different instance of obj_ INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION obj_GetFacetConnectivity1 + END FUNCTION MeshGetFacetConnectivity END INTERFACE !---------------------------------------------------------------------------- @@ -432,13 +459,14 @@ END FUNCTION obj_GetFacetConnectivity1 ! - iface is the local face number in globalElement INTERFACE - MODULE FUNCTION obj_GetFacetConnectivity2(obj, globalElement, & - & iface) RESULT(ans) + MODULE FUNCTION obj_GetFacetConnectivity(obj, globalElement, & + & iface, islocal) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), INTENT(IN) :: iface + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION obj_GetFacetConnectivity2 + END FUNCTION obj_GetFacetConnectivity END INTERFACE !---------------------------------------------------------------------------- @@ -472,6 +500,37 @@ MODULE SUBROUTINE obj_GetParam(obj, & END SUBROUTINE obj_GetParam END INTERFACE +!---------------------------------------------------------------------------- +! GetMaterial@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Returns the materials id of a given medium + +INTERFACE + MODULE FUNCTION obj_GetMaterial2(obj, medium) RESULT(ans) + CLASS(Mesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B) :: ans + END FUNCTION obj_GetMaterial2 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetMaterial@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Returns the materials id of a given medium + +INTERFACE + MODULE FUNCTION obj_GetTotalMaterial2(obj) RESULT(ans) + CLASS(Mesh_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION obj_GetTotalMaterial2 +END INTERFACE + !---------------------------------------------------------------------------- ! InitiateExtraNodeToNode@NodeDataMethods !---------------------------------------------------------------------------- @@ -696,24 +755,6 @@ MODULE SUBROUTINE obj_SetSparsity4(obj, colMesh, nodeToNode, mat, & END SUBROUTINE obj_SetSparsity4 END INTERFACE -!---------------------------------------------------------------------------- -! SetFacetElementType@setMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2022-04-14 -! summary: Set the facet element type of a given cell number - -INTERFACE - MODULE SUBROUTINE obj_SetFacetElementType(obj, globalElement, & - & iface, facetElementType) - CLASS(Mesh_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: globalElement - INTEGER(I4B), INTENT(IN) :: iface - INTEGER(I4B), INTENT(IN) :: facetElementType - END SUBROUTINE obj_SetFacetElementType -END INTERFACE - !---------------------------------------------------------------------------- ! SetQuality@setMethods !---------------------------------------------------------------------------- @@ -734,6 +775,37 @@ MODULE SUBROUTINE obj_SetQuality(obj, measures, max_measures, & END SUBROUTINE obj_SetQuality END INTERFACE +!---------------------------------------------------------------------------- +! SetMaterial@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetTotalMaterial2(obj, n) + CLASS(Mesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: n + END SUBROUTINE obj_SetTotalMaterial2 +END INTERFACE + +!---------------------------------------------------------------------------- +! SetMaterial@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2024-01-27 +! summary: Set the materials id of a given medium + +INTERFACE + MODULE SUBROUTINE obj_SetMaterial2(obj, medium, material) + CLASS(Mesh_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B), INTENT(IN) :: material + END SUBROUTINE obj_SetMaterial2 +END INTERFACE + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/MeshFacetData/CMakeLists.txt b/src/modules/MeshFacetData/CMakeLists.txt new file mode 100644 index 000000000..fe0e13d2f --- /dev/null +++ b/src/modules/MeshFacetData/CMakeLists.txt @@ -0,0 +1,19 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} PRIVATE ${src_path}/MeshFacetData_Class.F90) diff --git a/src/modules/MeshFacetData/src/MeshFacetData_Class.F90 b/src/modules/MeshFacetData/src/MeshFacetData_Class.F90 new file mode 100644 index 000000000..7a869b0fd --- /dev/null +++ b/src/modules/MeshFacetData/src/MeshFacetData_Class.F90 @@ -0,0 +1,135 @@ +! This program is a part of EASIFEM library +! Copyright (C) (Since 2000) Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +MODULE MeshFacetData_Class +USE GlobalData, ONLY: DFP, I4B, LGT +IMPLICIT NONE + +CHARACTER(*), PARAMETER :: modName = "MeshFacetData_Class" +PRIVATE + +PUBLIC :: MeshFacetData_ + +!---------------------------------------------------------------------------- +! MeshFacetData_ +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 May 2022 +! summary: Data storage for mesh-facets +! +!# Introduction +! +! Mesh facet elements are located on mesh boundary which is connected to +! other mesh region. +! +! In this way, the `slaveCell` of a `meshFacet` is inside some other mesh. +! The information of `slaveCell` number will be accessed through the +! Halo of the mesh. +! +! The `halo` of the mesh will be stored inside the instance of `Mesh_` +! +! For each Halo (neighbouring mesh) we have an instance of MeshFacetData_. +! therefore, I have defined MeshFacetData_ as the collection of +! all meshfacets. + +TYPE MeshFacetData_ + INTEGER(I4B) :: masterMesh = 0 + INTEGER(I4B) :: slaveMesh = 0 + INTEGER(I4B), ALLOCATABLE :: masterCellNumber(:) + INTEGER(I4B), ALLOCATABLE :: slaveCellNumber(:) + INTEGER(I4B), ALLOCATABLE :: masterLocalFacetID(:) + INTEGER(I4B), ALLOCATABLE :: slaveLocalFacetID(:) + ! CLASS( Halo_ ), POINTER :: halo => NULL() +CONTAINS + PROCEDURE, PUBLIC, PASS(obj) :: Display => MeshFacetData_Display + PROCEDURE, PUBLIC, PASS(obj) :: Initiate => MeshFacetData_Initiate + PROCEDURE, PUBLIC, PASS(obj) :: isInitiated => MeshFacetData_isInitiated + PROCEDURE, PUBLIC, PASS(obj) :: Size => MeshFacetData_Size + ! PROCEDURE, PUBLIC, PASS( obj ) :: Set => MeshFacet_Set + ! PROCEDURE, PUBLIC, PASS( obj ) :: Size => MeshFacet_Size + ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveCellNumber => & + ! & MeshFacet_SetSlaveCellNumber + ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveLocalFacetID => & + ! & MeshFacet_SetSlaveLocalFacetID + ! PROCEDURE, PUBLIC, PASS( obj ) :: SetSlaveData => & + ! & MeshFacet_SetSlaveData + ! !! +END TYPE MeshFacetData_ + +!---------------------------------------------------------------------------- +! Initaite@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Initiate an instance of MeshFacetData + +INTERFACE + MODULE SUBROUTINE MeshFacetData_Initiate(obj, n) + CLASS(MeshFacetData_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: n + END SUBROUTINE MeshFacetData_Initiate +END INTERFACE + +!---------------------------------------------------------------------------- +! Initaite@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 24 May 2022 +! summary: Returns true if MeshFacetData initiated + +INTERFACE + MODULE FUNCTION MeshFacetData_isInitiated(obj) RESULT(ans) + CLASS(MeshFacetData_), INTENT(IN) :: obj + LOGICAL(LGT) :: ans + END FUNCTION MeshFacetData_isInitiated +END INTERFACE + +!---------------------------------------------------------------------------- +! Initaite@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 24 May 2022 +! summary: Returns the size of MeshFacetData + +INTERFACE + MODULE FUNCTION MeshFacetData_Size(obj) RESULT(ans) + CLASS(MeshFacetData_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION MeshFacetData_Size +END INTERFACE + +!---------------------------------------------------------------------------- +! Display@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display mesh facet data + +INTERFACE + MODULE SUBROUTINE MeshFacetData_Display(obj, msg, unitno) + CLASS(MeshFacetData_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: msg + INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno + END SUBROUTINE MeshFacetData_Display +END INTERFACE + +END MODULE MeshFacetData_Class diff --git a/src/modules/PLPlot/src/PLPlot_Class.F90 b/src/modules/PLPlot/src/PLPlot_Class.F90 index bfd7f1aa2..1bce17c2d 100644 --- a/src/modules/PLPlot/src/PLPlot_Class.F90 +++ b/src/modules/PLPlot/src/PLPlot_Class.F90 @@ -608,7 +608,7 @@ END SUBROUTINE plot_Barh INTERFACE MODULE SUBROUTINE plot_Hist(obj, d, N, db, relWidth, fillColor, fillPattern, & - & lineColor, lineWidth) + & lineColor, lineWidth) CLASS(PLPlot_), INTENT(INOUT) :: obj !! REAL(DFP), INTENT(IN) :: d(:) diff --git a/src/submodules/AbstractDomain/CMakeLists.txt b/src/submodules/AbstractDomain/CMakeLists.txt new file mode 100644 index 000000000..cb20d6bbb --- /dev/null +++ b/src/submodules/AbstractDomain/CMakeLists.txt @@ -0,0 +1,25 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources( + ${PROJECT_NAME} + PRIVATE ${src_path}/AbstractDomain_Class@ConstructorMethods.F90 + ${src_path}/AbstractDomain_Class@IOMethods.F90 + ${src_path}/AbstractDomain_Class@GetMethods.F90 + ${src_path}/AbstractDomain_Class@SetMethods.F90 + ${src_path}/AbstractDomain_Class@MeshDataMethods.F90) diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 new file mode 100644 index 000000000..22e62c1a6 --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 @@ -0,0 +1,130 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: This submodule contains methods for domain object + +SUBMODULE(AbstractDomain_Class) ConstructorMethods +USE ReallocateUtility +USE CSRSparsity_Method +USE Kdtree2_Module, ONLY: Kdtree2_Destroy +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Initiate +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "AbstractDomain_Initiate()" +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +CALL obj%DEALLOCATE() + +CALL obj%IMPORT(hdf5=hdf5, group=group) + +SELECT CASE (obj%nsd) +CASE (0) + obj%mesh => obj%meshPoint +CASE (1) + obj%mesh => obj%meshCurve +CASE (2) + obj%mesh => obj%meshSurface +CASE (3) + obj%mesh => obj%meshVolume +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif +END PROCEDURE obj_Initiate + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate +! obj%showTime = .FALSE. +obj%isInitiated = .FALSE. +obj%engine = '' +obj%majorVersion = 0 +obj%minorVersion = 0 +obj%version = 0.0_DFP +obj%nsd = 0 +obj%maxNptrs = 0 +obj%minNptrs = 0 +obj%tNodes = 0 +obj%isNodeNumberSparse = .FALSE. +obj%maxElemNum = 0 +obj%minElemNum = 0 +obj%isElemNumberSparse = .FALSE. +obj%tEntitiesForNodes = 0 +obj%tEntitiesForElements = 0 +obj%tElements(0:3) = 0 +obj%tEntities(0:3) = 0 +CALL DEALLOCATE (obj%meshmap) + +obj%mesh => NULL() + +IF (ASSOCIATED(obj%meshVolume)) THEN + CALL obj%meshVolume%DEALLOCATE() + obj%meshVolume => NULL() +END IF + +IF (ASSOCIATED(obj%meshSurface)) THEN + CALL obj%meshSurface%DEALLOCATE() + obj%meshSurface => NULL() +END IF + +IF (ASSOCIATED(obj%meshCurve)) THEN + CALL obj%meshCurve%DEALLOCATE() + obj%meshCurve => NULL() +END IF + +IF (ASSOCIATED(obj%meshPoint)) THEN + CALL obj%meshPoint%DEALLOCATE() + obj%meshPoint => NULL() +END IF + +IF (ALLOCATED(obj%nodeCoord)) DEALLOCATE (obj%nodeCoord) + +CALL obj%DeallocateKdtree() + +END PROCEDURE obj_Deallocate + +!---------------------------------------------------------------------------- +! DeallocateKdtree +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_DeallocateKdtree +IF (ASSOCIATED(obj%kdtree)) THEN + CALL Kdtree2_Destroy(obj%kdtree) + obj%kdtree => NULL() +END IF + +IF (ALLOCATED(obj%kdresult)) DEALLOCATE (obj%kdresult) +END PROCEDURE obj_DeallocateKdtree + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- +END SUBMODULE ConstructorMethods diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 new file mode 100644 index 000000000..5a43965ba --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -0,0 +1,936 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: This submodule contains methods for domain object + +SUBMODULE(AbstractDomain_Class) GetMethods +USE ReallocateUtility +USE InputUtility +USE BoundingBox_Method, ONLY: Center, GetRadiusSqr, isInside +USE F95_BLAS, ONLY: Copy +USE Kdtree2_Module, ONLY: Kdtree2_r_nearest, Kdtree2_n_nearest +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! IsNodePresent +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_IsNodePresent +SELECT CASE (obj%nsd) +CASE (0) + ans = obj%meshPoint%IsNodePresent(globalNode, islocal=islocal) +CASE (1) + ans = obj%meshCurve%IsNodePresent(globalNode, islocal=islocal) +CASE (2) + ans = obj%meshSurface%IsNodePresent(globalNode, islocal=islocal) +CASE (3) + ans = obj%meshVolume%IsNodePresent(globalNode, islocal=islocal) +END SELECT +END PROCEDURE obj_IsNodePresent + +!---------------------------------------------------------------------------- +! isElementPresent +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_IsElementPresent +INTEGER(I4B) :: dim0 + +dim0 = Input(default=obj%nsd, option=dim) +SELECT CASE (dim0) +CASE (3) + ans = obj%meshVolume%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) +CASE (2) + ans = obj%meshSurface%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) +CASE (1) + ans = obj%meshCurve%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) +CASE (0) + ans = obj%meshPoint%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) +END SELECT + +END PROCEDURE obj_IsElementPresent + +!---------------------------------------------------------------------------- +! GetConnectivity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetConnectivity +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetConnectivity()" +#endif + +INTEGER(I4B) :: dim0 + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +dim0 = Input(default=obj%nsd, option=dim) + +SELECT CASE (dim0) +CASE (3) + ans = obj%meshVolume%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) +CASE (2) + ans = obj%meshSurface%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) +CASE (1) + ans = obj%meshCurve%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) +CASE (0) + ans = obj%meshPoint%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetConnectivity + +!---------------------------------------------------------------------------- +! GetConnectivity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetConnectivity_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetConnectivity_()" +#endif + +INTEGER(I4B) :: dim0 + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +dim0 = Input(default=obj%nsd, option=dim) + +SELECT CASE (dim0) +CASE (3) + CALL obj%meshVolume%GetConnectivity_(globalElement=globalElement, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (2) + CALL obj%meshSurface%GetConnectivity_(globalElement=globalElement, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (1) + CALL obj%meshCurve%GetConnectivity_(globalElement=globalElement, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (0) + CALL obj%meshPoint%GetConnectivity_(globalElement=globalElement, & + & islocal=islocal, ans=ans, tsize=tsize) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetConnectivity_ + +!---------------------------------------------------------------------------- +! GetNNE +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNNE +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNNE()" +#endif + +INTEGER(I4B) :: dim0 + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +dim0 = Input(default=obj%nsd, option=dim) + +SELECT CASE (dim0) +CASE (3) + ans = obj%meshVolume%GetNNE(globalElement=globalElement, & + & islocal=islocal) +CASE (2) + ans = obj%meshSurface%GetNNE(globalElement=globalElement, & + & islocal=islocal) +CASE (1) + ans = obj%meshCurve%GetNNE(globalElement=globalElement, & + & islocal=islocal) +CASE (0) + ans = obj%meshPoint%GetNNE(globalElement=globalElement, & + & islocal=islocal) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetNNE + +!---------------------------------------------------------------------------- +! GetNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements1 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToElements1()" +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (2) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (1) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (0) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetNodeToElements1 + +!---------------------------------------------------------------------------- +! GetNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements2 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToElements2()" +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (2) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (1) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +CASE (0) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetNodeToElements2 + +!---------------------------------------------------------------------------- +! GetNodeToElements_ +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements1_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToElements1_()" +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +SELECT CASE (obj%nsd) +CASE (3) + CALL obj%meshVolume%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (2) + CALL obj%meshSurface%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (1) + CALL obj%meshCurve%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (0) + CALL obj%meshPoint%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetNodeToElements1_ + +!---------------------------------------------------------------------------- +! GetNodeToElements_ +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements2_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToElements2_()" +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +SELECT CASE (obj%nsd) +CASE (3) + CALL obj%meshVolume%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (2) + CALL obj%meshSurface%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (1) + CALL obj%meshCurve%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +CASE (0) + CALL obj%meshPoint%GetNodeToElements_(globalNode=globalNode, & + & islocal=islocal, ans=ans, tsize=tsize) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_GetNodeToElements2_ + +!---------------------------------------------------------------------------- +! GetTotalNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalNodes +IF (PRESENT(dim)) THEN + SELECT CASE (dim) + CASE (3) + ans = obj%meshVolume%GetTotalNodes() + CASE (2) + ans = obj%meshSurface%GetTotalNodes() + CASE (1) + ans = obj%meshCurve%GetTotalNodes() + CASE (0) + ans = obj%meshPoint%GetTotalNodes() + END SELECT + +ELSE + ans = obj%tNodes +END IF +END PROCEDURE obj_GetTotalNodes + +!---------------------------------------------------------------------------- +! tNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_tNodes1 +ans = obj%GetTotalNodes(dim=dim) +END PROCEDURE obj_tNodes1 + +!---------------------------------------------------------------------------- +! tNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_tNodes2 +ans = obj%GetTotalNodes() +END PROCEDURE obj_tNodes2 + +!---------------------------------------------------------------------------- +! GetTotalElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalElements +IF (PRESENT(dim)) THEN + SELECT CASE (dim) + CASE (3) + ans = obj%meshVolume%GetTotalElements() + CASE (2) + ans = obj%meshSurface%GetTotalElements() + CASE (1) + ans = obj%meshCurve%GetTotalElements() + CASE (0) + ans = obj%meshPoint%GetTotalElements() + END SELECT + +ELSE + ans = SUM(obj%tElements) +END IF +END PROCEDURE obj_GetTotalElements + +!---------------------------------------------------------------------------- +! tElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_tElements1 +ans = obj%GetTotalElements() +END PROCEDURE obj_tElements1 + +!---------------------------------------------------------------------------- +! tElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_tElements2 +ans = obj%GetTotalElements(dim=dim) +END PROCEDURE obj_tElements2 + +!---------------------------------------------------------------------------- +! GetLocalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetLocalNodeNumber1 +ans = globalNode +! #ifdef DEBUG_VER +! CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber1()" +! #endif +! +! SELECT CASE (obj%nsd) +! CASE (3) +! ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (2) +! ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (1) +! ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (0) +! ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE DEFAULT +! ans = 0 +! #ifdef DEBUG_VER +! CALL e%RaiseError(modName//'::'//myName//' - '// & +! & '[INTERNAL ERROR] :: No case found') +! #endif +! END SELECT + +END PROCEDURE obj_GetLocalNodeNumber1 + +!---------------------------------------------------------------------------- +! GetLocalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetLocalNodeNumber2 +ans = globalNode +! #ifdef DEBUG_VER +! CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber2()" +! #endif +! +! SELECT CASE (obj%nsd) +! CASE (3) +! ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (2) +! ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (1) +! ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE (0) +! ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode, & +! & islocal=islocal) +! CASE DEFAULT +! ans = 0 +! #ifdef DEBUG_VER +! CALL e%RaiseError(modName//'::'//myName//' - '// & +! & '[INTERNAL ERROR] :: No case found') +! #endif +! END SELECT + +END PROCEDURE obj_GetLocalNodeNumber2 + +!---------------------------------------------------------------------------- +! GetGlobalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetGlobalNodeNumber1 +ans = localNode +! #ifdef DEBUG_VER +! CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalNodeNumber1()" +! #endif +! +! SELECT CASE (obj%nsd) +! CASE (3) +! ans = obj%meshVolume%GetGlobalNodeNumber(localNode=localNode) +! CASE (2) +! ans = obj%meshSurface%GetGlobalNodeNumber(localNode=localNode) +! CASE (1) +! ans = obj%meshCurve%GetGlobalNodeNumber(localNode=localNode) +! CASE (0) +! ans = obj%meshPoint%GetGlobalNodeNumber(localNode=localNode) +! CASE DEFAULT +! ans = 0 +! #ifdef DEBUG_VER +! CALL e%RaiseError(modName//'::'//myName//' - '// & +! & '[INTERNAL ERROR] :: No case found') +! #endif +! END SELECT +END PROCEDURE obj_GetGlobalNodeNumber1 + +!---------------------------------------------------------------------------- +! GetGlobalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetGlobalNodeNumber2 +ans = localNode +! #ifdef DEBUG_VER +! CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalNodeNumber2()" +! #endif +! +! SELECT CASE (obj%nsd) +! CASE (3) +! ans = obj%meshVolume%GetGlobalNodeNumber(localNode=localNode) +! CASE (2) +! ans = obj%meshSurface%GetGlobalNodeNumber(localNode=localNode) +! CASE (1) +! ans = obj%meshCurve%GetGlobalNodeNumber(localNode=localNode) +! CASE (0) +! ans = obj%meshPoint%GetGlobalNodeNumber(localNode=localNode) +! CASE DEFAULT +! ans = 0 +! #ifdef DEBUG_VER +! CALL e%RaiseError(modName//'::'//myName//' - '// & +! & '[INTERNAL ERROR] :: No case found') +! #endif +! END SELECT +END PROCEDURE obj_GetGlobalNodeNumber2 + +!---------------------------------------------------------------------------- +! GetTotalEntities +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalEntities +#ifdef DEBUG_VER +LOGICAL(LGT) :: problem +CHARACTER(*), PARAMETER :: myName = "obj_GetTotalEntities()" + +problem = dim .LT. 0 .OR. dim .GT. 3 + +IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: dim of the mesh should be in [0,1,2,3]") +END IF +#endif + +ans = obj%tEntities(dim) +END PROCEDURE obj_GetTotalEntities + +!---------------------------------------------------------------------------- +! GetMeshPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetMeshPointer1 +SELECT CASE (dim) +CASE (0) + ans => obj%meshPoint +CASE (1) + ans => obj%meshCurve +CASE (2) + ans => obj%meshSurface +CASE (3) + ans => obj%meshVolume +END SELECT + +END PROCEDURE obj_GetMeshPointer1 + +!---------------------------------------------------------------------------- +! GetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeCoord +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeCoord()" +LOGICAL(LGT) :: problem + +problem = .NOT. ALLOCATED(obj%nodeCoord) +IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: Nodecoord is not allocated.") + RETURN +END IF +#endif + +nodeCoord(1:obj%nsd, :) = obj%nodeCoord(1:obj%nsd, :) + +END PROCEDURE obj_GetNodeCoord + +!---------------------------------------------------------------------------- +! GetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeCoord2 +INTEGER(I4B) :: localNode(SIZE(globalNode)) +localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) +nodeCoord(1:obj%nsd, 1:SIZE(globalNode)) = obj%nodeCoord(1:obj%nsd, localNode) +END PROCEDURE obj_GetNodeCoord2 + +!---------------------------------------------------------------------------- +! GetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeCoord3 +INTEGER(I4B) :: localNode +localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) +nodeCoord(1:obj%nsd) = obj%nodeCoord(1:obj%nsd, localNode) +END PROCEDURE obj_GetNodeCoord3 + +!---------------------------------------------------------------------------- +! GetNearestNode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNearestNode1 +CHARACTER(*), PARAMETER :: myName = "obj_GetNearestNode1()" +LOGICAL(LGT) :: isok + +isok = ALLOCATED(obj%kdresult) .AND. (ASSOCIATED(obj%kdtree)) +IF (.NOT. isok) THEN + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'AbstractDomain_::obj%kdtree is not initiating, initing it.') + CALL obj%InitiateKdtree() +END IF + +CALL Kdtree2_n_nearest(tp=obj%kdtree, qv=qv(1:obj%nsd), nn=1, & + results=obj%kdresult) + +globalNode = obj%kdresult(1)%idx +x(1:obj%nsd) = obj%nodeCoord(1:obj%nsd, globalNode) +globalNode = obj%GetGlobalNodeNumber(localnode=globalNode) + +END PROCEDURE obj_GetNearestNode1 + +!---------------------------------------------------------------------------- +! GetNearestNode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNearestNode2 +CHARACTER(*), PARAMETER :: myName = "obj_GetNearestNode2()" +LOGICAL(LGT) :: isok +INTEGER(I4B) :: ii + +isok = ALLOCATED(obj%kdresult) .AND. (ASSOCIATED(obj%kdtree)) +IF (.NOT. isok) THEN + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'AbstractDomain_::obj%kdtree is not initiating, initing it.') + CALL obj%InitiateKdtree() +END IF + +CALL Kdtree2_n_nearest(tp=obj%kdtree, qv=qv(1:obj%nsd), nn=nn, & + results=obj%kdresult) + +DO ii = 1, nn + globalNode(ii) = obj%kdresult(ii)%idx + x(1:obj%nsd, ii) = obj%nodeCoord(1:obj%nsd, globalNode(ii)) + globalNode(ii) = obj%GetGlobalNodeNumber(localnode=globalNode(ii)) +END DO + +END PROCEDURE obj_GetNearestNode2 + +!---------------------------------------------------------------------------- +! GetNodeCoordPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeCoordPointer +ans => obj%nodeCoord +END PROCEDURE obj_GetNodeCoordPointer + +!---------------------------------------------------------------------------- +! GetNptrs +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrs +SELECT CASE (dim) +CASE (3) + ans = obj%meshVolume%GetNptrs() +CASE (2) + ans = obj%meshSurface%GetNptrs() +CASE (1) + ans = obj%meshCurve%GetNptrs() +CASE (0) + ans = obj%meshPoint%GetNptrs() +END SELECT +END PROCEDURE obj_GetNptrs + +!---------------------------------------------------------------------------- +! GetNptrs +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrs_ +SELECT CASE (dim) +CASE (3) + CALL obj%meshVolume%GetNptrs_(nptrs=nptrs) +CASE (2) + CALL obj%meshSurface%GetNptrs_(nptrs=nptrs) +CASE (1) + CALL obj%meshCurve%GetNptrs_(nptrs=nptrs) +CASE (0) + CALL obj%meshPoint%GetNptrs_(nptrs=nptrs) +END SELECT +END PROCEDURE obj_GetNptrs_ + +!---------------------------------------------------------------------------- +! GetNptrsInBox +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrsInBox +CHARACTER(*), PARAMETER :: myName = "obj_GetNptrsInBox()" +REAL(DFP) :: qv(3), r2 +INTEGER(I4B) :: tnodes, ii, nsd +LOGICAL(LGT) :: isok +LOGICAL(LGT), ALLOCATABLE :: bools(:) +INTEGER(I4B), ALLOCATABLE :: nptrs0(:) + +isok = (.NOT. ASSOCIATED(obj%kdtree)) .OR. (.NOT. ALLOCATED(obj%kdresult)) +IF (isok) THEN + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'AbstractDomain_::obj%kdtree not initiated, initiating it...') + + CALL obj%InitiateKdtree() +END IF + +qv = Center(box) +r2 = GetRadiusSqr(box) +nsd = obj%nsd + +CALL Kdtree2_r_nearest(tp=obj%kdtree, qv=qv(1:nsd), r2=r2, & + nfound=tnodes, nalloc=SIZE(obj%kdresult), results=obj%kdresult) + +isok = Input(default=.TRUE., option=isStrict) + +IF (.NOT. isok) THEN + CALL Reallocate(nptrs, tnodes) + DO CONCURRENT(ii=1:tnodes) + nptrs(ii) = obj%kdresult(ii)%idx + END DO + RETURN +END IF + +CALL Reallocate(nptrs0, tnodes) +CALL Reallocate(bools, tnodes) +DO CONCURRENT(ii=1:tnodes) + nptrs0(ii) = obj%kdresult(ii)%idx + bools(ii) = isInside(box, obj%nodeCoord(1:nsd, obj%kdresult(ii)%idx)) +END DO + +nptrs = PACK(nptrs0, bools) + +IF (ALLOCATED(bools)) DEALLOCATE (bools) +IF (ALLOCATED(nptrs0)) DEALLOCATE (nptrs0) + +END PROCEDURE obj_GetNptrsInBox + +!---------------------------------------------------------------------------- +! GetNptrsInBox +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrsInBox_ +! nptrs = box.Nptrs.obj%nodeCoord +REAL(DFP) :: qv(3), r2 +INTEGER(I4B) :: ii, jj, kk, nsd +CHARACTER(*), PARAMETER :: myName = "obj_GetNptrsInBox_()" +LOGICAL(LGT) :: isok, abool + +isok = (.NOT. ASSOCIATED(obj%kdtree)) .OR. (.NOT. ALLOCATED(obj%kdresult)) +IF (isok) THEN + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'AbstractDomain_::obj%kdtree not initiated, initiating it...') + + CALL obj%InitiateKdtree() +END IF + +qv = Center(box) +r2 = GetRadiusSqr(box) +nsd = obj%nsd + +CALL Kdtree2_r_nearest(tp=obj%kdtree, qv=qv(1:nsd), r2=r2, & + nfound=tnodes, nalloc=SIZE(obj%kdresult), results=obj%kdresult) + +#ifdef DEBUG_VER +isok = SIZE(nptrs) .LT. tnodes +IF (isok) THEN + + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: size of nptrs is not enough') + RETURN + +END IF +#endif + +isok = Input(default=.TRUE., option=isStrict) + +IF (.NOT. isok) THEN + DO CONCURRENT(ii=1:tnodes) + nptrs(ii) = obj%kdresult(ii)%idx + END DO + RETURN +END IF + +jj = 0 +DO ii = 1, tnodes + + kk = obj%kdresult(ii)%idx + abool = isInside(box, obj%nodeCoord(1:nsd, kk)) + IF (abool) THEN + jj = jj + 1 + nptrs(jj) = kk + END IF + +END DO + +tnodes = jj + +END PROCEDURE obj_GetNptrsInBox_ + +!---------------------------------------------------------------------------- +! GetNptrs +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetInternalNptrs +SELECT CASE (dim) +CASE (3) + ans = obj%meshVolume%GetInternalNptrs() +CASE (2) + ans = obj%meshSurface%GetInternalNptrs() +CASE (1) + ans = obj%meshCurve%GetInternalNptrs() +CASE (0) + ans = obj%meshPoint%GetInternalNptrs() +END SELECT +END PROCEDURE obj_GetInternalNptrs + +!---------------------------------------------------------------------------- +! GetNSD +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNSD +ans = obj%nsd +END PROCEDURE obj_GetNSD + +!---------------------------------------------------------------------------- +! GetBoundingBox +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetBoundingBox +INTEGER(I4B) :: dim0 + +dim0 = Input(default=obj%nsd, option=dim) +SELECT CASE (dim0) +CASE (0_I4B) + ans = obj%meshPoint%GetBoundingBox(nodes=obj%nodeCoord) +CASE (1_I4B) + ans = obj%meshCurve%GetBoundingBox(nodes=obj%nodeCoord) +CASE (2_I4B) + ans = obj%meshSurface%GetBoundingBox(nodes=obj%nodeCoord) +CASE (3_I4B) + ans = obj%meshVolume%GetBoundingBox(nodes=obj%nodeCoord) +END SELECT + +END PROCEDURE obj_GetBoundingBox + +!---------------------------------------------------------------------------- +! GetTotalMeshFacetData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalMeshFacetData +CHARACTER(*), PARAMETER :: myName = "obj_GetTotalMeshFacetData()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[DEPRECATED] :: We are working on alternative') +ans = 0 +END PROCEDURE obj_GetTotalMeshFacetData + +!---------------------------------------------------------------------------- +! GetTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalMaterial1 +SELECT CASE (dim) +CASE (3) + ans = obj%meshVolume%GetTotalMaterial() +CASE (2) + ans = obj%meshSurface%GetTotalMaterial() +CASE (1) + ans = obj%meshCurve%GetTotalMaterial() +CASE (0) + ans = obj%meshPoint%GetTotalMaterial() +END SELECT +END PROCEDURE obj_GetTotalMaterial1 + +!---------------------------------------------------------------------------- +! GetUniqueElemType +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetUniqueElemType +CHARACTER(*), PARAMETER :: myName = "obj_GetUniqueElemType()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[DEPRECATED] :: We are working on alternative.') +END PROCEDURE obj_GetUniqueElemType + +!---------------------------------------------------------------------------- +! GetParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetParam +IF (PRESENT(isInitiated)) isInitiated = obj%isInitiated +IF (PRESENT(engine)) engine = obj%engine%chars() +IF (PRESENT(majorVersion)) majorVersion = obj%majorVersion +IF (PRESENT(minorVersion)) minorVersion = obj%minorVersion +IF (PRESENT(version)) version = obj%version +IF (PRESENT(nsd)) nsd = obj%nsd +IF (PRESENT(maxNptrs)) maxNptrs = obj%maxNptrs +IF (PRESENT(minNptrs)) minNptrs = obj%minNptrs +IF (PRESENT(tNodes)) tNodes = obj%tNodes +IF (PRESENT(isNodeNumberSparse)) isNodeNumberSparse = obj%isNodeNumberSparse +IF (PRESENT(maxElemNum)) maxElemNum = obj%maxElemNum +IF (PRESENT(minElemNum)) minElemNum = obj%minElemNum +IF (PRESENT(isElemNumberSparse)) isElemNumberSparse = obj%isElemNumberSparse +IF (PRESENT(tEntitiesForElements)) tEntitiesForElements = obj%tEntitiesForElements +IF (PRESENT(tEntitiesForNodes)) tEntitiesForNodes = obj%tEntitiesForNodes +IF (PRESENT(tElements)) tElements = obj%tElements +IF (PRESENT(tEntities)) tEntities = obj%tEntities +IF (PRESENT(nodeCoord)) nodeCoord = obj%nodeCoord +IF (PRESENT(meshVolume)) meshVolume => obj%meshVolume +IF (PRESENT(meshSurface)) meshSurface => obj%meshSurface +IF (PRESENT(meshCurve)) meshCurve => obj%meshCurve +IF (PRESENT(meshPoint)) meshPoint => obj%meshPoint +END PROCEDURE obj_GetParam + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE GetMethods diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 new file mode 100644 index 000000000..a3291038a --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 @@ -0,0 +1,488 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see + +SUBMODULE(AbstractDomain_Class) IOMethods +USE GlobalData, ONLY: stdout, CHAR_LF +USE Display_Method +USE StringUtility +USE ReallocateUtility +USE tomlf, ONLY: toml_serialize, toml_get => get_value +USE TomlUtility +USE HDF5File_Method +USE FEMesh_Class, ONLY: FEMesh_, FEMesh_Pointer +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Display +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Display +LOGICAL(LGT) :: abool + +CALL Display(obj%isInitiated, "AbstractDomain_::obj Initiated: ", unitno=unitno) +IF (.NOT. obj%isInitiated) RETURN + +CALL Display("engine: "//obj%engine, unitno=unitno) +CALL Display("majorVersion: "//tostring(obj%majorVersion), unitno=unitno) +CALL Display("minorVersion: "//tostring(obj%minorVersion), unitno=unitno) +CALL Display("version: "//tostring(obj%version), unitno=unitno) +CALL Display("nsd: "//tostring(obj%nsd), unitno=unitno) +CALL Display("maxNptrs: "//tostring(obj%maxNptrs), unitno=unitno) +CALL Display("minNptrs: "//tostring(obj%minNptrs), unitno=unitno) +CALL Display("tNodes: "//tostring(obj%tNodes), unitno=unitno) +CALL Display(obj%isNodeNumberSparse, "isNodeNumberSparse: ", unitno=unitno) +CALL Display("maxElemNum: "//tostring(obj%maxElemNum), unitno=unitno) +CALL Display("minElemNum: "//tostring(obj%minElemNum), unitno=unitno) +CALL Display(obj%isElemNumberSparse, "isElemNumberSparse: ", unitno=unitno) +CALL Display("tEntitiesForNodes: "//tostring(obj%tEntitiesForNodes), & + & unitno=unitno) +CALL Display("tEntitiesForElements: "//tostring(obj%tEntitiesForElements), & + & unitno=unitno) +CALL Display("tEntitiesForElements: "//tostring(obj%tEntitiesForElements), & + & unitno=unitno) +CALL Display("tElements: "//tostring(obj%tElements), & + & unitno=unitno) +CALL Display("tEntities: "//tostring(obj%tEntities), & + & unitno=unitno) + +abool = ALLOCATED(obj%nodeCoord) +CALL Display(abool, "nodeCoord Allocated: ", unitno=unitno) + +abool = ASSOCIATED(obj%meshVolume) +CALL Display(abool, "meshVolume ASSOCIATED: ", unitno=unitno) +IF (abool) THEN + CALL BlankLines(nol=1, unitno=unitno) + CALL obj%meshVolume%DisplayMeshInfo("Volume Mesh Info:", unitno=unitno) + CALL BlankLines(nol=1, unitno=unitno) +END IF + +abool = ASSOCIATED(obj%meshSurface) +CALL Display(abool, "meshSurface ASSOCIATED: ", unitno=unitno) +IF (abool) THEN + CALL BlankLines(nol=1, unitno=unitno) + CALL obj%meshSurface%DisplayMeshInfo("Surface Mesh Info:", unitno=unitno) + CALL BlankLines(nol=1, unitno=unitno) +END IF + +abool = ASSOCIATED(obj%meshCurve) +CALL Display(abool, "meshCurve ASSOCIATED: ", unitno=unitno) +IF (abool) THEN + CALL BlankLines(nol=1, unitno=unitno) + CALL obj%meshCurve%DisplayMeshInfo("Curve Mesh Info:", unitno=unitno) + CALL BlankLines(nol=1, unitno=unitno) +END IF + +abool = ASSOCIATED(obj%meshPoint) +CALL Display(abool, "meshPoint ASSOCIATED: ", unitno=unitno) +IF (abool) THEN + CALL BlankLines(nol=1, unitno=unitno) + CALL obj%meshPoint%DisplayMeshInfo("Point Mesh Info:", unitno=unitno) + CALL BlankLines(nol=1, unitno=unitno) +END IF + +abool = ASSOCIATED(obj%mesh) +CALL Display(abool, "mesh ASSOCIATED: ", unitno=unitno) + +CALL Display(obj%meshMap%isInitiated, "meshMap Initiated: ", unitno=unitno) + +END PROCEDURE obj_Display + +!---------------------------------------------------------------------------- +! DisplaDomainInfo +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_DisplayDomainInfo +LOGICAL(LGT) :: abool + +CALL Display(obj%isInitiated, "AbstractDomain_::obj Initiated: ", & + unitno=unitno) +IF (.NOT. obj%isInitiated) RETURN + +CALL EqualLine(unitno=unitno) +CALL Display("engine: "//obj%engine, unitno=unitno) +CALL Display("version: "//tostring(obj%version), unitno=unitno) +CALL Display("nsd: "//tostring(obj%nsd), unitno=unitno) +CALL Display("minNptrs: "//tostring(obj%minNptrs), unitno=unitno) +CALL Display("maxNptrs: "//tostring(obj%maxNptrs), unitno=unitno) +CALL Display("minElemNum: "//tostring(obj%minElemNum), unitno=unitno) +CALL Display("maxElemNum: "//tostring(obj%maxElemNum), unitno=unitno) + +CALL Display("tNodes: "//tostring(obj%tNodes), unitno=unitno) + +CALL Display("tEntitiesForNodes: "//tostring(obj%tEntitiesForNodes), & + & unitno=unitno) + +CALL Display("tEntitiesForElements: "//tostring(obj%tEntitiesForElements), & + & unitno=unitno) + +CALL Display("tElements: "//tostring(obj%tElements), unitno=unitno) + +CALL Display("Total mesh of volume: "//tostring(obj%tEntities(3)), & + & unitno=unitno) + +CALL Display("Total mesh of surface: "//tostring(obj%tEntities(2)), & + & unitno=unitno) + +CALL Display("Total mesh of curve: "//tostring(obj%tEntities(1)), & + & unitno=unitno) + +CALL Display("Total mesh of point: "//tostring(obj%tEntities(0)), & + & unitno=unitno) + +SELECT CASE (obj%nsd) +CASE (3) + abool = ASSOCIATED(obj%meshVolume) + CALL Display(abool, "meshVolume ASSOCIATED: ", unitno=unitno) + IF (abool) THEN + CALL obj%meshVolume%DisplayMeshInfo("Volume Mesh Info:", unitno=unitno) + END IF +CASE (2) + abool = ASSOCIATED(obj%meshSurface) + CALL Display(abool, "meshSurface ASSOCIATED: ", unitno=unitno) + IF (abool) THEN + CALL obj%meshSurface%DisplayMeshInfo("Surface Mesh Info:", unitno=unitno) + END IF +CASE (1) + abool = ASSOCIATED(obj%meshCurve) + CALL Display(abool, "meshCurve ASSOCIATED: ", unitno=unitno) + IF (abool) THEN + CALL obj%meshCurve%DisplayMeshInfo("Curve Mesh Info:", unitno=unitno) + END IF +CASE (0) + abool = ASSOCIATED(obj%meshPoint) + CALL Display(abool, "meshPoint ASSOCIATED: ", unitno=unitno) + IF (abool) THEN + CALL obj%meshPoint%DisplayMeshInfo("Point Mesh Info:", unitno=unitno) + END IF +END SELECT + +END PROCEDURE obj_DisplayDomainInfo + +!---------------------------------------------------------------------------- +! Import +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Import +CHARACTER(*), PARAMETER :: myName = "AbstractDomain_Import()" + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Calling AbstractDomainImportCheckErr()') +#endif + +CALL AbstractDomainImportCheckErr(obj=obj, hdf5=hdf5, myName=myName) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Calling AbstractDomainImportMetaData') +#endif + +CALL AbstractDomainImportMetaData(obj=obj, hdf5=hdf5, group=group, & + myName=myName) + +IF (obj%nsd .EQ. 3_I4B) THEN + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Importing meshVolume') +#endif + + obj%meshVolume => FEMesh_Pointer() + CALL obj%meshVolume%Initiate(hdf5=hdf5, group=group, dim=3_I4B) + obj%tElements(3) = obj%meshVolume%GetTotalElements() +END IF + +IF (obj%nsd .GT. 1_I4B) THEN + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Importing meshSurface') +#endif + + obj%meshSurface => FEMesh_Pointer() + CALL obj%meshSurface%Initiate(hdf5=hdf5, group=group, dim=2_I4B) + obj%tElements(2) = obj%meshSurface%GetTotalElements() + +END IF + +IF (obj%nsd .GE. 1_I4B) THEN + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Importing meshCurve') +#endif + + obj%meshCurve => FEMesh_Pointer() + CALL obj%meshCurve%Initiate(hdf5=hdf5, group=group, dim=1_I4B) + obj%tElements(1) = obj%meshCurve%GetTotalElements() + +END IF + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Importing meshPoint') +#endif + +obj%meshPoint => FEMesh_Pointer() +CALL obj%meshPoint%Initiate(hdf5=hdf5, group=group, dim=0_I4B) +obj%tElements(0) = obj%meshPoint%GetTotalElements() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_Import + +!---------------------------------------------------------------------------- +! AbstractDomainImportCheckErr +!---------------------------------------------------------------------------- + +SUBROUTINE AbstractDomainImportCheckErr(obj, hdf5, myName) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + CHARACTER(*), INTENT(IN) :: myName + + ! internal variable + LOGICAL(LGT) :: problem + + problem = obj%isInitiated + + IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: AbstractDomain_Class::obj is already initiated.") + RETURN + END IF + + problem = .NOT. hdf5%isOpen() + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[INTERNAL ERROR] :: HDF5 file is not opened') + RETURN + END IF + + problem = .NOT. hdf5%isRead() + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[INTERNAL ERROR] :: HDF5 file does not have read permission') + RETURN + END IF +END SUBROUTINE AbstractDomainImportCheckErr + +!---------------------------------------------------------------------------- +! AbstractDomainImportMetaData +!---------------------------------------------------------------------------- + +SUBROUTINE AbstractDomainImportMetaData(obj, hdf5, group, myName) + CLASS(AbstractDomain_), INTENT(INOUT) :: obj + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + CHARACTER(*), INTENT(IN) :: group + CHARACTER(*), INTENT(IN) :: myName + + obj%isInitiated = .TRUE. + + ! read engine + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%engine, fieldname="engine", myName=myName, modName=modName) + + ! read majorVersion + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%majorVersion, fieldname="majorVersion", myName=myName, & + & modName=modName) + + ! read minorVersion + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%minorVersion, fieldname="minorVersion", myName=myName, & + & modName=modName) + + ! read version + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%version, fieldname="version", myName=myName, & + & modName=modName) + + ! read NSD + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%NSD, fieldname="NSD", myName=myName, & + & modName=modName) + + ! maxNptrs + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%maxNptrs, fieldname="maxNptrs", myName=myName, & + & modName=modName) + + ! minNptrs + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%minNptrs, fieldname="minNptrs", myName=myName, & + & modName=modName) + + ! tNodes + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tNodes, fieldname="tNodes", myName=myName, & + & modName=modName) + + ! nodeCoord + CALL HDF5ReadMatrix(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%nodeCoord, fieldname="nodeCoord", myName=myName, & + & modName=modName) + + ! is node number sparse + IF ((obj%maxNptrs - obj%minNptrs) .EQ. (obj%tNodes - 1)) THEN + obj%isNodeNumberSparse = .FALSE. + ELSE + obj%isNodeNumberSparse = .TRUE. + END IF + + ! maxElemNum + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%maxElemNum, fieldname="maxElemNum", myName=myName, & + & modName=modName) + + ! minElemNum + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%minElemNum, fieldname="minElemNum", myName=myName, & + & modName=modName) + + ! tEntitiesForNodes + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntitiesForNodes, fieldname="tEntitiesForNodes", & + & myName=myName, modName=modName) + + ! tEntitiesForElements + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntitiesForElements, fieldname="tEntitiesForElements", & + & myName=myName, modName=modName) + + ! numVolumeEntities + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntities(3), fieldname="numVolumeEntities", & + & myName=myName, modName=modName) + + ! numSurfaceEntities + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntities(2), fieldname="numSurfaceEntities", & + & myName=myName, modName=modName) + + ! numCurveEntities + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntities(1), fieldname="numCurveEntities", & + & myName=myName, modName=modName) + + ! numPointEntities + CALL HDF5ReadScalar(hdf5=hdf5, check=.TRUE., group=group, & + & VALUE=obj%tEntities(0), fieldname="numPointEntities", & + & myName=myName, modName=modName) + +END SUBROUTINE AbstractDomainImportMetaData + +!---------------------------------------------------------------------------- +! ImportFromToml +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_ImportFromToml1 +CHARACTER(*), PARAMETER :: myName = "AbstractDomain_ImportFromToml()" +TYPE(HDF5File_) :: meshfile +CHARACTER(:), ALLOCATABLE :: meshfilename, ext, group +CHARACTER(*), PARAMETER :: default_meshfilename = "mesh.h5" +CHARACTER(*), PARAMETER :: default_group = "" +INTEGER(I4B) :: origin, stat +LOGICAL(LGT) :: problem + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START]') +#endif + +CALL toml_get(table, "filename", meshfilename, default_meshfilename, & + & origin=origin, stat=stat) + +ext = getExtension(meshfilename) +problem = .NOT. ext .EQ. "h5" + +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: given filename is not HDF5File. '// & + & 'Extension should be "h5"') +END IF + +CALL toml_get(table, "group", group, default_group, & + & origin=origin, stat=stat) + +CALL meshfile%Initiate(meshfilename, mode="READ") +CALL meshfile%OPEN() +CALL obj%IMPORT(hdf5=meshfile, group=group) +CALL meshfile%DEALLOCATE() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_ImportFromToml1 + +!---------------------------------------------------------------------------- +! ImportFromToml +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_ImportFromToml2 +CHARACTER(*), PARAMETER :: myName = "AbstractDomain_ImportFromToml2()" +TYPE(toml_table), ALLOCATABLE :: table +TYPE(toml_table), POINTER :: node +INTEGER(I4B) :: origin, stat + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START]') +#endif + +CALL GetValue(table=table, afile=afile, filename=filename) + +node => NULL() +CALL toml_get(table, tomlName, node, origin=origin, requested=.FALSE., & + & stat=stat) + +IF (.NOT. ASSOCIATED(node)) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[CONFIG ERROR] :: following error occured while reading '// & + & 'the toml file :: cannot find '//tomlName//" table in config.") +END IF + +CALL obj%ImportFromToml(table=node) + +#ifdef DEBUG_VER +IF (PRESENT(printToml)) THEN +CALL Display(toml_serialize(node), "AbstractDomain toml config: "//CHAR_LF, & + & unitno=stdout) +END IF +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END]') +#endif + +END PROCEDURE obj_ImportFromToml2 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE IOMethods diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 new file mode 100644 index 000000000..15c70983d --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 @@ -0,0 +1,630 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(AbstractDomain_Class) MeshDataMethods +USE GlobalData, ONLY: stdout +USE BaseMethod +USE DomainConnectivity_Class +USE Kdtree2_Module, ONLY: Kdtree2_create +USE CPUTime_Class, ONLY: CPUTime_ + +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! InitiateKdtree +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateKdtree +INTEGER(I4B) :: nsd +CHARACTER(*), PARAMETER :: myName = "obj_InitiateKdtree()" + +#ifdef DEBUG_VER +LOGICAL(LGT) :: isok +#endif + +TYPE(CPUTime_) :: TypeCPUTime + +IF (obj%showTime) CALL TypeCPUTime%SetStartTime() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +CALL obj%DeallocateKdtree() + +#ifdef DEBUG_VER + +isok = ALLOCATED(obj%nodeCoord) +IF (.NOT. isok) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: AbstractDomain_::obj%nodeCoord not allocated') + RETURN +END IF + +#endif + +nsd = obj%nsd +! FUNCTION Kdtree2_create(input_data, dim, sort, rearrange) RESULT(mr) +obj%kdtree => Kdtree2_Create(input_data=obj%nodeCoord(1:nsd, :), & + dim=nsd, sort=.FALSE., rearrange=.TRUE.) + +ALLOCATE (obj%kdresult(obj%tNodes)) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +IF (obj%showTime) THEN + CALL TypeCPUTime%SetEndTime() + CALL Display(modName//" : "//myName// & + & " : time : "// & + & tostring(TypeCPUTime%GetTime()), unitno=stdout) +END IF + +END PROCEDURE obj_InitiateKdtree + +!---------------------------------------------------------------------------- +! InitiateNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateNodeToElements +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateNodeToElements()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateNodeToElements() +CALL obj%meshSurface%InitiateNodeToElements() +CALL obj%meshCurve%InitiateNodeToElements() +CALL obj%meshPoint%InitiateNodeToElements() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER +END PROCEDURE obj_InitiateNodeToElements + +!---------------------------------------------------------------------------- +! InitiateNodeToNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateNodeToNodes +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateExtraNodeToNodes()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateNodeToNodes() +CALL obj%meshSurface%InitiateNodeToNodes() +CALL obj%meshCurve%InitiateNodeToNodes() +CALL obj%meshPoint%InitiateNodeToNodes() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER +END PROCEDURE obj_InitiateNodeToNodes + +!---------------------------------------------------------------------------- +! InitiateElementToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateElementToElements +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateElementToElements()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateElementToElements() +CALL obj%meshSurface%InitiateElementToElements() +CALL obj%meshCurve%InitiateElementToElements() +CALL obj%meshPoint%InitiateElementToElements() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER + +END PROCEDURE obj_InitiateElementToElements + +!---------------------------------------------------------------------------- +! InitiateBoundaryData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateBoundaryData +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateBoundaryData()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateBoundaryData() +CALL obj%meshSurface%InitiateBoundaryData() +CALL obj%meshCurve%InitiateBoundaryData() +CALL obj%meshPoint%InitiateBoundaryData() +CALL obj%SetFacetElementType() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER +END PROCEDURE obj_InitiateBoundaryData + +!---------------------------------------------------------------------------- +! InitiateFacetElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateFacetElements +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetElements()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateFacetElements() +CALL obj%meshSurface%InitiateFacetElements() +CALL obj%meshCurve%InitiateFacetElements() +CALL obj%meshPoint%InitiateFacetElements() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER +END PROCEDURE obj_InitiateFacetElements + +!---------------------------------------------------------------------------- +! InitiateExtraNodeToNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateExtraNodeToNodes +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateExtraNodeToNodes()" + +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +CALL obj%meshVolume%InitiateExtraNodeToNodes() +CALL obj%meshSurface%InitiateExtraNodeToNodes() +CALL obj%meshCurve%InitiateExtraNodeToNodes() +CALL obj%meshPoint%InitiateExtraNodeToNodes() + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER + +END PROCEDURE obj_InitiateExtraNodeToNodes + +!---------------------------------------------------------------------------- +! SetFacetElementType +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetFacetElementType +CHARACTER(*), PARAMETER :: myName = "obj_SetFacetElementType" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! CLASS(Mesh_), POINTER :: masterMesh, slaveMesh +! INTEGER(I4B) :: tsize, ii, jj, kk, iel, iface +! INTEGER(I4B), ALLOCATABLE :: faceID(:), faceNptrs(:) +! LOGICAL(LGT) :: isVar +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[START] ') +! #endif DEBUG_VER +! +! tsize = obj%GetTotalMesh(dim=obj%nsd) +! +! DO ii = 1, tsize +! +! masterMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=ii) +! +! CALL masterMesh%GetParam(isBoundaryDataInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & 'In masterMesh (nsd = '//tostring(obj%nsd)// & +! & ', entityNum = '//tostring(ii)// & +! & ' Boundary data is not initiated, calling '// & +! & ' InitiateBoundaryData') +! CALL masterMesh%InitiateBoundaryData() +! END IF +! +! DO iel = masterMesh%minElemNum, masterMesh%maxElemNum +! +! IF (.NOT. masterMesh%isElementPresent(iel)) CYCLE +! IF (.NOT. masterMesh%isBoundaryElement(iel)) CYCLE +! +! faceID = masterMesh%GetBoundaryElementData(globalElement=iel) +! +! DO iface = 1, SIZE(faceID) +! +! kk = faceID(iface) +! faceNptrs = masterMesh%GetFacetConnectivity(globalElement=iel, & +! & iface=kk) +! +! DO jj = 1, tsize +! IF (jj .NE. ii) THEN +! slaveMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=jj) +! IF (slaveMesh%isAllNodePresent(faceNptrs)) THEN +! CALL masterMesh%SetFacetElementType(globalElement=iel, & +! & iface=kk, facetElementType=BOUNDARY_ELEMENT) +! EXIT +! END IF +! END IF +! END DO +! +! END DO +! +! END DO +! +! END DO +! +! NULLIFY (masterMesh, slaveMesh) +! +! IF (ALLOCATED(faceID)) DEALLOCATE (faceID) +! IF (ALLOCATED(faceNptrs)) DEALLOCATE (faceNptrs) +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[END] ') +! #endif DEBUG_VER +! +END PROCEDURE obj_SetFacetElementType + +!---------------------------------------------------------------------------- +! SetDomainFacetElement +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetDomainFacetElement +CHARACTER(*), PARAMETER :: myName = "obj_SetDomainFacetElement" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! CLASS(Mesh_), POINTER :: masterMesh, slaveMesh +! INTEGER(I4B) :: tsize, ii, jj, iel, tDomFacet, tMeshFacet +! INTEGER(I4B), ALLOCATABLE :: faceNptrs(:) +! LOGICAL(LGT) :: faceFound, isVar +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[START] ') +! #endif DEBUG_VER +! +! tsize = obj%GetTotalMesh(dim=obj%nsd) +! +! DO ii = 1, tsize +! +! masterMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=ii) +! +! CALL masterMesh%GetParam(isFacetDataInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & 'In masterMesh (nsd = '//tostring(obj%nsd)// & +! & ', entityNum = '//tostring(ii)// & +! & ' Facet data is not initiated, calling '// & +! & ' InitiateFacetElements') +! CALL masterMesh%InitiateFacetElements() +! END IF +! +! tDomFacet = masterMesh%GetTotalBoundaryFacetElements() +! tMeshFacet = 0 +! +! DO iel = 1, tDomFacet +! +! faceNptrs = masterMesh%GetFacetConnectivity( & +! & facetElement=iel, & +! & elementType=DOMAIN_BOUNDARY_ELEMENT, & +! & isMaster=.TRUE.) +! +! faceFound = .FALSE. +! +! ! The code below checks if any other mesh contains the +! ! facetNptrs; if there exists such as mesh, then +! ! the face-element is actually meshFacet (not domainFacet). +! +! DO jj = 1, tsize +! IF (jj .NE. ii) THEN +! +! slaveMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=jj) +! +! IF (slaveMesh%isAllNodePresent(faceNptrs)) THEN +! +! faceFound = .TRUE. +! tMeshFacet = tMeshFacet + 1 +! EXIT +! +! END IF +! END IF +! END DO +! +! IF (faceFound) THEN +! masterMesh%boundaryFacetData(iel)%elementType = & +! & BOUNDARY_ELEMENT +! END IF +! +! END DO +! +! END DO +! +! NULLIFY (masterMesh, slaveMesh) +! IF (ALLOCATED(faceNptrs)) DEALLOCATE (faceNptrs) +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[END] ') +! #endif DEBUG_VER + +END PROCEDURE obj_SetDomainFacetElement + +!---------------------------------------------------------------------------- +! SetMeshMap +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMeshmap +CHARACTER(*), PARAMETER :: myName = "obj_SetMeshmap" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! CLASS(Mesh_), POINTER :: masterMesh, slaveMesh +! INTEGER(I4B) :: tsize, ii, jj, iel, tDomFacet, tMeshFacet +! INTEGER(I4B), ALLOCATABLE :: nptrs(:), meshmap(:, :) +! LOGICAL(LGT) :: isVar +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[START] ') +! #endif DEBUG_VER +! +! IF (ALLOCATED(obj%meshFacetData)) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'meshFacetData is already allocated... dellocate it first') +! END IF +! +! tsize = obj%GetTotalMesh(dim=obj%nsd) +! CALL Reallocate(meshmap, tsize, tsize) +! +! DO ii = 1, tsize +! +! masterMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=ii) +! tDomFacet = masterMesh%GetTotalBoundaryFacetElements() +! +! CALL masterMesh%GetParam(isFacetDataInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & 'In masterMesh (nsd = '//tostring(obj%nsd)// & +! & ', entityNum = '//tostring(ii)// & +! & ' Facet data is not initiated, calling '// & +! & ' InitiateFacetElements') +! CALL masterMesh%InitiateFacetElements() +! END IF +! +! DO jj = ii + 1, tsize +! +! slaveMesh => obj%GetMeshPointer(dim=obj%nsd, entityNum=jj) +! +! DO iel = 1, tDomFacet +! +! IF (masterMesh%boundaryFacetData(iel)%elementType & +! & .EQ. BOUNDARY_ELEMENT) THEN +! +! nptrs = masterMesh%GetFacetConnectivity( & +! & facetElement=iel, & +! & elementType=BOUNDARY_ELEMENT, & +! & isMaster=.TRUE.) +! +! IF (slaveMesh%isAllNodePresent(nptrs)) THEN +! +! meshmap(ii, jj) = 1 +! EXIT +! +! END IF +! +! END IF +! +! END DO +! +! END DO +! +! END DO +! +! tMeshFacet = COUNT(meshmap .EQ. 1) +! ! +! ! ALLOCATE meshFacetData +! ! +! ALLOCATE (obj%meshFacetData(tMeshFacet)) +! CALL Initiate(obj%meshMap, ncol=tsize, nrow=tsize) +! CALL SetSparsity(obj%meshMap, graph=meshmap) +! CALL SetSparsity(obj%meshMap) +! +! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! IF (ALLOCATED(meshmap)) DEALLOCATE (meshmap) +! NULLIFY (masterMesh, slaveMesh) +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[END] ') +! #endif DEBUG_VER +! +END PROCEDURE obj_SetMeshmap + +!---------------------------------------------------------------------------- +! SetMeshFacetElement +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMeshFacetElement +CHARACTER(*), PARAMETER :: myName = "obj_SetMeshFacetElement()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! CLASS(Mesh_), POINTER :: masterMesh, slaveMesh +! INTEGER(I4B) :: tSize, ii, imeshfacet, tBndyFacet_master, & +! & iface_slave, iface_master, tmeshfacet, tBndyFacet_slave +! INTEGER(I4B), ALLOCATABLE :: faceNptrs_master(:), faceNptrs_slave(:) +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[END] ') +! #endif DEBUG_VER +! +! ! main +! IF (.NOT. obj%meshmap%isInitiated) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & 'obj_::obj%meshMap is not initiated, calling obj%SetMeshMap()') +! CALL obj%SetMeshMap() +! END IF +! +! tsize = obj%GetTotalMesh(dim=obj%nsd) +! +! ! Set masterMesh and slaveMesh of meshFacetData +! DO ii = 1, tSize +! DO imeshfacet = obj%meshmap%IA(ii), obj%meshmap%IA(ii + 1) - 1 +! obj%meshFacetData(imeshfacet)%masterMesh = ii +! obj%meshFacetData(imeshfacet)%slaveMesh = obj%meshmap%JA(imeshfacet) +! END DO +! END DO +! +! ! Count number of facet element in each meshFacetData +! DO imeshfacet = 1, SIZE(obj%meshFacetData) +! masterMesh => obj%GetMeshPointer(dim=obj%nsd, & +! & entityNum=obj%meshFacetData(imeshfacet)%masterMesh) +! +! slaveMesh => obj%GetMeshPointer(dim=obj%nsd, & +! & entityNum=obj%meshFacetData(imeshfacet)%slaveMesh) +! +! tBndyFacet_master = masterMesh%GetTotalBoundaryFacetElements() +! tBndyFacet_slave = slaveMesh%GetTotalBoundaryFacetElements() +! +! ! count the number of facet elements in imeshfacet +! +! tmeshfacet = 0 +! +! DO iface_master = 1, tBndyFacet_master +! +! IF (masterMesh%boundaryFacetData(iface_master)%elementType .EQ. & +! & DOMAIN_BOUNDARY_ELEMENT) CYCLE +! +! faceNptrs_master = masterMesh%GetFacetConnectivity( & +! & facetElement=iface_master, & +! & elementType=BOUNDARY_ELEMENT, & +! & isMaster=.TRUE.) +! +! IF (slaveMesh%isAllNodePresent(faceNptrs_master)) & +! & tmeshfacet = tmeshfacet + 1 +! +! END DO +! +! ! Prepare data for imeshfacet +! CALL obj%meshFacetData(imeshfacet)%Initiate(tmeshfacet) +! +! ii = 0 +! +! DO iface_master = 1, tBndyFacet_master +! +! IF (masterMesh%boundaryFacetData(iface_master)%elementType .EQ. & +! & DOMAIN_BOUNDARY_ELEMENT) CYCLE +! +! faceNptrs_master = masterMesh%GetFacetConnectivity( & +! & facetElement=iface_master, & +! & elementType=BOUNDARY_ELEMENT, & +! & isMaster=.TRUE.) +! +! IF (slaveMesh%isAllNodePresent(faceNptrs_master)) THEN +! +! DO iface_slave = 1, tBndyFacet_slave +! +! IF (slaveMesh%boundaryFacetData(iface_slave)%elementType .EQ. & +! & DOMAIN_BOUNDARY_ELEMENT) CYCLE +! +! faceNptrs_slave = slaveMesh%GetFacetConnectivity( & +! & facetElement=iface_slave, & +! & elementType=BOUNDARY_ELEMENT, & +! & isMaster=.TRUE.) +! +! IF (faceNptrs_master.IN.faceNptrs_slave) THEN +! +! ii = ii + 1 +! +! ! masterCellNumber +! obj%meshFacetData(imeshfacet)%masterCellNumber(ii) = & +! & masterMesh%GetMasterCellNumber( & +! & facetElement=iface_master, & +! & elementType=BOUNDARY_ELEMENT) +! +! ! masterLocalFacetID +! obj%meshFacetData(imeshfacet)%masterLocalFacetID(ii) = & +! & masterMesh%GetLocalFacetID( & +! & facetElement=iface_master, & +! & isMaster=.TRUE., & +! & elementType=BOUNDARY_ELEMENT) +! +! ! slaveCellNumber +! obj%meshFacetData(imeshfacet)%slaveCellNumber(ii) = & +! & slaveMesh%GetMasterCellNumber( & +! & facetElement=iface_slave, & +! & elementType=BOUNDARY_ELEMENT) +! +! ! slaveLocalFacetID +! obj%meshFacetData(imeshfacet)%slaveLocalFacetID(ii) = & +! & slaveMesh%GetLocalFacetID( & +! & facetElement=iface_slave, & +! & isMaster=.TRUE., & +! & elementType=BOUNDARY_ELEMENT) +! +! EXIT +! +! END IF +! +! END DO +! +! END IF +! +! END DO +! +! END DO +! +! IF (ALLOCATED(faceNptrs_master)) DEALLOCATE (faceNptrs_master) +! IF (ALLOCATED(faceNptrs_slave)) DEALLOCATE (faceNptrs_slave) +! NULLIFY (masterMesh, slaveMesh) +! +! #ifdef DEBUG_VER +! CALL e%RaiseInformation(modName//'::'//myName//' - '// & +! & '[END] ') +! #endif DEBUG_VER + +END PROCEDURE obj_SetMeshFacetElement + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE MeshDataMethods diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 new file mode 100644 index 000000000..bc1afe90c --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -0,0 +1,472 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(AbstractDomain_Class) SetMethods +USE FEDomainConnectivity_Class, ONLY: FEDomainConnectivity_ +USE CSRMatrix_Method +USE BoundingBox_Method +USE Display_Method +USE InputUtility +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! SetShowTime +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetShowTime +obj%showTime = VALUE +END PROCEDURE obj_SetShowTime + +!---------------------------------------------------------------------------- +! SetSparsity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetSparsity1 +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" +#ifdef DEBUG_VER + +IF (.NOT. obj%isInitiated) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: Domain is not initiated, first initiate") + RETURN +END IF +#endif + +SELECT CASE (obj%nsd) +CASE (0) + CALL obj%meshPoint%SetSparsity(mat=mat) +CASE (1) + CALL obj%meshCurve%SetSparsity(mat=mat) +CASE (2) + CALL obj%meshSurface%SetSparsity(mat=mat) +CASE (3) + CALL obj%meshVolume%SetSparsity(mat=mat) +CASE DEFAULT + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: No case found for nsd='//tostring(obj%nsd)) + RETURN +END SELECT + +CALL SetSparsity(mat) + +END PROCEDURE obj_SetSparsity1 + +!---------------------------------------------------------------------------- +! SetSparsity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetSparsity2 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" +INTEGER(I4B) :: ivar, nsd(SIZE(domains)) +LOGICAL(LGT) :: problem +#endif + +CHARACTER(:), ALLOCATABLE :: matProp + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +#ifdef DEBUG_VER + +DO ivar = 1, SIZE(domains) + + problem = .NOT. ASSOCIATED(domains(ivar)%ptr) + IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & '[INTERNAL ERROR] :: domains('//Tostring(ivar)//') NOT ASSOCIATED') + RETURN + END IF + + problem = .NOT. domains(ivar)%ptr%isInitiated + IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & '[INTERNAL ERROR] :: domains('//Tostring(ivar)//')%ptr NOT INITIATED') + RETURN + END IF + + nsd(ivar) = domains(ivar)%ptr%GetNSD() + +END DO + +problem = ANY(nsd .NE. nsd(1)) +IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & '[INTERNAL ERROR] :: It seems that NSD of domains are not identical.') + RETURN +END IF + +#endif + +matProp = GetMatrixProp(mat) + +IF (matProp .EQ. "RECTANGLE") THEN + CALL part2_obj_Set_sparsity2(domains=domains, mat=mat) +ELSE + CALL part1_obj_Set_sparsity2(domains=domains, mat=mat) +END IF + +matProp = "" + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_SetSparsity2 + +!---------------------------------------------------------------------------- +! part1_obj_Set_sparsity2 +!---------------------------------------------------------------------------- + +SUBROUTINE part1_obj_Set_sparsity2(domains, mat) + CLASS(AbstractDomainPointer_), INTENT(IN) :: domains(:) + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + + ! internal variables + CHARACTER(*), PARAMETER :: myName = "part1_obj_Set_sparsity2()" + INTEGER(I4B) :: ivar, jvar + CLASS(AbstractDomain_), POINTER :: rowDomain, colDomain + CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh + TYPE(FEDomainConnectivity_) :: domainConn + INTEGER(I4B), POINTER :: nodeToNode(:) + LOGICAL(LGT) :: isdebug + + isdebug = .FALSE. + +#ifdef DEBUG_VER + CALL e%raiseInformation(modName//'::'//myName//' - '// & + & '[START]') + isdebug = .TRUE. +#endif + + ! nullify first for safety + rowMesh => NULL() + colMesh => NULL() + rowDomain => NULL() + colDomain => NULL() + + DO ivar = 1, SIZE(domains) + + IF (isdebug) CALL Display("row domain = "//tostring(ivar)) + + rowDomain => domains(ivar)%ptr + IF (.NOT. ASSOCIATED(rowDomain)) CYCLE + + rowMesh => rowDomain%GetMeshPointer(dim=rowDomain%GetNSD()) + IF (.NOT. ASSOCIATED(rowMesh)) CYCLE + IF (rowMesh%isEmpty()) CYCLE + + DO jvar = 1, SIZE(domains) + + IF (isdebug) CALL Display("col domain = "//tostring(jvar)) + + colDomain => domains(jvar)%ptr + IF (.NOT. ASSOCIATED(colDomain)) CYCLE + + colMesh => colDomain%GetMeshPointer(dim=colDomain%GetNSD()) + IF (.NOT. ASSOCIATED(colMesh)) CYCLE + IF (colMesh%isEmpty()) CYCLE + + CALL domainConn%DEALLOCATE() + CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & + & domain2=colDomain) + nodeToNode => domainConn%GetNodeToNodePointer() + + CALL rowMesh%SetSparsity( & + & mat=mat, & + & colMesh=colMesh, & + & nodeToNode=nodeToNode, & + & ivar=ivar, & + & jvar=jvar) + + END DO + END DO + + CALL SetSparsity(mat) + NULLIFY (rowMesh, colMesh, rowDomain, colDomain, nodeToNode) + CALL domainConn%DEALLOCATE() + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END SUBROUTINE part1_obj_Set_sparsity2 + +!---------------------------------------------------------------------------- +! part2_obj_Set_sparsity2 +!---------------------------------------------------------------------------- + +SUBROUTINE part2_obj_Set_sparsity2(domains, mat) + CLASS(AbstractDomainPointer_), INTENT(IN) :: domains(2) + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + + ! internal variables + CHARACTER(*), PARAMETER :: myName = "part2_obj_Set_sparsity2()" + INTEGER(I4B), PARAMETER :: tvar = 2, ivar = 1, jvar = 1 + INTEGER(I4B) :: nsd(tvar), ii + CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh + CLASS(AbstractDomain_), POINTER :: rowDomain, colDomain + TYPE(FEDomainConnectivity_) :: domainConn + INTEGER(I4B), POINTER :: nodeToNode(:) + LOGICAL(LGT) :: problem + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + + DO ii = 1, tvar + nsd(ii) = domains(ii)%ptr%GetNSD() + END DO + + rowDomain => NULL() + colDomain => NULL() + rowDomain => domains(1)%ptr + colDomain => domains(2)%ptr + +#ifdef DEBUG_VER + + problem = (.NOT. ASSOCIATED(rowDomain)) .OR. (.NOT. ASSOCIATED(colDomain)) + + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: rowMesh not ASSOCIATED') + RETURN + END IF + +#endif + + rowMesh => NULL() + colMesh => NULL() + rowMesh => rowDomain%GetMeshPointer(dim=nsd(1)) + colMesh => colDomain%GetMeshPointer(dim=nsd(2)) + +#ifdef DEBUG_VER + + problem = (.NOT. ASSOCIATED(rowMesh)) .OR. (.NOT. ASSOCIATED(colMesh)) + + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: rowMesh or colMesh not ASSOCIATED') + RETURN + END IF + +#endif + + CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & + & domain2=colDomain) + nodeToNode => domainConn%GetNodeToNodePointer() + + CALL rowMesh%SetSparsity(mat=mat, colMesh=colMesh, & + nodeToNode=nodeToNode, ivar=ivar, jvar=jvar) + + CALL SetSparsity(mat) + + NULLIFY (rowMesh, colMesh, rowDomain, colDomain, nodeToNode) + + CALL domainConn%DEALLOCATE() + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END SUBROUTINE part2_obj_Set_sparsity2 + +!---------------------------------------------------------------------------- +! SetTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetTotalMaterial +SELECT CASE (dim) +CASE (0) + CALL obj%meshPoint%SetTotalMaterial(n) +CASE (1) + CALL obj%meshCurve%SetTotalMaterial(n) +CASE (2) + CALL obj%meshSurface%SetTotalMaterial(n) +CASE (3) + CALL obj%meshVolume%SetTotalMaterial(n) +END SELECT +END PROCEDURE obj_SetTotalMaterial + +!---------------------------------------------------------------------------- +! SetTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMaterial +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial()" +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +SELECT CASE (dim) +CASE (0) + CALL obj%meshPoint%SetMaterial(medium=medium, material=material, & + entityNum=entityNum) +CASE (1) + CALL obj%meshCurve%SetMaterial(medium=medium, material=material, & + entityNum=entityNum) +CASE (2) + CALL obj%meshSurface%SetMaterial(medium=medium, material=material, & + entityNum=entityNum) +CASE (3) + CALL obj%meshVolume%SetMaterial(medium=medium, material=material, & + entityNum=entityNum) +END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_SetMaterial + +!---------------------------------------------------------------------------- +! SetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetNodeCoord1 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_SetNodeCoord1()" +LOGICAL(LGT) :: problem +#endif + +REAL(DFP) :: scale0 +LOGICAL(LGT) :: add0 +INTEGER(I4B) :: ii, tnodes, nsd + +#ifdef DEBUG_VER + +problem = .NOT. ALLOCATED(obj%nodeCoord) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: AbstractDomain_::obj%nodeCoord not allocated') + RETURN +END IF + +problem = ALL(SHAPE(nodeCoord) .NE. SHAPE(obj%nodeCoord)) + +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: Shape of nodeCoord does not match '// & + & 'with obj_::obj%nodeCoord') + RETURN +END IF +#endif + +scale0 = Input(option=scale, default=1.0_DFP) +add0 = Input(option=addContribution, default=.FALSE.) +tnodes = SIZE(nodeCoord, 2) +nsd = obj%nsd + +IF (add0) THEN + DO CONCURRENT(ii=1:tnodes) + obj%nodeCoord(1:nsd, ii) = nodeCoord(1:nsd, ii) * scale0 & + + obj%nodeCoord(1:nsd, ii) + END DO + RETURN +END IF + +! make do concurrent loop for setting obj%nodeCoord to nodeCoord +DO CONCURRENT(ii=1:tnodes) + obj%nodeCoord(1:nsd, ii) = nodeCoord(1:nsd, ii) +END DO + +END PROCEDURE obj_SetNodeCoord1 + +!---------------------------------------------------------------------------- +! SetQuality +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetQuality +CHARACTER(*), PARAMETER :: myName = "obj_SetQuality()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +! CLASS(Mesh_), POINTER :: meshptr +! CHARACTER(*), PARAMETER :: myName = "obj_SetQuality" +! REAL(DFP), ALLOCATABLE :: max_(:, :), min_(:, :) +! INTEGER(I4B) :: tmesh, imesh, dim0 +! +! +! dim0 = Input(default=obj%nsd, option=dim) +! +! IF (PRESENT(dim) .AND. PRESENT(entityNum)) THEN +! meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum) +! IF (meshptr%GetTotalElements() .EQ. 0) THEN +! CALL e%RaiseWarning(modName//'::'//myName//' - '// & +! & 'mesh if empty') +! ELSE +! CALL meshptr%SetQuality(& +! & measures=measures, & +! & max_measures=max_measures, & +! & min_measures=min_measures, & +! & nodeCoord=obj%nodeCoord, & +! & local_nptrs=obj%local_nptrs & +! & ) +! END IF +! NULLIFY (meshptr) +! RETURN +! END IF +! +! IF (PRESENT(dim) .AND. .NOT. PRESENT(entityNum)) THEN +! tmesh = obj%GetTotalMesh(dim=dim) +! CALL Reallocate(max_, SIZE(measures), tmesh) +! min_ = max_ +! +! DO imesh = 1, tmesh +! meshptr => obj%GetMeshPointer(dim=dim, entityNum=imesh) +! IF (meshptr%GetTotalElements() .EQ. 0) THEN +! max_(:, imesh) = -1 * MaxDFP +! min_(:, imesh) = MaxDFP +! ELSE +! CALL meshptr%SetQuality(& +! & measures=measures, & +! & max_measures=max_(:, imesh), & +! & min_measures=min_(:, imesh), & +! & nodeCoord=obj%nodeCoord, & +! & local_nptrs=obj%local_nptrs & +! & ) +! END IF +! END DO +! +! max_measures = MAXVAL(max_, dim=2) +! min_measures = MINVAL(min_, dim=2) +! NULLIFY (meshptr) +! DEALLOCATE (max_, min_) +! RETURN +! END IF +! +! CALL e%RaiseError(modName//'::'//myName//' - '// & +! & 'No case found') + +END PROCEDURE obj_SetQuality + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE SetMethods diff --git a/src/submodules/AbstractKernel/src/AbstractKernel_Class@ConstructorMethods.F90 b/src/submodules/AbstractKernel/src/AbstractKernel_Class@ConstructorMethods.F90 index ba672ecc7..74fc18500 100644 --- a/src/submodules/AbstractKernel/src/AbstractKernel_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractKernel/src/AbstractKernel_Class@ConstructorMethods.F90 @@ -777,6 +777,7 @@ CALL AbstractMeshFieldDeallocate(obj%Cijkl) CALL AbstractMeshFieldDeallocate(obj%stress) CALL AbstractMeshFieldDeallocate(obj%strain) +CALL AbstractMeshFieldDeallocate(obj%scalarCoefficient) NULLIFY (obj%bodySourceFunc) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 8d622a2f3..5c3e85a44 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -56,9 +56,9 @@ SUBROUTINE InitiateElementToElements3D(elementData, tFaceInMesh, showTime) ! internal variables CHARACTER(*), PARAMETER :: myName = "obj_InitiateElementToElements3D()" - LOGICAL(LGT) :: problem, isok1, isok2 + LOGICAL(LGT) :: problem, isok1, isok2, isbndy INTEGER(I4B) :: telems, iel, aint, bint, tfaces, ii, jj, & - & temp1(3 * PARAM_REFELEM_MAX_FACES), cint + & temp1(3 * PARAM_REFELEM_MAX_FACES), cint, bndyflag(PARAM_REFELEM_MAX_FACES) INTEGER(I4B), ALLOCATABLE :: face2elem(:, :) LOGICAL(LGT), ALLOCATABLE :: amask(:) TYPE(CPUTime_) :: TypeCPUTime @@ -122,13 +122,17 @@ SUBROUTINE InitiateElementToElements3D(elementData, tFaceInMesh, showTime) IF (problem) CYCLE tfaces = SIZE(elementData(iel)%globalFaces) - jj = 0; temp1 = 0 + jj = 0 + temp1 = 0 + bndyflag = 0 DO ii = 1, tfaces aint = ABS(elementData(iel)%globalFaces(ii)) bint = face2elem(1, aint) isok1 = bint .NE. iel isok2 = bint .NE. 0 + IF (amask(aint)) bndyflag(ii) = 1_I4B + IF (isok1 .AND. isok2) THEN jj = jj + 1 temp1(1 + (jj - 1) * 3) = elementData(bint)%globalElemNum @@ -147,10 +151,35 @@ SUBROUTINE InitiateElementToElements3D(elementData, tFaceInMesh, showTime) END IF END DO +#ifdef DEBUG_VER + IF (jj .EQ. 0) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: jj = 0 found, somethign is wrong') + RETURN + END IF +#endif + aint = jj * 3 CALL Reallocate(elementData(iel)%globalElements, aint) elementData(iel)%globalElements = temp1(1:aint) + aint = tfaces - jj + CALL Reallocate(elementData(iel)%boundaryData, aint) + isbndy = jj .NE. tfaces + + IF (isbndy) THEN + elementData(iel)%elementType = TypeElem%domainBoundary + jj = 0 + DO ii = 1, tfaces + IF (bndyflag(ii) .NE. 0) THEN + jj = jj + 1 + elementData(iel)%boundaryData(jj) = ii + END IF + END DO + ELSE + elementData(iel)%elementType = TypeElem%internal + END IF + END DO IF (ALLOCATED(face2elem)) DEALLOCATE (face2elem) @@ -181,9 +210,9 @@ SUBROUTINE InitiateElementToElements2D(elementData, tEdgeInMesh, showTime) ! internal variables CHARACTER(*), PARAMETER :: myName = "InitiateElementToElements2D()" - LOGICAL(LGT) :: problem, isok1, isok2 + LOGICAL(LGT) :: problem, isok1, isok2, isbndy INTEGER(I4B) :: telems, iel, aint, bint, tedges, ii, jj, temp1(3 * 4), & - & cint + & cint, bndyflag(4) INTEGER(I4B), ALLOCATABLE :: edge2elem(:, :) LOGICAL(LGT), ALLOCATABLE :: amask(:) TYPE(CPUTime_) :: TypeCPUTime @@ -249,12 +278,15 @@ SUBROUTINE InitiateElementToElements2D(elementData, tEdgeInMesh, showTime) tedges = SIZE(elementData(iel)%globalEdges) jj = 0 temp1 = 0 + bndyflag = 0 DO ii = 1, tedges aint = ABS(elementData(iel)%globalEdges(ii)) bint = edge2elem(1, aint) isok1 = bint .NE. iel isok2 = bint .NE. 0 + IF (amask(aint)) bndyflag(ii) = 1_I4B + IF (isok1 .AND. isok2) THEN jj = jj + 1 temp1(1 + (jj - 1) * 3) = elementData(bint)%globalElemNum @@ -272,10 +304,35 @@ SUBROUTINE InitiateElementToElements2D(elementData, tEdgeInMesh, showTime) END IF END DO +#ifdef DEBUG_VER + IF (jj .EQ. 0) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: jj = 0 found, somethign is wrong') + RETURN + END IF +#endif + aint = jj * 3 CALL Reallocate(elementData(iel)%globalElements, aint) elementData(iel)%globalElements = temp1(1:aint) + aint = tedges - jj + CALL Reallocate(elementData(iel)%boundaryData, aint) + isbndy = jj .NE. tedges + + IF (isbndy) THEN + elementData(iel)%elementType = TypeElem%domainBoundary + jj = 0 + DO ii = 1, tedges + IF (bndyflag(ii) .NE. 0) THEN + jj = jj + 1 + elementData(iel)%boundaryData(jj) = ii + END IF + END DO + ELSE + elementData(iel)%elementType = TypeElem%internal + END IF + END DO IF (ALLOCATED(amask)) DEALLOCATE (amask) @@ -308,9 +365,9 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & ! ! internal variables CHARACTER(*), PARAMETER :: myName = "InitiateElementToElements1D()" - LOGICAL(LGT) :: problem, isok1, isok2 + LOGICAL(LGT) :: problem, isok1, isok2, isbndy INTEGER(I4B) :: telems, iel, aint, bint, tNodes, ii, jj, temp1(3 * 2), & - & cint + & cint, bndyflag(2) INTEGER(I4B), ALLOCATABLE :: node2elem(:, :) LOGICAL(LGT), ALLOCATABLE :: amask(:) TYPE(CPUTime_) :: TypeCPUTime @@ -368,14 +425,15 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & END DO + tNodes = 2 DO iel = 1, telems problem = .NOT. elementData(iel)%isActive IF (problem) CYCLE - tNodes = SIZE(elementData(iel)%globalNodes) jj = 0 temp1 = 0 + bndyflag = 0 DO ii = 1, 2 aint = elementData(iel)%globalNodes(ii) aint = local_nptrs(aint) @@ -383,6 +441,8 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & isok1 = bint .NE. iel isok2 = bint .NE. 0 + IF (amask(aint)) bndyflag(ii) = 1_I4B + IF (isok1 .AND. isok2) THEN jj = jj + 1 temp1(1 + (jj - 1) * 3) = elementData(bint)%globalElemNum @@ -400,10 +460,35 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & END IF END DO +#ifdef DEBUG_VER + IF (jj .EQ. 0) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: jj = 0 found, somethign is wrong') + RETURN + END IF +#endif + aint = jj * 3 CALL Reallocate(elementData(iel)%globalElements, aint) elementData(iel)%globalElements = temp1(1:aint) + aint = tNodes - jj + CALL Reallocate(elementData(iel)%boundaryData, aint) + isbndy = jj .NE. tNodes + + IF (isbndy) THEN + elementData(iel)%elementType = TypeElem%domainBoundary + jj = 0 + DO ii = 1, tNodes + IF (bndyflag(ii) .NE. 0) THEN + jj = jj + 1 + elementData(iel)%boundaryData(jj) = ii + END IF + END DO + ELSE + elementData(iel)%elementType = TypeElem%internal + END IF + END DO IF (ALLOCATED(amask)) DEALLOCATE (amask) @@ -577,7 +662,8 @@ SUBROUTINE MeshImportVector(obj, hdf5, group, connectivity, elemNumber, & IF (PRESENT(internalNptrs)) THEN CALL HDF5ReadVector(hdf5=hdf5, VALUE=internalNptrs, group=dsetname, & -& fieldname="intNodeNumber", myname=myname, modName=modName, check=.TRUE.) + & fieldname="intNodeNumber", myname=myname, modName=modName, & + & check=.TRUE.) END IF obj%maxElemNum = MAXVAL(elemNumber) @@ -585,6 +671,8 @@ SUBROUTINE MeshImportVector(obj, hdf5, group, connectivity, elemNumber, & obj%maxNptrs = MAXVAL(connectivity) obj%minNptrs = MINVAL(connectivity) + dsetname = "" + END SUBROUTINE MeshImportVector !---------------------------------------------------------------------------- @@ -900,8 +988,8 @@ SUBROUTINE MeshImportFromDim(obj, hdf5, group, dim, entities, tEntities) xyz(3, ii) = obj%z aint = GetElementIndex(elemType(ii)) - obj%tElements_topology_wise(aint) = obj%tElements_topology_wise(aint) + & - & tElements(ii) + obj%tElements_topology_wise(aint) = obj%tElements_topology_wise(aint) & + & + tElements(ii) END DO diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@BoundaryDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@BoundaryDataMethods.F90 index 80ac71c2e..5132ef85f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@BoundaryDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@BoundaryDataMethods.F90 @@ -25,8 +25,26 @@ MODULE PROCEDURE obj_InitiateBoundaryData CHARACTER(*), PARAMETER :: myName = "obj_InitiateBoundaryData()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: This routine should be implemented by subclass.') +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +! check +IF (obj%isBoundaryDataInitiated) THEN + CALL e%RaiseInformation(modName//"::"//myName//" - "// & + & "Boundary data information is already initiated.") + RETURN +END IF + +CALL obj%InitiateElementToElements() + +obj%isBoundaryDataInitiated = .TRUE. + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif END PROCEDURE obj_InitiateBoundaryData !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ConstructorMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ConstructorMethods.F90 index 7648f5ffd..21c5badc0 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ConstructorMethods.F90 @@ -83,7 +83,6 @@ obj%X = 0.0_DFP obj%Y = 0.0_DFP obj%Z = 0.0_DFP -IF (ALLOCATED(obj%material)) DEALLOCATE (obj%material) IF (ALLOCATED(obj%boundingEntity)) DEALLOCATE (obj%boundingEntity) IF (ALLOCATED(obj%local_elemNumber)) DEALLOCATE (obj%local_elemNumber) IF (ALLOCATED(obj%local_Nptrs)) DEALLOCATE (obj%local_Nptrs) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 index 837e688c6..2f378938f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 @@ -16,10 +16,8 @@ ! SUBMODULE(AbstractMesh_Class) EdgeDataMethods -USE ReferenceElement_Method, ONLY: & - REFELEM_MAX_EDGES => PARAM_REFELEM_MAX_EDGES, & - REFELEM_MAX_POINTS => PARAM_REFELEM_MAX_POINTS, & - RefElemGetGeoParam +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_EDGES, & + & PARAM_REFELEM_MAX_POINTS, RefElemGetGeoParam USE ReferenceLine_Method, ONLY: MaxOrder_Line USE ReallocateUtility, ONLY: Reallocate USE EdgeData_Class @@ -36,7 +34,7 @@ MODULE PROCEDURE obj_InitiateEdgeConnectivity CHARACTER(*), PARAMETER :: myName = "obj_InitiateEdgeConnectivity()" INTEGER(I4B) :: tElements, iel, elemType, tEdges, & - & localEdges(MaxOrder_Line + 1, REFELEM_MAX_EDGES), & + & localEdges(MaxOrder_Line + 1, PARAM_REFELEM_MAX_EDGES), & & edge(2), sorted_edge(2), & & tNodes, tsize1, tsize2, iedge LOGICAL(LGT) :: problem diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 index e1dc4bfed..be37fb910 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 @@ -18,8 +18,7 @@ SUBMODULE(AbstractMesh_Class) ElementDataMethods USE ReallocateUtility USE Display_Method -USE ReferenceElement_Method, ONLY: & - REFELEM_MAX_FACES => PARAM_REFELEM_MAX_FACES +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES USE AbstractMeshUtility, ONLY: InitiateElementToElements3D, & & InitiateElementToElements2D, & & InitiateElementToElements1D @@ -50,6 +49,8 @@ #endif SELECT CASE (obj%xidim) +CASE (0_I4B) + CASE (1_I4B) CALL InitiateElementToElements1D( & @@ -78,11 +79,14 @@ CALL InitiateElementToElements3D(elementData=obj%elementData, & & tFaceInMesh=obj%tFaces, showTime=obj%showTime) -CASE default +CASE DEFAULT CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: No case found.') + & '[INTERNAL ERROR] :: No case found for xidim ' & + & //tostring(obj%xidim)) END SELECT +CALL MarkInternalNodes(obj=obj) + #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & & '[END] ') @@ -90,6 +94,51 @@ END PROCEDURE obj_InitiateElementToElements +!---------------------------------------------------------------------------- +! MarkInternalNodes +!---------------------------------------------------------------------------- + +SUBROUTINE MarkInternalNodes(obj) + CLASS(AbstractMesh_), INTENT(INOUT) :: obj + + INTEGER(I4B) :: ii, jj, tsize, tElements, kk + LOGICAL(LGT) :: isok + INTEGER(I4B), ALLOCATABLE :: nptrs(:) + CHARACTER(*), PARAMETER :: myName = "MarkInternalNodes()" + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + + IF (obj%xidim .EQ. 0) RETURN + + tElements = obj%GetTotalElements() + + DO ii = 1, tElements + + isok = .NOT. (obj%isBoundaryElement(ii, isLocal=.TRUE.)) + IF (isok) CYCLE + + tsize = SIZE(obj%elementData(ii)%boundaryData) + DO jj = 1, tsize + nptrs = obj%GetFacetConnectivity(globalElement=ii, & + & iface=obj%elementData(ii)%boundaryData(jj), & + & isLocal=.TRUE.) + DO kk = 1, SIZE(nptrs) + obj%nodeData(nptrs(kk))%nodeType = TypeNode%domainBoundary + END DO + END DO + + END DO + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END SUBROUTINE MarkInternalNodes + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 index 16c849c4b..993dd8751 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 @@ -16,9 +16,9 @@ ! SUBMODULE(AbstractMesh_Class) FaceDataMethods -USE ReferenceElement_Method, ONLY: & - REFELEM_MAX_FACES => PARAM_REFELEM_MAX_FACES, & - & REFELEM_MAX_POINTS => PARAM_REFELEM_MAX_POINTS, & + +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES, & + & PARAM_REFELEM_MAX_POINTS, & & RefElemGetGeoParam, & & IsQuadrangle @@ -41,9 +41,9 @@ MODULE PROCEDURE obj_InitiateFaceConnectivity CHARACTER(*), PARAMETER :: myName = "obj_InitiateFaceConnectivity()" INTEGER(I4B) :: tElements, iel, elemType, tFaces, & - & localFaces(4_I4B, REFELEM_MAX_FACES), face(4), sorted_face(4), & + & localFaces(4_I4B, PARAM_REFELEM_MAX_FACES), face(4), sorted_face(4), & & tNodes, tsize1, tsize2, iface, & - & faceElemType(REFELEM_MAX_FACES), tFaceNodes(REFELEM_MAX_FACES), & + & faceElemType(PARAM_REFELEM_MAX_FACES), tFaceNodes(PARAM_REFELEM_MAX_FACES), & & aint, faceOrient(3_I4B) LOGICAL(LGT) :: problem, abool TYPE(FaceDataBinaryTree_) :: faceTree diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 0df820e55..f0e29b41f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -21,8 +21,7 @@ USE BoundingBox_Method USE InputUtility USE Display_Method -USE ReferenceElement_Method, ONLY: & - REFELEM_MAX_FACES => PARAM_REFELEM_MAX_FACES, & +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES, & & GetEdgeConnectivity, & & GetFaceConnectivity, & & ElementOrder, & @@ -45,24 +44,8 @@ MODULE PROCEDURE obj_GetNNE INTEGER(I4B) :: iel - -#ifdef DEBUG_VER -LOGICAL(LGT) :: isok -#endif - -iel = obj%GetLocalElemNumber(globalElement) -ans = 0 - -#ifdef DEBUG_VER - -isok = ALLOCATED(obj%elementData(iel)%globalNodes) -IF (isok) ans = SIZE(obj%elementData(iel)%globalNodes) - -#else - +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) ans = SIZE(obj%elementData(iel)%globalNodes) - -#endif END PROCEDURE obj_GetNNE !---------------------------------------------------------------------------- @@ -89,7 +72,7 @@ INTEGER(I4B) :: ii CALL Reallocate(ans, obj%GetTotalElements()) DO ii = 1, SIZE(ans) - ans(ii) = obj%GetGlobalElemNumber(localElement=ii) + ans(ii) = obj%GetglobalElemNumber(localElement=ii) END DO END PROCEDURE obj_GetElemNum @@ -106,7 +89,7 @@ END PROCEDURE obj_GetBoundingEntity !---------------------------------------------------------------------------- -! GetNptrs +! GetNptrs !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrs @@ -116,6 +99,19 @@ END DO END PROCEDURE obj_GetNptrs +!---------------------------------------------------------------------------- +! GetNptrs_ +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrs_ +INTEGER(I4B) :: ii, n +n = SIZE(obj%nodeData) +DO CONCURRENT(ii=1:n) + nptrs(ii) = obj%nodeData(ii)%globalNodeNum +END DO +IF (PRESENT(tsize)) tsize = n +END PROCEDURE obj_GetNptrs_ + !---------------------------------------------------------------------------- ! GetInternalNptrs !---------------------------------------------------------------------------- @@ -133,6 +129,38 @@ END DO END PROCEDURE obj_GetInternalNptrs +!---------------------------------------------------------------------------- +! GetInternalNptrs +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetInternalNptrs_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetInternalNptrs_()" +LOGICAL(LGT) :: problem +#endif +INTEGER(I4B) :: ii, dummy + +dummy = obj%GetTotalInternalNodes() + +#ifdef DEBUG_VER +problem = dummy .GT. SIZE(nptrs) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: size of nptrs is not enough '// & + & 'it should be ateast '//tostring(dummy)) + RETURN +END IF +#endif + +dummy = 0 +DO ii = 1, obj%tNodes + IF (obj%nodeData(ii)%nodeType .EQ. INTERNAL_NODE) THEN + dummy = dummy + 1 + nptrs(dummy) = obj%nodeData(ii)%globalNodeNum + END IF +END DO +END PROCEDURE obj_GetInternalNptrs_ + !---------------------------------------------------------------------------- ! GetBoundaryNptrs !---------------------------------------------------------------------------- @@ -157,7 +185,7 @@ MODULE PROCEDURE obj_isBoundaryNode INTEGER(I4B) :: localnode -localnode = obj%GetLocalNodeNumber(GlobalNode) +localnode = obj%GetLocalNodeNumber(globalNode, islocal=islocal) ans = obj%nodeData(localnode)%nodeType .NE. INTERNAL_NODE END PROCEDURE obj_isBoundaryNode @@ -166,12 +194,21 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_isNodePresent1 -LOGICAL(LGT) :: abool +LOGICAL(LGT) :: abool, islocal0 + +islocal0 = Input(default=.FALSE., option=islocal) + +IF (islocal0) THEN + ans = (globalNode .GT. 0_I4B) .AND. (globalNode .LE. obj%tNodes) + +ELSE + + abool = globalNode .GT. obj%maxNptrs .OR. globalNode .LT. obj%minNptrs + ans = .NOT. abool + IF (ans) THEN + ans = obj%local_nptrs(globalNode) .GT. 0 + END IF -abool = globalNode .GT. obj%maxNptrs .OR. globalNode .LT. obj%minNptrs -ans = .NOT. abool -IF (ans) THEN - ans = obj%local_nptrs(globalNode) .GT. 0 END IF END PROCEDURE obj_isNodePresent1 @@ -183,10 +220,42 @@ MODULE PROCEDURE obj_isNodePresent2 INTEGER(I4B) :: ii DO ii = 1, SIZE(globalNode) - ans(ii) = obj%isNodePresent(globalNode(ii)) + ans(ii) = obj%isNodePresent(globalNode(ii), islocal=islocal) END DO END PROCEDURE obj_isNodePresent2 +!---------------------------------------------------------------------------- +! GetNodeMask +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeMask +INTEGER(I4B) :: ii, jj, kk, tsize +LOGICAL(LGT) :: isok + +isok = .NOT. PRESENT(local_nptrs) +mask = .FALSE. + +IF (isok) THEN + + tsize = SIZE(obj%nodeData) + DO CONCURRENT(ii=1:tsize) + jj = obj%nodeData(ii)%globalNodeNum + mask(jj) = .TRUE. + END DO + + RETURN + +END IF + +tsize = SIZE(obj%nodeData) +DO CONCURRENT(ii=1:tsize) + jj = obj%nodeData(ii)%globalNodeNum + kk = local_nptrs(jj) + mask(kk) = .TRUE. +END DO + +END PROCEDURE obj_GetNodeMask + !---------------------------------------------------------------------------- ! isAnyNodePresent !---------------------------------------------------------------------------- @@ -198,7 +267,7 @@ n = SIZE(globalNode) DO ii = 1, n - cond(ii) = obj%isNodePresent(globalNode=globalNode(ii)) + cond(ii) = obj%isNodePresent(globalNode=globalNode(ii), islocal=islocal) END DO ans = ANY(cond) @@ -215,7 +284,7 @@ n = SIZE(globalNode) DO ii = 1, n - cond(ii) = obj%isNodePresent(globalNode=globalNode(ii)) + cond(ii) = obj%isNodePresent(globalNode=globalNode(ii), islocal=islocal) END DO ans = ALL(cond) @@ -227,12 +296,24 @@ MODULE PROCEDURE obj_isElementPresent LOGICAL(LGT) :: isok +LOGICAL(LGT) :: islocal0 + +islocal0 = Input(default=.FALSE., option=islocal) + +IF (islocal0) THEN + ans = (globalElement .GT. 0_I4B) .AND. (globalElement .LT. obj%tElements) -isok = globalElement .GT. obj%maxElemNum & - & .OR. globalElement .LT. obj%minElemNum & - & .OR. obj%local_elemNumber(globalElement) .EQ. 0 +ELSE + isok = (globalElement .GT. obj%maxElemNum) .OR. & + & (globalElement .LT. obj%minElemNum) + + ans = .NOT. isok + + IF (ans) THEN + ans = .NOT. (isok .OR. obj%local_elemNumber(globalElement) .EQ. 0) + END IF +END IF -ans = .NOT. isok END PROCEDURE obj_isElementPresent !---------------------------------------------------------------------------- @@ -241,7 +322,7 @@ MODULE PROCEDURE obj_isBoundaryElement INTEGER(I4B) :: iel -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) ans = obj%elementData(iel)%elementType .LE. BOUNDARY_ELEMENT END PROCEDURE obj_isBoundaryElement @@ -251,7 +332,7 @@ MODULE PROCEDURE obj_isDomainBoundaryElement INTEGER(I4B) :: iel -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) ans = obj%elementData(iel)%elementType .EQ. DOMAIN_BOUNDARY_ELEMENT END PROCEDURE obj_isDomainBoundaryElement @@ -324,26 +405,22 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetBoundingBox2 -INTEGER(I4B) :: nsd +INTEGER(I4B) :: nsd, tsize, ii REAL(DFP) :: lim(6) +LOGICAL(LGT) :: mask(SIZE(nodes, 1), SIZE(nodes, 2)) lim = 0.0_DFP nsd = SIZE(nodes, 1) -IF (PRESENT(local_nptrs)) THEN - lim(1:nsd * 2:2) = MINVAL(nodes(1:nsd, & - & local_nptrs(obj%GetNptrs())), & - & dim=2) - lim(2:nsd * 2:2) = MAXVAL(nodes(1:nsd, & - & local_nptrs(obj%GetNptrs())), & - & dim=2) -ELSE - lim(1:nsd * 2:2) = MINVAL(nodes(1:nsd, & - & obj%GetNptrs()), & - & dim=2) - lim(2:nsd * 2:2) = MAXVAL(nodes(1:nsd, & - & obj%GetNptrs()), & - & dim=2) -END IF +tsize = SIZE(mask, 2) + +CALL obj%GetNodeMask(mask=mask(1, :), local_nptrs=local_nptrs) +DO ii = 2, nsd + mask(ii, :) = mask(1, :) +END DO + +lim(1:nsd * 2:2) = MINVAL(nodes(1:nsd, :), dim=2, mask=mask) +lim(2:nsd * 2:2) = MAXVAL(nodes(1:nsd, :), dim=2, mask=mask) + CALL Initiate(obj=ans, nsd=nsd, lim=lim) END PROCEDURE obj_GetBoundingBox2 @@ -357,24 +434,49 @@ LOGICAL(LGT) :: problem #endif -INTEGER(I4B) :: ii -ii = obj%GetLocalElemNumber(globalElement) +INTEGER(I4B) :: iel #ifdef DEBUG_VER -problem = (ii .EQ. 0) .OR. (ii .GT. obj%tElements) +problem = .NOT. obj%isElementPresent(globalElement, islocal=islocal) IF (problem) THEN CALL e%RaiseError(modName//'::'//myName//' - '// & & '[INTERNAL ERROR] :: problem in getting localElement number') END IF #endif -ans = obj%elementData(ii)%globalNodes +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +ans = obj%elementData(iel)%globalNodes END PROCEDURE obj_GetConnectivity !---------------------------------------------------------------------------- ! GetConnectivity !---------------------------------------------------------------------------- +MODULE PROCEDURE obj_GetConnectivity_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetConnectivity_()" +LOGICAL(LGT) :: problem +#endif + +INTEGER(I4B) :: iel + +#ifdef DEBUG_VER +problem = .NOT. obj%isElementPresent(globalElement, islocal=islocal) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: problem in getting localElement number') +END IF +#endif + +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +tsize = SIZE(obj%elementData(iel)%globalNodes) +ans(1:tsize) = obj%elementData(iel)%globalNodes +END PROCEDURE obj_GetConnectivity_ + +!---------------------------------------------------------------------------- +! GetConnectivity +!---------------------------------------------------------------------------- + MODULE PROCEDURE obj_GetNodeConnectivity #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_GetNodeConnectivity()" @@ -408,9 +510,11 @@ MODULE PROCEDURE obj_GetLocalNodeNumber1 INTEGER(I4B) :: ii + DO ii = 1, SIZE(globalNode) - ans(ii) = obj%GetLocalNodeNumber(globalNode(ii)) + ans(ii) = obj%GetLocalNodeNumber(globalNode(ii), islocal=islocal) END DO + END PROCEDURE obj_GetLocalNodeNumber1 !---------------------------------------------------------------------------- @@ -421,35 +525,46 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber2()" LOGICAL(LGT) :: problem +#endif +LOGICAL(LGT) :: islocal0 -problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) +#ifdef DEBUG_VER +problem = .NOT. obj%isNodePresent(globalnode, islocal=islocal) IF (problem) THEN CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalNode is out of bound.') + & '[INTERNAL ERROR] :: globalNode '//tostring(globalNode)// & + ' is out of bound') END IF #endif -ans = obj%local_nptrs(globalNode) +islocal0 = Input(option=islocal, default=.FALSE.) + +IF (islocal0) THEN + ans = globalNode +ELSE + ans = obj%local_nptrs(globalNode) +END IF + END PROCEDURE obj_GetLocalNodeNumber2 !---------------------------------------------------------------------------- -! GetGlobalNodeNumber +! GetglobalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetGlobalNodeNumber1 +MODULE PROCEDURE obj_GetglobalNodeNumber1 INTEGER(I4B) :: ii DO ii = 1, SIZE(localNode) - ans(ii) = obj%GetGlobalNodeNumber(localNode(ii)) + ans(ii) = obj%GetglobalNodeNumber(localNode(ii)) END DO -END PROCEDURE obj_GetGlobalNodeNumber1 +END PROCEDURE obj_GetglobalNodeNumber1 !---------------------------------------------------------------------------- -! GetGlobalNodeNumber +! GetglobalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetGlobalNodeNumber2 +MODULE PROCEDURE obj_GetglobalNodeNumber2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalNodeNumber2()" +CHARACTER(*), PARAMETER :: myName = "obj_GetglobalNodeNumber2()" LOGICAL(LGT) :: problem problem = (localNode .EQ. 0) .OR. (localNode .GT. obj%tNodes) @@ -461,26 +576,26 @@ #endif ans = obj%nodeData(localNode)%globalNodeNum -END PROCEDURE obj_GetGlobalNodeNumber2 +END PROCEDURE obj_GetglobalNodeNumber2 !---------------------------------------------------------------------------- -! GetGlobalElemNumber +! GetglobalElemNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetGlobalElemNumber1 +MODULE PROCEDURE obj_GetglobalElemNumber1 INTEGER(I4B) :: ii DO ii = 1, SIZE(localElement) - ans(ii) = obj%GetGlobalElemNumber(localElement(ii)) + ans(ii) = obj%GetglobalElemNumber(localElement(ii)) END DO -END PROCEDURE obj_GetGlobalElemNumber1 +END PROCEDURE obj_GetglobalElemNumber1 !---------------------------------------------------------------------------- -! GetGlobalElemNumber +! GetglobalElemNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetGlobalElemNumber2 +MODULE PROCEDURE obj_GetglobalElemNumber2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalNodeNumber2()" +CHARACTER(*), PARAMETER :: myName = "obj_GetglobalNodeNumber2()" LOGICAL(LGT) :: problem problem = (localElement .EQ. 0) .OR. (LocalElement .GT. obj%tElements) @@ -491,7 +606,7 @@ #endif ans = obj%elementData(localElement)%globalElemNum -END PROCEDURE obj_GetGlobalElemNumber2 +END PROCEDURE obj_GetglobalElemNumber2 !---------------------------------------------------------------------------- ! GetLocalElemNumber @@ -500,7 +615,7 @@ MODULE PROCEDURE obj_GetLocalElemNumber1 INTEGER(I4B) :: ii DO ii = 1, SIZE(globalElement) - ans(ii) = obj%GetLocalElemNumber(globalElement(ii)) + ans(ii) = obj%GetLocalElemNumber(globalElement(ii), islocal=islocal) END DO END PROCEDURE obj_GetLocalElemNumber1 @@ -510,20 +625,36 @@ MODULE PROCEDURE obj_GetLocalElemNumber2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalElemNumber2()" +CHARACTER(*), PARAMETER :: myName = "obj_GetglobalElemNumber2()" LOGICAL(LGT) :: problem +#endif + +LOGICAL(LGT) :: islocal0 + +islocal0 = Input(default=.FALSE., option=islocal) + +IF (islocal0) THEN + ans = globalElement + RETURN +END IF + +#ifdef DEBUG_VER -problem = (globalElement .LT. obj%MinElemNum) & +problem = (globalElement .LT. obj%minElemNum) & & .OR. (globalElement .GT. obj%maxElemNum) IF (problem) THEN ans = 0 CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalElement is not present.') + & '[INTERNAL ERROR] :: globalElement '//tostring(globalElement)// & + & ' not present.') + RETURN END IF + #endif ans = obj%local_elemNumber(globalElement) + END PROCEDURE obj_GetLocalElemNumber2 !---------------------------------------------------------------------------- @@ -537,7 +668,7 @@ CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToElements1()" LOGICAL(LGT) :: problem -problem = .NOT. obj%isNodePresent(globalNode) +problem = .NOT. obj%isNodePresent(globalNode, islocal=islocal) IF (problem) THEN ALLOCATE (ans(0)) CALL e%RaiseError(modName//'::'//myName//' - '// & @@ -545,7 +676,9 @@ END IF #endif -ii = obj%GetLocalNodeNumber(globalNode) +IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() + +ii = obj%GetLocalNodeNumber(globalNode, islocal=islocal) ans = obj%nodeData(ii)%globalElements END PROCEDURE obj_GetNodeToElements1 @@ -557,11 +690,13 @@ INTEGER(I4B) :: ii, jj, kk, n, lnode(SIZE(globalNode)), & & nn(SIZE(globalNode) + 1) +IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() + nn(1) = 1 n = SIZE(globalNode) DO ii = 1, n - lnode(ii) = obj%GetLocalNodeNumber(globalNode(ii)) + lnode(ii) = obj%GetLocalNodeNumber(globalNode(ii), islocal=islocal) nn(ii + 1) = nn(ii) + SIZE(obj%nodeData(lnode(ii))%globalElements) END DO @@ -578,6 +713,63 @@ CALL RemoveDuplicates(ans) END PROCEDURE obj_GetNodeToElements2 +!---------------------------------------------------------------------------- +! GetNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements1_ +INTEGER(I4B) :: ii, jj +LOGICAL(LGT) :: problem + +problem = .NOT. obj%isNodePresent(globalNode, islocal=islocal) +IF (problem) THEN + tsize = 0 + RETURN +END IF + +IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() + +ii = obj%GetLocalNodeNumber(globalNode, islocal=islocal) +tsize = SIZE(obj%nodeData(ii)%globalElements) + +DO jj = 1, tsize + ans(jj) = obj%nodeData(ii)%globalElements(jj) +END DO +END PROCEDURE obj_GetNodeToElements1_ + +!---------------------------------------------------------------------------- +! GetNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements2_ +INTEGER(I4B) :: ii, jj, kk, n, lnode, a, b + +IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() + +a = 1 +n = SIZE(globalNode) + +DO ii = 1, n + lnode = obj%GetLocalNodeNumber(globalNode(ii), islocal=islocal) + b = a + SIZE(obj%nodeData(lnode)%globalElements) + + kk = 0 + DO jj = a, b - 1 + kk = kk + 1 + ans(jj) = obj%nodeData(lnode)%globalElements(kk) + END DO + + b = a + +END DO + +tsize = b - 1 + +IF (tsize .LE. 1) RETURN + +CALL RemoveDuplicates_(obj=ans(1:tsize), tsize=tsize, isSorted=.FALSE.) +END PROCEDURE obj_GetNodeToElements2_ + !---------------------------------------------------------------------------- ! GetNodeToNodes !---------------------------------------------------------------------------- @@ -587,43 +779,51 @@ CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToNodes1()" LOGICAL(LGT) :: problem #endif -INTEGER(I4B) :: i -i = obj%GetLocalNodeNumber(GlobalNode=GlobalNode) +LOGICAL(LGT) :: abool + +INTEGER(I4B) :: i, j #ifdef DEBUG_VER -problem = (i .EQ. 0) .OR. (i .GT. obj%tNodes) +problem = .NOT. obj%isNodePresent(globalNode=globalNode, islocal=islocal) IF (problem) THEN ALLOCATE (ans(0)) CALL e%RaiseError(modName//'::'//myName//' - '// & & '[INTERNAL ERROR] :: globalNode is out of bound.') RETURN END IF +#endif +i = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) + +#ifdef DEBUG_VER IF (obj%isExtraNodeToNodesInitiated) THEN - problem = .NOT. ALLOCATED(obj%nodeData(i)%extraGlobalNodes) + problem = .NOT. ALLOCATED(obj%nodeData(i)%extraglobalNodes) IF (problem) THEN CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: extraGlobalNodes is not ALLOCATED.') + & '[INTERNAL ERROR] :: extraglobalNodes is not ALLOCATED.') END IF END IF #endif -! check -IF (obj%isExtraNodeToNodesInitiated .AND. IncludeSelf) THEN - CALL Append(ans, [globalNode], obj%nodeData(i)%globalNodes, & - & obj%nodeData(i)%extraGlobalNodes) +abool = obj%isExtraNodeToNodesInitiated .AND. IncludeSelf +IF (abool) THEN + j = obj%GetglobalNodeNumber(i) + CALL Append(ans, [j], obj%nodeData(i)%globalNodes, & + & obj%nodeData(i)%extraglobalNodes) RETURN END IF -IF (obj%isExtraNodeToNodesInitiated .AND. (.NOT. IncludeSelf)) THEN +abool = obj%isExtraNodeToNodesInitiated .AND. (.NOT. IncludeSelf) +IF (abool) THEN CALL Append(ans, obj%nodeData(i)%globalNodes, & - & obj%nodeData(i)%extraGlobalNodes) + & obj%nodeData(i)%extraglobalNodes) RETURN END IF IF (IncludeSelf) THEN - CALL Append(ans, [globalNode], obj%nodeData(i)%globalNodes) + j = obj%GetglobalNodeNumber(i) + CALL Append(ans, [j], obj%nodeData(i)%globalNodes) RETURN END IF @@ -636,30 +836,217 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeToNodes2 -INTEGER(I4B) :: ii, jj, kk, n, lnode(SIZE(globalNode)), & - & nn(SIZE(globalNode) + 1) +INTEGER(I4B) :: ii, n, tsize, lnode +INTEGER(I4B), ALLOCATABLE :: temp(:) -nn(1) = 1 n = SIZE(globalNode) - +tsize = 0 DO ii = 1, n - lnode(ii) = obj%GetLocalNodeNumber(globalNode(ii)) - nn(ii + 1) = nn(ii) + SIZE(obj%nodeData(lnode(ii))%globalNodes) + lnode = obj%GetLocalNodeNumber(globalNode(ii), islocal=islocal) + tsize = tsize + SIZE(obj%nodeData(lnode)%globalNodes) END DO -CALL Reallocate(ans, nn(n + 1) - 1) +IF (includeSelf) THEN + CALL Reallocate(temp, tsize + n) +ELSE + CALL Reallocate(temp, tsize) +END IF + +CALL obj%GetNodeToNodes_(globalNode=globalNode, includeSelf=includeSelf, & + ans=temp, tsize=tsize, islocal=islocal) +CALL Reallocate(ans, tsize) +ans = temp(1:tsize) + +END PROCEDURE obj_GetNodeToNodes2 + +!---------------------------------------------------------------------------- +! GetNodeToNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToNodes1_ +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToNodes1_()" +LOGICAL(LGT) :: problem +#endif + +LOGICAL(LGT) :: abool + +INTEGER(I4B) :: i, a + +tsize = 0 +#ifdef DEBUG_VER + +problem = .NOT. obj%isNodePresent(globalNode=globalNode, islocal=islocal) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalNode not present.') + RETURN +END IF + +#endif + +i = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) + +#ifdef DEBUG_VER +IF (obj%isExtraNodeToNodesInitiated) THEN + problem = .NOT. ALLOCATED(obj%nodeData(i)%extraglobalNodes) + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: extraglobalNodes is not ALLOCATED.') + END IF +END IF +#endif + +#ifdef DEBUG_VER + +a = 0 +IF (IncludeSelf) THEN + + a = 1 + tsize = 1 + + problem = SIZE(ans) .LT. 1 + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: size of ans is not enough') + RETURN + END IF + + ans(1) = obj%GetglobalNodeNumber(i) + +END IF + +#else + +a = 0 +IF (IncludeSelf) THEN + + a = 1 + tsize = 1 + ans(1) = obj%GetglobalNodeNumber(i) + +END IF + +#endif + +tsize = a + SIZE(obj%nodeData(i)%globalNodes) + +#ifdef DEBUG_VER + +! problem = size ans .lt. 1 +problem = SIZE(ans) .LT. tsize +! call raiseError if problem is true +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: size of ans is not enough') + RETURN +END IF + +ans(a + 1:tsize) = obj%nodedata(i)%globalNodes + +#else + +ans(a + 1:tsize) = obj%nodedata(i)%globalNodes + +#endif + +! exatranodes + +abool = obj%isExtraNodeToNodesInitiated + +#ifdef DEBUG_VER + +IF (abool) THEN + + a = tsize + tsize = tsize + SIZE(obj%nodeData(i)%extraglobalNodes) + + problem = SIZE(ans) .LT. tsize + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: size of ans is not enough') + RETURN + END IF + + ans(a + 1:tsize) = obj%nodedata(i)%extraglobalNodes + +END IF + +#else + +IF (abool) THEN + + a = tsize + tsize = tsize + SIZE(obj%nodeData(i)%extraglobalNodes) + ans(a + 1:tsize) = obj%nodedata(i)%extraglobalNodes + +END IF + +#endif + +END PROCEDURE obj_GetNodeToNodes1_ + +!---------------------------------------------------------------------------- +! GetNodeToNodes +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToNodes2_ +CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToNodes2_()" +LOGICAL(LGT) :: problem + +LOGICAL(LGT) :: abool + +INTEGER(I4B) :: i, a, jj + +tsize = 0 +a = 0 + +DO jj = 1, SIZE(globalNode) + + problem = .NOT. obj%isNodePresent(globalNode=globalNode(jj), islocal=islocal) + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalNode node present.') + RETURN + END IF + + i = obj%GetLocalNodeNumber(globalNode=globalNode(jj), islocal=islocal) + + IF (obj%isExtraNodeToNodesInitiated) THEN + problem = .NOT. ALLOCATED(obj%nodeData(i)%extraglobalNodes) + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: extraglobalNodes is not ALLOCATED.') + END IF + RETURN + END IF + + IF (IncludeSelf) THEN + + ans(tsize + 1) = obj%GetglobalNodeNumber(i) + a = a + 1 + tsize = tsize + 1 + + END IF + + tsize = a + SIZE(obj%nodeData(i)%globalNodes) + ans(a + 1:tsize) = obj%nodedata(i)%globalNodes + a = tsize + + abool = obj%isExtraNodeToNodesInitiated + IF (abool) THEN + + tsize = tsize + SIZE(obj%nodeData(i)%extraglobalNodes) + ans(a + 1:tsize) = obj%nodedata(i)%extraglobalNodes + a = tsize + + END IF -DO ii = 1, n - kk = 0 - DO jj = nn(ii), nn(ii + 1) - 1 - kk = kk + 1 - ans(jj) = obj%nodeData(lnode(ii))%globalNodes(kk) - END DO END DO -CALL RemoveDuplicates(ans) +CALL RemoveDuplicates_(obj=ans(1:tsize), tsize=tsize, isSorted=.FALSE.) -END PROCEDURE obj_GetNodeToNodes2 +END PROCEDURE obj_GetNodeToNodes2_ !---------------------------------------------------------------------------- ! GetElementToElements @@ -674,7 +1061,7 @@ LOGICAL(LGT) :: problem #endif -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) #ifdef DEBUG_VER problem = .NOT. ALLOCATED(obj%elementData(iel)%globalElements) @@ -714,25 +1101,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetBoundaryElementData -INTEGER(I4B) :: iel - -#ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_GetBoundaryElementData()" -LOGICAL(LGT) :: problem - -problem = .NOT. obj%isBoundaryElement(globalElement) - -IF (problem) THEN - ALLOCATE (ans(0)) - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: Element is not boundary element.') - RETURN -END IF -#endif - -iel = obj%GetLocalElemNumber(globalElement) +INTEGER(I4B) :: iel, tsize +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +tsize = SIZE(obj%elementData(iel)%boundaryData) +CALL Reallocate(ans, tsize) ans = obj%elementData(iel)%boundaryData - END PROCEDURE obj_GetBoundaryElementData !---------------------------------------------------------------------------- @@ -766,31 +1139,46 @@ ! GetMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetMaterial -#ifdef DEBUG_VER -LOGICAL(LGT) :: isok -ans = 0 +MODULE PROCEDURE obj_GetMaterial1 +INTEGER(I4B) :: iel +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +ans = obj%elementData(iel)%material(medium) +END PROCEDURE obj_GetMaterial1 + +!---------------------------------------------------------------------------- +! GetMaterial +!---------------------------------------------------------------------------- -isok = ALLOCATED(obj%material) -IF (.NOT. isok) RETURN +MODULE PROCEDURE obj_GetMaterial2 +CHARACTER(*), PARAMETER :: myName = "obj_GetMaterial2()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: This routine is not available') +ans = 0 +END PROCEDURE obj_GetMaterial2 -isok = medium .LE. SIZE(obj%material) -IF (.NOT. isok) RETURN -#endif +!---------------------------------------------------------------------------- +! GetTotalMaterial +!---------------------------------------------------------------------------- -ans = obj%material(medium) -END PROCEDURE obj_GetMaterial +MODULE PROCEDURE obj_GetTotalMaterial1 +INTEGER(I4B) :: iel +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +ans = 0 ! default value +IF (ALLOCATED(obj%elementData(iel)%material)) THEN + ans = SIZE(obj%elementData(iel)%material) +END IF +END PROCEDURE obj_GetTotalMaterial1 !---------------------------------------------------------------------------- ! GetTotalMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetTotalMaterial +MODULE PROCEDURE obj_GetTotalMaterial2 +CHARACTER(*), PARAMETER :: myName = "obj_GetTotalMaterial2()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: This routine is not available') ans = 0 -IF (ALLOCATED(obj%material)) THEN - ans = SIZE(obj%material) -END IF -END PROCEDURE obj_GetTotalMaterial +END PROCEDURE obj_GetTotalMaterial2 !---------------------------------------------------------------------------- ! GetTotalFacetElements @@ -885,7 +1273,7 @@ ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity1 +MODULE PROCEDURE AbstractMeshGetFacetConnectivity INTEGER(I4B), ALLOCATABLE :: cellNptrs(:) INTEGER(I4B) :: localFaceID, cellNum @@ -915,19 +1303,22 @@ END IF IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) -END PROCEDURE obj_GetFacetConnectivity1 +END PROCEDURE AbstractMeshGetFacetConnectivity !---------------------------------------------------------------------------- ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity2 -! CHARACTER(*), PARAMETER :: myName = "obj_GetFacetConnectivity2()" +MODULE PROCEDURE obj_GetFacetConnectivity +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetFacetConnectivity2()" +#endif + INTEGER(I4B) :: iel, temp4(4), elemType, order, & - & con(MaxNodesInElement, REFELEM_MAX_FACES), & - & ii, tFaceNodes(REFELEM_MAX_FACES) + & con(MaxNodesInElement, PARAM_REFELEM_MAX_FACES), & + & ii, tFaceNodes(PARAM_REFELEM_MAX_FACES) -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) SELECT CASE (obj%xidim) @@ -966,13 +1357,35 @@ CALL Reallocate(ans, tFaceNodes(iface)) +#ifdef DEBUG_VER + DO ii = 1, SIZE(ans) + + IF (con(ii, iface) .EQ. 0_I4B) THEN + CALL Display(elemType, "elemType: ") + CALL Display(temp4, "TotalEntities: ") + CALL Display(order, "order: ") + CALL Display(tFaceNodes, "tFaceNodes: ") + CALL Display(iface, "iface: ") + CALL Display(con, "con: ") + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: con(ii, iface) is zero') + RETURN + END IF + + ans(ii) = obj%elementData(iel)%globalNodes(con(ii, iface)) + END DO + +#else + DO ii = 1, SIZE(ans) ans(ii) = obj%elementData(iel)%globalNodes(con(ii, iface)) END DO +#endif + END SELECT -END PROCEDURE obj_GetFacetConnectivity2 +END PROCEDURE obj_GetFacetConnectivity !---------------------------------------------------------------------------- ! GetFacetElementType @@ -980,7 +1393,7 @@ MODULE PROCEDURE obj_GetFacetElementType INTEGER(I4B) :: iel -iel = obj%GetLocalElemNumber(globalElement=globalElement) +iel = obj%GetLocalElemNumber(globalElement=globalElement, islocal=islocal) ans = obj%facetElementType(:, iel) END PROCEDURE obj_GetFacetElementType diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 index 9f4cea6d1..5b58b5cf7 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 @@ -127,12 +127,6 @@ CALL Display(obj%Z, "Z: ", unitno=unitno) -abool = ALLOCATED(obj%material) -CALL Display(abool, "materialALLOCATED: ", unitno=unitno) -IF (abool) THEN - CALL Display(obj%material, "material: ", unitno=unitno) -END IF - abool = ALLOCATED(obj%boundingEntity) CALL Display(abool, "boundingEntity ALLOCATED: ", unitno=unitno) IF (abool) THEN @@ -197,8 +191,10 @@ ELSEIF (cases(3)) THEN CALL HDF5GetEntities(hdf5=hdf5, group=group0, dim=dim, & & tEntities=tEntities, myName=myName, modName=modName) - entities0 = arange(1_I4B, tEntities) - CALL MeshImportFromDim(obj, hdf5, group0, dim, entities0, tEntities) + IF (tEntities .GT. 0_I4B) THEN + entities0 = arange(1_I4B, tEntities) + CALL MeshImportFromDim(obj, hdf5, group0, dim, entities0, tEntities) + END IF ELSE CALL e%RaiseError(modName//'::'//myName//' - '// & @@ -206,6 +202,8 @@ RETURN END IF +CALL obj%InitiateElementToElements() + IF (ALLOCATED(entities0)) DEALLOCATE (entities0) group0 = "" diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@NodeDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@NodeDataMethods.F90 index 419563c72..edcda599d 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@NodeDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@NodeDataMethods.F90 @@ -40,8 +40,8 @@ #endif IF (obj%isNodeToElementsInitiated) THEN - CALL e%raiseWarning(modName//"::"//myName//" - "// & - & "NodeToElements is already initiated.") + CALL e%RaiseInformation(modName//"::"//myName//" - "// & + & "[INFO] :: NodeToElements is already initiated.") RETURN END IF diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index 9427d873a..3cdc4d201 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -15,6 +15,7 @@ ! along with this program. If not, see SUBMODULE(AbstractMesh_Class) SetMethods +USE globalData, ONLY: INT8 USE BoundingBox_Method USE ReallocateUtility USE CSRMatrix_Method @@ -61,11 +62,11 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_setSparsity1()" INTEGER(I4B) :: tsize -LOGICAL(LGT) :: problem #endif +LOGICAL(LGT) :: problem -INTEGER(I4B) :: i, j, k, tNodes -INTEGER(I4B), ALLOCATABLE :: n2n(:) +INTEGER(I4B) :: i, j, k, tNodes, tsize +INTEGER(I4B) :: n2n(PARAM_MAX_NODE_TO_NODE) #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & @@ -73,6 +74,7 @@ #endif #ifdef DEBUG_VER + IF (.NOT. obj%isInitiated) THEN CALL e%RaiseError(modName//"::"//myName//" - "// & & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") @@ -87,27 +89,31 @@ RETURN END IF +#endif + ! check problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF -#endif +IF (problem) CALL obj%InitiateNodeToNodes() tNodes = obj%GetTotalNodes() +! TODO: +! Use openmp parallel loop +! make n2n a variable, each thread has its own copy of n2n +! each thread will call setSparsity with its own copy of n2n + DO i = 1, tNodes - j = obj%GetGlobalNodeNumber(localNode=i) + j = obj%GetglobalNodeNumber(localNode=i) k = localNodeNumber(j) - IF (k .NE. 0) THEN - n2n = localNodeNumber( & - & obj%GetNodeToNodes(globalNode=j, includeSelf=.TRUE.)) - CALL SetSparsity(obj=mat, row=k, col=n2n) - END IF + + IF (k .EQ. 0) CYCLE + + CALL obj%GetNodeToNodes_(globalNode=i, includeSelf=.TRUE., & + & ans=n2n, tsize=tsize, islocal=.TRUE.) + + CALL SetSparsity(obj=mat, row=k, col=n2n(1:tsize)) + END DO -IF (ALLOCATED(n2n)) DEALLOCATE (n2n) #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & @@ -121,20 +127,21 @@ MODULE PROCEDURE obj_SetSparsity2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_setSparsity1()" +CHARACTER(*), PARAMETER :: myName = "obj_setSparsity2()" INTEGER(I4B) :: tsize -LOGICAL(LGT) :: problem #endif +LOGICAL(LGT) :: problem -INTEGER(I4B) :: i, j, tNodes -INTEGER(I4B), ALLOCATABLE :: n2n(:) +INTEGER(I4B) :: i, j, tNodes, tsize +INTEGER(I4B) :: n2n(PARAM_MAX_NODE_TO_NODE) #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') + & '[START]') #endif #ifdef DEBUG_VER + IF (.NOT. obj%isInitiated) THEN CALL e%RaiseError(modName//"::"//myName//" - "// & & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") @@ -149,23 +156,23 @@ RETURN END IF -! check -problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF #endif +problem = .NOT. obj%isNodeToNodesInitiated +IF (problem) CALL obj%InitiateNodeToNodes() + tNodes = obj%GetTotalNodes() DO i = 1, tNodes - j = obj%GetGlobalNodeNumber(localNode=i) - n2n = obj%GetNodeToNodes(globalNode=j, includeSelf=.TRUE.) - CALL SetSparsity(obj=mat, row=j, col=n2n) + + j = obj%GetglobalNodeNumber(localNode=i) + + CALL obj%GetNodeToNodes_(globalNode=i, includeSelf=.TRUE., & + & ans=n2n, tsize=tsize, islocal=.TRUE.) + + CALL SetSparsity(obj=mat, row=j, col=n2n(1:tsize)) + END DO -IF (ALLOCATED(n2n)) DEALLOCATE (n2n) #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & @@ -179,8 +186,71 @@ MODULE PROCEDURE obj_SetSparsity3 CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity3()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') +LOGICAL(LGT) :: problem, isok + +INTEGER(I4B) :: n2n(PARAM_MAX_NODE_TO_NODE), tsize, ii, & + temp(PARAM_MAX_NODE_TO_NODE), ll, jj, kk + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +#ifdef DEBUG_VER + +IF (.NOT. obj%isInitiated) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") + RETURN +END IF + +IF (.NOT. colMesh%isInitiated) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: colMesh data is not initiated, first initiate") + RETURN +END IF + +problem = SIZE(nodeToNode) .NE. obj%maxNptrs +IF (problem) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: SIZE(nodeToNode) .NE. obj%maxNptrs") + RETURN +END IF + +#endif + +! check +IF (.NOT. obj%isNodeToNodesInitiated) CALL obj%InitiateNodeToNodes() + +DO ii = 1, obj%tNodes + + CALL obj%GetNodeToNodes_(globalNode=ii, includeSelf=.TRUE., & + ans=n2n, tsize=tsize, islocal=.TRUE.) + !! n2n(1) will contains the global node for ii + + ll = 0 + DO jj = 1, tsize + kk = nodeToNode(n2n(jj)) + isok = colMesh%IsNodePresent(globalNode=kk, islocal=.FALSE.) + + IF (isok) THEN + ll = ll + 1 + temp(ll) = kk + END IF + + END DO + + IF (ll .EQ. 0) CYCLE + + CALL SetSparsity(obj=mat, row=n2n(1), col=temp(1:ll), ivar=ivar, jvar=jvar) + +END DO + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + END PROCEDURE obj_SetSparsity3 !---------------------------------------------------------------------------- @@ -197,28 +267,85 @@ ! setTotalMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_SetTotalMaterial -INTEGER(I4B), ALLOCATABLE :: temp_material(:) -INTEGER(I4B) :: n0 +MODULE PROCEDURE obj_SetTotalMaterial1 +INTEGER(I4B) :: iel +iel = obj%GetLocalElemNumber(globalelement, islocal=islocal) +CALL ElemData_SetTotalMaterial(obj%elementData(iel), n=n) +END PROCEDURE obj_SetTotalMaterial1 -IF (ALLOCATED(obj%material)) THEN - n0 = SIZE(obj%material) - CALL Reallocate(temp_material, n0 + n) - temp_material(1:n0) = obj%material(1:n0) - CALL MOVE_ALLOC(from=temp_material, to=obj%material) - RETURN -END IF +!---------------------------------------------------------------------------- +! setTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetTotalMaterial2 +INTEGER(I4B) :: ii +LOGICAL(LGT) :: isok + +DO CONCURRENT(ii=1:obj%tElements) + isok = obj%elementData(ii)%isActive + IF (.NOT. isok) CYCLE + CALL ElemData_SetTotalMaterial(obj%elementData(ii), n=n) +END DO +END PROCEDURE obj_SetTotalMaterial2 + +!---------------------------------------------------------------------------- +! setMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMaterial1 +INTEGER(I4B) :: ii +LOGICAL(LGT) :: isok + +! start a loop of obj%elementData with ii = 1, size(obj%elementData) + +DO CONCURRENT(ii=1:obj%tElements) + isok = obj%elementData(ii)%isActive + IF (.NOT. isok) CYCLE + + ! if obj%elementData(ii)%meshID is equal to entityNum then + ! set %material(medium) = material + isok = obj%elementData(ii)%meshID .EQ. entityNum + IF (isok) THEN + CALL ElemDataSet(obj%elementData(ii), material=material, & + medium=medium) + END IF -CALL Reallocate(obj%material, n) -END PROCEDURE obj_SetTotalMaterial +END DO + +END PROCEDURE obj_SetMaterial1 !---------------------------------------------------------------------------- ! setMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_SetMaterial -obj%material(medium) = material -END PROCEDURE obj_SetMaterial +MODULE PROCEDURE obj_SetMaterial2 +INTEGER(I4B) :: ii +LOGICAL(LGT) :: isok + +! start a loop of obj%elementData with ii = 1, size(obj%elementData) + +DO CONCURRENT(ii=1:obj%tElements) + isok = obj%elementData(ii)%isActive + IF (.NOT. isok) CYCLE + CALL ElemDataSet(obj%elementData(ii), material=material, & + medium=medium) +END DO +END PROCEDURE obj_SetMaterial2 + +!---------------------------------------------------------------------------- +! setMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMaterial3 +INTEGER(I4B) :: iel + +iel = obj%GetLocalElemNumber(globalElement=globalElement, & + & islocal=islocal) + +CALL ElemDataSet(obj%elementData(iel), material=material, & + medium=medium) + +END PROCEDURE obj_SetMaterial3 !---------------------------------------------------------------------------- ! setFacetElementType @@ -226,7 +353,8 @@ MODULE PROCEDURE obj_SetFacetElementType INTEGER(I4B) :: localElem -localElem = obj%GetLocalElemNumber(globalElement=globalElement) +localElem = obj%GetLocalElemNumber(globalElement=globalElement, & + & islocal=islocal) obj%facetElementType(iface, localElem) = facetElementType obj%elementData(localElem)%elementType = facetElementType END PROCEDURE obj_SetFacetElementType diff --git a/src/submodules/CMakeLists.txt b/src/submodules/CMakeLists.txt index 31c5b103d..ef4208e9d 100644 --- a/src/submodules/CMakeLists.txt +++ b/src/submodules/CMakeLists.txt @@ -69,6 +69,18 @@ include(${CMAKE_CURRENT_LIST_DIR}/FEMesh/CMakeLists.txt) # Mesh include(${CMAKE_CURRENT_LIST_DIR}/Mesh/CMakeLists.txt) +# MeshFacetData +include(${CMAKE_CURRENT_LIST_DIR}/MeshFacetData/CMakeLists.txt) + +# AbstractDomain +include(${CMAKE_CURRENT_LIST_DIR}/AbstractDomain/CMakeLists.txt) + +# FEDomain +include(${CMAKE_CURRENT_LIST_DIR}/FEDomain/CMakeLists.txt) + +# FEDomainConnectivity +include(${CMAKE_CURRENT_LIST_DIR}/FEDomainConnectivity/CMakeLists.txt) + # Domain include(${CMAKE_CURRENT_LIST_DIR}/Domain/CMakeLists.txt) diff --git a/src/submodules/Domain/src/Domain_Class@ConstructorMethods.F90 b/src/submodules/Domain/src/Domain_Class@ConstructorMethods.F90 index cc876bf3a..4cae153a8 100644 --- a/src/submodules/Domain/src/Domain_Class@ConstructorMethods.F90 +++ b/src/submodules/Domain/src/Domain_Class@ConstructorMethods.F90 @@ -48,41 +48,6 @@ #endif END PROCEDURE Domain_Initiate -!---------------------------------------------------------------------------- -! Initiate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE MeshFacetData_Initiate -CALL Reallocate(obj%masterCellNumber, n) -CALL Reallocate(obj%slaveCellNumber, n) -CALL Reallocate(obj%masterLocalFacetID, n) -CALL Reallocate(obj%slaveLocalFacetID, n) -END PROCEDURE MeshFacetData_Initiate - -!---------------------------------------------------------------------------- -! isInitiated -!---------------------------------------------------------------------------- - -MODULE PROCEDURE MeshFacetData_isInitiated -IF (ALLOCATED(obj%masterCellNumber)) THEN - ans = .TRUE. -ELSE - ans = .FALSE. -END IF -END PROCEDURE MeshFacetData_isInitiated - -!---------------------------------------------------------------------------- -! Size -!---------------------------------------------------------------------------- - -MODULE PROCEDURE MeshFacetData_Size -IF (ALLOCATED(obj%masterCellNumber)) THEN - ans = SIZE(obj%masterCellNumber) -ELSE - ans = 0 -END IF -END PROCEDURE MeshFacetData_Size - !---------------------------------------------------------------------------- ! Deallocate !---------------------------------------------------------------------------- diff --git a/src/submodules/Domain/src/Domain_Class@IOMethods.F90 b/src/submodules/Domain/src/Domain_Class@IOMethods.F90 index 229ffa751..239d9ee83 100644 --- a/src/submodules/Domain/src/Domain_Class@IOMethods.F90 +++ b/src/submodules/Domain/src/Domain_Class@IOMethods.F90 @@ -103,53 +103,6 @@ END IF END PROCEDURE Domain_DisplayMeshFacetData -!---------------------------------------------------------------------------- -! Display -!---------------------------------------------------------------------------- - -MODULE PROCEDURE MeshFacetData_Display -LOGICAL(LGT) :: abool - -CALL Display(msg, unitno=unitno) - -CALL Display("elementType: BOUNDARY_ELEMENT", unitno=unitno) - -CALL Display(obj%masterMesh, "masterMesh: ", unitno=unitno) - -CALL Display(obj%slaveMesh, "slaveMesh: ", unitno=unitno) - -abool = ALLOCATED(obj%masterCellNumber) -CALL Display(abool, "masterCellNumber Allocated: ", unitNo=unitNo) - -IF (abool) THEN - CALL Display(obj%masterCellNumber, msg="masterCellNumber: ", & - & unitno=unitno) -END IF - -abool = ALLOCATED(obj%masterlocalFacetID) -CALL Display(abool, "masterlocalFacetID Allocated: ", unitNo=unitNo) - -IF (abool) THEN - CALL Display(obj%masterlocalFacetID, msg="masterlocalFacetID: ", & - & unitno=unitno) -END IF - -abool = ALLOCATED(obj%slaveCellNumber) -CALL Display(abool, "slaveCellNumber Allocated: ", unitNo=unitNo) - -IF (abool) THEN - CALL Display(obj%slaveCellNumber, msg="slaveCellNumber: ", & - & unitno=unitno) -END IF - -abool = ALLOCATED(obj%slavelocalFacetID) -IF (abool) THEN - CALL Display(obj%slavelocalFacetID, msg="slavelocalFacetID: ", & - & unitno=unitno) -END IF - -END PROCEDURE MeshFacetData_Display - !---------------------------------------------------------------------------- ! Import !---------------------------------------------------------------------------- diff --git a/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 b/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 index 286ebc8a2..da9fafc30 100644 --- a/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 +++ b/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 @@ -313,7 +313,8 @@ DO iel = 1, tDomFacet - faceNptrs = masterMesh%GetFacetConnectivity( & + faceNptrs = MeshGetFacetConnectivity( & + & obj=masterMesh, & & facetElement=iel, & & elementType=DOMAIN_BOUNDARY_ELEMENT, & & isMaster=.TRUE.) @@ -407,7 +408,8 @@ IF (masterMesh%boundaryFacetData(iel)%elementType & & .EQ. BOUNDARY_ELEMENT) THEN - nptrs = masterMesh%GetFacetConnectivity( & + nptrs = MeshGetFacetConnectivity( & + & obj=masterMesh, & & facetElement=iel, & & elementType=BOUNDARY_ELEMENT, & & isMaster=.TRUE.) @@ -500,7 +502,8 @@ IF (masterMesh%boundaryFacetData(iface_master)%elementType .EQ. & & DOMAIN_BOUNDARY_ELEMENT) CYCLE - faceNptrs_master = masterMesh%GetFacetConnectivity( & + faceNptrs_master = MeshGetFacetConnectivity( & + & obj=masterMesh, & & facetElement=iface_master, & & elementType=BOUNDARY_ELEMENT, & & isMaster=.TRUE.) @@ -520,7 +523,8 @@ IF (masterMesh%boundaryFacetData(iface_master)%elementType .EQ. & & DOMAIN_BOUNDARY_ELEMENT) CYCLE - faceNptrs_master = masterMesh%GetFacetConnectivity( & + faceNptrs_master = MeshGetFacetConnectivity( & + & obj=masterMesh, & & facetElement=iface_master, & & elementType=BOUNDARY_ELEMENT, & & isMaster=.TRUE.) @@ -532,7 +536,8 @@ IF (slaveMesh%boundaryFacetData(iface_slave)%elementType .EQ. & & DOMAIN_BOUNDARY_ELEMENT) CYCLE - faceNptrs_slave = slaveMesh%GetFacetConnectivity( & + faceNptrs_slave = MeshGetFacetConnectivity( & + & obj=slaveMesh, & & facetElement=iface_slave, & & elementType=BOUNDARY_ELEMENT, & & isMaster=.TRUE.) diff --git a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Constructor.F90 b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Constructor.F90 index 7434e3b7e..2c118f71f 100644 --- a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Constructor.F90 +++ b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Constructor.F90 @@ -64,7 +64,7 @@ nn = SIZE(substr) DO ii = 2, nn - 1 prefix = prefix//substr(ii)//"::" - end do + END DO prefix = prefix//substr(nn) DEALLOCATE (substr) END IF @@ -74,7 +74,7 @@ myname = substr(1) DO ii = 2, nn - 1 msg = msg//substr(ii)//"-" - end do + END DO msg = msg//substr(nn) DEALLOCATE (substr) END IF diff --git a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Enquire.F90 b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Enquire.F90 index ced4aaa84..a37f5bbc1 100644 --- a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Enquire.F90 +++ b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@Enquire.F90 @@ -24,11 +24,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isQuietMode_all - IF( ASSOCIATED( obj%surrogate ) ) THEN - ans = ALL( obj%surrogate%quiet ) - ELSE - ans = ALL( obj%quiet ) - END IF +IF (ASSOCIATED(obj%surrogate)) THEN + ans = ALL(obj%surrogate%quiet) +ELSE + ans = ALL(obj%quiet) +END IF END PROCEDURE isQuietMode_all !---------------------------------------------------------------------------- @@ -36,11 +36,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isQuietMode_eCode - ans=.FALSE. - IF((EXCEPTION_OK < eCode) .AND. (eCode <= EXCEPTION_SIZE-1)) THEN - ans=obj%quiet(eCode) - IF(ASSOCIATED(obj%surrogate)) ans=obj%surrogate%quiet(eCode) - ENDIF +ans = .FALSE. +IF ((EXCEPTION_OK < eCode) .AND. (eCode <= EXCEPTION_SIZE - 1)) THEN + ans = obj%quiet(eCode) + IF (ASSOCIATED(obj%surrogate)) ans = obj%surrogate%quiet(eCode) +END IF END PROCEDURE isQuietMode_eCode !---------------------------------------------------------------------------- @@ -48,8 +48,8 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isVerboseMode_all - ans = ALL( obj%verbose ) - IF( ASSOCIATED( obj%surrogate ) ) ans=ALL( obj%surrogate%verbose ) +ans = ALL(obj%verbose) +IF (ASSOCIATED(obj%surrogate)) ans = ALL(obj%surrogate%verbose) END PROCEDURE isVerboseMode_all !---------------------------------------------------------------------------- @@ -57,11 +57,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isVerboseMode_eCode - ans = .FALSE. - IF( ( EXCEPTION_OK < eCode ) .AND. ( eCode <= EXCEPTION_SIZE-1 ) ) THEN - ans = obj%verbose(eCode) - IF( ASSOCIATED( obj%surrogate ) ) ans = obj%surrogate%verbose(eCode) - ENDIF +ans = .FALSE. +IF ((EXCEPTION_OK < eCode) .AND. (eCode <= EXCEPTION_SIZE - 1)) THEN + ans = obj%verbose(eCode) + IF (ASSOCIATED(obj%surrogate)) ans = obj%surrogate%verbose(eCode) +END IF END PROCEDURE isVerboseMode_eCode !---------------------------------------------------------------------------- @@ -69,14 +69,14 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isLogActive - ans=.FALSE. - IF( ASSOCIATED( obj%surrogate ) ) THEN - IF( obj%surrogate%logFileActive ) CALL obj%surrogate%checkLogFileOK() - ans=obj%surrogate%logFileActive - ELSE - IF( obj%logFileActive ) CALL obj%checkLogFileOK() - ans=obj%logFileActive - ENDIF +ans = .FALSE. +IF (ASSOCIATED(obj%surrogate)) THEN + IF (obj%surrogate%logFileActive) CALL obj%surrogate%checkLogFileOK() + ans = obj%surrogate%logFileActive +ELSE + IF (obj%logFileActive) CALL obj%checkLogFileOK() + ans = obj%logFileActive +END IF END PROCEDURE isLogActive !---------------------------------------------------------------------------- @@ -84,43 +84,43 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE checkLogFileOK - LOGICAL( LGT ) :: isOpen - INTEGER( I4B ) :: nDebugOld - CHARACTER( LEN=10 ) :: fprop - - IF( ASSOCIATED( obj%surrogate ) ) THEN - CALL checkLogFileOK( obj%surrogate ) - ELSE - !Since the state of the log file can change (e.g. closed) check it's - !integrity - nDebugOld=obj%nDebug - obj%logFileActive=.FALSE. - - !Test if the file is open - INQUIRE( UNIT = obj%logFileUnit, OPENED=isOpen ) - IF( .NOT. isOpen ) CALL raiseDebug( obj, 'Log file is not open! '// & - & 'Log file status is inactive.' ) - - !Test if the file is a formatted file - INQUIRE( UNIT = obj%logFileUnit, FORM=fprop ) - IF(TRIM(fprop) /= 'FORMATTED') CALL raiseDebug(obj, & - & 'Log file is not a formatted file! Log file status is inactive.') - - !Test if the file is sequential - INQUIRE( UNIT = obj%logFileUnit, ACCESS=fprop ) - IF(TRIM(fprop) /= 'SEQUENTIAL') CALL raiseDebug(obj, & - & 'Log file is not a sequential file! Log file status is inactive.') - - !Test if the file has been opened for writing - INQUIRE( UNIT = obj%logFileUnit, ACTION=fprop ) - IF( .NOT. ( TRIM(fprop) == 'WRITE' .OR. TRIM(fprop) == 'READWRITE' ) ) & - & CALL raiseDebug( obj,'Log file is not open for writing! '// & - & 'Log file status is inactive.' ) - - !If none of the checks produced a new warning then the log file check - !passes the return value can be set to .TRUE. otherwise it is .FALSE. - IF(nDebugOld == obj%nDebug) obj%logFileActive=.TRUE. - ENDIF +LOGICAL(LGT) :: isOpen +INTEGER(I4B) :: nDebugOld +CHARACTER(10) :: fprop + +IF (ASSOCIATED(obj%surrogate)) THEN + CALL checkLogFileOK(obj%surrogate) +ELSE + !Since the state of the log file can change (e.g. closed) check it's + !integrity + nDebugOld = obj%nDebug + obj%logFileActive = .FALSE. + + !Test if the file is open + INQUIRE (UNIT=obj%logFileUnit, OPENED=isOpen) + IF (.NOT. isOpen) CALL raiseDebug(obj, 'Log file is not open! '// & + & 'Log file status is inactive.') + + !Test if the file is a formatted file + INQUIRE (UNIT=obj%logFileUnit, FORM=fprop) + IF (TRIM(fprop) /= 'FORMATTED') CALL raiseDebug(obj, & + & 'Log file is not a formatted file! Log file status is inactive.') + + !Test if the file is sequential + INQUIRE (UNIT=obj%logFileUnit, ACCESS=fprop) + IF (TRIM(fprop) /= 'SEQUENTIAL') CALL raiseDebug(obj, & + & 'Log file is not a sequential file! Log file status is inactive.') + + !Test if the file has been opened for writing + INQUIRE (UNIT=obj%logFileUnit, ACTION=fprop) + IF (.NOT. (TRIM(fprop) == 'WRITE' .OR. TRIM(fprop) == 'READWRITE')) & + & CALL raiseDebug(obj, 'Log file is not open for writing! '// & + & 'Log file status is inactive.') + + !If none of the checks produced a new warning then the log file check + !passes the return value can be set to .TRUE. otherwise it is .FALSE. + IF (nDebugOld == obj%nDebug) obj%logFileActive = .TRUE. +END IF END PROCEDURE checkLogFileOK !---------------------------------------------------------------------------- @@ -128,8 +128,8 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE isStopOnError - ans=obj%stopOnError - IF(ASSOCIATED(obj%surrogate)) ans=obj%surrogate%stopOnError +ans = obj%stopOnError +IF (ASSOCIATED(obj%surrogate)) ans = obj%surrogate%stopOnError END PROCEDURE isStopOnError -END SUBMODULE Enquire \ No newline at end of file +END SUBMODULE Enquire diff --git a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@raiseMethod.F90 b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@raiseMethod.F90 index 49ed2f19e..9e661a588 100644 --- a/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@raiseMethod.F90 +++ b/src/submodules/ExceptionHandler/src/ExceptionHandler_Class@raiseMethod.F90 @@ -24,29 +24,29 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE raiseInformation - LOGICAL( LGT ) :: toLog - IF( ASSOCIATED( obj%surrogate ) ) THEN - obj%surrogate%nInfo=obj%surrogate%nInfo+1 - obj%surrogate%lastMesg=mesg - toLog=(obj%surrogate%logFileActive .AND. & - & obj%surrogate%verbose(EXCEPTION_INFORMATION)) - CALL exceptionMessage( & - & eCode = EXCEPTION_INFORMATION, & - & isQuiet = obj%surrogate%quiet(EXCEPTION_INFORMATION), & - & isLogActive = toLog, & - & logUnit = obj%surrogate%logFileUnit, & - & mesg = obj%surrogate%lastMesg ) - ELSE - obj%nInfo = obj%nInfo+1 - obj%lastMesg = mesg - toLog=( obj%logFileActive .AND. obj%verbose(EXCEPTION_INFORMATION)) - CALL exceptionMessage( & - & eCode = EXCEPTION_INFORMATION, & - & isQuiet = obj%quiet(EXCEPTION_INFORMATION), & - & isLogActive = toLog, & - & logUnit = obj%logFileUnit, & - & mesg = obj%lastMesg ) - ENDIF +LOGICAL(LGT) :: toLog +IF (ASSOCIATED(obj%surrogate)) THEN + obj%surrogate%nInfo = obj%surrogate%nInfo + 1 + obj%surrogate%lastMesg = mesg + toLog = (obj%surrogate%logFileActive .AND. & + & obj%surrogate%verbose(EXCEPTION_INFORMATION)) + CALL exceptionMessage( & + & eCode=EXCEPTION_INFORMATION, & + & isQuiet=obj%surrogate%quiet(EXCEPTION_INFORMATION), & + & isLogActive=toLog, & + & logUnit=obj%surrogate%logFileUnit, & + & mesg=obj%surrogate%lastMesg) +ELSE + obj%nInfo = obj%nInfo + 1 + obj%lastMesg = mesg + toLog = (obj%logFileActive .AND. obj%verbose(EXCEPTION_INFORMATION)) + CALL exceptionMessage( & + & eCode=EXCEPTION_INFORMATION, & + & isQuiet=obj%quiet(EXCEPTION_INFORMATION), & + & isLogActive=toLog, & + & logUnit=obj%logFileUnit, & + & mesg=obj%lastMesg) +END IF END PROCEDURE raiseInformation !---------------------------------------------------------------------------- @@ -54,29 +54,29 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE raiseWarning - LOGICAL( LGT ) :: toLog - IF( ASSOCIATED( obj%surrogate ) ) THEN - obj%surrogate%nWarn=obj%surrogate%nWarn+1 - obj%surrogate%lastMesg=mesg - toLog=(obj%surrogate%logFileActive .AND. & - & obj%surrogate%verbose(EXCEPTION_WARNING)) - CALL exceptionMessage( & - & eCode = EXCEPTION_WARNING, & - & isQuiet = obj%surrogate%quiet(EXCEPTION_WARNING), & - & isLogActive = toLog, & - & logUnit = obj%surrogate%logFileUnit, & - & mesg = obj%surrogate%lastMesg ) - ELSE - obj%nWarn = obj%nWarn+1 - obj%lastMesg = mesg - toLog=( obj%logFileActive .AND. obj%verbose(EXCEPTION_WARNING)) - CALL exceptionMessage( & - & eCode = EXCEPTION_WARNING, & - & isQuiet = obj%quiet(EXCEPTION_WARNING), & - & isLogActive = toLog, & - & logUnit = obj%logFileUnit, & - & mesg = obj%lastMesg ) - ENDIF +LOGICAL(LGT) :: toLog +IF (ASSOCIATED(obj%surrogate)) THEN + obj%surrogate%nWarn = obj%surrogate%nWarn + 1 + obj%surrogate%lastMesg = mesg + toLog = (obj%surrogate%logFileActive .AND. & + & obj%surrogate%verbose(EXCEPTION_WARNING)) + CALL exceptionMessage( & + & eCode=EXCEPTION_WARNING, & + & isQuiet=obj%surrogate%quiet(EXCEPTION_WARNING), & + & isLogActive=toLog, & + & logUnit=obj%surrogate%logFileUnit, & + & mesg=obj%surrogate%lastMesg) +ELSE + obj%nWarn = obj%nWarn + 1 + obj%lastMesg = mesg + toLog = (obj%logFileActive .AND. obj%verbose(EXCEPTION_WARNING)) + CALL exceptionMessage( & + & eCode=EXCEPTION_WARNING, & + & isQuiet=obj%quiet(EXCEPTION_WARNING), & + & isLogActive=toLog, & + & logUnit=obj%logFileUnit, & + & mesg=obj%lastMesg) +END IF END PROCEDURE raiseWarning !---------------------------------------------------------------------------- @@ -84,29 +84,29 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE raiseDebug - LOGICAL( LGT ) :: toLog - IF( ASSOCIATED( obj%surrogate ) ) THEN - obj%surrogate%nDebug=obj%surrogate%nDebug+1 - obj%surrogate%lastMesg=mesg - toLog=(obj%surrogate%logFileActive .AND. & - & obj%surrogate%verbose(EXCEPTION_DEBUG)) - CALL exceptionMessage( & - & eCode = EXCEPTION_DEBUG, & - & isQuiet = obj%surrogate%quiet(EXCEPTION_DEBUG), & - & isLogActive = toLog, & - & logUnit = obj%surrogate%logFileUnit, & - & mesg = obj%surrogate%lastMesg ) - ELSE - obj%nDebug = obj%nDebug+1 - obj%lastMesg = mesg - toLog=( obj%logFileActive .AND. obj%verbose(EXCEPTION_DEBUG)) - CALL exceptionMessage( & - & eCode = EXCEPTION_DEBUG, & - & isQuiet = obj%quiet(EXCEPTION_DEBUG), & - & isLogActive = toLog, & - & logUnit = obj%logFileUnit, & - & mesg = obj%lastMesg ) - ENDIF +LOGICAL(LGT) :: toLog +IF (ASSOCIATED(obj%surrogate)) THEN + obj%surrogate%nDebug = obj%surrogate%nDebug + 1 + obj%surrogate%lastMesg = mesg + toLog = (obj%surrogate%logFileActive .AND. & + & obj%surrogate%verbose(EXCEPTION_DEBUG)) + CALL exceptionMessage( & + & eCode=EXCEPTION_DEBUG, & + & isQuiet=obj%surrogate%quiet(EXCEPTION_DEBUG), & + & isLogActive=toLog, & + & logUnit=obj%surrogate%logFileUnit, & + & mesg=obj%surrogate%lastMesg) +ELSE + obj%nDebug = obj%nDebug + 1 + obj%lastMesg = mesg + toLog = (obj%logFileActive .AND. obj%verbose(EXCEPTION_DEBUG)) + CALL exceptionMessage( & + & eCode=EXCEPTION_DEBUG, & + & isQuiet=obj%quiet(EXCEPTION_DEBUG), & + & isLogActive=toLog, & + & logUnit=obj%logFileUnit, & + & mesg=obj%lastMesg) +END IF END PROCEDURE raiseDebug !---------------------------------------------------------------------------- @@ -114,31 +114,31 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE raiseError - LOGICAL( LGT ) :: toLog - IF( ASSOCIATED( obj%surrogate ) ) THEN - obj%surrogate%nError=obj%surrogate%nError+1 - obj%surrogate%lastMesg=mesg - toLog=(obj%surrogate%logFileActive .AND. & - & obj%surrogate%verbose(EXCEPTION_ERROR)) - CALL exceptionMessage( & - & eCode = EXCEPTION_ERROR, & - & isQuiet = obj%surrogate%quiet(EXCEPTION_ERROR), & - & isLogActive = toLog, & - & logUnit = obj%surrogate%logFileUnit, & - & mesg = obj%surrogate%lastMesg ) - CALL exceptionStop(obj%surrogate%stopOnError) - ELSE - obj%nError = obj%nError+1 - obj%lastMesg = mesg - toLog=( obj%logFileActive .AND. obj%verbose(EXCEPTION_ERROR)) - CALL exceptionMessage( & - & eCode = EXCEPTION_ERROR, & - & isQuiet = obj%quiet(EXCEPTION_ERROR), & - & isLogActive = toLog, & - & logUnit = obj%logFileUnit, & - & mesg = obj%lastMesg ) - CALL exceptionStop(obj%stopOnError) - ENDIF +LOGICAL(LGT) :: toLog +IF (ASSOCIATED(obj%surrogate)) THEN + obj%surrogate%nError = obj%surrogate%nError + 1 + obj%surrogate%lastMesg = mesg + toLog = (obj%surrogate%logFileActive .AND. & + & obj%surrogate%verbose(EXCEPTION_ERROR)) + CALL exceptionMessage( & + & eCode=EXCEPTION_ERROR, & + & isQuiet=obj%surrogate%quiet(EXCEPTION_ERROR), & + & isLogActive=toLog, & + & logUnit=obj%surrogate%logFileUnit, & + & mesg=obj%surrogate%lastMesg) + CALL exceptionStop(obj%surrogate%stopOnError) +ELSE + obj%nError = obj%nError + 1 + obj%lastMesg = mesg + toLog = (obj%logFileActive .AND. obj%verbose(EXCEPTION_ERROR)) + CALL exceptionMessage( & + & eCode=EXCEPTION_ERROR, & + & isQuiet=obj%quiet(EXCEPTION_ERROR), & + & isLogActive=toLog, & + & logUnit=obj%logFileUnit, & + & mesg=obj%lastMesg) + CALL exceptionStop(obj%stopOnError) +END IF END PROCEDURE raiseError !---------------------------------------------------------------------------- @@ -146,29 +146,29 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE raiseFatalError - LOGICAL( LGT ) :: tmpQuiet - tmpQuiet=.FALSE. +LOGICAL(LGT) :: tmpQuiet +tmpQuiet = .FALSE. - IF( ASSOCIATED( obj%surrogate ) ) THEN - obj%surrogate%nFatal=obj%surrogate%nFatal+1 - obj%surrogate%lastMesg=mesg - CALL exceptionMessage( & - & eCode = EXCEPTION_FATAL_ERROR, & - & isQuiet = tmpQuiet, & - & isLogActive = obj%surrogate%logFileActive, & - & logUnit = obj%surrogate%logFileUnit, & - & mesg = obj%surrogate%lastMesg ) - ELSE - obj%nFatal = obj%nFatal+1 - obj%lastMesg = mesg - CALL exceptionMessage( & - & eCode = EXCEPTION_FATAL_ERROR, & - & isQuiet = tmpQuiet, & - & isLogActive = obj%logFileActive, & - & logUnit = obj%logFileUnit, & - & mesg = obj%lastMesg ) - ENDIF - CALL exceptionStop(.TRUE.) +IF (ASSOCIATED(obj%surrogate)) THEN + obj%surrogate%nFatal = obj%surrogate%nFatal + 1 + obj%surrogate%lastMesg = mesg + CALL exceptionMessage( & + & eCode=EXCEPTION_FATAL_ERROR, & + & isQuiet=tmpQuiet, & + & isLogActive=obj%surrogate%logFileActive, & + & logUnit=obj%surrogate%logFileUnit, & + & mesg=obj%surrogate%lastMesg) +ELSE + obj%nFatal = obj%nFatal + 1 + obj%lastMesg = mesg + CALL exceptionMessage( & + & eCode=EXCEPTION_FATAL_ERROR, & + & isQuiet=tmpQuiet, & + & isLogActive=obj%logFileActive, & + & logUnit=obj%logFileUnit, & + & mesg=obj%lastMesg) +END IF +CALL exceptionStop(.TRUE.) END PROCEDURE raiseFatalError -END SUBMODULE raiseMethod \ No newline at end of file +END SUBMODULE raiseMethod diff --git a/src/submodules/FEDomain/CMakeLists.txt b/src/submodules/FEDomain/CMakeLists.txt new file mode 100644 index 000000000..8e3e92f0a --- /dev/null +++ b/src/submodules/FEDomain/CMakeLists.txt @@ -0,0 +1,25 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources( + ${PROJECT_NAME} + PRIVATE ${src_path}/FEDomain_Class@ConstructorMethods.F90 + ${src_path}/FEDomain_Class@IOMethods.F90 + ${src_path}/FEDomain_Class@GetMethods.F90 + ${src_path}/FEDomain_Class@SetMethods.F90 + ${src_path}/FEDomain_Class@MeshDataMethods.F90) diff --git a/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 new file mode 100644 index 000000000..3bf309f1e --- /dev/null +++ b/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 @@ -0,0 +1,47 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: This submodule contains methods for domain object + +SUBMODULE(FEDomain_Class) ConstructorMethods +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Final +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Final +CALL obj%DEALLOCATE() +END PROCEDURE obj_Final + +!---------------------------------------------------------------------------- +! FEDomain_Pointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Constructor_1 +ALLOCATE (FEDomain_ :: ans) +CALL ans%Initiate(hdf5=hdf5, group=group) +END PROCEDURE obj_Constructor_1 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE ConstructorMethods diff --git a/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 new file mode 100644 index 000000000..6df326abb --- /dev/null +++ b/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 @@ -0,0 +1,19 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: This submodule contains methods for domain object diff --git a/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 new file mode 100644 index 000000000..e578e29a2 --- /dev/null +++ b/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 @@ -0,0 +1,15 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see diff --git a/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 new file mode 100644 index 000000000..63b7886bf --- /dev/null +++ b/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 @@ -0,0 +1,16 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! diff --git a/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 new file mode 100644 index 000000000..63b7886bf --- /dev/null +++ b/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 @@ -0,0 +1,16 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! diff --git a/src/submodules/FEDomainConnectivity/CMakeLists.txt b/src/submodules/FEDomainConnectivity/CMakeLists.txt new file mode 100644 index 000000000..b560408f6 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/CMakeLists.txt @@ -0,0 +1,25 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources( + ${PROJECT_NAME} + PRIVATE ${src_path}/FEDomainConnectivity_Class@ConstructorMethods.F90 + ${src_path}/FEDomainConnectivity_Class@IOMethods.F90 + ${src_path}/FEDomainConnectivity_Class@NodeMethods.F90 + ${src_path}/FEDomainConnectivity_Class@CellMethods.F90 + ${src_path}/FEDomainConnectivity_Class@FacetMethods.F90) diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 new file mode 100644 index 000000000..0232a67a3 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -0,0 +1,147 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(FEDomainConnectivity_Class) CellMethods +! USE BaseMethod +USE IntegerUtility, ONLY: OPERATOR(.in.) +USE ReallocateUtility +USE Display_Method +IMPLICIT NONE + +CONTAINS + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateCellToCellData1 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData1()" +INTEGER(I4B) :: ii, nsd, order1, order2, iel1, jj +! some counters and indices +! element numbers in mesh2 +INTEGER(I4B), POINTER :: nodeToNode(:) +LOGICAL(LGT) :: isok +INTEGER(I4B) :: nptrs1(PARAM_MAX_NNE), nptrs2(PARAM_MAX_NNE), & + nptrs3(PARAM_MAX_NNE), elem2(PARAM_MAX_NODE_TO_ELEM) + +INTEGER(I4B) :: minelem, maxelem, telem2 + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +#ifdef DEBUG_VER + +isok = obj%isCellToCell +IF (isok) THEN + CALL e%RaiseInformation(modName//"::"//myName//" - "// & + & "[INFO] :: It seems, obj%cellToCell data is already initiated") + RETURN +END IF + +isok = obj%isNodeToNode + +IF (.NOT. isok) THEN + CALL e%RaiseInformation(modName//"::"//myName//" - "// & + & '[INFO] :: NodeToNode data is not initiated!') + CALL obj%InitiateNodeToNodeData(domain1=domain1, domain2=domain2) +END IF + +#endif + +isok = obj%isCellToCell +IF (isok) RETURN + +isok = obj%isNodeToNode +IF (.NOT. isok) & + CALL obj%InitiateNodeToNodeData(domain1=domain1, domain2=domain2) + +CALL domain1%GetParam(maxElemNum=maxelem, minElemNum=minelem) +CALL Reallocate(obj%cellToCell, maxelem) + +obj%isCellToCell = .TRUE. +nsd = domain1%GetNSD() + +nodeToNode => obj%GetNodeToNodePointer() + +! Get mesh pointer +DO iel1 = minelem, maxelem + isok = domain1%isElementPresent(globalElement=iel1) + IF (.NOT. isok) CYCLE + + CALL domain1%GetConnectivity_(globalElement=iel1, ans=nptrs1, tsize=order1, & + islocal=.FALSE., dim=nsd) + DO ii = 1, order1 + nptrs2(ii) = nodeToNode(nptrs1(ii)) + END DO + + DO ii = 1, order1 + IF (nptrs2(ii) .EQ. 0) CYCLE + + CALL domain2%GetNodeToElements_(GlobalNode=nptrs2(ii), ans=elem2, & + tsize=telem2, islocal=.FALSE.) + + DO jj = 1, telem2 + + CALL domain2%GetConnectivity_(globalElement=elem2(jj), & + ans=nptrs3, tsize=order2, dim=nsd, islocal=.FALSE.) + + IF (order1 .GE. order2) THEN + IF (nptrs3(1:order2) .in.nptrs2(1:order1)) THEN + obj%cellToCell(iel1) = elem2(jj) + EXIT + END IF + ELSE + IF (nptrs2(1:order1) .in.nptrs3(1:order2)) THEN + obj%cellToCell(iel1) = elem2(jj) + EXIT + END IF + END IF + + END DO + + END DO + +END DO + +NULLIFY (nodeToNode) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_InitiateCellToCellData1 + +!---------------------------------------------------------------------------- +! GetCellToCellPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetCellToCellPointer +ans => obj%cellTocell +END PROCEDURE obj_GetCellToCellPointer + +!---------------------------------------------------------------------------- +! GetDimEntityNum +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetDimEntityNum +ans = obj%cellToCellExtraData(1:2, globalElement) +END PROCEDURE obj_GetDimEntityNum + +END SUBMODULE CellMethods diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ConstructorMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ConstructorMethods.F90 new file mode 100644 index 000000000..9f246dea4 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ConstructorMethods.F90 @@ -0,0 +1,80 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(FEDomainConnectivity_Class) ConstructorMethods +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate1 +obj%isInitiated = .FALSE. +obj%isFacetToCell = .FALSE. +obj%isNodeToNode = .FALSE. +obj%isCellToCell = .FALSE. +IF (ALLOCATED(obj%nodeToNode)) DEALLOCATE (obj%nodeToNode) +IF (ALLOCATED(obj%cellToCell)) DEALLOCATE (obj%cellToCell) +IF (ALLOCATED(obj%facetToCell)) DEALLOCATE (obj%facetToCell) +IF (ALLOCATED(obj%elemToElem)) DEALLOCATE (obj%elemToElem) +END PROCEDURE obj_Deallocate1 + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate2 +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE obj_Deallocate2 + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate3 +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + IF (ASSOCIATED(obj(ii)%ptr)) THEN + CALL obj(ii)%ptr%DEALLOCATE() + obj(ii)%ptr => NULL() + END IF + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE obj_Deallocate3 + +!---------------------------------------------------------------------------- +! Final +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Final +CALL obj%DEALLOCATE() +END PROCEDURE obj_Final + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE ConstructorMethods diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 new file mode 100644 index 000000000..01669e069 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 @@ -0,0 +1,18 @@ +! This program is a part of EASIFEM library +! Expandable And Scalable Infrastructure for Finite Element Methods +! htttps://www.easifem.com +! Vikas Sharma, Ph.D., vickysharma0812@gmail.com +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 new file mode 100644 index 000000000..7f9dea9cf --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 @@ -0,0 +1,950 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(FEDomainConnectivity_Class) FacetMethods +USE ReallocateUtility +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +! SUBROUTINE facet_to_cell_helper(obj, facetMesh, cellMesh, dim, entityNum, & +! & isMaster) +! CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj +! !! FEDomain connectivity data +! CLASS(AbstractMesh_), INTENT(INOUT) :: facetMesh +! !! Mesh of facet elements +! CLASS(AbstractMesh_), INTENT(INOUT) :: cellMesh +! !! Master mesh +! INTEGER(I4B), INTENT(IN) :: dim +! !! dim +! INTEGER(I4B), INTENT(IN) :: entityNum +! !! entityNum +! LOGICAL(LGT), INTENT(IN) :: isMaster +! !! if true then cell Mesh is master cell +! !! if false then cell mesh is slave cell +! +! ! INTEGER(I4B) :: iface, icell, ii, tfacet, cellGlobalNum, & +! ! & localFacetID, jj +! ! INTEGER(I4B), ALLOCATABLE :: nptrs(:), pt2elem(:), & +! ! & cellNptrs(:), facetNptrs(:) +! ! CHARACTER(*), PARAMETER :: myName = "facet_to_cell_helper()" +! ! +! ! ii = 0 +! ! +! ! IF (.NOT. ALLOCATED(cellMesh%facetElements)) THEN +! ! CALL e%raiseError(modName//'::'//myName//' - '// & +! ! & 'AbstractMesh_::cellMesh%facetElements should be allocated!') +! ! RETURN +! ! END IF +! ! +! ! tfacet = SIZE(cellMesh%facetElements) +! ! +! ! DO iface = facetMesh%minElemNum, facetMesh%maxElemNum +! ! IF (.NOT. facetMesh%isElementPresent(globalElement=iface)) CYCLE +! ! nptrs = facetMesh%getConnectivity(globalElement=iface) +! ! +! ! ! It is important that all nodes of a facet element are present +! ! ! in the cellMesh. +! ! +! ! ii = ii + 1 +! ! +! ! obj%facetToCell(ii)%facetID = iface +! ! +! ! IF (.NOT. cellMesh%isAllNodePresent(nptrs)) CYCLE +! ! +! ! ! Get the element in Cell mesh surrounding this node +! ! +! ! pt2elem = cellMesh%getNodetoElements(globalNode=nptrs) +! ! +! ! DO icell = 1, SIZE(pt2elem) +! ! +! ! cellNptrs = cellMesh%getConnectivity(globalElement=pt2elem(icell)) +! ! +! ! IF (nptrs.IN.cellNptrs) THEN +! ! +! ! cellGlobalNum = pt2elem(icell) +! ! +! ! localFacetID = 0 +! ! +! ! DO jj = 1, tfacet +! ! +! ! facetNptrs = cellMesh%getFacetConnectivity(& +! ! & globalElement=cellGlobalNum, & +! ! & iface=jj) +! ! +! ! IF (nptrs.in.facetNptrs) THEN +! ! localFacetID = jj +! ! EXIT +! ! END IF +! ! +! ! END DO +! ! +! ! IF (localFacetID .EQ. 0) THEN +! ! CALL e%raiseError(modName//'::'//myName//' - '// & +! ! & 'No local facet found') +! ! END IF +! ! +! ! IF (isMaster) THEN +! ! obj%facetToCell(ii)%GlobalCellData(1, 1) = cellGlobalNum +! ! obj%facetToCell(ii)%GlobalCellData(2, 1) = localFacetID +! ! obj%facetToCell(ii)%GlobalCellData(3:4, 1) = [dim, entityNum] +! ! ELSE +! ! obj%facetToCell(ii)%GlobalCellData(1, 2) = cellGlobalNum +! ! obj%facetToCell(ii)%GlobalCellData(2, 2) = localFacetID +! ! obj%facetToCell(ii)%GlobalCellData(3:4, 2) = [dim, entityNum] +! ! END IF +! ! +! ! EXIT +! ! +! ! END IF +! ! +! ! END DO +! ! END DO +! ! +! ! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! ! IF (ALLOCATED(pt2elem)) DEALLOCATE (pt2elem) +! ! IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) +! ! IF (ALLOCATED(facetNptrs)) DEALLOCATE (facetNptrs) +! +! END SUBROUTINE facet_to_cell_helper + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateFacetToCellData1 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData1()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +! +! INTEGER(I4B) :: tfacet +! CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData1" +! LOGICAL(LGT) :: isVar +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[START] InitiateFacetToCellData()') +! +! CALL cellMesh%GetParam(isNodeToElementsInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & "In cellMesh node to elements data is not initiated, & +! & calling cellMesh%InitiateNodeToElements()") +! CALL cellMesh%InitiateNodeToElements() +! END IF +! +! IF (obj%isFacetToCell) THEN +! CALL e%raiseInformation(modName//"::"//myName//" - "// & +! & "It seems, obj%facetToCell data is already initiated") +! RETURN +! END IF +! +! tfacet = facetMesh%getTotalElements() +! ALLOCATE (obj%facetToCell(tfacet)) +! obj%isFacetToCell = .TRUE. +! CALL display("Calling facet_to_cell_helper()", unitno=stdout) +! +! CALL facet_to_cell_helper(obj, facetMesh, cellMesh, dim, entityNum, isMaster) +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[END] InitiateFacetToCellData()') + +END PROCEDURE obj_InitiateFacetToCellData1 + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateFacetToCellData2 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData2()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +! INTEGER(I4B) :: dim_facet, icellMesh, tCellMesh, tface, nsd +! CLASS(AbstractMesh_), POINTER :: meshptr +! LOGICAL(LGT) :: isVar +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[START] InitiateFacetToCellData()') +! +! IF (obj%isFacetToCell) THEN +! CALL e%raiseInformation(modName//"::"//myName//" - "// & +! & "It seems, obj%facetToCell data is already initiated") +! RETURN +! END IF +! +! meshptr => NULL() +! dim_facet = facetMesh%getXidimension() +! nsd = masterFEDomain%getNSD() +! +! IF (dim_facet .GE. nsd) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'xidimension of facet mesh is >= to spatial dimension of masterFEDomain') +! END IF +! +! tface = facetMesh%getTotalElements() +! ! IF (ALLOCATED(obj%facetToCell)) DEALLOCATE (obj%facetToCell) +! ALLOCATE (obj%facetToCell(tface)) +! obj%isFacetToCell = .TRUE. +! +! ! Handling masterCell +! +! tCellMesh = masterFEDomain%getTotalMesh(dim=dim_facet + 1) +! +! DO icellMesh = 1, tCellMesh +! +! meshptr => masterFEDomain%getMeshPointer(dim=dim_facet + 1, & +! & entityNum=icellMesh) +! +! CALL meshptr%GetParam(isNodeToElementsInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & "In cellMesh node to elements data is not initiated, & +! & calling cellMesh%InitiateNodeToElements()") +! CALL meshptr%InitiateNodeToElements() +! END IF +! +! CALL facet_to_cell_helper(obj=obj, & +! & facetMesh=facetMesh, & +! & cellMesh=meshptr, & +! & dim=dim_facet + 1, & +! & entityNum=icellMesh, & +! & isMaster=.TRUE.) +! +! END DO +! +! ! Handling slaveCell +! +! tCellMesh = slaveFEDomain%getTotalMesh(dim=dim_facet + 1) +! +! DO icellMesh = 1, tCellMesh +! +! meshptr => slaveFEDomain%getMeshPointer(dim=dim_facet + 1, & +! & entityNum=icellMesh) +! +! CALL facet_to_cell_helper( & +! & obj=obj, & +! & facetMesh=facetMesh, & +! & cellMesh=meshptr, & +! & dim=dim_facet + 1, & +! & entityNum=icellMesh, & +! & isMaster=.FALSE.) +! +! END DO +! +! NULLIFY (meshptr) +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[END] InitiateFacetToCellData()') + +END PROCEDURE obj_InitiateFacetToCellData2 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateFacetToCellData3 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData3()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +! +! INTEGER(I4B) :: iface, icell, ii, colID, tface, tfacet, & +! & cellGlobalNum, localFacetID, jj +! INTEGER(I4B), ALLOCATABLE :: nptrs(:), pt2elem(:), & +! & cellNptrs(:), facetNptrs(:) +! LOGICAL(LGT) :: isVar +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[START] InitiateFacetToCellData()') +! +! IF (.NOT. ALLOCATED(cellMesh%facetElements)) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'AbstractMesh_::cellMesh%facetElements should be allocated!') +! ELSE +! tfacet = SIZE(cellMesh%facetElements) +! END IF +! +! CALL cellMesh%GetParam(isNodeToElementsInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & "In cellMesh node to elements data is not initiated, & +! & calling cellMesh%InitiateNodeToElements()") +! CALL cellMesh%InitiateNodeToElements() +! END IF +! +! IF (obj%isFacetToCell) THEN +! CALL e%raiseInformation(modName//"::"//myName//" - "// & +! & "It seems, obj%facetToCell data is already initiated") +! RETURN +! END IF +! +! tface = facetMesh%getTotalElements() +! ALLOCATE (obj%facetToCell(tface)) +! +! ii = 0 +! +! DO iface = facetMesh%minElemNum, facetMesh%maxElemNum +! IF (.NOT. facetMesh%isElementPresent(globalElement=iface)) CYCLE +! nptrs = facetMesh%getConnectivity(globalElement=iface) +! +! ! It is important that all nodes of a facet element are present +! ! in the cellMesh. +! +! ii = ii + 1 +! +! obj%facetToCell(ii)%facetID = iface +! +! IF (.NOT. cellMesh%isAllNodePresent(nptrs)) CYCLE +! +! ! Get the element in Cell mesh surrounding this node +! +! pt2elem = cellMesh%getNodetoElements(globalNode=nptrs) +! +! colID = 0 +! +! DO icell = 1, SIZE(pt2elem) +! +! cellGlobalNum = pt2elem(icell) +! +! cellNptrs = cellMesh%getConnectivity(globalElement=cellGlobalNum) +! +! IF (nptrs.IN.cellNptrs) THEN +! +! localFacetID = 0 +! +! DO jj = 1, tfacet +! +! facetNptrs = cellMesh%getFacetConnectivity(& +! & globalElement=cellGlobalNum, & +! & iface=jj) +! +! IF (nptrs.in.facetNptrs) THEN +! localFacetID = jj +! EXIT +! END IF +! +! END DO +! +! IF (localFacetID .EQ. 0) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'No local facet found') +! END IF +! +! colID = colID + 1 +! +! IF (colID .GT. 2) THEN +! CALL e%raiseError(modName//"::"//myName//" - "// & +! & "It seems the facet element has more than 2 cell element") +! ELSE +! obj%facetToCell(ii)%GlobalCellData(1, colID) = cellGlobalNum +! obj%facetToCell(ii)%GlobalCellData(2, colID) = localFacetID +! obj%facetToCell(ii)%GlobalCellData(3:4, colID) = [dim, entityNum] +! END IF +! END IF +! +! END DO +! +! IF (colID .EQ. 0) THEN +! CALL e%raiseError(modName//"::"//myName//" - "// & +! & "It seems the facet element has no cell element") +! END IF +! +! END DO +! +! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! IF (ALLOCATED(pt2elem)) DEALLOCATE (pt2elem) +! IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) +! IF (ALLOCATED(facetNptrs)) DEALLOCATE (facetNptrs) +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[END] InitiateFacetToCellData()') +END PROCEDURE obj_InitiateFacetToCellData3 + +!---------------------------------------------------------------------------- +! InitiateFacetToCellData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateFacetToCellData4 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData4()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +! INTEGER(I4B) :: dim_facet, icellMesh, tCellMesh, tface, ii, iface, icell, & +! & nsd, tfacet, cellGlobalNum, localFacetID, jj +! CLASS(AbstractMesh_), POINTER :: cellMesh +! INTEGER(I4B), ALLOCATABLE :: colID(:), nptrs(:), pt2elem(:), & +! & cellNptrs(:), facetNptrs(:) +! LOGICAL(LGT) :: isVar +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[START] InitiateFacetToCellData()') +! +! IF (obj%isFacetToCell) THEN +! CALL e%raiseInformation(modName//"::"//myName//" - "// & +! & "It seems, obj%facetToCell data is already initiated") +! RETURN +! END IF +! +! cellMesh => NULL() +! dim_facet = facetMesh%getXidimension() +! nsd = cellFEDomain%getNSD() +! +! IF (dim_facet .GE. nsd) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'xidimension of facet mesh is >= to spatial dimension of cellFEDomain') +! END IF +! +! tface = facetMesh%getTotalElements() +! ! IF (ALLOCATED(obj%facetToCell)) DEALLOCATE (obj%facetToCell) +! ALLOCATE (obj%facetToCell(tface)) +! +! ALLOCATE (colID(tface)) +! colID = 0 +! ! +! ! Handling masterCell +! ! +! tCellMesh = cellFEDomain%getTotalMesh(dim=dim_facet + 1) +! +! DO icellMesh = 1, tCellMesh +! +! cellMesh => cellFEDomain%getMeshPointer(dim=dim_facet + 1, & +! & entityNum=icellMesh) +! +! ! +! ! Check if the mesh is not empty +! ! +! IF (.NOT. ASSOCIATED(cellMesh)) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'AbstractMesh_::cellMesh is not associated!') +! END IF +! +! IF (cellMesh%getTotalElements() .EQ. 0) CYCLE +! +! IF (.NOT. ALLOCATED(cellMesh%facetElements)) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'AbstractMesh_::cellMesh%facetElements should be allocated!') +! ELSE +! tfacet = SIZE(cellMesh%facetElements) +! END IF +! +! CALL cellMesh%GetParam(isNodeToElementsInitiated=isVar) +! +! IF (.NOT. isVar) THEN +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & "In cellMesh node to elements data is not initiated, & +! & calling cellMesh%InitiateNodeToElements()") +! CALL cellMesh%InitiateNodeToElements() +! END IF +! +! ii = 0 +! +! DO iface = facetMesh%minElemNum, facetMesh%maxElemNum +! +! IF (.NOT. facetMesh%isElementPresent(globalElement=iface)) CYCLE +! nptrs = facetMesh%getConnectivity(globalElement=iface) +! +! ! It is important that all nodes of a facet element are present +! ! in the cellMesh. +! +! ii = ii + 1 +! +! obj%facetToCell(ii)%facetID = iface +! +! IF (.NOT. cellMesh%isAllNodePresent(nptrs)) CYCLE +! +! ! Get the element in Cell mesh surrounding this node +! +! pt2elem = cellMesh%getNodetoElements(globalNode=nptrs) +! +! ! colID = 0 +! +! DO icell = 1, SIZE(pt2elem) +! +! cellGlobalNum = pt2elem(icell) +! cellNptrs = cellMesh%getConnectivity(globalElement=cellGlobalNum) +! +! IF (nptrs.IN.cellNptrs) THEN +! +! localFacetID = 0 +! +! DO jj = 1, tfacet +! +! facetNptrs = cellMesh%getFacetConnectivity(& +! & globalElement=cellGlobalNum, & +! & iface=jj) +! +! IF (nptrs.in.facetNptrs) THEN +! localFacetID = jj +! EXIT +! END IF +! +! END DO +! +! IF (localFacetID .EQ. 0) THEN +! CALL e%raiseError(modName//'::'//myName//' - '// & +! & 'No local facet found') +! END IF +! +! colID(ii) = colID(ii) + 1 +! +! IF (colID(ii) .GT. 2) THEN +! CALL e%raiseError(modName//"::"//myName//" - "// & +! & "It seems the facet element = "//TOSTRING(iface)// & +! & " has more than 2 cell element") +! ELSE +! obj%facetToCell(ii)%GlobalCellData(1, colID(ii)) = & +! & cellGlobalNum +! obj%facetToCell(ii)%GlobalCellData(2, colID(ii)) = & +! & localFacetID +! obj%facetToCell(ii)%GlobalCellData(3:4, colID(ii)) = & +! & [dim_facet + 1, icellMesh] +! END IF +! END IF +! +! END DO +! +! IF (colID(ii) .EQ. 0) THEN +! CALL e%raiseWarning(modName//"::"//myName//" - "// & +! & "It seems the facet element = "//TOSTRING(iface)// & +! & " has no cell element"// & +! & " . Nptrs of facet = "//tostring(nptrs)) +! END IF +! +! END DO +! +! END DO +! +! NULLIFY (cellMesh) +! IF (ALLOCATED(colID)) DEALLOCATE (colID) +! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! IF (ALLOCATED(pt2elem)) DEALLOCATE (pt2elem) +! IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) +! IF (ALLOCATED(facetNptrs)) DEALLOCATE (facetNptrs) +! +! CALL e%raiseInformation(modName//'::'//myName//' - '// & +! & '[END] InitiateFacetToCellData()') + +END PROCEDURE obj_InitiateFacetToCellData4 + +!---------------------------------------------------------------------------- +! masterCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterCellNumber1 +ans = obj%facetToCell(localElement)%GlobalCellData(1, 1) +END PROCEDURE obj_MasterCellNumber1 + +!---------------------------------------------------------------------------- +! masterCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterCellNumber2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(ii) = obj%facetToCell(localElement(ii))%GlobalCellData(1, 1) +END DO +END PROCEDURE obj_MasterCellNumber2 + +!---------------------------------------------------------------------------- +! masterCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterCellNumber3 +INTEGER(I4B) :: tsize + +IF (ALLOCATED(obj%facetToCell)) THEN + tsize = SIZE(obj%facetToCell) +ELSE + tsize = 0 +END IF + +CALL Reallocate(ans, tsize) + +CALL obj%GetMasterCellNumber(VALUE=ans) +END PROCEDURE obj_MasterCellNumber3 + +!---------------------------------------------------------------------------- +! masterCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetMasterCellNumber +INTEGER(I4B) :: ii, tsize + +tsize = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + tsize = SIZE(obj%facetToCell) +END IF + +DO ii = 1, tsize + VALUE(ii) = obj%facetToCell(ii)%GlobalCellData(1, 1) +END DO + +END PROCEDURE obj_GetMasterCellNumber + +!---------------------------------------------------------------------------- +! slaveCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveCellNumber1 +ans = obj%facetToCell(localElement)%GlobalCellData(1, 2) +END PROCEDURE obj_SlaveCellNumber1 + +!---------------------------------------------------------------------------- +! slaveCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveCellNumber2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(ii) = obj%facetToCell(localElement(ii))%GlobalCellData(1, 2) +END DO +END PROCEDURE obj_SlaveCellNumber2 + +!---------------------------------------------------------------------------- +! slaveCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveCellNumber3 +INTEGER(I4B) :: tsize + +tsize = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + tsize = SIZE(obj%facetToCell) +ELSE + tsize = 0 +END IF + +CALL Reallocate(ans, tsize) +CALL obj%GetSlaveCellNumber(ans) +END PROCEDURE obj_SlaveCellNumber3 + +!---------------------------------------------------------------------------- +! GetSlaveCellNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetSlaveCellNumber +INTEGER(I4B) :: ii, tsize +tsize = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + tsize = SIZE(obj%facetToCell) +END IF + +DO ii = 1, tsize + VALUE(ii) = obj%facetToCell(ii)%GlobalCellData(1, 2) +END DO +END PROCEDURE obj_GetSlaveCellNumber + +!---------------------------------------------------------------------------- +! masterFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterFacetLocalID1 +ans = obj%facetToCell(localElement)%GlobalCellData(2, 1) +END PROCEDURE obj_MasterFacetLocalID1 + +!---------------------------------------------------------------------------- +! masterFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterFacetLocalID2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(ii) = obj%facetToCell(localElement(ii))%GlobalCellData(2, 1) +END DO +END PROCEDURE obj_MasterFacetLocalID2 + +!---------------------------------------------------------------------------- +! masterFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterFacetLocalID3 +INTEGER(I4B) :: tsize + +tsize = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + tsize = SIZE(obj%facetToCell) +END IF + +CALL Reallocate(ans, tsize) + +CALL obj%GetMasterFacetLocalID(ans) + +END PROCEDURE obj_MasterFacetLocalID3 + +!---------------------------------------------------------------------------- +! GetMasterFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetMasterFacetLocalID +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() + +DO ii = 1, tsize + VALUE(ii) = obj%facetToCell(ii)%GlobalCellData(2, 1) +END DO +END PROCEDURE obj_GetMasterFacetLocalID + +!---------------------------------------------------------------------------- +! slaveFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveFacetLocalID1 +ans = obj%facetToCell(localElement)%GlobalCellData(2, 2) +END PROCEDURE obj_SlaveFacetLocalID1 + +!---------------------------------------------------------------------------- +! slaveFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveFacetLocalID2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(ii) = obj%facetToCell(localElement(ii))%GlobalCellData(2, 2) +END DO +END PROCEDURE obj_SlaveFacetLocalID2 + +!---------------------------------------------------------------------------- +! slaveFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveFacetLocalID3 +INTEGER(I4B) :: tsize + +tsize = obj%GetTotalFacet() + +CALL Reallocate(ans, tsize) +CALL obj%GetSlaveCellNumber(ans) + +END PROCEDURE obj_SlaveFacetLocalID3 + +!---------------------------------------------------------------------------- +! GetSlaveFacetLocalID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetSlaveFacetLocalID +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() + +DO ii = 1, tsize + VALUE(ii) = obj%facetToCell(ii)%GlobalCellData(2, 2) +END DO +END PROCEDURE obj_GetSlaveFacetLocalID + +!---------------------------------------------------------------------------- +! masterDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterDimTag1 +ans = obj%facetToCell(localElement)%GlobalCellData(3:4, 1) +END PROCEDURE obj_MasterDimTag1 + +!---------------------------------------------------------------------------- +! masterDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterDimTag2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(:, ii) = obj%facetToCell(localElement(ii))%GlobalCellData(3:4, 1) +END DO +END PROCEDURE obj_MasterDimTag2 + +!---------------------------------------------------------------------------- +! slaveDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MasterDimTag3 +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() +ii = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + ii = 2 +END IF + +IF (isTranspose) THEN + CALL Reallocate(ans, tsize, ii) +ELSE + CALL Reallocate(ans, ii, tsize) +END IF + +CALL obj%GetMasterDimTag(isTranspose=isTranspose, VALUE=ans) +END PROCEDURE obj_MasterDimTag3 + +!---------------------------------------------------------------------------- +! GetMasterDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetMasterDimTag +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() + +IF (isTranspose) THEN + + DO ii = 1, tsize + VALUE(ii, 1) = obj%facetToCell(ii)%GlobalCellData(3, 1) + END DO + + DO ii = 1, tsize + VALUE(ii, 2) = obj%facetToCell(ii)%GlobalCellData(4, 1) + END DO + + RETURN + +END IF + +DO ii = 1, tsize + VALUE(1:2, ii) = obj%facetToCell(ii)%GlobalCellData(3:4, 1) +END DO + +END PROCEDURE obj_GetMasterDimTag + +!---------------------------------------------------------------------------- +! slaveDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveDimTag1 +ans = obj%facetToCell(localElement)%GlobalCellData(3:4, 2) +END PROCEDURE obj_SlaveDimTag1 + +!---------------------------------------------------------------------------- +! slaveDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveDimTag2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(1:2, ii) = obj%facetToCell(localElement(ii))%GlobalCellData(3:4, 2) +END DO +END PROCEDURE obj_SlaveDimTag2 + +!---------------------------------------------------------------------------- +! slaveDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SlaveDimTag3 +INTEGER(I4B) :: ii, tsize + +ii = 0 +tsize = obj%GetTotalFacet() + +IF (isTranspose) THEN + CALL Reallocate(ans, tsize, ii) + +ELSE + CALL Reallocate(ans, ii, tsize) + +END IF + +CALL obj%GetSlaveDimTag(isTranspose=isTranspose, VALUE=ans) +END PROCEDURE obj_SlaveDimTag3 + +!---------------------------------------------------------------------------- +! GetSlaveDimTag +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetSlaveDimTag +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() + +IF (isTranspose) THEN + + DO ii = 1, tsize + VALUE(ii, 1) = obj%facetToCell(ii)%GlobalCellData(3, 2) + VALUE(ii, 2) = obj%facetToCell(ii)%GlobalCellData(4, 2) + END DO + +ELSE + + DO ii = 1, tsize + VALUE(1:2, ii) = obj%facetToCell(ii)%GlobalCellData(3:4, 2) + END DO + +END IF + +END PROCEDURE obj_GetSlaveDimTag + +!---------------------------------------------------------------------------- +! GlobalFacetID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GlobalFacetID1 +ans = obj%facetToCell(localElement)%facetID +END PROCEDURE obj_GlobalFacetID1 + +!---------------------------------------------------------------------------- +! GlobalFacetID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GlobalFacetID2 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(localElement) + ans(ii) = obj%facetToCell(localElement(ii))%facetID +END DO +END PROCEDURE obj_GlobalFacetID2 + +!---------------------------------------------------------------------------- +! GlobalFacetID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GlobalFacetID3 +INTEGER(I4B) :: tsize + +tsize = obj%GetTotalFacet() +CALL Reallocate(ans, tsize) + +CALL obj%GetGlobalFacetID(ans) + +END PROCEDURE obj_GlobalFacetID3 + +!---------------------------------------------------------------------------- +! GetGlobalFacetID +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetGlobalFacetID +INTEGER(I4B) :: ii, tsize + +tsize = obj%GetTotalFacet() + +DO ii = 1, tsize + VALUE(ii) = obj%facetToCell(ii)%facetID +END DO +END PROCEDURE obj_GetGlobalFacetID + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalFacet +ans = 0 +IF (ALLOCATED(obj%facetToCell)) THEN + ans = SIZE(obj%facetToCell) +END IF +END PROCEDURE obj_GetTotalFacet + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE FacetMethods diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@IOMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@IOMethods.F90 new file mode 100644 index 000000000..e43363a57 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@IOMethods.F90 @@ -0,0 +1,55 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(FEDomainConnectivity_Class) IOMethods +USE Display_Method +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! DisplayFacetToCellData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_DisplayFacetToCellData +INTEGER(I4B) :: ii, tsize +LOGICAL(LGT) :: abool +CHARACTER(:), ALLOCATABLE :: astr + +abool = ALLOCATED(obj%facetToCell) +CALL Display(abool, "FEDomainConnectivity_::obj%facetToCell ALLOCATED: ", & + & unitno=unitno) +IF (.NOT. abool) RETURN + +CALL Display(msg, unitno=unitno) + +tsize = SIZE(obj%facetToCell) +astr = "facetID, globalCell(master), localFacetID(master), dim(master), & + & entityNum(master), globalCell(slave), localFacetID(slave), dim(slave),& + & entityNum(slave) " + +CALL Display(astr, unitno=unitno) + +DO ii = 1, tsize + astr = Tostring(obj%facetToCell(ii)%facetID)//", "// & + & Tostring(obj%facetToCell(ii)%globalCellData(:, 1))//", "// & + & Tostring(obj%facetToCell(ii)%globalCellData(:, 2)) + CALL Display(astr, unitno=unitno) +END DO + +END PROCEDURE obj_DisplayFacetToCellData + +END SUBMODULE IOMethods diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 new file mode 100644 index 000000000..3d8d489ae --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 @@ -0,0 +1,132 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +SUBMODULE(FEDomainConnectivity_Class) NodeMethods +! USE BaseMethod +USE BaseType, ONLY: BoundingBox_ +USE BoundingBox_Method +USE ReallocateUtility +USE ApproxUtility +USE Display_Method +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! InitiateNodeToNodeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateNodeToNodeData1 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateNodeToNodeData1()" + +TYPE(BoundingBox_) :: box, box1, box2 +LOGICAL(LGT) :: isvar, isok +INTEGER(I4B), ALLOCATABLE :: nptrs1(:) +INTEGER(I4B) :: ii, jj, nsd, tnodes1, node1, node2 +REAL(DFP) :: x1(3), x2(3) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif DEBUG_VER + +#ifdef DEBUG_VER + +CALL domain1%GetParam(isInitiated=isok) +! check domain1 initiated +IF (.NOT. isok) THEN + CALL e%raiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: domain1 is not initiated, first initiate it") + RETURN +END IF + +CALL domain2%GetParam(isInitiated=isok) +IF (.NOT. isok) THEN + CALL e%raiseError(modName//"::"//myName//" - "// & + & "[INTERNAL ERROR] :: domain2 is not initiated, first initiate it") + RETURN +END IF + +isok = obj%isNodeToNode +IF (isok) THEN + CALL e%raiseInformation(modName//"::"//myName//" - "// & + & "[INFO] :: It seems, obj%nodeToNode data is already initiated") + RETURN +END IF + +#endif + +isok = obj%isNodeToNode +IF (isok) RETURN + +ii = domain1%GetTotalNodes() +CALL Reallocate(obj%nodeToNode, ii) +obj%isNodeToNode = .TRUE. + +box1 = domain1%GetBoundingBox() +box2 = domain2%GetBoundingBox() +isvar = box1.isIntersect.box2 + +IF (.NOT. isvar) THEN + CALL e%RaiseError(modName//"::"//myName//" - "// & + & '[INTERNAL ERROR] :: The two mesh does not overlap each other.') + RETURN +END IF + +box = box1.INTERSECTION.box2 + +CALL domain1%GetNptrsInBox(nptrs=nptrs1, box=box, isStrict=.FALSE.) +nsd = domain1%GetNSD() +tnodes1 = SIZE(nptrs1) + +DO ii = 1, tnodes1 + node1 = nptrs1(ii) + CALL domain1%GetNodeCoord(globalNode=node1, nodeCoord=x1, & + islocal=.TRUE.) + + CALL domain2%GetNearestNode(qv=x1, x=x2, globalNode=node2) + + isok = ALL(x1.APPROXEQ.x2) + jj = domain1%GetGlobalNodeNumber(node1) + + IF (isok) THEN + obj%nodeToNode(jj) = node2 + ELSE + obj%nodeToNode(jj) = 0_I4B + END IF +END DO + +IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif DEBUG_VER +END PROCEDURE obj_InitiateNodeToNodeData1 + +!---------------------------------------------------------------------------- +! GetNodeToNodePointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToNodePointer +ans => obj%NodeToNode +END PROCEDURE obj_GetNodeToNodePointer + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE NodeMethods diff --git a/src/submodules/FEMesh/src/FEMesh_Class@BoundaryDataMethods.F90 b/src/submodules/FEMesh/src/FEMesh_Class@BoundaryDataMethods.F90 index 3f191d1fa..63fd4025d 100644 --- a/src/submodules/FEMesh/src/FEMesh_Class@BoundaryDataMethods.F90 +++ b/src/submodules/FEMesh/src/FEMesh_Class@BoundaryDataMethods.F90 @@ -15,96 +15,5 @@ ! along with this program. If not, see ! -SUBMODULE(FEMesh_Class) BoundaryDataMethods -! USE BaseMethod -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! InitiateBoundaryData -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_InitiateBoundaryData -! Define internal variables -CHARACTER(*), PARAMETER :: myName = "obj_InitiateBoundaryData()" -! INTEGER(I4B) :: iel, tFace, ii, jj, kk -! INTEGER(I4B), ALLOCATABLE :: global_nptrs(:), ElemToElem(:, :) -! -! ! check -! IF (obj%elemType .EQ. 0 .OR. obj%elemType .EQ. Point1) RETURN -! -! ! check -! IF (.NOT. ASSOCIATED(obj%refelem)) THEN -! CALL e%raiseError(modName//"::"//myName//" - "// & -! & "Unable to identify the Reference element of the mesh, & -! & may be it is not set") -! END IF -! -! ! check -! IF (obj%isBoundaryDataInitiated) THEN -! CALL e%raiseWarning(modName//"::"//myName//" - "// & -! & "Boundary data information is already initiated. If you want to & -! & Reinitiate it then deallocate nodeData, first!") -! RETURN -! END IF -! -! IF (.NOT. obj%isElementToElementsInitiated) & -! & CALL obj%InitiateElementToElements() -! -! obj%isBoundaryDataInitiated = .TRUE. -! -! IF (.NOT. ALLOCATED(obj%FacetElements)) & -! & obj%FacetElements = FacetElements(obj%refelem) -! -! tFace = SIZE(obj%FacetElements) -! -! ! Case of single element in the mesh -! IF (obj%tElements .EQ. 1) THEN -! obj%elementData(1)%elementType = BOUNDARY_ELEMENT -! tFace = SIZE(obj%FacetElements) -! obj%elementData(1)%boundaryData = [(ii, ii=1, tFace)] -! ELSE -! -! ! Now we will include those elements in boundary elements -! ! which contains the boundary nodes -! DO ii = 1, obj%tElements -! iel = obj%getGlobalElemNumber(ii) -! global_nptrs = obj%getConnectivity(iel) -! DO jj = 1, SIZE(global_nptrs) -! IF (obj%isBoundaryNode(global_nptrs(jj))) & -! & obj%elementData(ii)%elementType = BOUNDARY_ELEMENT -! END DO -! END DO -! -! DO ii = 1, obj%tElements -! IF (obj%elementData(ii)%elementType .NE. BOUNDARY_ELEMENT) CYCLE -! iel = obj%getGlobalElemNumber(ii) -! ElemToElem = obj%getElementToElements(globalElement=iel, & -! & onlyElements=.FALSE.) -! ! Because iel is a boundary element, not all its faces will -! ! have neighbours. Below, we calculate how many faces -! ! of iel does not have neighbors. These faces are -! ! called boundary faces. -! jj = tFace - SIZE(ElemToElem, 1) -! CALL Reallocate(obj%elementData(ii)%boundaryData, jj) -! global_nptrs = obj%getConnectivity(iel) -! jj = 0 -! DO kk = 1, tFace -! IF (ANY(kk .EQ. ElemToElem(:, 2))) CYCLE -! jj = jj + 1 -! obj%elementData(ii)%boundaryData(jj) = kk -! END DO -! END DO -! END IF -! IF (ALLOCATED(global_nptrs)) DEALLOCATE (global_nptrs) -! IF (ALLOCATED(ElemToElem)) DEALLOCATE (ElemToElem) - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') -END PROCEDURE obj_InitiateBoundaryData - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -END SUBMODULE BoundaryDataMethods +! SUBMODULE(FEMesh_Class) BoundaryDataMethods +! END SUBMODULE BoundaryDataMethods diff --git a/src/submodules/FEMesh/src/FEMesh_Class@FacetDataMethods.F90 b/src/submodules/FEMesh/src/FEMesh_Class@FacetDataMethods.F90 index ee233838e..5f6150f75 100644 --- a/src/submodules/FEMesh/src/FEMesh_Class@FacetDataMethods.F90 +++ b/src/submodules/FEMesh/src/FEMesh_Class@FacetDataMethods.F90 @@ -15,133 +15,5 @@ ! along with this program. If not, see ! -SUBMODULE(FEMesh_Class) FacetDataMethods -! USE BaseMethod -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! InitiateFacetElements -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_InitiateFacetElements -CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetElements()" -! INTEGER(I4B) :: iel, ii, jj, iintface, idomainFace, kk, telements, & -! & tIntFace, tDomainFace -! INTEGER(I4B), ALLOCATABLE :: e2e(:, :), indx(:), cellNptrs(:) -! LOGICAL(LGT) :: problem, isok - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif DEBUG_VER - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -! -! problem = obj%elemType .EQ. 0 .OR. obj%elemType .EQ. Point1 -! IF (problem) RETURN -! -! problem = obj%isFacetDataInitiated -! IF (problem) THEN -! CALL e%raiseInformation(modName//"::"//myName//" - "// & -! & "[INTERNAL ERROR] :: InternalFacetData and boundary "// & -! & "facet data is already initiated. "// & -! & "If you want to Reinitiate it then deallocate nodeData, first!") -! RETURN -! END IF -! -! problem = .NOT. obj%isElementToElementsInitiated -! IF (problem) CALL obj%InitiateElementToElements() -! -! problem = .NOT. obj%IsBoundaryDataInitiated -! IF (problem) CALL obj%InitiateBoundaryData() -! -! tDomainFace = 0 -! tIntFace = 0 -! obj%isFacetDataInitiated = .TRUE. -! -! telements = obj%GetTotalElements() -! DO iel = 1, telements -! -! jj = obj%GetGlobalElemNumber(iel) -! -! isok = obj%IsBoundaryElement(globalElement=jj) -! IF (isok) THEN -! indx = obj%GetBoundaryElementData(globalElement=jj) -! tDomainFace = tDomainFace + SIZE(indx) -! END IF -! -! e2e = obj%GetElementToElements(globalElement=jj, onlyElements=.TRUE.) -! -! DO ii = 1, SIZE(e2e, 1) -! IF (jj .LE. e2e(ii, 1)) THEN -! tIntFace = tIntFace + 1 -! END IF -! END DO -! END DO -! -! ! internalFacetData -! IF (ALLOCATED(obj%internalFacetData)) DEALLOCATE (obj%internalFacetData) -! ALLOCATE (obj%internalFacetData(tIntFace)) -! -! ! boundaryFacetData -! IF (ALLOCATED(obj%boundaryFacetData)) DEALLOCATE (obj%boundaryFacetData) -! ALLOCATE (obj%boundaryFacetData(tDomainFace)) -! -! ! facetElementType -! telements = obj%GetTotalElements() -! CALL Reallocate(obj%facetElementType, SIZE(obj%facetElements), telements) -! -! iintface = 0; idomainFace = 0 -! -! DO iel = 1, telements -! jj = obj%GetGlobalElemNumber(iel) -! cellNptrs = obj%GetConnectivity(globalElement=jj) -! e2e = obj%GetElementToElements(globalElement=jj, onlyElements=.FALSE.) -! -! ! boundaryFacetData -! IF (obj%IsBoundaryElement(globalElement=jj)) THEN -! indx = obj%GetBoundaryElementData(globalElement=jj) -! DO ii = 1, SIZE(indx) -! kk = indx(ii) -! idomainFace = idomainFace + 1 -! obj%boundaryFacetData(idomainFace)%masterCellNumber = jj -! obj%boundaryFacetData(idomainFace)%masterLocalFacetID = kk -! obj%boundaryFacetData(idomainFace)%elementType = & -! & DOMAIN_BOUNDARY_ELEMENT -! obj%facetElementType(kk, iel) = DOMAIN_BOUNDARY_ELEMENT -! END DO -! END IF -! -! ! internalFacetData -! DO ii = 1, SIZE(e2e, 1) -! kk = e2e(ii, 2) -! obj%facetElementType(kk, iel) = INTERNAL_ELEMENT -! IF (jj .LE. e2e(ii, 1)) THEN -! iintface = iintface + 1 -! obj%internalFacetData(iintface)%masterCellNumber = jj -! obj%internalFacetData(iintface)%slaveCellNumber = e2e(ii, 1) -! obj%internalFacetData(iintface)%masterlocalFacetID = e2e(ii, 2) -! obj%internalFacetData(iintface)%slavelocalFacetID = e2e(ii, 3) -! END IF -! END DO -! END DO -! -! IF (ALLOCATED(e2e)) DEALLOCATE (e2e) -! IF (ALLOCATED(indx)) DEALLOCATE (indx) -! IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif DEBUG_VER - -END PROCEDURE obj_InitiateFacetElements - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -END SUBMODULE FacetDataMethods +! SUBMODULE(FEMesh_Class) FacetDataMethods +! END SUBMODULE FacetDataMethods diff --git a/src/submodules/FEMesh/src/FEMesh_Class@SetMethods.F90 b/src/submodules/FEMesh/src/FEMesh_Class@SetMethods.F90 index 9d0f132d1..c8f363de5 100644 --- a/src/submodules/FEMesh/src/FEMesh_Class@SetMethods.F90 +++ b/src/submodules/FEMesh/src/FEMesh_Class@SetMethods.F90 @@ -14,296 +14,5 @@ ! You should have received a copy of the GNU General Public License ! along with this program. If not, see -SUBMODULE(FEMesh_Class) SetMethods -! USE BaseMethod -! USE MeshUtility -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! SetSparsity -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetSparsity1 -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" -LOGICAL(LGT) :: problem - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -problem = .NOT. obj%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: FEMesh_::obj is not initiated.") - RETURN -END IF - -! if the mesh is empty then return -problem = obj%GetTotalElements() .EQ. 0_I4B -IF (problem) THEN - CALL e%RaiseWarning(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: Empty mesh found, returning') - RETURN -END IF - -! check -problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF - -! Call from MeshUtility -! CALL SetSparsity1(obj=obj, mat=mat, localNodeNumber=localNodeNumber, & -! & lbound=lbound, ubound=ubound) - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif - -END PROCEDURE obj_SetSparsity1 - -!---------------------------------------------------------------------------- -! SetSparsity -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetSparsity2 -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" -LOGICAL(LGT) :: problem - -! check -problem = .NOT. obj%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") - RETURN -END IF - -! check -problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF - -! Call from MeshUtility -! CALL SetSparsity2(obj=obj, mat=mat) - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -END PROCEDURE obj_SetSparsity2 - -!---------------------------------------------------------------------------- -! SetSparsity -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetSparsity3 -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity3()" -LOGICAL(LGT) :: problem - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -! check -problem = .NOT. obj%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") - RETURN -END IF - -! check -problem = .NOT. colMesh%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: colMesh data is not initiated, first initiate") - RETURN -END IF - -! check -problem = SIZE(nodeToNode) .NE. obj%maxNptrs -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: SIZE( nodeToNode ) .NE. obj%maxNptrs") - RETURN -END IF - -! check -problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF - -! Call from MeshUtility -! SELECT TYPE (colMesh) -! CLASS IS (Mesh_) -! CALL SetSparsity3(obj=obj, colMesh=colMesh, nodeToNode=nodeToNode, & -! & mat=mat, ivar=ivar, jvar=jvar) -! CLASS DEFAULT -! CALL e%RaiseError(modName//'::'//myName//' - '// & -! & '[INTERNAL ERROR] :: No case found for the type of colMesh') -! END SELECT - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif - -END PROCEDURE obj_SetSparsity3 - -!---------------------------------------------------------------------------- -! SetSparsity -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetSparsity4 -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity4()" -LOGICAL(LGT) :: problem - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -problem = .NOT. obj%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") - RETURN -END IF - -problem = .NOT. colMesh%isInitiated -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: colMesh data is not initiated, first initiate") - RETURN -END IF - -problem = SIZE(nodeToNode) .LT. obj%maxNptrs -IF (problem) THEN - CALL e%RaiseError(modName//"::"//myName//" - "// & - & "[INTERNAL ERROR] :: SIZE( nodeToNode ) .LT. obj%maxNptrs "// & - & "[easifemClasses ISSUE#63]") - RETURN -END IF - -problem = .NOT. obj%isNodeToNodesInitiated -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') - RETURN -END IF - -! Call from MeshUtility -! SELECT TYPE (colMesh) -! CLASS IS (Mesh_) -! CALL SetSparsity4(obj=obj, colMesh=colMesh, nodeToNode=nodeToNode, & -! & mat=mat, rowGlobalToLocalNodeNum=rowGlobalToLocalNodeNum, & -! & colGlobalToLocalNodeNum=colGlobalToLocalNodeNum, & -! & rowLBOUND=rowLBOUND, rowUBOUND=rowUBOUND, & -! & colLBOUND=colLBOUND, colUBOUND=colUBOUND, & -! & ivar=ivar, jvar=jvar) -! CLASS DEFAULT -! CALL e%RaiseError(modName//'::'//myName//' - '// & -! & '[INTERNAL ERROR] :: No case found for given type of colMesh') -! END SELECT - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif - -END PROCEDURE obj_SetSparsity4 - -!---------------------------------------------------------------------------- -! setQuality -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetQuality -CHARACTER(*), PARAMETER :: myName = "obj_SetQuality()" -! INTEGER(I4B) :: a, b, c, tsize, telements, iel, ii, nsd -! INTEGER(I4B), ALLOCATABLE :: indx(:), nptrs(:) -! REAL(DFP), ALLOCATABLE :: xij(:, :) -! -! a = SIZE(measures) -! b = SIZE(max_measures) -! c = SIZE(min_measures) -! -! IF (a .NE. b & -! & .OR. a .NE. c) THEN -! CALL e%RaiseError(modName//'::'//myName//' - '// & -! & 'size of measures, max_measures, min_measures are not same.') -! END IF -! -! tsize = a -! telements = obj%telements -! -! IF (ALLOCATED(obj%quality)) THEN -! tsize = SIZE(obj%quality, 1) -! IF (tsize .NE. a) THEN -! CALL e%RaiseError(modName//'::'//myName//' - '// & -! & 'Mesh_::obj%quality is allocated row size is not same as '// & -! & CHAR_LF//" the size of measures") -! END IF -! ELSE -! CALL Reallocate(obj%quality, tsize, telements) -! END IF -! -! a = .NNE.obj%refelem -! -! CALL Reallocate(indx, a, nptrs, a) -! -! nsd = obj%getNSD() -! CALL Reallocate(xij, nsd, a) -! -! b = 0 -! -! DO iel = obj%minElemNum, obj%maxElemNum -! IF (.NOT. obj%isElementPresent(iel)) CYCLE -! b = b + 1 -! nptrs = obj%getConnectivity(globalElement=iel) -! indx = local_nptrs(nptrs) -! xij = nodeCoord(1:nsd, indx) -! -! DO ii = 1, tsize -! obj%quality(ii, b) = ElementQuality(refelem=obj%refelem, & -! & xij=xij, measure=measures(ii)) -! END DO -! -! END DO -! -! max_measures = MAXVAL(obj%quality, dim=2) -! min_measures = MINVAL(obj%quality, dim=2) -! -! IF (ALLOCATED(indx)) DEALLOCATE (indx) -! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) -! IF (ALLOCATED(xij)) DEALLOCATE (xij) - -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -END PROCEDURE obj_SetQuality - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -END SUBMODULE SetMethods +! SUBMODULE(FEMesh_Class) SetMethods +! END SUBMODULE SetMethods diff --git a/src/submodules/Mesh/src/Mesh_Class@ConstructorMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@ConstructorMethods.F90 index 7efa0e466..faf0ea5c8 100644 --- a/src/submodules/Mesh/src/Mesh_Class@ConstructorMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@ConstructorMethods.F90 @@ -54,6 +54,8 @@ DEALLOCATE (obj%facetElements) END IF +IF (ALLOCATED(obj%material)) DEALLOCATE (obj%material) + obj%refelem => NULL() END PROCEDURE obj_Deallocate diff --git a/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 index 109611e0a..c7c25a784 100644 --- a/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 @@ -39,7 +39,7 @@ ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity1 +MODULE PROCEDURE MeshGetFacetConnectivity INTEGER(I4B), ALLOCATABLE :: cellNptrs(:) INTEGER(I4B) :: localFaceID, cellNum @@ -66,20 +66,20 @@ END IF IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) -END PROCEDURE obj_GetFacetConnectivity1 +END PROCEDURE MeshGetFacetConnectivity !---------------------------------------------------------------------------- ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity2 +MODULE PROCEDURE obj_GetFacetConnectivity INTEGER(I4B), ALLOCATABLE :: nptrs(:), indx(:) nptrs = obj%GetConnectivity(globalElement=globalElement) indx = GetConnectivity(obj%facetElements(iface)) ans = nptrs(indx) IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) IF (ALLOCATED(indx)) DEALLOCATE (indx) -END PROCEDURE obj_GetFacetConnectivity2 +END PROCEDURE obj_GetFacetConnectivity !---------------------------------------------------------------------------- ! @@ -106,6 +106,36 @@ IF (PRESENT(elemType)) elemType = obj%elemType END PROCEDURE obj_GetParam +!---------------------------------------------------------------------------- +! GetMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetMaterial2 +#ifdef DEBUG_VER +LOGICAL(LGT) :: isok +ans = 0 + +isok = ALLOCATED(obj%material) +IF (.NOT. isok) RETURN + +isok = medium .LE. SIZE(obj%material) +IF (.NOT. isok) RETURN +#endif + +ans = obj%material(medium) +END PROCEDURE obj_GetMaterial2 + +!---------------------------------------------------------------------------- +! GetTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetTotalMaterial2 +ans = 0 +IF (ALLOCATED(obj%material)) THEN + ans = SIZE(obj%material) +END IF +END PROCEDURE obj_GetTotalMaterial2 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 index 20df86362..157c4a652 100644 --- a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 @@ -44,6 +44,12 @@ CALL Display(abool, "refElem ASSOCIATED: ", unitno=unitno) abool = ALLOCATED(obj%facetElements) CALL Display(abool, "facetElements ALLOCATED: ", unitno=unitno) + +abool = ALLOCATED(obj%material) +CALL Display(abool, "materialALLOCATED: ", unitno=unitno) +IF (abool) THEN + CALL Display(obj%material, "material: ", unitno=unitno) +END IF END PROCEDURE obj_Display !---------------------------------------------------------------------------- @@ -73,6 +79,11 @@ isok = obj%xidim .GT. 0 IF (isok) THEN temp4 = TotalEntities(obj%elemType) + !! INFO: + !! In case of line, the number of facet elements are end points + !! not the total number of nodes + !! temp4(1) will denote total number of nodes + IF (obj%xidim .EQ. 1_I4B) temp4(1) = 2 ALLOCATE (obj%facetElements(temp4(obj%xidim))) CALL GetFacetElements(refelem=obj%refelem, ans=obj%facetElements) END IF diff --git a/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 index 739c7ec9e..8583923ef 100644 --- a/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 @@ -177,17 +177,6 @@ END PROCEDURE obj_setSparsity4 -!---------------------------------------------------------------------------- -! setFacetElementType -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_setFacetElementType -INTEGER(I4B) :: localElem -localElem = obj%getLocalElemNumber(globalElement=globalElement) -obj%facetElementType(iface, localElem) = facetElementType -obj%elementData(localElem)%elementType = facetElementType -END PROCEDURE obj_setFacetElementType - !---------------------------------------------------------------------------- ! setQuality !---------------------------------------------------------------------------- @@ -254,6 +243,33 @@ END PROCEDURE obj_setQuality +!---------------------------------------------------------------------------- +! SetTotalMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetTotalMaterial2 +INTEGER(I4B), ALLOCATABLE :: temp_material(:) +INTEGER(I4B) :: n0 + +IF (ALLOCATED(obj%material)) THEN + n0 = SIZE(obj%material) + CALL Reallocate(temp_material, n0 + n) + temp_material(1:n0) = obj%material(1:n0) + CALL MOVE_ALLOC(from=temp_material, to=obj%material) + RETURN +END IF + +CALL Reallocate(obj%material, n) +END PROCEDURE obj_SetTotalMaterial2 + +!---------------------------------------------------------------------------- +! setMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMaterial2 +obj%material(medium) = material +END PROCEDURE obj_SetMaterial2 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/MeshFacetData/CMakeLists.txt b/src/submodules/MeshFacetData/CMakeLists.txt new file mode 100644 index 000000000..9bb66d915 --- /dev/null +++ b/src/submodules/MeshFacetData/CMakeLists.txt @@ -0,0 +1,20 @@ +# This program is a part of EASIFEM library Copyright (C) 2020-2021 Vikas +# Sharma, Ph.D +# +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see +# + +set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") +target_sources(${PROJECT_NAME} + PRIVATE ${src_path}/MeshFacetData_Class@Methods.F90) diff --git a/src/submodules/MeshFacetData/src/MeshFacetData_Class@Methods.F90 b/src/submodules/MeshFacetData/src/MeshFacetData_Class@Methods.F90 new file mode 100644 index 000000000..4bacd8485 --- /dev/null +++ b/src/submodules/MeshFacetData/src/MeshFacetData_Class@Methods.F90 @@ -0,0 +1,105 @@ +! This program is a part of EASIFEM library +! Copyright (C) (Since 2000) Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! +SUBMODULE(MeshFacetData_Class) Methods +USE ReallocateUtility +USE Display_Method +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MeshFacetData_Initiate +CALL Reallocate(obj%masterCellNumber, n) +CALL Reallocate(obj%slaveCellNumber, n) +CALL Reallocate(obj%masterLocalFacetID, n) +CALL Reallocate(obj%slaveLocalFacetID, n) +END PROCEDURE MeshFacetData_Initiate + +!---------------------------------------------------------------------------- +! isInitiated +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MeshFacetData_isInitiated +IF (ALLOCATED(obj%masterCellNumber)) THEN + ans = .TRUE. +ELSE + ans = .FALSE. +END IF +END PROCEDURE MeshFacetData_isInitiated + +!---------------------------------------------------------------------------- +! Size +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MeshFacetData_Size +IF (ALLOCATED(obj%masterCellNumber)) THEN + ans = SIZE(obj%masterCellNumber) +ELSE + ans = 0 +END IF +END PROCEDURE MeshFacetData_Size + +!---------------------------------------------------------------------------- +! Display +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MeshFacetData_Display +LOGICAL(LGT) :: abool + +CALL Display(msg, unitno=unitno) + +CALL Display("elementType: BOUNDARY_ELEMENT", unitno=unitno) + +CALL Display(obj%masterMesh, "masterMesh: ", unitno=unitno) + +CALL Display(obj%slaveMesh, "slaveMesh: ", unitno=unitno) + +abool = ALLOCATED(obj%masterCellNumber) +CALL Display(abool, "masterCellNumber Allocated: ", unitNo=unitNo) + +IF (abool) THEN + CALL Display(obj%masterCellNumber, msg="masterCellNumber: ", & + & unitno=unitno) +END IF + +abool = ALLOCATED(obj%masterlocalFacetID) +CALL Display(abool, "masterlocalFacetID Allocated: ", unitNo=unitNo) + +IF (abool) THEN + CALL Display(obj%masterlocalFacetID, msg="masterlocalFacetID: ", & + & unitno=unitno) +END IF + +abool = ALLOCATED(obj%slaveCellNumber) +CALL Display(abool, "slaveCellNumber Allocated: ", unitNo=unitNo) + +IF (abool) THEN + CALL Display(obj%slaveCellNumber, msg="slaveCellNumber: ", & + & unitno=unitno) +END IF + +abool = ALLOCATED(obj%slavelocalFacetID) +IF (abool) THEN + CALL Display(obj%slavelocalFacetID, msg="slavelocalFacetID: ", & + & unitno=unitno) +END IF + +END PROCEDURE MeshFacetData_Display + +END SUBMODULE Methods diff --git a/src/submodules/PLPlot/src/PLPlot_Class@LinePlotMethods.F90 b/src/submodules/PLPlot/src/PLPlot_Class@LinePlotMethods.F90 index 6a8163ef1..1c7a917fc 100644 --- a/src/submodules/PLPlot/src/PLPlot_Class@LinePlotMethods.F90 +++ b/src/submodules/PLPlot/src/PLPlot_Class@LinePlotMethods.F90 @@ -27,66 +27,66 @@ MODULE PROCEDURE line_plot_x1y1 #ifdef USE_PLPLOT - REAL( DFP ) :: xmin0, xmax0, ymin0, ymax0, lineWidth0 - TYPE( String ) :: device, xlabel0, ylabel0, title0, pointType0 +REAL(DFP) :: xmin0, xmax0, ymin0, ymax0, lineWidth0 +TYPE(String) :: device, xlabel0, ylabel0, title0, pointType0 !! - device = GetDeviceName( filename ) +device = GetDeviceName(filename) !! - CALL obj%Set( & - & device=device%chars(), & - & filename=filename, & - & fontScaling=fontScaling, & - & isWhiteOnBlack=isWhiteOnBlack, & - & isTransparent=isTransparent, & - & colormap=colormap, & - & figSize=figSize, & - & isFileFamily=.FALSE. ) +CALL obj%Set( & + & device=device%chars(), & + & filename=filename, & + & fontScaling=fontScaling, & + & isWhiteOnBlack=isWhiteOnBlack, & + & isTransparent=isTransparent, & + & colormap=colormap, & + & figSize=figSize, & + & isFileFamily=.FALSE.) !! - ! CALL obj%Figure() - CALL obj%Subplot(ncol=1_I4B, nrow=1_I4B, i=1_I4B ) +! CALL obj%Figure() +CALL obj%Subplot(ncol=1_I4B, nrow=1_I4B, i=1_I4B) !! - xmin0 = MINVAL(x); xmin0=xmin0 - ABS( xmin0 ) * 0.1_DFP - xmin0 = INPUT( option=xmin, default=xmin0 ) - xmax0 = MAXVAL(x); xmax0=xmax0 + ABS( xmax0 ) * 0.1_DFP - xmax0 = INPUT( option=xmax, default=xmax0 ) +xmin0 = MINVAL(x); xmin0 = xmin0 - ABS(xmin0) * 0.1_DFP +xmin0 = INPUT(option=xmin, default=xmin0) +xmax0 = MAXVAL(x); xmax0 = xmax0 + ABS(xmax0) * 0.1_DFP +xmax0 = INPUT(option=xmax, default=xmax0) !! - ymin0 = MINVAL(y); ymin0=ymin0 - ABS( ymin0 ) * 0.1_DFP - ymin0 = INPUT( option=ymin, default=ymin0 ) - ymax0 = MAXVAL(y); ymax0=ymax0 + ABS( ymax0 ) * 0.1_DFP - ymax0 = INPUT( option=ymax, default=ymax0 ) +ymin0 = MINVAL(y); ymin0 = ymin0 - ABS(ymin0) * 0.1_DFP +ymin0 = INPUT(option=ymin, default=ymin0) +ymax0 = MAXVAL(y); ymax0 = ymax0 + ABS(ymax0) * 0.1_DFP +ymax0 = INPUT(option=ymax, default=ymax0) !! - CALL obj%SetXYlim(x=[xmin0, xmax0], y=[ymin0, ymax0]) +CALL obj%SetXYlim(x=[xmin0, xmax0], y=[ymin0, ymax0]) !! - CALL obj%Plot2D( & - & x=x, & - & y=y, & - & lineColor=lineColor, & - & lineType=lineType, & - & lineWidth=lineWidth, & - & pointColor=pointColor, & - & pointType=pointType, & - & pointSize=pointSize ) +CALL obj%Plot2D( & + & x=x, & + & y=y, & + & lineColor=lineColor, & + & lineType=lineType, & + & lineWidth=lineWidth, & + & pointColor=pointColor, & + & pointType=pointType, & + & pointSize=pointSize) !! - CALL obj%SetTicks( & - & dx=dx, & - & dy=dy, & - & isLogX=isLogX, & - & isLogY=isLogY, & - & color=tickColor, & - & lineWidth=tickWidth ) +CALL obj%SetTicks( & + & dx=dx, & + & dy=dy, & + & isLogX=isLogX, & + & isLogY=isLogY, & + & color=tickColor, & + & lineWidth=tickWidth) !! - xlabel0 = INPUT( option=xlabel, default="" ) - ylabel0 = INPUT( option=ylabel, default="" ) - title0 = INPUT( option=title, default="" ) +xlabel0 = INPUT(option=xlabel, default="") +ylabel0 = INPUT(option=ylabel, default="") +title0 = INPUT(option=title, default="") !! - CALL obj%SetLabels( & - & xlabel=xlabel0%chars(), & - & ylabel=ylabel0%chars(), & - & title=title0%chars(), & - & color=labelColor) +CALL obj%SetLabels( & + & xlabel=xlabel0%chars(), & + & ylabel=ylabel0%chars(), & + & title=title0%chars(), & + & color=labelColor) !! - CALL PLEND - ! CALL obj%Show() +CALL PLEND +! CALL obj%Show() #endif END PROCEDURE line_plot_x1y1 @@ -96,145 +96,145 @@ MODULE PROCEDURE line_plot_x1y2 #ifdef USE_PLPLOT - REAL( DFP ) :: xmin0, xmax0, ymin0, ymax0, lineWidth0 - REAL( DFP ) :: legend_width, legend_height - TYPE( String ) :: extn, driver, xlabel0, ylabel0, title0, pointType0 - INTEGER( I4B ) :: ii - INTEGER( I4B ), DIMENSION(SIZE( y, 2 )) :: opt_array, text_colors, & - & box_colors, box_patterns, line_colors, & - & line_styles, symbol_colors, symbol_numbers - REAL( DFP ), DIMENSION( SIZE(y,2)) :: symbol_scales, line_widths, & - & box_line_widths, box_scales - CHARACTER( LEN = 20 ), DIMENSION( SIZE(y,2)) :: symbols - CHARACTER( LEN = 80 ), DIMENSION( SIZE(y,2)) :: legend_text +REAL(DFP) :: xmin0, xmax0, ymin0, ymax0, lineWidth0 +REAL(DFP) :: legend_width, legend_height +TYPE(String) :: extn, driver, xlabel0, ylabel0, title0, pointType0 +INTEGER(I4B) :: ii +INTEGER(I4B), DIMENSION(SIZE(y, 2)) :: opt_array, text_colors, & +& box_colors, box_patterns, line_colors, & +& line_styles, symbol_colors, symbol_numbers +REAL(DFP), DIMENSION(SIZE(y, 2)) :: symbol_scales, line_widths, & + & box_line_widths, box_scales +CHARACTER(LEN=20), DIMENSION(SIZE(y, 2)) :: symbols +CHARACTER(LEN=80), DIMENSION(SIZE(y, 2)) :: legend_text !! - xlabel0 = INPUT( option=xlabel, default="X-Axis" ) - ylabel0 = INPUT( option=ylabel, default="Y-Axis" ) - title0 = INPUT( option=title, default="Title" ) - lineWidth0 = INPUT( option=lineWidth, default=2.0_DFP ) - pointType0 = INPUT( option=pointType, default="#(135)" ) +xlabel0 = INPUT(option=xlabel, default="X-Axis") +ylabel0 = INPUT(option=ylabel, default="Y-Axis") +title0 = INPUT(option=title, default="Title") +lineWidth0 = INPUT(option=lineWidth, default=2.0_DFP) +pointType0 = INPUT(option=pointType, default="#(135)") !! - IF( PRESENT( xmin ) ) THEN - xmin0 = xmin - ELSE - xmin0 = MINVAL( x ) - xmin0 = xmin0 - ABS( xmin0 ) * 0.1 - END IF +IF (PRESENT(xmin)) THEN + xmin0 = xmin +ELSE + xmin0 = MINVAL(x) + xmin0 = xmin0 - ABS(xmin0) * 0.1 +END IF !! - IF( PRESENT( xmax ) ) THEN - xmax0 = xmax - ELSE - xmax0 = MAXVAL( x ) - xmax0 = xmax0 + ABS( xmax0 ) * 0.1 - END IF +IF (PRESENT(xmax)) THEN + xmax0 = xmax +ELSE + xmax0 = MAXVAL(x) + xmax0 = xmax0 + ABS(xmax0) * 0.1 +END IF !! - IF( PRESENT( ymin ) ) THEN - ymin0 = ymin - ELSE - ymin0 = MINVAL( y ) - ymin0 = ymin0 - ABS( ymin0 ) * 0.1 - END IF +IF (PRESENT(ymin)) THEN + ymin0 = ymin +ELSE + ymin0 = MINVAL(y) + ymin0 = ymin0 - ABS(ymin0) * 0.1 +END IF !! - IF( PRESENT( ymax ) ) THEN - ymax0 = ymax - ELSE - ymax0 = MAXVAL( y ) - ymax0 = ymax0 + ABS( ymax0 ) * 0.1 - END IF +IF (PRESENT(ymax)) THEN + ymax0 = ymax +ELSE + ymax0 = MAXVAL(y) + ymax0 = ymax0 + ABS(ymax0) * 0.1 +END IF !! - IF( PRESENT( legendTexts ) ) THEN - DO ii = 1, SIZE( legendTexts ) - legend_text( ii ) = legendTexts( ii )%chars() - END DO - ELSE - DO ii = 1, SIZE( legend_text ) - legend_text( ii ) = "data_"//tostring(ii) - END DO - END IF +IF (PRESENT(legendTexts)) THEN + DO ii = 1, SIZE(legendTexts) + legend_text(ii) = legendTexts(ii)%chars() + END DO +ELSE + DO ii = 1, SIZE(legend_text) + legend_text(ii) = "data_"//tostring(ii) + END DO +END IF !! - extn = getExtension( filename ) +extn = getExtension(filename) !! - SELECT CASE( extn%chars( ) ) - CASE( "pdf" ) - driver = "pdf" - ! driver = "pdfcairo" - CASE( "png" ) - driver = "pngqt" - ! driver = "pngcairo" - CASE( "ps" ) - driver = "ps" - ! driver = "pscairo" - CASE( "eps" ) - driver = "epscairo" - CASE( "svg" ) - driver = "svg" - CASE( "jpeg", "jpg" ) - driver = "jpgqt" - END SELECT +SELECT CASE (extn%chars()) +CASE ("pdf") + driver = "pdf" + ! driver = "pdfcairo" +CASE ("png") + driver = "pngqt" + ! driver = "pngcairo" +CASE ("ps") + driver = "ps" + ! driver = "pscairo" +CASE ("eps") + driver = "epscairo" +CASE ("svg") + driver = "svg" +CASE ("jpeg", "jpg") + driver = "jpgqt" +END SELECT !! - CALL PLSDEV( driver%chars() ) - CALL PLSFNAM( TRIM(filename ) ) - CALL PLSCOLBG(255,255,255) - CALL PLINIT - CALL PLSCOL0(0,0,0,0) - CALL PLCOL0(0) - CALL PLENV( xmin0, xmax0, ymin0, ymax0, 0, 0 ) - CALL PLBOX( 'bcnst', 0.0_DFP, 0, 'bcnstv', 0.0_DFP, 0 ) - CALL PLLAB( xlabel0%chars(), ylabel0%chars(), title0%chars() ) - CALL PLWIDTH( lineWidth0 ) - DO ii = 1, SIZE( y, 2 ) - CALL PLCOL0(ii) - line_colors( ii ) = ii - symbol_colors( ii ) = ii - CALL PLLINE( x, y(:, ii) ) - IF( PRESENT( isPoint ) ) THEN - CALL PLSTRING(x, y(:, ii), pointType0%chars()) - END IF - END DO +CALL PLSDEV(driver%chars()) +CALL PLSFNAM(TRIM(filename)) +CALL PLSCOLBG(255, 255, 255) +CALL PLINIT +CALL PLSCOL0(0, 0, 0, 0) +CALL PLCOL0(0) +CALL PLENV(xmin0, xmax0, ymin0, ymax0, 0, 0) +CALL PLBOX('bcnst', 0.0_DFP, 0, 'bcnstv', 0.0_DFP, 0) +CALL PLLAB(xlabel0%chars(), ylabel0%chars(), title0%chars()) +CALL PLWIDTH(lineWidth0) +DO ii = 1, SIZE(y, 2) + CALL PLCOL0(ii) + line_colors(ii) = ii + symbol_colors(ii) = ii + CALL PLLINE(x, y(:, ii)) + IF (PRESENT(isPoint)) THEN + CALL PLSTRING(x, y(:, ii), pointType0%chars()) + END IF +END DO !! - opt_array = PL_LEGEND_LINE - line_styles = 1 - line_widths = 1 - symbol_scales = 1.0 - symbol_numbers = 1 - text_colors = 0 - DO ii = 1, SIZE(symbols) - symbols(ii)="" - END DO +opt_array = PL_LEGEND_LINE +line_styles = 1 +line_widths = 1 +symbol_scales = 1.0 +symbol_numbers = 1 +text_colors = 0 +DO ii = 1, SIZE(symbols) + symbols(ii) = "" +END DO !! - CALL PLLEGEND( & - & legend_width, & - & legend_height, & - & PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX, & - & 0, & - & 0.0_DFP, & - & 0.0_DFP, & - & 0.10_DFP, & - & 15, & - & 0, & - & 1, & - & 0, & - & 0, & - & opt_array, & - & 1.0_DFP, & - & 1.0_DFP, & - & 2.0_DFP, & - & 1.0_DFP, & - & text_colors, & - & legend_text, & - & box_colors, & - & box_patterns, & - & box_scales, & - & box_line_widths, & - & line_colors, & - & line_styles, & - & line_widths, & - & symbol_colors, & - & symbol_scales, & - & symbol_numbers, & - & symbols ) - CALL PLCOL0(0) - CALL PLEND +CALL PLLEGEND( & + & legend_width, & + & legend_height, & + & PL_LEGEND_BACKGROUND + PL_LEGEND_BOUNDING_BOX, & + & 0, & + & 0.0_DFP, & + & 0.0_DFP, & + & 0.10_DFP, & + & 15, & + & 0, & + & 1, & + & 0, & + & 0, & + & opt_array, & + & 1.0_DFP, & + & 1.0_DFP, & + & 2.0_DFP, & + & 1.0_DFP, & + & text_colors, & + & legend_text, & + & box_colors, & + & box_patterns, & + & box_scales, & + & box_line_widths, & + & line_colors, & + & line_styles, & + & line_widths, & + & symbol_colors, & + & symbol_scales, & + & symbol_numbers, & + & symbols) +CALL PLCOL0(0) +CALL PLEND #endif END PROCEDURE line_plot_x1y2 @@ -243,15 +243,15 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE plot_Plot2D - CALL Plot( & - & x=x, & - & y=y, & - & lineColor=lineColor, & - & lineStyle=lineType, & - & lineWidth=lineWidth, & - & markColor=pointColor, & - & markStyle=pointType, & - & markSize=pointSize ) +CALL Plot( & + & x=x, & + & y=y, & + & lineColor=lineColor, & + & lineStyle=lineType, & + & lineWidth=lineWidth, & + & markColor=pointColor, & + & markStyle=pointType, & + & markSize=pointSize) END PROCEDURE plot_Plot2D !---------------------------------------------------------------------------- @@ -259,14 +259,14 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE plot_Errorbar - CALL errorbar(& - & x=x, & - & y=y, & - & xerr=xerr, & - & yerr=yerr, & - & lineColor=lineColor, & - & lineStyle=lineType, & - & lineWidth=lineWidth ) +CALL errorbar(& + & x=x, & + & y=y, & + & xerr=xerr, & + & yerr=yerr, & + & lineColor=lineColor, & + & lineStyle=lineType, & + & lineWidth=lineWidth) END PROCEDURE plot_Errorbar !---------------------------------------------------------------------------- @@ -274,16 +274,16 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE plot_Plot3D - CALL Plot3( & - & x=x, & - & y=y, & - & z=z, & - & lineColor=lineColor, & - & lineStyle=lineType, & - & lineWidth=lineWidth, & - & markColor=pointColor, & - & markStyle=pointType, & - & markSize=pointSize) +CALL Plot3( & + & x=x, & + & y=y, & + & z=z, & + & lineColor=lineColor, & + & lineStyle=lineType, & + & lineWidth=lineWidth, & + & markColor=pointColor, & + & markStyle=pointType, & + & markSize=pointSize) END PROCEDURE plot_Plot3D -END SUBMODULE LinePlotMethods \ No newline at end of file +END SUBMODULE LinePlotMethods diff --git a/src/submodules/RefElement/src/Topology_Class@Methods.F90 b/src/submodules/RefElement/src/Topology_Class@Methods.F90 index c1e1b1b48..96e2d63fb 100644 --- a/src/submodules/RefElement/src/Topology_Class@Methods.F90 +++ b/src/submodules/RefElement/src/Topology_Class@Methods.F90 @@ -231,6 +231,14 @@ ans(4)%nptrs = nptrs([4, 1, 8]) ans(1:)%xidimension = 1 ans(1:)%name = line3 +CASE (Quadrangle16) + ! ALLOCATE (ans(4)) + ans(1)%nptrs = nptrs([1, 2, 5, 6]) + ans(2)%nptrs = nptrs([2, 3, 7, 8]) + ans(3)%nptrs = nptrs([3, 4, 9, 10]) + ans(4)%nptrs = nptrs([4, 1, 11, 12]) + ans(1:)%xidimension = 1 + ans(1:)%name = line4 CASE (Quadrangle8) ! ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2, 5]) diff --git a/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 b/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 index 425c84ef9..60fe0a434 100644 --- a/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 +++ b/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 @@ -369,8 +369,8 @@ CHARACTER(*), PARAMETER :: myName = "obj_SetByFunction()" LOGICAL(LGT) :: istimes, problem INTEGER(I4B) :: ttime, returnType, nsd, tnodes, ii, globalNode(1) -REAL(DFP), ALLOCATABLE :: xij(:, :) -REAL(DFP) :: args(4), VALUE +REAL(DFP), ALLOCATABLE :: xij(:, :), args(:) +REAL(DFP) :: VALUE INTEGER(I4B), PARAMETER :: needed_returnType = Scalar CLASS(Domain_), POINTER :: dom @@ -382,11 +382,15 @@ istimes = PRESENT(times) problem = .FALSE. -args = 0.0_DFP IF (istimes) THEN + ALLOCATE (args(4)) + args = 0.0_DFP ttime = SIZE(times) args(4) = times(1) problem = ttime .NE. 1_I4B +ELSE + ALLOCATE (args(3)) + args = 0.0_DFP END IF IF (problem) THEN