From 102cf2437262fcc18db87222995dec175149fdd5 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 28 Mar 2024 18:30:30 +0900 Subject: [PATCH 001/119] EASIFEM-132 Minor formatting in exception handler --- .../ExceptionHandler_Class@Constructor.F90 | 4 +- .../src/ExceptionHandler_Class@Enquire.F90 | 130 +++++----- .../ExceptionHandler_Class@raiseMethod.F90 | 234 +++++++++--------- 3 files changed, 184 insertions(+), 184 deletions(-) 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 From 328d3db234bea3c3efd56a614839fb25263d367d Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 28 Mar 2024 18:32:00 +0900 Subject: [PATCH 002/119] EASIFEM-130 Updating mesh import from dim. --- .../AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 index 9f4cea6d1..00c94b228 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 @@ -197,8 +197,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//' - '// & From d00180587fa5681ff1cf45a40f4f9b4fb05465eb Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 28 Mar 2024 18:46:25 +0900 Subject: [PATCH 003/119] EASIFEM-117 Adding constructor methods --- src/modules/Domain/src/FEDomain_Class.F90 | 1333 +++++++++++++++++++++ 1 file changed, 1333 insertions(+) create mode 100644 src/modules/Domain/src/FEDomain_Class.F90 diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 new file mode 100644 index 000000000..cc213880e --- /dev/null +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -0,0 +1,1333 @@ +! 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 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 + +IMPLICIT NONE +PRIVATE + +PUBLIC :: FEDomain_ +PUBLIC :: FEDomainPointer_ +PUBLIC :: FEDomainDeallocate +PUBLIC :: FEDomain_Pointer +PUBLIC :: FEDomainSetSparsity + +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 :: FEDomain_ + PRIVATE + LOGICAL(LGT), PUBLIC :: 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), PUBLIC :: maxNptrs = 0 + !! Largest node number in the domain + INTEGER(I4B), PUBLIC :: 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), PUBLIC :: maxElemNum = 0 + !! Largest element number in the domain + INTEGER(I4B), PUBLIC :: 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, PUBLIC :: 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 + + 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 + !! TODO Rename Deallocate to Deallocate + FINAL :: obj_Final + !! Finalizer for domain + + ! 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 + PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => obj_IsElementPresent + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => obj_GetConnectivity + PROCEDURE, PASS(obj) :: obj_GetNodeToElements1 + PROCEDURE, PASS(obj) :: obj_GetNodeToElements2 + GENERIC, PUBLIC :: GetNodeToElements => & + & obj_GetNodeToElements1, & + & obj_GetNodeToElements2 + 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) :: obj_GetLocalNodeNumber1 + PROCEDURE, PASS(obj) :: obj_GetLocalNodeNumber2 + GENERIC, PUBLIC :: & + & GetLocalNodeNumber => & + & obj_GetLocalNodeNumber1, & + & obj_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, PUBLIC, PASS(obj) :: GetDimEntityNum => obj_GetDimEntityNum + !! Returns a dim entity-num of mesh which contains the element number + 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 + GENERIC, PUBLIC :: GetNodeCoord => GetNodeCoord1, GetNodeCoord2 + !! 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) :: GetNptrs => obj_GetNptrs + !! returns node number + + 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. + + ! SET: + ! @SetMethods + 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) :: 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 FEDomain_ + +!---------------------------------------------------------------------------- +! FEDomainPointer +!---------------------------------------------------------------------------- + +TYPE :: FEDomainPointer_ + CLASS(FEDomain_), POINTER :: ptr => NULL() +END TYPE FEDomainPointer_ + +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: Initiate the instance of [[FEDomain_]] object + +INTERFACE + MODULE SUBROUTINE obj_Initiate(obj, hdf5, group) + CLASS(FEDomain_), INTENT(INOUT) :: obj + !! FEDomainData 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: 18 June 2021 +! summary: Deallocate data stored in FEDomain object + +INTERFACE FEDomainDeallocate + MODULE SUBROUTINE obj_Deallocate(obj) + CLASS(FEDomain_), INTENT(INOUT) :: obj + !! FEDomain object + END SUBROUTINE obj_Deallocate +END INTERFACE FEDomainDeallocate + +!---------------------------------------------------------------------------- +! Final@ConstructorMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! 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: 19 June 2021 +! 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 + +!---------------------------------------------------------------------------- +! Import@IOMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: Construct an instance of domain by importing data from mesh + +INTERFACE + MODULE SUBROUTINE obj_Import(obj, hdf5, group) + CLASS(FEDomain_), INTENT(INOUT) :: obj + TYPE(HDF5File_), INTENT(INOUT) :: hdf5 + CHARACTER(*), INTENT(IN) :: group + END SUBROUTINE obj_Import +END INTERFACE + +!---------------------------------------------------------------------------- +! ImportFromToml@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_ImportFromToml1(obj, table) + CLASS(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + 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) & + & RESULT(ans) + CLASS(FEDomain_), 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) :: ans + END FUNCTION obj_IsElementPresent +END INTERFACE + +!---------------------------------------------------------------------------- +! GetConnectivity@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-12 +! update: 2021-11-12 +! summary: Returns the connectivity vector of a given element number + +INTERFACE + MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim) & + & RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + !! Global 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 + INTEGER(I4B), ALLOCATABLE :: ans(:) + !! vertex connectivity + END FUNCTION obj_GetConnectivity +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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + INTEGER(I4B), ALLOCATABLE :: ans(:) + 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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode(:) + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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 FEDomain +! - 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 FEDomain_GetTotalElements +! +!@endtodo + +INTERFACE + MODULE FUNCTION obj_GetTotalElements(obj, dim) RESULT(ans) + CLASS(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode + !! Global node number in mesh of obj%nsd dimension + 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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode(:) + 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + !! dimension of mesh entity + CLASS(AbstractMesh_), POINTER :: ans + END FUNCTION obj_GetMeshPointer1 +END INTERFACE + +!---------------------------------------------------------------------------- +! getDimEntityNum@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2021-11-12 +! summary: Returns dim and entity number +! +!# Introduction +! deprecated + +INTERFACE + MODULE FUNCTION obj_GetDimEntityNum(obj, globalElement) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalElement + INTEGER(I4B) :: ans(2) + END FUNCTION obj_GetDimEntityNum +END INTERFACE + +!---------------------------------------------------------------------------- +! getNodeCoord@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) + !! make sure nodeCoord is allocated + END SUBROUTINE obj_GetNodeCoord +END INTERFACE + +!---------------------------------------------------------------------------- +! getNodeCoord@getMethod +!---------------------------------------------------------------------------- + +!> 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. +! - If `dim` and `tag` are absent then this routine returns the nodal +! coordinates of the entire domain +! - If `dim` and `tag` are present then the routine selects the mesh and +! returns its nodal coordinates + +INTERFACE + MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode) + CLASS(FEDomain_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) + !! It should be allocated by the user. + !! SIZE(nodeCoord, 1) is equal to nsd + !! Size(nodeCoord, 2) is equal to the size(globalNode) + INTEGER(I4B), INTENT(IN) :: globalNode(:) + END SUBROUTINE obj_GetNodeCoord2 +END INTERFACE + +!---------------------------------------------------------------------------- +! getNodeCoordPointer@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), TARGET, INTENT(IN) :: obj + REAL(DFP), POINTER :: ans(:, :) + END FUNCTION obj_GetNodeCoordPointer +END INTERFACE + +!---------------------------------------------------------------------------- +! getNptrs@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), 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@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), 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@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), 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) RESULT(ans) + CLASS(FEDomain_), INTENT(IN) :: obj + 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION obj_GetUniqueElemType +END INTERFACE + +!---------------------------------------------------------------------------- +! SetSparsity@setMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 12 Oct 2021 +! summary: Set sparsity in [[CSRMatrix_]] from [[FEDomain_]] + +INTERFACE + MODULE SUBROUTINE obj_SetSparsity1(obj, mat) + CLASS(FEDomain_), INTENT(IN) :: 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 [[FEDomain_]] + +INTERFACE FEDomainSetSparsity + MODULE SUBROUTINE obj_SetSparsity2(domains, mat) + CLASS(FEDomainPointer_), INTENT(IN) :: domains(:) + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + END SUBROUTINE obj_SetSparsity2 +END INTERFACE FEDomainSetSparsity + +!---------------------------------------------------------------------------- +! 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), INTENT(IN) :: entityNum + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B), INTENT(IN) :: material + END SUBROUTINE obj_SetMaterial +END INTERFACE + +!---------------------------------------------------------------------------- +! SetNodeCoord@SetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-02-24 +! summary: SetNodeCoord + +INTERFACE + MODULE SUBROUTINE obj_SetNodeCoord1(obj, nodeCoord, scale, & + & addContribution) + CLASS(FEDomain_), 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(FEDomain_), 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 + +!---------------------------------------------------------------------------- +! 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetFacetElementType +END INTERFACE + +!---------------------------------------------------------------------------- +! SetFEDomainFacetElement@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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj + END SUBROUTINE obj_SetMeshFacetElement +END INTERFACE + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END MODULE FEDomain_Class From d487d3f470c0ac8da4f1b9e06f7593c218444efa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 28 Mar 2024 19:38:51 +0900 Subject: [PATCH 004/119] EASIFEM-91 Bug fix in obj_isElementPresent. in ABstractmesh_class.f90 --- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 8cfe346cd..403f1e2b5 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -227,11 +227,15 @@ MODULE PROCEDURE obj_isElementPresent LOGICAL(LGT) :: isok -isok = globalElement .GT. obj%maxElemNum & - & .OR. globalElement .LT. obj%minElemNum & - & .OR. obj%local_elemNumber(globalElement) .EQ. 0 +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 PROCEDURE obj_isElementPresent !---------------------------------------------------------------------------- From 4e2dd25bdf89ff56291ed1b7e7ba10b684487d61 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 09:24:24 +0900 Subject: [PATCH 005/119] EASIFEM-116 Minor formatting in fedomainclass --- src/modules/Domain/src/FEDomain_Class.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index cc213880e..4d4925b6b 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -288,7 +288,7 @@ MODULE FEDomain_Class !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 18 June 2021 +! date: 2024-03-28 ! summary: Initiate the instance of [[FEDomain_]] object INTERFACE @@ -307,7 +307,7 @@ END SUBROUTINE obj_Initiate !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 18 June 2021 +! date: 2024-03-28 ! summary: Deallocate data stored in FEDomain object INTERFACE FEDomainDeallocate @@ -322,7 +322,7 @@ END SUBROUTINE obj_Deallocate !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 18 June 2021 +! date: 2024-03-28 ! summary: Finalizer INTERFACE @@ -336,7 +336,7 @@ END SUBROUTINE obj_Final !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 19 June 2021 +! date: 2024-03-28 ! summary: This function returns pointer to a newly constructed FEDomain obj INTERFACE FEDomain_Pointer @@ -352,7 +352,7 @@ END FUNCTION obj_Constructor_1 !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 18 June 2021 +! date: 2024-03-28 ! summary: Construct an instance of domain by importing data from mesh INTERFACE @@ -368,7 +368,7 @@ END SUBROUTINE obj_Import !---------------------------------------------------------------------------- !> author: Shion Shimizu -! date: 2023-12-20 +! date: 2024-03-28 ! summary: Initiate an instance of domain by importing meshfile name from ! Toml file ! @@ -500,6 +500,7 @@ MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim) & CLASS(FEDomain_), 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 From b2d1c4533b889cd3d629c48bba540c7580fcbb0a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 09:24:51 +0900 Subject: [PATCH 006/119] EASIFEM-117 Adding constructor methods in fedomain class --- .../src/FEDomain_Class@ConstructorMethods.F90 | 116 ++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 src/submodules/Domain/src/FEDomain_Class@ConstructorMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@ConstructorMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@ConstructorMethods.F90 new file mode 100644 index 000000000..cc49df0e9 --- /dev/null +++ b/src/submodules/Domain/src/FEDomain_Class@ConstructorMethods.F90 @@ -0,0 +1,116 @@ +! 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 +USE ReallocateUtility +USE CSRSparsity_Method +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Initiate +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "FEDomain_Initiate()" +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +CALL obj%DEALLOCATE() + +CALL obj%IMPORT(hdf5=hdf5, group=group) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif +END PROCEDURE obj_Initiate + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate +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) + +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) +END PROCEDURE obj_Deallocate + +!---------------------------------------------------------------------------- +! 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 From 7de0a3dfb66a697e98882b82854587d6ce246a44 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 09:57:34 +0900 Subject: [PATCH 007/119] EASIFEM-133 Adding display method in fedomainclass --- .../Domain/src/FEDomain_Class@IOMethods.F90 | 101 ++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 new file mode 100644 index 000000000..1316b08d1 --- /dev/null +++ b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 @@ -0,0 +1,101 @@ +! 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(FEDomain_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, "FEDomain_::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 + +CALL Display(obj%meshMap%isInitiated, "meshMap Initiated: ", unitno=unitno) + +END PROCEDURE obj_Display + +END SUBMODULE IOMethods From 193ec2bcfe81d36df9e269b288cdc384310b9d22 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 09:58:36 +0900 Subject: [PATCH 008/119] EASIFEM-136 Adding DisplayDomainInfo method in fedomain classe --- .../Domain/src/FEDomain_Class@IOMethods.F90 | 69 +++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 index 1316b08d1..68c895fd7 100644 --- a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 @@ -98,4 +98,73 @@ END PROCEDURE obj_Display +!---------------------------------------------------------------------------- +! DisplaDomainInfo +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_DisplayDomainInfo +LOGICAL(LGT) :: abool + +CALL Display(obj%isInitiated, "FEDomain_::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 END SUBMODULE IOMethods From 887cfbf11a756767fac3fb3c53794dd3ebac0c3f Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 09:59:29 +0900 Subject: [PATCH 009/119] EASIFEM-134 Adding import method in fedomain class --- .../Domain/src/FEDomain_Class@IOMethods.F90 | 220 ++++++++++++++++++ 1 file changed, 220 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 index 68c895fd7..e5b2381d3 100644 --- a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 @@ -167,4 +167,224 @@ END SELECT END PROCEDURE obj_DisplayDomainInfo + +!---------------------------------------------------------------------------- +! Import +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Import +CHARACTER(*), PARAMETER :: myName = "FEDomain_Import()" + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Calling FEDomainImportCheckErr()') +#endif + +CALL FEDomainImportCheckErr(obj=obj, hdf5=hdf5, myName=myName) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & 'Calling FEDomainImportMetaData') +#endif + +CALL FEDomainImportMetaData(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 + +!---------------------------------------------------------------------------- +! FEDomainImportCheckErr +!---------------------------------------------------------------------------- + +SUBROUTINE FEDomainImportCheckErr(obj, hdf5, myName) + CLASS(FEDomain_), 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] :: FEDomain_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 FEDomainImportCheckErr + +!---------------------------------------------------------------------------- +! FEDomainImportMetaData +!---------------------------------------------------------------------------- + +SUBROUTINE FEDomainImportMetaData(obj, hdf5, group, myName) + CLASS(FEDomain_), 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 FEDomainImportMetaData END SUBMODULE IOMethods From 9894ab581e5776e1a6c0659327f00c7dfde5fffc Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 10:00:14 +0900 Subject: [PATCH 010/119] EASIFEM-135 Adding import from toml metod in fedomain --- .../Domain/src/FEDomain_Class@IOMethods.F90 | 93 +++++++++++++++++++ 1 file changed, 93 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 index e5b2381d3..54227f3cd 100644 --- a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 @@ -387,4 +387,97 @@ SUBROUTINE FEDomainImportMetaData(obj, hdf5, group, myName) & myName=myName, modName=modName) END SUBROUTINE FEDomainImportMetaData + +!---------------------------------------------------------------------------- +! ImportFromToml +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_ImportFromToml1 +CHARACTER(*), PARAMETER :: myName = "FEDomain_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 = "FEDomain_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), "FEDomain 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 From 322d8bf6f320b20410957101347290792ca093aa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 10:21:50 +0900 Subject: [PATCH 011/119] EASIFEM-137 Removing get dim entity number method from fedomain class --- src/modules/Domain/src/FEDomain_Class.F90 | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index 4d4925b6b..1b8a8eed6 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -189,8 +189,6 @@ MODULE FEDomain_Class PROCEDURE, PUBLIC, PASS(obj) :: GetMeshPointer => obj_GetMeshPointer1 - PROCEDURE, PUBLIC, PASS(obj) :: GetDimEntityNum => obj_GetDimEntityNum - !! Returns a dim entity-num of mesh which contains the element number PROCEDURE, PASS(obj) :: GetNodeCoord1 => obj_GetNodeCoord !! This routine returns the nodal coordinate in rank2 array PROCEDURE, PASS(obj) :: GetNodeCoord2 => obj_GetNodeCoord2 @@ -828,25 +826,6 @@ MODULE FUNCTION obj_GetMeshPointer1(obj, dim) RESULT(Ans) END FUNCTION obj_GetMeshPointer1 END INTERFACE -!---------------------------------------------------------------------------- -! getDimEntityNum@GetMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2021-11-12 -! summary: Returns dim and entity number -! -!# Introduction -! deprecated - -INTERFACE - MODULE FUNCTION obj_GetDimEntityNum(obj, globalElement) RESULT(ans) - CLASS(FEDomain_), INTENT(IN) :: obj - INTEGER(I4B), INTENT(IN) :: globalElement - INTEGER(I4B) :: ans(2) - END FUNCTION obj_GetDimEntityNum -END INTERFACE - !---------------------------------------------------------------------------- ! getNodeCoord@getMethod !---------------------------------------------------------------------------- From 9869c818cdd88650be5e9275f93c1413f187d304 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 11:56:01 +0900 Subject: [PATCH 012/119] EASIFEM-139 Adding GetNptrs_ method to abstractmeshclass --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 20 ++++++++++++++++++- .../src/AbstractMesh_Class@GetMethods.F90 | 11 ++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 9048124ff..fae0d879e 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -295,6 +295,9 @@ 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 @@ -946,6 +949,21 @@ 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) + CLASS(AbstractMesh_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + END SUBROUTINE obj_GetNptrs_ +END INTERFACE + !---------------------------------------------------------------------------- ! GetInternalNptrs@GetMethods !---------------------------------------------------------------------------- @@ -2324,7 +2342,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 403f1e2b5..70658847b 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -115,6 +115,17 @@ END DO END PROCEDURE obj_GetNptrs +!---------------------------------------------------------------------------- +! GetNptrs_ +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrs_ +INTEGER(I4B) :: ii +DO CONCURRENT(ii=1:SIZE(obj%nodeData)) + nptrs(ii) = obj%nodeData(ii)%globalNodeNum +END DO +END PROCEDURE obj_GetNptrs_ + !---------------------------------------------------------------------------- ! GetInternalNptrs !---------------------------------------------------------------------------- From 134e9f5aeb88dbd1cd11c0b854feeb0d948c9580 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 12:32:09 +0900 Subject: [PATCH 013/119] EASIFEM-138 Adding get nptrs which subroutine version in fedomainclass --- src/modules/Domain/src/FEDomain_Class.F90 | 28 ++++++++- .../Domain/src/FEDomain_Class@GetMethods.F90 | 63 +++++++++++++++++++ 2 files changed, 89 insertions(+), 2 deletions(-) create mode 100644 src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index 1b8a8eed6..d093aa628 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -201,7 +201,10 @@ MODULE FEDomain_Class !! This routine returns the pointer to nodal coordinate PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs => obj_GetNptrs - !! returns node number + !! returns node number, this is a function + + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs_ => obj_GetNptrs_ + !! returns node number, this is subroutine PROCEDURE, PUBLIC, PASS(obj) :: GetInternalNptrs => & & obj_GetInternalNptrs @@ -897,7 +900,7 @@ END FUNCTION obj_GetNodeCoordPointer END INTERFACE !---------------------------------------------------------------------------- -! getNptrs@getMethod +! GetNptrs@getMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -917,6 +920,27 @@ MODULE FUNCTION obj_GetNptrs(obj, dim) RESULT(ans) END FUNCTION obj_GetNptrs END INTERFACE +!---------------------------------------------------------------------------- +! GetNptrs@getMethod +!---------------------------------------------------------------------------- + +!> 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(FEDomain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(INOUT) :: nptrs(:) + INTEGER(I4B), INTENT(IN) :: dim + !! dim = [0, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] + END SUBROUTINE obj_GetNptrs_ +END INTERFACE + !---------------------------------------------------------------------------- ! getNptrs@getMethod !---------------------------------------------------------------------------- diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 new file mode 100644 index 000000000..3d2c5d13d --- /dev/null +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -0,0 +1,63 @@ +! 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) GetMethods +USE ReallocateUtility +USE InputUtility +USE BoundingBox_Method +USE F95_BLAS, ONLY: Copy +IMPLICIT NONE +CONTAINS + +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_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE GetMethods From f1037977383b9a23f2c581554c20d0201ee4a5bb Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 12:42:27 +0900 Subject: [PATCH 014/119] EASIFEM-140 Adding subroutien version of get internal nptrs in abstract mesh class --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 19 +++++++++++ .../src/AbstractMesh_Class@GetMethods.F90 | 32 +++++++++++++++++++ 2 files changed, 51 insertions(+) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index fae0d879e..99dc49569 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -301,6 +301,10 @@ MODULE AbstractMesh_Class 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 @@ -979,6 +983,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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 70658847b..c31c7b3ef 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -143,6 +143,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 !---------------------------------------------------------------------------- From b5f99c607753499f40ac671efde4bd34f4c8725c Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 14:18:23 +0900 Subject: [PATCH 015/119] Minor formatting in AbstractMeshUtility --- src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 5602aa74a..efa4e4bb7 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -900,8 +900,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 From 514f0defc802ac50a7f00e7f056a1fe85ab283ed Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 16:16:44 +0900 Subject: [PATCH 016/119] EASIFEM-95 Adding initiate boundarydata methpd to abstractmesh class --- ...AbstractMesh_Class@BoundaryDataMethods.F90 | 22 +++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) 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 !---------------------------------------------------------------------------- From e8b7cfe669cab7f57cb27f6916eb78fc2ee9e5b1 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 16:19:42 +0900 Subject: [PATCH 017/119] EASIFEM-101 Adding boundary element info in element to elements for 2d case. --- .../AbstractMesh/src/AbstractMeshUtility.F90 | 24 +++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index efa4e4bb7..410c0f984 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -181,9 +181,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 +249,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 @@ -276,6 +279,23 @@ SUBROUTINE InitiateElementToElements2D(elementData, tEdgeInMesh, showTime) 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) From 707009c256da4ab10b2788fc53451eafa30c1eb8 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 16:23:31 +0900 Subject: [PATCH 018/119] EASIFEM-102 Updated initite element to element for 3d case. Boundary element information is added. --- .../AbstractMesh/src/AbstractMeshUtility.F90 | 27 ++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 410c0f984..44891797a 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 * REFELEM_MAX_FACES), cint + & temp1(3 * REFELEM_MAX_FACES), cint, bndyflag(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 @@ -151,6 +155,23 @@ SUBROUTINE InitiateElementToElements3D(elementData, tFaceInMesh, showTime) 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) From 30c74235e09fdef0d33af9d1fd1f24aa19cd0a64 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 16:28:21 +0900 Subject: [PATCH 019/119] EASIFEM-103 Update initiate element to element for 1d case in abstract msh utility. --- .../AbstractMesh/src/AbstractMeshUtility.F90 | 24 +++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 44891797a..9d5c6be1e 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -349,9 +349,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 @@ -417,6 +417,7 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & tNodes = SIZE(elementData(iel)%globalNodes) jj = 0 temp1 = 0 + bndyflag = 0 DO ii = 1, 2 aint = elementData(iel)%globalNodes(ii) aint = local_nptrs(aint) @@ -424,6 +425,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 @@ -445,6 +448,23 @@ SUBROUTINE InitiateElementToElements1D(elementData, tNodesInMesh, & 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) From a8569d841bc9218ce1243a6d0fbdfe893ccca75a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 17:51:13 +0900 Subject: [PATCH 020/119] EASIFEM-144 Calling initiate elemene to element in obj_import method in abstract mesh class --- .../AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 index 00c94b228..0cd76cce1 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 @@ -208,6 +208,8 @@ RETURN END IF +CALL obj%InitiateElementToElements() + IF (ALLOCATED(entities0)) DEALLOCATE (entities0) group0 = "" From 2a46d61659a840aa77847dad5bcc9e2968cf65b3 Mon Sep 17 00:00:00 2001 From: shion Date: Fri, 29 Mar 2024 18:24:12 +0900 Subject: [PATCH 021/119] EASIFEM-146 Adding islocal opt in get local node number in abstract mesh --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 6 ++++- .../src/AbstractMesh_Class@GetMethods.F90 | 27 ++++++++++++++----- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 99dc49569..8d5c6a885 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1326,8 +1326,10 @@ END SUBROUTINE obj_GetNodeConnectivity 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 @@ -1341,9 +1343,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index c31c7b3ef..484324f04 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -454,9 +454,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 !---------------------------------------------------------------------------- @@ -467,15 +469,26 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber2()" LOGICAL(LGT) :: problem +#endif -problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalNode is out of bound.') -END IF +LOGICAL(LGT) :: islocal0 +islocal0 = Input(option=islocal, default=.FALSE.) + +IF (islocal0) THEN + ans = globalNode +ELSE + +#ifdef DEBUG_VER + problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) + IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalNode is out of bound.') + END IF #endif -ans = obj%local_nptrs(globalNode) + ans = obj%local_nptrs(globalNode) +END IF + END PROCEDURE obj_GetLocalNodeNumber2 !---------------------------------------------------------------------------- From 4d1f2bb1a65fa5af616f7614011732073dba58d5 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 20:10:44 +0900 Subject: [PATCH 022/119] EASIFEM-91 Minor updates in abstract mesh --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 8d5c6a885..6a3e8f93d 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1325,8 +1325,8 @@ 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) + 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 @@ -1374,7 +1374,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) @@ -1407,7 +1407,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) @@ -2365,7 +2365,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 From 59cf1b548e8f43c1e8261a2aeab5165248de0517 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 21:31:55 +0900 Subject: [PATCH 023/119] EASIFEM-147 Removing getconnectivity 1 from abstract mesh and mesh. --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 21 ++++++++----------- src/modules/Mesh/src/Mesh_Class.F90 | 17 ++++++++------- .../src/AbstractMesh_Class@GetMethods.F90 | 8 +++---- .../src/Domain_Class@MeshDataMethods.F90 | 15 ++++++++----- .../Mesh/src/Mesh_Class@GetMethods.F90 | 8 +++---- 5 files changed, 36 insertions(+), 33 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 6a3e8f93d..8a9976420 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -36,6 +36,7 @@ MODULE AbstractMesh_Class PUBLIC :: AbstractMeshDisplay PUBLIC :: AbstractMeshGetParam PUBLIC :: AbstractMeshImport +PUBLIC :: AbstractMeshGetFacetConnectivity CHARACTER(*), PARAMETER :: modName = "AbstractMesh_Class" @@ -455,13 +456,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 => & @@ -1888,7 +1884,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 @@ -1901,7 +1897,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 !---------------------------------------------------------------------------- @@ -1919,13 +1915,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 !---------------------------------------------------------------------------- diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index 7258f63eb..e0f6eba28 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" @@ -126,9 +127,8 @@ 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 @@ -401,7 +401,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 +414,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 +432,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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 484324f04..2b37a0310 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -944,7 +944,7 @@ ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity1 +MODULE PROCEDURE AbstractMeshGetFacetConnectivity INTEGER(I4B), ALLOCATABLE :: cellNptrs(:) INTEGER(I4B) :: localFaceID, cellNum @@ -974,13 +974,13 @@ END IF IF (ALLOCATED(cellNptrs)) DEALLOCATE (cellNptrs) -END PROCEDURE obj_GetFacetConnectivity1 +END PROCEDURE AbstractMeshGetFacetConnectivity !---------------------------------------------------------------------------- ! GetFacetConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_GetFacetConnectivity2 +MODULE PROCEDURE obj_GetFacetConnectivity ! CHARACTER(*), PARAMETER :: myName = "obj_GetFacetConnectivity2()" INTEGER(I4B) :: iel, temp4(4), elemType, order, & & con(MaxNodesInElement, REFELEM_MAX_FACES), & @@ -1031,7 +1031,7 @@ END SELECT -END PROCEDURE obj_GetFacetConnectivity2 +END PROCEDURE obj_GetFacetConnectivity !---------------------------------------------------------------------------- ! GetFacetElementType 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/Mesh/src/Mesh_Class@GetMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 index 109611e0a..0231e6bd8 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 !---------------------------------------------------------------------------- ! From dad68431c425937ecf60dd39341dfbeb78245fb4 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 21:40:37 +0900 Subject: [PATCH 024/119] EASIFEM-148 Updating get local element number in abstract mesh. --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 6 ++-- .../src/AbstractMesh_Class@GetMethods.F90 | 35 ++++++++++++++----- 2 files changed, 30 insertions(+), 11 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 8a9976420..100600bd9 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1422,10 +1422,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 @@ -1439,10 +1440,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 2b37a0310..f30fdb03c 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -559,7 +559,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 @@ -571,18 +571,35 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalElemNumber2()" LOGICAL(LGT) :: problem +#endif -problem = (globalElement .LT. obj%MinElemNum) & - & .OR. (globalElement .GT. obj%maxElemNum) +LOGICAL(LGT) :: islocal0 + +islocal0 = Input(default=.FALSE., option=islocal) + +IF (islocal0) THEN + ans = globalElement + +ELSE + +#ifdef DEBUG_VER + + problem = (globalElement .LT. obj%MinElemNum) & + & .OR. (globalElement .GT. obj%maxElemNum) + + IF (problem) THEN + ans = 0 + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalElement '//tostring(globalElement)// & + & ' not present.') + RETURN + END IF -IF (problem) THEN - ans = 0 - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalElement is not present.') -END IF #endif -ans = obj%local_elemNumber(globalElement) + ans = obj%local_elemNumber(globalElement) +END IF + END PROCEDURE obj_GetLocalElemNumber2 !---------------------------------------------------------------------------- From 7828a2b988c2bb0ce5bc8bb513604e3624391356 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 22:27:07 +0900 Subject: [PATCH 025/119] EASIFEM-150 Updating is element boundary element in abstract mesh --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 100600bd9..bfe2e836e 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1119,10 +1119,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index f30fdb03c..89920d69f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -287,7 +287,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 From 8cadaffcc4ea89b1d3d6feb9de7df5c8797b0077 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:28:07 +0900 Subject: [PATCH 026/119] EASIFEM-141 Updating initiate element to elements in abstract mesh utility --- .../AbstractMesh/src/AbstractMeshUtility.F90 | 29 ++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 9d5c6be1e..15c12901c 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -151,6 +151,14 @@ 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) @@ -296,6 +304,14 @@ 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) @@ -444,6 +460,14 @@ 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) @@ -638,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) @@ -646,6 +671,8 @@ SUBROUTINE MeshImportVector(obj, hdf5, group, connectivity, elemNumber, & obj%maxNptrs = MAXVAL(connectivity) obj%minNptrs = MINVAL(connectivity) + dsetname = "" + END SUBROUTINE MeshImportVector !---------------------------------------------------------------------------- From b31cabe539041162c053fbe8691e481b5db4bc08 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:30:17 +0900 Subject: [PATCH 027/119] EASIFEM-91 Minor fixes in abstract mesh class get methods. --- .../src/AbstractMesh_Class@GetMethods.F90 | 47 ++++++++++--------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 89920d69f..8d432560d 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -470,25 +470,27 @@ CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber2()" LOGICAL(LGT) :: problem #endif - LOGICAL(LGT) :: islocal0 + islocal0 = Input(option=islocal, default=.FALSE.) IF (islocal0) THEN ans = globalNode -ELSE + RETURN +END IF #ifdef DEBUG_VER - problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) - IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalNode is out of bound.') - END IF -#endif - ans = obj%local_nptrs(globalNode) +problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalNode is out of bound.') END IF +#endif + +ans = obj%local_nptrs(globalNode) + END PROCEDURE obj_GetLocalNodeNumber2 !---------------------------------------------------------------------------- @@ -579,26 +581,25 @@ IF (islocal0) THEN ans = globalElement - -ELSE + RETURN +END IF #ifdef DEBUG_VER - problem = (globalElement .LT. obj%MinElemNum) & - & .OR. (globalElement .GT. obj%maxElemNum) +problem = (globalElement .LT. obj%minElemNum) & + & .OR. (globalElement .GT. obj%maxElemNum) - IF (problem) THEN - ans = 0 - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: globalElement '//tostring(globalElement)// & - & ' not present.') - RETURN - END IF +IF (problem) THEN + ans = 0 + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: globalElement '//tostring(globalElement)// & + & ' not present.') + RETURN +END IF #endif - ans = obj%local_elemNumber(globalElement) -END IF +ans = obj%local_elemNumber(globalElement) END PROCEDURE obj_GetLocalElemNumber2 @@ -1003,7 +1004,7 @@ & con(MaxNodesInElement, REFELEM_MAX_FACES), & & ii, tFaceNodes(REFELEM_MAX_FACES) -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) SELECT CASE (obj%xidim) From 28fd869acc046dda417018875da23e97ccf35647 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:31:19 +0900 Subject: [PATCH 028/119] EASIFEM-95 Updating initiate element to elements in abstract mesh element data methods. --- .../AbstractMesh_Class@ElementDataMethods.F90 | 54 ++++++++++++++++++- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 index 9c0c239ce..e8a1d57c7 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 @@ -49,6 +49,8 @@ #endif SELECT CASE (obj%xidim) +CASE (0_I4B) + CASE (1_I4B) CALL InitiateElementToElements1D( & @@ -77,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] ') @@ -89,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 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From 9544fab39fcfe1f9231e51d77b6b0de79803416f Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:39:29 +0900 Subject: [PATCH 029/119] EASIFEM-151 Addign is node present to fedomain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 3d2c5d13d..6062ecf23 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -26,6 +26,28 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! IsNodePresent +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_IsNodePresent +ans = .TRUE. +IF (globalNode .GT. obj%maxNptrs .OR. globalNode .LT. obj%minNptrs) THEN + ans = .FALSE. + RETURN +END IF + +SELECT CASE (obj%nsd) +CASE (0) + ans = obj%meshPoint%IsNodePresent(globalNode) +CASE (1) + ans = obj%meshCurve%IsNodePresent(globalNode) +CASE (2) + ans = obj%meshSurface%IsNodePresent(globalNode) +CASE (3) + ans = obj%meshVolume%IsNodePresent(globalNode) +END SELECT +END PROCEDURE obj_IsNodePresent MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From cbeb72e3f044d25db7138ccae6e4a31170655924 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:40:39 +0900 Subject: [PATCH 030/119] EASIFEM-151 Addign is element present --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 6062ecf23..a4ce1ee35 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -48,6 +48,27 @@ ans = obj%meshVolume%IsNodePresent(globalNode) 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) +CASE (2) + ans = obj%meshSurface%IsElementPresent(globalElement=globalElement) +CASE (1) + ans = obj%meshCurve%IsElementPresent(globalElement=globalElement) +CASE (0) + ans = obj%meshPoint%IsElementPresent(globalElement=globalElement) +END SELECT + +END PROCEDURE obj_IsElementPresent MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 6d1effdd196b19d45074fd9a9728a29c87cba495 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:40:56 +0900 Subject: [PATCH 031/119] EASIFEM-152 adding get connectivity --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index a4ce1ee35..c10570ab1 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -69,6 +69,28 @@ END SELECT END PROCEDURE obj_IsElementPresent + +!---------------------------------------------------------------------------- +! getConnectivity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetConnectivity +INTEGER(I4B) :: dim0 + +dim0 = Input(default=obj%nsd, option=dim) + +SELECT CASE (dim0) +CASE (3) + ans = obj%meshVolume%GetConnectivity(globalElement=globalElement) +CASE (2) + ans = obj%meshSurface%GetConnectivity(globalElement=globalElement) +CASE (1) + ans = obj%meshCurve%GetConnectivity(globalElement=globalElement) +CASE (0) + ans = obj%meshPoint%GetConnectivity(globalElement=globalElement) +END SELECT + +END PROCEDURE obj_GetConnectivity MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 1c9a90a1570c7df852cb0d5b85a064d8e36207ba Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:41:17 +0900 Subject: [PATCH 032/119] EASIFEM-153 Addign node to elements to fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 34 +++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index c10570ab1..8cc87cab9 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -91,6 +91,40 @@ END SELECT END PROCEDURE obj_GetConnectivity + +!---------------------------------------------------------------------------- +! getNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements1 +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode) +CASE (2) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode) +CASE (1) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode) +CASE (0) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode) +END SELECT +END PROCEDURE obj_GetNodeToElements1 + +!---------------------------------------------------------------------------- +! getNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements2 +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode) +CASE (2) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode) +CASE (1) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode) +CASE (0) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode) +END SELECT +END PROCEDURE obj_GetNodeToElements2 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 266227f80ac5be7198fa92f7a4fccc100476a30e Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:41:39 +0900 Subject: [PATCH 033/119] EASIFEM-154 Adding get total nodes to fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 38 +++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 8cc87cab9..6d3216df5 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -125,6 +125,44 @@ ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode) END SELECT 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 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 915c0f9fe46a703678d2333093a827f2a871d161 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:42:01 +0900 Subject: [PATCH 034/119] EASIFEM-155 Adding get total elements to fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 6d3216df5..c0195627e 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -163,6 +163,28 @@ 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 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From f36ec62f3aef268b9e17e3d484eee6f8e3803a6f Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:43:14 +0900 Subject: [PATCH 035/119] EASIFEM-155 Adding total element method in fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index c0195627e..962b79260 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -185,6 +185,23 @@ 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 + MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 2a2a8ae6eb4db73152ef698f85ff1a86d4856383 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:43:34 +0900 Subject: [PATCH 036/119] EASIFEM-156 Adding get local node number method --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 55 +++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 962b79260..e97bcc906 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -202,6 +202,61 @@ ans = obj%GetTotalElements(dim=dim) END PROCEDURE obj_tElements2 +!---------------------------------------------------------------------------- +! getLocalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetLocalNodeNumber1 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber1()" +#endif + +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode) +CASE (2) + ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode) +CASE (1) + ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode) +CASE (0) + ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode) +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 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_GetLocalNodeNumber2()" +#endif + +SELECT CASE (obj%nsd) +CASE (3) + ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode) +CASE (2) + ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode) +CASE (1) + ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode) +CASE (0) + ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode) +CASE DEFAULT + ans = 0 +#ifdef DEBUG_VER + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: No case found') +#endif +END SELECT + +END PROCEDURE obj_GetLocalNodeNumber2 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From cc3d7e3cae7dc1e06c0014b275e70d13540a0396 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:43:52 +0900 Subject: [PATCH 037/119] EASIFEM-157 Adding get global node number method --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 54 +++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index e97bcc906..81edd0ded 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -257,6 +257,60 @@ END SELECT END PROCEDURE obj_GetLocalNodeNumber2 + +!---------------------------------------------------------------------------- +! getGlobalNodeNumber +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetGlobalNodeNumber1 +#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 +#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 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 5e844e748f183fd5358fa115c40fedfe07e092b9 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:44:11 +0900 Subject: [PATCH 038/119] EASIFEM-158 adding get total entities in fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 81edd0ded..3df4b0496 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -311,6 +311,26 @@ #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 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From d5ce6c35be7b114c1225f4b6f751c5616f18b8ad Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:44:31 +0900 Subject: [PATCH 039/119] EASIFEM-159 Adding get mesh pointer method --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 3df4b0496..68860067e 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -331,6 +331,26 @@ 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 + +!---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From e35f891ce62929d5500ac1cc0a82c6ba922626fa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:45:13 +0900 Subject: [PATCH 040/119] EASIFEM-161 Adding the get node coord in fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 68860067e..64a591271 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -351,6 +351,37 @@ 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)) +INTEGER(I4B) :: nsd +localNode = obj%GetLocalNodeNumber(globalNode=globalNode) +nsd = SIZE(nodeCoord, 1) +nodeCoord = obj%nodeCoord(1:nsd, localNode) +END PROCEDURE obj_GetNodeCoord2 MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From 8cfe6cde8be7e35bc05c82abaa4838b3ce5c4759 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:45:29 +0900 Subject: [PATCH 041/119] EASIFEM-162 Adding get node coord pointer in fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 64a591271..b9f788377 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -382,6 +382,18 @@ nsd = SIZE(nodeCoord, 1) nodeCoord = obj%nodeCoord(1:nsd, localNode) END PROCEDURE obj_GetNodeCoord2 + +!---------------------------------------------------------------------------- +! getNodeCoordPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeCoordPointer +ans => obj%nodeCoord +END PROCEDURE obj_GetNodeCoordPointer + +!---------------------------------------------------------------------------- +! GetNptrs +!---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) From eb03a9399da870e2cf0126b9efc3b29b212b7854 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:45:47 +0900 Subject: [PATCH 042/119] EASIFEM-163 Adding get nptrs in fe domai --- src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index b9f788377..41b3d2b78 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -394,6 +394,7 @@ !---------------------------------------------------------------------------- ! GetNptrs !---------------------------------------------------------------------------- + MODULE PROCEDURE obj_GetNptrs SELECT CASE (dim) CASE (3) @@ -424,6 +425,7 @@ END SELECT END PROCEDURE obj_GetNptrs_ +!---------------------------------------------------------------------------- !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From cdd20df23b26d2048b1eac989dfaa4f812af2ff3 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:46:05 +0900 Subject: [PATCH 043/119] EASIFEM-164 Adding get internal nptrs in fe domain --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 41b3d2b78..1e318d328 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -426,6 +426,21 @@ END PROCEDURE obj_GetNptrs_ !---------------------------------------------------------------------------- +! 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 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From 2d2bcd86d8215b2cbed37f6af1e1747e4d183ed6 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:46:38 +0900 Subject: [PATCH 044/119] EASIFEM-116 Some minor updates in get methods of fe domain --- .../src/FEDomain_Class@MeshDataMethods.F90 | 571 ++++++++++++++++++ 1 file changed, 571 insertions(+) create mode 100644 src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 new file mode 100644 index 000000000..8318b9c6b --- /dev/null +++ b/src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 @@ -0,0 +1,571 @@ +! 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(FEDomain_Class) MeshDataMethods +USE BaseMethod +USE DomainConnectivity_Class +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! 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 From 2113e7ecfc75bcef10be8e6184780996bf92c25b Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 29 Mar 2024 23:49:33 +0900 Subject: [PATCH 045/119] EASIFEM-116 Some updates in fe domain get methods --- .../Domain/src/FEDomain_Class@GetMethods.F90 | 79 +++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 1e318d328..14490e216 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -441,6 +441,85 @@ 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 +REAL(DFP) :: lim(6) +INTEGER(I4B) :: nsd +!> main +lim = 0.0_DFP +nsd = SIZE(obj%nodeCoord, 1) +lim(1:nsd * 2:2) = MINVAL(obj%nodeCoord(1:nsd, :), dim=2) +lim(2:nsd * 2:2) = MAXVAL(obj%nodeCoord(1:nsd, :), dim=2) +CALL Initiate(obj=ans, nsd=3_I4B, lim=lim) +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 +! IF (PRESENT(imeshFacetData)) THEN +! IF (ALLOCATED(obj%meshFacetData)) THEN +! IF (obj%meshFacetData(imeshFacetData)%isInitiated()) THEN +! ans = obj%meshFacetData(imeshFacetData)%SIZE() +! ELSE +! ans = 0 +! END IF +! ELSE +! ans = 0 +! END IF +! ELSE +! IF (ALLOCATED(obj%meshFacetData)) THEN +! ans = SIZE(obj%meshFacetData) +! ELSE +! ans = 0 +! END IF +! END IF +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 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From 99b5c2dd4f36b6056101edbeba98090a5906f7ab Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 16:53:10 +0900 Subject: [PATCH 046/119] EASIFEM-165 Adding islocal in isBoundaryNode --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index bfe2e836e..d1da939f7 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1018,9 +1018,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 8d432560d..17a2258ea 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -199,7 +199,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 From 03165e51324a50893ab91f24eda0f7d525d7ef05 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 17:23:21 +0900 Subject: [PATCH 047/119] EASIFEM-166 Adding is node present routine to abstract mesh --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 12 ++++++--- .../src/AbstractMesh_Class@GetMethods.F90 | 25 +++++++++++++------ 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index d1da939f7..a3bc2e78b 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1035,9 +1035,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 @@ -1051,9 +1052,10 @@ 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 @@ -1067,9 +1069,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 @@ -1083,9 +1086,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 17a2258ea..6368c544d 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -208,12 +208,21 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_isNodePresent1 -LOGICAL(LGT) :: abool +LOGICAL(LGT) :: abool, islocal0 + +islocal0 = Input(default=.FALSE., option=islocal) + +IF (islocal0) THEN + ans = 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 @@ -225,7 +234,7 @@ 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 @@ -240,7 +249,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) @@ -257,7 +266,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) From 0458ddde8a297dbab71fbf6cdb6b328bf843c229 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 18:29:44 +0900 Subject: [PATCH 048/119] EASIFEM-167 Updating islocal option to get node to elements method in abstract mesh, --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 8 ++++++-- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 6 +++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index a3bc2e78b..dcf6379ec 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1474,11 +1474,13 @@ END FUNCTION obj_GetLocalElemNumber2 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & + & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: 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 @@ -1505,11 +1507,13 @@ END FUNCTION obj_GetNodeToElements1 !@endnote INTERFACE - MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & + & RESULT(ans) CLASS(AbstractMesh_), INTENT(IN) :: 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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 6368c544d..da0eaf0bd 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -623,7 +623,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//' - '// & @@ -631,7 +631,7 @@ END IF #endif -ii = obj%GetLocalNodeNumber(globalNode) +ii = obj%GetLocalNodeNumber(globalNode, islocal=islocal) ans = obj%nodeData(ii)%globalElements END PROCEDURE obj_GetNodeToElements1 @@ -647,7 +647,7 @@ 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 From 1b2db760a826050264515ec68071590daef3eaf9 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 18:52:16 +0900 Subject: [PATCH 049/119] EASIFEM-168 updating get node to nodes methods in abstract mesh. adding is local option --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 10 ++++++---- .../src/AbstractMesh_Class@GetMethods.F90 | 14 ++++++++------ 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index dcf6379ec..0cd889ce0 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1541,11 +1541,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 @@ -1573,11 +1574,12 @@ 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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index da0eaf0bd..a14562b4f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -213,7 +213,7 @@ islocal0 = Input(default=.FALSE., option=islocal) IF (islocal0) THEN - ans = globalNode .LE. obj%tNodes + ans = (globalNode .GT. 0_I4B) .AND. (globalNode .LE. obj%tNodes) ELSE @@ -673,19 +673,22 @@ CHARACTER(*), PARAMETER :: myName = "obj_GetNodeToNodes1()" LOGICAL(LGT) :: problem #endif -INTEGER(I4B) :: i -i = obj%GetLocalNodeNumber(GlobalNode=GlobalNode) +INTEGER(I4B) :: i #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) IF (problem) THEN @@ -695,7 +698,6 @@ END IF #endif -! check IF (obj%isExtraNodeToNodesInitiated .AND. IncludeSelf) THEN CALL Append(ans, [globalNode], obj%nodeData(i)%globalNodes, & & obj%nodeData(i)%extraGlobalNodes) @@ -729,7 +731,7 @@ 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))%globalNodes) END DO From 3bbb33b4895fdced6701d73afc744b45ef69e62a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 19:10:30 +0900 Subject: [PATCH 050/119] EASIFEM-171 Adding islocal to islement present method. --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 5 +++-- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 0cd889ce0..510cc196c 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -620,7 +620,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 ! ! @@ -866,9 +866,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index a14562b4f..b846ed609 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -49,7 +49,7 @@ LOGICAL(LGT) :: isok #endif -iel = obj%GetLocalElemNumber(globalElement) +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) ans = 0 #ifdef DEBUG_VER @@ -62,6 +62,7 @@ ans = SIZE(obj%elementData(iel)%globalNodes) #endif + END PROCEDURE obj_GetNNE !---------------------------------------------------------------------------- From 2676af4362ce94f4b3d6658f3670a35e64d1218d Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 19:26:48 +0900 Subject: [PATCH 051/119] EASIFEM-171 Adding islocal to is element present in abstract mesh --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 7 ++++--- .../src/AbstractMesh_Class@GetMethods.F90 | 18 +++++++++++++----- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 510cc196c..6d38e86f6 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1104,10 +1104,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 @@ -2078,8 +2079,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index b846ed609..c9c7a686f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -279,14 +279,22 @@ 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 +ELSE + isok = (globalElement .GT. obj%maxElemNum) .OR. & + & (globalElement .LT. obj%minElemNum) -ans = .NOT. isok + ans = .NOT. isok -IF (ans) THEN - ans = .NOT. (isok .OR. obj%local_elemNumber(globalElement) .EQ. 0) + IF (ans) THEN + ans = .NOT. (isok .OR. obj%local_elemNumber(globalElement) .EQ. 0) + END IF END IF END PROCEDURE obj_isElementPresent From 8e8f28b8a8ff55284a8e12eae325e70d0a01feaa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 19:48:43 +0900 Subject: [PATCH 052/119] EASIFEM-169 adding islocal to get element to lements methods in abstract mesh --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 6d38e86f6..4c58e578c 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1616,7 +1616,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 @@ -1626,6 +1626,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index c9c7a686f..8f1ae6e26 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -771,7 +771,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) From 3674ce622c87c455800b370a9de64f20b836cae0 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 19:54:00 +0900 Subject: [PATCH 053/119] EASIFEM-176 adding is local to is domain boundary element in abstractmesh get methods --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 4c58e578c..333c4509c 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1151,10 +1151,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 8f1ae6e26..0a4e8b720 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -315,7 +315,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 From 531705c86b1fcda67d8f753f69175087936155a2 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 30 Mar 2024 19:58:28 +0900 Subject: [PATCH 054/119] EASIFEM-174 addin is local option in get facet elemet type --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 333c4509c..393cc6f6e 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1952,10 +1952,11 @@ END FUNCTION obj_GetFacetConnectivity ! 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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 0a4e8b720..19a514335 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -1077,7 +1077,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 From b79e7d135b040f6f088e4199aa9a361fa59accf1 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 15:35:58 +0900 Subject: [PATCH 055/119] EASIFEM-175 adding islocal to set facet element to abstract mesh class --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 393cc6f6e..a61d3802a 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -2446,11 +2446,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/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index 9427d873a..bbf260aa1 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -226,7 +226,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 From 239357ae6dcb41b25e9caf8d6fb5038ecac7c5c8 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 15:35:58 +0900 Subject: [PATCH 056/119] EASIFEM-175 adding islocal to set facet element to abstract mesh class --- src/modules/Mesh/src/Mesh_Class.F90 | 21 ------------------- .../Mesh/src/Mesh_Class@SetMethods.F90 | 11 ---------- 2 files changed, 32 deletions(-) diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index e0f6eba28..517ac88d1 100755 --- a/src/modules/Mesh/src/Mesh_Class.F90 +++ b/src/modules/Mesh/src/Mesh_Class.F90 @@ -141,9 +141,6 @@ 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 @@ -697,24 +694,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 !---------------------------------------------------------------------------- diff --git a/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 index 739c7ec9e..dbec84847 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 !---------------------------------------------------------------------------- From 97344b83b07cbe3a9ff35b125a88be62865ee809 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 15:40:12 +0900 Subject: [PATCH 057/119] EASIFEM-178 addign islocal to get connectivity method in abstrract mesh --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index a61d3802a..0ca7e23f5 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1287,9 +1287,10 @@ 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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 19a514335..6519df4ba 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -422,16 +422,16 @@ #endif INTEGER(I4B) :: ii -ii = obj%GetLocalElemNumber(globalElement) #ifdef DEBUG_VER -problem = (ii .EQ. 0) .OR. (ii .GT. obj%tElements) +problem = .NOT. obj%isNodePresent(globalnode, islocal=islocal) IF (problem) THEN CALL e%RaiseError(modName//'::'//myName//' - '// & & '[INTERNAL ERROR] :: problem in getting localElement number') END IF #endif +ii = obj%GetLocalElemNumber(globalElement, islocal=islocal) ans = obj%elementData(ii)%globalNodes END PROCEDURE obj_GetConnectivity From 5ac1e364d5c6fc44f02ef7998b7949ff4bd4fa73 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 15:55:30 +0900 Subject: [PATCH 058/119] EASIFEM-179 Adding islocal to get boundary element method in abstract mesh --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 6 ++-- .../src/AbstractMesh_Class@GetMethods.F90 | 30 +++++-------------- 2 files changed, 12 insertions(+), 24 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 0ca7e23f5..c0fe29104 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1287,7 +1287,8 @@ END FUNCTION obj_GetBoundingBox2 ! summary: This routine returns global node numbers in a given global elem INTERFACE - MODULE FUNCTION obj_GetConnectivity(obj, globalElement, islocal) 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 @@ -1662,10 +1663,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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 6519df4ba..c654aab51 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -421,18 +421,18 @@ LOGICAL(LGT) :: problem #endif -INTEGER(I4B) :: ii +INTEGER(I4B) :: iel #ifdef DEBUG_VER -problem = .NOT. obj%isNodePresent(globalnode, islocal=islocal) +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 -ii = obj%GetLocalElemNumber(globalElement, islocal=islocal) -ans = obj%elementData(ii)%globalNodes +iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) +ans = obj%elementData(iel)%globalNodes END PROCEDURE obj_GetConnectivity !---------------------------------------------------------------------------- @@ -811,25 +811,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 !---------------------------------------------------------------------------- From 916f8ee3bed2ffe11a92369250635a3e8594ec25 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 16:10:28 +0900 Subject: [PATCH 059/119] EASIFEM-146 minor fixes in get local node number method in abstract mesh --- .../src/AbstractMesh_Class@GetMethods.F90 | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index c654aab51..93a7cb4a2 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -490,24 +490,21 @@ #endif LOGICAL(LGT) :: islocal0 -islocal0 = Input(option=islocal, default=.FALSE.) - -IF (islocal0) THEN - ans = globalNode - RETURN -END IF - #ifdef DEBUG_VER - -problem = (globalNode .LT. obj%minNptrs) .OR. (globalNode .GT. obj%maxNptrs) +problem = .NOT. obj%isNodePresent(globalnode, islocal=islocal) IF (problem) THEN CALL e%RaiseError(modName//'::'//myName//' - '// & & '[INTERNAL ERROR] :: 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 From cd46c13edf2236ce1b4355edb82c7cacbdf5c6ff Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 16:19:47 +0900 Subject: [PATCH 060/119] EASIFEM-181 adding islocal to isnodepresent to fedomai --- src/modules/Domain/src/FEDomain_Class.F90 | 3 ++- .../Domain/src/FEDomain_Class@GetMethods.F90 | 14 ++++---------- 2 files changed, 6 insertions(+), 11 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index d093aa628..ca549ea84 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -453,9 +453,10 @@ END SUBROUTINE obj_DisplayDomainInfo ! summary: Returns true if the global node number is present INTERFACE - MODULE FUNCTION obj_IsNodePresent(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_IsNodePresent(obj, globalNode, islocal) RESULT(ans) CLASS(FEDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal LOGICAL(LGT) :: ans END FUNCTION obj_IsNodePresent END INTERFACE diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 14490e216..5ed2f3913 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -31,21 +31,15 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_IsNodePresent -ans = .TRUE. -IF (globalNode .GT. obj%maxNptrs .OR. globalNode .LT. obj%minNptrs) THEN - ans = .FALSE. - RETURN -END IF - SELECT CASE (obj%nsd) CASE (0) - ans = obj%meshPoint%IsNodePresent(globalNode) + ans = obj%meshPoint%IsNodePresent(globalNode, islocal=islocal) CASE (1) - ans = obj%meshCurve%IsNodePresent(globalNode) + ans = obj%meshCurve%IsNodePresent(globalNode, islocal=islocal) CASE (2) - ans = obj%meshSurface%IsNodePresent(globalNode) + ans = obj%meshSurface%IsNodePresent(globalNode, islocal=islocal) CASE (3) - ans = obj%meshVolume%IsNodePresent(globalNode) + ans = obj%meshVolume%IsNodePresent(globalNode, islocal=islocal) END SELECT END PROCEDURE obj_IsNodePresent From 90c3481750cf01f4e7dbf70978033b374edffeb4 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 16:23:58 +0900 Subject: [PATCH 061/119] EASIFEM-182 add islocal to is element present --- src/modules/Domain/src/FEDomain_Class.F90 | 5 +++-- .../Domain/src/FEDomain_Class@GetMethods.F90 | 12 ++++++++---- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index ca549ea84..699dccd1b 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -471,8 +471,8 @@ END FUNCTION obj_IsNodePresent ! summary: Returns true if the element number is present inside the domain INTERFACE - MODULE FUNCTION obj_IsElementPresent(obj, globalElement, dim) & - & RESULT(ans) + MODULE FUNCTION obj_IsElementPresent(obj, globalElement, dim, & + & islocal) RESULT(ans) CLASS(FEDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement !! Element number @@ -483,6 +483,7 @@ MODULE FUNCTION obj_IsElementPresent(obj, globalElement, dim) & !! 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 diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 5ed2f3913..e914cbb60 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -53,13 +53,17 @@ dim0 = Input(default=obj%nsd, option=dim) SELECT CASE (dim0) CASE (3) - ans = obj%meshVolume%IsElementPresent(globalElement=globalElement) + ans = obj%meshVolume%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%IsElementPresent(globalElement=globalElement) + ans = obj%meshSurface%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%IsElementPresent(globalElement=globalElement) + ans = obj%meshCurve%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%IsElementPresent(globalElement=globalElement) + ans = obj%meshPoint%IsElementPresent(globalElement=globalElement, & + & islocal=islocal) END SELECT END PROCEDURE obj_IsElementPresent From 4cfc4128097b3c3355f5f472f04a9ca21ab6d295 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 16:26:50 +0900 Subject: [PATCH 062/119] EASIFEM-183 add islocal to get connectivity in abstract domain --- src/modules/Domain/src/FEDomain_Class.F90 | 3 ++- .../Domain/src/FEDomain_Class@GetMethods.F90 | 12 ++++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index 699dccd1b..6bdcae3da 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -498,7 +498,7 @@ END FUNCTION obj_IsElementPresent ! summary: Returns the connectivity vector of a given element number INTERFACE - MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim) & + MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim, islocal) & & RESULT(ans) CLASS(FEDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement @@ -511,6 +511,7 @@ MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim) & !! 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 diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index e914cbb60..f672a6372 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -79,13 +79,17 @@ SELECT CASE (dim0) CASE (3) - ans = obj%meshVolume%GetConnectivity(globalElement=globalElement) + ans = obj%meshVolume%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%GetConnectivity(globalElement=globalElement) + ans = obj%meshSurface%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%GetConnectivity(globalElement=globalElement) + ans = obj%meshCurve%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%GetConnectivity(globalElement=globalElement) + ans = obj%meshPoint%GetConnectivity(globalElement=globalElement, & + & islocal=islocal) END SELECT END PROCEDURE obj_GetConnectivity From d49994d16947ddf24d7616e458b1ecf7217565b1 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 16:31:12 +0900 Subject: [PATCH 063/119] EASIFEM-184 adding is local to get node toelements in fedomain --- src/modules/Domain/src/FEDomain_Class.F90 | 8 +++++-- .../Domain/src/FEDomain_Class@GetMethods.F90 | 24 ++++++++++++------- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index 6bdcae3da..c9a9806f8 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -533,10 +533,12 @@ END FUNCTION obj_GetConnectivity ! for obj%nsd = 0, we use meshPoint INTERFACE - MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & + & RESULT(ans) CLASS(FEDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode INTEGER(I4B), ALLOCATABLE :: ans(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal END FUNCTION obj_GetNodeToElements1 END INTERFACE @@ -556,10 +558,12 @@ END FUNCTION obj_GetNodeToElements1 ! for obj%nsd = 0, we use meshPoint INTERFACE - MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & + & RESULT(ans) CLASS(FEDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) INTEGER(I4B), ALLOCATABLE :: ans(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal END FUNCTION obj_GetNodeToElements2 END INTERFACE diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index f672a6372..4a9f7b9f2 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -101,13 +101,17 @@ MODULE PROCEDURE obj_GetNodeToElements1 SELECT CASE (obj%nsd) CASE (3) - ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) END SELECT END PROCEDURE obj_GetNodeToElements1 @@ -118,13 +122,17 @@ MODULE PROCEDURE obj_GetNodeToElements2 SELECT CASE (obj%nsd) CASE (3) - ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode) + ans = obj%meshVolume%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode) + ans = obj%meshSurface%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode) + ans = obj%meshCurve%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode) + ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & + & islocal=islocal) END SELECT END PROCEDURE obj_GetNodeToElements2 From cd49a0e1eb7e519bcd8b085493a400f2bee11116 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 17:41:44 +0900 Subject: [PATCH 064/119] EASIFEM-185 add islocal to get local node number in fedomain --- src/modules/Domain/src/FEDomain_Class.F90 | 8 +++++-- .../Domain/src/FEDomain_Class@GetMethods.F90 | 24 ++++++++++++------- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index c9a9806f8..b7c05ab9b 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -729,10 +729,12 @@ END FUNCTION obj_tElements2 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION obj_GetLocalNodeNumber1(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetLocalNodeNumber1(obj, globalNode, islocal) & + & RESULT(ans) CLASS(FEDomain_), 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 @@ -747,9 +749,11 @@ END FUNCTION obj_GetLocalNodeNumber1 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION obj_GetLocalNodeNumber2(obj, globalNode) RESULT(ans) + MODULE FUNCTION obj_GetLocalNodeNumber2(obj, globalNode, islocal) & + & RESULT(ans) CLASS(FEDomain_), 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 diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index 4a9f7b9f2..e884d55a8 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -223,13 +223,17 @@ SELECT CASE (obj%nsd) CASE (3) - ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE DEFAULT ans = 0 #ifdef DEBUG_VER @@ -251,13 +255,17 @@ SELECT CASE (obj%nsd) CASE (3) - ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshVolume%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (2) - ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshSurface%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (1) - ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshCurve%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE (0) - ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode) + ans = obj%meshPoint%GetLocalNodeNumber(globalNode=globalNode, & + & islocal=islocal) CASE DEFAULT ans = 0 #ifdef DEBUG_VER From 1fd5a4b3c1be8f2bcb2f0de4bf667d0e6c5b2bf3 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 17:52:16 +0900 Subject: [PATCH 065/119] EASIFEM-186 adding islocal to get node coord in fe domain. --- src/modules/Domain/src/FEDomain_Class.F90 | 4 +++- src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index b7c05ab9b..940f07ae8 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -879,13 +879,15 @@ END SUBROUTINE obj_GetNodeCoord ! returns its nodal coordinates INTERFACE - MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode) + MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode, & + & islocal) CLASS(FEDomain_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) !! It should be allocated by the user. !! SIZE(nodeCoord, 1) is equal to nsd !! Size(nodeCoord, 2) is equal to the size(globalNode) INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal END SUBROUTINE obj_GetNodeCoord2 END INTERFACE diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 index e884d55a8..bc8eb9b50 100644 --- a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 @@ -396,7 +396,7 @@ MODULE PROCEDURE obj_GetNodeCoord2 INTEGER(I4B) :: localNode(SIZE(globalNode)) INTEGER(I4B) :: nsd -localNode = obj%GetLocalNodeNumber(globalNode=globalNode) +localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) nsd = SIZE(nodeCoord, 1) nodeCoord = obj%nodeCoord(1:nsd, localNode) END PROCEDURE obj_GetNodeCoord2 From 9e3543cbe1cc3106099d3d14ed413825ff182340 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 18:42:04 +0900 Subject: [PATCH 066/119] EASIFEM-123 added set sparsity 1 in fedomain class --- src/modules/Domain/src/FEDomain_Class.F90 | 2 +- .../Domain/src/FEDomain_Class@SetMethods.F90 | 250 ++++++++++++++++++ 2 files changed, 251 insertions(+), 1 deletion(-) create mode 100644 src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 diff --git a/src/modules/Domain/src/FEDomain_Class.F90 b/src/modules/Domain/src/FEDomain_Class.F90 index 940f07ae8..4ddfc5957 100644 --- a/src/modules/Domain/src/FEDomain_Class.F90 +++ b/src/modules/Domain/src/FEDomain_Class.F90 @@ -1060,7 +1060,7 @@ END FUNCTION obj_GetUniqueElemType !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 12 Oct 2021 +! date: 2024-03-31 ! summary: Set sparsity in [[CSRMatrix_]] from [[FEDomain_]] INTERFACE diff --git a/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 new file mode 100644 index 000000000..b252388da --- /dev/null +++ b/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 @@ -0,0 +1,250 @@ +! 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(FEDomain_Class) SetMethods +! USE BaseMethod +! USE DomainConnectivity_Class +! USE DomainUtility +USE Display_Method +USE InputUtility +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! SetSparsity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetSparsity1 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" + +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 + +END PROCEDURE obj_SetSparsity1 + +!---------------------------------------------------------------------------- +! SetSparsity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetSparsity2 +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" +! INTEGER(I4B) :: ivar, nsd(SIZE(domains)) +! CHARACTER(20) :: matProp + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! DO ivar = 1, SIZE(domains) +! +! IF (.NOT. ASSOCIATED(domains(ivar)%ptr)) THEN +! CALL e%RaiseError(modName//"::"//myName//" - "// & +! & 'DOMAINS( '//TOSTRING(ivar)//' ) NOT ASSOCIATED') +! ELSE +! IF (.NOT. domains(ivar)%ptr%isInitiated) & +! & CALL e%RaiseError(modName//"::"//myName//" - "// & +! & 'DOMAINS( '//TOSTRING(ivar)//' )%ptr NOT INITIATED') +! END IF +! +! nsd(ivar) = domains(ivar)%ptr%getNSD() +! +! END DO +! +! IF (ANY(nsd .NE. nsd(1))) THEN +! CALL e%RaiseError(modName//"::"//myName//" - "// & +! & 'It seems that NSD (number of spatial dimensions) of domains are & +! & not identical') +! END IF +! +! CALL Display("Calling SetSparsity2 or SetSpartsity3 from DomainUtility") +! matProp = GetMatrixProp(mat) +! +! IF (TRIM(matProp) .EQ. "RECTANGLE") THEN +! CALL SetSparsity3(domains=domains, mat=mat) +! ELSE +! CALL SetSparsity2(domains=domains, mat=mat) +! END IF + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END PROCEDURE obj_SetSparsity2 + +!---------------------------------------------------------------------------- +! 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 +CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) +! CALL meshptr%SetMaterial(medium=medium, material=material) +! meshptr => NULL() +END PROCEDURE obj_SetMaterial + +!---------------------------------------------------------------------------- +! SetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetNodeCoord1 +CHARACTER(*), PARAMETER :: myName = "obj_SetNodeCoord1()" +REAL(DFP) :: scale0 +LOGICAL(LGT) :: problem + +problem = .NOT. ALLOCATED(obj%nodeCoord) +IF (problem) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[INTERNAL ERROR] :: FEDomain_::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 + +scale0 = Input(option=scale, default=1.0_DFP) + +IF (PRESENT(addContribution)) THEN + obj%nodeCoord = obj%nodeCoord + scale * nodeCoord +ELSE + obj%nodeCoord = nodeCoord +END IF + +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 From a09d7ee09e5754042386077646517330edd8d520 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 19:46:23 +0900 Subject: [PATCH 067/119] EASIFEM-124 working on set sparsity 2 in fe domain --- .../Domain/src/FEDomain_Class@SetMethods.F90 | 167 ++++++++++++++---- 1 file changed, 133 insertions(+), 34 deletions(-) diff --git a/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 b/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 index b252388da..364c9949d 100644 --- a/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 +++ b/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 @@ -17,8 +17,11 @@ SUBMODULE(FEDomain_Class) SetMethods ! USE BaseMethod -! USE DomainConnectivity_Class +USE FEMesh_Class, ONLY: FEMesh_ +USE DomainConnectivity_Class, ONLY: DomainConnectivity_ ! USE DomainUtility +USE CSRMatrix_Method +USE BoundingBox_Method USE Display_Method USE InputUtility IMPLICIT NONE @@ -54,6 +57,8 @@ RETURN END SELECT +CALL SetSparsity(mat) + END PROCEDURE obj_SetSparsity1 !---------------------------------------------------------------------------- @@ -62,46 +67,52 @@ MODULE PROCEDURE obj_SetSparsity2 CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" -! INTEGER(I4B) :: ivar, nsd(SIZE(domains)) -! CHARACTER(20) :: matProp +INTEGER(I4B) :: ivar, nsd(SIZE(domains)) +CHARACTER(:), ALLOCATABLE :: matProp +LOGICAL(LGT) :: problem #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & & '[START] ') #endif -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') +DO ivar = 1, SIZE(domains) -! DO ivar = 1, SIZE(domains) -! -! IF (.NOT. ASSOCIATED(domains(ivar)%ptr)) THEN -! CALL e%RaiseError(modName//"::"//myName//" - "// & -! & 'DOMAINS( '//TOSTRING(ivar)//' ) NOT ASSOCIATED') -! ELSE -! IF (.NOT. domains(ivar)%ptr%isInitiated) & -! & CALL e%RaiseError(modName//"::"//myName//" - "// & -! & 'DOMAINS( '//TOSTRING(ivar)//' )%ptr NOT INITIATED') -! END IF -! -! nsd(ivar) = domains(ivar)%ptr%getNSD() -! -! END DO -! -! IF (ANY(nsd .NE. nsd(1))) THEN -! CALL e%RaiseError(modName//"::"//myName//" - "// & -! & 'It seems that NSD (number of spatial dimensions) of domains are & -! & not identical') -! END IF -! -! CALL Display("Calling SetSparsity2 or SetSpartsity3 from DomainUtility") -! matProp = GetMatrixProp(mat) -! -! IF (TRIM(matProp) .EQ. "RECTANGLE") THEN -! CALL SetSparsity3(domains=domains, mat=mat) -! ELSE -! CALL SetSparsity2(domains=domains, mat=mat) -! END IF + 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') + 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 + +matProp = GetMatrixProp(mat) + +IF (TRIM(matProp) .EQ. "RECTANGLE") THEN + !FIXME: + ! CALL SetSparsity3(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//' - '// & @@ -110,6 +121,94 @@ END PROCEDURE obj_SetSparsity2 +!---------------------------------------------------------------------------- +! part1_obj_set_sparsity2 +!---------------------------------------------------------------------------- + +SUBROUTINE part1_obj_set_sparsity2(domains, mat) + CLASS(FEDomainPointer_), INTENT(IN) :: domains(:) + TYPE(CSRMatrix_), INTENT(INOUT) :: mat + + INTEGER(I4B) :: ivar, jvar, rowLBOUND, rowUBOUND, colLBOUND, colUBOUND + CLASS(FEDomain_), POINTER :: rowDomain, colDomain + CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh + TYPE(DomainConnectivity_) :: domainConn + INTEGER(I4B), POINTER :: nodeToNode(:) + CHARACTER(*), PARAMETER :: myName = "part1_obj_set_sparsity2()" + TYPE(BoundingBox_) :: row_box, col_box + LOGICAL(LGT) :: is_intersect, 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 + rowMesh => rowDomain%meshVolume + IF (.NOT. ASSOCIATED(rowMesh)) CYCLE + IF (rowMesh%isEmpty()) CYCLE + row_box = rowMesh%GetBoundingBox() + rowLBOUND = LBOUND(rowMesh%local_nptrs, 1) + rowUBOUND = UBOUND(rowMesh%local_nptrs, 1) + + DO jvar = 1, SIZE(domains) + + IF (isdebug) CALL Display("col domain = "//tostring(jvar)) + + colDomain => domains(jvar)%ptr + colMesh => colDomain%meshVolume + IF (.NOT. ASSOCIATED(colMesh)) CYCLE + IF (colMesh%isEmpty()) CYCLE + col_box = colMesh%getBoundingBox() + is_intersect = row_box.isIntersect.col_box + colLBOUND = LBOUND(colMesh%local_nptrs, 1) + colUBOUND = UBOUND(colMesh%local_nptrs, 1) + + CALL domainConn%DEALLOCATE() + !FIXME: + ! CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & + ! & domain2=colDomain) + nodeToNode => domainConn%GetNodeToNodePointer() + + IF (is_intersect) THEN + CALL rowMesh%SetSparsity( & + & mat=mat, & + & colMesh=colMesh, & + & nodeToNode=nodeToNode, & + & ivar=ivar, & + & jvar=jvar) + END IF + + END DO + END DO + + CALL SetSparsity(mat) + + NULLIFY (rowMesh, colMesh, rowDomain, colDomain, nodeToNode) + + !FIXME: + ! CALL domainConn%DEALLOCATE() + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END SUBROUTINE part1_obj_set_sparsity2 + !---------------------------------------------------------------------------- ! SetTotalMaterial !---------------------------------------------------------------------------- From 8a4923b6838017b0b737b6497af9aee54ea7e7cd Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 19:47:30 +0900 Subject: [PATCH 068/119] EASIFEM-99 Adding mesh facet data as separate class. Adding FEDomain_Class FEDomain is WIP --- src/modules/Domain/CMakeLists.txt | 27 +++- .../Domain/src/MeshFacetData_Class.F90 | 135 ++++++++++++++++++ src/submodules/Domain/CMakeLists.txt | 9 +- .../src/MeshFacetData_Class@Methods.F90 | 105 ++++++++++++++ 4 files changed, 271 insertions(+), 5 deletions(-) create mode 100644 src/modules/Domain/src/MeshFacetData_Class.F90 create mode 100644 src/submodules/Domain/src/MeshFacetData_Class@Methods.F90 diff --git a/src/modules/Domain/CMakeLists.txt b/src/modules/Domain/CMakeLists.txt index a3740de65..1fcebaef5 100644 --- a/src/modules/Domain/CMakeLists.txt +++ b/src/modules/Domain/CMakeLists.txt @@ -1,4 +1,23 @@ -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 + PRIVATE ${src_path}/FEDomain_Class.F90 + PRIVATE ${src_path}/MeshFacetData_Class.F90) diff --git a/src/modules/Domain/src/MeshFacetData_Class.F90 b/src/modules/Domain/src/MeshFacetData_Class.F90 new file mode 100644 index 000000000..7a869b0fd --- /dev/null +++ b/src/modules/Domain/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/submodules/Domain/CMakeLists.txt b/src/submodules/Domain/CMakeLists.txt index cd03a4255..f96d43d11 100644 --- a/src/submodules/Domain/CMakeLists.txt +++ b/src/submodules/Domain/CMakeLists.txt @@ -23,4 +23,11 @@ target_sources( ${src_path}/Domain_Class@IOMethods.F90 ${src_path}/Domain_Class@GetMethods.F90 ${src_path}/Domain_Class@SetMethods.F90 - ${src_path}/Domain_Class@MeshDataMethods.F90) + ${src_path}/Domain_Class@MeshDataMethods.F90 + ${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 + ${src_path}/MeshFacetData_Class@Methods.F90 +) diff --git a/src/submodules/Domain/src/MeshFacetData_Class@Methods.F90 b/src/submodules/Domain/src/MeshFacetData_Class@Methods.F90 new file mode 100644 index 000000000..4bacd8485 --- /dev/null +++ b/src/submodules/Domain/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 From fb9ac463dcb3487856fe2ad426f0e0c341dc1010 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 20:24:29 +0900 Subject: [PATCH 069/119] EASIFEM-116 Adding AbstractDomain_Class FeDomain_class is not a child at this moment. This is WIP --- src/modules/AbstractDomain/CMakeLists.txt | 19 + .../src/AbstractDomain_Class.F90 | 1316 +++++++++++++++++ src/modules/CMakeLists.txt | 9 + src/modules/Domain/CMakeLists.txt | 6 +- src/modules/FEDomain/CMakeLists.txt | 19 + .../src/FEDomain_Class.F90 | 0 src/modules/MeshFacetData/CMakeLists.txt | 19 + .../src/MeshFacetData_Class.F90 | 0 src/submodules/AbstractDomain/CMakeLists.txt | 25 + ...bstractDomain_Class@ConstructorMethods.F90 | 99 ++ .../src/AbstractDomain_Class@GetMethods.F90 | 545 +++++++ .../src/AbstractDomain_Class@IOMethods.F90 | 483 ++++++ .../AbstractDomain_Class@MeshDataMethods.F90 | 571 +++++++ .../src/AbstractDomain_Class@SetMethods.F90 | 349 +++++ src/submodules/CMakeLists.txt | 9 + src/submodules/Domain/CMakeLists.txt | 9 +- src/submodules/FEDomain/CMakeLists.txt | 25 + .../src/FEDomain_Class@ConstructorMethods.F90 | 0 .../src/FEDomain_Class@GetMethods.F90 | 0 .../src/FEDomain_Class@IOMethods.F90 | 0 .../src/FEDomain_Class@MeshDataMethods.F90 | 0 .../src/FEDomain_Class@SetMethods.F90 | 0 src/submodules/MeshFacetData/CMakeLists.txt | 20 + .../src/MeshFacetData_Class@Methods.F90 | 0 24 files changed, 3510 insertions(+), 13 deletions(-) create mode 100644 src/modules/AbstractDomain/CMakeLists.txt create mode 100644 src/modules/AbstractDomain/src/AbstractDomain_Class.F90 create mode 100644 src/modules/FEDomain/CMakeLists.txt rename src/modules/{Domain => FEDomain}/src/FEDomain_Class.F90 (100%) create mode 100644 src/modules/MeshFacetData/CMakeLists.txt rename src/modules/{Domain => MeshFacetData}/src/MeshFacetData_Class.F90 (100%) create mode 100644 src/submodules/AbstractDomain/CMakeLists.txt create mode 100644 src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 create mode 100644 src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 create mode 100644 src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 create mode 100644 src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 create mode 100644 src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 create mode 100644 src/submodules/FEDomain/CMakeLists.txt rename src/submodules/{Domain => FEDomain}/src/FEDomain_Class@ConstructorMethods.F90 (100%) rename src/submodules/{Domain => FEDomain}/src/FEDomain_Class@GetMethods.F90 (100%) rename src/submodules/{Domain => FEDomain}/src/FEDomain_Class@IOMethods.F90 (100%) rename src/submodules/{Domain => FEDomain}/src/FEDomain_Class@MeshDataMethods.F90 (100%) rename src/submodules/{Domain => FEDomain}/src/FEDomain_Class@SetMethods.F90 (100%) create mode 100644 src/submodules/MeshFacetData/CMakeLists.txt rename src/submodules/{Domain => MeshFacetData}/src/MeshFacetData_Class@Methods.F90 (100%) 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..89ae85cce --- /dev/null +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -0,0 +1,1316 @@ +! 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 + +IMPLICIT NONE +PRIVATE + +PUBLIC :: AbstractDomain_ +PUBLIC :: AbstractDomainPointer_ +PUBLIC :: AbstractDomainDeallocate +PUBLIC :: AbstractDomainSetSparsity + +CHARACTER(*), PARAMETER :: modName = "AbstractDomain_Class" + +!---------------------------------------------------------------------------- +! AbstractDomain_ +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 18 June 2021 +! summary: AbstractDomain_ contains finite element mesh data of a domain +! +!{!pages/docs-api/AbstractDomain/AbstractDomain_.md!} + +TYPE, ABSTRACT :: AbstractDomain_ + PRIVATE + 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 + + 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 + + ! 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 + PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => obj_IsElementPresent + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => obj_GetConnectivity + PROCEDURE, PASS(obj) :: obj_GetNodeToElements1 + PROCEDURE, PASS(obj) :: obj_GetNodeToElements2 + GENERIC, PUBLIC :: GetNodeToElements => & + & obj_GetNodeToElements1, & + & obj_GetNodeToElements2 + 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) :: obj_GetLocalNodeNumber1 + PROCEDURE, PASS(obj) :: obj_GetLocalNodeNumber2 + GENERIC, PUBLIC :: & + & GetLocalNodeNumber => & + & obj_GetLocalNodeNumber1, & + & obj_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 + GENERIC, PUBLIC :: GetNodeCoord => GetNodeCoord1, GetNodeCoord2 + !! 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) :: 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) :: 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. + + ! SET: + ! @SetMethods + 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) :: 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 + +!---------------------------------------------------------------------------- +! 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: 2021-11-12 +! update: 2021-11-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 + +!---------------------------------------------------------------------------- +! 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(IN) :: obj + 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(IN) :: obj + INTEGER(I4B), INTENT(IN) :: globalNode(:) + INTEGER(I4B), ALLOCATABLE :: ans(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END FUNCTION 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@getMethod +!---------------------------------------------------------------------------- + +!> 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@getMethod +!---------------------------------------------------------------------------- + +!> 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. +! - If `dim` and `tag` are absent then this routine returns the nodal +! coordinates of the entire domain +! - If `dim` and `tag` are present then the routine selects the mesh and +! returns its nodal coordinates + +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) is equal to nsd + !! Size(nodeCoord, 2) is equal to the size(globalNode) + INTEGER(I4B), INTENT(IN) :: globalNode(:) + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_GetNodeCoord2 +END INTERFACE + +!---------------------------------------------------------------------------- +! getNodeCoordPointer@getMethod +!---------------------------------------------------------------------------- + +!> 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@getMethod +!---------------------------------------------------------------------------- + +!> 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@getMethod +!---------------------------------------------------------------------------- + +!> 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, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] + END SUBROUTINE obj_GetNptrs_ +END INTERFACE + +!---------------------------------------------------------------------------- +! getNptrs@getMethod +!---------------------------------------------------------------------------- + +!> 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@getMethod +!---------------------------------------------------------------------------- + +!> 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) RESULT(ans) + CLASS(AbstractDomain_), INTENT(IN) :: obj + 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 + +!---------------------------------------------------------------------------- +! 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(IN) :: 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(IN) :: 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 + INTEGER(I4B), INTENT(IN) :: entityNum + INTEGER(I4B), INTENT(IN) :: medium + INTEGER(I4B), INTENT(IN) :: material + END SUBROUTINE obj_SetMaterial +END INTERFACE + +!---------------------------------------------------------------------------- +! SetNodeCoord@SetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-02-24 +! summary: SetNodeCoord + +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 + +!---------------------------------------------------------------------------- +! 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/CMakeLists.txt b/src/modules/CMakeLists.txt index 34a2c4b11..f9248ffa7 100644 --- a/src/modules/CMakeLists.txt +++ b/src/modules/CMakeLists.txt @@ -105,6 +105,15 @@ 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) + # Domain include(${CMAKE_CURRENT_LIST_DIR}/Domain/CMakeLists.txt) diff --git a/src/modules/Domain/CMakeLists.txt b/src/modules/Domain/CMakeLists.txt index 1fcebaef5..97f39af87 100644 --- a/src/modules/Domain/CMakeLists.txt +++ b/src/modules/Domain/CMakeLists.txt @@ -16,8 +16,4 @@ # set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") -target_sources( - ${PROJECT_NAME} - PRIVATE ${src_path}/Domain_Class.F90 - PRIVATE ${src_path}/FEDomain_Class.F90 - PRIVATE ${src_path}/MeshFacetData_Class.F90) +target_sources(${PROJECT_NAME} PRIVATE ${src_path}/Domain_Class.F90) 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/Domain/src/FEDomain_Class.F90 b/src/modules/FEDomain/src/FEDomain_Class.F90 similarity index 100% rename from src/modules/Domain/src/FEDomain_Class.F90 rename to src/modules/FEDomain/src/FEDomain_Class.F90 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/Domain/src/MeshFacetData_Class.F90 b/src/modules/MeshFacetData/src/MeshFacetData_Class.F90 similarity index 100% rename from src/modules/Domain/src/MeshFacetData_Class.F90 rename to src/modules/MeshFacetData/src/MeshFacetData_Class.F90 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..dff3392f7 --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 @@ -0,0 +1,99 @@ +! 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 +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) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif +END PROCEDURE obj_Initiate + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_Deallocate +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) + +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) +END PROCEDURE obj_Deallocate + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- +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..b9a1c3f20 --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -0,0 +1,545 @@ +! 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 +USE F95_BLAS, ONLY: Copy +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 +INTEGER(I4B) :: dim0 + +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 + +END PROCEDURE obj_GetConnectivity + +!---------------------------------------------------------------------------- +! getNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements1 +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 +END PROCEDURE obj_GetNodeToElements1 + +!---------------------------------------------------------------------------- +! getNodeToElements +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNodeToElements2 +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 +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 +#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 +#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 +#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 +#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)) +INTEGER(I4B) :: nsd +localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) +nsd = SIZE(nodeCoord, 1) +nodeCoord = obj%nodeCoord(1:nsd, localNode) +END PROCEDURE obj_GetNodeCoord2 + +!---------------------------------------------------------------------------- +! 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_ + +!---------------------------------------------------------------------------- +! 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 +REAL(DFP) :: lim(6) +INTEGER(I4B) :: nsd +!> main +lim = 0.0_DFP +nsd = SIZE(obj%nodeCoord, 1) +lim(1:nsd * 2:2) = MINVAL(obj%nodeCoord(1:nsd, :), dim=2) +lim(2:nsd * 2:2) = MAXVAL(obj%nodeCoord(1:nsd, :), dim=2) +CALL Initiate(obj=ans, nsd=3_I4B, lim=lim) +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 +! IF (PRESENT(imeshFacetData)) THEN +! IF (ALLOCATED(obj%meshFacetData)) THEN +! IF (obj%meshFacetData(imeshFacetData)%isInitiated()) THEN +! ans = obj%meshFacetData(imeshFacetData)%SIZE() +! ELSE +! ans = 0 +! END IF +! ELSE +! ans = 0 +! END IF +! ELSE +! IF (ALLOCATED(obj%meshFacetData)) THEN +! ans = SIZE(obj%meshFacetData) +! ELSE +! ans = 0 +! END IF +! END IF +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 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +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..f11f9ca1d --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 @@ -0,0 +1,483 @@ +! 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 + +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..395d88b1f --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 @@ -0,0 +1,571 @@ +! 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 BaseMethod +USE DomainConnectivity_Class +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! 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..772a612cd --- /dev/null +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -0,0 +1,349 @@ +! 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 BaseMethod +USE FEMesh_Class, ONLY: FEMesh_ +USE DomainConnectivity_Class, ONLY: DomainConnectivity_ +! USE DomainUtility +USE CSRMatrix_Method +USE BoundingBox_Method +USE Display_Method +USE InputUtility +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! SetSparsity +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetSparsity1 +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" + +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 +CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" +INTEGER(I4B) :: ivar, nsd(SIZE(domains)) +CHARACTER(:), ALLOCATABLE :: matProp +LOGICAL(LGT) :: problem + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +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') + 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 + +matProp = GetMatrixProp(mat) + +IF (TRIM(matProp) .EQ. "RECTANGLE") THEN + !FIXME: + ! CALL SetSparsity3(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 + + INTEGER(I4B) :: ivar, jvar, rowLBOUND, rowUBOUND, colLBOUND, colUBOUND + CLASS(AbstractDomain_), POINTER :: rowDomain, colDomain + CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh + TYPE(DomainConnectivity_) :: domainConn + INTEGER(I4B), POINTER :: nodeToNode(:) + CHARACTER(*), PARAMETER :: myName = "part1_obj_set_sparsity2()" + TYPE(BoundingBox_) :: row_box, col_box + LOGICAL(LGT) :: is_intersect, 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 + rowMesh => rowDomain%meshVolume + IF (.NOT. ASSOCIATED(rowMesh)) CYCLE + IF (rowMesh%isEmpty()) CYCLE + row_box = rowMesh%GetBoundingBox() + rowLBOUND = LBOUND(rowMesh%local_nptrs, 1) + rowUBOUND = UBOUND(rowMesh%local_nptrs, 1) + + DO jvar = 1, SIZE(domains) + + IF (isdebug) CALL Display("col domain = "//tostring(jvar)) + + colDomain => domains(jvar)%ptr + colMesh => colDomain%meshVolume + IF (.NOT. ASSOCIATED(colMesh)) CYCLE + IF (colMesh%isEmpty()) CYCLE + col_box = colMesh%getBoundingBox() + is_intersect = row_box.isIntersect.col_box + colLBOUND = LBOUND(colMesh%local_nptrs, 1) + colUBOUND = UBOUND(colMesh%local_nptrs, 1) + + CALL domainConn%DEALLOCATE() + !FIXME: + ! CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & + ! & domain2=colDomain) + nodeToNode => domainConn%GetNodeToNodePointer() + + IF (is_intersect) THEN + CALL rowMesh%SetSparsity( & + & mat=mat, & + & colMesh=colMesh, & + & nodeToNode=nodeToNode, & + & ivar=ivar, & + & jvar=jvar) + END IF + + END DO + END DO + + CALL SetSparsity(mat) + + NULLIFY (rowMesh, colMesh, rowDomain, colDomain, nodeToNode) + + !FIXME: + ! CALL domainConn%DEALLOCATE() + +#ifdef DEBUG_VER + CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + +END SUBROUTINE part1_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 +CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') + +! meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) +! CALL meshptr%SetMaterial(medium=medium, material=material) +! meshptr => NULL() +END PROCEDURE obj_SetMaterial + +!---------------------------------------------------------------------------- +! SetNodeCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetNodeCoord1 +CHARACTER(*), PARAMETER :: myName = "obj_SetNodeCoord1()" +REAL(DFP) :: scale0 +LOGICAL(LGT) :: problem + +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 + +scale0 = Input(option=scale, default=1.0_DFP) + +IF (PRESENT(addContribution)) THEN + obj%nodeCoord = obj%nodeCoord + scale * nodeCoord +ELSE + obj%nodeCoord = nodeCoord +END IF + +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/CMakeLists.txt b/src/submodules/CMakeLists.txt index 31c5b103d..db16663ea 100644 --- a/src/submodules/CMakeLists.txt +++ b/src/submodules/CMakeLists.txt @@ -69,6 +69,15 @@ 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) + # Domain include(${CMAKE_CURRENT_LIST_DIR}/Domain/CMakeLists.txt) diff --git a/src/submodules/Domain/CMakeLists.txt b/src/submodules/Domain/CMakeLists.txt index f96d43d11..cd03a4255 100644 --- a/src/submodules/Domain/CMakeLists.txt +++ b/src/submodules/Domain/CMakeLists.txt @@ -23,11 +23,4 @@ target_sources( ${src_path}/Domain_Class@IOMethods.F90 ${src_path}/Domain_Class@GetMethods.F90 ${src_path}/Domain_Class@SetMethods.F90 - ${src_path}/Domain_Class@MeshDataMethods.F90 - ${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 - ${src_path}/MeshFacetData_Class@Methods.F90 -) + ${src_path}/Domain_Class@MeshDataMethods.F90) 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/Domain/src/FEDomain_Class@ConstructorMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 similarity index 100% rename from src/submodules/Domain/src/FEDomain_Class@ConstructorMethods.F90 rename to src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 similarity index 100% rename from src/submodules/Domain/src/FEDomain_Class@GetMethods.F90 rename to src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 similarity index 100% rename from src/submodules/Domain/src/FEDomain_Class@IOMethods.F90 rename to src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 similarity index 100% rename from src/submodules/Domain/src/FEDomain_Class@MeshDataMethods.F90 rename to src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 diff --git a/src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 similarity index 100% rename from src/submodules/Domain/src/FEDomain_Class@SetMethods.F90 rename to src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 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/Domain/src/MeshFacetData_Class@Methods.F90 b/src/submodules/MeshFacetData/src/MeshFacetData_Class@Methods.F90 similarity index 100% rename from src/submodules/Domain/src/MeshFacetData_Class@Methods.F90 rename to src/submodules/MeshFacetData/src/MeshFacetData_Class@Methods.F90 From 85d41331cbc713264f8a427cbc4f6671e3db0818 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 20:29:44 +0900 Subject: [PATCH 070/119] EASIFEM-116 Updates in FEDomain and ABstractDomain - now fedomain is child of abstractdomain - this is WIP --- src/modules/FEDomain/src/FEDomain_Class.F90 | 1260 +---------------- .../src/FEDomain_Class@ConstructorMethods.F90 | 71 +- .../src/FEDomain_Class@GetMethods.F90 | 526 ------- .../FEDomain/src/FEDomain_Class@IOMethods.F90 | 468 ------ .../src/FEDomain_Class@MeshDataMethods.F90 | 555 -------- .../src/FEDomain_Class@SetMethods.F90 | 333 ----- 6 files changed, 3 insertions(+), 3210 deletions(-) diff --git a/src/modules/FEDomain/src/FEDomain_Class.F90 b/src/modules/FEDomain/src/FEDomain_Class.F90 index 4ddfc5957..759537e09 100644 --- a/src/modules/FEDomain/src/FEDomain_Class.F90 +++ b/src/modules/FEDomain/src/FEDomain_Class.F90 @@ -23,13 +23,8 @@ ! summary: This module contains methods for domain data type MODULE FEDomain_Class -USE GlobalData, ONLY: DFP, I4B, LGT -USE BaseType, ONLY: CSRSparsity_, CSRMatrix_, BoundingBox_ -USE String_Class, ONLY: String -USE AbstractMesh_Class, ONLY: AbstractMesh_ +USE AbstractDomain_Class, ONLY: AbstractDomain_ USE HDF5File_Class, ONLY: HDF5File_ -USE tomlf, ONLY: toml_table -USE TxtFile_Class, ONLY: TxtFile_ USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE @@ -37,9 +32,7 @@ MODULE FEDomain_Class PUBLIC :: FEDomain_ PUBLIC :: FEDomainPointer_ -PUBLIC :: FEDomainDeallocate PUBLIC :: FEDomain_Pointer -PUBLIC :: FEDomainSetSparsity CHARACTER(*), PARAMETER :: modName = "FEDomain_Class" @@ -53,227 +46,7 @@ MODULE FEDomain_Class ! !{!pages/docs-api/FEDomain/FEDomain_.md!} -TYPE :: FEDomain_ - PRIVATE - LOGICAL(LGT), PUBLIC :: 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), PUBLIC :: maxNptrs = 0 - !! Largest node number in the domain - INTEGER(I4B), PUBLIC :: 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), PUBLIC :: maxElemNum = 0 - !! Largest element number in the domain - INTEGER(I4B), PUBLIC :: 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, PUBLIC :: 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 - - 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 - !! TODO Rename Deallocate to Deallocate - FINAL :: obj_Final - !! Finalizer for domain - - ! 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 - PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => obj_IsElementPresent - PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => obj_GetConnectivity - PROCEDURE, PASS(obj) :: obj_GetNodeToElements1 - PROCEDURE, PASS(obj) :: obj_GetNodeToElements2 - GENERIC, PUBLIC :: GetNodeToElements => & - & obj_GetNodeToElements1, & - & obj_GetNodeToElements2 - 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) :: obj_GetLocalNodeNumber1 - PROCEDURE, PASS(obj) :: obj_GetLocalNodeNumber2 - GENERIC, PUBLIC :: & - & GetLocalNodeNumber => & - & obj_GetLocalNodeNumber1, & - & obj_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 - GENERIC, PUBLIC :: GetNodeCoord => GetNodeCoord1, GetNodeCoord2 - !! 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) :: 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) :: 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. - - ! SET: - ! @SetMethods - 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) :: 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 - +TYPE, EXTENDS(AbstractDomain_) :: FEDomain_ END TYPE FEDomain_ !---------------------------------------------------------------------------- @@ -284,40 +57,6 @@ MODULE FEDomain_Class CLASS(FEDomain_), POINTER :: ptr => NULL() END TYPE FEDomainPointer_ -!---------------------------------------------------------------------------- -! Initiate@ConstructorMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-28 -! summary: Initiate the instance of [[FEDomain_]] object - -INTERFACE - MODULE SUBROUTINE obj_Initiate(obj, hdf5, group) - CLASS(FEDomain_), INTENT(INOUT) :: obj - !! FEDomainData 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 FEDomain object - -INTERFACE FEDomainDeallocate - MODULE SUBROUTINE obj_Deallocate(obj) - CLASS(FEDomain_), INTENT(INOUT) :: obj - !! FEDomain object - END SUBROUTINE obj_Deallocate -END INTERFACE FEDomainDeallocate - !---------------------------------------------------------------------------- ! Final@ConstructorMethods !---------------------------------------------------------------------------- @@ -348,1001 +87,6 @@ MODULE FUNCTION obj_Constructor_1(hdf5, group) RESULT(ans) END FUNCTION obj_Constructor_1 END INTERFACE FEDomain_Pointer -!---------------------------------------------------------------------------- -! 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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: 2021-11-12 -! update: 2021-11-12 -! summary: Returns the connectivity vector of a given element number - -INTERFACE - MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim, islocal) & - & RESULT(ans) - CLASS(FEDomain_), 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 - -!---------------------------------------------------------------------------- -! 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(FEDomain_), INTENT(IN) :: obj - 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(FEDomain_), INTENT(IN) :: obj - INTEGER(I4B), INTENT(IN) :: globalNode(:) - INTEGER(I4B), ALLOCATABLE :: ans(:) - LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal - END FUNCTION 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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 FEDomain -! - 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 FEDomain_GetTotalElements -! -!@endtodo - -INTERFACE - MODULE FUNCTION obj_GetTotalElements(obj, dim) RESULT(ans) - CLASS(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(IN) :: obj - INTEGER(I4B), INTENT(IN) :: dim - !! dimension of mesh entity - CLASS(AbstractMesh_), POINTER :: ans - END FUNCTION obj_GetMeshPointer1 -END INTERFACE - -!---------------------------------------------------------------------------- -! getNodeCoord@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), INTENT(IN) :: obj - REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) - !! make sure nodeCoord is allocated - END SUBROUTINE obj_GetNodeCoord -END INTERFACE - -!---------------------------------------------------------------------------- -! getNodeCoord@getMethod -!---------------------------------------------------------------------------- - -!> 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. -! - If `dim` and `tag` are absent then this routine returns the nodal -! coordinates of the entire domain -! - If `dim` and `tag` are present then the routine selects the mesh and -! returns its nodal coordinates - -INTERFACE - MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode, & - & islocal) - CLASS(FEDomain_), INTENT(IN) :: obj - REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) - !! It should be allocated by the user. - !! SIZE(nodeCoord, 1) is equal to nsd - !! Size(nodeCoord, 2) is equal to the size(globalNode) - INTEGER(I4B), INTENT(IN) :: globalNode(:) - LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal - END SUBROUTINE obj_GetNodeCoord2 -END INTERFACE - -!---------------------------------------------------------------------------- -! getNodeCoordPointer@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), TARGET, INTENT(IN) :: obj - REAL(DFP), POINTER :: ans(:, :) - END FUNCTION obj_GetNodeCoordPointer -END INTERFACE - -!---------------------------------------------------------------------------- -! GetNptrs@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), 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@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), INTENT(IN) :: obj - INTEGER(I4B), INTENT(INOUT) :: nptrs(:) - INTEGER(I4B), INTENT(IN) :: dim - !! dim = [0, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] - END SUBROUTINE obj_GetNptrs_ -END INTERFACE - -!---------------------------------------------------------------------------- -! getNptrs@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), 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@getMethod -!---------------------------------------------------------------------------- - -!> 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(FEDomain_), 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) RESULT(ans) - CLASS(FEDomain_), INTENT(IN) :: obj - 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(IN) :: obj - INTEGER(I4B), INTENT(IN) :: dim - INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION obj_GetUniqueElemType -END INTERFACE - -!---------------------------------------------------------------------------- -! SetSparsity@setMethods -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 2024-03-31 -! summary: Set sparsity in [[CSRMatrix_]] from [[FEDomain_]] - -INTERFACE - MODULE SUBROUTINE obj_SetSparsity1(obj, mat) - CLASS(FEDomain_), INTENT(IN) :: 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 [[FEDomain_]] - -INTERFACE FEDomainSetSparsity - MODULE SUBROUTINE obj_SetSparsity2(domains, mat) - CLASS(FEDomainPointer_), INTENT(IN) :: domains(:) - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - END SUBROUTINE obj_SetSparsity2 -END INTERFACE FEDomainSetSparsity - -!---------------------------------------------------------------------------- -! 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: dim - INTEGER(I4B), INTENT(IN) :: entityNum - INTEGER(I4B), INTENT(IN) :: medium - INTEGER(I4B), INTENT(IN) :: material - END SUBROUTINE obj_SetMaterial -END INTERFACE - -!---------------------------------------------------------------------------- -! SetNodeCoord@SetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2023-02-24 -! summary: SetNodeCoord - -INTERFACE - MODULE SUBROUTINE obj_SetNodeCoord1(obj, nodeCoord, scale, & - & addContribution) - CLASS(FEDomain_), 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(FEDomain_), 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 - -!---------------------------------------------------------------------------- -! 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj - END SUBROUTINE obj_SetFacetElementType -END INTERFACE - -!---------------------------------------------------------------------------- -! SetFEDomainFacetElement@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(FEDomain_), 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(FEDomain_), 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(FEDomain_), INTENT(INOUT) :: obj - END SUBROUTINE obj_SetMeshFacetElement -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 index cc49df0e9..3bf309f1e 100644 --- a/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 +++ b/src/submodules/FEDomain/src/FEDomain_Class@ConstructorMethods.F90 @@ -20,79 +20,9 @@ ! summary: This submodule contains methods for domain object SUBMODULE(FEDomain_Class) ConstructorMethods -USE ReallocateUtility -USE CSRSparsity_Method IMPLICIT NONE CONTAINS -!---------------------------------------------------------------------------- -! Initiate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_Initiate -#ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "FEDomain_Initiate()" -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -CALL obj%DEALLOCATE() - -CALL obj%IMPORT(hdf5=hdf5, group=group) - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif -END PROCEDURE obj_Initiate - -!---------------------------------------------------------------------------- -! Deallocate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_Deallocate -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) - -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) -END PROCEDURE obj_Deallocate - !---------------------------------------------------------------------------- ! Final !---------------------------------------------------------------------------- @@ -113,4 +43,5 @@ !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- + END SUBMODULE ConstructorMethods diff --git a/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 index bc8eb9b50..6df326abb 100644 --- a/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 +++ b/src/submodules/FEDomain/src/FEDomain_Class@GetMethods.F90 @@ -17,529 +17,3 @@ !> authors: Vikas Sharma, Ph. D. ! date: 18 June 2021 ! summary: This submodule contains methods for domain object - -SUBMODULE(FEDomain_Class) GetMethods -USE ReallocateUtility -USE InputUtility -USE BoundingBox_Method -USE F95_BLAS, ONLY: Copy -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 -INTEGER(I4B) :: dim0 - -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 - -END PROCEDURE obj_GetConnectivity - -!---------------------------------------------------------------------------- -! getNodeToElements -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_GetNodeToElements1 -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 -END PROCEDURE obj_GetNodeToElements1 - -!---------------------------------------------------------------------------- -! getNodeToElements -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_GetNodeToElements2 -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 -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 -#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 -#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 -#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 -#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)) -INTEGER(I4B) :: nsd -localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) -nsd = SIZE(nodeCoord, 1) -nodeCoord = obj%nodeCoord(1:nsd, localNode) -END PROCEDURE obj_GetNodeCoord2 - -!---------------------------------------------------------------------------- -! 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_ - -!---------------------------------------------------------------------------- -! 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 -REAL(DFP) :: lim(6) -INTEGER(I4B) :: nsd -!> main -lim = 0.0_DFP -nsd = SIZE(obj%nodeCoord, 1) -lim(1:nsd * 2:2) = MINVAL(obj%nodeCoord(1:nsd, :), dim=2) -lim(2:nsd * 2:2) = MAXVAL(obj%nodeCoord(1:nsd, :), dim=2) -CALL Initiate(obj=ans, nsd=3_I4B, lim=lim) -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 -! IF (PRESENT(imeshFacetData)) THEN -! IF (ALLOCATED(obj%meshFacetData)) THEN -! IF (obj%meshFacetData(imeshFacetData)%isInitiated()) THEN -! ans = obj%meshFacetData(imeshFacetData)%SIZE() -! ELSE -! ans = 0 -! END IF -! ELSE -! ans = 0 -! END IF -! ELSE -! IF (ALLOCATED(obj%meshFacetData)) THEN -! ans = SIZE(obj%meshFacetData) -! ELSE -! ans = 0 -! END IF -! END IF -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 - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -END SUBMODULE GetMethods diff --git a/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 index 54227f3cd..e578e29a2 100644 --- a/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 +++ b/src/submodules/FEDomain/src/FEDomain_Class@IOMethods.F90 @@ -13,471 +13,3 @@ ! ! You should have received a copy of the GNU General Public License ! along with this program. If not, see - -SUBMODULE(FEDomain_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, "FEDomain_::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 - -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, "FEDomain_::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 = "FEDomain_Import()" - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & 'Calling FEDomainImportCheckErr()') -#endif - -CALL FEDomainImportCheckErr(obj=obj, hdf5=hdf5, myName=myName) - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & 'Calling FEDomainImportMetaData') -#endif - -CALL FEDomainImportMetaData(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 - -!---------------------------------------------------------------------------- -! FEDomainImportCheckErr -!---------------------------------------------------------------------------- - -SUBROUTINE FEDomainImportCheckErr(obj, hdf5, myName) - CLASS(FEDomain_), 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] :: FEDomain_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 FEDomainImportCheckErr - -!---------------------------------------------------------------------------- -! FEDomainImportMetaData -!---------------------------------------------------------------------------- - -SUBROUTINE FEDomainImportMetaData(obj, hdf5, group, myName) - CLASS(FEDomain_), 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 FEDomainImportMetaData - -!---------------------------------------------------------------------------- -! ImportFromToml -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_ImportFromToml1 -CHARACTER(*), PARAMETER :: myName = "FEDomain_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 = "FEDomain_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), "FEDomain 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/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 index 8318b9c6b..63b7886bf 100644 --- a/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 +++ b/src/submodules/FEDomain/src/FEDomain_Class@MeshDataMethods.F90 @@ -14,558 +14,3 @@ ! You should have received a copy of the GNU General Public License ! along with this program. If not, see ! - -SUBMODULE(FEDomain_Class) MeshDataMethods -USE BaseMethod -USE DomainConnectivity_Class -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! 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/FEDomain/src/FEDomain_Class@SetMethods.F90 b/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 index 364c9949d..63b7886bf 100644 --- a/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 +++ b/src/submodules/FEDomain/src/FEDomain_Class@SetMethods.F90 @@ -14,336 +14,3 @@ ! You should have received a copy of the GNU General Public License ! along with this program. If not, see ! - -SUBMODULE(FEDomain_Class) SetMethods -! USE BaseMethod -USE FEMesh_Class, ONLY: FEMesh_ -USE DomainConnectivity_Class, ONLY: DomainConnectivity_ -! USE DomainUtility -USE CSRMatrix_Method -USE BoundingBox_Method -USE Display_Method -USE InputUtility -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! SetSparsity -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetSparsity1 -#ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" - -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 -CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" -INTEGER(I4B) :: ivar, nsd(SIZE(domains)) -CHARACTER(:), ALLOCATABLE :: matProp -LOGICAL(LGT) :: problem - -#ifdef DEBUG_VER -CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[START] ') -#endif - -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') - 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 - -matProp = GetMatrixProp(mat) - -IF (TRIM(matProp) .EQ. "RECTANGLE") THEN - !FIXME: - ! CALL SetSparsity3(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(FEDomainPointer_), INTENT(IN) :: domains(:) - TYPE(CSRMatrix_), INTENT(INOUT) :: mat - - INTEGER(I4B) :: ivar, jvar, rowLBOUND, rowUBOUND, colLBOUND, colUBOUND - CLASS(FEDomain_), POINTER :: rowDomain, colDomain - CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh - TYPE(DomainConnectivity_) :: domainConn - INTEGER(I4B), POINTER :: nodeToNode(:) - CHARACTER(*), PARAMETER :: myName = "part1_obj_set_sparsity2()" - TYPE(BoundingBox_) :: row_box, col_box - LOGICAL(LGT) :: is_intersect, 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 - rowMesh => rowDomain%meshVolume - IF (.NOT. ASSOCIATED(rowMesh)) CYCLE - IF (rowMesh%isEmpty()) CYCLE - row_box = rowMesh%GetBoundingBox() - rowLBOUND = LBOUND(rowMesh%local_nptrs, 1) - rowUBOUND = UBOUND(rowMesh%local_nptrs, 1) - - DO jvar = 1, SIZE(domains) - - IF (isdebug) CALL Display("col domain = "//tostring(jvar)) - - colDomain => domains(jvar)%ptr - colMesh => colDomain%meshVolume - IF (.NOT. ASSOCIATED(colMesh)) CYCLE - IF (colMesh%isEmpty()) CYCLE - col_box = colMesh%getBoundingBox() - is_intersect = row_box.isIntersect.col_box - colLBOUND = LBOUND(colMesh%local_nptrs, 1) - colUBOUND = UBOUND(colMesh%local_nptrs, 1) - - CALL domainConn%DEALLOCATE() - !FIXME: - ! CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & - ! & domain2=colDomain) - nodeToNode => domainConn%GetNodeToNodePointer() - - IF (is_intersect) THEN - CALL rowMesh%SetSparsity( & - & mat=mat, & - & colMesh=colMesh, & - & nodeToNode=nodeToNode, & - & ivar=ivar, & - & jvar=jvar) - END IF - - END DO - END DO - - CALL SetSparsity(mat) - - NULLIFY (rowMesh, colMesh, rowDomain, colDomain, nodeToNode) - - !FIXME: - ! CALL domainConn%DEALLOCATE() - -#ifdef DEBUG_VER - CALL e%RaiseInformation(modName//'::'//myName//' - '// & - & '[END] ') -#endif - -END SUBROUTINE part1_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 -CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') - -! meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) -! CALL meshptr%SetMaterial(medium=medium, material=material) -! meshptr => NULL() -END PROCEDURE obj_SetMaterial - -!---------------------------------------------------------------------------- -! SetNodeCoord -!---------------------------------------------------------------------------- - -MODULE PROCEDURE obj_SetNodeCoord1 -CHARACTER(*), PARAMETER :: myName = "obj_SetNodeCoord1()" -REAL(DFP) :: scale0 -LOGICAL(LGT) :: problem - -problem = .NOT. ALLOCATED(obj%nodeCoord) -IF (problem) THEN - CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[INTERNAL ERROR] :: FEDomain_::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 - -scale0 = Input(option=scale, default=1.0_DFP) - -IF (PRESENT(addContribution)) THEN - obj%nodeCoord = obj%nodeCoord + scale * nodeCoord -ELSE - obj%nodeCoord = nodeCoord -END IF - -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 From c5c91ea5f849579ed003f4e70243029ae5355fbd Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 20:40:36 +0900 Subject: [PATCH 071/119] EASIFEM-116 Minor formatting in abstract domain class. This is WIP. --- .../src/AbstractDomain_Class.F90 | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 89ae85cce..88542852f 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -47,7 +47,7 @@ MODULE AbstractDomain_Class !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 18 June 2021 +! date: 2024-03-31 ! summary: AbstractDomain_ contains finite element mesh data of a domain ! !{!pages/docs-api/AbstractDomain/AbstractDomain_.md!} @@ -273,7 +273,7 @@ MODULE AbstractDomain_Class END TYPE AbstractDomain_ !---------------------------------------------------------------------------- -! AbstractDomainPointer +! AbstractDomainPointer !---------------------------------------------------------------------------- TYPE :: AbstractDomainPointer_ @@ -300,7 +300,7 @@ END SUBROUTINE obj_Initiate END INTERFACE !---------------------------------------------------------------------------- -! Deallocate@ConstructorMethods +! Deallocate@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -395,7 +395,7 @@ END SUBROUTINE obj_Display END INTERFACE !---------------------------------------------------------------------------- -! DisplayDomainInfo@IOMethods +! DisplayDomainInfo@IOMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -807,7 +807,7 @@ END FUNCTION obj_GetMeshPointer1 END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoord@getMethod +! getNodeCoord@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -828,7 +828,7 @@ END SUBROUTINE obj_GetNodeCoord END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoord@getMethod +! getNodeCoord@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -858,7 +858,7 @@ END SUBROUTINE obj_GetNodeCoord2 END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoordPointer@getMethod +! getNodeCoordPointer@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -879,7 +879,7 @@ END FUNCTION obj_GetNodeCoordPointer END INTERFACE !---------------------------------------------------------------------------- -! GetNptrs@getMethod +! GetNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -900,7 +900,7 @@ END FUNCTION obj_GetNptrs END INTERFACE !---------------------------------------------------------------------------- -! GetNptrs@getMethod +! GetNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -921,7 +921,7 @@ END SUBROUTINE obj_GetNptrs_ END INTERFACE !---------------------------------------------------------------------------- -! getNptrs@getMethod +! GetInternalNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -942,7 +942,7 @@ END FUNCTION obj_GetInternalNptrs END INTERFACE !---------------------------------------------------------------------------- -! getNSD@getMethod +! GetNSD@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -957,7 +957,7 @@ END FUNCTION obj_GetNSD END INTERFACE !---------------------------------------------------------------------------- -! getBoundingBox@GetMethods +! GetBoundingBox@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -972,7 +972,7 @@ END FUNCTION obj_GetBoundingBox END INTERFACE !---------------------------------------------------------------------------- -! getTotalMeshFacetData@GetMethods +! GetTotalMeshFacetData@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1052,7 +1052,7 @@ END SUBROUTINE obj_SetSparsity2 END INTERFACE AbstractDomainSetSparsity !---------------------------------------------------------------------------- -! setTotalMaterial@setMethods +! SetTotalMaterial@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1246,7 +1246,7 @@ END SUBROUTINE obj_SetFacetElementType END INTERFACE !---------------------------------------------------------------------------- -! SetAbstractDomainFacetElement@MeshDataMethods +! SetAbstractDomainFacetElement@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. From a427836ff77abb2d9d0d91a968354ce980928cd6 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sun, 31 Mar 2024 22:59:20 +0900 Subject: [PATCH 072/119] EASIFEM-188 Removing meshfacetdata field from domain_class --- src/modules/Domain/src/Domain_Class.F90 | 109 +----------------- .../src/Domain_Class@ConstructorMethods.F90 | 35 ------ .../Domain/src/Domain_Class@IOMethods.F90 | 47 -------- 3 files changed, 1 insertion(+), 190 deletions(-) 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/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 !---------------------------------------------------------------------------- From ad371ac769d99115d9f2dd6f504773d8655e2b01 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 8 Apr 2024 15:49:00 +0900 Subject: [PATCH 073/119] Minor formatting in plplot Minor formatting in plplot --- src/modules/PLPlot/src/PLPlot_Class.F90 | 2 +- .../src/PLPlot_Class@LinePlotMethods.F90 | 410 +++++++++--------- 2 files changed, 206 insertions(+), 206 deletions(-) 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/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 From b448d86354634850c44a8f95373695420a4c7206 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 8 Apr 2024 23:39:33 +0900 Subject: [PATCH 074/119] Updates in AbstractDomain_Class Adding GetParam method --- .../src/AbstractDomain_Class.F90 | 43 +++++++++++++++++++ .../src/AbstractDomain_Class@GetMethods.F90 | 29 +++++++++++++ 2 files changed, 72 insertions(+) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 88542852f..89b9ff87f 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -224,6 +224,8 @@ MODULE AbstractDomain_Class !! 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, PASS(obj) :: SetSparsity1 => obj_SetSparsity1 @@ -1021,6 +1023,47 @@ MODULE FUNCTION obj_GetUniqueElemType(obj, dim) RESULT(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 + !---------------------------------------------------------------------------- ! SetSparsity@setMethods !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index b9a1c3f20..b30678726 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -538,6 +538,35 @@ & '[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 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From e5b013fe5e47c50ce64bba60871f736dc03c0222 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 9 Apr 2024 12:45:57 +0900 Subject: [PATCH 075/119] EAS-2 Updates in AbstractMesh_Class Adding get node mask in abstract mesh class --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 21 +++++++ .../src/AbstractMesh_Class@GetMethods.F90 | 60 ++++++++++++++----- 2 files changed, 65 insertions(+), 16 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index c0fe29104..f743384e3 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -318,6 +318,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 @@ -1061,6 +1064,24 @@ MODULE FUNCTION obj_isNodePresent2(obj, globalNode, islocal) RESULT(ans) 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 93a7cb4a2..514f6c4d3 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -239,6 +239,38 @@ 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 !---------------------------------------------------------------------------- @@ -388,26 +420,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 From 8261f745f5b45be01e236c7a23bebb6271e80a8c Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 9 Apr 2024 12:47:33 +0900 Subject: [PATCH 076/119] EAS-6 Updates in AbstractDomain Some improvements in GetBoundingBox methods --- .../src/AbstractDomain_Class.F90 | 14 ++++--- .../src/AbstractDomain_Class@GetMethods.F90 | 39 +++++++------------ 2 files changed, 23 insertions(+), 30 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 89b9ff87f..dc1b9044c 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -166,12 +166,12 @@ MODULE AbstractDomain_Class & obj_tElements2 !! return total number of elements in domain, mesh, or part of domain - PROCEDURE, PASS(obj) :: obj_GetLocalNodeNumber1 - PROCEDURE, PASS(obj) :: obj_GetLocalNodeNumber2 + PROCEDURE, PASS(obj) :: GetLocalNodeNumber1 => obj_GetLocalNodeNumber1 + PROCEDURE, PASS(obj) :: GetLocalNodeNumber2 => obj_GetLocalNodeNumber2 GENERIC, PUBLIC :: & & GetLocalNodeNumber => & - & obj_GetLocalNodeNumber1, & - & obj_GetLocalNodeNumber2 + & GetLocalNodeNumber1, & + & GetLocalNodeNumber2 PROCEDURE, PASS(obj) :: obj_GetGlobalNodeNumber1 !! Returns the global node number of a local node number PROCEDURE, PASS(obj) :: obj_GetGlobalNodeNumber2 @@ -967,8 +967,12 @@ END FUNCTION obj_GetNSD ! summary: Returns bounding box INTERFACE - MODULE FUNCTION obj_GetBoundingBox(obj) RESULT(ans) + 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 diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index b30678726..e3b8e26b5 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -473,14 +473,20 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetBoundingBox -REAL(DFP) :: lim(6) -INTEGER(I4B) :: nsd -!> main -lim = 0.0_DFP -nsd = SIZE(obj%nodeCoord, 1) -lim(1:nsd * 2:2) = MINVAL(obj%nodeCoord(1:nsd, :), dim=2) -lim(2:nsd * 2:2) = MAXVAL(obj%nodeCoord(1:nsd, :), dim=2) -CALL Initiate(obj=ans, nsd=3_I4B, lim=lim) +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 !---------------------------------------------------------------------------- @@ -492,23 +498,6 @@ CALL e%RaiseError(modName//'::'//myName//' - '// & & '[DEPRECATED] :: We are working on alternative') ans = 0 -! IF (PRESENT(imeshFacetData)) THEN -! IF (ALLOCATED(obj%meshFacetData)) THEN -! IF (obj%meshFacetData(imeshFacetData)%isInitiated()) THEN -! ans = obj%meshFacetData(imeshFacetData)%SIZE() -! ELSE -! ans = 0 -! END IF -! ELSE -! ans = 0 -! END IF -! ELSE -! IF (ALLOCATED(obj%meshFacetData)) THEN -! ans = SIZE(obj%meshFacetData) -! ELSE -! ans = 0 -! END IF -! END IF END PROCEDURE obj_GetTotalMeshFacetData !---------------------------------------------------------------------------- From 2943f873c1501f4047a7be68cd63c8df5c293bce Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 9 Apr 2024 14:03:37 +0900 Subject: [PATCH 077/119] EAS-20 adding GetNptrsInBox in abstract domain Adding get nptrs in box in abstract domain. This routine should be improved for its speed. --- .../src/AbstractDomain_Class.F90 | 24 ++++++++++++++++++- .../src/AbstractDomain_Class@GetMethods.F90 | 8 +++++++ 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index dc1b9044c..bb518b165 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -202,6 +202,9 @@ MODULE AbstractDomain_Class 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) :: GetInternalNptrs => & & obj_GetInternalNptrs !! returns internal node number @@ -918,10 +921,29 @@ MODULE SUBROUTINE obj_GetNptrs_(obj, nptrs, dim) CLASS(AbstractDomain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(INOUT) :: nptrs(:) INTEGER(I4B), INTENT(IN) :: dim - !! dim = [0, 1, 2, 3] for [meshPoint, meshCurve, meshSurface, meshVolume] + !! 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, nptrs, box) + CLASS(AbstractDomain_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE, INTENT(INOUT) :: nptrs(:) + TYPE(BoundingBox_), INTENT(IN) :: box + END SUBROUTINE obj_GetNptrsInBox +END INTERFACE + !---------------------------------------------------------------------------- ! GetInternalNptrs@GetMethods !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index e3b8e26b5..ca6a69381 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -443,6 +443,14 @@ END SELECT END PROCEDURE obj_GetNptrs_ +!---------------------------------------------------------------------------- +! GetNptrsInBox +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_GetNptrsInBox +nptrs = box.Nptrs.obj%nodeCoord +END PROCEDURE obj_GetNptrsInBox + !---------------------------------------------------------------------------- ! GetNptrs !---------------------------------------------------------------------------- From 33c88146774fa7528b3d969bba5b482511028d2b Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Wed, 10 Apr 2024 18:55:26 +0900 Subject: [PATCH 078/119] EAS-42 adding kdtree to abstractdomain Adding kdtree to abstract domain Adding showtime to abstract domain this is wip --- .../src/AbstractDomain_Class.F90 | 68 +++++++++++++++++++ ...bstractDomain_Class@ConstructorMethods.F90 | 18 +++++ .../AbstractDomain_Class@MeshDataMethods.F90 | 55 +++++++++++++++ .../src/AbstractDomain_Class@SetMethods.F90 | 8 +++ 4 files changed, 149 insertions(+) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index bb518b165..b19d2915f 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -31,6 +31,7 @@ MODULE AbstractDomain_Class USE tomlf, ONLY: toml_table USE TxtFile_Class, ONLY: TxtFile_ USE ExceptionHandler_Class, ONLY: e +USE Kdtree2_Module, ONLY: Kdtree2_, Kdtree2Result_ IMPLICIT NONE PRIVATE @@ -54,6 +55,8 @@ MODULE AbstractDomain_Class 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 @@ -109,6 +112,9 @@ MODULE AbstractDomain_Class CLASS(AbstractMesh_), POINTER :: meshPoint => NULL() !! meshPoint list of meshes of point entities + TYPE(Kdtree2_), POINTER :: kdtree => NULL() + TYPE(Kdtree2Result_), ALLOCATABLE :: kdresult(:) + TYPE(CSRSparsity_) :: meshMap !! Sparse mesh data in CSR format CONTAINS @@ -120,6 +126,7 @@ MODULE AbstractDomain_Class !! 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 @@ -231,41 +238,58 @@ MODULE AbstractDomain_Class ! 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 => & @@ -319,6 +343,21 @@ MODULE SUBROUTINE obj_Deallocate(obj) 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 !---------------------------------------------------------------------------- @@ -1090,6 +1129,21 @@ MODULE SUBROUTINE obj_GetParam(obj, isInitiated, engine, majorVersion, & 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 !---------------------------------------------------------------------------- @@ -1192,6 +1246,20 @@ MODULE SUBROUTINE obj_SetQuality(obj, measures, max_measures, & 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 index dff3392f7..4c2dce54c 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 @@ -22,6 +22,7 @@ SUBMODULE(AbstractDomain_Class) ConstructorMethods USE ReallocateUtility USE CSRSparsity_Method +USE Kdtree2_Module, ONLY: Kdtree2_Destroy IMPLICIT NONE CONTAINS @@ -51,6 +52,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_Deallocate +obj%showTime = .FALSE. obj%isInitiated = .FALSE. obj%engine = '' obj%majorVersion = 0 @@ -91,8 +93,24 @@ 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 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 index 395d88b1f..4fbc9a474 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 @@ -18,9 +18,64 @@ SUBMODULE(AbstractDomain_Class) MeshDataMethods USE BaseMethod USE DomainConnectivity_Class +USE Kdtree2_Module, ONLY: Kdtree2_create IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! InitiateKdtree +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateKdtree +INTEGER(I4B) :: nsd +#ifdef DEBUG_VER +CHARACTER(*), PARAMETER :: myName = "obj_InitiateKdtree()" +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 obj%showTimeFile%WRITE(val=TypeCPUTime%GetStringForKernelLog( & + & currentTime=obj%currentTime, currentTimeStep=obj%currentTimeStep, & + & methodName=myName)) +END IF + +END PROCEDURE obj_InitiateKdtree + !---------------------------------------------------------------------------- ! InitiateNodeToElements !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 index 772a612cd..c32132567 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -27,6 +27,14 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! SetShowTime +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetShowTime +obj%showTime = VALUE +END PROCEDURE obj_SetShowTime + !---------------------------------------------------------------------------- ! SetSparsity !---------------------------------------------------------------------------- From ef7d72c18e623da539cb6467526e82be771ce83a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Wed, 10 Apr 2024 18:55:58 +0900 Subject: [PATCH 079/119] EAS-2 minor updates in abstract mesh Minor updats --- .../src/AbstractMesh_Class@GetMethods.F90 | 27 ++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 514f6c4d3..514cdf401 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -1030,7 +1030,10 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetFacetConnectivity -! CHARACTER(*), PARAMETER :: myName = "obj_GetFacetConnectivity2()" +#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) @@ -1074,10 +1077,32 @@ 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_GetFacetConnectivity From 005d25ffba3e952f2e8904256942b787190883f2 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 12:18:39 +0900 Subject: [PATCH 080/119] EAS-20 updates in abstractdomain working on getnptrs in box this is wip --- .../src/AbstractDomain_Class.F90 | 34 +++++++- .../src/AbstractDomain_Class@GetMethods.F90 | 82 ++++++++++++++++++- .../src/AbstractDomain_Class@IOMethods.F90 | 12 +-- .../AbstractDomain_Class@MeshDataMethods.F90 | 12 ++- 4 files changed, 127 insertions(+), 13 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index b19d2915f..c3599fa76 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -212,6 +212,9 @@ MODULE AbstractDomain_Class 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 @@ -976,13 +979,40 @@ END SUBROUTINE obj_GetNptrs_ ! summary: this routine returns the global node number in a box INTERFACE - MODULE SUBROUTINE obj_GetNptrsInBox(obj, nptrs, box) - CLASS(AbstractDomain_), INTENT(IN) :: obj + MODULE SUBROUTINE obj_GetNptrsInBox(obj, box, nptrs) + 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 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index ca6a69381..fec1ce61d 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -21,8 +21,9 @@ SUBMODULE(AbstractDomain_Class) GetMethods USE ReallocateUtility USE InputUtility -USE BoundingBox_Method +USE BoundingBox_Method, ONLY: Center, GetRadiusSqr, isInside USE F95_BLAS, ONLY: Copy +USE Kdtree2_Module, ONLY: Kdtree2_r_nearest IMPLICIT NONE CONTAINS @@ -448,9 +449,86 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrsInBox -nptrs = box.Nptrs.obj%nodeCoord +! nptrs = box.Nptrs.obj%nodeCoord +REAL(DFP) :: qv(3), r2 +INTEGER(I4B) :: nfound, ii + +qv = Center(box) +r2 = GetRadiusSqr(box) + +CALL Kdtree2_r_nearest(tp=obj%kdtree, qv=qv(1:obj%nsd), r2=r2, & + nfound=nfound, nalloc=SIZE(obj%kdresult), results=obj%kdresult) + +CALL Reallocate(nptrs, nfound) + +DO CONCURRENT(ii=1:nfound) + nptrs(ii) = obj%kdresult(ii)%idx +END DO + 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 index f11f9ca1d..46cf8a0e1 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 @@ -105,7 +105,8 @@ MODULE PROCEDURE obj_DisplayDomainInfo LOGICAL(LGT) :: abool -CALL Display(obj%isInitiated, "AbstractDomain_::obj Initiated: ", unitno=unitno) +CALL Display(obj%isInitiated, "AbstractDomain_::obj Initiated: ", & + unitno=unitno) IF (.NOT. obj%isInitiated) RETURN CALL EqualLine(unitno=unitno) @@ -192,7 +193,8 @@ & 'Calling AbstractDomainImportMetaData') #endif -CALL AbstractDomainImportMetaData(obj=obj, hdf5=hdf5, group=group, myName=myName) +CALL AbstractDomainImportMetaData(obj=obj, hdf5=hdf5, group=group, & + myName=myName) IF (obj%nsd .EQ. 3_I4B) THEN @@ -249,7 +251,7 @@ END PROCEDURE obj_Import !---------------------------------------------------------------------------- -! AbstractDomainImportCheckErr +! AbstractDomainImportCheckErr !---------------------------------------------------------------------------- SUBROUTINE AbstractDomainImportCheckErr(obj, hdf5, myName) @@ -284,7 +286,7 @@ SUBROUTINE AbstractDomainImportCheckErr(obj, hdf5, myName) END SUBROUTINE AbstractDomainImportCheckErr !---------------------------------------------------------------------------- -! AbstractDomainImportMetaData +! AbstractDomainImportMetaData !---------------------------------------------------------------------------- SUBROUTINE AbstractDomainImportMetaData(obj, hdf5, group, myName) @@ -465,7 +467,7 @@ END SUBROUTINE AbstractDomainImportMetaData #ifdef DEBUG_VER IF (PRESENT(printToml)) THEN CALL Display(toml_serialize(node), "AbstractDomain toml config: "//CHAR_LF, & - & unitno=stdout) + & unitno=stdout) END IF #endif diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 index 4fbc9a474..15c70983d 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@MeshDataMethods.F90 @@ -16,9 +16,12 @@ ! 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 @@ -28,8 +31,9 @@ MODULE PROCEDURE obj_InitiateKdtree INTEGER(I4B) :: nsd -#ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_InitiateKdtree()" + +#ifdef DEBUG_VER LOGICAL(LGT) :: isok #endif @@ -69,9 +73,9 @@ IF (obj%showTime) THEN CALL TypeCPUTime%SetEndTime() - CALL obj%showTimeFile%WRITE(val=TypeCPUTime%GetStringForKernelLog( & - & currentTime=obj%currentTime, currentTimeStep=obj%currentTimeStep, & - & methodName=myName)) + CALL Display(modName//" : "//myName// & + & " : time : "// & + & tostring(TypeCPUTime%GetTime()), unitno=stdout) END IF END PROCEDURE obj_InitiateKdtree From 50f8488379d889362190dac20f8c7d9ae6340910 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 14:41:05 +0900 Subject: [PATCH 081/119] EAS-20 Updates in abstract domain Updating nptrs in bounding box --- .../src/AbstractDomain_Class.F90 | 8 +++- .../src/AbstractDomain_Class@GetMethods.F90 | 42 +++++++++++++++---- 2 files changed, 42 insertions(+), 8 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index c3599fa76..2bf375da6 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -979,11 +979,17 @@ END SUBROUTINE obj_GetNptrs_ ! summary: this routine returns the global node number in a box INTERFACE - MODULE SUBROUTINE obj_GetNptrsInBox(obj, box, nptrs) + 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 diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index fec1ce61d..f0854e176 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -449,22 +449,50 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrsInBox -! nptrs = box.Nptrs.obj%nodeCoord +CHARACTER(*), PARAMETER :: myName = "obj_GetNptrsInBox()" REAL(DFP) :: qv(3), r2 -INTEGER(I4B) :: nfound, ii +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) -CALL Kdtree2_r_nearest(tp=obj%kdtree, qv=qv(1:obj%nsd), r2=r2, & - nfound=nfound, nalloc=SIZE(obj%kdresult), results=obj%kdresult) +isok = Input(default=.TRUE., option=isStrict) -CALL Reallocate(nptrs, nfound) +IF (.NOT. isok) THEN + CALL Reallocate(nptrs, tnodes) + DO CONCURRENT(ii=1:tnodes) + nptrs(ii) = obj%kdresult(ii)%idx + END DO + RETURN +END IF -DO CONCURRENT(ii=1:nfound) - nptrs(ii) = obj%kdresult(ii)%idx +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 !---------------------------------------------------------------------------- From d96177bc824e3f5929691a6a40fc3d7f6cdaac46 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 15:52:11 +0900 Subject: [PATCH 082/119] EAS-22 Updates in abstract domain Adding get nearest node method. It uses kdtree. --- .../src/AbstractDomain_Class.F90 | 68 ++++++++++++--- .../src/AbstractDomain_Class@GetMethods.F90 | 85 +++++++++++++++---- 2 files changed, 125 insertions(+), 28 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 2bf375da6..9dcf21503 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -144,7 +144,7 @@ MODULE AbstractDomain_Class PROCEDURE, PUBLIC, PASS(obj) :: DisplayDomainInfo => & & obj_DisplayDomainInfo - ! GET: + ! Get: ! @GetMethods PROCEDURE, PUBLIC, PASS(obj) :: IsNodePresent => obj_IsNodePresent PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => obj_IsElementPresent @@ -162,7 +162,7 @@ MODULE AbstractDomain_Class !! Returns the total nodes in a dimension GENERIC, PUBLIC :: OPERATOR(.tNodes.) => & & obj_tNodes1, obj_tNodes2 - !! Generic method for getting total nodes + !! 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 @@ -203,6 +203,11 @@ MODULE AbstractDomain_Class & 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 @@ -660,7 +665,7 @@ END FUNCTION obj_tNodes2 END INTERFACE !---------------------------------------------------------------------------- -! getTotalElements@GetMethods +! GetTotalElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -734,7 +739,7 @@ END FUNCTION obj_tElements2 END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@GetMethods +! GetLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -754,7 +759,7 @@ END FUNCTION obj_GetLocalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@GetMethods +! GetLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -772,7 +777,7 @@ END FUNCTION obj_GetLocalNodeNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNodeNumber@GetMethods +! GetGlobalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -788,7 +793,7 @@ END FUNCTION obj_GetGlobalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNodeNumber@GetMethods +! GetGlobalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -854,7 +859,7 @@ END FUNCTION obj_GetMeshPointer1 END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoord@GetMethods +! GetNodeCoord@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -875,7 +880,7 @@ END SUBROUTINE obj_GetNodeCoord END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoord@GetMethods +! GetNodeCoord@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -905,7 +910,50 @@ END SUBROUTINE obj_GetNodeCoord2 END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoordPointer@GetMethods +! 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. diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index f0854e176..8ddc74ee3 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -23,7 +23,7 @@ USE InputUtility USE BoundingBox_Method, ONLY: Center, GetRadiusSqr, isInside USE F95_BLAS, ONLY: Copy -USE Kdtree2_Module, ONLY: Kdtree2_r_nearest +USE Kdtree2_Module, ONLY: Kdtree2_r_nearest, Kdtree2_n_nearest IMPLICIT NONE CONTAINS @@ -70,7 +70,7 @@ END PROCEDURE obj_IsElementPresent !---------------------------------------------------------------------------- -! getConnectivity +! GetConnectivity !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetConnectivity @@ -96,7 +96,7 @@ END PROCEDURE obj_GetConnectivity !---------------------------------------------------------------------------- -! getNodeToElements +! GetNodeToElements !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeToElements1 @@ -117,7 +117,7 @@ END PROCEDURE obj_GetNodeToElements1 !---------------------------------------------------------------------------- -! getNodeToElements +! GetNodeToElements !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeToElements2 @@ -138,7 +138,7 @@ END PROCEDURE obj_GetNodeToElements2 !---------------------------------------------------------------------------- -! getTotalNodes +! GetTotalNodes !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetTotalNodes @@ -176,7 +176,7 @@ END PROCEDURE obj_tNodes2 !---------------------------------------------------------------------------- -! getTotalElements +! GetTotalElements !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetTotalElements @@ -214,7 +214,7 @@ END PROCEDURE obj_tElements2 !---------------------------------------------------------------------------- -! getLocalNodeNumber +! GetLocalNodeNumber !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetLocalNodeNumber1 @@ -246,7 +246,7 @@ END PROCEDURE obj_GetLocalNodeNumber1 !---------------------------------------------------------------------------- -! getLocalNodeNumber +! GetLocalNodeNumber !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetLocalNodeNumber2 @@ -278,7 +278,7 @@ END PROCEDURE obj_GetLocalNodeNumber2 !---------------------------------------------------------------------------- -! getGlobalNodeNumber +! GetGlobalNodeNumber !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetGlobalNodeNumber1 @@ -305,7 +305,7 @@ END PROCEDURE obj_GetGlobalNodeNumber1 !---------------------------------------------------------------------------- -! getGlobalNodeNumber +! GetGlobalNodeNumber !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetGlobalNodeNumber2 @@ -352,7 +352,7 @@ END PROCEDURE obj_GetTotalEntities !---------------------------------------------------------------------------- -! getMeshPointer +! GetMeshPointer !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetMeshPointer1 @@ -370,7 +370,7 @@ END PROCEDURE obj_GetMeshPointer1 !---------------------------------------------------------------------------- -! getNodeCoord +! GetNodeCoord !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeCoord @@ -391,7 +391,7 @@ END PROCEDURE obj_GetNodeCoord !---------------------------------------------------------------------------- -! getNodeCoord +! GetNodeCoord !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeCoord2 @@ -403,7 +403,56 @@ END PROCEDURE obj_GetNodeCoord2 !---------------------------------------------------------------------------- -! getNodeCoordPointer +! 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) + +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)) +END DO + +END PROCEDURE obj_GetNearestNode2 + +!---------------------------------------------------------------------------- +! GetNodeCoordPointer !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNodeCoordPointer @@ -575,7 +624,7 @@ END PROCEDURE obj_GetInternalNptrs !---------------------------------------------------------------------------- -! getNSD +! GetNSD !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNSD @@ -583,7 +632,7 @@ END PROCEDURE obj_GetNSD !---------------------------------------------------------------------------- -! getBoundingBox +! GetBoundingBox !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetBoundingBox @@ -604,7 +653,7 @@ END PROCEDURE obj_GetBoundingBox !---------------------------------------------------------------------------- -! getTotalMeshFacetData +! GetTotalMeshFacetData !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetTotalMeshFacetData @@ -615,7 +664,7 @@ END PROCEDURE obj_GetTotalMeshFacetData !---------------------------------------------------------------------------- -! getTotalMaterial +! GetTotalMaterial !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetTotalMaterial1 From 89f2d7657d6f9100fd81519463993f9dbe5fb045 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 17:20:47 +0900 Subject: [PATCH 083/119] EAS-59 fixing some methods in abstract domain Fixing some methods in abstract domain. read the issue on JIRA EAS-59 --- .../src/AbstractDomain_Class.F90 | 41 +++- .../src/AbstractDomain_Class@GetMethods.F90 | 196 ++++++++++-------- 2 files changed, 140 insertions(+), 97 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 9dcf21503..f4c8eab4c 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -196,7 +196,10 @@ MODULE AbstractDomain_Class !! This routine returns the nodal coordinate in rank2 array PROCEDURE, PASS(obj) :: GetNodeCoord2 => obj_GetNodeCoord2 !! This routine returns the nodal coordinate in rank2 array - GENERIC, PUBLIC :: GetNodeCoord => GetNodeCoord1, GetNodeCoord2 + 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 => & @@ -891,10 +894,6 @@ END SUBROUTINE obj_GetNodeCoord ! - 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. -! - If `dim` and `tag` are absent then this routine returns the nodal -! coordinates of the entire domain -! - If `dim` and `tag` are present then the routine selects the mesh and -! returns its nodal coordinates INTERFACE MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode, & @@ -902,13 +901,43 @@ MODULE SUBROUTINE obj_GetNodeCoord2(obj, nodeCoord, globalNode, & CLASS(AbstractDomain_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) !! It should be allocated by the user. - !! SIZE(nodeCoord, 1) is equal to nsd + !! 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index 8ddc74ee3..c565d8125 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -218,30 +218,31 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetLocalNodeNumber1 -#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 +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 @@ -250,30 +251,31 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetLocalNodeNumber2 -#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 +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 @@ -282,26 +284,27 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetGlobalNodeNumber1 -#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 +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 !---------------------------------------------------------------------------- @@ -309,26 +312,27 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetGlobalNodeNumber2 -#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 +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 !---------------------------------------------------------------------------- @@ -396,12 +400,20 @@ MODULE PROCEDURE obj_GetNodeCoord2 INTEGER(I4B) :: localNode(SIZE(globalNode)) -INTEGER(I4B) :: nsd localNode = obj%GetLocalNodeNumber(globalNode=globalNode, islocal=islocal) -nsd = SIZE(nodeCoord, 1) -nodeCoord = obj%nodeCoord(1:nsd, localNode) +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 !---------------------------------------------------------------------------- @@ -422,6 +434,7 @@ globalNode = obj%kdresult(1)%idx x(1:obj%nsd) = obj%nodeCoord(1:obj%nsd, globalNode) +globalNode = obj%GetGlobalNodeNumber(localnode=globalNode) END PROCEDURE obj_GetNearestNode1 @@ -447,6 +460,7 @@ 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 From 26bff6882d1855a2171d2833262727347b5fd7d9 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 17:54:33 +0900 Subject: [PATCH 084/119] EAS-11 adding fedomain connectivity Adding fedomain connectivity WIP --- CMakeLists.txt | 120 +- src/modules/CMakeLists.txt | 3 + .../FEDomainConnectivity/CMakeLists.txt | 21 + .../src/FEDomainConnectivity_Class.F90 | 1253 +++++++++++++++++ src/submodules/CMakeLists.txt | 3 + .../FEDomainConnectivity/CMakeLists.txt | 25 + ...FEDomainConnectivity_Class@CellMethods.F90 | 296 ++++ ...nConnectivity_Class@ConstructorMethods.F90 | 80 ++ ...omainConnectivity_Class@ElementMethods.F90 | 0 ...EDomainConnectivity_Class@FacetMethods.F90 | 941 +++++++++++++ .../FEDomainConnectivity_Class@IOMethods.F90 | 55 + ...FEDomainConnectivity_Class@NodeMethods.F90 | 130 ++ 12 files changed, 2868 insertions(+), 59 deletions(-) create mode 100644 src/modules/FEDomainConnectivity/CMakeLists.txt create mode 100644 src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 create mode 100644 src/submodules/FEDomainConnectivity/CMakeLists.txt create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ConstructorMethods.F90 create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@IOMethods.F90 create mode 100644 src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 3505127b1..79eac44a5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,67 +1,69 @@ -# This program is a part of EASIFEM library -# Copyright (C) 2020-2021 Vikas Sharma, Ph.D +# 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 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. +# 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 +# You should have received a copy of the GNU General Public License along with +# this program. If not, see # -CMAKE_MINIMUM_REQUIRED(VERSION 3.20.0 FATAL_ERROR) -SET(PROJECT_NAME "easifemClasses") -PROJECT(${PROJECT_NAME}) -ENABLE_LANGUAGE(C) -ENABLE_LANGUAGE(Fortran) -ENABLE_LANGUAGE(CXX) -SET(VERSION_MAJOR "23") -SET(VERSION_MINOR "6") -SET(VERSION_BugFix "0") -SET(PROJECT_VERSION ${VERSION_MAJOR}.${VERSION_MINOR}.${VERSION_BugFix}) -SET(CMAKE_PROJECT_DESCRIPTION "Expandable and Scalable Infrastructure for Finite Element Methods") -SET(CMAKE_PROJECT_HOMEPAGE_URL "https://github.com/vickysharma0812/easifem-classes") -SET(TARGETS_EXPORT_NAME "${PROJECT_NAME}Targets") -SET(namespace "${PROJECT_NAME}") -INCLUDE(CMakePrintHelpers) -INCLUDE(FortranCInterface) +cmake_minimum_required(VERSION 3.20.0 FATAL_ERROR) +set(PROJECT_NAME "easifemClasses") +project(${PROJECT_NAME}) +enable_language(C) +enable_language(Fortran) +enable_language(CXX) +set(VERSION_MAJOR "23") +set(VERSION_MINOR "6") +set(VERSION_BugFix "0") +set(PROJECT_VERSION ${VERSION_MAJOR}.${VERSION_MINOR}.${VERSION_BugFix}) +set(CMAKE_PROJECT_DESCRIPTION + "Expandable and Scalable Infrastructure for Finite Element Methods") +set(CMAKE_PROJECT_HOMEPAGE_URL + "https://github.com/vickysharma0812/easifem-classes") +set(TARGETS_EXPORT_NAME "${PROJECT_NAME}Targets") +set(namespace "${PROJECT_NAME}") +include(CMakePrintHelpers) +include(FortranCInterface) FortranCInterface_VERIFY() -LIST( APPEND TARGET_COMPILE_DEF "-DUSE_CMAKE" ) +list(APPEND TARGET_COMPILE_DEF "-DUSE_CMAKE") # find my cmake modules here... -LIST(APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/checkError.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/makeDirs.cmake) -IF(BUILD_SHARED_LIBS) - ADD_LIBRARY(${PROJECT_NAME} SHARED "" ) -ELSE() - ADD_LIBRARY(${PROJECT_NAME} STATIC "") -ENDIF() -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/Compiler.cmake) +list(APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules) +include(${PROJECT_SOURCE_DIR}/cmake/checkError.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/makeDirs.cmake) +if(BUILD_SHARED_LIBS) + add_library(${PROJECT_NAME} SHARED "") +else() + add_library(${PROJECT_NAME} STATIC "") +endif() +include(${PROJECT_SOURCE_DIR}/cmake/Compiler.cmake) # Add source files -INCLUDE(src/modules/CMakeLists.txt) -INCLUDE(src/submodules/CMakeLists.txt) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/prefixPaths.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addOpenBLAS.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addOpenMP.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addSuperLU.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addLIS.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addMetis.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addARPACK.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addHDF5.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addPLPLOT.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addGmsh.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addFFTW.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/addGTKFortran.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/targetLinkLibs.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/targetIncludeDirs.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/targetCompileOpts.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/targetCompileDefs.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/targetProperties.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/install.cmake) -INCLUDE(${PROJECT_SOURCE_DIR}/cmake/packaging.cmake) +include(src/modules/CMakeLists.txt) +include(src/submodules/CMakeLists.txt) +include(${PROJECT_SOURCE_DIR}/cmake/prefixPaths.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addOpenBLAS.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addOpenMP.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addSuperLU.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addLIS.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addMetis.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addARPACK.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addHDF5.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addPLPLOT.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addGmsh.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addFFTW.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/addGTKFortran.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/targetLinkLibs.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/targetIncludeDirs.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/targetCompileOpts.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/targetCompileDefs.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/targetProperties.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/install.cmake) +include(${PROJECT_SOURCE_DIR}/cmake/packaging.cmake) diff --git a/src/modules/CMakeLists.txt b/src/modules/CMakeLists.txt index f9248ffa7..66d666a52 100644 --- a/src/modules/CMakeLists.txt +++ b/src/modules/CMakeLists.txt @@ -114,6 +114,9 @@ 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/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..8a64f8aca --- /dev/null +++ b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 @@ -0,0 +1,1253 @@ +! 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 BaseType +USE AbstractMesh_Class +USE FEDomain_Class +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +PRIVATE +CHARACTER(*), PARAMETER :: modName = "FEDomainConnectivity_Class" +INTEGER(I4B), PUBLIC, PARAMETER :: pType = 1 +INTEGER(I4B), PUBLIC, PARAMETER :: hType = 2 +INTEGER(I4B), PUBLIC, PARAMETER :: rType = 3 +INTEGER(I4B), PUBLIC, PARAMETER :: oversetType = 4 + +PUBLIC :: FEDomainConnectivity_ +PUBLIC :: FEDomainConnectivityPointer_ +PUBLIC :: FEDomainConnectivityDeallocate + +!---------------------------------------------------------------------------- +! 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 + + ! @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]] + + ! @CellMethods + PROCEDURE, PUBLIC, PASS(obj) :: obj_InitiateCellToCellData1 + !! Initiates [[FEDomainConnectivity_:cellToCell]] data + PROCEDURE, PUBLIC, PASS(obj) :: obj_InitiateCellToCellData2 + !! Initiates [[FEDomainConnectivity_:cellToCell]] data + GENERIC, PUBLIC :: InitiateCellToCellData => & + & obj_InitiateCellToCellData1, & + & obj_InitiateCellToCellData2 + + !! 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(FEDomain_), INTENT(INOUT) :: domain1 + !! Primary domain, in nodeToNode(i), i denotes the + !! global node number in domain1 domain. + CLASS(FEDomain_), 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@CellMethods +!---------------------------------------------------------------------------- + +!> 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 meshes +! +! - `obj%cellToCell` will be initiated +! - `domain1` main domain +! - `domain2` secondary domain +! - `dim1, entitynum1` dimension and entity number of mesh in `domain1` +! - `dim2, entitynum2` dimension and entity number of mesh in `domain2` +! +! Following points should be noted +! +! - The topology of elements in both meshes should be the same, this +! means that if one mesh is triangle then other mesh should be a triangle +! - The xidim of the elements in both meshes should be the same, this means +! that if the mesh1 is surface mesh then mesh2 should be a surface mesh +! - This routine needs [[FEDomainConnectivity_:nodeToNode]] information, so +! make sure it is initiated before calling this routine. + +INTERFACE + MODULE SUBROUTINE obj_initiateCellToCellData1(obj, domain1, domain2, & + dim1, dim2, entityNum1, entityNum2) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity object, + !! [[FEDomainConnectivity:cellToCell]] will be initiated + CLASS(FEDomain_), INTENT(IN) :: domain1 + !! Primary domain, in cellToCell(i), i denotes the + !! global element number in domain1 domain. + CLASS(FEDomain_), INTENT(IN) :: domain2 + !! secondary domain, => cellToCell(i) denotes the + !! global cell number in `domain2` domain. + INTEGER(I4B), INTENT(IN) :: dim1 + !! dimension of mesh in domain1 + INTEGER(I4B), INTENT(IN) :: dim2 + !! dimension of mesh in domain2 + INTEGER(I4B), INTENT(IN) :: entityNum1 + !! entity num of mesh in domain1 + INTEGER(I4B), INTENT(IN) :: entityNum2 + !! entity num of mesh in domain2 + END SUBROUTINE obj_initiateCellToCellData1 +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_InitiateCellToCellData2(obj, domain1, domain2) + CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj + !! FEDomain connectivity object + CLASS(FEDomain_), INTENT(IN) :: domain1 + !! Primary domain, in CellToCell(i), i denotes the + !! global element number in domain1 domain. + CLASS(FEDomain_), INTENT(IN) :: domain2 + !! Secondary domain => CellToCell(i) denotes the + !! global element number in domain2 domain. + END SUBROUTINE obj_InitiateCellToCellData2 +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(FEDomain_), INTENT(INOUT) :: masterFEDomain + !! FEDomain of master elements + CLASS(FEDomain_), 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(FEDomain_), 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/submodules/CMakeLists.txt b/src/submodules/CMakeLists.txt index db16663ea..ef4208e9d 100644 --- a/src/submodules/CMakeLists.txt +++ b/src/submodules/CMakeLists.txt @@ -78,6 +78,9 @@ 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/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..6faa7c7f8 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -0,0 +1,296 @@ +! 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 +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_initiateCellToCellData1 +! CHARACTER(*), PARAMETER :: myName = "obj_initiateCellToCellData1" +! CLASS(Mesh_), POINTER :: mesh1 => NULL() +! ! mesh1 in domain1 (low order mesh) +! CLASS(Mesh_), POINTER :: mesh2 => NULL() +! ! mesh2 in domain2 (high order mesh) +! CLASS(ReferenceElement_), POINTER :: refelem1 => NULL() +! ! reference element in mesh1 +! CLASS(ReferenceElement_), POINTER :: refelem2 => NULL() +! ! refelem in mesh2 +! INTEGER(I4B) :: ii, jj, nsd, order1, order2, iel1, iel2 +! ! some counters and indices +! INTEGER(I4B), ALLOCATABLE :: nptrs1(:) +! ! node number in mesh1 +! INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) +! ! node number in mesh2 +! INTEGER(I4B), ALLOCATABLE :: elem2(:) +! ! element numbers in mesh2 +! INTEGER(I4B), POINTER :: nodeToNode(:) +! !> main +! !> check +! IF (.NOT. obj%isNodeToNode) & +! & CALL e%raiseError(modName//"::"//myName//" - "// & +! & 'NodeToNode data is not initiated!') +! !> check +! IF (obj%isCellToCell) THEN +! CALL e%raiseWarning(modName//"::"//myName//" - "// & +! & "It seems, obj%cellToCell data is already initiated") +! END IF +! !> get mesh pointer +! mesh1 => domain1%GetMeshPointer(dim=dim1, entityNum=entityNum1) +! mesh2 => domain2%GetMeshPointer(dim=dim2, entityNum=entityNum2) +! ! TODO +! ! is it possible to have bounds of obj%cellToCell from +! ! mesh1%minElemNum to mesh1%maxElemNum, it will save the space +! CALL Reallocate(obj%cellToCell, mesh1%maxElemNum) +! CALL Reallocate(obj%cellToCellExtraData, 2, mesh1%maxElemNum) +! obj%isCellToCell = .TRUE. +! ! +! ! +! ! +! refelem1 => mesh1%getRefElemPointer() +! refelem2 => mesh2%getRefElemPointer() +! ! +! ! +! ! +! IF (ElementTopology(refelem1) .NE. ElementTopology(refelem2)) & +! & CALL e%raiseError(modName//"::"//myName//" - "// & +! & 'Topology of mesh element is not the same.') +! ! +! ! +! ! +! order1 = elementOrder(refelem1) +! order2 = elementOrder(refelem2) +! !> +! ! NOTE +! ! The size of nptrs1 and nptrs2 are the same. +! ! When order1 > order2, some of the entries in nptrs2 +! ! will be zero. In this case size(nptrs2) .gt. size(nptrs) +! ! +! ! when order1 < order2, then size(nptrs) .gt. size(nptrs2) +! ! in this case we should use (nptrs2 .in nptrs) +! ! +! nodeToNode => obj%getNodeToNodePointer() +! IF (order1 .GE. order2) THEN +! DO iel1 = mesh1%minElemNum, mesh1%maxElemNum +! IF (.NOT. mesh1%isElementPresent(globalElement=iel1)) CYCLE +! nptrs1 = mesh1%getConnectivity(globalElement=iel1) +! nptrs2 = nodeToNode(nptrs1) +! !> Now we get the list of all elements in mesh2 which are +! ! connected/contains node number in nptrs2 +! elem2 = mesh2%getNodeToElements(GlobalNode=nptrs2) +! !> now we are ready to search iel2 in elem2 which +! ! contains all nptrs2 +! DO ii = 1, SIZE(elem2) +! iel2 = elem2(ii) +! nptrs = mesh2%getConnectivity(globalElement=iel2) +! IF (nptrs.in.nptrs2) THEN +! obj%cellToCell(iel1) = iel2 +! obj%cellToCellExtraData(1, iel1) = dim2 +! obj%cellToCellExtraData(2, iel1) = entityNum2 +! EXIT +! END IF +! END DO +! END DO +! ELSE +! DO iel1 = mesh1%minElemNum, mesh1%maxElemNum +! IF (.NOT. mesh1%isElementPresent(globalElement=iel1)) CYCLE +! nptrs1 = mesh1%getConnectivity(globalElement=iel1) +! nptrs2 = nodeToNode(nptrs1) +! !> Now we get the list of all elements in mesh2 which are +! ! connected/contains node number in nptrs2 +! elem2 = mesh2%getNodeToElements(GlobalNode=nptrs2) +! !> now we are ready to search iel2 in elem2 which +! ! contains all nptrs2 +! DO ii = 1, SIZE(elem2) +! iel2 = elem2(ii) +! nptrs = mesh2%getConnectivity(globalElement=iel2) +! IF (nptrs2.in.nptrs) THEN +! obj%cellToCell(iel1) = iel2 +! obj%cellToCellExtraData(1, iel1) = dim2 +! obj%cellToCellExtraData(2, iel1) = entityNum2 +! EXIT +! END IF +! END DO +! END DO +! END IF +! !> cleanup +! NULLIFY (mesh1, mesh2, refelem1, refelem2) +! IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) +! IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) +! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! IF (ALLOCATED(elem2)) DEALLOCATE (elem2) +END PROCEDURE obj_initiateCellToCellData1 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_InitiateCellToCellData2 +! CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData2" +! CLASS(Mesh_), POINTER :: mesh1 => NULL() +! ! mesh1 in domain1 (low order mesh) +! CLASS(Mesh_), POINTER :: mesh2 => NULL() +! ! mesh2 in domain2 (high order mesh) +! CLASS(ReferenceElement_), POINTER :: refelem1 => NULL() +! ! reference element in mesh1 +! CLASS(ReferenceElement_), POINTER :: refelem2 => NULL() +! ! refelem in mesh2 +! INTEGER(I4B) :: ii, jj, nsd, order1, order2, iel1, iel2, dimEntity(2) +! ! some counters and indices +! INTEGER(I4B), ALLOCATABLE :: nptrs1(:) +! ! node number in mesh1 +! INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) +! ! node number in mesh2 +! INTEGER(I4B), ALLOCATABLE :: elem2(:) +! ! element numbers in mesh2 +! INTEGER(I4B), POINTER :: nodeToNode(:) +! ! +! ! main +! ! +! ! +! ! check +! ! +! IF (.NOT. domain1%isInitiated) & +! & CALL e%raiseError(modName//"::"//myName//" - "// & +! & "FEDomain-1 is not initiated, first initiate") +! ! +! ! check +! ! +! IF (.NOT. domain2%isInitiated) & +! & CALL e%raiseError(modName//"::"//myName//" - "// & +! & "FEDomain-2 is not initiated, first initiate") +! ! +! ! check +! ! +! IF (.NOT. obj%isNodeToNode) & +! & CALL e%raiseError(modName//"::"//myName//" - "// & +! & 'NodeToNode data is not initiated!') +! ! +! ! check +! ! +! IF (obj%isCellToCell) & +! & CALL e%raiseWarning(modName//"::"//myName//" - "// & +! & "It seems, obj%cellToCell data is already initiated") +! ! +! ! TODO is it possible to have bounds of obj%cellToCell from +! ! domain1%minElemNum to domain1%maxElemNum, +! ! it will save the space +! ! +! CALL Reallocate(obj%cellToCell, domain1%maxElemNum) +! CALL Reallocate(obj%cellToCellExtraData, 2, domain1%maxElemNum) +! obj%isCellToCell = .TRUE. +! nsd = domain1%getNSD() +! ! +! ! +! ! +! nodeToNode => obj%getNodeToNodePointer() +! ! +! ! get mesh pointer +! ! +! DO iel1 = domain1%minElemNum, domain1%maxElemNum +! ! +! IF (.NOT. domain1%isElementPresent(globalElement=iel1)) CYCLE +! ! +! mesh1 => domain1%GetMeshPointer(globalElement=iel1) +! refelem1 => mesh1%getRefElemPointer() +! ! +! ! If the mesh is made of point elements then skip it +! ! +! IF (refelem1%xidimension .EQ. 0) CYCLE +! ! +! ! NOTE if the reference element is not a cell then +! ! skip it. We want to consider only the +! ! cells, i.e xidim == dim +! ! +! ! Commented: IF (refelem1%xidimension .NE. nsd) CYCLE +! ! +! order1 = elementOrder(refelem1) +! nptrs1 = mesh1%getConnectivity(globalElement=iel1) +! nptrs2 = nodeToNode(nptrs1) +! ! +! ! Now we get the list of all elements in domain2 +! ! which are connected/contains node number in nptrs2 +! ! +! ! NOTE some of these elements in elem2 may not be cell +! ! elements, i.e. xidim .ne. nsd +! ! we should skip such elements. +! ! +! elem2 = domain2%getNodeToElements(GlobalNode=nptrs2) +! ! +! ! now we are ready to search iel2 in elem2 which +! ! contains all nptrs2 +! ! +! DO ii = 1, SIZE(elem2) +! iel2 = elem2(ii) +! dimEntity = domain2%GetDimEntityNum(globalElement=iel2) +! mesh2 => domain2%GetMeshPointer( & +! & dim=dimEntity(1), & +! & entityNum=dimEntity(2)) +! refelem2 => mesh2%getRefElemPointer() +! ! +! ! skip if refelem2%xidim .ne. refelem1%xidim +! ! +! IF (refelem2%xidimension .NE. refelem1%xidimension) CYCLE +! IF (ElementTopology(refelem1) .NE. ElementTopology(refelem2)) CYCLE +! ! +! order2 = elementOrder(refelem2) +! nptrs = mesh2%getConnectivity(globalElement=iel2) +! ! +! IF (order1 .GE. order2) THEN +! IF (nptrs.in.nptrs2) THEN +! obj%cellToCell(iel1) = iel2 +! obj%cellToCellExtraData(:, iel1) = dimEntity +! EXIT +! END IF +! ELSE +! IF (nptrs2.in.nptrs) THEN +! obj%cellToCell(iel1) = iel2 +! obj%cellToCellExtraData(:, iel1) = dimEntity +! EXIT +! END IF +! END IF +! END DO +! END DO +! ! cleanup +! NULLIFY (mesh1, mesh2, refelem1, refelem2) +! IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) +! IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) +! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +! IF (ALLOCATED(elem2)) DEALLOCATE (elem2) +END PROCEDURE obj_InitiateCellToCellData2 + +!---------------------------------------------------------------------------- +! 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..e69de29bb 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..dc4ec4018 --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 @@ -0,0 +1,941 @@ +! 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 +! +! 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" +! 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 +! +! INTEGER(I4B) :: iface, icell, ii, colID, tface, tfacet, & +! & cellGlobalNum, localFacetID, jj +! INTEGER(I4B), ALLOCATABLE :: nptrs(:), pt2elem(:), & +! & cellNptrs(:), facetNptrs(:) +! CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData3" +! 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" +! 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..2e935c37e --- /dev/null +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.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 +! + +SUBMODULE(FEDomainConnectivity_Class) NodeMethods +! USE BaseMethod +USE BaseType, ONLY: BoundingBox_ +USE BoundingBox_Method +USE ReallocateUtility +USE ApproxUtility +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) + IF (isok) THEN + jj = domain1%GetGlobalNodeNumber(node1) + 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 From 97e3e4ab2d6657d36e5f6d8f46c7625aeb9388a4 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Thu, 11 Apr 2024 21:43:19 +0900 Subject: [PATCH 085/119] EAS-4 updates in abstractmeshutil Fixing a bug in init elem to elem 1d. --- src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 index 15c12901c..0b2346454 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -425,12 +425,12 @@ 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 From 79d26079bc5fd067640b1e32ba14c163c5cfd2a4 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 00:44:39 +0900 Subject: [PATCH 086/119] Updates in abstract mesh and domain Minor updates --- .../src/AbstractDomain_Class@GetMethods.F90 | 44 +++++++++++++++++++ .../src/AbstractMesh_Class@GetMethods.F90 | 3 +- 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index c565d8125..b30e880be 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -74,8 +74,17 @@ !---------------------------------------------------------------------------- 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) @@ -93,6 +102,11 @@ & islocal=islocal) END SELECT +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + END PROCEDURE obj_GetConnectivity !---------------------------------------------------------------------------- @@ -100,6 +114,15 @@ !---------------------------------------------------------------------------- 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, & @@ -114,6 +137,12 @@ ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & & islocal=islocal) END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + END PROCEDURE obj_GetNodeToElements1 !---------------------------------------------------------------------------- @@ -121,6 +150,15 @@ !---------------------------------------------------------------------------- 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, & @@ -135,6 +173,12 @@ ans = obj%meshPoint%GetNodeToElements(globalNode=globalNode, & & islocal=islocal) END SELECT + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + END PROCEDURE obj_GetNodeToElements2 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 514cdf401..b9697c33a 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -522,7 +522,8 @@ 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 From 50f0b1795675ba9be6dbcd023691cd6594c308b3 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 00:45:22 +0900 Subject: [PATCH 087/119] EAS-11 updates in fe domain conn - Working on cel to cell data --- ...FEDomainConnectivity_Class@CellMethods.F90 | 359 ++++++------------ 1 file changed, 107 insertions(+), 252 deletions(-) diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 index 6faa7c7f8..ed921476c 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -17,6 +17,8 @@ SUBMODULE(FEDomainConnectivity_Class) CellMethods ! USE BaseMethod +USE IntegerUtility, ONLY: OPERATOR(.in.) +USE ReallocateUtility IMPLICIT NONE CONTAINS @@ -24,261 +26,114 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_initiateCellToCellData1 -! CHARACTER(*), PARAMETER :: myName = "obj_initiateCellToCellData1" -! CLASS(Mesh_), POINTER :: mesh1 => NULL() -! ! mesh1 in domain1 (low order mesh) -! CLASS(Mesh_), POINTER :: mesh2 => NULL() -! ! mesh2 in domain2 (high order mesh) -! CLASS(ReferenceElement_), POINTER :: refelem1 => NULL() -! ! reference element in mesh1 -! CLASS(ReferenceElement_), POINTER :: refelem2 => NULL() -! ! refelem in mesh2 -! INTEGER(I4B) :: ii, jj, nsd, order1, order2, iel1, iel2 -! ! some counters and indices -! INTEGER(I4B), ALLOCATABLE :: nptrs1(:) -! ! node number in mesh1 -! INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) -! ! node number in mesh2 -! INTEGER(I4B), ALLOCATABLE :: elem2(:) -! ! element numbers in mesh2 -! INTEGER(I4B), POINTER :: nodeToNode(:) -! !> main -! !> check -! IF (.NOT. obj%isNodeToNode) & -! & CALL e%raiseError(modName//"::"//myName//" - "// & -! & 'NodeToNode data is not initiated!') -! !> check -! IF (obj%isCellToCell) THEN -! CALL e%raiseWarning(modName//"::"//myName//" - "// & -! & "It seems, obj%cellToCell data is already initiated") -! END IF -! !> get mesh pointer -! mesh1 => domain1%GetMeshPointer(dim=dim1, entityNum=entityNum1) -! mesh2 => domain2%GetMeshPointer(dim=dim2, entityNum=entityNum2) -! ! TODO -! ! is it possible to have bounds of obj%cellToCell from -! ! mesh1%minElemNum to mesh1%maxElemNum, it will save the space -! CALL Reallocate(obj%cellToCell, mesh1%maxElemNum) -! CALL Reallocate(obj%cellToCellExtraData, 2, mesh1%maxElemNum) -! obj%isCellToCell = .TRUE. -! ! -! ! -! ! -! refelem1 => mesh1%getRefElemPointer() -! refelem2 => mesh2%getRefElemPointer() -! ! -! ! -! ! -! IF (ElementTopology(refelem1) .NE. ElementTopology(refelem2)) & -! & CALL e%raiseError(modName//"::"//myName//" - "// & -! & 'Topology of mesh element is not the same.') -! ! -! ! -! ! -! order1 = elementOrder(refelem1) -! order2 = elementOrder(refelem2) -! !> -! ! NOTE -! ! The size of nptrs1 and nptrs2 are the same. -! ! When order1 > order2, some of the entries in nptrs2 -! ! will be zero. In this case size(nptrs2) .gt. size(nptrs) -! ! -! ! when order1 < order2, then size(nptrs) .gt. size(nptrs2) -! ! in this case we should use (nptrs2 .in nptrs) -! ! -! nodeToNode => obj%getNodeToNodePointer() -! IF (order1 .GE. order2) THEN -! DO iel1 = mesh1%minElemNum, mesh1%maxElemNum -! IF (.NOT. mesh1%isElementPresent(globalElement=iel1)) CYCLE -! nptrs1 = mesh1%getConnectivity(globalElement=iel1) -! nptrs2 = nodeToNode(nptrs1) -! !> Now we get the list of all elements in mesh2 which are -! ! connected/contains node number in nptrs2 -! elem2 = mesh2%getNodeToElements(GlobalNode=nptrs2) -! !> now we are ready to search iel2 in elem2 which -! ! contains all nptrs2 -! DO ii = 1, SIZE(elem2) -! iel2 = elem2(ii) -! nptrs = mesh2%getConnectivity(globalElement=iel2) -! IF (nptrs.in.nptrs2) THEN -! obj%cellToCell(iel1) = iel2 -! obj%cellToCellExtraData(1, iel1) = dim2 -! obj%cellToCellExtraData(2, iel1) = entityNum2 -! EXIT -! END IF -! END DO -! END DO -! ELSE -! DO iel1 = mesh1%minElemNum, mesh1%maxElemNum -! IF (.NOT. mesh1%isElementPresent(globalElement=iel1)) CYCLE -! nptrs1 = mesh1%getConnectivity(globalElement=iel1) -! nptrs2 = nodeToNode(nptrs1) -! !> Now we get the list of all elements in mesh2 which are -! ! connected/contains node number in nptrs2 -! elem2 = mesh2%getNodeToElements(GlobalNode=nptrs2) -! !> now we are ready to search iel2 in elem2 which -! ! contains all nptrs2 -! DO ii = 1, SIZE(elem2) -! iel2 = elem2(ii) -! nptrs = mesh2%getConnectivity(globalElement=iel2) -! IF (nptrs2.in.nptrs) THEN -! obj%cellToCell(iel1) = iel2 -! obj%cellToCellExtraData(1, iel1) = dim2 -! obj%cellToCellExtraData(2, iel1) = entityNum2 -! EXIT -! END IF -! END DO -! END DO -! END IF -! !> cleanup -! NULLIFY (mesh1, mesh2, refelem1, refelem2) -! IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) -! IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) -! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) -! IF (ALLOCATED(elem2)) DEALLOCATE (elem2) -END PROCEDURE obj_initiateCellToCellData1 +MODULE PROCEDURE obj_InitiateCellToCellData1 +CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData1()" +INTEGER(I4B) :: ii, nsd, order1, order2, iel1, iel2 +! some counters and indices +INTEGER(I4B), ALLOCATABLE :: nptrs1(:) +! node number in mesh1 +INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) +! node number in mesh2 +INTEGER(I4B), ALLOCATABLE :: elem2(:) +! element numbers in mesh2 +INTEGER(I4B), POINTER :: nodeToNode(:) +LOGICAL(LGT) :: isok -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- +INTEGER(I4B) :: telem1, minelem, maxelem + +#ifdef DEBUG_VER +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[START] ') +#endif + +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() + +telem1 = domain1%GetTotalElements(dim=nsd) + +! Get mesh pointer +DO iel1 = minelem, maxelem + isok = domain1%isElementPresent(globalElement=iel1) + IF (.NOT. isok) CYCLE + + nptrs1 = domain1%GetConnectivity(globalElement=iel1, islocal=.FALSE., & + dim=nsd) + order1 = SIZE(nptrs1) + CALL Reallocate(nptrs2, order1) + DO ii = 1, order1 + nptrs2(ii) = nodeToNode(nptrs1(ii)) + END DO + + elem2 = domain2%GetNodeToElements(GlobalNode=nptrs2) + + ! now we are ready to search iel2 in elem2 which + ! contains all nptrs2 + DO ii = 1, SIZE(elem2) + iel2 = elem2(ii) + + nptrs = domain2%GetConnectivity(globalElement=iel2, dim=nsd) + order2 = SIZE(nptrs) + + IF (order1 .GE. order2) THEN + IF (nptrs.in.nptrs2) THEN + obj%cellToCell(iel1) = iel2 + EXIT + END IF + ELSE + IF (nptrs2.in.nptrs) THEN + obj%cellToCell(iel1) = iel2 + EXIT + END IF + END IF + END DO + +END DO + +NULLIFY (nodeToNode) +IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) +IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) +IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) +IF (ALLOCATED(elem2)) DEALLOCATE (elem2) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif -MODULE PROCEDURE obj_InitiateCellToCellData2 -! CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData2" -! CLASS(Mesh_), POINTER :: mesh1 => NULL() -! ! mesh1 in domain1 (low order mesh) -! CLASS(Mesh_), POINTER :: mesh2 => NULL() -! ! mesh2 in domain2 (high order mesh) -! CLASS(ReferenceElement_), POINTER :: refelem1 => NULL() -! ! reference element in mesh1 -! CLASS(ReferenceElement_), POINTER :: refelem2 => NULL() -! ! refelem in mesh2 -! INTEGER(I4B) :: ii, jj, nsd, order1, order2, iel1, iel2, dimEntity(2) -! ! some counters and indices -! INTEGER(I4B), ALLOCATABLE :: nptrs1(:) -! ! node number in mesh1 -! INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) -! ! node number in mesh2 -! INTEGER(I4B), ALLOCATABLE :: elem2(:) -! ! element numbers in mesh2 -! INTEGER(I4B), POINTER :: nodeToNode(:) -! ! -! ! main -! ! -! ! -! ! check -! ! -! IF (.NOT. domain1%isInitiated) & -! & CALL e%raiseError(modName//"::"//myName//" - "// & -! & "FEDomain-1 is not initiated, first initiate") -! ! -! ! check -! ! -! IF (.NOT. domain2%isInitiated) & -! & CALL e%raiseError(modName//"::"//myName//" - "// & -! & "FEDomain-2 is not initiated, first initiate") -! ! -! ! check -! ! -! IF (.NOT. obj%isNodeToNode) & -! & CALL e%raiseError(modName//"::"//myName//" - "// & -! & 'NodeToNode data is not initiated!') -! ! -! ! check -! ! -! IF (obj%isCellToCell) & -! & CALL e%raiseWarning(modName//"::"//myName//" - "// & -! & "It seems, obj%cellToCell data is already initiated") -! ! -! ! TODO is it possible to have bounds of obj%cellToCell from -! ! domain1%minElemNum to domain1%maxElemNum, -! ! it will save the space -! ! -! CALL Reallocate(obj%cellToCell, domain1%maxElemNum) -! CALL Reallocate(obj%cellToCellExtraData, 2, domain1%maxElemNum) -! obj%isCellToCell = .TRUE. -! nsd = domain1%getNSD() -! ! -! ! -! ! -! nodeToNode => obj%getNodeToNodePointer() -! ! -! ! get mesh pointer -! ! -! DO iel1 = domain1%minElemNum, domain1%maxElemNum -! ! -! IF (.NOT. domain1%isElementPresent(globalElement=iel1)) CYCLE -! ! -! mesh1 => domain1%GetMeshPointer(globalElement=iel1) -! refelem1 => mesh1%getRefElemPointer() -! ! -! ! If the mesh is made of point elements then skip it -! ! -! IF (refelem1%xidimension .EQ. 0) CYCLE -! ! -! ! NOTE if the reference element is not a cell then -! ! skip it. We want to consider only the -! ! cells, i.e xidim == dim -! ! -! ! Commented: IF (refelem1%xidimension .NE. nsd) CYCLE -! ! -! order1 = elementOrder(refelem1) -! nptrs1 = mesh1%getConnectivity(globalElement=iel1) -! nptrs2 = nodeToNode(nptrs1) -! ! -! ! Now we get the list of all elements in domain2 -! ! which are connected/contains node number in nptrs2 -! ! -! ! NOTE some of these elements in elem2 may not be cell -! ! elements, i.e. xidim .ne. nsd -! ! we should skip such elements. -! ! -! elem2 = domain2%getNodeToElements(GlobalNode=nptrs2) -! ! -! ! now we are ready to search iel2 in elem2 which -! ! contains all nptrs2 -! ! -! DO ii = 1, SIZE(elem2) -! iel2 = elem2(ii) -! dimEntity = domain2%GetDimEntityNum(globalElement=iel2) -! mesh2 => domain2%GetMeshPointer( & -! & dim=dimEntity(1), & -! & entityNum=dimEntity(2)) -! refelem2 => mesh2%getRefElemPointer() -! ! -! ! skip if refelem2%xidim .ne. refelem1%xidim -! ! -! IF (refelem2%xidimension .NE. refelem1%xidimension) CYCLE -! IF (ElementTopology(refelem1) .NE. ElementTopology(refelem2)) CYCLE -! ! -! order2 = elementOrder(refelem2) -! nptrs = mesh2%getConnectivity(globalElement=iel2) -! ! -! IF (order1 .GE. order2) THEN -! IF (nptrs.in.nptrs2) THEN -! obj%cellToCell(iel1) = iel2 -! obj%cellToCellExtraData(:, iel1) = dimEntity -! EXIT -! END IF -! ELSE -! IF (nptrs2.in.nptrs) THEN -! obj%cellToCell(iel1) = iel2 -! obj%cellToCellExtraData(:, iel1) = dimEntity -! EXIT -! END IF -! END IF -! END DO -! END DO -! ! cleanup -! NULLIFY (mesh1, mesh2, refelem1, refelem2) -! IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) -! IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) -! IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) -! IF (ALLOCATED(elem2)) DEALLOCATE (elem2) -END PROCEDURE obj_InitiateCellToCellData2 +END PROCEDURE obj_InitiateCellToCellData1 !---------------------------------------------------------------------------- -! getCellToCellPointer +! GetCellToCellPointer !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetCellToCellPointer @@ -286,7 +141,7 @@ END PROCEDURE obj_GetCellToCellPointer !---------------------------------------------------------------------------- -! getDimEntityNum +! GetDimEntityNum !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetDimEntityNum From e628a5098b8f2f26c05ef1f863ab66e2af12bb59 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 09:06:28 +0900 Subject: [PATCH 088/119] EAS-64 Updates in abstractmesh - updating getnode to elements --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 4 ++-- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index f743384e3..589e00b14 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1502,7 +1502,7 @@ END FUNCTION obj_GetLocalElemNumber2 INTERFACE MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & & RESULT(ans) - CLASS(AbstractMesh_), INTENT(IN) :: obj + CLASS(AbstractMesh_), INTENT(INOUT) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode !! global node number @@ -1535,7 +1535,7 @@ END FUNCTION obj_GetNodeToElements1 INTERFACE MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & & RESULT(ans) - CLASS(AbstractMesh_), INTENT(IN) :: obj + CLASS(AbstractMesh_), INTENT(INOUT) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode(:) !! global node number diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index b9697c33a..6b8068f54 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -666,6 +666,8 @@ END IF #endif +IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() + ii = obj%GetLocalNodeNumber(globalNode, islocal=islocal) ans = obj%nodeData(ii)%globalElements END PROCEDURE obj_GetNodeToElements1 @@ -678,6 +680,8 @@ 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) From 28b08d025dad50472beb04aec2d67ac4cc912140 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 09:08:04 +0900 Subject: [PATCH 089/119] EAS-8 updates in FEDomainConnectivity_class - working on cell to cell data - this is wip --- .../src/FEDomainConnectivity_Class.F90 | 93 +++++-------------- ...FEDomainConnectivity_Class@CellMethods.F90 | 40 ++++---- ...omainConnectivity_Class@ElementMethods.F90 | 18 ++++ ...FEDomainConnectivity_Class@NodeMethods.F90 | 6 +- 4 files changed, 65 insertions(+), 92 deletions(-) diff --git a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 index 8a64f8aca..bed2575ad 100644 --- a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 +++ b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 @@ -79,17 +79,17 @@ MODULE FEDomainConnectivity_Class TYPE :: FEDomainConnectivity_ PRIVATE LOGICAL(LGT), PUBLIC :: isInitiated = .FALSE. - !! True if an instance of [[FEDomainConnectivity_]] is initiated + !! True if an instance of [[FEDomainConnectivity_]] is Initiated LOGICAL(LGT), PUBLIC :: isFacetToCell = .FALSE. - !! True if FacetToCell data is allocated and initiated + !! True if FacetToCell data is allocated and Initiated LOGICAL(LGT), PUBLIC :: isNodeToNode = .FALSE. - !! True if nodeToNode data is initiate + !! True if nodeToNode data is Initiate LOGICAL(LGT), PUBLIC :: isCellToCell = .FALSE. - !! True if elemToElem data is initiated + !! 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) + !! 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(:) @@ -127,7 +127,9 @@ MODULE FEDomainConnectivity_Class FINAL :: obj_Final !! finalizer + ! SET: ! @NodeMethods + PROCEDURE, PASS(obj) :: InitiateNodeToNodeData1 => & obj_InitiateNodeToNodeData1 !! Initiate [[FEDomainConnectivity_:nodeToNode]] @@ -139,18 +141,17 @@ MODULE FEDomainConnectivity_Class & obj_GetNodeToNodePointer !! Return pointer to the [[FEDomainConnectivity_:nodeToNode]] + ! SET: ! @CellMethods + PROCEDURE, PUBLIC, PASS(obj) :: obj_InitiateCellToCellData1 !! Initiates [[FEDomainConnectivity_:cellToCell]] data - PROCEDURE, PUBLIC, PASS(obj) :: obj_InitiateCellToCellData2 - !! Initiates [[FEDomainConnectivity_:cellToCell]] data GENERIC, PUBLIC :: InitiateCellToCellData => & - & obj_InitiateCellToCellData1, & - & obj_InitiateCellToCellData2 - + & obj_InitiateCellToCellData1 !! Initiates [[FEDomainConnectivity_:cellToCell]] data + PROCEDURE, PUBLIC, PASS(obj) :: GetCellToCellPointer => & - & obj_GetCellToCellPointer + obj_GetCellToCellPointer !! Return pointer to the [[FEDomainConnectivity_:CellToCell]] PROCEDURE, PUBLIC, PASS(obj) :: GetDimEntityNum => & & obj_GetDimEntityNum @@ -379,7 +380,7 @@ END SUBROUTINE obj_DisplayFacetToCellData !all meshes in the domain2 will be generated! !@endnote ! -! - `obj%nodeToNode` will be initiated +! - `obj%nodeToNode` will be Initiated ! - `domain1` main domain ! - `domain2` secondary domain @@ -417,58 +418,6 @@ MODULE FUNCTION obj_GetNodeToNodePointer(obj) RESULT(Ans) END FUNCTION obj_GetNodeToNodePointer END INTERFACE -!---------------------------------------------------------------------------- -! InitiateCellToCellData@CellMethods -!---------------------------------------------------------------------------- - -!> 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 meshes -! -! - `obj%cellToCell` will be initiated -! - `domain1` main domain -! - `domain2` secondary domain -! - `dim1, entitynum1` dimension and entity number of mesh in `domain1` -! - `dim2, entitynum2` dimension and entity number of mesh in `domain2` -! -! Following points should be noted -! -! - The topology of elements in both meshes should be the same, this -! means that if one mesh is triangle then other mesh should be a triangle -! - The xidim of the elements in both meshes should be the same, this means -! that if the mesh1 is surface mesh then mesh2 should be a surface mesh -! - This routine needs [[FEDomainConnectivity_:nodeToNode]] information, so -! make sure it is initiated before calling this routine. - -INTERFACE - MODULE SUBROUTINE obj_initiateCellToCellData1(obj, domain1, domain2, & - dim1, dim2, entityNum1, entityNum2) - CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj - !! FEDomain connectivity object, - !! [[FEDomainConnectivity:cellToCell]] will be initiated - CLASS(FEDomain_), INTENT(IN) :: domain1 - !! Primary domain, in cellToCell(i), i denotes the - !! global element number in domain1 domain. - CLASS(FEDomain_), INTENT(IN) :: domain2 - !! secondary domain, => cellToCell(i) denotes the - !! global cell number in `domain2` domain. - INTEGER(I4B), INTENT(IN) :: dim1 - !! dimension of mesh in domain1 - INTEGER(I4B), INTENT(IN) :: dim2 - !! dimension of mesh in domain2 - INTEGER(I4B), INTENT(IN) :: entityNum1 - !! entity num of mesh in domain1 - INTEGER(I4B), INTENT(IN) :: entityNum2 - !! entity num of mesh in domain2 - END SUBROUTINE obj_initiateCellToCellData1 -END INTERFACE - !---------------------------------------------------------------------------- ! InitiateCellToCellData@NodeMethods !---------------------------------------------------------------------------- @@ -483,7 +432,7 @@ END SUBROUTINE obj_initiateCellToCellData1 !This subroutine generates the cell to cell connectivity between !two domains. ! -! - `obj%cellToCell` will be initiated +! - `obj%cellToCell` will be Initiated ! - `domain1` main domain ! - `domain2` secondary domain ! @@ -524,16 +473,16 @@ END SUBROUTINE obj_initiateCellToCellData1 !@endnote INTERFACE - MODULE SUBROUTINE obj_InitiateCellToCellData2(obj, domain1, domain2) + MODULE SUBROUTINE obj_InitiateCellToCellData1(obj, domain1, domain2) CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj !! FEDomain connectivity object - CLASS(FEDomain_), INTENT(IN) :: domain1 + CLASS(FEDomain_), INTENT(INOUT) :: domain1 !! Primary domain, in CellToCell(i), i denotes the !! global element number in domain1 domain. - CLASS(FEDomain_), INTENT(IN) :: domain2 + CLASS(FEDomain_), INTENT(INOUT) :: domain2 !! Secondary domain => CellToCell(i) denotes the !! global element number in domain2 domain. - END SUBROUTINE obj_InitiateCellToCellData2 + END SUBROUTINE obj_InitiateCellToCellData1 END INTERFACE !---------------------------------------------------------------------------- @@ -587,7 +536,7 @@ END FUNCTION obj_GetDimEntityNum ! !# Introduction ! -! - This routine initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - 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. @@ -649,7 +598,7 @@ END SUBROUTINE obj_InitiateFacetToCellData2 ! !# Introduction ! -! - This routine initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - This routine Initiate `facetToCell` for given facetFEMesh and CellFEMesh ! - In this case facetFEMesh can be an internal boundary of cellFEMesh INTERFACE @@ -676,7 +625,7 @@ END SUBROUTINE obj_InitiateFacetToCellData3 ! !# Introduction ! -! - This routine initiate `facetToCell` for given facetFEMesh and CellFEMesh +! - This routine Initiate `facetToCell` for given facetFEMesh and CellFEMesh ! - In this case facetFEMesh can be an internal boundary of cellFEMesh INTERFACE diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 index ed921476c..b32208f9c 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -19,6 +19,7 @@ ! USE BaseMethod USE IntegerUtility, ONLY: OPERATOR(.in.) USE ReallocateUtility +USE Display_Method IMPLICIT NONE CONTAINS @@ -28,7 +29,7 @@ MODULE PROCEDURE obj_InitiateCellToCellData1 CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData1()" -INTEGER(I4B) :: ii, nsd, order1, order2, iel1, iel2 +INTEGER(I4B) :: ii, nsd, order1, order2, iel1, jj ! some counters and indices INTEGER(I4B), ALLOCATABLE :: nptrs1(:) ! node number in mesh1 @@ -94,27 +95,30 @@ nptrs2(ii) = nodeToNode(nptrs1(ii)) END DO - elem2 = domain2%GetNodeToElements(GlobalNode=nptrs2) + DO ii = 1, order1 + IF (nptrs2(ii) .EQ. 0) CYCLE - ! now we are ready to search iel2 in elem2 which - ! contains all nptrs2 - DO ii = 1, SIZE(elem2) - iel2 = elem2(ii) + elem2 = domain2%GetNodeToElements(GlobalNode=nptrs2(ii)) - nptrs = domain2%GetConnectivity(globalElement=iel2, dim=nsd) - order2 = SIZE(nptrs) + DO jj = 1, SIZE(elem2) - IF (order1 .GE. order2) THEN - IF (nptrs.in.nptrs2) THEN - obj%cellToCell(iel1) = iel2 - EXIT - END IF - ELSE - IF (nptrs2.in.nptrs) THEN - obj%cellToCell(iel1) = iel2 - EXIT + nptrs = domain2%GetConnectivity(globalElement=elem2(jj), dim=nsd) + order2 = SIZE(nptrs) + + IF (order1 .GE. order2) THEN + IF (nptrs.in.nptrs2) THEN + obj%cellToCell(iel1) = elem2(jj) + EXIT + END IF + ELSE + IF (nptrs2.in.nptrs) THEN + obj%cellToCell(iel1) = elem2(jj) + EXIT + END IF END IF - END IF + + END DO + END DO END DO diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 index e69de29bb..01669e069 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@ElementMethods.F90 +++ 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@NodeMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 index 2e935c37e..3d8d489ae 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@NodeMethods.F90 @@ -21,6 +21,7 @@ USE BoundingBox_Method USE ReallocateUtility USE ApproxUtility +USE Display_Method IMPLICIT NONE CONTAINS @@ -72,7 +73,7 @@ IF (isok) RETURN ii = domain1%GetTotalNodes() -CALL Reallocate(obj%NodeToNode, ii) +CALL Reallocate(obj%nodeToNode, ii) obj%isNodeToNode = .TRUE. box1 = domain1%GetBoundingBox() @@ -99,8 +100,9 @@ CALL domain2%GetNearestNode(qv=x1, x=x2, globalNode=node2) isok = ALL(x1.APPROXEQ.x2) + jj = domain1%GetGlobalNodeNumber(node1) + IF (isok) THEN - jj = domain1%GetGlobalNodeNumber(node1) obj%nodeToNode(jj) = node2 ELSE obj%nodeToNode(jj) = 0_I4B From fb99037242ba9c11a678b9c380afdd01e3ef4d71 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 09:45:51 +0900 Subject: [PATCH 090/119] EAS-65 [close] updates in GetNNE adding get nne method in abstract domain class --- .../src/AbstractDomain_Class.F90 | 47 +++++++++++++++++-- .../src/AbstractDomain_Class@GetMethods.F90 | 40 ++++++++++++++++ 2 files changed, 84 insertions(+), 3 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index f4c8eab4c..dcc11a16a 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -144,16 +144,30 @@ MODULE AbstractDomain_Class PROCEDURE, PUBLIC, PASS(obj) :: DisplayDomainInfo => & & obj_DisplayDomainInfo - ! Get: + ! 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) :: GetNNE => obj_GetNNE + !! Get number of nodes(vertex) in element, size of connectivity + PROCEDURE, PASS(obj) :: obj_GetNodeToElements1 + !! Get the list of elements connnected to a specified node PROCEDURE, PASS(obj) :: obj_GetNodeToElements2 + !! Get the list of elements connnected to many specified nodes GENERIC, PUBLIC :: GetNodeToElements => & & obj_GetNodeToElements1, & & obj_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 @@ -514,8 +528,7 @@ END FUNCTION obj_IsElementPresent !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 2021-11-12 -! update: 2021-11-12 +! date: 2024-04-12 ! summary: Returns the connectivity vector of a given element number INTERFACE @@ -538,6 +551,34 @@ MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim, islocal) & END FUNCTION 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index b30e880be..c92b89c5b 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -109,6 +109,46 @@ 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 !---------------------------------------------------------------------------- From a1c5262a56c7cc4a0fbf554b428de10a344f18d2 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 13:09:21 +0900 Subject: [PATCH 091/119] EAS-63 [close] updates in abstract mesh adding get node to element routine without reallocation. --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 58 +++++++++++++- .../src/AbstractMesh_Class@GetMethods.F90 | 77 ++++++++++++++----- 2 files changed, 116 insertions(+), 19 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 589e00b14..2bbe05778 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -407,10 +407,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 @@ -1545,6 +1555,52 @@ MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, 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 + +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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 6b8068f54..dfd874d55 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -27,6 +27,7 @@ & ElementOrder, & & TotalEntities, & & RefElemGetGeoParam +USE SafeSizeUtility IMPLICIT NONE @@ -44,25 +45,8 @@ MODULE PROCEDURE obj_GetNNE INTEGER(I4B) :: iel - -#ifdef DEBUG_VER -LOGICAL(LGT) :: isok -#endif - iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) -ans = 0 - -#ifdef DEBUG_VER - -isok = ALLOCATED(obj%elementData(iel)%globalNodes) -IF (isok) ans = SIZE(obj%elementData(iel)%globalNodes) - -#else - -ans = SIZE(obj%elementData(iel)%globalNodes) - -#endif - +ans = SafeSize(obj%elementData(iel)%globalNodes) END PROCEDURE obj_GetNNE !---------------------------------------------------------------------------- @@ -703,6 +687,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 = SafeSize(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 + SafeSize(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, tsize=tsize, isSorted=.FALSE.) +END PROCEDURE obj_GetNodeToElements2_ + !---------------------------------------------------------------------------- ! GetNodeToNodes !---------------------------------------------------------------------------- From 0e37a569048d414ec68d698fd800bde77bc992fa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 13:10:07 +0900 Subject: [PATCH 092/119] EAS-66 [close] updates in abstract domain adding get node to elements with allocations. --- .../src/AbstractDomain_Class.F90 | 68 +++++++++++++++++- .../src/AbstractDomain_Class@GetMethods.F90 | 72 +++++++++++++++++++ 2 files changed, 138 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index dcc11a16a..a9dc792f2 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -597,7 +597,8 @@ END FUNCTION obj_GetNNE INTERFACE MODULE FUNCTION obj_GetNodeToElements1(obj, globalNode, islocal) & & RESULT(ans) - CLASS(AbstractDomain_), INTENT(IN) :: obj + 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 @@ -622,13 +623,76 @@ END FUNCTION obj_GetNodeToElements1 INTERFACE MODULE FUNCTION obj_GetNodeToElements2(obj, globalNode, islocal) & & RESULT(ans) - CLASS(AbstractDomain_), INTENT(IN) :: obj + 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index c92b89c5b..a377c298b 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -221,6 +221,78 @@ 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 !---------------------------------------------------------------------------- From 1e817072206691964613410747a3127613ad53bc Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 14:51:40 +0900 Subject: [PATCH 093/119] EAS-67 [close] updates in abstractmesh adding no alloc version of get connectivity --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 23 +++++++++++++ .../src/AbstractMesh_Class@GetMethods.F90 | 34 ++++++++++++++++--- .../AbstractMesh_Class@NodeDataMethods.F90 | 4 +-- 3 files changed, 54 insertions(+), 7 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 2bbe05778..7df449811 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -367,6 +367,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 @@ -1327,6 +1331,25 @@ MODULE FUNCTION obj_GetConnectivity(obj, globalElement, islocal) & 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index dfd874d55..177bfaaf5 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -27,7 +27,6 @@ & ElementOrder, & & TotalEntities, & & RefElemGetGeoParam -USE SafeSizeUtility IMPLICIT NONE @@ -46,7 +45,7 @@ MODULE PROCEDURE obj_GetNNE INTEGER(I4B) :: iel iel = obj%GetLocalElemNumber(globalElement, islocal=islocal) -ans = SafeSize(obj%elementData(iel)%globalNodes) +ans = SIZE(obj%elementData(iel)%globalNodes) END PROCEDURE obj_GetNNE !---------------------------------------------------------------------------- @@ -451,6 +450,31 @@ ! 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()" @@ -704,7 +728,7 @@ IF (.NOT. obj%isNodeToElementsInitiated) CALL obj%InitiateNodeToElements() ii = obj%GetLocalNodeNumber(globalNode, islocal=islocal) -tsize = SafeSize(obj%nodeData(ii)%globalElements) +tsize = SIZE(obj%nodeData(ii)%globalElements) DO jj = 1, tsize ans(jj) = obj%nodeData(ii)%globalElements(jj) @@ -725,7 +749,7 @@ DO ii = 1, n lnode = obj%GetLocalNodeNumber(globalNode(ii), islocal=islocal) - b = a + SafeSize(obj%nodeData(lnode)%globalElements) + b = a + SIZE(obj%nodeData(lnode)%globalElements) kk = 0 DO jj = a, b - 1 @@ -741,7 +765,7 @@ IF (tsize .LE. 1) RETURN -CALL RemoveDuplicates_(obj=ans, tsize=tsize, isSorted=.FALSE.) +CALL RemoveDuplicates_(obj=ans(1:tsize), tsize=tsize, isSorted=.FALSE.) END PROCEDURE obj_GetNodeToElements2_ !---------------------------------------------------------------------------- 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 From 3f8743cff733b8c13aebce568dac752da3ea300c Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 14:52:55 +0900 Subject: [PATCH 094/119] EAS-68 [close] updates in abstract domain adding no alloc version of get connectivity --- .../src/AbstractDomain_Class.F90 | 51 +++++++++++++++++-- .../src/AbstractDomain_Class@GetMethods.F90 | 40 +++++++++++++++ 2 files changed, 87 insertions(+), 4 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index a9dc792f2..46180e0b6 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -156,16 +156,28 @@ MODULE AbstractDomain_Class 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) :: obj_GetNodeToElements1 + PROCEDURE, PASS(obj) :: GetNodeToElements1 => obj_GetNodeToElements1 !! Get the list of elements connnected to a specified node - PROCEDURE, PASS(obj) :: obj_GetNodeToElements2 + PROCEDURE, PASS(obj) :: GetNodeToElements2 => obj_GetNodeToElements2 !! Get the list of elements connnected to many specified nodes GENERIC, PUBLIC :: GetNodeToElements => & - & obj_GetNodeToElements1, & - & obj_GetNodeToElements2 + & 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 @@ -551,6 +563,37 @@ MODULE FUNCTION obj_GetConnectivity(obj, globalElement, dim, islocal) & 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 index a377c298b..5a43965ba 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@GetMethods.F90 @@ -109,6 +109,46 @@ 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 !---------------------------------------------------------------------------- From fa2a0e699d8da67030d480c44fd0086439bcf4d7 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 14:53:55 +0900 Subject: [PATCH 095/119] EAS-69 [close] update in fedomainconnectivity Adding cell to cell data --- ...FEDomainConnectivity_Class@CellMethods.F90 | 50 ++++++++++--------- 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 index b32208f9c..bd23da74b 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -21,6 +21,19 @@ USE ReallocateUtility USE Display_Method IMPLICIT NONE + +#ifdef MAX_NODES_IN_ELEM +INTEGER(I4B), PARAMETER :: PARAM_MAX_NNE = MAX_NODES_IN_ELEM +#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 + CONTAINS !---------------------------------------------------------------------------- @@ -31,23 +44,21 @@ CHARACTER(*), PARAMETER :: myName = "obj_InitiateCellToCellData1()" INTEGER(I4B) :: ii, nsd, order1, order2, iel1, jj ! some counters and indices -INTEGER(I4B), ALLOCATABLE :: nptrs1(:) -! node number in mesh1 -INTEGER(I4B), ALLOCATABLE :: nptrs2(:), nptrs(:) -! node number in mesh2 -INTEGER(I4B), ALLOCATABLE :: elem2(:) ! 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) :: telem1, minelem, maxelem +INTEGER(I4B) :: minelem, maxelem, telem2 -#ifdef DEBUG_VER #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & & '[START] ') #endif +#ifdef DEBUG_VER + isok = obj%isCellToCell IF (isok) THEN CALL e%RaiseInformation(modName//"::"//myName//" - "// & @@ -80,17 +91,13 @@ nodeToNode => obj%GetNodeToNodePointer() -telem1 = domain1%GetTotalElements(dim=nsd) - ! Get mesh pointer DO iel1 = minelem, maxelem isok = domain1%isElementPresent(globalElement=iel1) IF (.NOT. isok) CYCLE - nptrs1 = domain1%GetConnectivity(globalElement=iel1, islocal=.FALSE., & - dim=nsd) - order1 = SIZE(nptrs1) - CALL Reallocate(nptrs2, order1) + CALL domain1%GetConnectivity_(globalElement=iel1, ans=nptrs1, tsize=order1, & + islocal=.FALSE., dim=nsd) DO ii = 1, order1 nptrs2(ii) = nodeToNode(nptrs1(ii)) END DO @@ -98,20 +105,21 @@ DO ii = 1, order1 IF (nptrs2(ii) .EQ. 0) CYCLE - elem2 = domain2%GetNodeToElements(GlobalNode=nptrs2(ii)) + CALL domain2%GetNodeToElements_(GlobalNode=nptrs2(ii), ans=elem2, & + tsize=telem2, islocal=.FALSE.) - DO jj = 1, SIZE(elem2) + DO jj = 1, telem2 - nptrs = domain2%GetConnectivity(globalElement=elem2(jj), dim=nsd) - order2 = SIZE(nptrs) + CALL domain2%GetConnectivity_(globalElement=elem2(jj), & + ans=nptrs3, tsize=order2, dim=nsd, islocal=.FALSE.) IF (order1 .GE. order2) THEN - IF (nptrs.in.nptrs2) THEN + IF (nptrs3(1:order2) .in.nptrs2(1:order1)) THEN obj%cellToCell(iel1) = elem2(jj) EXIT END IF ELSE - IF (nptrs2.in.nptrs) THEN + IF (nptrs2(1:order1) .in.nptrs3(1:order2)) THEN obj%cellToCell(iel1) = elem2(jj) EXIT END IF @@ -124,10 +132,6 @@ END DO NULLIFY (nodeToNode) -IF (ALLOCATED(nptrs1)) DEALLOCATE (nptrs1) -IF (ALLOCATED(nptrs2)) DEALLOCATE (nptrs2) -IF (ALLOCATED(nptrs)) DEALLOCATE (nptrs) -IF (ALLOCATED(elem2)) DEALLOCATE (elem2) #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & From 38a69746cec623947fa991513c2954e72f8d0d95 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 16:53:56 +0900 Subject: [PATCH 096/119] EAS-8 updates in fedomainconnectivity minor updates --- ...EDomainConnectivity_Class@FacetMethods.F90 | 215 +++++++++--------- 1 file changed, 112 insertions(+), 103 deletions(-) diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 index dc4ec4018..7f9dea9cf 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@FacetMethods.F90 @@ -24,112 +24,115 @@ ! !---------------------------------------------------------------------------- -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 +! 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" @@ -170,7 +173,9 @@ END SUBROUTINE facet_to_cell_helper !---------------------------------------------------------------------------- MODULE PROCEDURE obj_InitiateFacetToCellData2 -! CHARACTER(*), PARAMETER :: myName = "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 @@ -256,12 +261,14 @@ END SUBROUTINE facet_to_cell_helper !---------------------------------------------------------------------------- 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(:) -! CHARACTER(*), PARAMETER :: myName = "obj_InitiateFacetToCellData3" ! LOGICAL(LGT) :: isVar ! ! CALL e%raiseInformation(modName//'::'//myName//' - '// & @@ -376,7 +383,9 @@ END SUBROUTINE facet_to_cell_helper !---------------------------------------------------------------------------- MODULE PROCEDURE obj_InitiateFacetToCellData4 -! CHARACTER(*), PARAMETER :: myName = "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 From 2bc8f7ffc46d2fb4442c55043cf0e6734f1ff956 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 17:14:28 +0900 Subject: [PATCH 097/119] EAS-8 updates in fedomain connectivity usin abstract domain instead of fedomain --- .../src/FEDomainConnectivity_Class.F90 | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 index bed2575ad..a52800fef 100644 --- a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 +++ b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 @@ -21,12 +21,14 @@ MODULE FEDomainConnectivity_Class USE GlobalData, ONLY: LGT, DFP, I4B -! USE BaseType USE AbstractMesh_Class -USE FEDomain_Class +USE AbstractDomain_Class USE ExceptionHandler_Class, ONLY: e + IMPLICIT NONE + PRIVATE + CHARACTER(*), PARAMETER :: modName = "FEDomainConnectivity_Class" INTEGER(I4B), PUBLIC, PARAMETER :: pType = 1 INTEGER(I4B), PUBLIC, PARAMETER :: hType = 2 @@ -388,10 +390,10 @@ END SUBROUTINE obj_DisplayFacetToCellData MODULE SUBROUTINE obj_InitiateNodeToNodeData1(obj, domain1, domain2) CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj !! FEDomain connectivity object - CLASS(FEDomain_), INTENT(INOUT) :: domain1 + CLASS(AbstractDomain_), INTENT(INOUT) :: domain1 !! Primary domain, in nodeToNode(i), i denotes the !! global node number in domain1 domain. - CLASS(FEDomain_), INTENT(INOUT) :: domain2 + CLASS(AbstractDomain_), INTENT(INOUT) :: domain2 !! Secondary domain => nodeToNode(i) denotes the !! global node number in domain2 domain. END SUBROUTINE obj_InitiateNodeToNodeData1 @@ -476,10 +478,10 @@ END FUNCTION obj_GetNodeToNodePointer MODULE SUBROUTINE obj_InitiateCellToCellData1(obj, domain1, domain2) CLASS(FEDomainConnectivity_), INTENT(INOUT) :: obj !! FEDomain connectivity object - CLASS(FEDomain_), INTENT(INOUT) :: domain1 + CLASS(AbstractDomain_), INTENT(INOUT) :: domain1 !! Primary domain, in CellToCell(i), i denotes the !! global element number in domain1 domain. - CLASS(FEDomain_), INTENT(INOUT) :: domain2 + CLASS(AbstractDomain_), INTENT(INOUT) :: domain2 !! Secondary domain => CellToCell(i) denotes the !! global element number in domain2 domain. END SUBROUTINE obj_InitiateCellToCellData1 @@ -581,9 +583,9 @@ MODULE SUBROUTINE obj_InitiateFacetToCellData2(obj, facetFEMesh, & !! FEMesh connectivity data CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh !! FEMesh of facet elements - CLASS(FEDomain_), INTENT(INOUT) :: masterFEDomain + CLASS(AbstractDomain_), INTENT(INOUT) :: masterFEDomain !! FEDomain of master elements - CLASS(FEDomain_), INTENT(INOUT) :: slaveFEDomain + CLASS(AbstractDomain_), INTENT(INOUT) :: slaveFEDomain !! FEDomain of slave elements END SUBROUTINE obj_InitiateFacetToCellData2 END INTERFACE @@ -634,7 +636,7 @@ MODULE SUBROUTINE obj_InitiateFacetToCellData4(obj, facetFEMesh, cellFEDomain) !! FEDomain connectivity data CLASS(AbstractMesh_), INTENT(INOUT) :: facetFEMesh !! FEMesh of facet elements - CLASS(FEDomain_), INTENT(INOUT) :: cellFEDomain + CLASS(AbstractDomain_), INTENT(INOUT) :: cellFEDomain !! Master mesh END SUBROUTINE obj_InitiateFacetToCellData4 END INTERFACE From 4ff16fe90b86a3627a39e8a5ff80c85f5f1aa15d Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 18:19:32 +0900 Subject: [PATCH 098/119] EAS-47 [close] updating abstractdomain adding set sparsity methods. They make call to abstractmesh --- .../src/AbstractDomain_Class.F90 | 4 +- .../src/AbstractDomain_Class@SetMethods.F90 | 154 +++++++++++++----- 2 files changed, 113 insertions(+), 45 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index 46180e0b6..f25b0fee4 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -1415,7 +1415,7 @@ END SUBROUTINE obj_SetShowTime INTERFACE MODULE SUBROUTINE obj_SetSparsity1(obj, mat) - CLASS(AbstractDomain_), INTENT(IN) :: obj + CLASS(AbstractDomain_), INTENT(INOUT) :: obj TYPE(CSRMatrix_), INTENT(INOUT) :: mat END SUBROUTINE obj_SetSparsity1 END INTERFACE @@ -1430,7 +1430,7 @@ END SUBROUTINE obj_SetSparsity1 INTERFACE AbstractDomainSetSparsity MODULE SUBROUTINE obj_SetSparsity2(domains, mat) - CLASS(AbstractDomainPointer_), INTENT(IN) :: domains(:) + CLASS(AbstractDomainPointer_), INTENT(INOUT) :: domains(:) TYPE(CSRMatrix_), INTENT(INOUT) :: mat END SUBROUTINE obj_SetSparsity2 END INTERFACE AbstractDomainSetSparsity diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 index c32132567..94b8936fc 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -16,10 +16,7 @@ ! SUBMODULE(AbstractDomain_Class) SetMethods -! USE BaseMethod -USE FEMesh_Class, ONLY: FEMesh_ -USE DomainConnectivity_Class, ONLY: DomainConnectivity_ -! USE DomainUtility +USE FEDomainConnectivity_Class, ONLY: FEDomainConnectivity_ USE CSRMatrix_Method USE BoundingBox_Method USE Display_Method @@ -114,10 +111,9 @@ matProp = GetMatrixProp(mat) IF (TRIM(matProp) .EQ. "RECTANGLE") THEN - !FIXME: - ! CALL SetSparsity3(domains=domains, mat=mat) + CALL part2_obj_Set_sparsity2(domains=domains, mat=mat) ELSE - CALL part1_obj_set_sparsity2(domains=domains, mat=mat) + CALL part1_obj_Set_sparsity2(domains=domains, mat=mat) END IF matProp = "" @@ -130,21 +126,21 @@ END PROCEDURE obj_SetSparsity2 !---------------------------------------------------------------------------- -! part1_obj_set_sparsity2 +! part1_obj_Set_sparsity2 !---------------------------------------------------------------------------- -SUBROUTINE part1_obj_set_sparsity2(domains, mat) +SUBROUTINE part1_obj_Set_sparsity2(domains, mat) CLASS(AbstractDomainPointer_), INTENT(IN) :: domains(:) TYPE(CSRMatrix_), INTENT(INOUT) :: mat - INTEGER(I4B) :: ivar, jvar, rowLBOUND, rowUBOUND, colLBOUND, colUBOUND + ! internal variables + CHARACTER(*), PARAMETER :: myName = "part1_obj_Set_sparsity2()" + INTEGER(I4B) :: ivar, jvar CLASS(AbstractDomain_), POINTER :: rowDomain, colDomain CLASS(AbstractMesh_), POINTER :: rowMesh, colMesh - TYPE(DomainConnectivity_) :: domainConn + TYPE(FEDomainConnectivity_) :: domainConn INTEGER(I4B), POINTER :: nodeToNode(:) - CHARACTER(*), PARAMETER :: myName = "part1_obj_set_sparsity2()" - TYPE(BoundingBox_) :: row_box, col_box - LOGICAL(LGT) :: is_intersect, isdebug + LOGICAL(LGT) :: isdebug isdebug = .FALSE. @@ -165,57 +161,129 @@ SUBROUTINE part1_obj_set_sparsity2(domains, mat) IF (isdebug) CALL Display("row domain = "//tostring(ivar)) rowDomain => domains(ivar)%ptr - rowMesh => rowDomain%meshVolume + IF (.NOT. ASSOCIATED(rowDomain)) CYCLE + + rowMesh => rowDomain%GetMeshPointer(dim=rowDomain%GetNSD()) IF (.NOT. ASSOCIATED(rowMesh)) CYCLE IF (rowMesh%isEmpty()) CYCLE - row_box = rowMesh%GetBoundingBox() - rowLBOUND = LBOUND(rowMesh%local_nptrs, 1) - rowUBOUND = UBOUND(rowMesh%local_nptrs, 1) DO jvar = 1, SIZE(domains) IF (isdebug) CALL Display("col domain = "//tostring(jvar)) colDomain => domains(jvar)%ptr - colMesh => colDomain%meshVolume + IF (.NOT. ASSOCIATED(colDomain)) CYCLE + + colMesh => colDomain%GetMeshPointer(dim=colDomain%GetNSD()) IF (.NOT. ASSOCIATED(colMesh)) CYCLE IF (colMesh%isEmpty()) CYCLE - col_box = colMesh%getBoundingBox() - is_intersect = row_box.isIntersect.col_box - colLBOUND = LBOUND(colMesh%local_nptrs, 1) - colUBOUND = UBOUND(colMesh%local_nptrs, 1) CALL domainConn%DEALLOCATE() - !FIXME: - ! CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & - ! & domain2=colDomain) + CALL domainConn%InitiateNodeToNodeData(domain1=rowDomain, & + & domain2=colDomain) nodeToNode => domainConn%GetNodeToNodePointer() - IF (is_intersect) THEN - CALL rowMesh%SetSparsity( & - & mat=mat, & - & colMesh=colMesh, & - & nodeToNode=nodeToNode, & - & ivar=ivar, & - & jvar=jvar) - END IF + 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) - !FIXME: - ! CALL domainConn%DEALLOCATE() + CALL domainConn%DEALLOCATE() #ifdef DEBUG_VER CALL e%RaiseInformation(modName//'::'//myName//' - '// & & '[END] ') #endif -END SUBROUTINE part1_obj_set_sparsity2 +END SUBROUTINE part2_obj_Set_sparsity2 !---------------------------------------------------------------------------- ! SetTotalMaterial @@ -243,7 +311,7 @@ END SUBROUTINE part1_obj_set_sparsity2 CALL e%RaiseError(modName//'::'//myName//' - '// & & '[WIP ERROR] :: This routine is under development') -! meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) +! meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum) ! CALL meshptr%SetMaterial(medium=medium, material=material) ! meshptr => NULL() END PROCEDURE obj_SetMaterial @@ -300,8 +368,8 @@ END SUBROUTINE part1_obj_set_sparsity2 ! 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 +! meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum) +! IF (meshptr%GetTotalElements() .EQ. 0) THEN ! CALL e%RaiseWarning(modName//'::'//myName//' - '// & ! & 'mesh if empty') ! ELSE @@ -318,13 +386,13 @@ END SUBROUTINE part1_obj_set_sparsity2 ! END IF ! ! IF (PRESENT(dim) .AND. .NOT. PRESENT(entityNum)) THEN -! tmesh = obj%getTotalMesh(dim=dim) +! 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 +! meshptr => obj%GetMeshPointer(dim=dim, entityNum=imesh) +! IF (meshptr%GetTotalElements() .EQ. 0) THEN ! max_(:, imesh) = -1 * MaxDFP ! min_(:, imesh) = MaxDFP ! ELSE From 8ec0d43213183bf395f5dad8c7352d5c50dee248 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 19:28:28 +0900 Subject: [PATCH 099/119] EAS-75 [wip] updates in abstract mesh Adding interface to set material in the mesh. work in progress. --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 34 +++++++++++++++++-- .../src/AbstractMesh_Class@SetMethods.F90 | 14 ++++++-- 2 files changed, 43 insertions(+), 5 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 7df449811..d936d63ff 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -539,8 +539,14 @@ MODULE AbstractMesh_Class PROCEDURE, PUBLIC, PASS(obj) :: SetTotalMaterial => obj_SetTotalMaterial !! Adding a material ID of a medium which is mapped to the mesh - PROCEDURE, PUBLIC, PASS(obj) :: SetMaterial => obj_setMaterial + + 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 + GENERIC, PUBLIC :: SetMaterial => SetMaterial1, SetMaterial2 + PROCEDURE, PUBLIC, PASS(obj) :: SetFacetElementType => & & obj_SetFacetElementType !! Set the facet element type of a given cell number @@ -2532,11 +2538,33 @@ END SUBROUTINE obj_SetTotalMaterial ! summary: Set the materials id of a given medium INTERFACE - MODULE SUBROUTINE obj_SetMaterial(obj, medium, material) + 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_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 !---------------------------------------------------------------------------- diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index bbf260aa1..b9caf66ad 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -216,9 +216,19 @@ ! setMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_SetMaterial +MODULE PROCEDURE obj_SetMaterial2 obj%material(medium) = material -END PROCEDURE obj_SetMaterial +END PROCEDURE obj_SetMaterial2 + +!---------------------------------------------------------------------------- +! setMaterial +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_SetMaterial1 +CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial1()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP ERROR] :: This routine is under development') +END PROCEDURE obj_SetMaterial1 !---------------------------------------------------------------------------- ! setFacetElementType From 80b7206192fe8febfe98eba7f197501930d8809b Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 19:30:19 +0900 Subject: [PATCH 100/119] EAS-77 [wip] updates in abstract domain structure - adding mesh pointer --- .../AbstractDomain/src/AbstractDomain_Class.F90 | 11 ++++++++++- .../src/AbstractDomain_Class@ConstructorMethods.F90 | 13 +++++++++++++ .../src/AbstractDomain_Class@IOMethods.F90 | 5 ++++- 3 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 index f25b0fee4..c4dc43f57 100644 --- a/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 +++ b/src/modules/AbstractDomain/src/AbstractDomain_Class.F90 @@ -111,6 +111,11 @@ MODULE AbstractDomain_Class !! 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(:) @@ -1466,9 +1471,13 @@ 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 @@ -1478,7 +1487,7 @@ END SUBROUTINE obj_SetMaterial !> author: Vikas Sharma, Ph. D. ! date: 2023-02-24 -! summary: SetNodeCoord +! summary: Set the node coordinate of the domain INTERFACE MODULE SUBROUTINE obj_SetNodeCoord1(obj, nodeCoord, scale, & diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 index 4c2dce54c..856e8c43f 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 @@ -41,6 +41,17 @@ 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] ') @@ -72,6 +83,8 @@ obj%tEntities(0:3) = 0 CALL DEALLOCATE (obj%meshmap) +obj%mesh => NULL() + IF (ASSOCIATED(obj%meshVolume)) THEN CALL obj%meshVolume%DEALLOCATE() obj%meshVolume => NULL() diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 index 46cf8a0e1..a3291038a 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@IOMethods.F90 @@ -94,6 +94,9 @@ 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 @@ -467,7 +470,7 @@ END SUBROUTINE AbstractDomainImportMetaData #ifdef DEBUG_VER IF (PRESENT(printToml)) THEN CALL Display(toml_serialize(node), "AbstractDomain toml config: "//CHAR_LF, & - & unitno=stdout) + & unitno=stdout) END IF #endif From 8037458697ac0d0e908e58c5a6fd8663166445e8 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 19:31:45 +0900 Subject: [PATCH 101/119] EAS-50 [close] updates in abstractdomain class adding setmaterial method. this calls mesh mesh issue is wip. --- .../src/AbstractDomain_Class@SetMethods.F90 | 79 +++++++++++++++---- 1 file changed, 63 insertions(+), 16 deletions(-) diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 index 94b8936fc..cb456c058 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -71,30 +71,35 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_SetSparsity2 +#ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity2()" INTEGER(I4B) :: ivar, nsd(SIZE(domains)) -CHARACTER(:), ALLOCATABLE :: matProp 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') + & '[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') + & '[INTERNAL ERROR] :: domains('//Tostring(ivar)//')%ptr NOT INITIATED') + RETURN END IF nsd(ivar) = domains(ivar)%ptr%GetNSD() @@ -108,9 +113,11 @@ RETURN END IF +#endif + matProp = GetMatrixProp(mat) -IF (TRIM(matProp) .EQ. "RECTANGLE") THEN +IF (matProp .EQ. "RECTANGLE") THEN CALL part2_obj_Set_sparsity2(domains=domains, mat=mat) ELSE CALL part1_obj_Set_sparsity2(domains=domains, mat=mat) @@ -307,13 +314,35 @@ END SUBROUTINE part2_obj_Set_sparsity2 !---------------------------------------------------------------------------- MODULE PROCEDURE obj_SetMaterial +#ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') +#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 -! meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum) -! CALL meshptr%SetMaterial(medium=medium, material=material) -! meshptr => NULL() END PROCEDURE obj_SetMaterial !---------------------------------------------------------------------------- @@ -321,9 +350,16 @@ END SUBROUTINE part2_obj_Set_sparsity2 !---------------------------------------------------------------------------- MODULE PROCEDURE obj_SetNodeCoord1 +#ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_SetNodeCoord1()" -REAL(DFP) :: scale0 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 @@ -340,15 +376,26 @@ END SUBROUTINE part2_obj_Set_sparsity2 & 'with obj_::obj%nodeCoord') RETURN END IF +#endif scale0 = Input(option=scale, default=1.0_DFP) - -IF (PRESENT(addContribution)) THEN - obj%nodeCoord = obj%nodeCoord + scale * nodeCoord -ELSE - obj%nodeCoord = nodeCoord +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 !---------------------------------------------------------------------------- From 5b364a9231920f5969f6f3a7a5719475ce4e5ed8 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 20:42:49 +0900 Subject: [PATCH 102/119] EAS-75 [wip] Updates in ElemData_Class minor updates adding some function related to setting the material properties --- .../AbstractMesh/src/ElemData_Class.F90 | 47 +++++++++++++++++-- 1 file changed, 43 insertions(+), 4 deletions(-) diff --git a/src/modules/AbstractMesh/src/ElemData_Class.F90 b/src/modules/AbstractMesh/src/ElemData_Class.F90 index b16bdae18..2da151472 100644 --- a/src/modules/AbstractMesh/src/ElemData_Class.F90 +++ b/src/modules/AbstractMesh/src/ElemData_Class.F90 @@ -39,13 +39,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 @@ -83,7 +84,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 @@ -201,6 +202,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) @@ -274,7 +280,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) @@ -284,13 +290,29 @@ 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 + +SUBROUTINE ElemData_SetTotalMaterial(obj, n) + TYPE(ElemData_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: n + ALLOCATE (obj%material(n)) +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) @@ -317,6 +339,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 @@ -329,6 +357,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 !---------------------------------------------------------------------------- From 8791db3ffc1245ac4b4843b859e6942de5423ae7 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 20:56:31 +0900 Subject: [PATCH 103/119] EAS-75 [close] updates in abstract mesh - adding set material method to abstract mesh --- .../src/AbstractMesh_Class@SetMethods.F90 | 33 ++++++++++++++----- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index b9caf66ad..0567004b3 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 @@ -216,19 +217,35 @@ ! setMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_SetMaterial2 -obj%material(medium) = material -END PROCEDURE obj_SetMaterial2 +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 + +END DO + +END PROCEDURE obj_SetMaterial1 !---------------------------------------------------------------------------- ! setMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE obj_SetMaterial1 -CHARACTER(*), PARAMETER :: myName = "obj_SetMaterial1()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') -END PROCEDURE obj_SetMaterial1 +MODULE PROCEDURE obj_SetMaterial2 +obj%material(medium) = material +END PROCEDURE obj_SetMaterial2 !---------------------------------------------------------------------------- ! setFacetElementType From 4d4fca16c4dfd5573e75369f85cf198365efaa99 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Fri, 12 Apr 2024 21:11:56 +0900 Subject: [PATCH 104/119] EAS-76 [close] wip --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 11 ----------- src/modules/Mesh/src/Mesh_Class.F90 | 12 ++++++++++++ 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index d936d63ff..5f288c820 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -129,17 +129,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(:) diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index 517ac88d1..8b6931363 100755 --- a/src/modules/Mesh/src/Mesh_Class.F90 +++ b/src/modules/Mesh/src/Mesh_Class.F90 @@ -73,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 From 5ba92000c62293ae1c05ad89d1331ef381d6ec91 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 10:49:09 +0900 Subject: [PATCH 105/119] EAS-75 updates in elemdata_class updating elemdata_settotalmaterial method --- .../AbstractMesh/src/ElemData_Class.F90 | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/src/modules/AbstractMesh/src/ElemData_Class.F90 b/src/modules/AbstractMesh/src/ElemData_Class.F90 index 2da151472..4c3d94975 100644 --- a/src/modules/AbstractMesh/src/ElemData_Class.F90 +++ b/src/modules/AbstractMesh/src/ElemData_Class.F90 @@ -23,6 +23,7 @@ MODULE ElemData_Class USE ReferenceQuadrangle_Method, ONLY: HelpFaceData_Quadrangle, & & FaceShapeMetaData_Quadrangle USE SortUtility +USE ReallocateUtility IMPLICIT NONE PRIVATE @@ -300,10 +301,24 @@ END SUBROUTINE ElemData_Deallocate ! ! this subroutine allocates materials in obj -SUBROUTINE ElemData_SetTotalMaterial(obj, n) +PURE SUBROUTINE ElemData_SetTotalMaterial(obj, n) TYPE(ElemData_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: n - ALLOCATE (obj%material(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 !---------------------------------------------------------------------------- From b62ea594d9c16d4d1d92a1911d5337f8b7f4a695 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 10:51:17 +0900 Subject: [PATCH 106/119] EAS-81 EAS-82 [close] updates in abstract mesh - adding new methods - some methods are kept for compatibility with mesh (old style) - improving node to nodes - adding no alloc ver of node to node --- .../AbstractMesh/src/AbstractMesh_Class.F90 | 260 ++++++++++++++--- src/modules/Mesh/src/Mesh_Class.F90 | 80 ++++++ .../AbstractMesh_Class@ConstructorMethods.F90 | 1 - .../src/AbstractMesh_Class@GetMethods.F90 | 262 ++++++++++++++---- .../src/AbstractMesh_Class@IOMethods.F90 | 6 - .../src/AbstractMesh_Class@SetMethods.F90 | 123 +++++++- .../src/Mesh_Class@ConstructorMethods.F90 | 2 + .../Mesh/src/Mesh_Class@GetMethods.F90 | 30 ++ .../Mesh/src/Mesh_Class@IOMethods.F90 | 6 + .../Mesh/src/Mesh_Class@SetMethods.F90 | 27 ++ 10 files changed, 670 insertions(+), 127 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 5f288c820..0c512644a 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 @@ -65,10 +65,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 @@ -225,7 +225,7 @@ MODULE AbstractMesh_Class & obj_DisplayMeshInfo !! Display mesh statistics - ! SET: + ! Set: ! @NodeDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToElements => & & obj_InitiateNodeToElements @@ -237,29 +237,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 @@ -423,6 +423,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 @@ -482,11 +490,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) :: GetTotalMaterial => obj_GetTotalMaterial - !! returns the total material + 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) :: 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 @@ -500,46 +518,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, 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 + 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 + 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 - GENERIC, PUBLIC :: SetMaterial => SetMaterial1, SetMaterial2 + 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_ @@ -1684,6 +1709,73 @@ MODULE FUNCTION obj_GetNodeToNodes2(obj, globalNode, includeSelf, & 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 !---------------------------------------------------------------------------- @@ -1821,11 +1913,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 !---------------------------------------------------------------------------- @@ -1837,10 +1948,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 !---------------------------------------------------------------------------- @@ -2395,7 +2524,7 @@ END SUBROUTINE obj_SetBoundingBox2 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2438,7 +2567,7 @@ END SUBROUTINE obj_SetSparsity2 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2453,9 +2582,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 @@ -2466,7 +2595,7 @@ END SUBROUTINE obj_SetSparsity3 END INTERFACE !---------------------------------------------------------------------------- -! SetSparsity@setMethod +! SetSparsity@SetMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2512,10 +2641,48 @@ 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 + INTEGER(I4B), INTENT(IN) :: globalElement + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: islocal + END SUBROUTINE obj_SetTotalMaterial1 +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(AbstractMesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: n - END SUBROUTINE obj_SetTotalMaterial + 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 + !! type of medium like clay, sand, water1, water2 + END SUBROUTINE obj_SetMaterial1 END INTERFACE !---------------------------------------------------------------------------- @@ -2535,7 +2702,7 @@ END SUBROUTINE obj_SetMaterial2 END INTERFACE !---------------------------------------------------------------------------- -! SetMaterial@setMethods +! SetMaterial@SetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2544,16 +2711,19 @@ END SUBROUTINE obj_SetMaterial2 ! summary: Set the materials id of a given medium INTERFACE - MODULE SUBROUTINE obj_SetMaterial1(obj, entityNum, & - & medium, material) + MODULE SUBROUTINE obj_SetMaterial3(obj, medium, material, globalElement, & + islocal) 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 !! type of medium like clay, sand, water1, water2 - END SUBROUTINE obj_SetMaterial1 + 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 !---------------------------------------------------------------------------- diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index 8b6931363..3a16d5f5e 100755 --- a/src/modules/Mesh/src/Mesh_Class.F90 +++ b/src/modules/Mesh/src/Mesh_Class.F90 @@ -131,6 +131,7 @@ MODULE Mesh_Class ! GET: ! @GetMethods + PROCEDURE, PUBLIC, PASS(obj) :: GetRefElemPointer => & & obj_GetRefElemPointer !! Returns pointer to the reference element @@ -146,6 +147,15 @@ MODULE Mesh_Class 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 @@ -156,6 +166,14 @@ MODULE Mesh_Class 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_ !---------------------------------------------------------------------------- @@ -482,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 !---------------------------------------------------------------------------- @@ -726,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/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@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index 177bfaaf5..c117fe7a7 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -72,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 @@ -183,7 +183,7 @@ MODULE PROCEDURE obj_isBoundaryNode INTEGER(I4B) :: localnode -localnode = obj%GetLocalNodeNumber(GlobalNode, islocal=islocal) +localnode = obj%GetLocalNodeNumber(globalNode, islocal=islocal) ans = obj%nodeData(localnode)%nodeType .NE. INTERNAL_NODE END PROCEDURE obj_isBoundaryNode @@ -546,23 +546,23 @@ 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) @@ -574,26 +574,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) @@ -604,7 +604,7 @@ #endif ans = obj%elementData(localElement)%globalElemNum -END PROCEDURE obj_GetGlobalElemNumber2 +END PROCEDURE obj_GetglobalElemNumber2 !---------------------------------------------------------------------------- ! GetLocalElemNumber @@ -623,7 +623,7 @@ MODULE PROCEDURE obj_GetLocalElemNumber2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_GetGlobalElemNumber2()" +CHARACTER(*), PARAMETER :: myName = "obj_GetglobalElemNumber2()" LOGICAL(LGT) :: problem #endif @@ -778,7 +778,9 @@ LOGICAL(LGT) :: problem #endif -INTEGER(I4B) :: i +LOGICAL(LGT) :: abool + +INTEGER(I4B) :: i, j #ifdef DEBUG_VER problem = .NOT. obj%isNodePresent(globalNode=globalNode, islocal=islocal) @@ -790,32 +792,36 @@ END IF #endif -i = obj%GetLocalNodeNumber(GlobalNode=GlobalNode, islocal=islocal) +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 -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 @@ -828,30 +834,151 @@ !---------------------------------------------------------------------------- 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), islocal=islocal) - 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 + +a = 0 +IF (IncludeSelf) THEN + + ans(1) = obj%GetglobalNodeNumber(i) + a = 1 + tsize = 1 + +END IF + +tsize = a + SIZE(obj%nodeData(i)%globalNodes) +ans(a + 1:tsize) = obj%nodedata(i)%globalNodes + +abool = obj%isExtraNodeToNodesInitiated +IF (abool) THEN + + a = tsize + tsize = tsize + SIZE(obj%nodeData(i)%extraglobalNodes) + ans(a + 1:tsize) = obj%nodedata(i)%extraglobalNodes + +END IF + +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 @@ -944,31 +1071,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 -isok = ALLOCATED(obj%material) -IF (.NOT. isok) RETURN +!---------------------------------------------------------------------------- +! GetMaterial +!---------------------------------------------------------------------------- -isok = medium .LE. SIZE(obj%material) -IF (.NOT. isok) RETURN -#endif +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 -ans = obj%material(medium) -END PROCEDURE obj_GetMaterial +!---------------------------------------------------------------------------- +! GetTotalMaterial +!---------------------------------------------------------------------------- + +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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@IOMethods.F90 index 0cd76cce1..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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index 0567004b3..61417ad90 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -74,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") @@ -95,6 +96,7 @@ & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') RETURN END IF + #endif tNodes = obj%GetTotalNodes() @@ -136,6 +138,7 @@ #endif #ifdef DEBUG_VER + IF (.NOT. obj%isInitiated) THEN CALL e%RaiseError(modName//"::"//myName//" - "// & & "[INTERNAL ERROR] :: Mesh data is not initiated, first initiate") @@ -157,6 +160,7 @@ & '[INTERNAL ERROR] :: In mesh NodeToNodeData is not initiated') RETURN END IF + #endif tNodes = obj%GetTotalNodes() @@ -180,8 +184,66 @@ MODULE PROCEDURE obj_SetSparsity3 CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity3()" -CALL e%RaiseError(modName//'::'//myName//' - '// & - & '[WIP ERROR] :: This routine is under development') +LOGICAL(LGT) :: problem +INTEGER(I4B) :: ii +INTEGER(I4B), ALLOCATABLE :: temp(:) +LOGICAL(LGT), ALLOCATABLE :: maskVec(:) + +#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 = obj%minNptrs, obj%maxNptrs + IF (.NOT. obj%IsNodePresent(globalNode=ii)) CYCLE + temp = nodeToNode(obj%GetNodeToNodes(GlobalNode=ii, IncludeSelf=.TRUE.)) + maskVec = colMesh%IsNodePresent(globalNode=temp) + + IF (ANY(maskVec)) THEN + CALL SetSparsity( & + & obj=mat, & + & row=ii, & + & col=PACK(temp, maskVec), & + & ivar=ivar, & + & jvar=jvar) + END IF + +END DO + +IF (ALLOCATED(temp)) DEALLOCATE (temp) +IF (ALLOCATED(maskVec)) DEALLOCATE (maskVec) + +#ifdef DEBUG_VER +CALL e%RaiseInformation(modName//'::'//myName//' - '// & + & '[END] ') +#endif + END PROCEDURE obj_SetSparsity3 !---------------------------------------------------------------------------- @@ -198,20 +260,26 @@ ! 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 -CALL Reallocate(obj%material, n) -END PROCEDURE obj_SetTotalMaterial +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 @@ -244,9 +312,34 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_SetMaterial2 -obj%material(medium) = material +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 !---------------------------------------------------------------------------- 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 0231e6bd8..c7c25a784 100644 --- a/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@GetMethods.F90 @@ -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..be019bfb7 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 !---------------------------------------------------------------------------- diff --git a/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 index dbec84847..8583923ef 100644 --- a/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@SetMethods.F90 @@ -243,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 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From 79043f8475b0d224298da20431fb99cec134deaa Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 10:52:47 +0900 Subject: [PATCH 107/119] EAS-6 [minor] update in abstractdomain removing showtime reset in deallocate, because we call deallocate during init. so this setting is overwritten. --- .../src/AbstractDomain_Class@ConstructorMethods.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 index 856e8c43f..22e62c1a6 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@ConstructorMethods.F90 @@ -63,7 +63,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_Deallocate -obj%showTime = .FALSE. +! obj%showTime = .FALSE. obj%isInitiated = .FALSE. obj%engine = '' obj%majorVersion = 0 From 8dbfd0d47d89b587fe8baeef87f319b154bf32da Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:51:29 +0900 Subject: [PATCH 108/119] EAS-2 [minor] adding param in abstract mesh mesh related macro param added. --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 0c512644a..095fe7657 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -40,6 +40,18 @@ MODULE AbstractMesh_Class 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_ !---------------------------------------------------------------------------- From 5a832cd1842f523717bd880ef1ddf24b1c73813d Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:52:03 +0900 Subject: [PATCH 109/119] EAS-6 [mino] updates in abstract domain --- .../src/FEDomainConnectivity_Class.F90 | 24 ++++++++++++++----- 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 index a52800fef..2d35a596d 100644 --- a/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 +++ b/src/modules/FEDomainConnectivity/src/FEDomainConnectivity_Class.F90 @@ -29,16 +29,28 @@ MODULE FEDomainConnectivity_Class PRIVATE -CHARACTER(*), PARAMETER :: modName = "FEDomainConnectivity_Class" -INTEGER(I4B), PUBLIC, PARAMETER :: pType = 1 -INTEGER(I4B), PUBLIC, PARAMETER :: hType = 2 -INTEGER(I4B), PUBLIC, PARAMETER :: rType = 3 -INTEGER(I4B), PUBLIC, PARAMETER :: oversetType = 4 - 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_ !---------------------------------------------------------------------------- From 6f83ad97b5ed74f8e462ebc0ce0f9bc6a5390ad8 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:52:20 +0900 Subject: [PATCH 110/119] EAS-2 [minor] updates in femesh --- src/modules/FEMesh/src/FEMesh_Class.F90 | 243 +----------------------- 1 file changed, 6 insertions(+), 237 deletions(-) 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 - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From f1aad2ab0d7a9624b68384bed81c6239612496d2 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:52:47 +0900 Subject: [PATCH 111/119] EAS-2 updating methods in abstract mesh --- .../src/AbstractMesh_Class@GetMethods.F90 | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index c117fe7a7..b85a41274 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -895,19 +895,83 @@ 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 @@ -916,6 +980,8 @@ END IF +#endif + END PROCEDURE obj_GetNodeToNodes1_ !---------------------------------------------------------------------------- From 7666a6dceb318eea8b6fd61f945f6ec231ab442e Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:52:59 +0900 Subject: [PATCH 112/119] EAS-2 updating methods in abstract mesh --- .../src/AbstractMesh_Class@SetMethods.F90 | 113 ++++++++++-------- 1 file changed, 60 insertions(+), 53 deletions(-) diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index 61417ad90..3ea57e187 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -15,7 +15,7 @@ ! along with this program. If not, see SUBMODULE(AbstractMesh_Class) SetMethods -USE GlobalData, ONLY: INT8 +USE globalData, ONLY: INT8 USE BoundingBox_Method USE ReallocateUtility USE CSRMatrix_Method @@ -65,8 +65,8 @@ LOGICAL(LGT) :: problem #endif -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//' - '// & @@ -89,28 +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//' - '// & @@ -124,17 +127,17 @@ MODULE PROCEDURE obj_SetSparsity2 #ifdef DEBUG_VER -CHARACTER(*), PARAMETER :: myName = "obj_setSparsity1()" +CHARACTER(*), PARAMETER :: myName = "obj_setSparsity2()" INTEGER(I4B) :: tsize LOGICAL(LGT) :: problem #endif -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 @@ -153,24 +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//' - '// & @@ -184,10 +186,10 @@ MODULE PROCEDURE obj_SetSparsity3 CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity3()" -LOGICAL(LGT) :: problem -INTEGER(I4B) :: ii -INTEGER(I4B), ALLOCATABLE :: temp(:) -LOGICAL(LGT), ALLOCATABLE :: maskVec(:) +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//' - '// & @@ -220,24 +222,29 @@ ! check IF (.NOT. obj%isNodeToNodesInitiated) CALL obj%InitiateNodeToNodes() -DO ii = obj%minNptrs, obj%maxNptrs - IF (.NOT. obj%IsNodePresent(globalNode=ii)) CYCLE - temp = nodeToNode(obj%GetNodeToNodes(GlobalNode=ii, IncludeSelf=.TRUE.)) - maskVec = colMesh%IsNodePresent(globalNode=temp) - - IF (ANY(maskVec)) THEN - CALL SetSparsity( & - & obj=mat, & - & row=ii, & - & col=PACK(temp, maskVec), & - & ivar=ivar, & - & jvar=jvar) - END IF +DO ii = 1, obj%tNodes -END DO + 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 -IF (ALLOCATED(temp)) DEALLOCATE (temp) -IF (ALLOCATED(maskVec)) DEALLOCATE (maskVec) + 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//' - '// & From 878cd83c2463385e66144753a92586d04320f5c1 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:53:20 +0900 Subject: [PATCH 113/119] EAS-2 [minor] updates in femesh --- .../src/FEMesh_Class@BoundaryDataMethods.F90 | 95 +----- .../src/FEMesh_Class@FacetDataMethods.F90 | 132 +------- .../FEMesh/src/FEMesh_Class@SetMethods.F90 | 295 +----------------- 3 files changed, 6 insertions(+), 516 deletions(-) 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 From 72e14b2710caaa5ade6fbc0cf21a4158f508b9e9 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Sat, 13 Apr 2024 12:53:39 +0900 Subject: [PATCH 114/119] [EAS-6] [minor] updates in abstract domain --- .../src/FEDomainConnectivity_Class@CellMethods.F90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 index bd23da74b..0232a67a3 100644 --- a/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 +++ b/src/submodules/FEDomainConnectivity/src/FEDomainConnectivity_Class@CellMethods.F90 @@ -22,18 +22,6 @@ USE Display_Method IMPLICIT NONE -#ifdef MAX_NODES_IN_ELEM -INTEGER(I4B), PARAMETER :: PARAM_MAX_NNE = MAX_NODES_IN_ELEM -#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 - CONTAINS !---------------------------------------------------------------------------- From a07f50e3d6447282be640d35d694ddfa9c0e495a Mon Sep 17 00:00:00 2001 From: shion Date: Mon, 15 Apr 2024 15:19:14 +0900 Subject: [PATCH 115/119] Updates in Mesh_Class - bug is fixed --- .../AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 | 2 +- .../AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 | 4 ++-- src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 | 4 ++++ 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 index cb456c058..bc1afe90c 100644 --- a/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 +++ b/src/submodules/AbstractDomain/src/AbstractDomain_Class@SetMethods.F90 @@ -37,8 +37,8 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_SetSparsity1 -#ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_SetSparsity1()" +#ifdef DEBUG_VER IF (.NOT. obj%isInitiated) THEN CALL e%RaiseError(modName//"::"//myName//" - "// & diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 index 3ea57e187..3cdc4d201 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@SetMethods.F90 @@ -62,8 +62,8 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_setSparsity1()" INTEGER(I4B) :: tsize -LOGICAL(LGT) :: problem #endif +LOGICAL(LGT) :: problem INTEGER(I4B) :: i, j, k, tNodes, tsize INTEGER(I4B) :: n2n(PARAM_MAX_NODE_TO_NODE) @@ -129,8 +129,8 @@ #ifdef DEBUG_VER CHARACTER(*), PARAMETER :: myName = "obj_setSparsity2()" INTEGER(I4B) :: tsize -LOGICAL(LGT) :: problem #endif +LOGICAL(LGT) :: problem INTEGER(I4B) :: i, j, tNodes, tsize INTEGER(I4B) :: n2n(PARAM_MAX_NODE_TO_NODE) diff --git a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 index be019bfb7..2561a570a 100644 --- a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 @@ -79,6 +79,10 @@ isok = obj%xidim .GT. 0 IF (isok) THEN temp4 = TotalEntities(obj%elemType) + SELECT CASE (ElementTopology(obj%elemType)) + CASE (Line) + temp4(1) = 2 + END SELECT ALLOCATE (obj%facetElements(temp4(obj%xidim))) CALL GetFacetElements(refelem=obj%refelem, ans=obj%facetElements) END IF From 24fda0a0d9cbf7d61755c1e003cfa916a3ed249a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 15 Apr 2024 16:54:12 +0900 Subject: [PATCH 116/119] Enhancing implementaton of import method in mesh. --- src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 index 2561a570a..157c4a652 100644 --- a/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@IOMethods.F90 @@ -79,10 +79,11 @@ isok = obj%xidim .GT. 0 IF (isok) THEN temp4 = TotalEntities(obj%elemType) - SELECT CASE (ElementTopology(obj%elemType)) - CASE (Line) - temp4(1) = 2 - END SELECT + !! 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 From 86cca20c5e6544093a54c5f9819e2289830cd25f Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Wed, 17 Apr 2024 10:21:01 +0900 Subject: [PATCH 117/119] adding tsize in getnptrs in abstractmesh EAS-137 Adding tsize as optional parameter in `GetNptrs_` method in `AbstractMesh_Class.F90` --- src/modules/AbstractMesh/src/AbstractMesh_Class.F90 | 3 ++- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 10 ++++++---- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 index 095fe7657..8ed51fc21 100644 --- a/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 +++ b/src/modules/AbstractMesh/src/AbstractMesh_Class.F90 @@ -1008,9 +1008,10 @@ END FUNCTION obj_GetNptrs ! summary: Returns the vector of global node numbers INTERFACE - MODULE SUBROUTINE obj_GetNptrs_(obj, nptrs) + 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 diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 index b85a41274..78700f116 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -89,7 +89,7 @@ END PROCEDURE obj_GetBoundingEntity !---------------------------------------------------------------------------- -! GetNptrs +! GetNptrs !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrs @@ -100,14 +100,16 @@ END PROCEDURE obj_GetNptrs !---------------------------------------------------------------------------- -! GetNptrs_ +! GetNptrs_ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetNptrs_ -INTEGER(I4B) :: ii -DO CONCURRENT(ii=1:SIZE(obj%nodeData)) +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_ !---------------------------------------------------------------------------- From 68ea3fd0b86ddb8d3b4f1eb632267542f93fcc79 Mon Sep 17 00:00:00 2001 From: shion <106575883+shishiousan@users.noreply.github.com> Date: Sat, 16 Mar 2024 17:46:03 +0900 Subject: [PATCH 118/119] Updates in ScalarField_Class - Working in progress --- .../ScalarField/src/ScalarField_Class@SetMethods.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) 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 From 821102e48af7f2a2146a1e8d760497b2e482da9f Mon Sep 17 00:00:00 2001 From: shion Date: Tue, 4 Jun 2024 18:18:02 +0900 Subject: [PATCH 119/119] Updates in classes - minor changes --- src/modules/AbstractKernel/src/AbstractKernel_Class.F90 | 2 ++ src/modules/AbstractMesh/src/ElemData_Class.F90 | 8 ++++---- src/modules/FPL/src/FPL_Method.F90 | 2 +- .../src/AbstractKernel_Class@ConstructorMethods.F90 | 1 + src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 | 2 +- .../src/AbstractMesh_Class@EdgeDataMethods.F90 | 6 +++--- .../src/AbstractMesh_Class@ElementDataMethods.F90 | 2 +- .../src/AbstractMesh_Class@FaceDataMethods.F90 | 8 ++++---- .../AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 | 6 +++--- src/submodules/RefElement/src/Topology_Class@Methods.F90 | 8 ++++++++ 10 files changed, 28 insertions(+), 17 deletions(-) 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/ElemData_Class.F90 b/src/modules/AbstractMesh/src/ElemData_Class.F90 index 4c3d94975..19b8aa8b3 100644 --- a/src/modules/AbstractMesh/src/ElemData_Class.F90 +++ b/src/modules/AbstractMesh/src/ElemData_Class.F90 @@ -18,8 +18,8 @@ MODULE ElemData_Class USE GlobalData, ONLY: I4B, DFP, LGT, INT8 USE Display_Method, ONLY: Display -USE ReferenceElement_Method, ONLY: REFELEM_MAX_FACES, & - & 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 @@ -439,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/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/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 0b2346454..5c3e85a44 100644 --- a/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMeshUtility.F90 @@ -58,7 +58,7 @@ SUBROUTINE InitiateElementToElements3D(elementData, tFaceInMesh, showTime) CHARACTER(*), PARAMETER :: myName = "obj_InitiateElementToElements3D()" LOGICAL(LGT) :: problem, isok1, isok2, isbndy INTEGER(I4B) :: telems, iel, aint, bint, tfaces, ii, jj, & - & temp1(3 * REFELEM_MAX_FACES), cint, bndyflag(REFELEM_MAX_FACES) + & temp1(3 * PARAM_REFELEM_MAX_FACES), cint, bndyflag(PARAM_REFELEM_MAX_FACES) INTEGER(I4B), ALLOCATABLE :: face2elem(:, :) LOGICAL(LGT), ALLOCATABLE :: amask(:) TYPE(CPUTime_) :: TypeCPUTime diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 index 83e39b3c0..2f378938f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@EdgeDataMethods.F90 @@ -16,8 +16,8 @@ ! SUBMODULE(AbstractMesh_Class) EdgeDataMethods -USE ReferenceElement_Method, ONLY: REFELEM_MAX_EDGES, & - & 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 @@ -34,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 e8a1d57c7..be37fb910 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@ElementDataMethods.F90 @@ -18,7 +18,7 @@ SUBMODULE(AbstractMesh_Class) ElementDataMethods USE ReallocateUtility USE Display_Method -USE ReferenceElement_Method, ONLY: REFELEM_MAX_FACES +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES USE AbstractMeshUtility, ONLY: InitiateElementToElements3D, & & InitiateElementToElements2D, & & InitiateElementToElements1D diff --git a/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 b/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 index 1996fc7c7..4ce22605a 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@FaceDataMethods.F90 @@ -16,8 +16,8 @@ ! SUBMODULE(AbstractMesh_Class) FaceDataMethods -USE ReferenceElement_Method, ONLY: REFELEM_MAX_FACES, & - & REFELEM_MAX_POINTS, & +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES, & + & PARAM_REFELEM_MAX_POINTS, & & RefElemGetGeoParam, & & IsQuadrangle @@ -40,9 +40,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 78700f116..f0e29b41f 100644 --- a/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 +++ b/src/submodules/AbstractMesh/src/AbstractMesh_Class@GetMethods.F90 @@ -21,7 +21,7 @@ USE BoundingBox_Method USE InputUtility USE Display_Method -USE ReferenceElement_Method, ONLY: REFELEM_MAX_FACES, & +USE ReferenceElement_Method, ONLY: PARAM_REFELEM_MAX_FACES, & & GetEdgeConnectivity, & & GetFaceConnectivity, & & ElementOrder, & @@ -1315,8 +1315,8 @@ #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, islocal=islocal) 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])