diff --git a/install.py b/install.py old mode 100644 new mode 100755 index 6426f9a42..c81816614 --- a/install.py +++ b/install.py @@ -1,3 +1,5 @@ +#!/usr/bin/env python3 + # This program is a part of EASIFEM library. # See. www.easifem.com # Copyright (c) 2020-2021, All right reserved, Vikas Sharma, Ph.D. @@ -25,7 +27,8 @@ print("CMAKE DEF : ", cmake_def) _build0 = os.path.join(os.environ["HOME"], "temp") build_dir = os.path.join( - os.environ.get("EASIFEM_BUILD_DIR", _build0), "easifem", "classes", "build" + os.environ.get("EASIFEM_BUILD_DIR", + _build0), "easifem", "classes", "build" ) # build_dir = os.environ["HOME"] + "/temp/easifem-base/build" os.makedirs(build_dir, exist_ok=True) diff --git a/src/modules/AbstractField/src/AbstractField_Class.F90 b/src/modules/AbstractField/src/AbstractField_Class.F90 index eff29f07c..c4126a01f 100644 --- a/src/modules/AbstractField/src/AbstractField_Class.F90 +++ b/src/modules/AbstractField/src/AbstractField_Class.F90 @@ -46,15 +46,8 @@ MODULE AbstractField_Class INTEGER(I4B), PARAMETER, PUBLIC :: FIELD_TYPE_CONSTANT = 2 INTEGER(I4B), PARAMETER, PUBLIC :: FIELD_TYPE_CONSTANT_SPACE = 3 INTEGER(I4B), PARAMETER, PUBLIC :: FIELD_TYPE_CONSTANT_TIME = 4 -! CHARACTER( LEN = * ), PARAMETER, PUBLIC :: FIELD_TYPE_NAME( 4 ) = & -! & [ & -! & "NORMAL ", & -! & "CONSTANT ", & -! & "CONSTANT_SPACE", & -! & "CONSTANT_TIME " & -! & ] - CHARACTER(*), PARAMETER :: modName = "AbstractField_Class" +PUBLIC :: AbstractFieldInitiate !---------------------------------------------------------------------------- ! AbstractField_ @@ -66,19 +59,19 @@ MODULE AbstractField_Class TYPE, ABSTRACT :: AbstractField_ LOGICAL(LGT) :: isInitiated = .FALSE. - !! It is true if the object is initiated + !! It is true if the object is initiated INTEGER(I4B) :: fieldType = FIELD_TYPE_NORMAL - !! fieldType can be normal, constant, can vary in space and/ or both. + !! fieldType can be normal, constant, can vary in space and/ or both. TYPE(String) :: name - !! name of the field + !! name of the field TYPE(String) :: engine - !! Engine of the field, for example - !! NATIVE_SERIAL - !! NATIVE_OMP, - !! NATIVE_MPI, - !! PETSC, - !! LIS_OMP, - !! LIS_MPI + !! Engine of the field, for example + !! NATIVE_SERIAL + !! NATIVE_OMP, + !! NATIVE_MPI, + !! PETSC, + !! LIS_OMP, + !! LIS_MPI INTEGER(I4B) :: comm = 0_I4B !! communication group (MPI) INTEGER(I4B) :: myRank = 0_I4B @@ -97,13 +90,13 @@ MODULE AbstractField_Class !! lis_ptr is pointer returned by the LIS library !! It is used when engine is LIS_OMP or LIS_MPI TYPE(Domain_), POINTER :: domain => NULL() - !! Domain contains the information of the finite element meshes. + !! Domain contains the information of the finite element meshes. TYPE(DomainPointer_), ALLOCATABLE :: domains(:) - !! Domain for each physical variables - !! The size of `domains` should be equal to the total number of - !! physical variables. - !! It is used in the case of BlockNodeField - !! and BlockMatrixField + !! Domain for each physical variables + !! The size of `domains` should be equal to the total number of + !! physical variables. + !! It is used in the case of BlockNodeField + !! and BlockMatrixField CONTAINS PRIVATE PROCEDURE(aField_checkEssentialParam), DEFERRED, PUBLIC, PASS(obj) :: & @@ -131,6 +124,18 @@ MODULE AbstractField_Class GENERIC, PUBLIC :: WriteData => WriteData_vtk, WriteData_hdf5 PROCEDURE, PASS(obj), NON_OVERRIDABLE, PUBLIC :: GetParam PROCEDURE, PASS(obj), NON_OVERRIDABLE, PUBLIC :: SetParam + PROCEDURE, PUBLIC, PASS(obj) :: GetSpaceCompo => aField_GetSpaceCompo + !! Return space component + !! INFO: This routine should be implemented by child classes + PROCEDURE, PUBLIC, PASS(obj) :: GetTimeCompo => aField_GetTimeCompo + !! Return time component + !! INFO: This routine should be implemented by child classes + PROCEDURE, PUBLIC, PASS(obj) :: GetStorageFMT => aField_GetStorageFMT + !! Return storage format + !! INFO: This routine should be implemented by child classes + PROCEDURE, PUBLIC, PASS(obj), NON_OVERRIDABLE :: isConstant & + & => aField_isConstant + !! It returns true if the field is constant field END TYPE AbstractField_ PUBLIC :: AbstractField_ @@ -168,6 +173,23 @@ SUBROUTINE aField_Initiate1(obj, param, dom) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Initiate the field by reading param and given domain + +INTERFACE + MODULE SUBROUTINE AbstractFieldInitiate(obj, param, dom, prefix) + CLASS(AbstractField_), INTENT(INOUT) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + TYPE(Domain_), TARGET, INTENT(IN) :: dom + CHARACTER(*), INTENT(IN) :: prefix + END SUBROUTINE AbstractFieldInitiate +END INTERFACE + !---------------------------------------------------------------------------- ! InitiateByCopy !---------------------------------------------------------------------------- @@ -424,4 +446,62 @@ MODULE SUBROUTINE GetParam(obj, & END SUBROUTINE GetParam END INTERFACE +!---------------------------------------------------------------------------- +! GetSpaceCompo +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns space components + +INTERFACE + MODULE FUNCTION aField_GetSpaceCompo(obj) RESULT(ans) + CLASS(AbstractField_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION aField_GetSpaceCompo +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTimeCompo +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns Time components + +INTERFACE + MODULE FUNCTION aField_GetTimeCompo(obj) RESULT(ans) + CLASS(AbstractField_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION aField_GetTimeCompo +END INTERFACE + +!---------------------------------------------------------------------------- +! GetStorageFMT +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns storage format + +INTERFACE + MODULE FUNCTION aField_GetStorageFMT(obj) RESULT(ans) + CLASS(AbstractField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION aField_GetStorageFMT +END INTERFACE + +!---------------------------------------------------------------------------- +! isConstant +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns true if the field is constant +INTERFACE + MODULE FUNCTION aField_isConstant(obj) RESULT(ans) + CLASS(AbstractField_), INTENT(IN) :: obj + LOGICAL(LGT) :: ans + END FUNCTION aField_isConstant +END INTERFACE END MODULE AbstractField_Class diff --git a/src/modules/AbstractMeshField/src/AbstractMeshField_Class.F90 b/src/modules/AbstractMeshField/src/AbstractMeshField_Class.F90 index 5be8015a1..4129751a8 100644 --- a/src/modules/AbstractMeshField/src/AbstractMeshField_Class.F90 +++ b/src/modules/AbstractMeshField/src/AbstractMeshField_Class.F90 @@ -16,7 +16,7 @@ MODULE AbstractMeshField_Class USE GlobalData -USE BaseType +USE BaSetype USE String_Class, ONLY: String USE FPL, ONLY: ParameterList_ USE Mesh_Class, ONLY: Mesh_ @@ -27,6 +27,13 @@ MODULE AbstractMeshField_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "AbstractMeshField_Class" +PUBLIC :: AbstractMeshField_ +PUBLIC :: AbstractMeshFieldPointer_ +PUBLIC :: SetAbstractMeshFieldParam +PUBLIC :: AbstractFieldCheckEssentialParam +PUBLIC :: AbstractMeshFieldDeallocate +PUBLIC :: AbstractMeshFieldInitiate +PUBLIC :: DEALLOCATE !---------------------------------------------------------------------------- ! AbstractMeshField_ @@ -96,7 +103,7 @@ MODULE AbstractMeshField_Class !! Export data in vtkFile PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => aField_Deallocate !! Deallocate the field - PROCEDURE, PUBLIC, PASS(obj) :: getPointer => aField_getPointer + PROCEDURE, PUBLIC, PASS(obj) :: GetPointer => aField_getPointer !! Return pointer to val PROCEDURE, PUBLIC, PASS(obj) :: Size => aField_Size !! Returns size @@ -110,8 +117,6 @@ MODULE AbstractMeshField_Class !! Getting the value END TYPE AbstractMeshField_ -PUBLIC :: AbstractMeshField_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -120,10 +125,8 @@ MODULE AbstractMeshField_Class CLASS(AbstractMeshField_), POINTER :: ptr => NULL() END TYPE AbstractMeshFieldPointer_ -PUBLIC :: AbstractMeshFieldPointer_ - !---------------------------------------------------------------------------- -! setAbstractMeshFieldParam@ConstructorMethods +! SetAbstractMeshFieldParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -131,7 +134,7 @@ MODULE AbstractMeshField_Class ! summary: This routine check the essential parameters in param. INTERFACE - MODULE SUBROUTINE setAbstractMeshFieldParam(param, prefix, name, & + MODULE SUBROUTINE SetAbstractMeshFieldParam(param, prefix, name, & & fieldType, engine, defineOn, varType, rank, s) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: prefix @@ -142,11 +145,9 @@ MODULE SUBROUTINE setAbstractMeshFieldParam(param, prefix, name, & INTEGER(I4B), INTENT(IN) :: varType INTEGER(I4B), INTENT(IN) :: rank INTEGER(I4B), INTENT(IN) :: s(:) - END SUBROUTINE setAbstractMeshFieldParam + END SUBROUTINE SetAbstractMeshFieldParam END INTERFACE -PUBLIC :: setAbstractMeshFieldParam - !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods !---------------------------------------------------------------------------- @@ -178,8 +179,6 @@ MODULE SUBROUTINE AbstractFieldCheckEssentialParam(obj, prefix, param) END SUBROUTINE AbstractFieldCheckEssentialParam END INTERFACE -PUBLIC :: AbstractFieldCheckEssentialParam - !---------------------------------------------------------------------------- ! Deallocate@ConstructorMethods !---------------------------------------------------------------------------- @@ -198,7 +197,19 @@ END SUBROUTINE aField_Deallocate MODULE PROCEDURE aField_Deallocate END INTERFACE AbstractMeshFieldDeallocate -PUBLIC :: AbstractMeshFieldDeallocate +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(AbstractMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods @@ -233,8 +244,6 @@ MODULE SUBROUTINE AbstractMeshFieldInitiate(obj, prefix, param, mesh) END SUBROUTINE AbstractMeshFieldInitiate END INTERFACE -PUBLIC :: AbstractMeshFieldInitiate - !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods !---------------------------------------------------------------------------- @@ -255,7 +264,7 @@ END SUBROUTINE aField_Initiate2 END INTERFACE !---------------------------------------------------------------------------- -! getPointer@ConstructorMethods +! GetPointer@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -263,10 +272,10 @@ END SUBROUTINE aField_Initiate2 ! summary: Returns the pointer to a fortran real vector stored inside realVec INTERFACE - MODULE FUNCTION aField_getPointer(obj) RESULT(ans) + MODULE FUNCTION aField_GetPointer(obj) RESULT(ans) CLASS(AbstractMeshField_), TARGET, INTENT(IN) :: obj REAL(DFP), POINTER :: ans(:, :) - END FUNCTION aField_getPointer + END FUNCTION aField_GetPointer END INTERFACE !---------------------------------------------------------------------------- diff --git a/src/modules/AbstractNodeField/src/AbstractNodeField_Class.F90 b/src/modules/AbstractNodeField/src/AbstractNodeField_Class.F90 index f18600b2e..c042ed111 100644 --- a/src/modules/AbstractNodeField/src/AbstractNodeField_Class.F90 +++ b/src/modules/AbstractNodeField/src/AbstractNodeField_Class.F90 @@ -22,8 +22,20 @@ MODULE AbstractNodeField_Class USE Domain_Class, ONLY: DomainPointer_, Domain_ USE HDF5File_Class, ONLY: HDF5File_ USE VTKFile_Class, ONLY: VTKFile_ +USE FiniteElement_Class, ONLY: FiniteElementPointer_ IMPLICIT NONE PRIVATE +PUBLIC :: AbstractNodeFieldDisplay +PUBLIC :: AbstractNodeField_ +PUBLIC :: AbstractNodeFieldPointer_ +PUBLIC :: AbstractNodeFieldImport +PUBLIC :: AbstractNodeFieldExport +PUBLIC :: AbstractNodeFieldGetPointer +PUBLIC :: AbstractNodeFieldInitiate2 +PUBLIC :: AbstractNodeFieldDeallocate +PUBLIC :: AbstractNodeFieldSetSingle +PUBLIC :: AbstractNodeFieldGetSingle +PUBLIC :: AbstractNodeFieldInitiate CHARACTER(*), PARAMETER :: modName = "AbstractField_Class" @@ -43,22 +55,45 @@ MODULE AbstractNodeField_Class TYPE(DOF_) :: dof !! Degree of freedom object, which contains the information about !! how the different components are stored inside the realVec + TYPE(FiniteElementPointer_), ALLOCATABLE :: fe(:) + !! Finite element CONTAINS PROCEDURE, PUBLIC, PASS(obj) :: Display => anf_Display + !! Display the content of AbstractNodeField PROCEDURE, PUBLIC, PASS(obj) :: IMPORT => anf_Import + !! Import AbstractNodeField from HDF5File_ PROCEDURE, PUBLIC, PASS(obj) :: Export => anf_Export + !! Export AbstractNodeField to HDF5File_ PROCEDURE, PUBLIC, PASS(obj) :: GetPointer => anf_GetPointer + !! GetPointer to the fortran vector stored inside the realvec + !! This function should be called for Native engine only PROCEDURE, PUBLIC, PASS(obj) :: Size => anf_Size + !! Returns the length of data stored inside the fortran vector PROCEDURE, PUBLIC, PASS(obj) :: Initiate2 => anf_Initiate2 + !! Initiate an instance of AbstrtactNodeField PROCEDURE, PUBLIC, PASS(obj) :: Initiate3 => anf_Initiate3 + !! Initiate an instance of AbstrtactNodeField PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => anf_Deallocate + !! Deallocate the data stored inside PROCEDURE, PUBLIC, PASS(obj) :: Norm2 => anf_Norm2 + !! Returns the L2 norm PROCEDURE, PUBLIC, PASS(obj) :: SetSingle => anf_SetSingle + !! Set single entry PROCEDURE, PUBLIC, PASS(obj) :: GetSingle => anf_GetSingle + !! Get single entry + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalDOF => anf_GetTotalDOF + !! Returns the total number of degree of freedoms + !! This is same as calling Size + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalVertexDOF => anf_GetTotalVertexDOF + !! Returns the total number of vertex degree of freedoms + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalEdgeDOF => anf_GetTotalEdgeDOF + !! Returns the total number of edge degree of freedoms + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalFaceDOF => anf_GetTotalFaceDOF + !! Returns the total number of face degree of freedoms + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalCellDOF => anf_GetTotalCellDOF + !! Returns the total number of cell degree of freedoms END TYPE AbstractNodeField_ -PUBLIC :: AbstractNodeField_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -67,7 +102,22 @@ MODULE AbstractNodeField_Class CLASS(AbstractNodeField_), POINTER :: ptr => NULL() END TYPE AbstractNodeFieldPointer_ -PUBLIC :: AbstractNodeFieldPointer_ +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Initiate an instance of AbstractNodeField + +INTERFACE + MODULE SUBROUTINE AbstractNodeFieldInitiate(obj, param, dom, prefix) + CLASS(AbstractNodeField_), INTENT(INOUT) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + TYPE(Domain_), TARGET, INTENT(IN) :: dom + CHARACTER(*), INTENT(IN) :: prefix + END SUBROUTINE AbstractNodeFieldInitiate +END INTERFACE !---------------------------------------------------------------------------- ! Display @@ -85,8 +135,6 @@ END SUBROUTINE anf_Display MODULE PROCEDURE anf_Display END INTERFACE AbstractNodeFieldDisplay -PUBLIC :: AbstractNodeFieldDisplay - !---------------------------------------------------------------------------- ! IMPORT !---------------------------------------------------------------------------- @@ -105,8 +153,6 @@ END SUBROUTINE anf_Import MODULE PROCEDURE anf_Import END INTERFACE AbstractNodeFieldImport -PUBLIC :: AbstractNodeFieldImport - !---------------------------------------------------------------------------- ! Export !---------------------------------------------------------------------------- @@ -123,10 +169,8 @@ END SUBROUTINE anf_Export MODULE PROCEDURE anf_Export END INTERFACE AbstractNodeFieldExport -PUBLIC :: AbstractNodeFieldExport - !---------------------------------------------------------------------------- -! getPointer +! GetPointer !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -134,34 +178,16 @@ END SUBROUTINE anf_Export ! summary: Returns the pointer to a fortran real vector stored inside realVec INTERFACE - MODULE FUNCTION anf_getPointer(obj) RESULT(ans) + MODULE FUNCTION anf_GetPointer(obj) RESULT(ans) CLASS(AbstractNodeField_), TARGET, INTENT(IN) :: obj REAL(DFP), POINTER :: ans(:) - END FUNCTION anf_getPointer + END FUNCTION anf_GetPointer END INTERFACE INTERFACE AbstractNodeFieldGetPointer - MODULE PROCEDURE anf_getPointer + MODULE PROCEDURE anf_GetPointer END INTERFACE AbstractNodeFieldGetPointer -PUBLIC :: AbstractNodeFieldGetPointer - -!---------------------------------------------------------------------------- -! Size -!---------------------------------------------------------------------------- - -!> authors: Vikas Sharma, Ph. D. -! date: 25 Sept 2021 -! summary: This function returns the size of the field - -INTERFACE - MODULE FUNCTION anf_Size(obj, dims) RESULT(ans) - CLASS(AbstractNodeField_), INTENT(IN) :: obj - INTEGER(I4B), OPTIONAL :: dims - INTEGER(I4B) :: ans - END FUNCTION anf_Size -END INTERFACE - !---------------------------------------------------------------------------- ! anf_Initiate3 !---------------------------------------------------------------------------- @@ -199,8 +225,6 @@ END SUBROUTINE anf_Initiate2 MODULE PROCEDURE anf_Initiate2 END INTERFACE AbstractNodeFieldInitiate2 -PUBLIC :: AbstractNodeFieldInitiate2 - !---------------------------------------------------------------------------- ! anf_Initiate3 !---------------------------------------------------------------------------- @@ -235,8 +259,6 @@ END SUBROUTINE anf_Deallocate MODULE PROCEDURE anf_Deallocate END INTERFACE AbstractNodeFieldDeallocate -PUBLIC :: AbstractNodeFieldDeallocate - !---------------------------------------------------------------------------- ! Norm2 !---------------------------------------------------------------------------- @@ -275,8 +297,6 @@ END SUBROUTINE anf_setSingle MODULE PROCEDURE anf_setSingle END INTERFACE AbstractNodeFieldSetSingle -PUBLIC :: AbstractNodeFieldSetSingle - !---------------------------------------------------------------------------- ! GetSingle@Methods !---------------------------------------------------------------------------- @@ -286,18 +306,110 @@ END SUBROUTINE anf_setSingle ! summary: Set single entry INTERFACE - MODULE SUBROUTINE anf_getSingle(obj, indx, VALUE) + MODULE SUBROUTINE anf_GetSingle(obj, indx, VALUE) CLASS(AbstractNodeField_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: indx REAL(DFP), INTENT(OUT) :: VALUE - END SUBROUTINE anf_getSingle + END SUBROUTINE anf_GetSingle END INTERFACE INTERFACE AbstractNodeFieldGetSingle - MODULE PROCEDURE anf_getSingle + MODULE PROCEDURE anf_GetSingle END INTERFACE AbstractNodeFieldGetSingle -PUBLIC :: AbstractNodeFieldGetSingle +!---------------------------------------------------------------------------- +! Size +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 25 Sept 2021 +! summary: This function returns the size of the field + +INTERFACE + MODULE FUNCTION anf_Size(obj, dims) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL :: dims + INTEGER(I4B) :: ans + END FUNCTION anf_Size +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalDOF +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns the total number of degree of freedoms +! +!# Introduction +! This method is same as calling the size function. + +INTERFACE + MODULE FUNCTION anf_GetTotalDOF(obj) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION anf_GetTotalDOF +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalVertexDOF +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns the total number of vertex degree of freedoms + +INTERFACE + MODULE FUNCTION anf_GetTotalVertexDOF(obj) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION anf_GetTotalVertexDOF +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalEdgeDOF +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns the total number of Edge degree of freedoms + +INTERFACE + MODULE FUNCTION anf_GetTotalEdgeDOF(obj) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION anf_GetTotalEdgeDOF +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalFaceDOF +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns the total number of Face degree of freedoms + +INTERFACE + MODULE FUNCTION anf_GetTotalFaceDOF(obj) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION anf_GetTotalFaceDOF +END INTERFACE + +!---------------------------------------------------------------------------- +! GetTotalCellDOF +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Returns the total number of Cell degree of freedoms + +INTERFACE + MODULE FUNCTION anf_GetTotalCellDOF(obj) RESULT(ans) + CLASS(AbstractNodeField_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION anf_GetTotalCellDOF +END INTERFACE !---------------------------------------------------------------------------- ! diff --git a/src/modules/BlockNodeField/src/BlockNodeField_Class.F90 b/src/modules/BlockNodeField/src/BlockNodeField_Class.F90 index 8bf6f35af..9f07306ef 100644 --- a/src/modules/BlockNodeField/src/BlockNodeField_Class.F90 +++ b/src/modules/BlockNodeField/src/BlockNodeField_Class.F90 @@ -42,7 +42,7 @@ MODULE BlockNodeField_Class ! date: 06 Jan 2022 ! summary: This nodal field is designed for the multiphysics applications ! -!{!pages/BlockNodeField_.md} +!{!pages/docs-api/BlockNodeField/BlockNodeField_.md!} TYPE, EXTENDS(AbstractNodeField_) :: BlockNodeField_ CONTAINS diff --git a/src/modules/DirichletBC/src/DirichletBC_Class.F90 b/src/modules/DirichletBC/src/DirichletBC_Class.F90 index ee11d735a..4d5f424d7 100644 --- a/src/modules/DirichletBC/src/DirichletBC_Class.F90 +++ b/src/modules/DirichletBC/src/DirichletBC_Class.F90 @@ -26,6 +26,11 @@ MODULE DirichletBC_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "DirichletBC_Class" CHARACTER(*), PARAMETER :: myprefix = "DirichletBC" +PUBLIC :: DEALLOCATE +PUBLIC :: DirichletBC_ +PUBLIC :: DirichletBCPointer_ +PUBLIC :: AddDirichletBC +PUBLIC :: GetDirichletBCPointer !---------------------------------------------------------------------------- ! DirichletBC_ @@ -44,8 +49,6 @@ MODULE DirichletBC_Class FINAL :: bc_Final END TYPE DirichletBC_ -PUBLIC :: DirichletBC_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -54,7 +57,33 @@ MODULE DirichletBC_Class CLASS(DirichletBC_), POINTER :: ptr => NULL() END TYPE DirichletBCPointer_ -PUBLIC :: DirichletBCPointer_ +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Vector(obj) + TYPE(DirichletBC_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Ptr_Vector(obj) + TYPE(DirichletBCPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods @@ -72,7 +101,7 @@ END SUBROUTINE bc_checkEssentialParam !---------------------------------------------------------------------------- INTERFACE - MODULE SUBROUTINE setDirichletBCParam(param, name, idof, nodalValueType, & + MODULE SUBROUTINE SetDirichletBCParam(param, name, idof, nodalValueType, & & useFunction, isNormal, isTangent) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: name @@ -85,10 +114,10 @@ MODULE SUBROUTINE setDirichletBCParam(param, name, idof, nodalValueType, & LOGICAL(LGT), OPTIONAL, INTENT(IN) :: useFunction LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isNormal LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isTangent - END SUBROUTINE setDirichletBCParam + END SUBROUTINE SetDirichletBCParam END INTERFACE -PUBLIC :: setDirichletBCParam +PUBLIC :: SetDirichletBCParam !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods @@ -113,4 +142,49 @@ MODULE SUBROUTINE bc_Final(obj) END SUBROUTINE bc_Final END INTERFACE +!---------------------------------------------------------------------------- +! addDirichletBC@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Add dirichlet boundary conditions to the vector of pointer + +INTERFACE AddDirichletBC + MODULE SUBROUTINE bc_AddDirichletBC(dbc, dbcNo, param, boundary, dom) + TYPE(DirichletBCPointer_), INTENT(INOUT) :: dbc(:) + !! Dirichlet boundary to form + INTEGER(I4B), INTENT(IN) :: dbcNo + !! Dirichlet boundary number + TYPE(ParameterList_), INTENT(IN) :: param + !! parameter for constructing [[DirichletBC_]]. + TYPE(MeshSelection_), INTENT(IN) :: boundary + !! Boundary region + CLASS(Domain_), INTENT(IN) :: dom + END SUBROUTINE bc_AddDirichletBC +END INTERFACE AddDirichletBC + +!---------------------------------------------------------------------------- +! GetDirichletBC@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Get dirichlet boundary conditions to the vector of pointer + +INTERFACE GetDirichletBCPointer + MODULE FUNCTION bc_GetDirichletBCPointer(dbc, dbcNo) RESULT(ans) + CLASS(DirichletBCPointer_), INTENT(IN) :: dbc(:) + INTEGER(I4B), INTENT(IN) :: dbcNo + !! Dirichlet boundary nunber + CLASS(DirichletBC_), POINTER :: ans + END FUNCTION bc_GetDirichletBCPointer +END INTERFACE GetDirichletBCPointer + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END MODULE DirichletBC_Class diff --git a/src/modules/Domain/src/Domain_Class.F90 b/src/modules/Domain/src/Domain_Class.F90 index 70ede578c..06e3cb67b 100644 --- a/src/modules/Domain/src/Domain_Class.F90 +++ b/src/modules/Domain/src/Domain_Class.F90 @@ -47,10 +47,12 @@ MODULE Domain_Class ! ! 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 +! +! 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_ +! +! 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 @@ -88,7 +90,7 @@ MODULE Domain_Class ! date: 18 June 2021 ! summary: Domain_ contains finite element mesh data of a domain ! -!{!pages/Domain_.md!} +!{!pages/docs-api/Domain/Domain_.md!} TYPE :: Domain_ PRIVATE @@ -147,12 +149,14 @@ MODULE Domain_Class !! meshList( 2 ) list of meshes of surface entities !! meshList( 3 ) list of meshes of volume entities TYPE(MeshFacetData_), ALLOCATABLE, PUBLIC :: meshFacetData(:) + !! Mesh facet data TYPE(CSRSparsity_) :: meshMap + !! Sparse mesh data in CSR format CONTAINS PRIVATE - ! + + ! CONSTRUCTOR: ! @ConstructorMethods - ! PROCEDURE, PUBLIC, PASS(Obj) :: Initiate => Domain_Initiate !! Initiate an instance of domain PROCEDURE, PUBLIC, PASS(Obj) :: DEALLOCATE => Domain_Deallocate @@ -160,9 +164,9 @@ MODULE Domain_Class !! TODO Rename Deallocate to Deallocate FINAL :: Domain_Final !! Finalizer for domain - ! + + ! IO: ! @IOMethods - ! PROCEDURE, PASS(Obj) :: IMPORT => Domain_Import !! Initiates an instance of domain by importing data from meshfile !! TODO Add an export method to [[Domain_]] class @@ -171,18 +175,12 @@ MODULE Domain_Class PROCEDURE, PUBLIC, PASS(obj) :: DisplayMeshFacetData => & & Domain_DisplayMeshFacetData !! Display mesh facet data - ! - ! @getMethods - ! - PROCEDURE, PUBLIC, PASS(obj) :: & - & IsNodePresent => & - & Domain_IsNodePresent - PROCEDURE, PUBLIC, PASS(obj) :: & - & IsElementPresent => & - & Domain_IsElementPresent - PROCEDURE, PUBLIC, PASS(obj) :: & - & GetConnectivity => & - & Domain_GetConnectivity + + ! GET: + ! @GetMethods + PROCEDURE, PUBLIC, PASS(obj) :: IsNodePresent => Domain_IsNodePresent + PROCEDURE, PUBLIC, PASS(obj) :: IsElementPresent => Domain_IsElementPresent + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => Domain_GetConnectivity PROCEDURE, PASS(obj) :: Domain_GetNodeToElements1 PROCEDURE, PASS(obj) :: Domain_GetNodeToElements2 GENERIC, PUBLIC :: GetNodeToElements => & @@ -234,7 +232,7 @@ MODULE Domain_Class & Domain_GetMeshPointer2 !! This routine a pointer to [[Mesh_]] object PROCEDURE, PUBLIC, PASS(obj) :: GetDimEntityNum => Domain_GetDimEntityNum - !! Returns a dim and entity number of mesh which contains the element number + !! Returns a dim entity-num of mesh which contains the element number PROCEDURE, PUBLIC, PASS(obj) :: GetNodeCoord => Domain_GetNodeCoord !! This routine returns the nodal coordinate in rank2 array PROCEDURE, PUBLIC, PASS(obj) :: GetNodeCoordPointer => & @@ -257,12 +255,19 @@ MODULE Domain_Class PROCEDURE, PRIVATE, PASS(obj) :: Domain_GetTotalMaterial1, & & Domain_GetTotalMaterial2 GENERIC, PUBLIC :: GetTotalMaterial => & - & Domain_getTotalMaterial1, & - & Domain_getTotalMaterial2 + & Domain_GetTotalMaterial1, & + & Domain_GetTotalMaterial2 !! Get total number of materials - ! + PROCEDURE, PUBLIC, PASS(obj) :: GetElemType => Domain_GetElemType + !! Returns the element type of each mesh + PROCEDURE, PUBLIC, PASS(obj) :: GetUniqueElemType => & + & Domain_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 => Domain_SetSparsity1 PROCEDURE, NOPASS :: SetSparsity2 => Domain_SetSparsity2 GENERIC, PUBLIC :: SetSparsity => SetSparsity1, SetSparsity2 @@ -274,9 +279,9 @@ MODULE Domain_Class !! setNodeCoord GENERIC, PUBLIC :: SetNodeCoord => SetNodeCoord1 PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => Domain_SetQuality - ! + + ! SET: ! @MeshDataMethods - ! PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToElements => & & Domain_InitiateNodeToElements !! Initiate node to element data @@ -305,9 +310,9 @@ MODULE Domain_Class & Domain_SetMeshmap PROCEDURE, PUBLIC, PASS(obj) :: SetMeshFacetElement => & & Domain_SetMeshFacetElement - ! + + ! SET: ! @ShapedataMethods - ! PROCEDURE, PASS(obj) :: InitiateElemSD1 => Domain_InitiateElemSD1 PROCEDURE, PASS(obj) :: InitiateElemSD2 => Domain_InitiateElemSD2 PROCEDURE, PASS(obj) :: InitiateElemSD3 => Domain_InitiateElemSD3 @@ -552,7 +557,7 @@ END SUBROUTINE MeshFacetData_Display END INTERFACE !---------------------------------------------------------------------------- -! IsNodePresent@getMethods +! IsNodePresent@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -568,7 +573,7 @@ END FUNCTION Domain_IsNodePresent END INTERFACE !---------------------------------------------------------------------------- -! IsElementPresent@getMethods +! IsElementPresent@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -585,7 +590,7 @@ END FUNCTION Domain_IsElementPresent END INTERFACE !---------------------------------------------------------------------------- -! GetConnectivity@getMethods +! GetConnectivity@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -602,7 +607,7 @@ END FUNCTION Domain_GetConnectivity END INTERFACE !---------------------------------------------------------------------------- -! GetNodeToElements@getMethods +! GetNodeToElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -619,7 +624,7 @@ END FUNCTION Domain_GetNodeToElements1 END INTERFACE !---------------------------------------------------------------------------- -! GetNodeToElements@getMethods +! GetNodeToElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -636,7 +641,7 @@ END FUNCTION Domain_GetNodeToElements2 END INTERFACE !---------------------------------------------------------------------------- -! GetTotalNodes@getMethods +! GetTotalNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -664,7 +669,7 @@ END FUNCTION Domain_GetTotalNodes END INTERFACE !---------------------------------------------------------------------------- -! tNodes@getMethods +! tNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -695,7 +700,7 @@ END FUNCTION Domain_tNodes1 END INTERFACE !---------------------------------------------------------------------------- -! tNodes@getMethods +! tNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -725,7 +730,7 @@ END FUNCTION Domain_tNodes2 END INTERFACE !---------------------------------------------------------------------------- -! tNodes@getMethods +! tNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -740,7 +745,7 @@ END FUNCTION Domain_tNodes3 END INTERFACE !---------------------------------------------------------------------------- -! getTotalElements@getMethods +! getTotalElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -767,16 +772,16 @@ END FUNCTION Domain_tNodes3 !@endwarn INTERFACE - MODULE FUNCTION Domain_getTotalElements(obj, dim, entityNum) RESULT(Ans) + MODULE FUNCTION Domain_GetTotalElements(obj, dim, entityNum) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim INTEGER(I4B), OPTIONAL, INTENT(IN) :: entityNum INTEGER(I4B) :: ans - END FUNCTION Domain_getTotalElements + END FUNCTION Domain_GetTotalElements END INTERFACE !---------------------------------------------------------------------------- -! tElements@getMethods +! tElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -792,7 +797,7 @@ END FUNCTION Domain_tElements1 END INTERFACE !---------------------------------------------------------------------------- -! tElements@getMethods +! tElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -809,7 +814,7 @@ END FUNCTION Domain_tElements2 END INTERFACE !---------------------------------------------------------------------------- -! tElements@getMethods +! tElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -826,7 +831,7 @@ END FUNCTION Domain_tElements3 END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@getMethods +! getLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -834,15 +839,15 @@ END FUNCTION Domain_tElements3 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION Domain_getLocalNodeNumber1(obj, globalNode) RESULT(Ans) + MODULE FUNCTION Domain_GetLocalNodeNumber1(obj, globalNode) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode INTEGER(I4B) :: ans - END FUNCTION Domain_getLocalNodeNumber1 + END FUNCTION Domain_GetLocalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@getMethods +! getLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -850,15 +855,15 @@ END FUNCTION Domain_getLocalNodeNumber1 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION Domain_getLocalNodeNumber2(obj, globalNode) RESULT(Ans) + MODULE FUNCTION Domain_GetLocalNodeNumber2(obj, globalNode) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) INTEGER(I4B) :: ans(SIZE(globalNode)) - END FUNCTION Domain_getLocalNodeNumber2 + END FUNCTION Domain_GetLocalNodeNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNodeNumber@getMethods +! getGlobalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -866,15 +871,15 @@ END FUNCTION Domain_getLocalNodeNumber2 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION Domain_getGlobalNodeNumber1(obj, localNode) RESULT(Ans) + MODULE FUNCTION Domain_GetGlobalNodeNumber1(obj, localNode) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: localNode INTEGER(I4B) :: ans - END FUNCTION Domain_getGlobalNodeNumber1 + END FUNCTION Domain_GetGlobalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNodeNumber@getMethods +! getGlobalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -882,15 +887,15 @@ END FUNCTION Domain_getGlobalNodeNumber1 ! summary: Returns local node number of a global node number INTERFACE - MODULE FUNCTION Domain_getGlobalNodeNumber2(obj, localNode) RESULT(Ans) + MODULE FUNCTION Domain_GetGlobalNodeNumber2(obj, localNode) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: localNode(:) INTEGER(I4B) :: ans(SIZE(localNode)) - END FUNCTION Domain_getGlobalNodeNumber2 + END FUNCTION Domain_GetGlobalNodeNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getTotalMesh@getMethods +! getTotalMesh@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -907,15 +912,15 @@ END FUNCTION Domain_getGlobalNodeNumber2 ! - `dim=3` returns the total number of mesh of volume entities INTERFACE - MODULE FUNCTION Domain_getTotalMesh(obj, dim) RESULT(Ans) + MODULE FUNCTION Domain_GetTotalMesh(obj, dim) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B) :: ans - END FUNCTION Domain_getTotalMesh + END FUNCTION Domain_GetTotalMesh END INTERFACE !---------------------------------------------------------------------------- -! getMeshPointer@getMethods +! getMeshPointer@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -930,16 +935,16 @@ END FUNCTION Domain_getTotalMesh ! - tag, is the number of mesh INTERFACE - MODULE FUNCTION Domain_getMeshPointer1(obj, dim, entityNum) RESULT(Ans) + MODULE FUNCTION Domain_GetMeshPointer1(obj, dim, entityNum) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), INTENT(IN) :: entityNum CLASS(Mesh_), POINTER :: ans - END FUNCTION Domain_getMeshPointer1 + END FUNCTION Domain_GetMeshPointer1 END INTERFACE !---------------------------------------------------------------------------- -! getMeshPointer@getMethods +! getMeshPointer@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -953,15 +958,15 @@ END FUNCTION Domain_getMeshPointer1 ! element number INTERFACE - MODULE FUNCTION Domain_getMeshPointer2(obj, globalElement) RESULT(Ans) + MODULE FUNCTION Domain_GetMeshPointer2(obj, globalElement) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement CLASS(Mesh_), POINTER :: ans - END FUNCTION Domain_getMeshPointer2 + END FUNCTION Domain_GetMeshPointer2 END INTERFACE !---------------------------------------------------------------------------- -! getDimEntityNum@getMethods +! getDimEntityNum@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -970,11 +975,11 @@ END FUNCTION Domain_getMeshPointer2 ! summary: Returns dim and entity number INTERFACE - MODULE FUNCTION Domain_getDimEntityNum(obj, globalElement) RESULT(ans) + MODULE FUNCTION Domain_GetDimEntityNum(obj, globalElement) RESULT(ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B) :: ans(2) - END FUNCTION Domain_getDimEntityNum + END FUNCTION Domain_GetDimEntityNum END INTERFACE !---------------------------------------------------------------------------- @@ -995,12 +1000,12 @@ END FUNCTION Domain_getDimEntityNum ! returns its nodal coordinates INTERFACE - MODULE SUBROUTINE Domain_getNodeCoord(obj, nodeCoord, dim, entityNum) + MODULE SUBROUTINE Domain_GetNodeCoord(obj, nodeCoord, dim, entityNum) CLASS(Domain_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: nodeCoord(:, :) INTEGER(I4B), OPTIONAL, INTENT(IN) :: dim INTEGER(I4B), OPTIONAL, INTENT(IN) :: entityNum - END SUBROUTINE Domain_getNodeCoord + END SUBROUTINE Domain_GetNodeCoord END INTERFACE !---------------------------------------------------------------------------- @@ -1018,10 +1023,10 @@ END SUBROUTINE Domain_getNodeCoord ! number, and the rows correspond to the component. INTERFACE - MODULE FUNCTION Domain_getNodeCoordPointer(obj) RESULT(ans) + MODULE FUNCTION Domain_GetNodeCoordPointer(obj) RESULT(ans) CLASS(Domain_), TARGET, INTENT(IN) :: obj REAL(DFP), POINTER :: ans(:, :) - END FUNCTION Domain_getNodeCoordPointer + END FUNCTION Domain_GetNodeCoordPointer END INTERFACE !---------------------------------------------------------------------------- @@ -1039,10 +1044,10 @@ END FUNCTION Domain_getNodeCoordPointer ! number, and the rows correspond to the component. INTERFACE - MODULE FUNCTION Domain_getGlobalToLocalNodeNumPointer(obj) RESULT(ans) + MODULE FUNCTION Domain_GetGlobalToLocalNodeNumPointer(obj) RESULT(ans) CLASS(Domain_), TARGET, INTENT(IN) :: obj INTEGER(I4B), POINTER :: ans(:) - END FUNCTION Domain_getGlobalToLocalNodeNumPointer + END FUNCTION Domain_GetGlobalToLocalNodeNumPointer END INTERFACE !---------------------------------------------------------------------------- @@ -1058,12 +1063,12 @@ END FUNCTION Domain_getGlobalToLocalNodeNumPointer ! xidim is the dimension of the mesh INTERFACE - MODULE FUNCTION Domain_getNptrs(obj, entityNum, dim) RESULT(Ans) + MODULE FUNCTION Domain_GetNptrs(obj, entityNum, dim) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: entityNum(:) INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION Domain_getNptrs + END FUNCTION Domain_GetNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -1079,12 +1084,12 @@ END FUNCTION Domain_getNptrs ! xidim is the dimension of the mesh INTERFACE - MODULE FUNCTION Domain_getInternalNptrs(obj, entityNum, dim) RESULT(Ans) + MODULE FUNCTION Domain_GetInternalNptrs(obj, entityNum, dim) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: entityNum(:) INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION Domain_getInternalNptrs + END FUNCTION Domain_GetInternalNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -1096,14 +1101,14 @@ END FUNCTION Domain_getInternalNptrs ! summary: This routine returns the number of spatial dimensions INTERFACE - MODULE PURE FUNCTION Domain_getNSD(obj) RESULT(Ans) + MODULE PURE FUNCTION Domain_GetNSD(obj) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION Domain_getNSD + END FUNCTION Domain_GetNSD END INTERFACE !---------------------------------------------------------------------------- -! getNSD@getMethod +! GetOrder@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1111,15 +1116,15 @@ END FUNCTION Domain_getNSD ! summary: This routine returns the order of meshes of dimensions=dim INTERFACE - MODULE FUNCTION Domain_getOrder(obj, dim) RESULT(Ans) + MODULE FUNCTION Domain_GetOrder(obj, dim) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION Domain_getOrder + END FUNCTION Domain_GetOrder END INTERFACE !---------------------------------------------------------------------------- -! getBoundingBox@getMethod +! getBoundingBox@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1127,14 +1132,14 @@ END FUNCTION Domain_getOrder ! summary: Returns bounding box INTERFACE - MODULE PURE FUNCTION Domain_getBoundingBox(obj) RESULT(Ans) + MODULE PURE FUNCTION Domain_GetBoundingBox(obj) RESULT(Ans) CLASS(Domain_), INTENT(IN) :: obj TYPE(BoundingBox_) :: ans - END FUNCTION Domain_getBoundingBox + END FUNCTION Domain_GetBoundingBox END INTERFACE !---------------------------------------------------------------------------- -! getTotalMeshFacetData@getMethods +! getTotalMeshFacetData@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1142,12 +1147,12 @@ END FUNCTION Domain_getBoundingBox ! summary: returns size of meshFacetData INTERFACE - MODULE PURE FUNCTION Domain_getTotalMeshFacetData(obj, imeshFacetData) & + MODULE PURE FUNCTION Domain_GetTotalMeshFacetData(obj, imeshFacetData) & & RESULT(ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), OPTIONAL, INTENT(IN) :: imeshFacetData INTEGER(I4B) :: ans - END FUNCTION Domain_getTotalMeshFacetData + END FUNCTION Domain_GetTotalMeshFacetData END INTERFACE !---------------------------------------------------------------------------- @@ -1160,15 +1165,15 @@ END FUNCTION Domain_getTotalMeshFacetData ! summary: Returns the materials id of a given medium INTERFACE - MODULE FUNCTION Domain_getTotalMaterial1(obj, dim) RESULT(ans) + MODULE FUNCTION Domain_GetTotalMaterial1(obj, dim) RESULT(ans) CLASS(Domain_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION Domain_getTotalMaterial1 + END FUNCTION Domain_GetTotalMaterial1 END INTERFACE !---------------------------------------------------------------------------- -! GetTotalMaterial@setMethods +! GetTotalMaterial@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1185,6 +1190,38 @@ MODULE FUNCTION Domain_GetTotalMaterial2(obj, dim, entityNum) RESULT(ans) END FUNCTION Domain_GetTotalMaterial2 END INTERFACE +!---------------------------------------------------------------------------- +! GetElemType@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-23 +! summary: Returns the element type of each mesh in domain + +INTERFACE + MODULE FUNCTION Domain_GetElemType(obj, dim) RESULT(ans) + CLASS(Domain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION Domain_GetElemType +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 Domain_GetUniqueElemType(obj, dim) RESULT(ans) + CLASS(Domain_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: dim + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION Domain_GetUniqueElemType +END INTERFACE + !---------------------------------------------------------------------------- ! SetSparsity@setMethods !---------------------------------------------------------------------------- diff --git a/src/modules/DomainConnectivity/src/DomainConnectivity_Class.F90 b/src/modules/DomainConnectivity/src/DomainConnectivity_Class.F90 index b094e5c82..12ee01a5d 100644 --- a/src/modules/DomainConnectivity/src/DomainConnectivity_Class.F90 +++ b/src/modules/DomainConnectivity/src/DomainConnectivity_Class.F90 @@ -33,6 +33,10 @@ MODULE DomainConnectivity_Class INTEGER(I4B), PUBLIC, PARAMETER :: rType = 3 INTEGER(I4B), PUBLIC, PARAMETER :: oversetType = 4 +PUBLIC :: DomainConnectivity_ +PUBLIC :: DomainConnectivityPointer_ +PUBLIC :: DEALLOCATE + !---------------------------------------------------------------------------- ! FacetConnectivity_ !---------------------------------------------------------------------------- @@ -250,8 +254,6 @@ MODULE DomainConnectivity_Class & dc_DisplayFacetToCellData END TYPE DomainConnectivity_ -PUBLIC :: DomainConnectivity_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -260,8 +262,6 @@ MODULE DomainConnectivity_Class CLASS(DomainConnectivity_), POINTER :: Ptr => NULL() END TYPE DomainConnectivityPointer_ -PUBLIC :: DomainConnectivityPointer_ - !---------------------------------------------------------------------------- ! Deallocate@ConstructorMethods !---------------------------------------------------------------------------- @@ -276,12 +276,40 @@ MODULE DomainConnectivity_Class ! INTERFACE - MODULE PURE SUBROUTINE dc_Deallocate(obj) + MODULE SUBROUTINE dc_Deallocate(obj) CLASS(DomainConnectivity_), INTENT(INOUT) :: obj !! Mesh connectivity object END SUBROUTINE dc_Deallocate END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate a vector of DomainConnectivity_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE dc_Deallocate2(obj) + TYPE(DomainConnectivity_), ALLOCATABLE, INTENT(INOUT) :: obj(:) + END SUBROUTINE dc_Deallocate2 +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate a vector of DomainConnectivityPointer_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE dc_Deallocate3(obj) + TYPE(DomainConnectivityPointer_), ALLOCATABLE, INTENT(INOUT) :: obj(:) + END SUBROUTINE dc_Deallocate3 +END INTERFACE DEALLOCATE + !---------------------------------------------------------------------------- ! Final@ConstructorMethods !---------------------------------------------------------------------------- diff --git a/src/modules/EasyPlplot/examples/examples.f90 b/src/modules/EasyPlplot/examples/examples.f90 index e7ce098ed..9567c5f35 100644 --- a/src/modules/EasyPlplot/examples/examples.f90 +++ b/src/modules/EasyPlplot/examples/examples.f90 @@ -1,309 +1,309 @@ !> A collection of example plots -program examples - use easy_plplot_m - implicit none - real(wp), parameter :: pi = acos(-1.0d0) +PROGRAM examples +USE easy_plplot_m +IMPLICIT NONE +REAL(wp), PARAMETER :: pi = ACOS(-1.0D0) call setup(device='svg', fileName='media/example-%n.svg', figSize=[600, 500], transparent=.true.) - call doPlot() - call doScatter() - call doContour() - call doLegend() - call doQuiver() - call doBar() - call doFillBetween() - call doHist() - call doSurface() - call doError() - call doLogPlot() +CALL doPlot() +CALL doScatter() +CALL doContour() +CALL doLegend() +CALL doQuiver() +CALL doBar() +CALL doFillBetween() +CALL doHist() +CALL doSurface() +CALL doError() +CALL doLogPlot() - call show() +CALL show() -contains +CONTAINS - !> ![plot](../|media|/example-1.svg) - subroutine doPlot - integer, parameter :: N = 20 - real(wp), dimension(N) :: x, y +!> ![plot](../|media|/example-1.svg) +SUBROUTINE doPlot + INTEGER, PARAMETER :: N = 20 + REAL(wp), DIMENSION(N) :: x, y - x = linspace(0.0_wp, 1.0_wp, N) - y = x**2 - 1.0_wp + x = linspace(0.0_WP, 1.0_WP, N) + y = x**2 - 1.0_WP - call figure() - call subplot(1, 1, 1) - call xylim(mixval(x), mixval(y)) + CALL figure() + CALL subplot(1, 1, 1) + CALL xylim(mixval(x), mixval(y)) - call plot(x, y, lineColor='red', lineWidth=2.0_wp, & - & markStyle='.', markColor='cyan', markSize=2.0_wp) + CALL plot(x, y, lineColor='red', lineWidth=2.0_WP, & + & markStyle='.', markColor='cyan', markSize=2.0_WP) - call plot(x, -1.0_wp - y, lineColor='blue', lineStyle=':', lineWidth=2.0_wp, & - & markStyle='+', markColor='green', markSize=1.0_wp) +CALL plot(x, -1.0_WP - y, lineColor='blue', lineStyle=':', lineWidth=2.0_WP, & + & markStyle='+', markColor='green', markSize=1.0_WP) !~ call ticks() - call xticks(primary=.true., secondary=.false.) - call yticks(primary=.true., secondary=.false.) + CALL xticks(primary=.TRUE., secondary=.FALSE.) + CALL yticks(primary=.TRUE., secondary=.FALSE.) !~ call labels('x','y','f(x)=x#u2#d-1; g(x)=-x#u2#d') - call xlabel('x') - call ylabel('y') - call title('f(x)=x#u2#d-1; g(x)=-x#u2#d') - end subroutine doPlot - - !> ![scatter](../|media|/example-2.svg) - subroutine doScatter - integer, parameter :: N = 100 - real(wp), dimension(N) :: x, y, z - - call random_number(x) - call random_number(y) - z = sqrt(x**2 + y**2) - - call figure() - - call subplot(2, 2, 1) - call xylim([0.0_wp, 1.0_wp], [0.0_wp, 1.0_wp]) - call scatter(x, y) - call ticks() - call labels('x', 'y', '') - - call subplot(2, 2, 2) - call xylim([0.0_wp, 1.0_wp], [0.0_wp, 1.0_wp]) - call scatter(x, y, c=z) - call ticks() - call labels('x', 'y', '') - - call subplot(2, 2, 3) - call xylim([0.0_wp, 1.0_wp], [0.0_wp, 1.0_wp]) - call scatter(x, y, s=(4.0_wp*z + 1.0_wp), markColor='blue') - call ticks() - call labels('x', 'y', '') - - call subplot(2, 2, 4) - call xylim([0.0_wp, 1.0_wp], [0.0_wp, 1.0_wp]) - call scatter(x, y, c=z, s=(4.0_wp*z + 1.0_wp)) - call ticks() - call labels('x', 'y', '') - end subroutine doScatter - - !> ![contour](../|media|/example-3.svg) - subroutine doContour - integer, parameter :: N = 50 - real(wp), dimension(N) :: x, y - real(wp), dimension(N, N) :: z - integer :: i, j - - x = linspace(-10.0_wp, 10.0_wp, N) - y = linspace(-10.0_wp, 10.0_wp, N) - forall (i=1:N, j=1:N) - z(i, j) = sin(sqrt(x(i)**2 + y(j)**2))/sqrt(x(i)**2 + y(j)**2) - end forall - - call figure() - - call subplot(1, 1, 1, aspect=1.0_wp) - call xylim(mixval(x), mixval(y)) - call contourf(x, y, z, 10) - call contour(x, y, z, 10) - call colorbar(z, 5) - call ticks() - call labels('x', 'y', '') - end subroutine doContour - - !> ![legend](../|media|/example-4.svg) - subroutine doLegend - integer, parameter :: N = 20 - real(wp), dimension(N) :: x, y - character(32), dimension(3, 7) :: series - - x = linspace(0.0_wp, 1.0_wp, N) - y = x**2 - 1.0_wp - - call figure() - call subplot(1, 1, 1) - call xylim(mixval(x), mixval(y)) - - call plot(x, y, lineColor='red', lineWidth=2.0_wp, & - & markStyle='.', markColor='cyan', markSize=2.0_wp) - - call plot(x, -1.0_wp - y, lineColor='blue', lineStyle=':', lineWidth=2.0_wp, & - & markStyle='+', markColor='green', markSize=1.0_wp) - - ! [name,textColor,lineStyle,lineColor,markStyle,markColor] - series(1, :) = [character(32) :: 'f(x)=x#u2#d-1', '', '-', 'r', '.', 'c', ''] - series(2, :) = [character(32) :: 'g(x)=-x#u2#d', '', ':', 'b', '+', 'g', ''] - series(3, :) = [character(32) :: 'Box', '', '', '', '', '', 'r'] - - call legend('center left', series) - call ticks() - call labels('x', 'y', '') - end subroutine doLegend - - !> ![quiver](../|media|/example-5.svg) - subroutine doQuiver - integer, parameter :: N = 20 - real(wp), dimension(N) :: x, y - real(wp), dimension(N, N) :: u, v, m - integer :: i, j - - x = linspace(-10.0_wp, 10.0_wp, N) - y = linspace(-10.0_wp, 10.0_wp, N) - forall (i=1:N, j=1:N) - u(i, j) = -y(j) - v(i, j) = x(i) - m(i, j) = sqrt(u(i, j)**2 + v(i, j)**2) - end forall - - call figure() - - call subplot(1, 1, 1, aspect=1.0_wp) - call xylim(mixval(x), mixval(y)) - call quiver(x, y, u, v, c=m, s=m, scaling=2.0_wp, lineWidth=2.0_wp) - call colorbar(m, 10) - call ticks() - call labels('x', 'y', '') - end subroutine doQuiver - - !> ![bar](../|media|/example-6.svg) - subroutine doBar - integer, parameter :: N = 21 - real(wp), dimension(N) :: x, y - - x = linspace(-PI, PI, N) - y = exp(-x**2) - - call figure() - - call subplot(1, 2, 1) - call xylim(mixval(x) + [-0.1_wp, 0.1_wp], mixval(y) + [0.0_wp, 0.1_wp]) - call bar(x, y, c=y, relWidth=1.0_wp) - call ticks() - call labels('x', 'y', '') - - call subplot(1, 2, 2) - call xylim(mixval(y) + [0.0_wp, 0.1_wp], mixval(x) + [-0.1_wp, 0.1_wp]) - call barh(x, y, fillColor='r', relWidth=1.0_wp) - call ticks() - call labels('x', 'y', '') - end subroutine doBar - - !> ![fillBetween](../|media|/example-7.svg) - subroutine doFillBetween - integer, parameter :: N = 51 - real(wp), dimension(N) :: x, y1, y2 - - x = linspace(-3.0_wp, 3.0_wp, N) - y1 = x**2 - 1.0_wp - y2 = x**3 - 1.0_wp - - call figure() - call subplot(1, 1, 1) - call xylim(mixval(x), mixval([y1, y2])) - call fillBetween(x, y1, y2, fillColor='c', fillPattern='#', lineWidth=2.0_wp) - call plot(x, y1, lineColor='k', lineWidth=3.0_wp) - call plot(x, y2, lineColor='k', lineWidth=3.0_wp) - call ticks(color='b', lineWidth=3.0_wp) - call labels('x', 'y', 'f(x)=x#u2#d-1', color='r') - end subroutine doFillBetween - - !> ![hist](../|media|/example-8.svg) - subroutine doHist - integer, parameter :: N = 10000 - real(wp), dimension(N, 12) :: r - real(wp), dimension(N) :: x - real(wp), dimension(:, :), allocatable :: h - - call random_number(r) - x = sum(r, 2) - 6.0_wp - call figure() - - call subplot(1, 2, 1) - call xylim(mixval(x), [0.0_wp, 1.05_wp]) - call hist(x, 20) - call ticks() - - h = binData(x, 20, normalize=2) - call subplot(1, 2, 2) - call xylim(mixval(h(:, 1)), [0.0_wp, 1.05_wp*maxval(h(:, 2))]) - call bar(h(:, 1), h(:, 2), c=h(:, 2), relWidth=1.0_wp) - call ticks() - end subroutine doHist - - !> ![surface](../|media|/example-9.svg) - subroutine doSurface - integer, parameter :: N = 24 - real(wp), dimension(N) :: x, y - real(wp), dimension(N, N) :: z - integer :: i, j - - x = linspace(-10.0_wp, 10.0_wp, N) - y = linspace(-10.0_wp, 10.0_wp, N) - forall (i=1:N, j=1:N) - z(i, j) = sin(sqrt(x(i)**2 + y(j)**2))/sqrt(x(i)**2 + y(j)**2) - end forall - - call figure() - - call subplot(1, 1, 1, is3d=.true.) - call xyzlim(mixval(x), mixval(y), mixval(z), zoom=1.1_wp) - call surface(x, y, z, 11) + CALL xlabel('x') + CALL ylabel('y') + CALL title('f(x)=x#u2#d-1; g(x)=-x#u2#d') +END SUBROUTINE doPlot + +!> ![scatter](../|media|/example-2.svg) +SUBROUTINE doScatter + INTEGER, PARAMETER :: N = 100 + REAL(wp), DIMENSION(N) :: x, y, z + + CALL RANDOM_NUMBER(x) + CALL RANDOM_NUMBER(y) + z = SQRT(x**2 + y**2) + + CALL figure() + + CALL subplot(2, 2, 1) + CALL xylim([0.0_WP, 1.0_WP], [0.0_WP, 1.0_WP]) + CALL scatter(x, y) + CALL ticks() + CALL labels('x', 'y', '') + + CALL subplot(2, 2, 2) + CALL xylim([0.0_WP, 1.0_WP], [0.0_WP, 1.0_WP]) + CALL scatter(x, y, c=z) + CALL ticks() + CALL labels('x', 'y', '') + + CALL subplot(2, 2, 3) + CALL xylim([0.0_WP, 1.0_WP], [0.0_WP, 1.0_WP]) + CALL scatter(x, y, s=(4.0_WP * z + 1.0_WP), markColor='blue') + CALL ticks() + CALL labels('x', 'y', '') + + CALL subplot(2, 2, 4) + CALL xylim([0.0_WP, 1.0_WP], [0.0_WP, 1.0_WP]) + CALL scatter(x, y, c=z, s=(4.0_WP * z + 1.0_WP)) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doScatter + +!> ![contour](../|media|/example-3.svg) +SUBROUTINE doContour + INTEGER, PARAMETER :: N = 50 + REAL(wp), DIMENSION(N) :: x, y + REAL(wp), DIMENSION(N, N) :: z + INTEGER :: i, j + + x = linspace(-10.0_WP, 10.0_WP, N) + y = linspace(-10.0_WP, 10.0_WP, N) + DO CONCURRENT(i=1:N, j=1:N) + z(i, j) = SIN(SQRT(x(i)**2 + y(j)**2)) / SQRT(x(i)**2 + y(j)**2) + END DO + + CALL figure() + + CALL subplot(1, 1, 1, aspect=1.0_WP) + CALL xylim(mixval(x), mixval(y)) + CALL contourf(x, y, z, 10) + CALL contour(x, y, z, 10) + CALL colorbar(z, 5) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doContour + +!> ![legend](../|media|/example-4.svg) +SUBROUTINE doLegend + INTEGER, PARAMETER :: N = 20 + REAL(wp), DIMENSION(N) :: x, y + CHARACTER(32), DIMENSION(3, 7) :: series + + x = linspace(0.0_WP, 1.0_WP, N) + y = x**2 - 1.0_WP + + CALL figure() + CALL subplot(1, 1, 1) + CALL xylim(mixval(x), mixval(y)) + + CALL plot(x, y, lineColor='red', lineWidth=2.0_WP, & + & markStyle='.', markColor='cyan', markSize=2.0_WP) + +CALL plot(x, -1.0_WP - y, lineColor='blue', lineStyle=':', lineWidth=2.0_WP, & + & markStyle='+', markColor='green', markSize=1.0_WP) + + ! [name,textColor,lineStyle,lineColor,markStyle,markColor] + series(1, :) = [CHARACTER(32) :: 'f(x)=x#u2#d-1', '', '-', 'r', '.', 'c', ''] + series(2, :) = [CHARACTER(32) :: 'g(x)=-x#u2#d', '', ':', 'b', '+', 'g', ''] + series(3, :) = [CHARACTER(32) :: 'Box', '', '', '', '', '', 'r'] + + CALL legend('center left', series) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doLegend + +!> ![quiver](../|media|/example-5.svg) +SUBROUTINE doQuiver + INTEGER, PARAMETER :: N = 20 + REAL(wp), DIMENSION(N) :: x, y + REAL(wp), DIMENSION(N, N) :: u, v, m + INTEGER :: i, j + + x = linspace(-10.0_WP, 10.0_WP, N) + y = linspace(-10.0_WP, 10.0_WP, N) + DO CONCURRENT(i=1:N, j=1:N) + u(i, j) = -y(j) + v(i, j) = x(i) + m(i, j) = SQRT(u(i, j)**2 + v(i, j)**2) + END DO + + CALL figure() + + CALL subplot(1, 1, 1, aspect=1.0_WP) + CALL xylim(mixval(x), mixval(y)) + CALL quiver(x, y, u, v, c=m, s=m, scaling=2.0_WP, lineWidth=2.0_WP) + CALL colorbar(m, 10) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doQuiver + +!> ![bar](../|media|/example-6.svg) +SUBROUTINE doBar + INTEGER, PARAMETER :: N = 21 + REAL(wp), DIMENSION(N) :: x, y + + x = linspace(-PI, PI, N) + y = EXP(-x**2) + + CALL figure() + + CALL subplot(1, 2, 1) + CALL xylim(mixval(x) + [-0.1_WP, 0.1_WP], mixval(y) + [0.0_WP, 0.1_WP]) + CALL bar(x, y, c=y, relWidth=1.0_WP) + CALL ticks() + CALL labels('x', 'y', '') + + CALL subplot(1, 2, 2) + CALL xylim(mixval(y) + [0.0_WP, 0.1_WP], mixval(x) + [-0.1_WP, 0.1_WP]) + CALL barh(x, y, fillColor='r', relWidth=1.0_WP) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doBar + +!> ![fillBetween](../|media|/example-7.svg) +SUBROUTINE doFillBetween + INTEGER, PARAMETER :: N = 51 + REAL(wp), DIMENSION(N) :: x, y1, y2 + + x = linspace(-3.0_WP, 3.0_WP, N) + y1 = x**2 - 1.0_WP + y2 = x**3 - 1.0_WP + + CALL figure() + CALL subplot(1, 1, 1) + CALL xylim(mixval(x), mixval([y1, y2])) + CALL fillBetween(x, y1, y2, fillColor='c', fillPattern='#', lineWidth=2.0_WP) + CALL plot(x, y1, lineColor='k', lineWidth=3.0_WP) + CALL plot(x, y2, lineColor='k', lineWidth=3.0_WP) + CALL ticks(color='b', lineWidth=3.0_WP) + CALL labels('x', 'y', 'f(x)=x#u2#d-1', color='r') +END SUBROUTINE doFillBetween + +!> ![hist](../|media|/example-8.svg) +SUBROUTINE doHist + INTEGER, PARAMETER :: N = 10000 + REAL(wp), DIMENSION(N, 12) :: r + REAL(wp), DIMENSION(N) :: x + REAL(wp), DIMENSION(:, :), ALLOCATABLE :: h + + CALL RANDOM_NUMBER(r) + x = SUM(r, 2) - 6.0_WP + CALL figure() + + CALL subplot(1, 2, 1) + CALL xylim(mixval(x), [0.0_WP, 1.05_WP]) + CALL hist(x, 20) + CALL ticks() + + h = binData(x, 20, normalize=2) + CALL subplot(1, 2, 2) + CALL xylim(mixval(h(:, 1)), [0.0_WP, 1.05_WP * MAXVAL(h(:, 2))]) + CALL bar(h(:, 1), h(:, 2), c=h(:, 2), relWidth=1.0_WP) + CALL ticks() +END SUBROUTINE doHist + +!> ![surface](../|media|/example-9.svg) +SUBROUTINE doSurface + INTEGER, PARAMETER :: N = 24 + REAL(wp), DIMENSION(N) :: x, y + REAL(wp), DIMENSION(N, N) :: z + INTEGER :: i, j + + x = linspace(-10.0_WP, 10.0_WP, N) + y = linspace(-10.0_WP, 10.0_WP, N) + DO CONCURRENT(i=1:N, j=1:N) + z(i, j) = SIN(SQRT(x(i)**2 + y(j)**2)) / SQRT(x(i)**2 + y(j)**2) + END DO + + CALL figure() + + CALL subplot(1, 1, 1, is3d=.TRUE.) + CALL xyzlim(mixval(x), mixval(y), mixval(z), zoom=1.1_WP) + CALL surface(x, y, z, 11) !~ call wireframe(x,y,z,lineColor='k') - call box('x', 'y', 'z') - - end subroutine doSurface - - !> ![error](../|media|/example-10.svg) - subroutine doError - - integer, parameter :: N = 25 - real(wp), dimension(N) :: x, y, xe, ye - real(wp), dimension(12) :: r - real(wp) :: m, s - integer :: k - - x = linspace(0.0_wp, 5.0_wp, N) - y = 1.0_wp/(x**2 + 1.0_wp) - - do k = 1, N - call random_number(r) - r = 0.25_wp*(2.0_wp*r - 1.0_wp) - m = sum(r)/real(size(r)) - s = sqrt(sum((r - m)**2)/real(size(r) - 1)) - x(k) = x(k) + m - xe(k) = s - - call random_number(r) - r = 0.15_wp*(2.0_wp*r - 1.0_wp) - m = sum(r)/real(size(r)) - s = sqrt(sum((r - m)**2)/real(size(r) - 1)) - y(k) = y(k) + m - ye(k) = s - end do - - call figure() - call subplot(1, 1, 1) + CALL box('x', 'y', 'z') + +END SUBROUTINE doSurface + +!> ![error](../|media|/example-10.svg) +SUBROUTINE doError + + INTEGER, PARAMETER :: N = 25 + REAL(wp), DIMENSION(N) :: x, y, xe, ye + REAL(wp), DIMENSION(12) :: r + REAL(wp) :: m, s + INTEGER :: k + + x = linspace(0.0_WP, 5.0_WP, N) + y = 1.0_WP / (x**2 + 1.0_WP) + + DO k = 1, N + CALL RANDOM_NUMBER(r) + r = 0.25_WP * (2.0_WP * r - 1.0_WP) + m = SUM(r) / REAL(SIZE(r)) + s = SQRT(SUM((r - m)**2) / REAL(SIZE(r) - 1)) + x(k) = x(k) + m + xe(k) = s + + CALL RANDOM_NUMBER(r) + r = 0.15_WP * (2.0_WP * r - 1.0_WP) + m = SUM(r) / REAL(SIZE(r)) + s = SQRT(SUM((r - m)**2) / REAL(SIZE(r) - 1)) + y(k) = y(k) + m + ye(k) = s + END DO + + CALL figure() + CALL subplot(1, 1, 1) call xylim(mixval([x - xe, x + xe]) + [-0.5_wp, 0.5_wp], mixval([y - ye, y + ye]) + [-0.2_wp, 0.2_wp]) - call errorbar(x, y, xerr=xe, yerr=ye, lineColor='b', lineWidth=1.0_wp) - call plot(x, y, lineStyle='', markStyle='s', markColor='r', markSize=1.5_wp) - call ticks() - call labels('x', 'y', '') - end subroutine doError - - !> ![logPlot](../|media|/example-11.svg) - subroutine doLogPlot - - integer, parameter :: N = 25 - real(wp), dimension(N) :: x, y, yl - - x = linspace(0.0_wp, 5.0_wp, N) - y = exp(-x**2) - yl = log10(y) - - call figure() - call subplot(1, 1, 1) - call xylim(mixval(x), mixval(yl)) - call plot(x, yl, lineColor='r', lineWidth=2.0_wp) - call ticks(logy=.true.) - call labels('x [linear]', 'y [log]', 'exp(-x#u2#d)') - end subroutine doLogPlot - -end program examples + CALL errorbar(x, y, xerr=xe, yerr=ye, lineColor='b', lineWidth=1.0_WP) + CALL plot(x, y, lineStyle='', markStyle='s', markColor='r', markSize=1.5_WP) + CALL ticks() + CALL labels('x', 'y', '') +END SUBROUTINE doError + +!> ![logPlot](../|media|/example-11.svg) +SUBROUTINE doLogPlot + + INTEGER, PARAMETER :: N = 25 + REAL(wp), DIMENSION(N) :: x, y, yl + + x = linspace(0.0_WP, 5.0_WP, N) + y = EXP(-x**2) + yl = LOG10(y) + + CALL figure() + CALL subplot(1, 1, 1) + CALL xylim(mixval(x), mixval(yl)) + CALL plot(x, yl, lineColor='r', lineWidth=2.0_WP) + CALL ticks(logy=.TRUE.) + CALL labels('x [linear]', 'y [log]', 'exp(-x#u2#d)') +END SUBROUTINE doLogPlot + +END PROGRAM examples diff --git a/src/modules/EasyPlplot/src/EasyPlplot.F90 b/src/modules/EasyPlplot/src/EasyPlplot.F90 index 77d09fa30..5457bc984 100644 --- a/src/modules/EasyPlplot/src/EasyPlplot.F90 +++ b/src/modules/EasyPlplot/src/EasyPlplot.F90 @@ -208,7 +208,9 @@ FUNCTION localize_1(A) RESULT(o) N = SIZE(A) ALLOCATE (o(N)) - FORALL (k=1:N) o(k) = REAL(A(k), pp) + DO CONCURRENT(k=1:N) + o(k) = REAL(A(k), pp) + END DO END FUNCTION localize_1 !---------------------------------------------------------------------------- @@ -223,7 +225,9 @@ FUNCTION localize_2(A) RESULT(o) N = SIZE(A, 1) M = SIZE(A, 2) ALLOCATE (o(N, M)) - FORALL (i=1:N, j=1:M) o(i, j) = REAL(A(i, j), pp) + DO CONCURRENT(i=1:N, j=1:M) + o(i, j) = REAL(A(i, j), pp) + END DO END FUNCTION localize_2 !---------------------------------------------------------------------------- diff --git a/src/modules/EasyPlplot/src/EasyPlplot_Utilities.F90 b/src/modules/EasyPlplot/src/EasyPlplot_Utilities.F90 index 8897a282e..d8b6d359d 100644 --- a/src/modules/EasyPlplot/src/EasyPlplot_Utilities.F90 +++ b/src/modules/EasyPlplot/src/EasyPlplot_Utilities.F90 @@ -1,186 +1,186 @@ !> Utility module containing miscellaneous tools that don't !> quite fit anywhere else. -module EasyPlplot_Utilities -use GlobalData, ONLY: wp => DFP -implicit none -private +MODULE EasyPlplot_Utilities +USE GlobalData, ONLY: wp => DFP +IMPLICIT NONE +PRIVATE !> Return a 2-vector comprising the minimum and maximum values of an array -interface mixval - module procedure mixval_1 - module procedure mixval_2 - module procedure mixval_3 -end interface +INTERFACE mixval + MODULE PROCEDURE mixval_1 + MODULE PROCEDURE mixval_2 + MODULE PROCEDURE mixval_3 +END INTERFACE !> Return a the maximum-minumum values of an array -interface span - module procedure span_1 - module procedure span_2 - module procedure span_3 -end interface +INTERFACE span + MODULE PROCEDURE span_1 + MODULE PROCEDURE span_2 + MODULE PROCEDURE span_3 +END INTERFACE !> Reduce an array to one dimension -interface flatten - module procedure flatten_2 - module procedure flatten_3 -end interface +INTERFACE flatten + MODULE PROCEDURE flatten_2 + MODULE PROCEDURE flatten_3 +END INTERFACE -public :: mixval -public :: span -public :: linspace +PUBLIC :: mixval +PUBLIC :: span +PUBLIC :: linspace -public :: startsWith -public :: endsWith +PUBLIC :: startsWith +PUBLIC :: endsWith -public :: meshGridX -public :: meshGridY +PUBLIC :: meshGridX +PUBLIC :: meshGridY -public :: randomNormal -public :: randomUniform -public :: mean -public :: stdev +PUBLIC :: randomNormal +PUBLIC :: randomUniform +PUBLIC :: mean +PUBLIC :: stdev -public :: flatten +PUBLIC :: flatten -public :: colorize -public :: int2char -public :: real2char +PUBLIC :: colorize +PUBLIC :: int2char +PUBLIC :: real2char -public :: showProgress +PUBLIC :: showProgress -contains +CONTAINS !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return [hi,low] for an array -function mixval_1(x) result(b) - real(wp), dimension(:), intent(in) :: x +FUNCTION mixval_1(x) RESULT(b) + REAL(wp), DIMENSION(:), INTENT(in) :: x !! Array to find extrema in - real(wp), dimension(2) :: b + REAL(wp), DIMENSION(2) :: b - b = [minval(x), maxval(x)] -end function mixval_1 + b = [MINVAL(x), MAXVAL(x)] +END FUNCTION mixval_1 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return [hi,low] for an array -function mixval_2(x) result(b) - real(wp), dimension(:, :), intent(in) :: x +FUNCTION mixval_2(x) RESULT(b) + REAL(wp), DIMENSION(:, :), INTENT(in) :: x !! Array to find extrema in - real(wp), dimension(2) :: b + REAL(wp), DIMENSION(2) :: b - b = [minval(x), maxval(x)] -end function mixval_2 + b = [MINVAL(x), MAXVAL(x)] +END FUNCTION mixval_2 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return [hi,low] for an array -function mixval_3(x) result(b) - real(wp), dimension(:, :, :), intent(in) :: x +FUNCTION mixval_3(x) RESULT(b) + REAL(wp), DIMENSION(:, :, :), INTENT(in) :: x !! Array to find extrema in - real(wp), dimension(2) :: b + REAL(wp), DIMENSION(2) :: b - b = [minval(x), maxval(x)] -end function mixval_3 + b = [MINVAL(x), MAXVAL(x)] +END FUNCTION mixval_3 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return hi-low for an array -function span_1(x) result(o) - real(wp), dimension(:), intent(in) :: x +FUNCTION span_1(x) RESULT(o) + REAL(wp), DIMENSION(:), INTENT(in) :: x !! Array to find span in - real(wp) :: o + REAL(wp) :: o - o = maxval(x) - minval(x) -end function span_1 + o = MAXVAL(x) - MINVAL(x) +END FUNCTION span_1 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return hi-low for an array -function span_2(x) result(o) - real(wp), dimension(:, :), intent(in) :: x +FUNCTION span_2(x) RESULT(o) + REAL(wp), DIMENSION(:, :), INTENT(in) :: x !! Array to find span in - real(wp) :: o + REAL(wp) :: o - o = maxval(x) - minval(x) -end function span_2 + o = MAXVAL(x) - MINVAL(x) +END FUNCTION span_2 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return hi-low for an array -function span_3(x) result(o) - real(wp), dimension(:, :, :), intent(in) :: x +FUNCTION span_3(x) RESULT(o) + REAL(wp), DIMENSION(:, :, :), INTENT(in) :: x !! Array to find span in - real(wp) :: o + REAL(wp) :: o - o = maxval(x) - minval(x) -end function span_3 + o = MAXVAL(x) - MINVAL(x) +END FUNCTION span_3 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Return an array of evenly-spaced values -function linspace(l, h, N) result(o) - real(wp), intent(in) :: l +FUNCTION linspace(l, h, N) RESULT(o) + REAL(wp), INTENT(in) :: l !! Low-bound for values - real(wp), intent(in) :: h + REAL(wp), INTENT(in) :: h !! High-bound for values - integer, intent(in), optional :: N + INTEGER, INTENT(in), OPTIONAL :: N !! Number of values (default 20) - real(wp), dimension(:), allocatable :: o + REAL(wp), DIMENSION(:), ALLOCATABLE :: o - integer :: Nl, i + INTEGER :: Nl, i Nl = 20 - if (present(N)) Nl = N + IF (PRESENT(N)) Nl = N - o = [((h - l) * real(i - 1, wp) / real(Nl - 1, wp) + l, i=1, Nl)] -end function linspace + o = [((h - l) * REAL(i - 1, wp) / REAL(Nl - 1, wp) + l, i=1, Nl)] +END FUNCTION linspace !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Test if text starts with str -function startsWith(text, str) result(o) - character(*), intent(in) :: text !! Text to search - character(*), intent(in) :: str !! String to look for - logical :: o - integer :: k +FUNCTION startsWith(text, str) RESULT(o) + CHARACTER(*), INTENT(in) :: text !! Text to search + CHARACTER(*), INTENT(in) :: str !! String to look for + LOGICAL :: o + INTEGER :: k - k = len(str) + k = LEN(str) o = text(1:k) == str -end function startsWith +END FUNCTION startsWith !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Test if text ends with str -function endsWith(text, str) result(o) - character(*), intent(in) :: text +FUNCTION endsWith(text, str) RESULT(o) + CHARACTER(*), INTENT(in) :: text !! Text to search - character(*), intent(in) :: str + CHARACTER(*), INTENT(in) :: str !! String to look for - logical :: o - integer :: k + LOGICAL :: o + INTEGER :: k - k = len(text) - o = text(k - len(str) + 1:k) == str -end function endsWith + k = LEN(text) + o = text(k - LEN(str) + 1:k) == str +END FUNCTION endsWith !---------------------------------------------------------------------------- ! @@ -189,13 +189,13 @@ end function endsWith !> Return a sample from an approximate normal distribution !> with a mean of \(\mu=0\) and a standard deviation of !> \(\sigma=1\). In this approximate distribution, \(x\in[-6,6]\). -function randomNormal() result(o) - real(wp) :: o - real(wp), dimension(12) :: x +FUNCTION randomNormal() RESULT(o) + REAL(wp) :: o + REAL(wp), DIMENSION(12) :: x - call random_number(x) - o = sum(x) - 6.0_wp -end function randomNormal + CALL RANDOM_NUMBER(x) + o = SUM(x) - 6.0_WP +END FUNCTION randomNormal !---------------------------------------------------------------------------- ! @@ -203,266 +203,270 @@ end function randomNormal !> Return a sample from a uniform distribution !> in the range \(x\in[-1,1]\). -function randomUniform() result(o) - real(wp) :: o +FUNCTION randomUniform() RESULT(o) + REAL(wp) :: o - call random_number(o) - o = o * 2.0_wp - 1.0_wp -end function randomUniform + CALL RANDOM_NUMBER(o) + o = o * 2.0_WP - 1.0_WP +END FUNCTION randomUniform !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Convert a 2d array to 1d -function flatten_2(A) result(o) - real(wp), dimension(:, :), intent(in) :: A +FUNCTION flatten_2(A) RESULT(o) + REAL(wp), DIMENSION(:, :), INTENT(in) :: A !! Array to convert - real(wp), dimension(:), allocatable :: o + REAL(wp), DIMENSION(:), ALLOCATABLE :: o - o = reshape(A, [size(A)]) -end function flatten_2 + o = RESHAPE(A, [SIZE(A)]) +END FUNCTION flatten_2 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Convert a 3d array to 1d -function flatten_3(A) result(o) - real(wp), dimension(:, :, :), intent(in) :: A +FUNCTION flatten_3(A) RESULT(o) + REAL(wp), DIMENSION(:, :, :), INTENT(in) :: A !! Array to convert - real(wp), dimension(:), allocatable :: o + REAL(wp), DIMENSION(:), ALLOCATABLE :: o - o = reshape(A, [size(A)]) -end function flatten_3 + o = RESHAPE(A, [SIZE(A)]) +END FUNCTION flatten_3 !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Construct a 2d array of X values from a structured grid -function meshGridX(x, y) result(o) - real(wp), dimension(:), intent(in) :: x +FUNCTION meshGridX(x, y) RESULT(o) + REAL(wp), DIMENSION(:), INTENT(in) :: x !! x-positions in grid - real(wp), dimension(:), intent(in) :: y + REAL(wp), DIMENSION(:), INTENT(in) :: y !! y-positions in grid - real(wp), dimension(:, :), allocatable :: o + REAL(wp), DIMENSION(:, :), ALLOCATABLE :: o - integer :: Nx, Ny - integer :: i, j + INTEGER :: Nx, Ny + INTEGER :: i, j - Nx = size(x) - Ny = size(y) + Nx = SIZE(x) + Ny = SIZE(y) - allocate (o(Nx, Ny)) + ALLOCATE (o(Nx, Ny)) - forall (i=1:Nx, j=1:Ny) o(i, j) = x(i) -end function meshGridX + DO CONCURRENT(i=1:Nx, j=1:Ny) + o(i, j) = x(i) + END DO +END FUNCTION meshGridX !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Construct a 2d array of Y values from a structured grid -function meshGridY(x, y) result(o) - real(wp), dimension(:), intent(in) :: x +FUNCTION meshGridY(x, y) RESULT(o) + REAL(wp), DIMENSION(:), INTENT(in) :: x !! x-positions in grid - real(wp), dimension(:), intent(in) :: y + REAL(wp), DIMENSION(:), INTENT(in) :: y !! y-positions in grid - real(wp), dimension(:, :), allocatable :: o + REAL(wp), DIMENSION(:, :), ALLOCATABLE :: o - integer :: Nx, Ny - integer :: i, j + INTEGER :: Nx, Ny + INTEGER :: i, j - Nx = size(x) - Ny = size(y) + Nx = SIZE(x) + Ny = SIZE(y) - allocate (o(Nx, Ny)) + ALLOCATE (o(Nx, Ny)) - forall (i=1:Nx, j=1:Ny) o(i, j) = y(j) -end function meshGridY + DO CONCURRENT(i=1:Nx, j=1:Ny) + o(i, j) = y(j) + END DO +END FUNCTION meshGridY !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Add terminal format codes to coloize a string -function colorize(s, c) result(o) - character(*), intent(in) :: s +FUNCTION colorize(s, c) RESULT(o) + CHARACTER(*), INTENT(in) :: s !! String to colorize - integer, dimension(3) :: c ! c in [0,5] + INTEGER, DIMENSION(3) :: c ! c in [0,5] !! Color code in [r,g,b] where \(r,g,b\in[0,5]\) - character(:), allocatable :: o + CHARACTER(:), ALLOCATABLE :: o - character(1), parameter :: CR = achar(13) - character(1), parameter :: ESC = achar(27) + CHARACTER(1), PARAMETER :: CR = ACHAR(13) + CHARACTER(1), PARAMETER :: ESC = ACHAR(27) - character(20) :: pre - character(3) :: cb + CHARACTER(20) :: pre + CHARACTER(3) :: cb - write (cb, '(1I3)') 36 * c(1) + 6 * c(2) + c(3) + 16 - pre = ESC//'[38;5;'//trim(adjustl(cb))//'m' - o = trim(pre)//s//ESC//'[0m' -end function colorize + WRITE (cb, '(1I3)') 36 * c(1) + 6 * c(2) + c(3) + 16 + pre = ESC//'[38;5;'//TRIM(ADJUSTL(cb))//'m' + o = TRIM(pre)//s//ESC//'[0m' +END FUNCTION colorize !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Convert a real to a character -pure function real2char(a, f, l) result(o) - real(wp), intent(in) :: a +PURE FUNCTION real2char(a, f, l) RESULT(o) + REAL(wp), INTENT(in) :: a !! Real value to convert - character(*), optional, intent(in) :: f + CHARACTER(*), OPTIONAL, INTENT(in) :: f !! Format of result - integer, optional, intent(in) :: l + INTEGER, OPTIONAL, INTENT(in) :: l !! Length of result - character(:), allocatable :: o - - character(128) :: buf - - if (present(l)) then - allocate (character(l) :: o) - if (present(f)) then - write (o, '('//f//')') a - else - write (o, *) a - end if - else - if (present(f)) then - write (buf, '('//f//')') a - else - write (buf, *) a - end if - o = trim(adjustl(buf)) - end if -end function real2char + CHARACTER(:), ALLOCATABLE :: o + + CHARACTER(128) :: buf + + IF (PRESENT(l)) THEN + ALLOCATE (CHARACTER(l) :: o) + IF (PRESENT(f)) THEN + WRITE (o, '('//f//')') a + ELSE + WRITE (o, *) a + END IF + ELSE + IF (PRESENT(f)) THEN + WRITE (buf, '('//f//')') a + ELSE + WRITE (buf, *) a + END IF + o = TRIM(ADJUSTL(buf)) + END IF +END FUNCTION real2char !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Convert an integer to a character -pure function int2char(a, f, l) result(o) - integer, intent(in) :: a +PURE FUNCTION int2char(a, f, l) RESULT(o) + INTEGER, INTENT(in) :: a !! Integer value to convert - character(*), optional, intent(in) :: f + CHARACTER(*), OPTIONAL, INTENT(in) :: f !! Format of result - integer, optional, intent(in) :: l + INTEGER, OPTIONAL, INTENT(in) :: l !! Length of result - character(:), allocatable :: o - - character(128) :: buf - - if (present(l)) then - allocate (character(l) :: o) - if (present(f)) then - write (o, '('//f//')') a - else - write (o, *) a - end if - else - if (present(f)) then - write (buf, '('//f//')') a - else - write (buf, *) a - end if - o = trim(adjustl(buf)) - end if -end function int2char + CHARACTER(:), ALLOCATABLE :: o + + CHARACTER(128) :: buf + + IF (PRESENT(l)) THEN + ALLOCATE (CHARACTER(l) :: o) + IF (PRESENT(f)) THEN + WRITE (o, '('//f//')') a + ELSE + WRITE (o, *) a + END IF + ELSE + IF (PRESENT(f)) THEN + WRITE (buf, '('//f//')') a + ELSE + WRITE (buf, *) a + END IF + o = TRIM(ADJUSTL(buf)) + END IF +END FUNCTION int2char !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Show a progress bar with a message -subroutine showProgress(m, p) - character(*), intent(in) :: m +SUBROUTINE showProgress(m, p) + CHARACTER(*), INTENT(in) :: m !! Message to show - real(wp), intent(in) :: p + REAL(wp), INTENT(in) :: p !! Progress level \(p\in[0,1]\) - real(wp) :: r - real(wp), save :: po - integer :: N, k + REAL(wp) :: r + REAL(wp), SAVE :: po + INTEGER :: N, k N = 40 - if (p <= 0.0_wp) then + IF (p <= 0.0_WP) THEN po = p - end if - if (p - po < 0.05 .and. p < 1.0_wp) then - return - else + END IF + IF (p - po < 0.05 .AND. p < 1.0_WP) THEN + RETURN + ELSE po = p - end if - - write (*, '(1A)', advance='no') achar(13)//colorize(m//' [', [5, 5, 0]) - do k = 1, N - r = real(k - 1, wp) / real(N - 1, wp) - if (r <= p) then - write (*, '(1A)', advance='no') colorize('=', cmap(r, [0.0_wp, 1.0_wp])) - else - write (*, '(1A)', advance='no') colorize(' ', [0, 0, 0]) - end if - end do - write (*, '(1A,1A,1X,1A)', advance='no') colorize('] ', [5, 5, 0]), & - & colorize(real2char(100.0_wp * p, '1F5.1'), & - & cmap(p, [0.0_wp, 1.0_wp])), & + END IF + + WRITE (*, '(1A)', advance='no') ACHAR(13)//colorize(m//' [', [5, 5, 0]) + DO k = 1, N + r = REAL(k - 1, wp) / REAL(N - 1, wp) + IF (r <= p) THEN + WRITE (*, '(1A)', advance='no') colorize('=', cmap(r, [0.0_WP, 1.0_WP])) + ELSE + WRITE (*, '(1A)', advance='no') colorize(' ', [0, 0, 0]) + END IF + END DO + WRITE (*, '(1A,1A,1X,1A)', advance='no') colorize('] ', [5, 5, 0]), & + & colorize(real2char(100.0_WP * p, '1F5.1'), & + & cmap(p, [0.0_WP, 1.0_WP])), & & colorize('%', [5, 5, 0]) - if (p >= 1.0_wp) write (*, '(1A)') '' - flush (6) -end subroutine showProgress + IF (p >= 1.0_WP) WRITE (*, '(1A)') '' + FLUSH (6) +END SUBROUTINE showProgress !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Sample a color from a cool-warm colormap for colorize -function cmap(v, r) result(c) - real(wp), intent(in) :: v +FUNCTION cmap(v, r) RESULT(c) + REAL(wp), INTENT(in) :: v !! Value to sample - real(wp), dimension(2), intent(in) :: r + REAL(wp), DIMENSION(2), INTENT(in) :: r !! Range to sample from - integer, dimension(3) :: c + INTEGER, DIMENSION(3) :: c - integer :: s + INTEGER :: s - if (v < sum(r) / 2.0_wp) then - s = nint((v - r(1)) / (sum(r) / 2.0_wp - r(1)) * 5.0_wp) + IF (v < SUM(r) / 2.0_WP) THEN + s = NINT((v - r(1)) / (SUM(r) / 2.0_WP - r(1)) * 5.0_WP) c = [s, s, 5] - else - s = 5 - nint((v - sum(r) / 2.0_wp) / (r(2) - sum(r) / 2.0_wp) * 5.0_wp) + ELSE + s = 5 - NINT((v - SUM(r) / 2.0_WP) / (r(2) - SUM(r) / 2.0_WP) * 5.0_WP) c = [5, s, s] - end if -end function cmap + END IF +END FUNCTION cmap !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Compute the arithmetic mean of an array -function mean(d) result(o) - real(wp), dimension(:), intent(in) :: d - real(wp) :: o +FUNCTION mean(d) RESULT(o) + REAL(wp), DIMENSION(:), INTENT(in) :: d + REAL(wp) :: o - o = sum(d) / real(size(d), wp) -end function mean + o = SUM(d) / REAL(SIZE(d), wp) +END FUNCTION mean !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- !> Compute the standard deviation of an array -function stdev(d) result(o) - real(wp), dimension(:), intent(in) :: d - real(wp) :: o +FUNCTION stdev(d) RESULT(o) + REAL(wp), DIMENSION(:), INTENT(in) :: d + REAL(wp) :: o - o = sqrt(sum((d - mean(d))**2) / real(size(d) - 1, wp)) -end function stdev + o = SQRT(SUM((d - mean(d))**2) / REAL(SIZE(d) - 1, wp)) +END FUNCTION stdev !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- -end module EasyPlplot_Utilities +END MODULE EasyPlplot_Utilities diff --git a/src/modules/ElementFactory/src/ElementFactory.F90 b/src/modules/ElementFactory/src/ElementFactory.F90 index 24f74c97e..825e9b2d8 100755 --- a/src/modules/ElementFactory/src/ElementFactory.F90 +++ b/src/modules/ElementFactory/src/ElementFactory.F90 @@ -28,7 +28,7 @@ MODULE ElementFactory PUBLIC :: Element_, ElementPointer_, Element, Element_Pointer, TypeElement PUBLIC :: FacetElement_, FacetElementPointer_, & & FacetElement, FacetElement_Pointer, TypeFacetElement -CHARACTER(LEN=*), PARAMETER :: modName = "ElementFactory" +CHARACTER(*), PARAMETER :: modName = "ElementFactory" !---------------------------------------------------------------------------- ! @@ -67,8 +67,8 @@ FUNCTION elem_factory_from_fpl(param, refelem) RESULT(ans) CLASS(Element_), POINTER :: ans ! Define internal variables INTEGER(I4B) :: ierr - CHARACTER(LEN=*), PARAMETER :: myName = "elem_factory_from_fpl()" - CHARACTER(LEN=100) :: elemTypeName + CHARACTER(*), PARAMETER :: myName = "elem_factory_from_fpl()" + CHARACTER(100) :: elemTypeName TYPE(String) :: elemType IF (.NOT. param%ispresent(key="type")) THEN @@ -98,7 +98,7 @@ FUNCTION elem_factory_elem(obj) RESULT(ans) CLASS(Element_), INTENT(IN) :: obj CLASS(Element_), POINTER :: ans ! Define internal type - CHARACTER(LEN=*), PARAMETER :: myName = "elem_factory_elem()" + CHARACTER(*), PARAMETER :: myName = "elem_factory_elem()" SELECT TYPE (obj) TYPE IS (Element_) ALLOCATE (Element_ :: ans) @@ -118,11 +118,11 @@ END FUNCTION elem_factory_elem SUBROUTINE elem_factor_display(obj, msg, unitno, FullDisp) CLASS(Element_), INTENT(IN) :: obj - CHARACTER(LEN=*), INTENT(IN) :: msg + CHARACTER(*), INTENT(IN) :: msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno LOGICAL(LGT), OPTIONAL, INTENT(IN) :: FullDisp ! Define internal variables - CHARACTER(LEN=*), PARAMETER :: myName = "elem_factor_display()" + CHARACTER(*), PARAMETER :: myName = "elem_factor_display()" SELECT TYPE (obj) TYPE IS (Element_) CALL obj%display(msg=msg, unitno=unitno, FullDisp=FullDisp) @@ -177,4 +177,4 @@ END MODULE ElementFactory ! TYPE( H1_ ), INTENT( IN ) :: ContinuityType ! TYPE( LagrangeInterpolation_ ), INTENT( IN ) :: InterpolType ! END SUBROUTINE get_elemsd_H1_Lagrange -! END INTERFACE \ No newline at end of file +! END INTERFACE diff --git a/src/modules/FPL/src/FPL_Method.F90 b/src/modules/FPL/src/FPL_Method.F90 index 55520264d..34fa99b6c 100644 --- a/src/modules/FPL/src/FPL_Method.F90 +++ b/src/modules/FPL/src/FPL_Method.F90 @@ -21,13 +21,16 @@ MODULE FPL_Method USE GlobalData -USE BaSetype +USE BaseType USE BaseMethod USE FPL, ONLY: ParameterList_ USE ExceptionHandler_Class, ONLY: e PRIVATE -CHARACTER(*), PARAMETER :: modName = "FPL_Method" +CHARACTER(*), PARAMETER :: modName_ = "FPL_Method" !! TYPE(ExceptionHandler_) :: e +PUBLIC :: Set +PUBLIC :: GetValue +PUBLIC :: CheckEssentialParam !---------------------------------------------------------------------------- ! @@ -35,19 +38,39 @@ MODULE FPL_Method INTERFACE Set MODULE PROCEDURE fpl_Set1 + MODULE PROCEDURE fpl_Set_Int + MODULE PROCEDURE fpl_Set_Int_R1 + MODULE PROCEDURE fpl_Set_Real + MODULE PROCEDURE fpl_Set_Real_R1 + MODULE PROCEDURE fpl_Set_String + MODULE PROCEDURE fpl_Set_Char + MODULE PROCEDURE fpl_Set_Bool END INTERFACE Set -PUBLIC :: Set - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- -INTERFACE getValue - MODULE PROCEDURE fpl_getValue1 -END INTERFACE getValue +INTERFACE GetValue + MODULE PROCEDURE fpl_GetValue1 + MODULE PROCEDURE fpl_GetValue2 + MODULE PROCEDURE fpl_Get_Int + MODULE PROCEDURE fpl_Get_Int_R1 + MODULE PROCEDURE fpl_Get_Real + MODULE PROCEDURE fpl_Get_Real_R1 + MODULE PROCEDURE fpl_Get_Bool + MODULE PROCEDURE fpl_Get_Bool_R1 + MODULE PROCEDURE fpl_Get_String + MODULE PROCEDURE fpl_Get_Char +END INTERFACE GetValue + +!---------------------------------------------------------------------------- +! CheckEssentialParam +!---------------------------------------------------------------------------- -PUBLIC :: getValue +INTERFACE CheckEssentialParam + MODULE PROCEDURE fpl_CheckEssentialParam +END INTERFACE CheckEssentialParam !---------------------------------------------------------------------------- ! @@ -55,10 +78,45 @@ MODULE FPL_Method CONTAINS +!---------------------------------------------------------------------------- +! CheckEssentialParam +!---------------------------------------------------------------------------- + +SUBROUTINE fpl_CheckEssentialParam(obj, keys, prefix, myName, modName) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + TYPE(String), INTENT(IN) :: keys(:) + !! String keys to be check in obj + CHARACTER(*), INTENT(IN) :: prefix + !! Prefix + CHARACTER(*), INTENT(IN) :: myName + !! myName + CHARACTER(*), INTENT(IN) :: modName + ! internal variables + + INTEGER(I4B) :: ii + LOGICAL(LGT) :: abool + + DO ii = 1, SIZE(keys) + abool = obj%isPresent(key=prefix//"/"//keys(ii)) + IF (.NOT. abool) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & prefix//"/"//keys(ii)//' should be present in param. '// & + & "Error in "//tostring(ii)//"th parameter. "// & + & "This routine is called from fpl_CheckEssentialParam in "// & + & modName_//" module in the file "//__FILE__) + END IF + END DO +END SUBROUTINE fpl_CheckEssentialParam + !---------------------------------------------------------------------------- ! fpl_Set1 !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the parameters for DOF object + SUBROUTINE fpl_Set1(obj, key, VALUE) ! Define dummy variables TYPE(ParameterList_), INTENT(INOUT) :: obj @@ -72,10 +130,174 @@ SUBROUTINE fpl_Set1(obj, key, VALUE) END SUBROUTINE fpl_Set1 !---------------------------------------------------------------------------- -! fpl_get +! fpl_Set1 !---------------------------------------------------------------------------- -SUBROUTINE fpl_getValue1(obj, key, VALUE) +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the integer scalar parameter +! +!TODO: Implement fpl_Set for Int8, Int16, Int32, Int64 + +SUBROUTINE fpl_Set_Int(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + INTEGER(I4B), INTENT(IN) :: datatype + !! This argument is only to create unique interface + INTEGER(I4B), OPTIONAL, INTENT(IN) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE) + END IF +END SUBROUTINE fpl_Set_Int + +!---------------------------------------------------------------------------- +! fpl_Set1 +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the integer scalar parameter +! +!TODO: Implement fpl_Set for Int8, Int16, Int32, Int64 + +SUBROUTINE fpl_Set_Int_R1(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + INTEGER(I4B), INTENT(IN) :: datatype(1) + !! This argument is only to create unique interface + INTEGER(I4B), OPTIONAL, INTENT(IN) :: VALUE(:) + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE) + END IF +END SUBROUTINE fpl_Set_Int_R1 + +!---------------------------------------------------------------------------- +! fpl_Set +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the real scalar parameter +! +!TODO: Implement fpl_Set for Real32 and Real64 +SUBROUTINE fpl_Set_Real(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + REAL(DFP), INTENT(IN) :: datatype + !! This argument is only to create unique interface + REAL(DFP), OPTIONAL, INTENT(IN) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE) + END IF +END SUBROUTINE fpl_Set_Real + +!---------------------------------------------------------------------------- +! fpl_Set +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the real vector parameter +! +!TODO: Implement fpl_Set for Real32 and Real64 +SUBROUTINE fpl_Set_Real_R1(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + REAL(DFP), INTENT(IN) :: datatype(1) + !! This argument is only to create unique interface + REAL(DFP), OPTIONAL, INTENT(IN) :: VALUE(:) + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE) + END IF +END SUBROUTINE fpl_Set_Real_R1 + +!---------------------------------------------------------------------------- +! fpl_Set +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the real scalar parameter + +SUBROUTINE fpl_Set_String(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + TYPE(String), INTENT(IN) :: datatype + TYPE(String), OPTIONAL, INTENT(IN) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE%chars()) + END IF +END SUBROUTINE fpl_Set_String + +!---------------------------------------------------------------------------- +! fpl_Set +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the real scalar parameter + +SUBROUTINE fpl_Set_Char(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + CHARACTER(*), INTENT(IN) :: datatype + CHARACTER(*), OPTIONAL, INTENT(IN) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=TRIM(VALUE)) + END IF +END SUBROUTINE fpl_Set_Char + +!---------------------------------------------------------------------------- +! fpl_Set +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Set the real scalar parameter + +SUBROUTINE fpl_Set_Bool(obj, datatype, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(INOUT) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + LOGICAL(LGT), INTENT(IN) :: datatype + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + IF (PRESENT(VALUE)) THEN + ierr = obj%Set(key=TRIM(prefix)//"/"//TRIM(key), VALUE=VALUE) + END IF +END SUBROUTINE fpl_Set_Bool + +!---------------------------------------------------------------------------- +! fpl_Get +!---------------------------------------------------------------------------- + +SUBROUTINE fpl_GetValue1(obj, key, VALUE) ! Define dummy variables TYPE(ParameterList_), INTENT(IN) :: obj CHARACTER(*), INTENT(IN) :: key @@ -83,14 +305,264 @@ SUBROUTINE fpl_getValue1(obj, key, VALUE) ! Internal variable INTEGER(I4B) :: ierr INTEGER(I4B), ALLOCATABLE :: s(:) - ierr = obj%getShape(key=TRIM(key)//"/map", shape=s) + ierr = obj%GetShape(key=TRIM(key)//"/map", shape=s) CALL Reallocate(VALUE%map, s(1), s(2)) - ierr = obj%getShape(key=TRIM(key)//"/valmap", shape=s) + ierr = obj%GetShape(key=TRIM(key)//"/valmap", shape=s) CALL Reallocate(VALUE%valmap, s(1)) - ierr = obj%get(key=TRIM(key)//"/map", VALUE=VALUE%map) - ierr = obj%get(key=TRIM(key)//"/valmap", VALUE=VALUE%valmap) - ierr = obj%get(key=TRIM(key)//"/storageFMT", VALUE=VALUE%storageFMT) + ierr = obj%Get(key=TRIM(key)//"/map", VALUE=VALUE%map) + ierr = obj%Get(key=TRIM(key)//"/valmap", VALUE=VALUE%valmap) + ierr = obj%Get(key=TRIM(key)//"/storageFMT", VALUE=VALUE%storageFMT) DEALLOCATE (s) -END SUBROUTINE fpl_getValue1 +END SUBROUTINE fpl_GetValue1 + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +SUBROUTINE fpl_GetValue2(obj, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: key + TYPE(String), INTENT(INOUT) :: VALUE + ! Internal variable + CHARACTER(:), ALLOCATABLE :: char_var + INTEGER(I4B) :: ierr + CHARACTER(*), PARAMETER :: myName = "fpl_GetValue2()" + + IF (obj%isPresent(key=key)) THEN + ALLOCATE (CHARACTER( & + & obj%DataSizeInBytes(key=key)) :: char_var) + ierr = obj%Get(key=key, VALUE=char_var) + IF (ALLOCATED(char_var)) THEN + VALUE = char_var + DEALLOCATE (char_var) + ELSE + VALUE = "" + END IF + ELSE + CALL e%raiseError(modName_//'::'//myName//" - "// & + & key//' not found in obj') + END IF +END SUBROUTINE fpl_GetValue2 + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the integer scalar parameter +! +!TODO: Implement fpl_Set for Int8, Int16, Int32, Int64 + +SUBROUTINE fpl_Get_Int(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + INTEGER(I4B), INTENT(OUT) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Int + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the integer vector parameter +! +!TODO: Implement fpl_Set for Int8, Int16, Int32, Int64 + +SUBROUTINE fpl_Get_Int_R1(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + INTEGER(I4B), INTENT(OUT) :: VALUE(:) + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Int_R1 + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the real scalar parameter +! +!TODO: Implement fpl_Set for Real32, Real64 + +SUBROUTINE fpl_Get_Real(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + REAL(DFP), INTENT(OUT) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Real + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the real vector parameter +! +!TODO: Implement fpl_Set for Real32, Real64 + +SUBROUTINE fpl_Get_Real_R1(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + REAL(DFP), INTENT(OUT) :: VALUE(:) + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Real_R1 + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the boolean scalar parameter + +SUBROUTINE fpl_Get_Bool(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + LOGICAL(LGT), INTENT(OUT) :: VALUE + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Bool + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the boolean vector parameter + +SUBROUTINE fpl_Get_Bool_R1(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + LOGICAL(LGT), INTENT(OUT) :: VALUE(:) + ! Internal variable + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + IF (obj%isPresent(key=varname%chars())) THEN + ierr = obj%Get(key=varname%chars(), VALUE=VALUE) + END IF + varname = "" +END SUBROUTINE fpl_Get_Bool_R1 + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the string scalar parameter + +SUBROUTINE fpl_Get_String(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + TYPE(String), INTENT(OUT) :: VALUE + ! Internal variable + CHARACTER(:), ALLOCATABLE :: char_var + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + + IF (obj%isPresent(key=varname%chars())) THEN + ALLOCATE (CHARACTER( & + & obj%DataSizeInBytes(key=varname%chars())) :: char_var) + ierr = obj%Get(key=varname%chars(), VALUE=char_var) + IF (ALLOCATED(char_var)) THEN + VALUE = char_var + DEALLOCATE (char_var) + ELSE + VALUE = "" + END IF + END IF + varname = "" +END SUBROUTINE fpl_Get_String + +!---------------------------------------------------------------------------- +! GetValue +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Get the fortran string scalar parameter + +SUBROUTINE fpl_Get_Char(obj, prefix, key, VALUE) + ! Define dummy variables + TYPE(ParameterList_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: prefix + CHARACTER(*), INTENT(IN) :: key + CHARACTER(*), INTENT(OUT) :: VALUE + ! Internal variable + CHARACTER(:), ALLOCATABLE :: char_var + INTEGER(I4B) :: ierr + TYPE(String) :: varname + varname = TRIM(prefix)//"/"//TRIM(key) + + IF (obj%isPresent(key=varname%chars())) THEN + ALLOCATE (CHARACTER( & + & obj%DataSizeInBytes(key=varname%chars())) :: char_var) + ierr = obj%Get(key=varname%chars(), VALUE=char_var) + IF (ALLOCATED(char_var)) THEN + VALUE = char_var + DEALLOCATE (char_var) + ELSE + VALUE = "" + END IF + END IF + varname = "" +END SUBROUTINE fpl_Get_Char END MODULE FPL_Method diff --git a/src/modules/FacetElement/src/FacetElement_Class.F90 b/src/modules/FacetElement/src/FacetElement_Class.F90 index 0e47ef852..03c5ed6ae 100644 --- a/src/modules/FacetElement/src/FacetElement_Class.F90 +++ b/src/modules/FacetElement/src/FacetElement_Class.F90 @@ -15,10 +15,9 @@ ! along with this program. If not, see ! - !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: [[FacetElement_]] is defined +! date: 24 March 2021 +! summary: [[FacetElement_]] is defined MODULE FacetElement_Class USE GlobalData @@ -28,41 +27,41 @@ MODULE FacetElement_Class IMPLICIT NONE PRIVATE -CHARACTER( LEN=* ), PARAMETER :: modName="FACETELEMENT_CLASS" +CHARACTER(*), PARAMETER :: modName = "FACETELEMENT_CLASS" !---------------------------------------------------------------------------- ! FacetElement_ !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Facet Element is defined +! date: 24 March 2021 +! summary: Facet Element is defined ! !{!pages/FacetElement.md} -TYPE, EXTENDS( Element_ ) :: FacetElement_ +TYPE, EXTENDS(Element_) :: FacetElement_ PRIVATE - INTEGER( I4B ) :: LocalID = 0_I4B - CLASS( Element_ ), POINTER :: Cell => NULL( ) - CLASS( Element_ ), POINTER :: OuterCell => NULL( ) + INTEGER(I4B) :: LocalID = 0_I4B + CLASS(Element_), POINTER :: Cell => NULL() + CLASS(Element_), POINTER :: OuterCell => NULL() - CONTAINS +CONTAINS ! Constructor - PROCEDURE, PUBLIC, PASS( obj ) :: getCellNptrs => faceElem_getCellNptrs - PROCEDURE, PUBLIC, PASS( obj ) :: setCellNptrs => faceElem_setCellNptrs - PROCEDURE, PUBLIC, PASS( obj ) :: getCellPointer => faceElem_getCellPointer - PROCEDURE, PUBLIC, PASS( obj ) :: setCellPointer => faceElem_setCellPointer - PROCEDURE, PUBLIC, PASS( obj ) :: FreeCellPointer => & + PROCEDURE, PUBLIC, PASS(obj) :: getCellNptrs => faceElem_getCellNptrs + PROCEDURE, PUBLIC, PASS(obj) :: setCellNptrs => faceElem_setCellNptrs + PROCEDURE, PUBLIC, PASS(obj) :: getCellPointer => faceElem_getCellPointer + PROCEDURE, PUBLIC, PASS(obj) :: setCellPointer => faceElem_setCellPointer + PROCEDURE, PUBLIC, PASS(obj) :: FreeCellPointer => & & faceElem_freeCellPointer - PROCEDURE, PUBLIC, PASS( obj ) :: getFacetLocalID => & + PROCEDURE, PUBLIC, PASS(obj) :: getFacetLocalID => & & faceElem_getFacetLocalID - PROCEDURE, PUBLIC, PASS( obj ) :: setFacetLocalID => & + PROCEDURE, PUBLIC, PASS(obj) :: setFacetLocalID => & & faceElem_setFacetLocalID - PROCEDURE, PUBLIC, PASS( obj ) :: getFacetLocalNptrs => & + PROCEDURE, PUBLIC, PASS(obj) :: getFacetLocalNptrs => & & faceElem_getFacetLocalNptrs - PROCEDURE, PUBLIC, PASS( obj ) :: Display => faceElem_display + PROCEDURE, PUBLIC, PASS(obj) :: Display => faceElem_display FINAL :: faceElem_Deallocate - PROCEDURE, PUBLIC, PASS( obj ) :: Deallocate => elem_Deallocate + PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => elem_Deallocate END TYPE FacetElement_ !---------------------------------------------------------------------------- @@ -70,15 +69,15 @@ MODULE FacetElement_Class !---------------------------------------------------------------------------- PUBLIC :: FacetElement_ -TYPE( FacetElement_ ), PARAMETER, PUBLIC :: & - & TypeFacetElement = FacetElement_( LocalID = 0_I4B ) +TYPE(FacetElement_), PARAMETER, PUBLIC :: & + & TypeFacetElement = FacetElement_(LocalID=0_I4B) !---------------------------------------------------------------------------- ! FacetElementPointer_ !---------------------------------------------------------------------------- TYPE :: FacetElementPointer_ - CLASS( FacetElementPointer_ ), POINTER :: Ptr => NULL( ) + CLASS(FacetElementPointer_), POINTER :: Ptr => NULL() END TYPE FacetElementPointer_ PUBLIC :: FacetElementPointer_ @@ -88,11 +87,11 @@ MODULE FacetElement_Class !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns an instance of [[FacetElement_]] +! date: 24 March 2021 +! summary: Returns an instance of [[FacetElement_]] ! !# Introduction -! Returns an instance of [[FacetElement_]] from [[ParameterList_]] +! Returns an instance of [[FacetElement_]] from [[ParameterList_]] ! ! !### Usage @@ -130,11 +129,11 @@ MODULE FacetElement_Class !``` INTERFACE -MODULE FUNCTION Constructor1( param, refelem ) RESULT( ans ) - CLASS( ReferenceElement_ ), TARGET, INTENT( INOUT ) :: refelem - TYPE( ParameterList_ ), INTENT( IN ) :: param - TYPE( FacetElement_ ) :: ans -END FUNCTION Constructor1 + MODULE FUNCTION Constructor1(param, refelem) RESULT(ans) + CLASS(ReferenceElement_), TARGET, INTENT(INOUT) :: refelem + TYPE(ParameterList_), INTENT(IN) :: param + TYPE(FacetElement_) :: ans + END FUNCTION Constructor1 END INTERFACE !---------------------------------------------------------------------------- @@ -142,11 +141,11 @@ END FUNCTION Constructor1 !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns an instance of [[FacetElement_]] +! date: 24 March 2021 +! summary: Returns an instance of [[FacetElement_]] ! !# Introduction -! Constructing an instance of [[FacetElement_]] from another instance of +! Constructing an instance of [[FacetElement_]] from another instance of ! [[Element_]] or any of its child ! !### Usage @@ -184,10 +183,10 @@ END FUNCTION Constructor1 !``` INTERFACE -MODULE FUNCTION Constructor2( anotherobj ) RESULT( ans ) - CLASS( Element_ ), TARGET, INTENT( IN ) :: anotherobj - TYPE( FacetElement_ ) :: ans -END FUNCTION Constructor2 + MODULE FUNCTION Constructor2(anotherobj) RESULT(ans) + CLASS(Element_), TARGET, INTENT(IN) :: anotherobj + TYPE(FacetElement_) :: ans + END FUNCTION Constructor2 END INTERFACE INTERFACE FacetElement @@ -201,8 +200,8 @@ END FUNCTION Constructor2 !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns a pointer to an instance of [[FacetElement_]] +! date: 24 March 2021 +! summary: Returns a pointer to an instance of [[FacetElement_]] ! !### Usage ! @@ -239,11 +238,11 @@ END FUNCTION Constructor2 !``` INTERFACE -MODULE FUNCTION Constructor_1( param, refelem ) RESULT( ans ) - TYPE( ParameterList_ ), INTENT( IN ) :: param - CLASS( ReferenceElement_ ), TARGET, INTENT( IN ) :: refelem - CLASS( FacetElement_ ), POINTER :: ans -END FUNCTION Constructor_1 + MODULE FUNCTION Constructor_1(param, refelem) RESULT(ans) + TYPE(ParameterList_), INTENT(IN) :: param + CLASS(ReferenceElement_), TARGET, INTENT(IN) :: refelem + CLASS(FacetElement_), POINTER :: ans + END FUNCTION Constructor_1 END INTERFACE !---------------------------------------------------------------------------- @@ -251,11 +250,11 @@ END FUNCTION Constructor_1 !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns a pointer to an instance of [[FacetElement_]] +! date: 24 March 2021 +! summary: Returns a pointer to an instance of [[FacetElement_]] !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns a pointer to an instance of [[FacetElement_]] +! date: 24 March 2021 +! summary: Returns a pointer to an instance of [[FacetElement_]] ! !### Usage ! @@ -292,10 +291,10 @@ END FUNCTION Constructor_1 !``` INTERFACE -MODULE FUNCTION Constructor_2( anotherobj ) RESULT( ans ) - CLASS( FacetElement_ ), TARGET, INTENT( IN ) :: anotherobj - CLASS( FacetElement_ ), POINTER :: ans -END FUNCTION Constructor_2 + MODULE FUNCTION Constructor_2(anotherobj) RESULT(ans) + CLASS(FacetElement_), TARGET, INTENT(IN) :: anotherobj + CLASS(FacetElement_), POINTER :: ans + END FUNCTION Constructor_2 END INTERFACE INTERFACE FacetElement_Pointer @@ -309,13 +308,13 @@ END FUNCTION Constructor_2 !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Deallocate the memeory occupied by [[FacetElement_]] +! date: 24 March 2021 +! summary: Deallocate the memeory occupied by [[FacetElement_]] INTERFACE -MODULE PURE SUBROUTINE elem_Deallocate( obj ) - CLASS( FacetElement_ ), INTENT( INOUT ) :: obj -END SUBROUTINE elem_Deallocate + MODULE PURE SUBROUTINE elem_Deallocate(obj) + CLASS(FacetElement_), INTENT(INOUT) :: obj + END SUBROUTINE elem_Deallocate END INTERFACE !---------------------------------------------------------------------------- @@ -323,13 +322,13 @@ END SUBROUTINE elem_Deallocate !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 17 April 2021 -! summary: finalizer for [[FacetElement_]] +! date: 17 April 2021 +! summary: finalizer for [[FacetElement_]] INTERFACE -MODULE SUBROUTINE faceElem_Deallocate( obj ) - TYPE( FacetElement_ ), INTENT( INOUT ) :: obj -END SUBROUTINE faceElem_Deallocate + MODULE SUBROUTINE faceElem_Deallocate(obj) + TYPE(FacetElement_), INTENT(INOUT) :: obj + END SUBROUTINE faceElem_Deallocate END INTERFACE !---------------------------------------------------------------------------- @@ -337,14 +336,14 @@ END SUBROUTINE faceElem_Deallocate !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns the node number of cell element +! date: 24 March 2021 +! summary: Returns the node number of cell element INTERFACE -MODULE PURE FUNCTION faceElem_getCellNptrs( obj ) RESULT( ans ) - CLASS( FacetElement_ ), INTENT( IN ) :: obj - INTEGER( I4B ), ALLOCATABLE :: ans( : ) -END FUNCTION faceElem_getCellNptrs + MODULE PURE FUNCTION faceElem_getCellNptrs(obj) RESULT(ans) + CLASS(FacetElement_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE :: ans(:) + END FUNCTION faceElem_getCellNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -352,14 +351,14 @@ END FUNCTION faceElem_getCellNptrs !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns the node number of cell element +! date: 24 March 2021 +! summary: Returns the node number of cell element INTERFACE -MODULE PURE SUBROUTINE faceElem_setCellNptrs( obj, nptrs ) - CLASS( FacetElement_ ), INTENT( INOUT ) :: obj - INTEGER( I4B ), INTENT( IN ) :: nptrs( : ) -END SUBROUTINE faceElem_setCellNptrs + MODULE PURE SUBROUTINE faceElem_setCellNptrs(obj, nptrs) + CLASS(FacetElement_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: nptrs(:) + END SUBROUTINE faceElem_setCellNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -367,14 +366,14 @@ END SUBROUTINE faceElem_setCellNptrs !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns the pointer to cell +! date: 24 March 2021 +! summary: Returns the pointer to cell INTERFACE -MODULE FUNCTION faceElem_getCellPointer( obj ) RESULT( ans ) - CLASS( FacetElement_ ), INTENT( IN ), TARGET :: obj - CLASS( Element_ ), POINTER :: ans -END FUNCTION faceElem_getCellPointer + MODULE FUNCTION faceElem_getCellPointer(obj) RESULT(ans) + CLASS(FacetElement_), INTENT(IN), TARGET :: obj + CLASS(Element_), POINTER :: ans + END FUNCTION faceElem_getCellPointer END INTERFACE !---------------------------------------------------------------------------- @@ -382,14 +381,14 @@ END FUNCTION faceElem_getCellPointer !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Sets the pointer to cell element +! date: 24 March 2021 +! summary: Sets the pointer to cell element INTERFACE -MODULE PURE SUBROUTINE faceElem_setCellPointer( obj, cell ) - CLASS( FacetElement_ ), INTENT( INOUT ) :: obj - CLASS( Element_ ), INTENT( INOUT ), TARGET :: cell -END SUBROUTINE faceElem_setCellPointer + MODULE PURE SUBROUTINE faceElem_setCellPointer(obj, cell) + CLASS(FacetElement_), INTENT(INOUT) :: obj + CLASS(Element_), INTENT(INOUT), TARGET :: cell + END SUBROUTINE faceElem_setCellPointer END INTERFACE !---------------------------------------------------------------------------- @@ -397,13 +396,13 @@ END SUBROUTINE faceElem_setCellPointer !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Free the pointer to cell +! date: 24 March 2021 +! summary: Free the pointer to cell INTERFACE -MODULE PURE SUBROUTINE faceElem_freeCellPointer( obj ) - CLASS( FacetElement_ ), INTENT( INOUT ) :: obj -END SUBROUTINE faceElem_freeCellPointer + MODULE PURE SUBROUTINE faceElem_freeCellPointer(obj) + CLASS(FacetElement_), INTENT(INOUT) :: obj + END SUBROUTINE faceElem_freeCellPointer END INTERFACE !---------------------------------------------------------------------------- @@ -411,14 +410,14 @@ END SUBROUTINE faceElem_freeCellPointer !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns the facet local ID +! date: 24 March 2021 +! summary: Returns the facet local ID INTERFACE -MODULE PURE FUNCTION faceElem_getFacetLocalID( obj ) RESULT( ans ) - CLASS( FacetElement_ ), INTENT( IN ) :: obj - INTEGER( I4B ) :: ans -END FUNCTION faceElem_getFacetLocalID + MODULE PURE FUNCTION faceElem_getFacetLocalID(obj) RESULT(ans) + CLASS(FacetElement_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION faceElem_getFacetLocalID END INTERFACE !---------------------------------------------------------------------------- @@ -426,14 +425,14 @@ END FUNCTION faceElem_getFacetLocalID !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 -! summary: Returns the facet local ID +! date: 24 March 2021 +! summary: Returns the facet local ID INTERFACE -MODULE PURE SUBROUTINE faceElem_setFacetLocalID( obj, id ) - CLASS( FacetElement_ ), INTENT( INOUT ) :: obj - INTEGER( I4B ), INTENT( IN ) :: id -END SUBROUTINE faceElem_setFacetLocalID + MODULE PURE SUBROUTINE faceElem_setFacetLocalID(obj, id) + CLASS(FacetElement_), INTENT(INOUT) :: obj + INTEGER(I4B), INTENT(IN) :: id + END SUBROUTINE faceElem_setFacetLocalID END INTERFACE !---------------------------------------------------------------------------- @@ -445,10 +444,10 @@ END SUBROUTINE faceElem_setFacetLocalID ! summary: Returns the Local node number of facet element INTERFACE -MODULE FUNCTION faceElem_getFacetLocalNptrs( obj ) RESULT( nptrs ) - CLASS( FacetElement_ ), INTENT( IN ) :: obj - INTEGER( I4B ), ALLOCATABLE :: nptrs( : ) -END FUNCTION faceElem_getFacetLocalNptrs + MODULE FUNCTION faceElem_getFacetLocalNptrs(obj) RESULT(nptrs) + CLASS(FacetElement_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE :: nptrs(:) + END FUNCTION faceElem_getFacetLocalNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -456,16 +455,16 @@ END FUNCTION faceElem_getFacetLocalNptrs !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. -! date: 24 March 2021 +! date: 24 March 2021 ! summary: Displays content of [[FacetElement_]] INTERFACE -MODULE SUBROUTINE faceElem_display( obj, msg, UnitNo, FullDisp ) - CLASS( FacetElement_ ), INTENT( IN ) :: obj - CHARACTER( LEN = * ), INTENT( IN ) :: Msg - INTEGER( I4B ), INTENT( IN ), OPTIONAL :: UnitNo - LOGICAL( LGT ), OPTIONAL, INTENT( IN ) :: FullDisp -END SUBROUTINE faceElem_display + MODULE SUBROUTINE faceElem_display(obj, msg, UnitNo, FullDisp) + CLASS(FacetElement_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: Msg + INTEGER(I4B), INTENT(IN), OPTIONAL :: UnitNo + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: FullDisp + END SUBROUTINE faceElem_display END INTERFACE !---------------------------------------------------------------------------- diff --git a/src/modules/FieldFactory/src/FieldFactory.F90 b/src/modules/FieldFactory/src/FieldFactory.F90 index 9437d8524..d7b8e3ef8 100644 --- a/src/modules/FieldFactory/src/FieldFactory.F90 +++ b/src/modules/FieldFactory/src/FieldFactory.F90 @@ -20,11 +20,40 @@ ! summary: This modules is a factory for linear solver, vector and matrix MODULE FieldFactory +USE GlobalData +USE String_Class USE Field +USE Domain_Class, ONLY: Domain_, DomainPointer_ USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "FieldFactory" +PUBLIC :: MatrixFieldFactory +PUBLIC :: BlockMatrixFieldFactory +PUBLIC :: NodeFieldFactory +PUBLIC :: BlockNodeFieldFactory +PUBLIC :: ScalarFieldFactory +PUBLIC :: VectorFieldFactory +PUBLIC :: STScalarFieldFactory +PUBLIC :: STVectorFieldFactory +PUBLIC :: Initiate +public :: MeshFieldFactory + +!---------------------------------------------------------------------------- +! MeshFieldFactory +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2023-09-14 +! summary: This function returns child of AbstractMeshField + +INTERFACE + MODULE FUNCTION MeshFieldFactory(engine, name) RESULT(Ans) + CHARACTER(*), INTENT(IN) :: engine + CHARACTER(*), INTENT(IN) :: name + CLASS(AbstractMeshField_), POINTER :: ans + END FUNCTION MeshFieldFactory +END INTERFACE !---------------------------------------------------------------------------- ! MatrixFieldFactory @@ -41,8 +70,6 @@ MODULE FUNCTION MatrixFieldFactory(engine) RESULT(Ans) END FUNCTION MatrixFieldFactory END INTERFACE -PUBLIC :: MatrixFieldFactory - !---------------------------------------------------------------------------- ! BlockMatrixFieldFactory !---------------------------------------------------------------------------- @@ -58,8 +85,6 @@ MODULE FUNCTION BlockMatrixFieldFactory(engine) RESULT(Ans) END FUNCTION BlockMatrixFieldFactory END INTERFACE -PUBLIC :: BlockMatrixFieldFactory - !---------------------------------------------------------------------------- ! NodeFieldFactory !---------------------------------------------------------------------------- @@ -76,8 +101,6 @@ MODULE FUNCTION NodeFieldFactory(engine, datatype) RESULT(Ans) END FUNCTION NodeFieldFactory END INTERFACE -PUBLIC :: NodeFieldFactory - !---------------------------------------------------------------------------- ! BlockNodeFieldFactory !---------------------------------------------------------------------------- @@ -93,8 +116,6 @@ MODULE FUNCTION BlockNodeFieldFactory(engine) RESULT(Ans) END FUNCTION BlockNodeFieldFactory END INTERFACE -PUBLIC :: BlockNodeFieldFactory - !---------------------------------------------------------------------------- ! ScalarFieldFactory !---------------------------------------------------------------------------- @@ -110,8 +131,6 @@ MODULE FUNCTION ScalarFieldFactory(engine) RESULT(Ans) END FUNCTION ScalarFieldFactory END INTERFACE -PUBLIC :: ScalarFieldFactory - !---------------------------------------------------------------------------- ! VectorFieldFactory !---------------------------------------------------------------------------- @@ -127,8 +146,6 @@ MODULE FUNCTION VectorFieldFactory(engine) RESULT(Ans) END FUNCTION VectorFieldFactory END INTERFACE -PUBLIC :: VectorFieldFactory - !---------------------------------------------------------------------------- ! STScalarFieldFactory !---------------------------------------------------------------------------- @@ -144,8 +161,6 @@ MODULE FUNCTION STScalarFieldFactory(engine) RESULT(Ans) END FUNCTION STScalarFieldFactory END INTERFACE -PUBLIC :: STScalarFieldFactory - !---------------------------------------------------------------------------- ! STVectorFieldFactory !---------------------------------------------------------------------------- @@ -161,6 +176,91 @@ MODULE FUNCTION STVectorFieldFactory(engine) RESULT(Ans) END FUNCTION STVectorFieldFactory END INTERFACE -PUBLIC :: STVectorFieldFactory +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-03-29 +! summary: Initiate a vector of VectorFieldPointer_ +! +!# Introduction +! +! This routine initiates several vector of VectorField and +! its subclasses. +! +! Many times we need to initiate the vector field of same structures. +! Calling intiate methods on each vector field increases the +! code repeatition. +! Therefore, we can call this method instead. This method +! will create vectorfield of same type. They just have different +! names. +! +! NOTE: This is a module routine not a Method to VectorField_ + +INTERFACE Initiate + MODULE SUBROUTINE VectorField_Initiate1(obj, names, spaceCompo, fieldType, & + & engine, dom) + TYPE(VectorFieldPointer_), INTENT(INOUT) :: obj(:) + !! A vector of pointer to VectorField or subclass + !! NOTE: It should be allocated + TYPE(String), INTENT(IN) :: names(:) + !! names of vector field + !! NOTE: The size of names should be at least the size of obj + INTEGER(I4B), INTENT(IN) :: spaceCompo + !! spatial components in vector field + INTEGER(I4B), INTENT(IN) :: fieldType + !! NOTE: Field type, for info see documentation of AbstractNodeField_ + CHARACTER(*), INTENT(IN) :: engine + !! Engine, for info see documentation of AbstractNodeField_ + TYPE(Domain_), TARGET, INTENT(IN) :: dom + !! pointer to the domain + END SUBROUTINE VectorField_Initiate1 +END INTERFACE Initiate + +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-03-29 +! summary: Initiate a vector of VectorFieldPointer_ +! +!# Introduction +! +! This routine initiates several vector of VectorField and +! its subclasses. +! +! Many times we need to initiate the vector field of same structures. +! Calling intiate methods on each vector field increases the +! code repeatition. +! Therefore, we can call this method instead. This method +! will create instances of vectorfield and its subclass. +! +! INFO: This routine is same as VectorField_Initiate1 but +! here, we can set different properties to each vector field. +! +! NOTE: This is a module routine not a Method to VectorField_ + +INTERFACE Initiate + MODULE SUBROUTINE VectorField_Initiate2(obj, names, spaceCompo, fieldType, & + & engine, dom) + TYPE(VectorFieldPointer_), INTENT(INOUT) :: obj(:) + !! A vector of pointer to VectorField or subclass + !! NOTE: It should be allocated + TYPE(String), INTENT(IN) :: names(:) + !! names of vector field + !! NOTE: The size of names should be at least the size of obj + INTEGER(I4B), INTENT(IN) :: spaceCompo(:) + !! spatial components in vector field + INTEGER(I4B), INTENT(IN) :: fieldType(:) + !! NOTE: Field type, for info see documentation of AbstractNodeField_ + TYPE(String), INTENT(IN) :: engine(:) + !! Engine, for info see documentation of AbstractNodeField_ + TYPE(DomainPointer_), TARGET, INTENT(IN) :: dom(:) + !! pointer to the domain + END SUBROUTINE VectorField_Initiate2 +END INTERFACE Initiate + END MODULE FieldFactory diff --git a/src/modules/FiniteElement/CMakeLists.txt b/src/modules/FiniteElement/CMakeLists.txt index 2adfe414d..83c70956f 100644 --- a/src/modules/FiniteElement/CMakeLists.txt +++ b/src/modules/FiniteElement/CMakeLists.txt @@ -19,6 +19,6 @@ SET(src_path "${CMAKE_CURRENT_LIST_DIR}/src/") TARGET_SOURCES( ${PROJECT_NAME} PRIVATE ${src_path}/AbstractFE_Class.F90 - ${src_path}/LagrangeFE_Class.F90 + ${src_path}/FiniteElement_Class.F90 ${src_path}/FiniteElementFactory.F90 -) \ No newline at end of file +) diff --git a/src/modules/FiniteElement/src/AbstractFE_Class.F90 b/src/modules/FiniteElement/src/AbstractFE_Class.F90 index 2ff0579af..5c79aa85c 100644 --- a/src/modules/FiniteElement/src/AbstractFE_Class.F90 +++ b/src/modules/FiniteElement/src/AbstractFE_Class.F90 @@ -13,24 +13,41 @@ ! ! You should have received a copy of the GNU General Public License ! along with this program. If not, see -! MODULE AbstractFE_Class USE GlobalData +USE BaseType, ONLY: BaseInterpolation_, & + & BaseContinuity_, & + & ElemShapeData_, & + & QuadraturePoint_, & + & LagrangeInterpolation_, & + & OrthogonalInterpolation_, & + & HierarchyInterpolation_, & + & SerendipityInterpolation_, & + & HermitInterpolation_, & + & ReferenceElement_ +USE String_Class, ONLY: String USE AbstractRefElement_Class +USE FPL, ONLY: ParameterList_ IMPLICIT NONE PRIVATE -! +PUBLIC :: AbstractFE_ +PUBLIC :: AbstractFEPointer_ +PUBLIC :: SetAbstractFEParam +PUBLIC :: AbstractFEDeallocate +PUBLIC :: AbstractFEDisplay + CHARACTER(*), PARAMETER :: modName = "AbstractFE_Class" -INTEGER(I4B), PARAMETER, PUBLIC :: FE_DOF_POINT_EVAL = 1_I4B -INTEGER(I4B), PARAMETER, PUBLIC :: FE_TRANSFORM_IDENTITY = 1_I4B -INTEGER(I4B), PARAMETER, PUBLIC :: H1_LAGRANGE = LagrangePolynomial -INTEGER(I4B), PARAMETER, PUBLIC :: H1_SERENDIPITY = SerendipityPolynomial -INTEGER(I4B), PARAMETER, PUBLIC :: H1_HEIRARCHICAL = HeirarchicalPolynomial -INTEGER(I4B), PARAMETER, PUBLIC :: IP_EQUIDISTANCE = EquidistanceLIP -INTEGER(I4B), PARAMETER, PUBLIC :: IP_GAUSS_LOBATTO = GaussLobattoLIP -INTEGER(I4B), PARAMETER, PUBLIC :: IP_GAUSS_LEGENDRE = GaussLegendreLIP -INTEGER(I4B), PARAMETER, PUBLIC :: IP_CHEBYSHEV = ChebyshevLIP + +INTEGER(I4B), PARAMETER :: FE_DOF_POINT_EVAL = 1_I4B +INTEGER(I4B), PARAMETER :: DEFAULT_DOF_TYPE(4) = [1, 1, 1, 1] +INTEGER(I4B), PARAMETER :: FE_TRANSFORM_IDENTITY = 1_I4B +INTEGER(I4B), PARAMETER :: DEFAULT_TRANSFORM_TYPE = 1_I4B + +INTEGER(I4B), PARAMETER :: MAX_NO_FACE = 6 +!! Maximum number of faces in an element +INTEGER(I4B), PARAMETER :: MAX_NO_EDGE = 12 +!! Maximum number of edges in an element !---------------------------------------------------------------------------- ! AbstractRefElement_ @@ -40,37 +57,172 @@ MODULE AbstractFE_Class ! date: 27 Aug 2022 ! summary: Abstract class for finite element is defined ! -!{!pages/AbstractFE_.md!} +!{!pages/docs-api/AbstractFE/AbstractFE_.md!} TYPE, ABSTRACT :: AbstractFE_ PRIVATE - CLASS(AbstractRefElement_), PUBLIC, POINTER :: refelem => NULL() - !! reference element + LOGICAL(LGT) :: firstCall = .TRUE. + LOGICAL(LGT) :: isInitiated = .FALSE. + !! It is set to true at the time of constructor INTEGER(I4B) :: nsd = 0 - !! spatial dimension + !! spatial dimension of fintie element INTEGER(I4B) :: order = 0 !! Isotropic order of polynomial space + LOGICAL(LGT) :: isIsotropicOrder = .FALSE. + !! True if the order is same in all the direction + INTEGER(I4B) :: anisoOrder(3) + !! Order in x, y, and z direction + LOGICAL(LGT) :: isAnisotropicOrder = .FALSE. + !! True if the order is different in different directions + INTEGER(I4B) :: edgeOrder(MAX_NO_EDGE) = 0 + !! Order on each edge of the element + INTEGER(I4B) :: tEdgeOrder = 0 + !! The actual size of edgeOrder + LOGICAL(LGT) :: isEdgeOrder = .FALSE. + !! True if we set the edge order + INTEGER(I4B) :: faceOrder(MAX_NO_FACE) + !! Order of approximation on each face of the element + INTEGER(I4B) :: tFaceOrder = 0 + !! The actual size of faceOrder + LOGICAL(LGT) :: isFaceOrder = .FALSE. + !! True if we set the face order + INTEGER(I4B) :: cellOrder(3) + !! Order of approximation inside the element + INTEGER(I4B) :: tCellOrder = 0 + !! The actual size of cellOrder + LOGICAL(LGT) :: isCellOrder = .FALSE. + !! True if we set the cell order INTEGER(I4B) :: feType = 0 - !! type of finite element + !! Type of finite element + !! Scalar, Vector, Matrix + INTEGER(I4B) :: elemType = 0 + !! Topology type of reference elemtn + !! Line, Triangle, Quadrangle, Tetrahedron, Hexahedron, + !! Prism, Pyramid INTEGER(I4B) :: ipType = 0 - !! type of lattice (interpolation point type) point + !! Type of lattice point (i.e., interpolation point type) INTEGER(I4B) :: dofType(4) = 0 - !! type of dof for shape function defined on vertex - !! type of dof for shape functions on edge - !! type of dof for shape functions on face - !! type of dof for shape functions in cell + !! Currently it is not used + !! dofType(1): Type of dof for shape function defined on vertex + !! dofType(2): Type of dof for shape functions on edge + !! dofType(3): Type of dof for shape functions on face + !! dofType(4): Type of dof for shape functions in cell + !! These shape functions can take following values: + !! - FE_DOF_POINT_EVAL INTEGER(I4B) :: transformType = 0 - !! type of Tranformation usef for polynomial space + !! Currently it is not used + !! Type of Tranformation usef for polynomial space + !! - FE_TRANSFORM_IDENTITY + TYPE(String) :: baseContinuity0 + !! String name of base continuity + TYPE(String) :: baseInterpolation0 + !! String name of base interpolation + !! LagrangePolynomial + !! SerendipityPolynomial + !! HermitPolynomial + !! OrthogonalPolynomial + !! HierarchyPolynomial + INTEGER(I4B) :: basisType(3) + !! Integer code for basis type in x, y, and z direction + !! Monomial, Jacobi, Legendre, Chebyshev, Lobatto + !! Ultraspherical + REAL(DFP) :: alpha(3) + !!Jacobi parameters + REAL(DFP) :: beta(3) + !! Jacobi parameters + REAL(DFP) :: lambda(3) + !! Ultraspherical parameters + TYPE(String) :: refElemDomain + !! String name for reference element domain. + !! It can take following values: + !! - UNIT + !! - BIUNIT + CLASS(BaseContinuity_), ALLOCATABLE :: baseContinuity + !! continuity or conformity of basis defined on reference + !! element, following values are allowed + !! H1, HCurl, HDiv, DG + CLASS(BaseInterpolation_), ALLOCATABLE :: baseInterpolation + !! Type of basis functions used for interpolation on reference + !! element, Following values are allowed + !! LagrangeInterpolation + !! HermitInterpolation + !! SerendipityInterpolation + !! HierarchyInterpolation + !! OrthogonalInterpolation + CLASS(AbstractRefElement_), POINTER :: refelem => NULL() + !! reference element + TYPE(ReferenceElement_) :: refelem0 + !! This is only for internal use + !! At the time of initiate we extract refelem0 from refelem + !! This way we do not have to make copy every time we + !! make quadrature points and shape function data + TYPE(ReferenceElement_) :: facetElem0(MAX_NO_FACE) + !! Facet elements + REAL(DFP), ALLOCATABLE :: coeff(:, :) CONTAINS - !! - PROCEDURE(fe_Initiate), DEFERRED, PUBLIC, PASS(obj) :: Initiate + PRIVATE + ! CONSTRUCTOR: + !@ConstructorMethods + PROCEDURE, PUBLIC, PASS(obj) :: Initiate => fe_Initiate + !! Constructor method for AbstractFE element + !! This method can be overloaded by Subclass of this abstract class. + PROCEDURE, PUBLIC, PASS(obj) :: Copy => fe_Copy + !! Initiate by copy + GENERIC, PUBLIC :: ASSIGNMENT(=) => Copy + !! Initiate by copy + PROCEDURE, PUBLIC, PASS(obj) :: CheckEssentialParam => & + & fe_CheckEssentialParam PROCEDURE, PUBLIC, PASS(obj) :: Display => fe_Display + !! Display the content of a finite element + PROCEDURE, PUBLIC, PASS(obj) :: MdEncode => fe_MdEncode + !! Display the contents + PROCEDURE, PUBLIC, PASS(obj) :: ReactEncode => fe_ReactEncode + !! Display the contents PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => fe_Deallocate + !! Deallocate the data stored in an instance PROCEDURE, PUBLIC, PASS(obj) :: SetParam => fe_SetParam + !! Sets the parameters of finite element + PROCEDURE, PUBLIC, PASS(obj) :: GetParam => fe_GetParam + !! Sets the parameters of finite element + PROCEDURE, PUBLIC, PASS(obj) :: GetLocalElemShapeData => & + & fe_GetLocalElemShapeData + PROCEDURE, PRIVATE, PASS(obj) :: GetLocalElemshapeData_H1 => & + & fe_GetLocalElemShapeData_H1_Master + !! Get local element shape data for H1 + PROCEDURE, PRIVATE, PASS(obj) :: GetLocalElemshapeData_HDiv => & + & fe_GetLocalElemShapeData_HDiv_Master + !! Get local element shape data for Hdiv + PROCEDURE, PRIVATE, PASS(obj) :: GetLocalElemshapeData_HCurl => & + & fe_GetLocalElemShapeData_HCurl_Master + !! Get local element shape data for HCurl + PROCEDURE, PRIVATE, PASS(obj) :: GetLocalElemshapeData_DG => & + & fe_GetLocalElemShapeData_DG_Master + + ! GET: + ! @Global element shapedata + + !! Get local element shape data for Discontinuous Galerkin + PROCEDURE, PUBLIC, PASS(obj) :: GetGlobalElemShapeData => & + & fe_GetGlobalElemShapeData + PROCEDURE, PRIVATE, PASS(obj) :: GetGlobalElemshapeData_H1 => & + & fe_GetGlobalElemShapeData_H1_Master + !! Get global shape data for H1 + PROCEDURE, PRIVATE, PASS(obj) :: GetGlobalElemshapeData_HDiv => & + & fe_GetGlobalElemShapeData_HDiv_Master + !! Get global shape data for Hdiv + PROCEDURE, PRIVATE, PASS(obj) :: GetGlobalElemshapeData_HCurl => & + & fe_GetGlobalElemShapeData_HCurl_Master + !! Get global shape data for HCurl + PROCEDURE, PRIVATE, PASS(obj) :: GetGlobalElemshapeData_DG => & + & fe_GetGlobalElemShapeData_DG_Master + !! Get global shape data for Discontinuous Galerkin + + ! GET: + ! @QuadratureMethods + PROCEDURE, PUBLIC, PASS(obj) :: GetQuadraturePoints => & + & fe_GetQuadraturePoints1 END TYPE AbstractFE_ -!! -PUBLIC :: AbstractFE_ -!! + !---------------------------------------------------------------------------- ! AbstractFEPointer_ !---------------------------------------------------------------------------- @@ -79,7 +231,115 @@ MODULE AbstractFE_Class CLASS(AbstractFE_), POINTER :: ptr => NULL() END TYPE AbstractFEPointer_ -PUBLIC :: AbstractFEPointer_ +!---------------------------------------------------------------------------- +! CheckEssentialParam@Methods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2023-08-11 +! summary: This routine Check the essential parameters in param. + +INTERFACE + MODULE SUBROUTINE fe_CheckEssentialParam(obj, param) + CLASS(AbstractFE_), INTENT(IN) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + END SUBROUTINE fe_CheckEssentialParam +END INTERFACE + +!---------------------------------------------------------------------------- +! CheckEssentialParam@Methods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2023-08-11 +! summary: This routine Check the essential parameters in param. + +INTERFACE + MODULE SUBROUTINE AbstractFECheckEssentialParam(obj, param, prefix) + CLASS(AbstractFE_), INTENT(IN) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + CHARACTER(*), INTENT(IN) :: prefix + END SUBROUTINE AbstractFECheckEssentialParam +END INTERFACE + +PUBLIC :: AbstractFECheckEssentialParam + +!---------------------------------------------------------------------------- +! SetAbstractFEParam@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-11 +! summary: Sets the parameters for initiating abstract finite element + +INTERFACE + MODULE SUBROUTINE SetAbstractFEParam( & + & param, & + & prefix, & + & nsd, & + & elemType, & + & baseContinuity, & + & baseInterpolation, & + & ipType, & + & basisType, & + & alpha, & + & beta, & + & lambda, & + & order, & + & anisoOrder, & + & edgeOrder, & + & faceOrder, & + & cellOrder) + TYPE(ParameterList_), INTENT(INOUT) :: param + !! ParameterList + CHARACTER(*), INTENT(IN) :: prefix + !! Prefix + INTEGER(I4B), INTENT(IN) :: nsd + !! Number of spatial dimension + INTEGER(I4B), INTENT(IN) :: elemType + !! Type of finite element + !! Line, Triangle, Quadrangle, Tetrahedron, Prism, Pyramid, + !! Hexahedron + CHARACTER(*), INTENT(IN) :: baseContinuity + !! Continuity or Conformity of basis function. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! H1* (default), HDiv, HCurl, DG + CHARACTER(*), INTENT(IN) :: baseInterpolation + !! Basis function family used for interpolation. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! LagrangeInterpolation, LagrangePolynomial + !! SerendipityInterpolation, SerendipityPolynomial + !! HierarchyInterpolation, HierarchyPolynomial + !! OrthogonalInterpolation, OrthogonalPolynomial + !! HermitInterpolation, HermitPolynomial + INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType + !! Interpolation point type, It is required when + !! baseInterpol is LagrangePolynomial + INTEGER(I4B), OPTIONAL, INTENT(IN) :: basisType(:) + !! Basis type: Legendre, Lobatto, Ultraspherical, + !! Jacobi, Monomial + REAL(DFP), OPTIONAL, INTENT(IN) :: alpha(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: beta(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: lambda(:) + !! Ultraspherical parameters + INTEGER(I4B), OPTIONAL, INTENT(IN) :: order + !! Isotropic Order of finite element + INTEGER(I4B), OPTIONAL, INTENT(IN) :: anisoOrder(:) + !! Anisotropic order, order in x, y, and z directions + INTEGER(I4B), OPTIONAL, INTENT(IN) :: edgeOrder(:) + !! Order of approximation along edges + INTEGER(I4B), OPTIONAL, INTENT(IN) :: faceOrder(:) + !! Order of approximation along face + INTEGER(I4B), OPTIONAL, INTENT(IN) :: cellOrder(:) + !! Order of approximation along cell + END SUBROUTINE SetAbstractFEParam +END INTERFACE !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods @@ -87,58 +347,111 @@ MODULE AbstractFE_Class !> author: Vikas Sharma, Ph. D. ! date: 27 Aug 2022 -! summary: Initiate the finite element +! summary: Initiates an instance of the finite element -ABSTRACT INTERFACE - SUBROUTINE fe_Initiate(obj, elemType, order, ipType) - IMPORT :: AbstractFE_, I4B +INTERFACE + MODULE SUBROUTINE fe_Initiate(obj, param) CLASS(AbstractFE_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: elemType - INTEGER(I4B), INTENT(IN) :: order - INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType + TYPE(ParameterList_), INTENT(IN) :: param END SUBROUTINE fe_Initiate END INTERFACE !---------------------------------------------------------------------------- -! Deallocate@Methods +! Initiate@ConstructorMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 29 Aug 2022 -! summary: Deallocate the data +! date: 27 Aug 2022 +! summary: Initiates an instance of the finite element INTERFACE - MODULE SUBROUTINE fe_Deallocate(obj) + MODULE SUBROUTINE AbstractFEInitiate(obj, param, prefix) CLASS(AbstractFE_), INTENT(INOUT) :: obj - END SUBROUTINE fe_Deallocate + TYPE(ParameterList_), INTENT(IN) :: param + CHARACTER(*), INTENT(IN) :: prefix + END SUBROUTINE AbstractFEInitiate +END INTERFACE + +PUBLIC :: AbstractFEInitiate + +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Initiates an instance of the finite element by copying + +INTERFACE + MODULE SUBROUTINE fe_Copy(obj, obj2) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(AbstractFE_), INTENT(IN) :: obj2 + END SUBROUTINE fe_Copy END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 29 Aug 2022 +! summary: Deallocate the data + INTERFACE AbstractFEDeallocate - MODULE PROCEDURE fe_Deallocate + MODULE SUBROUTINE fe_Deallocate(obj) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + END SUBROUTINE fe_Deallocate END INTERFACE AbstractFEDeallocate -PUBLIC :: AbstractFEDeallocate - !---------------------------------------------------------------------------- -! Display +! Display@IOMethods !---------------------------------------------------------------------------- -INTERFACE - MODULE SUBROUTINE fe_Display(obj, msg, unitno) +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-14 +! summary: Display the content + +INTERFACE AbstractFEDisplay + MODULE SUBROUTINE fe_Display(obj, msg, unitno, notFull) CLASS(AbstractFE_), INTENT(IN) :: obj CHARACTER(*), INTENT(IN) :: msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: notFull END SUBROUTINE fe_Display +END INTERFACE AbstractFEDisplay + +!---------------------------------------------------------------------------- +! MdEncode@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the contents in mardown format + +INTERFACE + MODULE FUNCTION fe_MdEncode(obj) RESULT(ans) + CLASS(AbstractFE_), INTENT(IN) :: obj + TYPE(String) :: ans + END FUNCTION fe_MdEncode END INTERFACE -INTERFACE AbstractFEDisplay - MODULE PROCEDURE fe_Display -END INTERFACE AbstractFEDisplay +!---------------------------------------------------------------------------- +! ReactEncode@Methods +!---------------------------------------------------------------------------- -PUBLIC :: AbstractFEDisplay +!> author: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the reference elements in react components + +INTERFACE + MODULE FUNCTION fe_ReactEncode(obj) RESULT(ans) + CLASS(AbstractFE_), INTENT(IN) :: obj + TYPE(String) :: ans + END FUNCTION fe_ReactEncode +END INTERFACE !---------------------------------------------------------------------------- -! SetParam@Methods +! SetParam@SetMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. @@ -146,94 +459,452 @@ END SUBROUTINE fe_Display ! summary: Set the parameters INTERFACE - MODULE PURE SUBROUTINE fe_SetParam(obj, nsd, order, & - & feType, ipType, dofType, transformType) + MODULE SUBROUTINE fe_SetParam( & + & obj, & + & nsd, & + & order, & + & anisoOrder, & + & edgeOrder, & + & faceOrder, & + & cellOrder, & + & feType, & + & elemType, & + & ipType, & + & basisType, & + & alpha, & + & beta, & + & lambda, & + & dofType, & + & transformType, & + & refElemDomain, & + & baseContinuity, & + & baseInterpolation, & + & isIsotropicOrder, & + & isAnisotropicOrder, & + & isEdgeOrder, & + & isFaceOrder, & + & isCellOrder, & + & tEdgeOrder, & + & tFaceOrder, & + & tCellOrder) CLASS(AbstractFE_), INTENT(INOUT) :: obj INTEGER(I4B), OPTIONAL, INTENT(IN) :: nsd + !! Number of spatial dimension INTEGER(I4B), OPTIONAL, INTENT(IN) :: order + !! order of element (isotropic order) + INTEGER(I4B), OPTIONAL, INTENT(IN) :: anisoOrder(3) + !! order in x, y, and z directions + INTEGER(I4B), OPTIONAL, INTENT(IN) :: edgeOrder(:) + !! order of approximation on the edges of element + INTEGER(I4B), OPTIONAL, INTENT(IN) :: faceOrder(:) + !! order of approximation on the faces of element + INTEGER(I4B), OPTIONAL, INTENT(IN) :: cellOrder(3) + !! order of approximation in the cell of element INTEGER(I4B), OPTIONAL, INTENT(IN) :: feType + !! finite element type + INTEGER(I4B), OPTIONAL, INTENT(IN) :: elemType + !! Reference element type INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType + !! interpolation point type + INTEGER(I4B), OPTIONAL, INTENT(IN) :: basisType(:) + !! Basis type in x, y, and z directions + REAL(DFP), OPTIONAL, INTENT(IN) :: alpha(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: beta(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: lambda(:) + !! Ultraspherical parameter INTEGER(I4B), OPTIONAL, INTENT(IN) :: dofType(4) + !! degree of freedom type INTEGER(I4B), OPTIONAL, INTENT(IN) :: transformType + !! transformation type + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseContinuity + !! String name of type of continuity used for basis functions + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseInterpolation + !! String name of type of interpolation used for basis functions + CHARACTER(*), OPTIONAL, INTENT(IN) :: refElemDomain + !! Domain of reference element + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isIsotropicOrder + !! True if isotropic order + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isAnisotropicOrder + !! True if anisoOrder + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isEdgeOrder + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isFaceOrder + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isCellOrder + INTEGER(I4B), OPTIONAL, INTENT(IN) :: tEdgeOrder + INTEGER(I4B), OPTIONAL, INTENT(IN) :: tFaceOrder + INTEGER(I4B), OPTIONAL, INTENT(IN) :: tCellOrder END SUBROUTINE fe_SetParam END INTERFACE !---------------------------------------------------------------------------- -! AbstractScalarFE_ +! GetParam@GetMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 27 Aug 2022 -! summary: Abstract class for scalar finite element is defined -! -!{!pages/AbstractScalarFE_.md!} +! summary: Get the parameters + +INTERFACE + MODULE SUBROUTINE fe_GetParam( & + & obj, & + & nsd, & + & order, & + & anisoOrder, & + & edgeOrder, & + & faceOrder, & + & cellOrder, & + & feType, & + & elemType, & + & ipType, & + & basisType, & + & alpha, & + & beta, & + & lambda, & + & dofType, & + & transformType, & + & refElemDomain, & + & baseContinuity, & + & baseInterpolation, & + & isIsotropicOrder, & + & isAnisotropicOrder, & + & isEdgeOrder, & + & isFaceOrder, & + & isCellOrder, & + & tEdgeOrder, & + & tFaceOrder, & + & tCellOrder) + CLASS(AbstractFE_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: nsd + !! Number of spatial dimension + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: order + !! order of element (isotropic order) + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: anisoOrder(3) + !! order in x, y, and z directions + INTEGER(I4B), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: edgeOrder(:) + !! order of approximation on the edges of element + INTEGER(I4B), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: faceOrder(:) + !! order of approximation on the faces of element + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: cellOrder(3) + !! order of approximation in the cell of element + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: feType + !! finite element type + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: elemType + !! Reference element type + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: ipType + !! interpolation point type + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: basisType(3) + !! Basis type in x, y, and z directions + REAL(DFP), OPTIONAL, INTENT(OUT) :: alpha(3) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(OUT) :: beta(3) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(OUT) :: lambda(3) + !! Ultraspherical parameter + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: dofType(4) + !! degree of freedom type + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: transformType + !! transformation type + TYPE(String), OPTIONAL, INTENT(OUT) :: baseContinuity + !! String name of type of continuity used for basis functions + TYPE(String), OPTIONAL, INTENT(OUT) :: baseInterpolation + !! String name of type of interpolation used for basis functions + TYPE(String), OPTIONAL, INTENT(OUT) :: refElemDomain + !! Domain of reference element + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isIsotropicOrder + !! True if isotropic order + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isAnisotropicOrder + !! True if anisoOrder + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isEdgeOrder + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isFaceOrder + LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isCellOrder + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tEdgeOrder + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tFaceOrder + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: tCellOrder + END SUBROUTINE fe_GetParam +END INTERFACE -TYPE, ABSTRACT, EXTENDS(AbstractFE_) :: & - & AbstractScalarFE_ -END TYPE AbstractScalarFE_ -!! -PUBLIC :: AbstractScalarFE_ -!! !---------------------------------------------------------------------------- -! AbstractScalarFEPointer_ +! GetLocalElemShapeData@GetMethods !---------------------------------------------------------------------------- -TYPE :: AbstractScalarFEPointer_ - CLASS(AbstractScalarFE_), POINTER :: ptr => NULL() -END TYPE AbstractScalarFEPointer_ +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get local element shape data shape data -PUBLIC :: AbstractScalarFEPointer_ +INTERFACE + MODULE SUBROUTINE fe_GetLocalElemShapeData(obj, elemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + END SUBROUTINE fe_GetLocalElemShapeData +END INTERFACE !---------------------------------------------------------------------------- -! AbstractVectorFE_ +! GetLocalElemShapeData@GetMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 27 Aug 2022 -! summary: Abstract class for scalar finite element is defined -! -!{!pages/AbstractVectorFE_.md!} +! date: 2023-08-15 +! summary: Get local element shape data shape data on facets + +INTERFACE + MODULE SUBROUTINE fe_GetLocalFacetElemShapeData(obj, cellElemsd, & + & facetElemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: cellElemsd + !! element shape data on cell + CLASS(ElemShapedata_), INTENT(INOUT) :: facetElemsd(:) + !! element shapedata on facet element + !! The size of facetElemsd should be equal to total number of + !! facets in element. + CLASS(QuadraturePoint_), INTENT(IN) :: quad(:) + !! Quadrature points on each facet element + END SUBROUTINE fe_GetLocalFacetElemShapeData +END INTERFACE -TYPE, ABSTRACT, EXTENDS(AbstractFE_) :: & - & AbstractVectorFE_ -END TYPE AbstractVectorFE_ -!! -PUBLIC :: AbstractVectorFE_ -!! !---------------------------------------------------------------------------- -! AbstractVectorFEPointer_ +! GetLocalElemShapeData_H1@H1Methods !---------------------------------------------------------------------------- -TYPE :: AbstractVectorFEPointer_ - CLASS(AbstractVectorFE_), POINTER :: ptr => NULL() -END TYPE AbstractVectorFEPointer_ +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get local shape data -PUBLIC :: AbstractVectorFEPointer_ +INTERFACE + MODULE SUBROUTINE fe_GetLocalElemshapeData_H1_Master(obj, elemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + END SUBROUTINE fe_GetLocalElemshapeData_H1_Master +END INTERFACE !---------------------------------------------------------------------------- -! AbstractMatrixFE_ +! GetLocalElemShapeData_HDiv@HDivMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 27 Aug 2022 -! summary: Abstract class for scalar finite element is defined -! -!{!pages/AbstractMatrixFE_.md!} +! date: 2023-08-15 +! summary: Get local shape data + +INTERFACE + MODULE SUBROUTINE fe_GetLocalElemShapeData_HDiv_Master(obj, elemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + END SUBROUTINE fe_GetLocalElemShapeData_HDiv_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData_HCurl@HCurlMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get local shape data + +INTERFACE + MODULE SUBROUTINE fe_GetLocalElemShapeData_HCurl_Master(obj, elemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + END SUBROUTINE fe_GetLocalElemShapeData_HCurl_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData_DG@DGMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get local shape data + +INTERFACE + MODULE SUBROUTINE fe_GetLocalElemShapeData_DG_Master(obj, elemsd, quad) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + END SUBROUTINE fe_GetLocalElemShapeData_DG_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetQuadraturePoints@QuadratureMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-05 +! summary: Get quadrature points + +INTERFACE + MODULE SUBROUTINE fe_GetQuadraturePoints1(obj, quad, quadratureType, & + & order, nips, alpha, beta, lambda) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(QuadraturePoint_), INTENT(INOUT) :: quad + !! Quadrature points + INTEGER(I4B), INTENT(IN) :: quadratureType(:) + !! Type of quadrature points + !! GaussLegendre + !! GaussLegendreLobatto + !! GaussLegendreRadau, GaussLegendreRadauLeft + !! GaussLegendreRadauRight + !! GaussChebyshev + !! GaussChebyshevLobatto + !! GaussChebyshevRadau, GaussChebyshevRadauLeft + !! GaussChebyshevRadauRight + INTEGER(I4B), OPTIONAL, INTENT(IN) :: order(:) + !! Order of integrand, either order or nips should be present + !! Both nips and order should not be present + INTEGER(I4B), OPTIONAL, INTENT(IN) :: nips(:) + !! Number of integration points required + !! Either order or nips should be present + !! Both nips and order should not be present + REAL(DFP), OPTIONAL, INTENT(IN) :: alpha(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: beta(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: lambda(:) + !! Ultraspherical parameter + END SUBROUTINE fe_GetQuadraturePoints1 +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get Global element shape data shape data + +INTERFACE + MODULE SUBROUTINE fe_GetGlobalElemShapeData(obj, elemsd, xij, geoElemsd) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! Abstract finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + !! shape function data + REAL(DFP), INTENT(IN) :: xij(:, :) + !! nodal coordinates of element + !! The number of rows in xij should be same as the spatial dimension + !! The number of columns should be same as the number of nodes + !! present in the reference element in geoElemsd. + CLASS(ElemShapeData_), OPTIONAL, INTENT(INOUT) :: geoElemsd + !! shape function data for geometry which contains local shape function + !! data. If not present then the local shape function in elemsd + !! will be used for geometry. This means we are dealing with + !! isoparametric shape functions. + END SUBROUTINE fe_GetGlobalElemShapeData +END INTERFACE -TYPE, ABSTRACT, EXTENDS(AbstractFE_) :: & - & AbstractMatrixFE_ -END TYPE AbstractMatrixFE_ -!! -PUBLIC :: AbstractMatrixFE_ -!! !---------------------------------------------------------------------------- -! AbstractMatrixFEPointer_ +! GetGlobalElemShapeData@GetMethods !---------------------------------------------------------------------------- -TYPE :: AbstractMatrixFEPointer_ - CLASS(AbstractMatrixFE_), POINTER :: ptr => NULL() -END TYPE AbstractMatrixFEPointer_ +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get Global element shape data shape data + +INTERFACE + MODULE SUBROUTINE fe_GetGlobalElemShapeData_H1_Master(obj, elemsd, & + & xij, geoElemsd) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! Abstract finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + !! shape function data + REAL(DFP), INTENT(IN) :: xij(:, :) + !! nodal coordinates of element + !! The number of rows in xij should be same as the spatial dimension + !! The number of columns should be same as the number of nodes + !! present in the reference element in geoElemsd. + CLASS(ElemShapeData_), OPTIONAL, INTENT(INOUT) :: geoElemsd + !! shape function data for geometry which contains local shape function + !! data. If not present then the local shape function in elemsd + !! will be used for geometry. This means we are dealing with + !! isoparametric shape functions. + END SUBROUTINE fe_GetGlobalElemShapeData_H1_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData@GetMethods +!---------------------------------------------------------------------------- -PUBLIC :: AbstractMatrixFEPointer_ +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get Global element shape data shape data + +INTERFACE + MODULE SUBROUTINE fe_GetGlobalElemShapeData_HDiv_Master(obj, elemsd, & + & xij, geoElemsd) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! Abstract finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + !! shape function data + REAL(DFP), INTENT(IN) :: xij(:, :) + !! nodal coordinates of element + !! The number of rows in xij should be same as the spatial dimension + !! The number of columns should be same as the number of nodes + !! present in the reference element in geoElemsd. + CLASS(ElemShapeData_), OPTIONAL, INTENT(INOUT) :: geoElemsd + !! shape function data for geometry which contains local shape function + !! data. If not present then the local shape function in elemsd + !! will be used for geometry. This means we are dealing with + !! isoparametric shape functions. + END SUBROUTINE fe_GetGlobalElemShapeData_HDiv_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get Global element shape data shape data + +INTERFACE + MODULE SUBROUTINE fe_GetGlobalElemShapeData_HCurl_Master(obj, elemsd, & + & xij, geoElemsd) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! Abstract finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + !! shape function data + REAL(DFP), INTENT(IN) :: xij(:, :) + !! nodal coordinates of element + !! The number of rows in xij should be same as the spatial dimension + !! The number of columns should be same as the number of nodes + !! present in the reference element in geoElemsd. + CLASS(ElemShapeData_), OPTIONAL, INTENT(INOUT) :: geoElemsd + !! shape function data for geometry which contains local shape function + !! data. If not present then the local shape function in elemsd + !! will be used for geometry. This means we are dealing with + !! isoparametric shape functions. + END SUBROUTINE fe_GetGlobalElemShapeData_HCurl_Master +END INTERFACE + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-15 +! summary: Get Global element shape data shape data + +INTERFACE + MODULE SUBROUTINE fe_GetGlobalElemShapeData_DG_Master(obj, elemsd, & + & xij, geoElemsd) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + !! Abstract finite element + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + !! shape function data + REAL(DFP), INTENT(IN) :: xij(:, :) + !! nodal coordinates of element + !! The number of rows in xij should be same as the spatial dimension + !! The number of columns should be same as the number of nodes + !! present in the reference element in geoElemsd. + CLASS(ElemShapeData_), OPTIONAL, INTENT(INOUT) :: geoElemsd + !! shape function data for geometry which contains local shape function + !! data. If not present then the local shape function in elemsd + !! will be used for geometry. This means we are dealing with + !! isoparametric shape functions. + END SUBROUTINE fe_GetGlobalElemShapeData_DG_Master +END INTERFACE END MODULE AbstractFE_Class diff --git a/src/modules/FiniteElement/src/FiniteElementFactory.F90 b/src/modules/FiniteElement/src/FiniteElementFactory.F90 index 8dff1f71f..56852a5d3 100644 --- a/src/modules/FiniteElement/src/FiniteElementFactory.F90 +++ b/src/modules/FiniteElement/src/FiniteElementFactory.F90 @@ -17,5 +17,5 @@ MODULE FiniteElementFactory USE AbstractFE_Class -USE LagrangeFE_Class +USE FiniteElement_Class END MODULE FiniteElementFactory diff --git a/src/modules/FiniteElement/src/FiniteElement_Class.F90 b/src/modules/FiniteElement/src/FiniteElement_Class.F90 new file mode 100644 index 000000000..44f282008 --- /dev/null +++ b/src/modules/FiniteElement/src/FiniteElement_Class.F90 @@ -0,0 +1,209 @@ +! 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 +! + +MODULE FiniteElement_Class +USE GlobalData +USE AbstractRefElement_Class +USE AbstractFE_Class +USE FPL, ONLY: ParameterList_ +USE Domain_Class, ONLY: Domain_ +IMPLICIT NONE +PRIVATE +PUBLIC :: FiniteElement_ +PUBLIC :: FiniteElementPointer_ +PUBLIC :: SetFiniteElementParam +PUBLIC :: DEALLOCATE +PUBLIC :: Initiate +CHARACTER(*), PARAMETER :: modName = "FiniteElement_Class" +CHARACTER(*), PARAMETER :: myprefix = "FiniteElement" + +!---------------------------------------------------------------------------- +! AbstractRefElement_ +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-13 +! summary: Finite element class +! +!{!pages/docs-api/FiniteElement/FiniteElement_.md!} + +TYPE, EXTENDS(AbstractFE_) :: FiniteElement_ +CONTAINS + PRIVATE + PROCEDURE, PUBLIC, PASS(obj) :: Initiate => fe_Initiate + !! Constructor method for AbstractFE element + !! This method can be overloaded by Subclass of this abstract class. + PROCEDURE, PUBLIC, PASS(obj) :: CheckEssentialParam => & + & fe_CheckEssentialParam +END TYPE FiniteElement_ + +!---------------------------------------------------------------------------- +! FiniteElementPointer_ +!---------------------------------------------------------------------------- + +TYPE :: FiniteElementPointer_ + CLASS(FiniteElement_), POINTER :: ptr => NULL() +END TYPE FiniteElementPointer_ + +!---------------------------------------------------------------------------- +! CheckEssentialParam@Methods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2023-08-11 +! summary: This routine Check the essential parameters in param. + +INTERFACE + MODULE SUBROUTINE fe_CheckEssentialParam(obj, param) + CLASS(FiniteElement_), INTENT(IN) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + END SUBROUTINE fe_CheckEssentialParam +END INTERFACE + +!---------------------------------------------------------------------------- +! Initiate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 27 Aug 2022 +! summary: Initiates an instance of the finite element + +INTERFACE + MODULE SUBROUTINE fe_Initiate(obj, param) + CLASS(FiniteElement_), INTENT(INOUT) :: obj + TYPE(ParameterList_), INTENT(IN) :: param + END SUBROUTINE fe_Initiate +END INTERFACE + +!---------------------------------------------------------------------------- +! Deallocate@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-25 +! summary: Deallocate a vector of FiniteElement + +INTERFACE DEALLOCATE + MODULE SUBROUTINE Deallocate_Vector(obj) + TYPE(FiniteElement_), ALLOCATABLE :: obj(:) + END SUBROUTINE Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE Deallocate_Ptr_Vector(obj) + TYPE(FiniteElementPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! SetAbstractFEParam@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-11 +! summary: Sets the parameters for initiating abstract finite element + +INTERFACE + MODULE SUBROUTINE SetFiniteElementParam( & + & param, & + & nsd, & + & elemType, & + & baseContinuity, & + & baseInterpolation, & + & ipType, & + & basisType, & + & alpha, & + & beta, & + & lambda, & + & order, & + & anisoOrder, & + & edgeOrder, & + & faceOrder, & + & cellOrder) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: nsd + !! Number of spatial dimension + INTEGER(I4B), INTENT(IN) :: elemType + !! Type of finite element + !! Line, Triangle, Quadrangle, Tetrahedron, Prism, Pyramid, + !! Hexahedron + CHARACTER(*), INTENT(IN) :: baseContinuity + !! Continuity or Conformity of basis function. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! H1* (default), HDiv, HCurl, DG + CHARACTER(*), INTENT(IN) :: baseInterpolation + !! Basis function family used for interpolation. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! LagrangeInterpolation, LagrangePolynomial + !! SerendipityInterpolation, SerendipityPolynomial + !! HierarchyInterpolation, HierarchyPolynomial + !! OrthogonalInterpolation, OrthogonalPolynomial + !! HermitInterpolation, HermitPolynomial + INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType + !! Interpolation point type, It is required when + !! baseInterpol is LagrangePolynomial + INTEGER(I4B), OPTIONAL, INTENT(IN) :: basisType(:) + !! Basis type: Legendre, Lobatto, Ultraspherical, + !! Jacobi, Monomial + REAL(DFP), OPTIONAL, INTENT(IN) :: alpha(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: beta(:) + !! Jacobi parameter + REAL(DFP), OPTIONAL, INTENT(IN) :: lambda(:) + !! Ultraspherical parameters + INTEGER(I4B), OPTIONAL, INTENT(IN) :: order + !! Isotropic Order of finite element + INTEGER(I4B), OPTIONAL, INTENT(IN) :: anisoOrder(:) + !! Anisotropic order, order in x, y, and z directions + INTEGER(I4B), OPTIONAL, INTENT(IN) :: edgeOrder(:) + !! Order of approximation along edges + INTEGER(I4B), OPTIONAL, INTENT(IN) :: faceOrder(:) + !! Order of approximation along face + INTEGER(I4B), OPTIONAL, INTENT(IN) :: cellOrder(:) + !! Order of approximation along cell + END SUBROUTINE SetFiniteElementParam +END INTERFACE + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-22 +! summary: Initiate vector of FiniteElement pointers + +INTERFACE Initiate + MODULE SUBROUTINE fe_Initiate1(obj, param, dom) + TYPE(FiniteElementPointer_), ALLOCATABLE, INTENT(INOUT) :: obj(:) + TYPE(ParameterList_), INTENT(IN) :: param + CLASS(Domain_), INTENT(IN) :: dom + END SUBROUTINE fe_Initiate1 +END INTERFACE Initiate + +END MODULE FiniteElement_Class diff --git a/src/modules/FiniteElement/src/LagrangeFE_Class.F90 b/src/modules/FiniteElement/src/LagrangeFE_Class.F90 deleted file mode 100644 index 8695ca6e5..000000000 --- a/src/modules/FiniteElement/src/LagrangeFE_Class.F90 +++ /dev/null @@ -1,115 +0,0 @@ -! 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 -! - -MODULE LagrangeFE_Class -USE GlobalData -USE AbstractFE_Class -USE PolynomialFactory -IMPLICIT NONE -PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "LagrangeFE_Class" - -!---------------------------------------------------------------------------- -! LagrangeFE_ -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 Aug 2022 -! summary: Lagrange finite element class if defined - -TYPE, EXTENDS(AbstractScalarFE_) :: LagrangeFE_ - TYPE(LagrangeSpace1D_) :: oneD - TYPE(LagrangeSpace2D_) :: twoD - TYPE(LagrangeSpace3D_) :: threeD -CONTAINS - !! - PROCEDURE, PUBLIC, PASS(obj) :: Initiate => fe_Initiate - PROCEDURE, PUBLIC, PASS(obj) :: Deallocate => fe_Deallocate - FINAL :: fe_final - PROCEDURE, PUBLIC, PASS(obj) :: Display => fe_Display -END TYPE LagrangeFE_ - -PUBLIC :: LagrangeFE_ - -!---------------------------------------------------------------------------- -! LagrangeFEPointer_ -!---------------------------------------------------------------------------- - -TYPE :: LagrangeFEPointer_ - CLASS(LagrangeFE_), POINTER :: ptr => NULL() -END TYPE LagrangeFEPointer_ - -PUBLIC :: LagrangeFEPointer_ - -!---------------------------------------------------------------------------- -! Initiate@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 Aug 2022 -! summary: Initiate Lagrange finite element - -INTERFACE - MODULE SUBROUTINE fe_Initiate(obj, elemType, order, ipType) - CLASS(LagrangeFE_), INTENT(INOUT) :: obj - INTEGER(I4B), INTENT(IN) :: elemType - INTEGER(I4B), INTENT(IN) :: order - INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType - END SUBROUTINE fe_Initiate -END INTERFACE - -!---------------------------------------------------------------------------- -! Deallocate@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 29 Aug 2022 -! summary: Deallocate the data - -INTERFACE - MODULE SUBROUTINE fe_Deallocate(obj) - CLASS(LagrangeFE_), INTENT(INOUT) :: obj - END SUBROUTINE fe_Deallocate -END INTERFACE - -!---------------------------------------------------------------------------- -! Final@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 29 Aug 2022 -! summary: Final the data - -INTERFACE - MODULE SUBROUTINE fe_Final(obj) - TYPE(LagrangeFE_), INTENT(INOUT) :: obj - END SUBROUTINE fe_Final -END INTERFACE - -!---------------------------------------------------------------------------- -! Display -!---------------------------------------------------------------------------- - -INTERFACE - MODULE SUBROUTINE fe_Display(obj, msg, unitno) - CLASS(LagrangeFE_), INTENT(IN) :: obj - CHARACTER(LEN=*), INTENT(IN) :: msg - INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno - END SUBROUTINE fe_Display -END INTERFACE - -END MODULE LagrangeFE_Class diff --git a/src/modules/GmshAPI/src/Gmsh_Class.F90 b/src/modules/GmshAPI/src/Gmsh_Class.F90 index 62c2af41d..098d6edd6 100644 --- a/src/modules/GmshAPI/src/Gmsh_Class.F90 +++ b/src/modules/GmshAPI/src/Gmsh_Class.F90 @@ -99,11 +99,11 @@ MODULE Gmsh_Class !! Closes the Gmsh engine FINAL :: Gmsh_finalize_ !! Final for Gmsh_ - PROCEDURE, PUBLIC, NOPASS :: open => Gmsh_open + PROCEDURE, PUBLIC, NOPASS :: OPEN => Gmsh_open !! open file to load PROCEDURE, PUBLIC, NOPASS :: merge => Gmsh_merge !! merge model - PROCEDURE, PUBLIC, NOPASS :: write => Gmsh_write + PROCEDURE, PUBLIC, NOPASS :: WRITE => Gmsh_write !! Write content in a file PROCEDURE, PUBLIC, NOPASS :: clear => Gmsh_clear !! Clear the content @@ -158,14 +158,14 @@ FUNCTION Gmsh_initialize(obj, argv, readConfigFiles, run) & !! Internal variables !! CHARACTER(LEN=*), PARAMETER :: myName = "Gmsh_initialize()" - CHARACTER(LEN=maxStrLen, KIND=c_char), ALLOCATABLE :: argv_strs(:) + CHARACTER(LEN=maxStrLen, KIND=C_CHAR), ALLOCATABLE :: argv_strs(:) TYPE(C_PTR), ALLOCATABLE :: argv_cptr(:) !! ans = 0 !! IF (.NOT. obj%isInitiated) THEN !! - call gmsh_GetCharArray_cPtr( & + CALL gmsh_GetCharArray_cPtr( & & gmsh_InputStr(default=[''], & & option=argv), & & argv_strs, & @@ -200,7 +200,7 @@ FUNCTION Gmsh_initialize(obj, argv, readConfigFiles, run) & & hint: You can try, first Nullifying it") ans = -1 END IF - ALLOCATE (obj%Option); Call obj%Option%Initiate() + ALLOCATE (obj%Option); CALL obj%Option%Initiate() !! !! FLTK !! @@ -305,8 +305,8 @@ FUNCTION Gmsh_finalize(obj) RESULT(ans) END IF DEALLOCATE (obj%Model) END IF - obj%Option => null() - obj%Model => null() + obj%Option => NULL() + obj%Model => NULL() obj%isInitiated = .FALSE. ans = 0 CALL gmshFinalize(ierr=ierr) diff --git a/src/modules/LinSolver/src/LinSolver_Class.F90 b/src/modules/LinSolver/src/LinSolver_Class.F90 index 6e395a876..8de690c61 100644 --- a/src/modules/LinSolver/src/LinSolver_Class.F90 +++ b/src/modules/LinSolver/src/LinSolver_Class.F90 @@ -33,7 +33,7 @@ MODULE LinSolver_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "Linsolver_Class" -CHARACTER(*), PARAMETER :: myprefix = "Linsolver" +CHARACTER(*), PARAMETER :: myprefix = "LinSolver" CHARACTER(*), PARAMETER :: myengine = "NATIVE_SERIAL" INTEGER(I4B), PARAMETER :: IPAR_LENGTH = 14 INTEGER(I4B), PARAMETER :: FPAR_LENGTH = 14 diff --git a/src/modules/MSHFile/src/MSHFile_Class.F90 b/src/modules/MSHFile/src/MSHFile_Class.F90 index 11bb539b5..c938a5c08 100644 --- a/src/modules/MSHFile/src/MSHFile_Class.F90 +++ b/src/modules/MSHFile/src/MSHFile_Class.F90 @@ -23,7 +23,7 @@ MODULE MSHFile_Class USE ExceptionHandler_Class, ONLY: e USE mshFormat_Class USE mshPhysicalNames_Class -USE mshEntity_Class +USE mshEntity_Class, only: mshEntity_, TypeMshEntity USE mshNodes_Class USE mshElements_Class USE HDF5File_Class diff --git a/src/modules/MSHFile/src/mshEntity_Class.F90 b/src/modules/MSHFile/src/mshEntity_Class.F90 index 935e604e2..2de059ef6 100644 --- a/src/modules/MSHFile/src/mshEntity_Class.F90 +++ b/src/modules/MSHFile/src/mshEntity_Class.F90 @@ -27,6 +27,11 @@ MODULE mshEntity_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "mshEntity_Class" +PUBLIC :: mshEntity_ +PUBLIC :: mshEntityPointer_ +PUBLIC :: DEALLOCATE +PUBLIC :: Display +PUBLIC :: GetIndex !---------------------------------------------------------------------------- ! mshEntity_ @@ -134,8 +139,6 @@ MODULE mshEntity_Class ! !---------------------------------------------------------------------------- -PUBLIC :: mshEntity_ - TYPE(mshEntity_), PUBLIC, PARAMETER :: & & TypeMshEntity = & & mshEntity_( & @@ -154,7 +157,6 @@ MODULE mshEntity_Class CLASS(mshEntity_), POINTER :: Ptr => NULL() END TYPE mshEntityPointer_ -PUBLIC :: mshEntityPointer_ !---------------------------------------------------------------------------- ! Final @@ -174,18 +176,12 @@ END SUBROUTINE ent_Final ! date: 10 June 2021 ! summary: This subroutine deallocate the data from [[mshentity_]] -INTERFACE +INTERFACE DEALLOCATE MODULE SUBROUTINE ent_Deallocate(obj) CLASS(mshEntity_), INTENT(INOUT) :: obj END SUBROUTINE ent_Deallocate -END INTERFACE - -INTERFACE DEALLOCATE - MODULE PROCEDURE ent_Deallocate END INTERFACE DEALLOCATE -PUBLIC :: DEALLOCATE - !---------------------------------------------------------------------------- ! GotoTag !---------------------------------------------------------------------------- @@ -258,20 +254,14 @@ END SUBROUTINE ent_WriteElementBlock ! date: 10 June 2021 ! summary: This subroutine writes the content of [[mshEntity_]] -INTERFACE +INTERFACE Display MODULE SUBROUTINE ent_Display(obj, Msg, UnitNo) CLASS(mshEntity_), INTENT(IN) :: obj CHARACTER(*), INTENT(IN) :: Msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: UnitNo END SUBROUTINE ent_Display -END INTERFACE - -INTERFACE Display - MODULE PROCEDURE ent_Display END INTERFACE Display -PUBLIC :: Display - !---------------------------------------------------------------------------- ! Read !---------------------------------------------------------------------------- @@ -366,19 +356,13 @@ END SUBROUTINE ReadVolumeEntity ! date: 10 June 2021 ! summary: This function finds the index of a tag/uid in list of entities -INTERFACE +INTERFACE GetIndex MODULE PURE FUNCTION ent_getIndex(mshEntities, Uid) RESULT(ans) TYPE(mshEntity_), INTENT(IN) :: mshEntities(:) INTEGER(I4B), INTENT(IN) :: Uid INTEGER(I4B) :: ans END FUNCTION ent_getIndex -END INTERFACE - -INTERFACE getIndex - MODULE PROCEDURE ent_getIndex -END INTERFACE getIndex - -PUBLIC :: getIndex +END INTERFACE GetIndex !---------------------------------------------------------------------------- ! getTotalPhysicalTags diff --git a/src/modules/MatrixField/src/MatrixField_Class.F90 b/src/modules/MatrixField/src/MatrixField_Class.F90 index a04c4f3ec..6ec7e1029 100644 --- a/src/modules/MatrixField/src/MatrixField_Class.F90 +++ b/src/modules/MatrixField/src/MatrixField_Class.F90 @@ -647,7 +647,7 @@ END SUBROUTINE mField_Display PUBLIC :: MatrixFieldDisplay !---------------------------------------------------------------------------- -! Import@IOMethods +! Import@IOMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -689,7 +689,7 @@ END SUBROUTINE mField_ImportPmat END INTERFACE !---------------------------------------------------------------------------- -! Export@IOMethods +! Export@IOMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -787,7 +787,6 @@ END FUNCTION mField_Shape ! is a native fortran vector. The output vector is also a native fortran ! vector. It should be noted that the output vector should be allocated ! outside and it should have same length as the input vector. -! INTERFACE MODULE SUBROUTINE mField_Matvec1(obj, x, y, isTranspose, & diff --git a/src/modules/Mesh/src/Mesh_Class.F90 b/src/modules/Mesh/src/Mesh_Class.F90 index 91db971b0..610a16cd4 100755 --- a/src/modules/Mesh/src/Mesh_Class.F90 +++ b/src/modules/Mesh/src/Mesh_Class.F90 @@ -20,9 +20,8 @@ MODULE Mesh_Class USE GlobalData -USE BaseType +USE BaSetype USE String_Class, ONLY: String -USE ElementFactory USE ExceptionHandler_Class, ONLY: e USE FPL, ONLY: ParameterList_ USE HDF5File_Class @@ -107,11 +106,8 @@ MODULE Mesh_Class !! It may happen that a boundary element has no boundary face, in which !! case boundaryData will have zero size CONTAINS - !! - !! Contains - !! PROCEDURE, PUBLIC, PASS(obj) :: Display => elemData_Display - !! + !! Display the content of elemdata END TYPE ElemData_ !---------------------------------------------------------------------------- @@ -132,9 +128,6 @@ MODULE Mesh_Class INTEGER(I4B) :: slaveLocalFacetID = 0 !! slave facet ID in slave cell CONTAINS - !! - !! Contains - !! PROCEDURE, PUBLIC, PASS(obj) :: Display => InternalFacetData_Display !! Display the content of an instance of InternalFacetData_ END TYPE InternalFacetData_ @@ -159,11 +152,8 @@ MODULE Mesh_Class INTEGER(I4B) :: masterLocalFacetID = 0 INTEGER(I4B) :: elementType = 0 CONTAINS - !! - !! Contains - !! PROCEDURE, PUBLIC, PASS(obj) :: Display => BoundaryFacetData_Display - !! + !! Display the content of boundary facetdata END TYPE BoundaryFacetData_ ! PUBLIC :: BoundaryFacetData_ @@ -176,14 +166,14 @@ MODULE Mesh_Class ! date: 13 June 2021 ! summary: This datatype contains the meta data of a mesh ! -!{!pages/Mesh_.md!} +!{!pages/docs-api/Mesh/Mesh_.md!} TYPE :: Mesh_ PRIVATE LOGICAL(LGT) :: readFromFile = .TRUE. !! True if the mesh is read from a file LOGICAL(LGT) :: isInitiated = .FALSE. - !! logical flag denoting for whether mesh data is initiated or not + !! logical flag denoting for whether mesh data is Initiated or not LOGICAL(LGT) :: isNodeToElementsInitiated = .FALSE. !! Node to elements mapping LOGICAL(LGT) :: isNodeToNodesInitiated = .FALSE. @@ -196,6 +186,7 @@ MODULE Mesh_Class !! Boundary data LOGICAL(LGT), PUBLIC :: isFacetDataInitiated = .FALSE. !! FacetData + !! TODO: Make isFacetDataInitiated PRIVATE INTEGER(I4B) :: uid = 0 !! Unique id of the mesh INTEGER(I4B) :: xidim = 0 @@ -277,20 +268,21 @@ MODULE Mesh_Class !! element data TYPE(InternalFacetData_), PUBLIC, ALLOCATABLE :: internalFacetData(:) !! Internal facet data + !! INFO: This data is initiated by InitiateFacetElements method TYPE(BoundaryFacetData_), PUBLIC, ALLOCATABLE :: boundaryFacetData(:) !! Domain Facet Data + !! INFO: This data is initiated by InitiateFacetElements method CLASS(ReferenceElement_), PUBLIC, POINTER :: refelem => NULL() !! Reference element of the mesh (spatial) + !! TODO: Change refelem to Type(ReferenceElement_) REAL(DFP), ALLOCATABLE :: quality(:, :) !! number of rows are meshquality !! number of columns are elements INTEGER(I4B), PUBLIC :: ipType = Equidistance !! interpolation point type - !! - !! Following variables are required during processing. - !! - !! time - !! + + ! Following variables are required during processing. + ! time TYPE(QuadraturePoint_), PUBLIC :: quadForTime !! quadrature point for time domain #STFEM TYPE(ElemshapeData_), PUBLIC :: linTimeElemSD @@ -305,9 +297,8 @@ MODULE Mesh_Class !! interpolation of base function for time INTEGER(I4B) :: orderTime !! order for time - !! - !! space (cell) - !! + + ! space (cell) TYPE(QuadraturePoint_), PUBLIC :: quadForSpace !! quadrature point for space TYPE(ElemshapeData_), PUBLIC :: linSpaceElemSD @@ -324,9 +315,8 @@ MODULE Mesh_Class !! interoplation type of base function for space INTEGER(I4B) :: orderSpace !! order for space - !! - !! space (facets) - !! + + ! space (facets) TYPE(QuadraturePoint_), ALLOCATABLE, PUBLIC :: quadForFacet(:) !! quadrature point for facet elements TYPE(QuadraturePoint_), ALLOCATABLE, PUBLIC :: quadForFacetCell(:) @@ -349,26 +339,26 @@ MODULE Mesh_Class !! order for facet element TYPE(STElemshapeData_), ALLOCATABLE, PUBLIC :: facetSTelemsd(:, :) !! Element shape data on facet element - !! + CONTAINS PRIVATE - !! - !! @ConstructorMethods - !! + + ! CONSTRUCTOR: + ! @ConstructorMethods PROCEDURE, PUBLIC, PASS(obj) :: Initiate => mesh_initiate !! Allocate size of a mesh FINAL :: mesh_final !! mesh finalizer PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => mesh_Deallocate !! Deallocate memory occupied by the mesh instance - !! PROCEDURE, PUBLIC, PASS(obj) :: isEmpty => mesh_isEmpty - !! - !! @IOMethods - !! + !! Returns true if the mesh is empty. + + ! IO: + ! @IOMethods PROCEDURE, PUBLIC, PASS(obj) :: IMPORT => mesh_Import !! Read mesh from hdf5 file - PROCEDURE, PUBLIC, PASS(obj) :: getNodeCoord => mesh_getNodeCoord + PROCEDURE, PUBLIC, PASS(obj) :: GetNodeCoord => mesh_GetNodeCoord !! Read the nodeCoords from the hdf5file PROCEDURE, PUBLIC, PASS(obj) :: Export => mesh_Export !! Export mesh to an hdf5 file @@ -393,9 +383,9 @@ MODULE Mesh_Class !! Display facet element shape data PROCEDURE, PUBLIC, PASS(obj) :: DisplayFacetElements => & & mesh_DisplayFacetElements - ! - !@NodeDataMethods - ! + + ! SET: + ! @NodeDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateNodeToElements => & & mesh_InitiateNodeToElements !! Initiate node to node data @@ -405,24 +395,25 @@ MODULE Mesh_Class PROCEDURE, PUBLIC, PASS(obj) :: InitiateExtraNodeToNodes => & & mesh_InitiateExtraNodetoNodes !! Initiate Node to nodes mapping - ! - !@ElementDataMethods - ! + + ! SET: + ! @ElementDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateElementToElements => & & mesh_InitiateElementToElements !! Initiate element to elements mapping - ! - !@BoundaryDataMethods - ! + + ! SET: + ! @BoundaryDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateBoundaryData => & & mesh_InitiateBoundaryData - ! - !@FacetDataMethods - ! - !! Initiate boundary data + + ! SET: + ! @FacetDataMethods PROCEDURE, PUBLIC, PASS(obj) :: InitiateFacetElements => & & mesh_InitiateFacetElements - !! + !! Initiate boundary data + + ! GET: PROCEDURE, PUBLIC, PASS(obj) :: isBoundaryNode => & & mesh_isBoundaryNode !! Returns true if a given global node number is a boundary node @@ -449,191 +440,192 @@ MODULE Mesh_Class !! Returns true if a given element number is present PROCEDURE, PUBLIC, PASS(obj) :: Size => mesh_size !! Returns the size of the mesh (total number of elements) - PROCEDURE, PUBLIC, PASS(obj) :: getElemNum => mesh_getElemNum + PROCEDURE, PUBLIC, PASS(obj) :: GetElemNum => mesh_GetElemNum !! returns global element number in the mesh - PROCEDURE, PUBLIC, PASS(obj) :: getRefElemPointer => & - & mesh_getRefElemPointer + PROCEDURE, PUBLIC, PASS(obj) :: GetRefElemPointer => & + & mesh_GetRefElemPointer !! Returns pointer to the reference element - PROCEDURE, PUBLIC, PASS(obj) :: getTotalElements => mesh_size + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalElements => mesh_size !! Returns the size of the mesh - PROCEDURE, PUBLIC, PASS(obj) :: getBoundingEntity => & - & mesh_getBoundingEntity + PROCEDURE, PUBLIC, PASS(obj) :: GetBoundingEntity => & + & mesh_GetBoundingEntity !! Returns the nodal coordinates - PROCEDURE, PUBLIC, PASS(obj) :: getNptrs => mesh_getNptrs + PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs => mesh_GetNptrs !! Returns the node number of mesh - PROCEDURE, PUBLIC, PASS(obj) :: getInternalNptrs => & - & mesh_getInternalNptrs + PROCEDURE, PUBLIC, PASS(obj) :: GetInternalNptrs => & + & mesh_GetInternalNptrs !! Returns a vector of internal node numbers - PROCEDURE, PUBLIC, PASS(obj) :: getBoundaryNptrs => & - & mesh_getBoundaryNptrs + PROCEDURE, PUBLIC, PASS(obj) :: GetBoundaryNptrs => & + & mesh_GetBoundaryNptrs !! Returns a vector of boundary node numbers - PROCEDURE, PUBLIC, PASS(obj) :: getTotalInternalNodes => & - & mesh_getTotalInternalNodes + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalInternalNodes => & + & mesh_GetTotalInternalNodes !! Returns the total number of internal nodes - PROCEDURE, PUBLIC, PASS(obj) :: getTotalNodes => mesh_getTotalNodes + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalNodes => mesh_GetTotalNodes !! Returns the total number of nodes - PROCEDURE, PUBLIC, PASS(obj) :: getTotalBoundaryNodes => & - & mesh_getTotalBoundaryNodes + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalBoundaryNodes => & + & mesh_GetTotalBoundaryNodes !! Returns the total number of boundary nodes - PROCEDURE, PUBLIC, PASS(obj) :: getTotalBoundaryElements => & - & mesh_getTotalBoundaryElements + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalBoundaryElements => & + & mesh_GetTotalBoundaryElements !! Returns the total number of boundary element - PROCEDURE, PASS(obj) :: getBoundingBox1 => mesh_getBoundingBox1 + PROCEDURE, PASS(obj) :: GetBoundingBox1 => mesh_GetBoundingBox1 !! Returns the bounding box of the mesh - PROCEDURE, PASS(obj) :: getBoundingBox2 => mesh_getBoundingBox2 + PROCEDURE, PASS(obj) :: GetBoundingBox2 => mesh_GetBoundingBox2 !! Return the bounding box from the given nodes, and local_nptrs - GENERIC, PUBLIC :: getBoundingBox => getBoundingBox1, & - & getBoundingBox2 + GENERIC, PUBLIC :: GetBoundingBox => GetBoundingBox1, & + & GetBoundingBox2 !! Return the bounding box - PROCEDURE, PUBLIC, PASS(obj) :: getConnectivity => & - & mesh_getConnectivity + PROCEDURE, PUBLIC, PASS(obj) :: GetConnectivity => & + & mesh_GetConnectivity !! Returns node numbers in an element - PROCEDURE, PASS(obj) :: mesh_getLocalNodeNumber1 + PROCEDURE, PASS(obj) :: mesh_GetLocalNodeNumber1 !! Returns the local node number of a glocal node number - PROCEDURE, PASS(obj) :: mesh_getLocalNodeNumber2 + PROCEDURE, PASS(obj) :: mesh_GetLocalNodeNumber2 !! Returns the local node number of a global node number - GENERIC, PUBLIC :: getLocalNodeNumber => mesh_getLocalNodeNumber1, & - & mesh_getLocalNodeNumber2 + GENERIC, PUBLIC :: GetLocalNodeNumber => mesh_GetLocalNodeNumber1, & + & mesh_GetLocalNodeNumber2 !! Returns the local node number of a global node number - PROCEDURE, PASS(obj) :: mesh_getGlobalNodeNumber1 + PROCEDURE, PASS(obj) :: mesh_GetGlobalNodeNumber1 !! Returns the global node number of a local node number - PROCEDURE, PASS(obj) :: mesh_getGlobalNodeNumber2 + PROCEDURE, PASS(obj) :: mesh_GetGlobalNodeNumber2 !! Returns the global node number of a local node number - GENERIC, PUBLIC :: getGlobalNodeNumber => mesh_getGlobalNodeNumber1, & - & mesh_getGlobalNodeNumber2 - PROCEDURE, PASS(obj) :: mesh_getGlobalElemNumber1 - PROCEDURE, PASS(obj) :: mesh_getGlobalElemNumber2 - GENERIC, PUBLIC :: getGlobalElemNumber => & - & mesh_getGlobalElemNumber1, mesh_getGlobalElemNumber2 + GENERIC, PUBLIC :: GetGlobalNodeNumber => mesh_GetGlobalNodeNumber1, & + & mesh_GetGlobalNodeNumber2 + PROCEDURE, PASS(obj) :: mesh_GetGlobalElemNumber1 + PROCEDURE, PASS(obj) :: mesh_GetGlobalElemNumber2 + GENERIC, PUBLIC :: GetGlobalElemNumber => & + & mesh_GetGlobalElemNumber1, mesh_getGlobalElemNumber2 !! Returns the global element number for a local element number - PROCEDURE, PASS(obj) :: mesh_getLocalElemNumber1 - PROCEDURE, PASS(obj) :: mesh_getLocalElemNumber2 - GENERIC, PUBLIC :: getLocalElemNumber => & - & mesh_getLocalElemNumber1, mesh_getLocalElemNumber2 + PROCEDURE, PASS(obj) :: mesh_GetLocalElemNumber1 + PROCEDURE, PASS(obj) :: mesh_GetLocalElemNumber2 + GENERIC, PUBLIC :: GetLocalElemNumber => & + & mesh_GetLocalElemNumber1, mesh_getLocalElemNumber2 !! Returns the local element number of a global element number - PROCEDURE, PASS(obj) :: mesh_getNodeToElements1 - PROCEDURE, PASS(obj) :: mesh_getNodeToElements2 - GENERIC, PUBLIC :: getNodeToElements => & - & mesh_getNodeToElements1, & - & mesh_getNodeToElements2 + PROCEDURE, PASS(obj) :: mesh_GetNodeToElements1 + PROCEDURE, PASS(obj) :: mesh_GetNodeToElements2 + GENERIC, PUBLIC :: GetNodeToElements => & + & mesh_GetNodeToElements1, & + & mesh_GetNodeToElements2 !! Returns the element attached to a given global node number - PROCEDURE, PASS(obj) :: mesh_getNodeToNodes1 + PROCEDURE, PASS(obj) :: mesh_GetNodeToNodes1 !! Returns global node number connected to a given global node - PROCEDURE, PASS(obj) :: mesh_getNodeToNodes2 + PROCEDURE, PASS(obj) :: mesh_GetNodeToNodes2 !! Returns global node numbers connected to given global node numbers - GENERIC, PUBLIC :: getNodeToNodes => & - & mesh_getNodeToNodes1, & - & mesh_getNodeToNodes2 + GENERIC, PUBLIC :: GetNodeToNodes => & + & mesh_GetNodeToNodes1, & + & mesh_GetNodeToNodes2 !! Returns nodes connected to a given node number - PROCEDURE, PUBLIC, PASS(obj) :: getElementToElements => & - & mesh_getElementToElements + PROCEDURE, PUBLIC, PASS(obj) :: GetElementToElements => & + & mesh_GetElementToElements !! Returns local element number connected to a given local !! element number, it also gives information about the local !! facet number - PROCEDURE, PUBLIC, PASS(obj) :: getBoundaryElementData => & - & mesh_getBoundaryElementData + PROCEDURE, PUBLIC, PASS(obj) :: GetBoundaryElementData => & + & mesh_GetBoundaryElementData !! Returns boundary element data - PROCEDURE, PUBLIC, PASS(obj) :: getTotalFacetElements => & - & mesh_getTotalFacetElements + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalFacetElements => & + & mesh_GetTotalFacetElements !! Returns the total number of facet elements in the mesh - PROCEDURE, PUBLIC, PASS(obj) :: getTotalBoundaryFacetElements => & - & mesh_getTotalBoundaryFacetElements + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalBoundaryFacetElements => & + & mesh_GetTotalBoundaryFacetElements !! Returns the total number of boundary facet elements - PROCEDURE, PUBLIC, PASS(obj) :: getTotalInternalFacetElements => & - & mesh_getTotalInternalFacetElements + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalInternalFacetElements => & + & mesh_GetTotalInternalFacetElements !! Returns the total number of internal facet elements - PROCEDURE, PUBLIC, PASS(obj) :: getMasterCellNumber => & - & mesh_getMasterCellNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetMasterCellNumber => & + & mesh_GetMasterCellNumber !! Returns the master cell number of a facet element - PROCEDURE, PUBLIC, PASS(obj) :: getSlaveCellNumber => & - & mesh_getSlaveCellNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetSlaveCellNumber => & + & mesh_GetSlaveCellNumber !! Returns the slave cell number of a facet element - PROCEDURE, PUBLIC, PASS(obj) :: getCellNumber => & - & mesh_getCellNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetCellNumber => & + & mesh_GetCellNumber !! Returns the master and slave cell number of a facet element - PROCEDURE, PUBLIC, PASS(obj) :: getLocalFacetID => & - & mesh_getLocalFacetID - !! Return the local facet id, so that we can get reference element of + PROCEDURE, PUBLIC, PASS(obj) :: GetLocalFacetID => & + & mesh_GetLocalFacetID + !! Return the local facet id, so that we can Get reference element of !! the facet element - PROCEDURE, PASS(obj) :: mesh_getFacetConnectivity1 + PROCEDURE, PASS(obj) :: mesh_GetFacetConnectivity1 !! Return the node nubmers in the facet element - PROCEDURE, PASS(obj) :: mesh_getFacetConnectivity2 + PROCEDURE, PASS(obj) :: mesh_GetFacetConnectivity2 !! Return the node nubmers in the facet element of a cellElement - GENERIC, PUBLIC :: getFacetConnectivity => & - & mesh_getFacetConnectivity1, & - & mesh_getFacetConnectivity2 - !! Generic method to get the connectivity of a facet element - PROCEDURE, PUBLIC, PASS(obj) :: getFacetElementType => & - & mesh_getFacetElementType + GENERIC, PUBLIC :: GetFacetConnectivity => & + & mesh_GetFacetConnectivity1, & + & mesh_GetFacetConnectivity2 + !! Generic method to Get the connectivity of a facet element + PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElementType => & + & mesh_GetFacetElementType !! Returns the facet element type of a given cell element number - PROCEDURE, PUBLIC, PASS(obj) :: getOrder => & - & mesh_getOrder + PROCEDURE, PUBLIC, PASS(obj) :: GetOrder => & + & mesh_GetOrder !! Returns the order ofthe element of mesh - PROCEDURE, PUBLIC, PASS(obj) :: getNSD => & - & mesh_getNSD + PROCEDURE, PUBLIC, PASS(obj) :: GetNSD => & + & mesh_GetNSD !! Return the NSD - PROCEDURE, PUBLIC, PASS(obj) :: getXidimension => & - & mesh_getXidimension + PROCEDURE, PUBLIC, PASS(obj) :: GetXidimension => & + & mesh_GetXidimension !! Return the NSD - PROCEDURE, PUBLIC, PASS(obj) :: getMaterial => mesh_getMaterial + PROCEDURE, PUBLIC, PASS(obj) :: GetMaterial => mesh_GetMaterial !! returns the material id of a given medium - PROCEDURE, PUBLIC, PASS(obj) :: getTotalMaterial => mesh_getTotalMaterial + PROCEDURE, PUBLIC, PASS(obj) :: GetTotalMaterial => mesh_GetTotalMaterial !! returns the total material PROCEDURE, PUBLIC, PASS(obj) :: GetQuery => mesh_GetQuery - !! Get query - PROCEDURE, PUBLIC, PASS(obj) :: getMinElemNumber => & - & mesh_getMinElemNumber - PROCEDURE, PUBLIC, PASS(obj) :: getMaxElemNumber => & - & mesh_getMaxElemNumber - PROCEDURE, PUBLIC, PASS(obj) :: getMinNodeNumber => & - & mesh_getMinNodeNumber - PROCEDURE, PUBLIC, PASS(obj) :: getMaxNodeNumber => & - & mesh_getMaxNodeNumber - ! + !! Please use GetParam instead of GetQuery. + !! They are the same. But I like the name GetParam + PROCEDURE, PUBLIC, PASS(obj) :: GetParam => mesh_GetQuery + !! Get parameter of mesh + PROCEDURE, PUBLIC, PASS(obj) :: GetMinElemNumber => & + & mesh_GetMinElemNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetMaxElemNumber => & + & mesh_GetMaxElemNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetMinNodeNumber => & + & mesh_GetMinNodeNumber + PROCEDURE, PUBLIC, PASS(obj) :: GetMaxNodeNumber => & + & mesh_GetMaxNodeNumber + ! @SetMethods - ! !! Returns the order of reference element - PROCEDURE, PASS(obj) :: setBoundingBox1 => mesh_setBoundingBox1 + PROCEDURE, PASS(obj) :: SetBoundingBox1 => mesh_setBoundingBox1 !! Set the bounding box of the mesh - PROCEDURE, PASS(obj) :: setBoundingBox2 => mesh_setBoundingBox2 + PROCEDURE, PASS(obj) :: SetBoundingBox2 => mesh_setBoundingBox2 !! Set the bounding box from the given nodes, and local_nptrs - GENERIC, PUBLIC :: setBoundingBox => setBoundingBox1, & - & setBoundingBox2 + GENERIC, PUBLIC :: SetBoundingBox => setBoundingBox1, & + & SetBoundingBox2 !! Set the bounding box - PROCEDURE, PRIVATE, PASS(obj) :: setSparsity1 => mesh_setSparsity1 - PROCEDURE, PRIVATE, PASS(obj) :: setSparsity2 => mesh_setSparsity2 - PROCEDURE, PRIVATE, PASS(obj) :: setSparsity3 => mesh_setSparsity3 - PROCEDURE, PRIVATE, PASS(obj) :: setSparsity4 => mesh_setSparsity4 - GENERIC, PUBLIC :: setSparsity => setSparsity1, setSparsity2, & - & setSparsity3, setSparsity4 - PROCEDURE, PUBLIC, PASS(obj) :: setTotalMaterial => mesh_setTotalMaterial + PROCEDURE, PRIVATE, PASS(obj) :: SetSparsity1 => mesh_setSparsity1 + PROCEDURE, PRIVATE, PASS(obj) :: SetSparsity2 => mesh_setSparsity2 + PROCEDURE, PRIVATE, PASS(obj) :: SetSparsity3 => mesh_setSparsity3 + PROCEDURE, PRIVATE, PASS(obj) :: SetSparsity4 => mesh_setSparsity4 + GENERIC, PUBLIC :: SetSparsity => setSparsity1, setSparsity2, & + & SetSparsity3, setSparsity4 + PROCEDURE, PUBLIC, PASS(obj) :: SetTotalMaterial => mesh_SetTotalMaterial !! Adding a material ID of a medium which is mapped to the mesh - PROCEDURE, PUBLIC, PASS(obj) :: setMaterial => mesh_setMaterial + PROCEDURE, PUBLIC, PASS(obj) :: SetMaterial => mesh_setMaterial !! Adding a material ID of a medium which is mapped to the mesh - PROCEDURE, PUBLIC, PASS(obj) :: setFacetElementType => & - & mesh_setFacetElementType + PROCEDURE, PUBLIC, PASS(obj) :: SetFacetElementType => & + & mesh_SetFacetElementType !! Set the facet element type of a given cell number - PROCEDURE, PUBLIC, PASS(obj) :: setQuality => mesh_setQuality - !! set mesh quality - ! + PROCEDURE, PUBLIC, PASS(obj) :: SetQuality => mesh_setQuality + !! Set mesh quality + ! @ShapeDataMethods - ! - PROCEDURE, PASS(obj) :: initiateElemSD1 => mesh_initiateElemSD1 - PROCEDURE, PASS(obj) :: initiateElemSD2 => mesh_initiateElemSD2 - PROCEDURE, PASS(obj) :: initiateElemSD3 => mesh_initiateElemSD3 - PROCEDURE, PASS(obj) :: initiateElemSD4 => mesh_initiateElemSD4 - GENERIC, PUBLIC :: initiateElemSD => & - & initiateElemSD1, & - & initiateElemSD2, & - & initiateElemSD3, & - & initiateElemSD4 - PROCEDURE, PASS(obj) :: initiateFacetElemSD1 => mesh_initiateFacetElemSD1 - PROCEDURE, PASS(obj) :: initiateFacetElemSD2 => mesh_initiateFacetElemSD2 - PROCEDURE, PASS(obj) :: initiateFacetElemSD3 => mesh_initiateFacetElemSD3 - GENERIC, PUBLIC :: initiateFacetElemSD => & - & initiateFacetElemSD1, & - & initiateFacetElemSD2, & - & initiateFacetElemSD3 + PROCEDURE, PASS(obj) :: InitiateElemSD1 => mesh_initiateElemSD1 + PROCEDURE, PASS(obj) :: InitiateElemSD2 => mesh_initiateElemSD2 + PROCEDURE, PASS(obj) :: InitiateElemSD3 => mesh_initiateElemSD3 + PROCEDURE, PASS(obj) :: InitiateElemSD4 => mesh_initiateElemSD4 + GENERIC, PUBLIC :: InitiateElemSD => & + & InitiateElemSD1, & + & InitiateElemSD2, & + & InitiateElemSD3, & + & InitiateElemSD4 + PROCEDURE, PASS(obj) :: InitiateFacetElemSD1 => mesh_initiateFacetElemSD1 + PROCEDURE, PASS(obj) :: InitiateFacetElemSD2 => mesh_initiateFacetElemSD2 + PROCEDURE, PASS(obj) :: InitiateFacetElemSD3 => mesh_initiateFacetElemSD3 + GENERIC, PUBLIC :: InitiateFacetElemSD => & + & InitiateFacetElemSD1, & + & InitiateFacetElemSD2, & + & InitiateFacetElemSD3 !! Initiating local shape data for mesh END TYPE Mesh_ @@ -668,7 +660,7 @@ MODULE Mesh_Class ! !# Introduction ! -! This routine initiate the the mesh by reading the data stored inside +! This routine Initiate the the mesh by reading the data stored inside ! the HDF5 file. ! It calls following routines ! @@ -681,14 +673,14 @@ MODULE Mesh_Class ! - obj%InitiateBoundaryData() INTERFACE - MODULE SUBROUTINE mesh_initiate(obj, hdf5, group) + MODULE SUBROUTINE mesh_Initiate(obj, hdf5, group) CLASS(Mesh_), INTENT(INOUT) :: obj !! mesh object TYPE(HDF5File_), INTENT(INOUT) :: hdf5 !! Mesh file in hdf5 file format CHARACTER(*), INTENT(IN) :: group !! location in HDF5 file - END SUBROUTINE mesh_initiate + END SUBROUTINE mesh_Initiate END INTERFACE !---------------------------------------------------------------------------- @@ -807,10 +799,10 @@ END SUBROUTINE mesh_final ! meshData%physicalTag, meshData%InternalNptrs, meshData%elemNumber, ! meshData%connectivity, meshData%boundingEntity ! -! This routine initiate the local_nptrs data in mesh. -! This routine also sets the number of nodes in the mesh (tNodes) +! 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 globalNodeNum data inside the ! nodeData INTERFACE @@ -822,7 +814,7 @@ END SUBROUTINE mesh_Import END INTERFACE !---------------------------------------------------------------------------- -! getNodeCoord@IOMethods +! GetNodeCoord@IOMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -841,18 +833,18 @@ END SUBROUTINE mesh_Import !@note ! The nodeCoord returned by this routine should be used by the mesh object ! itself. This is because, in nodeCoords the nodes are arranged locally. -! However, if you wish to use nodeCoord, then get the localNodeNumber of a +! However, if you wish to use nodeCoord, then Get the localNodeNumber of a ! global node by calling the mesh methods, and use this localNodeNumber to ! extract the coordinates. !@endnote INTERFACE - MODULE SUBROUTINE mesh_getNodeCoord(obj, nodeCoord, hdf5, group) + MODULE SUBROUTINE mesh_GetNodeCoord(obj, nodeCoord, hdf5, group) CLASS(Mesh_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: nodeCoord(:, :) TYPE(HDF5File_), INTENT(INOUT) :: hdf5 CHARACTER(*), INTENT(IN) :: group - END SUBROUTINE mesh_getNodeCoord + END SUBROUTINE mesh_GetNodeCoord END INTERFACE !---------------------------------------------------------------------------- @@ -890,18 +882,18 @@ END SUBROUTINE mesh_Export ! - If `content` is present then write cell data by calling ! [[VTKFile_:WriteCells]] methods ! - If openTag is true then write piece info -! - If closeTag is true then close the piece +! - If cloSetag is true then close the piece INTERFACE MODULE SUBROUTINE mesh_ExportToVTK(obj, vtkFile, nodeCoord, filename, & - & OpenTag, Content, CloseTag) + & OpenTag, Content, CloSetag) CLASS(Mesh_), INTENT(IN) :: obj TYPE(VTKFile_), INTENT(INOUT) :: vtkFile REAL(DFP), OPTIONAL, INTENT(IN) :: nodeCoord(:, :) CHARACTER(*), OPTIONAL, INTENT(IN) :: filename LOGICAL(LGT), OPTIONAL, INTENT(IN) :: OpenTag !! Default is true - LOGICAL(LGT), OPTIONAL, INTENT(IN) :: CloseTag + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: CloSetag !! Default is true LOGICAL(LGT), OPTIONAL, INTENT(IN) :: Content !! Default is true @@ -1107,7 +1099,7 @@ END SUBROUTINE mesh_DisplayFacetElemSD END INTERFACE !---------------------------------------------------------------------------- -! getTotalElements@GetMethods +! GetTotalElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1123,7 +1115,7 @@ END FUNCTION mesh_size END INTERFACE !---------------------------------------------------------------------------- -! getElemNum@GetMethods +! GetElemNum@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1132,14 +1124,14 @@ END FUNCTION mesh_size ! summary: Returns the global element numbers present in the mesh INTERFACE - MODULE FUNCTION mesh_getElemNum(obj) RESULT(ans) + MODULE FUNCTION mesh_GetElemNum(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getElemNum + END FUNCTION mesh_GetElemNum END INTERFACE !---------------------------------------------------------------------------- -! getRefElemPointer@GetMethods +! GetRefElemPointer@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1147,14 +1139,14 @@ END FUNCTION mesh_getElemNum ! summary: Returns the pointer to the reference element INTERFACE - MODULE FUNCTION mesh_getRefElemPointer(obj) RESULT(ans) + MODULE FUNCTION mesh_GetRefElemPointer(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj CLASS(ReferenceElement_), POINTER :: ans - END FUNCTION mesh_getRefElemPointer + END FUNCTION mesh_GetRefElemPointer END INTERFACE !---------------------------------------------------------------------------- -! getBoundingEntity@GetMethods +! GetBoundingEntity@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1162,14 +1154,14 @@ END FUNCTION mesh_getRefElemPointer ! summary: Returns bounding entity of the mesh INTERFACE - MODULE PURE FUNCTION mesh_getBoundingEntity(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetBoundingEntity(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getBoundingEntity + END FUNCTION mesh_GetBoundingEntity END INTERFACE !---------------------------------------------------------------------------- -! getNptrs@GetMethods +! GetNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1177,14 +1169,14 @@ END FUNCTION mesh_getBoundingEntity ! summary: Returns the vector of global node numbers INTERFACE - MODULE PURE FUNCTION mesh_getNptrs(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetNptrs(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getNptrs + END FUNCTION mesh_GetNptrs END INTERFACE !---------------------------------------------------------------------------- -! getInternalNptrs@GetMethods +! GetInternalNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1192,14 +1184,14 @@ END FUNCTION mesh_getNptrs ! summary: Returns the vector of global node numbers of internal nodes INTERFACE - MODULE PURE FUNCTION mesh_getInternalNptrs(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetInternalNptrs(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getInternalNptrs + END FUNCTION mesh_GetInternalNptrs END INTERFACE !---------------------------------------------------------------------------- -! getBoundaryNptrs@GetMethods +! GetBoundaryNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1207,10 +1199,10 @@ END FUNCTION mesh_getInternalNptrs ! summary: Returns the vector of global node numbers of boundary nodes INTERFACE - MODULE PURE FUNCTION mesh_getBoundaryNptrs(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetBoundaryNptrs(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getBoundaryNptrs + END FUNCTION mesh_GetBoundaryNptrs END INTERFACE !---------------------------------------------------------------------------- @@ -1364,7 +1356,7 @@ END FUNCTION mesh_isDomainFacetElement END INTERFACE !---------------------------------------------------------------------------- -! getTotalInternalNodes@GetMethodss +! GetTotalInternalNodes@GetMethodss !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1372,14 +1364,14 @@ END FUNCTION mesh_isDomainFacetElement ! summary: Returns total number of internal nodes inside the mesh INTERFACE - MODULE PURE FUNCTION mesh_getTotalInternalNodes(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalInternalNodes(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalInternalNodes + END FUNCTION mesh_GetTotalInternalNodes END INTERFACE !---------------------------------------------------------------------------- -! getTotalNodes@MeshDataMethods +! GetTotalNodes@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1387,14 +1379,14 @@ END FUNCTION mesh_getTotalInternalNodes ! summary: returns total number of nodes in the mesh INTERFACE - MODULE PURE FUNCTION mesh_getTotalNodes(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalNodes(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalNodes + END FUNCTION mesh_GetTotalNodes END INTERFACE !---------------------------------------------------------------------------- -! getTotalBoundaryNodes@MeshDataMethods +! GetTotalBoundaryNodes@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1402,14 +1394,14 @@ END FUNCTION mesh_getTotalNodes ! summary: returns total number of boundary nodes in the mesh INTERFACE - MODULE PURE FUNCTION mesh_getTotalBoundaryNodes(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalBoundaryNodes(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalBoundaryNodes + END FUNCTION mesh_GetTotalBoundaryNodes END INTERFACE !---------------------------------------------------------------------------- -! getTotalBoundaryElements@MeshDataMethods +! GetTotalBoundaryElements@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1417,14 +1409,14 @@ END FUNCTION mesh_getTotalBoundaryNodes ! summary: returns total number of boundary elements INTERFACE - MODULE PURE FUNCTION mesh_getTotalBoundaryElements(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalBoundaryElements(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalBoundaryElements + END FUNCTION mesh_GetTotalBoundaryElements END INTERFACE !---------------------------------------------------------------------------- -! getBoundingBox@MeshDataMethods +! GetBoundingBox@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1432,14 +1424,14 @@ END FUNCTION mesh_getTotalBoundaryElements ! summary: returns bounding box of the mesh INTERFACE - MODULE PURE FUNCTION mesh_getBoundingBox1(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetBoundingBox1(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj TYPE(BoundingBox_) :: ans - END FUNCTION mesh_getBoundingBox1 + END FUNCTION mesh_GetBoundingBox1 END INTERFACE !---------------------------------------------------------------------------- -! getBoundingBox@GetMethods +! GetBoundingBox@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1447,18 +1439,18 @@ END FUNCTION mesh_getBoundingBox1 ! summary: returns bounding box of the mesh INTERFACE - MODULE PURE FUNCTION mesh_getBoundingBox2(obj, nodes, local_nptrs) & + MODULE PURE FUNCTION mesh_GetBoundingBox2(obj, nodes, local_nptrs) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj REAL(DFP), INTENT(IN) :: nodes(:, :) !! Nodal coordinates in XiJ format INTEGER(I4B), OPTIONAL, INTENT(IN) :: local_nptrs(:) TYPE(BoundingBox_) :: ans - END FUNCTION mesh_getBoundingBox2 + END FUNCTION mesh_GetBoundingBox2 END INTERFACE !---------------------------------------------------------------------------- -! getConnectivity@GetMethods +! GetConnectivity@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1466,15 +1458,15 @@ END FUNCTION mesh_getBoundingBox2 ! summary: This routine returns global node numbers in a given global elem INTERFACE - MODULE PURE FUNCTION mesh_getConnectivity(obj, globalElement) RESULT(ans) + MODULE PURE FUNCTION mesh_GetConnectivity(obj, globalElement) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getConnectivity + END FUNCTION mesh_GetConnectivity END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@GetMethods +! GetLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1486,15 +1478,15 @@ END FUNCTION mesh_getConnectivity ! This function returns the local node numbers from global node numbers. INTERFACE - MODULE PURE FUNCTION mesh_getLocalNodeNumber1(obj, globalNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetLocalNodeNumber1(obj, globalNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) INTEGER(I4B) :: ans(SIZE(globalNode)) - END FUNCTION mesh_getLocalNodeNumber1 + END FUNCTION mesh_GetLocalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getLocalNodeNumber@GetMethods +! GetLocalNodeNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1502,15 +1494,15 @@ END FUNCTION mesh_getLocalNodeNumber1 ! summary: This routine returns the local node number from a global node number INTERFACE - MODULE PURE FUNCTION mesh_getLocalNodeNumber2(obj, globalNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetLocalNodeNumber2(obj, globalNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode INTEGER(I4B) :: ans - END FUNCTION mesh_getLocalNodeNumber2 + END FUNCTION mesh_GetLocalNodeNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNptrs@GetMethods +! GetGlobalNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1518,15 +1510,15 @@ END FUNCTION mesh_getLocalNodeNumber2 ! summary: This function returns the Global node number from local node num INTERFACE - MODULE PURE FUNCTION mesh_getGlobalNodeNumber1(obj, localNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetGlobalNodeNumber1(obj, localNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: localNode(:) INTEGER(I4B) :: ans(SIZE(localNode)) - END FUNCTION mesh_getGlobalNodeNumber1 + END FUNCTION mesh_GetGlobalNodeNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalNptrs@GetMethods +! GetGlobalNptrs@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1534,15 +1526,15 @@ END FUNCTION mesh_getGlobalNodeNumber1 ! summary: This routine returns the Global node number from a local node number INTERFACE - MODULE PURE FUNCTION mesh_getGlobalNodeNumber2(obj, localNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetGlobalNodeNumber2(obj, localNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: localNode INTEGER(I4B) :: ans - END FUNCTION mesh_getGlobalNodeNumber2 + END FUNCTION mesh_GetGlobalNodeNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalElemNumber@GetMethods +! GetGlobalElemNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1550,16 +1542,16 @@ END FUNCTION mesh_getGlobalNodeNumber2 ! summary: This function returns the Global node number from local node num INTERFACE - MODULE PURE FUNCTION mesh_getGlobalElemNumber1(obj, LocalElement) & + MODULE PURE FUNCTION mesh_GetGlobalElemNumber1(obj, LocalElement) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: LocalElement(:) INTEGER(I4B) :: ans(SIZE(LocalElement)) - END FUNCTION mesh_getGlobalElemNumber1 + END FUNCTION mesh_GetGlobalElemNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getGlobalElemNumber@GetMethods +! GetGlobalElemNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1567,15 +1559,15 @@ END FUNCTION mesh_getGlobalElemNumber1 ! summary: This routine returns the Global node number from a local node number INTERFACE - MODULE PURE FUNCTION mesh_getGlobalElemNumber2(obj, LocalElement) RESULT(ans) + MODULE PURE FUNCTION mesh_GetGlobalElemNumber2(obj, LocalElement) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: LocalElement INTEGER(I4B) :: ans - END FUNCTION mesh_getGlobalElemNumber2 + END FUNCTION mesh_GetGlobalElemNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getLocalElemNumber@GetMethods +! GetLocalElemNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1583,15 +1575,15 @@ END FUNCTION mesh_getGlobalElemNumber2 ! summary: This function returns the local element number INTERFACE - MODULE PURE FUNCTION mesh_getLocalElemNumber1(obj, GlobalElement) RESULT(ans) + MODULE PURE FUNCTION mesh_GetLocalElemNumber1(obj, GlobalElement) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: GlobalElement(:) INTEGER(I4B) :: ans(SIZE(GlobalElement)) - END FUNCTION mesh_getLocalElemNumber1 + END FUNCTION mesh_GetLocalElemNumber1 END INTERFACE !---------------------------------------------------------------------------- -! getLocalElemNumber@GetMethods +! GetLocalElemNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1599,15 +1591,15 @@ END FUNCTION mesh_getLocalElemNumber1 ! summary: This function returns the local element number INTERFACE - MODULE PURE FUNCTION mesh_getLocalElemNumber2(obj, GlobalElement) RESULT(ans) + MODULE PURE FUNCTION mesh_GetLocalElemNumber2(obj, GlobalElement) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: GlobalElement INTEGER(I4B) :: ans - END FUNCTION mesh_getLocalElemNumber2 + END FUNCTION mesh_GetLocalElemNumber2 END INTERFACE !---------------------------------------------------------------------------- -! getNodeToElements@GetMethods +! GetNodeToElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1625,18 +1617,18 @@ END FUNCTION mesh_getLocalElemNumber2 !@endnote INTERFACE - MODULE PURE FUNCTION mesh_getNodeToElements1(obj, globalNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetNodeToElements1(obj, globalNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode !! global node number INTEGER(I4B), ALLOCATABLE :: ans(:) !! A vector of local element number - END FUNCTION mesh_getNodeToElements1 + END FUNCTION mesh_GetNodeToElements1 END INTERFACE !---------------------------------------------------------------------------- -! getNodeToElements@GetMethods +! GetNodeToElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1656,18 +1648,18 @@ END FUNCTION mesh_getNodeToElements1 !@endnote INTERFACE - MODULE PURE FUNCTION mesh_getNodeToElements2(obj, globalNode) RESULT(ans) + MODULE PURE FUNCTION mesh_GetNodeToElements2(obj, globalNode) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj !! mesh data INTEGER(I4B), INTENT(IN) :: globalNode(:) !! global node number INTEGER(I4B), ALLOCATABLE :: ans(:) !! A vector of local element number - END FUNCTION mesh_getNodeToElements2 + END FUNCTION mesh_GetNodeToElements2 END INTERFACE !---------------------------------------------------------------------------- -! getNodeToNodes@GetMethods +! GetNodeToNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1688,17 +1680,17 @@ END FUNCTION mesh_getNodeToElements2 !@endnote INTERFACE - MODULE FUNCTION mesh_getNodeToNodes1(obj, globalNode, IncludeSelf) & + MODULE FUNCTION mesh_GetNodeToNodes1(obj, globalNode, IncludeSelf) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode LOGICAL(LGT), INTENT(IN) :: IncludeSelf INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getNodeToNodes1 + END FUNCTION mesh_GetNodeToNodes1 END INTERFACE !---------------------------------------------------------------------------- -! getNodeToNodes@GetMethods +! GetNodeToNodes@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1720,17 +1712,17 @@ END FUNCTION mesh_getNodeToNodes1 !@endnote INTERFACE - MODULE FUNCTION mesh_getNodeToNodes2(obj, globalNode, IncludeSelf) & + MODULE FUNCTION mesh_GetNodeToNodes2(obj, globalNode, IncludeSelf) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) LOGICAL(LGT), INTENT(IN) :: IncludeSelf INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getNodeToNodes2 + END FUNCTION mesh_GetNodeToNodes2 END INTERFACE !---------------------------------------------------------------------------- -! getElementToElements@MeshDataMethods +! GetElementToElements@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1741,7 +1733,7 @@ END FUNCTION mesh_getNodeToNodes2 ! This routine returns element to element connectivity information ! for a given global element number `globalElement` ! -! If `OnlyElements` is absent or it is set to FALSE then, this routine +! If `OnlyElements` is absent or it is Set to FALSE then, this routine ! returns the **full information** about elements surrounding the global ! element `globalElement`. In this case, ! @@ -1758,7 +1750,7 @@ END FUNCTION mesh_getNodeToNodes2 ! INTERFACE - MODULE PURE FUNCTION mesh_getElementToElements(obj, globalElement, & + MODULE PURE FUNCTION mesh_GetElementToElements(obj, globalElement, & & onlyElements) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj !! mesh data @@ -1771,11 +1763,11 @@ MODULE PURE FUNCTION mesh_getElementToElements(obj, globalElement, & !! information about the elements connected to element iel is given INTEGER(I4B), ALLOCATABLE :: ans(:, :) !! list of elements surrounding elements - END FUNCTION mesh_getElementToElements + END FUNCTION mesh_GetElementToElements END INTERFACE !---------------------------------------------------------------------------- -! getBoundaryElementData@GetMethods +! GetBoundaryElementData@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1802,16 +1794,16 @@ END FUNCTION mesh_getElementToElements !@endnote INTERFACE - MODULE PURE FUNCTION mesh_getBoundaryElementData(obj, globalElement) & + MODULE PURE FUNCTION mesh_GetBoundaryElementData(obj, globalElement) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getBoundaryElementData + END FUNCTION mesh_GetBoundaryElementData END INTERFACE !---------------------------------------------------------------------------- -! getOrder@GetMethods +! GetOrder@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1820,14 +1812,14 @@ END FUNCTION mesh_getBoundaryElementData ! summary: Returns the order of reference element INTERFACE - MODULE PURE FUNCTION mesh_getOrder(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetOrder(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getOrder + END FUNCTION mesh_GetOrder END INTERFACE !---------------------------------------------------------------------------- -! getNSD@GetMethods +! GetNSD@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1835,14 +1827,14 @@ END FUNCTION mesh_getOrder ! summary: Returns the spatial dimension of the mesh INTERFACE - MODULE PURE FUNCTION mesh_getNSD(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetNSD(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getNSD + END FUNCTION mesh_GetNSD END INTERFACE !---------------------------------------------------------------------------- -! getXidimension@GetMethods +! GetXidimension@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1850,14 +1842,14 @@ END FUNCTION mesh_getNSD ! summary: Returns the xidimension of the mesh INTERFACE - MODULE PURE FUNCTION mesh_getXidimension(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetXidimension(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getXidimension + END FUNCTION mesh_GetXidimension END INTERFACE !---------------------------------------------------------------------------- -! getMaterial@GetMethods +! GetMaterial@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1866,15 +1858,15 @@ END FUNCTION mesh_getXidimension ! summary: Returns the materials id of a given medium INTERFACE - MODULE PURE FUNCTION mesh_getMaterial(obj, medium) RESULT(ans) + MODULE PURE FUNCTION mesh_GetMaterial(obj, medium) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: medium INTEGER(I4B) :: ans - END FUNCTION mesh_getMaterial + END FUNCTION mesh_GetMaterial END INTERFACE !---------------------------------------------------------------------------- -! getMaterial@GetMethods +! GetMaterial@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1883,14 +1875,14 @@ END FUNCTION mesh_getMaterial ! summary: Returns the materials id of a given medium INTERFACE - MODULE PURE FUNCTION mesh_getTotalMaterial(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalMaterial(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalMaterial + END FUNCTION mesh_GetTotalMaterial END INTERFACE !---------------------------------------------------------------------------- -! getTotalFacetElements@GetMethods +! GetTotalFacetElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1906,14 +1898,14 @@ END FUNCTION mesh_getTotalMaterial ! - MeshFacet Elements INTERFACE - MODULE PURE FUNCTION mesh_getTotalFacetElements(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalFacetElements(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalFacetElements + END FUNCTION mesh_GetTotalFacetElements END INTERFACE !---------------------------------------------------------------------------- -! getTotalInternalFacetElements@GetMethods +! GetTotalInternalFacetElements@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1921,25 +1913,25 @@ END FUNCTION mesh_getTotalFacetElements ! summary: Returns the total number of internal facets element in mesh INTERFACE - MODULE PURE FUNCTION mesh_getTotalInternalFacetElements(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalInternalFacetElements(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalInternalFacetElements + END FUNCTION mesh_GetTotalInternalFacetElements END INTERFACE !---------------------------------------------------------------------------- -! getTotalBoundaryFacetElements@GetMethods +! GetTotalBoundaryFacetElements@GetMethods !---------------------------------------------------------------------------- INTERFACE - MODULE PURE FUNCTION mesh_getTotalBoundaryFacetElements(obj) RESULT(ans) + MODULE PURE FUNCTION mesh_GetTotalBoundaryFacetElements(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getTotalBoundaryFacetElements + END FUNCTION mesh_GetTotalBoundaryFacetElements END INTERFACE !---------------------------------------------------------------------------- -! getMasterCellNumber@GetMethods +! GetMasterCellNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1953,18 +1945,18 @@ END FUNCTION mesh_getTotalBoundaryFacetElements ! - The master cell number is the global element number INTERFACE - MODULE PURE FUNCTION mesh_getMasterCellNumber(obj, facetElement, & + MODULE PURE FUNCTION mesh_GetMasterCellNumber(obj, facetElement, & & elementType)& & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement INTEGER(I4B), INTENT(IN) :: elementType INTEGER(I4B) :: ans - END FUNCTION mesh_getMasterCellNumber + END FUNCTION mesh_GetMasterCellNumber END INTERFACE !---------------------------------------------------------------------------- -! getSlaveCellNumber@GetMethods +! GetSlaveCellNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -1978,17 +1970,17 @@ END FUNCTION mesh_getMasterCellNumber ! - The slave cell number is the global element number INTERFACE - MODULE PURE FUNCTION mesh_getSlaveCellNumber(obj, facetElement, & + MODULE PURE FUNCTION mesh_GetSlaveCellNumber(obj, facetElement, & & elementType) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement INTEGER(I4B), INTENT(IN) :: elementType INTEGER(I4B) :: ans - END FUNCTION mesh_getSlaveCellNumber + END FUNCTION mesh_GetSlaveCellNumber END INTERFACE !---------------------------------------------------------------------------- -! getCellNumber@GetMethods +! GetCellNumber@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2004,17 +1996,17 @@ END FUNCTION mesh_getSlaveCellNumber ! - ans(2) contains the slave cell number INTERFACE - MODULE PURE FUNCTION mesh_getCellNumber(obj, facetElement, & + MODULE PURE FUNCTION mesh_GetCellNumber(obj, facetElement, & & elementType) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement INTEGER(I4B), INTENT(IN) :: elementType INTEGER(I4B) :: ans(2) - END FUNCTION mesh_getCellNumber + END FUNCTION mesh_GetCellNumber END INTERFACE !---------------------------------------------------------------------------- -! getLocalFacetID@GetMethods +! GetLocalFacetID@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2022,18 +2014,18 @@ END FUNCTION mesh_getCellNumber ! summary: Returns the local facet id INTERFACE - MODULE PURE FUNCTION mesh_getLocalFacetID(obj, facetElement, & + MODULE PURE FUNCTION mesh_GetLocalFacetID(obj, facetElement, & & elementType, isMaster) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement INTEGER(I4B), INTENT(IN) :: elementType LOGICAL(LGT), INTENT(IN) :: isMaster INTEGER(I4B) :: ans - END FUNCTION mesh_getLocalFacetID + END FUNCTION mesh_GetLocalFacetID END INTERFACE !---------------------------------------------------------------------------- -! getFacetConnectivity@GetMethods +! GetFacetConnectivity@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2046,7 +2038,7 @@ END FUNCTION mesh_getLocalFacetID ! - facetElement is local facet element number INTERFACE - MODULE PURE FUNCTION mesh_getFacetConnectivity1(obj, facetElement, & + MODULE PURE FUNCTION mesh_GetFacetConnectivity1(obj, facetElement, & & elementType, isMaster) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: facetElement @@ -2059,11 +2051,11 @@ MODULE PURE FUNCTION mesh_getFacetConnectivity1(obj, facetElement, & !! Currently, we do not support slave-cell for meshFacet because !! the slave of meshFacet lives in different instance of mesh_ INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getFacetConnectivity1 + END FUNCTION mesh_GetFacetConnectivity1 END INTERFACE !---------------------------------------------------------------------------- -! getFacetConnectivity@GetMethods +! GetFacetConnectivity@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2077,17 +2069,17 @@ END FUNCTION mesh_getFacetConnectivity1 ! - iface is the local face number in globalElement INTERFACE - MODULE PURE FUNCTION mesh_getFacetConnectivity2(obj, globalElement, & + MODULE PURE FUNCTION mesh_GetFacetConnectivity2(obj, globalElement, & & iface) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), INTENT(IN) :: iface INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getFacetConnectivity2 + END FUNCTION mesh_GetFacetConnectivity2 END INTERFACE !---------------------------------------------------------------------------- -! getFacetElementType@GetMethods +! GetFacetElementType@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2095,16 +2087,16 @@ END FUNCTION mesh_getFacetConnectivity2 ! summary: Returns the facet element type of the cell element number INTERFACE - MODULE PURE FUNCTION mesh_getFacetElementType(obj, globalElement) & + MODULE PURE FUNCTION mesh_GetFacetElementType(obj, globalElement) & & RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: globalElement INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION mesh_getFacetElementType + END FUNCTION mesh_GetFacetElementType END INTERFACE !---------------------------------------------------------------------------- -! getQuery@GetMethods +! GetQuery@GetMethods !---------------------------------------------------------------------------- INTERFACE @@ -2168,47 +2160,47 @@ END SUBROUTINE mesh_GetQuery END INTERFACE !---------------------------------------------------------------------------- -! getMinElemNumber@GetMethods +! GetMinElemNumber@GetMethods !---------------------------------------------------------------------------- INTERFACE - MODULE FUNCTION mesh_getMinElemNumber(obj) RESULT(ans) + MODULE FUNCTION mesh_GetMinElemNumber(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getMinElemNumber + END FUNCTION mesh_GetMinElemNumber END INTERFACE !---------------------------------------------------------------------------- -! getMaxElemNumber@GetMethods +! GetMaxElemNumber@GetMethods !---------------------------------------------------------------------------- INTERFACE - MODULE FUNCTION mesh_getMaxElemNumber(obj) RESULT(ans) + MODULE FUNCTION mesh_GetMaxElemNumber(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getMaxElemNumber + END FUNCTION mesh_GetMaxElemNumber END INTERFACE !---------------------------------------------------------------------------- -! getMinNodeNumber@GetMethods +! GetMinNodeNumber@GetMethods !---------------------------------------------------------------------------- INTERFACE - MODULE FUNCTION mesh_getMinNodeNumber(obj) RESULT(ans) + MODULE FUNCTION mesh_GetMinNodeNumber(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getMinNodeNumber + END FUNCTION mesh_GetMinNodeNumber END INTERFACE !---------------------------------------------------------------------------- -! getMaxNodeNumber@GetMethods +! GetMaxNodeNumber@GetMethods !---------------------------------------------------------------------------- INTERFACE - MODULE FUNCTION mesh_getMaxNodeNumber(obj) RESULT(ans) + MODULE FUNCTION mesh_GetMaxNodeNumber(obj) RESULT(ans) CLASS(Mesh_), INTENT(IN) :: obj INTEGER(I4B) :: ans - END FUNCTION mesh_getMaxNodeNumber + END FUNCTION mesh_GetMaxNodeNumber END INTERFACE !---------------------------------------------------------------------------- @@ -2229,7 +2221,7 @@ END FUNCTION mesh_getMaxNodeNumber ! contains the global element numbers. ! !@note -! Always use method called `getNodeToElements()` to access this information. +! Always use method called `GetNodeToElements()` to access this information. ! This methods requires global Node number !@endnote ! @@ -2262,7 +2254,7 @@ END SUBROUTINE mesh_InitiateNodeToElements ! 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 -! is not initiated, then this method calls `InitiateNodeToElements()` +! is not Initiated, then this method calls `InitiateNodeToElements()` ! INTERFACE @@ -2290,9 +2282,9 @@ END SUBROUTINE mesh_InitiateNodetoNodes ! !- This methods needs information about `nodeToNodes`, `nodeToElements`, ! and `elementToElements`. Therefore, -!- If `nodeToNodes` is not initiated, then this method initiates it. -!- If `nodeToElements` is not initiated, then this method initiates it. -!- If `elementToElements` is not initiated, then this method initiates it. +!- If `nodeToNodes` is not Initiated, then this method initiates it. +!- If `nodeToElements` is not Initiated, then this method initiates it. +!- If `elementToElements` is not Initiated, then this method initiates it. INTERFACE MODULE SUBROUTINE mesh_InitiateExtraNodetoNodes(obj) @@ -2315,12 +2307,12 @@ END SUBROUTINE mesh_InitiateExtraNodetoNodes !- Before calling this routine make sure the `refelem` in mesh is allocated. !- By using `refelem`, this routine forms the FacetElements. !- This routine needs `nodeToElements` information, therefore, if -! `nodeToElements` is not initiated then it calls `initiateNodeToelements` +! `nodeToElements` is not Initiated then it calls `initiateNodeToelements` ! method !- This method forms the following data: !- `obj%elementData(ielem)%globalElements` !- It also identifies those elements which are boundary element of mesh, and -!- set `obj%elementData(ielem)%elementType=BOUNDARY_ELEMENT` for those element +!- Set `obj%elementData(ielem)%elementType=BOUNDARY_ELEMENT` for those element !- Note that at this point boundary element are those which has at least ! one orphan face. !- Note that at this point these boundary element can be interface element @@ -2396,7 +2388,7 @@ END SUBROUTINE mesh_InitiateFacetElements END INTERFACE !---------------------------------------------------------------------------- -! setBoundingBox@setMethods +! SetBoundingBox@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2404,14 +2396,14 @@ END SUBROUTINE mesh_InitiateFacetElements ! summary: Sets the bounding box information in the mesh INTERFACE - MODULE PURE SUBROUTINE mesh_setBoundingBox1(obj, box) + MODULE PURE SUBROUTINE mesh_SetBoundingBox1(obj, box) CLASS(Mesh_), INTENT(INOUT) :: obj TYPE(BoundingBox_), INTENT(IN) :: box - END SUBROUTINE mesh_setBoundingBox1 + END SUBROUTINE mesh_SetBoundingBox1 END INTERFACE !---------------------------------------------------------------------------- -! setBoundingBox@setMethods +! SetBoundingBox@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2419,27 +2411,27 @@ END SUBROUTINE mesh_setBoundingBox1 ! summary: Sets the bounding box information in the mesh INTERFACE - MODULE PURE SUBROUTINE mesh_setBoundingBox2(obj, nodes, local_nptrs) + MODULE PURE SUBROUTINE mesh_SetBoundingBox2(obj, nodes, local_nptrs) CLASS(Mesh_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: nodes(:, :) INTEGER(I4B), OPTIONAL, INTENT(IN) :: local_nptrs(:) - END SUBROUTINE mesh_setBoundingBox2 + END SUBROUTINE mesh_SetBoundingBox2 END INTERFACE !---------------------------------------------------------------------------- -! setSparsity@setMethod +! SetSparsity@setMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 16 July 2021 -! summary: This routine set the sparsity pattern in [[CSRMatrix_]] object +! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object ! !# Introduction ! -! This routine sets the sparsity pattern in [[CSRMatrix_]] object. +! This routine Sets the sparsity pattern in [[CSRMatrix_]] object. INTERFACE - MODULE SUBROUTINE mesh_setSparsity1(obj, mat, localNodeNumber, lbound, & + MODULE SUBROUTINE mesh_SetSparsity1(obj, mat, localNodeNumber, lbound, & & ubound) CLASS(Mesh_), INTENT(INOUT) :: obj !! [[Mesh_]] class @@ -2449,40 +2441,40 @@ MODULE SUBROUTINE mesh_setSparsity1(obj, mat, localNodeNumber, lbound, & INTEGER(I4B), INTENT(IN) :: ubound INTEGER(I4B), INTENT(IN) :: localNodeNumber(lbound:ubound) !! Global to local node number map - END SUBROUTINE mesh_setSparsity1 + END SUBROUTINE mesh_SetSparsity1 END INTERFACE !---------------------------------------------------------------------------- -! setSparsity@MeshDataMethods +! SetSparsity@MeshDataMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 16 Oct 2021 -! summary: This routine set the sparsity pattern in [[CSRMatrix_]] object +! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object INTERFACE - MODULE SUBROUTINE mesh_setSparsity2(obj, mat) + MODULE SUBROUTINE mesh_SetSparsity2(obj, mat) CLASS(Mesh_), INTENT(INOUT) :: obj !! Mesh_ class TYPE(CSRMatrix_), INTENT(INOUT) :: mat !! CSRMatrix object - END SUBROUTINE mesh_setSparsity2 + END SUBROUTINE mesh_SetSparsity2 END INTERFACE !---------------------------------------------------------------------------- -! setSparsity@setMethod +! SetSparsity@setMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 12 Oct 2021 -! summary: This routine set the sparsity pattern in [[CSRMatrix_]] object +! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object ! !# Introduction ! -! This routine sets the sparsity pattern in [[CSRMatrix_]] object. +! This routine Sets the sparsity pattern in [[CSRMatrix_]] object. INTERFACE - MODULE SUBROUTINE mesh_setSparsity3(obj, colMesh, nodeToNode, mat, & + MODULE SUBROUTINE mesh_SetSparsity3(obj, colMesh, nodeToNode, mat, & & ivar, jvar) CLASS(Mesh_), INTENT(INOUT) :: obj !! [[Mesh_]] class @@ -2494,23 +2486,23 @@ MODULE SUBROUTINE mesh_setSparsity3(obj, colMesh, nodeToNode, mat, & !! [[CSRMatrix_]] object INTEGER(I4B), INTENT(IN) :: ivar INTEGER(I4B), INTENT(IN) :: jvar - END SUBROUTINE mesh_setSparsity3 + END SUBROUTINE mesh_SetSparsity3 END INTERFACE !---------------------------------------------------------------------------- -! setSparsity@setMethod +! SetSparsity@setMethod !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 12 Oct 2021 -! summary: This routine set the sparsity pattern in [[CSRMatrix_]] object +! summary: This routine Set the sparsity pattern in [[CSRMatrix_]] object ! !# Introduction ! -! This routine sets the sparsity pattern in [[CSRMatrix_]] object. +! This routine Sets the sparsity pattern in [[CSRMatrix_]] object. INTERFACE - MODULE SUBROUTINE mesh_setSparsity4(obj, colMesh, nodeToNode, mat, & + MODULE SUBROUTINE mesh_SetSparsity4(obj, colMesh, nodeToNode, mat, & & rowGlobalToLocalNodeNum, rowLBOUND, rowUBOUND, colGlobalToLocalNodeNum, & & colLBOUND, colUBOUND, ivar, jvar) CLASS(Mesh_), INTENT(INOUT) :: obj @@ -2532,11 +2524,11 @@ MODULE SUBROUTINE mesh_setSparsity4(obj, colMesh, nodeToNode, mat, & & colLBOUND:colUBOUND) INTEGER(I4B), INTENT(IN) :: ivar INTEGER(I4B), INTENT(IN) :: jvar - END SUBROUTINE mesh_setSparsity4 + END SUBROUTINE mesh_SetSparsity4 END INTERFACE !---------------------------------------------------------------------------- -! setMaterial@setMethods +! SetMaterial@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2545,14 +2537,14 @@ END SUBROUTINE mesh_setSparsity4 ! summary: Set the materials id of a given medium INTERFACE - MODULE PURE SUBROUTINE mesh_setTotalMaterial(obj, n) + MODULE PURE SUBROUTINE mesh_SetTotalMaterial(obj, n) CLASS(Mesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: n - END SUBROUTINE mesh_setTotalMaterial + END SUBROUTINE mesh_SetTotalMaterial END INTERFACE !---------------------------------------------------------------------------- -! setMaterial@setMethods +! SetMaterial@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2561,15 +2553,15 @@ END SUBROUTINE mesh_setTotalMaterial ! summary: Set the materials id of a given medium INTERFACE - MODULE PURE SUBROUTINE mesh_setMaterial(obj, medium, material) + MODULE PURE SUBROUTINE mesh_SetMaterial(obj, medium, material) CLASS(Mesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: medium INTEGER(I4B), INTENT(IN) :: material - END SUBROUTINE mesh_setMaterial + END SUBROUTINE mesh_SetMaterial END INTERFACE !---------------------------------------------------------------------------- -! setFacetElementType@setMethods +! SetFacetElementType@setMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -2577,25 +2569,25 @@ END SUBROUTINE mesh_setMaterial ! summary: Set the facet element type of a given cell number INTERFACE - MODULE PURE SUBROUTINE mesh_setFacetElementType(obj, globalElement, & + MODULE PURE SUBROUTINE mesh_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 mesh_setFacetElementType + END SUBROUTINE mesh_SetFacetElementType END INTERFACE !---------------------------------------------------------------------------- -! setQuality@setMethods +! SetQuality@setMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 2023-02-27 -! summary: set mesh quality +! summary: Set mesh quality INTERFACE - MODULE SUBROUTINE mesh_setQuality(obj, measures, max_measures, & + MODULE SUBROUTINE mesh_SetQuality(obj, measures, max_measures, & & min_measures, nodeCoord, local_nptrs) CLASS(Mesh_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: measures(:) @@ -2603,7 +2595,7 @@ MODULE SUBROUTINE mesh_setQuality(obj, measures, max_measures, & REAL(DFP), INTENT(OUT) :: min_measures(:) REAL(DFP), INTENT(IN) :: nodeCoord(:, :) INTEGER(I4B), INTENT(IN) :: local_nptrs(:) - END SUBROUTINE mesh_setQuality + END SUBROUTINE mesh_SetQuality END INTERFACE !---------------------------------------------------------------------------- @@ -2613,15 +2605,15 @@ END SUBROUTINE mesh_setQuality !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 ! update: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh ! !# Introduction ! -! This routine set the local shape data in space (linSpaceElemSD and +! This routine Set the local shape data in space (linSpaceElemSD and ! spaceElemSD) for the mesh. It also creates the quadrature points in space. INTERFACE - MODULE SUBROUTINE mesh_initiateElemSD1(obj, & + MODULE SUBROUTINE mesh_InitiateElemSD1(obj, & & orderSpace, & & linSpaceElem, & & spaceElem, & @@ -2641,7 +2633,7 @@ MODULE SUBROUTINE mesh_initiateElemSD1(obj, & !! continuity for base in space CHARACTER(*), INTENT(IN) :: interpolTypeForSpace !! interpolation type for base in space - END SUBROUTINE mesh_initiateElemSD1 + END SUBROUTINE mesh_InitiateElemSD1 END INTERFACE !---------------------------------------------------------------------------- @@ -2651,10 +2643,10 @@ END SUBROUTINE mesh_initiateElemSD1 !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 ! update: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateElemSD2(obj, & + MODULE SUBROUTINE mesh_InitiateElemSD2(obj, & & orderSpace, & & linSpaceElem, & & spaceElem, & @@ -2694,7 +2686,7 @@ MODULE SUBROUTINE mesh_initiateElemSD2(obj, & CHARACTER(*), INTENT(IN) :: interpolTypeForTime !! interpol type of base in time REAL(DFP), INTENT(IN) :: tvec(:) - END SUBROUTINE mesh_initiateElemSD2 + END SUBROUTINE mesh_InitiateElemSD2 END INTERFACE !---------------------------------------------------------------------------- @@ -2704,10 +2696,10 @@ END SUBROUTINE mesh_initiateElemSD2 !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 ! update: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateElemSD3(obj, & + MODULE SUBROUTINE mesh_InitiateElemSD3(obj, & & orderSpace, & & linSpaceElem, & & spaceElem, & @@ -2745,7 +2737,7 @@ MODULE SUBROUTINE mesh_initiateElemSD3(obj, & !! continuity type of base in time CHARACTER(*), INTENT(IN) :: interpolTypeForTime !! interpolation type of base in time - END SUBROUTINE mesh_initiateElemSD3 + END SUBROUTINE mesh_InitiateElemSD3 END INTERFACE !---------------------------------------------------------------------------- @@ -2755,13 +2747,13 @@ END SUBROUTINE mesh_initiateElemSD3 !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 ! update: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateElemSD4(obj, tvec) + MODULE SUBROUTINE mesh_InitiateElemSD4(obj, tvec) CLASS(Mesh_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: tvec(:) - END SUBROUTINE mesh_initiateElemSD4 + END SUBROUTINE mesh_InitiateElemSD4 END INTERFACE !---------------------------------------------------------------------------- @@ -2770,10 +2762,10 @@ END SUBROUTINE mesh_initiateElemSD4 !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateFacetElemSD1(obj, & + MODULE SUBROUTINE mesh_InitiateFacetElemSD1(obj, & & orderSpace, & & linSpaceElem, & & spaceElem, & @@ -2793,7 +2785,7 @@ MODULE SUBROUTINE mesh_initiateFacetElemSD1(obj, & !! continuity for base in space CHARACTER(*), INTENT(IN) :: interpolTypeForSpace !! interpolation type for base in space - END SUBROUTINE mesh_initiateFacetElemSD1 + END SUBROUTINE mesh_InitiateFacetElemSD1 END INTERFACE !---------------------------------------------------------------------------- @@ -2802,10 +2794,10 @@ END SUBROUTINE mesh_initiateFacetElemSD1 !> authors: Vikas Sharma, Ph. D. ! date: 20 May 2022 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateFacetElemSD2(obj, & + MODULE SUBROUTINE mesh_InitiateFacetElemSD2(obj, & & orderSpace, & & linSpaceElem, & & spaceElem, & @@ -2845,7 +2837,7 @@ MODULE SUBROUTINE mesh_initiateFacetElemSD2(obj, & CHARACTER(*), INTENT(IN) :: interpolTypeForTime !! interpol type of base in time REAL(DFP), INTENT(IN) :: tvec(:) - END SUBROUTINE mesh_initiateFacetElemSD2 + END SUBROUTINE mesh_InitiateFacetElemSD2 END INTERFACE !---------------------------------------------------------------------------- @@ -2855,13 +2847,13 @@ END SUBROUTINE mesh_initiateFacetElemSD2 !> authors: Vikas Sharma, Ph. D. ! date: 2021-12-09 ! update: 2021-12-09 -! summary: sets the local shape data for the mesh +! summary: Sets the local shape data for the mesh INTERFACE - MODULE SUBROUTINE mesh_initiateFacetElemSD3(obj, tvec) + MODULE SUBROUTINE mesh_InitiateFacetElemSD3(obj, tvec) CLASS(Mesh_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: tvec(:) - END SUBROUTINE mesh_initiateFacetElemSD3 + END SUBROUTINE mesh_InitiateFacetElemSD3 END INTERFACE !---------------------------------------------------------------------------- diff --git a/src/modules/MeshSelection/src/MeshSelection_Class.F90 b/src/modules/MeshSelection/src/MeshSelection_Class.F90 index 6fe8f1e3c..43d7bd15e 100644 --- a/src/modules/MeshSelection/src/MeshSelection_Class.F90 +++ b/src/modules/MeshSelection/src/MeshSelection_Class.F90 @@ -28,6 +28,9 @@ MODULE MeshSelection_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "MeshSelection_Class" +PUBLIC :: DEALLOCATE +PUBLIC :: MeshSelection_ +PUBLIC :: MeshSelectionPointer_ !---------------------------------------------------------------------------- ! MeshSelection_ @@ -67,13 +70,15 @@ MODULE MeshSelection_Class !! Element number in mesh of volume TYPE(IntVector_) :: nodeNum !! Global Node numbers - !! TODO add BoundingBox to MeshSelection_ - !! type(BoundingBoxPointer_), allocatable :: bbox(:) - !! Accordingly, modify the initiate method. + !! TODO: add BoundingBox to MeshSelection_ + !! type(BoundingBoxPointer_), allocatable :: bbox(:) + !! Accordingly, modify the initiate method. CONTAINS PRIVATE + ! CONSTRUCTOR: + ! @ConstructorMethods PROCEDURE, PUBLIC, PASS(obj) :: Initiate => meshSelect_Initiate - !! Initiates an instance of [[MeshSelection_]] + !! Initiates an instance of MeshSelection_ PROCEDURE, PASS(obj) :: Copy => meshSelect_Copy !! This routine copies object GENERIC, PUBLIC :: ASSIGNMENT(=) => Copy @@ -82,8 +87,11 @@ MODULE MeshSelection_Class & meshSelect_Deallocate !! Deallocate Data FINAL :: meshSelect_Final + + ! SET: + ! @SetMethods PROCEDURE, PUBLIC, PASS(obj) :: Add => meshSelect_Add - !! Add a new region to mesh selection + !! Add a new region to the MeshSelection_ PROCEDURE, PUBLIC, PASS(obj) :: Set => meshSelect_Set !! This routine should be called when we are done !! setting the regions in the instance @@ -93,29 +101,29 @@ MODULE MeshSelection_Class !! Export to the HDF5File PROCEDURE, PUBLIC, PASS(obj) :: Display => meshSelect_Display !! Displays the content - PROCEDURE, PUBLIC, PASS(obj) :: getMeshID => meshSelect_getMeshID + PROCEDURE, PUBLIC, PASS(obj) :: GetMeshID => meshSelect_getMeshID !! Returns the mesh id if available - PROCEDURE, PASS(obj) :: meshSelect_getElemNum1 + PROCEDURE, PASS(obj) :: meshSelect_GetElemNum1 !! Returns the element numbers if available - PROCEDURE, PASS(obj) :: meshSelect_getElemNum2 + PROCEDURE, PASS(obj) :: meshSelect_GetElemNum2 !! Returns the element numbers if available - PROCEDURE, PASS(obj) :: meshSelect_getElemNum3 + PROCEDURE, PASS(obj) :: meshSelect_GetElemNum3 !! Returns the element numbers if available - PROCEDURE, PASS(obj) :: meshSelect_getElemNum4 + PROCEDURE, PASS(obj) :: meshSelect_GetElemNum4 !! Returns the element numbers if available - GENERIC, PUBLIC :: getElemNum => & - & meshSelect_getElemNum1, & - & meshSelect_getElemNum2, & - & meshSelect_getElemNum3, & - & meshSelect_getElemNum4 + GENERIC, PUBLIC :: GetElemNum => & + & meshSelect_GetElemNum1, & + & meshSelect_GetElemNum2, & + & meshSelect_GetElemNum3, & + & meshSelect_GetElemNum4 !! Returns the element numbers if available - PROCEDURE, PASS(obj) :: meshSelect_getNodeNum1 - PROCEDURE, PASS(obj) :: meshSelect_getNodeNum2 - PROCEDURE, PASS(obj) :: meshSelect_getNodeNum3 - GENERIC, PUBLIC :: getNodeNum => & - & meshSelect_getNodeNum1, & - & meshSelect_getNodeNum2, & - & meshSelect_getNodeNum3 + PROCEDURE, PASS(obj) :: meshSelect_GetNodeNum1 + PROCEDURE, PASS(obj) :: meshSelect_GetNodeNum2 + PROCEDURE, PASS(obj) :: meshSelect_GetNodeNum3 + GENERIC, PUBLIC :: GetNodeNum => & + & meshSelect_GetNodeNum1, & + & meshSelect_GetNodeNum2, & + & meshSelect_GetNodeNum3 !! Returns the node number if available PROCEDURE, PUBLIC, PASS(obj) :: isMeshIDAllocated => & & meshSelect_isMeshIDAllocated @@ -128,16 +136,15 @@ MODULE MeshSelection_Class !! returns true if the node numbers are allocated PROCEDURE, PUBLIC, PASS(obj) :: GetQuery => meshSelect_GetQuery !! Query the mesh selection + PROCEDURE, PUBLIC, PASS(obj) :: GetParam => meshSelect_GetQuery + !! Query the mesh selection END TYPE MeshSelection_ -PUBLIC :: MeshSelection_ - !---------------------------------------------------------------------------- ! MeshSelection_ !---------------------------------------------------------------------------- -TYPE(MeshSelection_), PUBLIC, PARAMETER :: TypeMeshSelection = & - & MeshSelection_() +TYPE(MeshSelection_), PUBLIC, PARAMETER ::TypeMeshSelection=MeshSelection_() !---------------------------------------------------------------------------- ! MeshSelectionPointer_ @@ -147,7 +154,33 @@ MODULE MeshSelection_Class CLASS(MeshSelection_), POINTER :: ptr => NULL() END TYPE MeshSelectionPointer_ -PUBLIC :: MeshSelectionPointer_ +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE Deallocate_Vector(obj) + TYPE(MeshSelection_), ALLOCATABLE :: obj(:) + END SUBROUTINE Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE Deallocate_Ptr_Vector(obj) + TYPE(MeshSelectionPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods @@ -156,10 +189,16 @@ MODULE MeshSelection_Class !> authors: Vikas Sharma, Ph. D. ! date: 28 Aug 2021 ! summary: Initiate an instance of [[MeshSelection_]] +! +! TODO Initiate by passing ParameterList object to initiate. INTERFACE - MODULE SUBROUTINE meshSelect_Initiate(obj, isSelectionByMeshID, & - & isSelectionByElemNum, isSelectionByBox, isSelectionByNodeNum) + MODULE SUBROUTINE meshSelect_Initiate( & + & obj, & + & isSelectionByMeshID, & + & isSelectionByElemNum, & + & isSelectionByBox, & + & isSelectionByNodeNum) CLASS(MeshSelection_), INTENT(INOUT) :: obj LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isSelectionByMeshID LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isSelectionByElemNum @@ -296,7 +335,7 @@ END SUBROUTINE meshSelect_Display END INTERFACE !---------------------------------------------------------------------------- -! getMeshID@getMethods +! GetMeshID@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -304,15 +343,15 @@ END SUBROUTINE meshSelect_Display ! summary: This routine returns MeshID INTERFACE - MODULE PURE FUNCTION meshSelect_getMeshID(obj, dim) RESULT(Ans) + MODULE PURE FUNCTION meshSelect_GetMeshID(obj, dim) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getMeshID + END FUNCTION meshSelect_GetMeshID END INTERFACE !---------------------------------------------------------------------------- -! isMeshIDAllocated@getMethods +! isMeshIDAllocated@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -328,7 +367,7 @@ END FUNCTION meshSelect_isMeshIDAllocated END INTERFACE !---------------------------------------------------------------------------- -! isElemNumAllocated@getMethods +! isElemNumAllocated@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -344,7 +383,7 @@ END FUNCTION meshSelect_isElemNumAllocated END INTERFACE !---------------------------------------------------------------------------- -! isNodeNumAllocated@getMethods +! isNodeNumAllocated@GetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -363,8 +402,12 @@ END FUNCTION meshSelect_isNodeNumAllocated !---------------------------------------------------------------------------- INTERFACE - MODULE PURE SUBROUTINE meshSelect_GetQuery(obj, isInitiated, & - & isSelectionByBox, isSelectionByMeshID, isSelectionByElemNum, & + MODULE PURE SUBROUTINE meshSelect_GetQuery( & + & obj, & + & isInitiated, & + & isSelectionByBox, & + & isSelectionByMeshID, & + & isSelectionByElemNum, & & isSelectionByNodeNum) CLASS(MeshSelection_), INTENT(IN) :: obj LOGICAL(LGT), OPTIONAL, INTENT(OUT) :: isInitiated @@ -376,7 +419,7 @@ END SUBROUTINE meshSelect_GetQuery END INTERFACE !---------------------------------------------------------------------------- -! getElemNum@getMethods +! GetElemNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -384,15 +427,15 @@ END SUBROUTINE meshSelect_GetQuery ! summary: Returns element number if isSelectionByElemNum is true INTERFACE - MODULE FUNCTION meshSelect_getElemNum1(obj, dim) RESULT(Ans) + MODULE FUNCTION meshSelect_GetElemNum1(obj, dim) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getElemNum1 + END FUNCTION meshSelect_GetElemNum1 END INTERFACE !---------------------------------------------------------------------------- -! getElemNum@getMethods +! GetElemNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -410,16 +453,16 @@ END FUNCTION meshSelect_getElemNum1 ! - [ ] isSelectionByBox INTERFACE - MODULE FUNCTION meshSelect_getElemNum2(obj, dim, domain) RESULT(Ans) + MODULE FUNCTION meshSelect_GetElemNum2(obj, dim, domain) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim CLASS(Domain_), INTENT(IN) :: domain INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getElemNum2 + END FUNCTION meshSelect_GetElemNum2 END INTERFACE !---------------------------------------------------------------------------- -! getElemNum@getMethods +! GetElemNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -427,14 +470,14 @@ END FUNCTION meshSelect_getElemNum2 ! summary: Returns element number if isSelectionByElemNum is true INTERFACE - MODULE FUNCTION meshSelect_getElemNum3(obj) RESULT(Ans) + MODULE FUNCTION meshSelect_GetElemNum3(obj) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getElemNum3 + END FUNCTION meshSelect_GetElemNum3 END INTERFACE !---------------------------------------------------------------------------- -! getElemNum@getMethods +! GetElemNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -452,15 +495,15 @@ END FUNCTION meshSelect_getElemNum3 ! - [ ] isSelectionByBox INTERFACE - MODULE FUNCTION meshSelect_getElemNum4(obj, domain) RESULT(Ans) + MODULE FUNCTION meshSelect_GetElemNum4(obj, domain) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj CLASS(Domain_), INTENT(IN) :: domain INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getElemNum4 + END FUNCTION meshSelect_GetElemNum4 END INTERFACE !---------------------------------------------------------------------------- -! getNodeNum@getMethods +! GetNodeNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -468,14 +511,14 @@ END FUNCTION meshSelect_getElemNum4 ! summary: This routine returns the node numbers INTERFACE - MODULE FUNCTION meshSelect_getNodeNum1(obj) RESULT(Ans) + MODULE FUNCTION meshSelect_GetNodeNum1(obj) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getNodeNum1 + END FUNCTION meshSelect_GetNodeNum1 END INTERFACE !---------------------------------------------------------------------------- -! getNodeNum@getMethods +! GetNodeNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -488,16 +531,16 @@ END FUNCTION meshSelect_getNodeNum1 ! - [ ] isSelectionByBox INTERFACE - MODULE FUNCTION meshSelect_getNodeNum2(obj, dim, domain) RESULT(Ans) + MODULE FUNCTION meshSelect_GetNodeNum2(obj, dim, domain) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: dim CLASS(Domain_), INTENT(IN) :: domain INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getNodeNum2 + END FUNCTION meshSelect_GetNodeNum2 END INTERFACE !---------------------------------------------------------------------------- -! getNodeNum@getMethods +! GetNodeNum@getMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -505,11 +548,11 @@ END FUNCTION meshSelect_getNodeNum2 ! summary: This routine returns node numbers INTERFACE - MODULE FUNCTION meshSelect_getNodeNum3(obj, domain) RESULT(Ans) + MODULE FUNCTION meshSelect_GetNodeNum3(obj, domain) RESULT(Ans) CLASS(MeshSelection_), INTENT(IN) :: obj CLASS(Domain_), INTENT(IN) :: domain INTEGER(I4B), ALLOCATABLE :: ans(:) - END FUNCTION meshSelect_getNodeNum3 + END FUNCTION meshSelect_GetNodeNum3 END INTERFACE END MODULE MeshSelection_Class diff --git a/src/modules/NeumannBC/src/NeumannBC_Class.F90 b/src/modules/NeumannBC/src/NeumannBC_Class.F90 index 332990089..932ac0bc2 100644 --- a/src/modules/NeumannBC/src/NeumannBC_Class.F90 +++ b/src/modules/NeumannBC/src/NeumannBC_Class.F90 @@ -28,6 +28,12 @@ MODULE NeumannBC_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "NeumannBC_CLASS" CHARACTER(*), PARAMETER :: myprefix = "NeumannBC" +PUBLIC :: NeumannBC_ +PUBLIC :: NeumannBCPointer_ +PUBLIC :: SetNeumannBCParam +PUBLIC :: DEALLOCATE +PUBLIC :: AddNeumannBC +PUBLIC :: GetNeumannBCPointer !---------------------------------------------------------------------------- ! NeumannBC_ @@ -46,8 +52,6 @@ MODULE NeumannBC_Class FINAL :: bc_Final END TYPE NeumannBC_ -PUBLIC :: NeumannBC_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -56,7 +60,33 @@ MODULE NeumannBC_Class CLASS(NeumannBC_), POINTER :: ptr => NULL() END TYPE NeumannBCPointer_ -PUBLIC :: NeumannBCPointer_ +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Vector(obj) + TYPE(NeumannBC_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Ptr_Vector(obj) + TYPE(NeumannBCPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods @@ -67,10 +97,10 @@ MODULE NeumannBC_Class ! summary: Check essential parameters INTERFACE - MODULE SUBROUTINE bc_checkEssentialParam(obj, param) + MODULE SUBROUTINE bc_CheckEssentialParam(obj, param) CLASS(NeumannBC_), INTENT(INOUT) :: obj TYPE(ParameterList_), INTENT(IN) :: param - END SUBROUTINE bc_checkEssentialParam + END SUBROUTINE bc_CheckEssentialParam END INTERFACE !---------------------------------------------------------------------------- @@ -78,7 +108,7 @@ END SUBROUTINE bc_checkEssentialParam !---------------------------------------------------------------------------- INTERFACE - MODULE SUBROUTINE setNeumannBCParam(param, name, idof, nodalValueType, & + MODULE SUBROUTINE SetNeumannBCParam(param, name, idof, nodalValueType, & & useFunction, isNormal, isTangent) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: name @@ -91,11 +121,9 @@ MODULE SUBROUTINE setNeumannBCParam(param, name, idof, nodalValueType, & LOGICAL(LGT), OPTIONAL, INTENT(IN) :: useFunction LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isNormal LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isTangent - END SUBROUTINE setNeumannBCParam + END SUBROUTINE SetNeumannBCParam END INTERFACE -PUBLIC :: setNeumannBCParam - !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods !---------------------------------------------------------------------------- @@ -119,4 +147,45 @@ MODULE SUBROUTINE bc_Final(obj) END SUBROUTINE bc_Final END INTERFACE +!---------------------------------------------------------------------------- +! addNeumannBC@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Add Neumann boundary conditions to the vector of pointer + +INTERFACE AddNeumannBC + MODULE SUBROUTINE bc_AddNeumannBC(nbc, nbcNo, param, boundary, dom) + TYPE(NeumannBCPointer_), INTENT(INOUT) :: nbc(:) + !! Dirichlet boundary to form + INTEGER(I4B), INTENT(IN) :: nbcNo + !! Dirichlet boundary number + TYPE(ParameterList_), INTENT(IN) :: param + !! parameter for constructing [[DirichletBC_]]. + TYPE(MeshSelection_), INTENT(IN) :: boundary + !! Boundary region + CLASS(Domain_), INTENT(IN) :: dom + END SUBROUTINE bc_AddNeumannBC +END INTERFACE AddNeumannBC + +!---------------------------------------------------------------------------- +! GetNeumannBC@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Get dirichlet boundary conditions to the vector of pointer + +INTERFACE GetNeumannBCPointer + MODULE FUNCTION bc_GetNeumannBCPointer(nbc, nbcNo) RESULT(ans) + CLASS(NeumannBCPointer_), INTENT(IN) :: nbc(:) + INTEGER(I4B), INTENT(IN) :: nbcNo + !! Neumann boundary nunber + CLASS(NeumannBC_), POINTER :: ans + END FUNCTION bc_GetNeumannBCPointer +END INTERFACE GetNeumannBCPointer + END MODULE NeumannBC_Class diff --git a/src/modules/NitscheBC/src/NitscheBC_Class.F90 b/src/modules/NitscheBC/src/NitscheBC_Class.F90 index a3c3e2764..a012df0cf 100644 --- a/src/modules/NitscheBC/src/NitscheBC_Class.F90 +++ b/src/modules/NitscheBC/src/NitscheBC_Class.F90 @@ -28,8 +28,13 @@ MODULE NitscheBC_Class & DomainConnectivityPointer_ IMPLICIT NONE PRIVATE -CHARACTER(*), PARAMETER :: modName = "NitscheBC_CLASS" +CHARACTER(*), PARAMETER :: modName = "NitscheBC_Class" CHARACTER(*), PARAMETER :: myprefix = "NitscheBC" +PUBLIC :: DEALLOCATE +PUBLIC :: NitscheBCPointer_ +PUBLIC :: NitscheBC_ +PUBLIC :: AddNitscheBC +PUBLIC :: GetNitscheBCPointer !---------------------------------------------------------------------------- ! NitscheBC_ @@ -60,8 +65,6 @@ MODULE NitscheBC_Class FINAL :: bc_Final END TYPE NitscheBC_ -PUBLIC :: NitscheBC_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -70,7 +73,33 @@ MODULE NitscheBC_Class CLASS(NitscheBC_), POINTER :: ptr => NULL() END TYPE NitscheBCPointer_ -PUBLIC :: NitscheBCPointer_ +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Vector(obj) + TYPE(NitscheBC_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-09 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE bc_Deallocate_Ptr_Vector(obj) + TYPE(NitscheBCPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE bc_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods @@ -223,6 +252,47 @@ MODULE PURE FUNCTION bc_getLocalFacetID(obj, entityNum) RESULT(ans) END FUNCTION bc_getLocalFacetID END INTERFACE +!---------------------------------------------------------------------------- +! addNitscheBC@SetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Add Nitsche boundary conditions to the vector of pointer + +INTERFACE AddNitscheBC + MODULE SUBROUTINE bc_AddNitscheBC(dbc, dbcNo, param, boundary, dom) + TYPE(NitscheBCPointer_), INTENT(INOUT) :: dbc(:) + !! Nitsche boundary to form + INTEGER(I4B), INTENT(IN) :: dbcNo + !! Nitsche boundary number + TYPE(ParameterList_), INTENT(IN) :: param + !! parameter for constructing [[NitscheBC_]]. + TYPE(MeshSelection_), INTENT(IN) :: boundary + !! Boundary region + CLASS(Domain_), INTENT(IN) :: dom + END SUBROUTINE bc_AddNitscheBC +END INTERFACE AddNitscheBC + +!---------------------------------------------------------------------------- +! GetNitscheBC@GetMethods +!---------------------------------------------------------------------------- + +!> authors: Vikas Sharma, Ph. D. +! date: 2022-04-27 +! update: 2023-09-10 +! summary: Get dirichlet boundary conditions to the vector of pointer + +INTERFACE GetNitscheBCPointer + MODULE FUNCTION bc_GetNitscheBCPointer(dbc, dbcNo) RESULT(ans) + CLASS(NitscheBCPointer_), INTENT(IN) :: dbc(:) + INTEGER(I4B), INTENT(IN) :: dbcNo + !! Nitsche boundary nunber + CLASS(NitscheBC_), POINTER :: ans + END FUNCTION bc_GetNitscheBCPointer +END INTERFACE GetNitscheBCPointer + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/Polynomial2D/src/Polynomial2D_Class.F90 b/src/modules/Polynomial2D/src/Polynomial2D_Class.F90 index 0aa2e484d..63a8a3d30 100755 --- a/src/modules/Polynomial2D/src/Polynomial2D_Class.F90 +++ b/src/modules/Polynomial2D/src/Polynomial2D_Class.F90 @@ -45,7 +45,7 @@ MODULE Polynomial2D_Class !! @ConstructorMethods !! PROCEDURE, PUBLIC, PASS(obj) :: Initiate => func_Initiate - PROCEDURE, PUBLIC, PASS(obj) :: Deallocate => func_Deallocate + PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => func_Deallocate FINAL :: func_Final !! !! @GetMethods @@ -231,9 +231,9 @@ MODULE PURE SUBROUTINE func_Initiate(obj, coeff, degree, varname1, varname2) !! coefficients INTEGER(I4B), INTENT(IN) :: degree(:, :) !! degrees of x and y - CHARACTER(LEN=*), INTENT(IN) :: varname1 + CHARACTER(*), INTENT(IN) :: varname1 !! variable x - CHARACTER(LEN=*), INTENT(IN) :: varname2 + CHARACTER(*), INTENT(IN) :: varname2 !! variable y END SUBROUTINE func_Initiate END INTERFACE @@ -257,9 +257,9 @@ MODULE PURE FUNCTION func_Polynomial2D1(coeff, degree, varname1, varname2) & !! coefficients INTEGER(I4B), INTENT(IN) :: degree(:, :) !! degrees of x and y - CHARACTER(LEN=*), INTENT(IN) :: varname1 + CHARACTER(*), INTENT(IN) :: varname1 !! variable x - CHARACTER(LEN=*), INTENT(IN) :: varname2 + CHARACTER(*), INTENT(IN) :: varname2 !! variable y TYPE(Polynomial2D_) :: ans END FUNCTION func_Polynomial2D1 @@ -286,9 +286,9 @@ MODULE FUNCTION func_Polynomial2D_Pointer1(coeff, degree, varname1,& !! coefficients INTEGER(I4B), INTENT(IN) :: degree(:, :) !! degree of x and y - CHARACTER(LEN=*), INTENT(IN) :: varname1 + CHARACTER(*), INTENT(IN) :: varname1 !! x - CHARACTER(LEN=*), INTENT(IN) :: varname2 + CHARACTER(*), INTENT(IN) :: varname2 !! y CLASS(Polynomial2D_), POINTER :: ans END FUNCTION func_Polynomial2D_Pointer1 @@ -485,7 +485,7 @@ END FUNCTION func_GetOrder INTERFACE MODULE SUBROUTINE func_Display(obj, msg, unitno) CLASS(Polynomial2D_), INTENT(IN) :: obj - CHARACTER(LEN=*), INTENT(IN) :: msg + CHARACTER(*), INTENT(IN) :: msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno END SUBROUTINE func_Display END INTERFACE diff --git a/src/modules/RefElement/src/AbstractRefElement_Class.F90 b/src/modules/RefElement/src/AbstractRefElement_Class.F90 index 35bc1f144..1fec41686 100644 --- a/src/modules/RefElement/src/AbstractRefElement_Class.F90 +++ b/src/modules/RefElement/src/AbstractRefElement_Class.F90 @@ -17,16 +17,22 @@ !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: AbstractRefElement Class is implemented +! summary: AbstractRefElement Class is implemented MODULE AbstractRefElement_Class USE GlobalData +USE BaseType, ONLY: BaseInterpolation_, BaseContinuity_, & +& ReferenceElement_, ReferenceTopology_ USE String_Class, ONLY: String -USE Topology_Class +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "AbstractRefElement_Class" +PUBLIC :: AbstractRefElement_ +PUBLIC :: AbstractRefElementPointer_ +PUBLIC :: Display + !---------------------------------------------------------------------------- ! AbstractRefElement_ !---------------------------------------------------------------------------- @@ -36,65 +42,60 @@ MODULE AbstractRefElement_Class ! update: 18 Aug 2022 ! summary: AbstractRefElement class is defined ! -!{!pages/AbstractRefElement_.md!} +!{!pages/docs-api/AbstractRefElement/AbstractRefElement_.md!} TYPE, ABSTRACT :: AbstractRefElement_ PRIVATE - REAL(DFP), ALLOCATABLE :: xij(:, :) - !! Nodal coordinates - INTEGER(I4B) :: entityCounts(4) = 0_I4B - !! Number of 0D, 1D, 2D, 3D subentities in the reference element - INTEGER(I4B) :: xiDimension = -1_I4B - !! Xidimension elemType - !! 0 is for point - !! 1 is for line - !! 2 is for surface - !! 3 is for volume - INTEGER(I4B) :: name = -1_I4B - !! name of the element + TYPE(ReferenceElement_) :: refelem TYPE(String) :: nameStr !! name of the element - INTEGER(I4B) :: nsd = -1_I4B - !! Number of spatial dimensions - TYPE(Topology_), PUBLIC, ALLOCATABLE :: pointTopology(:) - !! Topology information of points - TYPE(Topology_), PUBLIC, ALLOCATABLE :: edgeTopology(:) - !! Topology information of edges - TYPE(Topology_), PUBLIC, ALLOCATABLE :: faceTopology(:) - !! Topology information of facet - TYPE(Topology_), PUBLIC, ALLOCATABLE :: cellTopology(:) - !! Topology information of cells - !! + CLASS(BaseContinuity_), ALLOCATABLE :: baseContinuity + !! continuity or conformity of basis defined on reference + !! element, following values are allowed + !! H1, HCurl, HDiv, DG + CLASS(BaseInterpolation_), ALLOCATABLE :: baseInterpolation + !! Type of basis functions used for interpolation on reference + !! element, Following values are allowed + !! LagrangeInterpolation + !! HermitInterpolation + !! SerendipityInterpolation + !! HierarchyInterpolation + !! OrthogonalInterpolation CONTAINS - !! - !! @DeferredMethods - !! + + ! @DeferredMethods + PROCEDURE(refelem_RefCoord), DEFERRED, PUBLIC, PASS(obj) :: & + & RefCoord + !! Reference coordiante of elements + !! It depends upon the basis type and basis continuity PROCEDURE(refelem_GetName), DEFERRED, PUBLIC, PASS(obj) :: & & GetName !! returns the name PROCEDURE(refelem_GetFacetElements), DEFERRED, PUBLIC, PASS(obj) :: & & GetFacetElements !! returns the facet elements - PROCEDURE(refelem_GenerateTopology), DEFERRED, PUBLIC, PASS(obj) :: & - & GenerateTopology - !! Get the vector of topology of facet elements PROCEDURE, PUBLIC, PASS(obj) :: Initiate => refelem_Initiate !! Initiate an instance PROCEDURE, PUBLIC, PASS(obj) :: GetTopology => refelem_GetTopology - !! Get the vector of topology of facet elements + !! Get the vector of topology of reference element PROCEDURE, PUBLIC, PASS(obj) :: Copy => refelem_Copy - !! Initiate an instance by copy + !! Initiate an instance by copying a reference element GENERIC, PUBLIC :: ASSIGNMENT(=) => Copy + !! Assignment operator PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => refelem_Deallocate !! Deallocate the data PROCEDURE, PUBLIC, PASS(obj) :: Display => refelem_Display !! Display the contents + PROCEDURE, PUBLIC, PASS(obj) :: MdEncode => refelem_MdEncode + !! Display the contents + PROCEDURE, PUBLIC, PASS(obj) :: ReactEncode => refelem_ReactEncode + !! Display the contents in react components PROCEDURE, PUBLIC, PASS(obj) :: GetNNE => refelem_GetNNE !! Returns the number of nodes in the element PROCEDURE, PUBLIC, PASS(obj) :: GetNSD => refelem_GetNSD - !! Returns the xidimension + !! Returns the spatial dimension of reference element PROCEDURE, PUBLIC, PASS(obj) :: GetXidimension => refelem_GetXidimension - !! Returns the xidimension + !! Returns the xidimension of reference element PROCEDURE, PUBLIC, PASS(obj) :: GetElementTopology => & & refelem_GetElementTopology !! Returns the element topology @@ -112,10 +113,10 @@ MODULE AbstractRefElement_Class & refelem_GetInterpolationPoint PROCEDURE, PUBLIC, PASS(obj) :: SetParam => refelem_SetParam !! Set the parameter at once + PROCEDURE, PUBLIC, PASS(obj) :: GetParam => refelem_GetParam + !! Set the parameter at once END TYPE AbstractRefElement_ -PUBLIC :: AbstractRefElement_ - !---------------------------------------------------------------------------- ! AbstractRefElementPointer_ !---------------------------------------------------------------------------- @@ -124,7 +125,23 @@ MODULE AbstractRefElement_Class CLASS(AbstractRefElement_), POINTER :: ptr => NULL() END TYPE AbstractRefElementPointer_ -PUBLIC :: AbstractRefElementPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +ABSTRACT INTERFACE + FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) RESULT(ans) + IMPORT AbstractRefElement_, I4B, DFP + CLASS(AbstractRefElement_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -168,22 +185,6 @@ SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GetFacetTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! update: 25 July 2022 -! summary: Generate topology of the element - -ABSTRACT INTERFACE - SUBROUTINE refelem_GenerateTopology(obj) - IMPORT AbstractRefElement_, Topology_ - CLASS(AbstractRefElement_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! Initiate@Methods !---------------------------------------------------------------------------- @@ -193,9 +194,41 @@ END SUBROUTINE refelem_GenerateTopology ! summary: Initiate the instance of Reference element INTERFACE - MODULE SUBROUTINE refelem_Initiate(obj, nsd) + MODULE SUBROUTINE refelem_Initiate( & + & obj, & + & nsd, & + & baseContinuity, & + & baseInterpolation, & + & xij) CLASS(AbstractRefElement_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: nsd + !! Spatial dimension of element + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseContinuity + !! Continuity or Conformity of basis function. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! H1 * Default + !! HDiv + !! HCurl + !! DG + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseInterpolation + !! Basis function family used for interpolation. + !! This parameter is used to determine the nodal coordinates of + !! reference element, when xij is not present. + !! If xij is present then this parameter is ignored + !! LagrangeInterpolation, LagrangePolynomial + !! SerendipityInterpolation, SerendipityPolynomial + !! HierarchyInterpolation, HierarchyPolynomial + !! OrthogonalInterpolation, OrthogonalPolynomial + !! HermitInterpolation, HermitPolynomial + REAL(DFP), OPTIONAL, INTENT(IN) :: xij(:, :) + !! Nodal coordiantes of reference element + !! The number of rows in xij are nsd. + !! The rows cooresponds to the x , y, and z components + !! The columns denotes the nodal point + !! If xij is present then baseContinuity and + !! baseInterpolation are ignored. END SUBROUTINE refelem_Initiate END INTERFACE @@ -215,7 +248,7 @@ END SUBROUTINE refelem_Initiate MODULE PURE FUNCTION refelem_GetTopology(obj, xidim) RESULT(ans) CLASS(AbstractRefElement_), INTENT(IN) :: obj INTEGER(I4B), OPTIONAL, INTENT(IN) :: xidim - TYPE(Topology_), ALLOCATABLE :: ans(:) + TYPE(ReferenceTopology_), ALLOCATABLE :: ans(:) END FUNCTION refelem_GetTopology END INTERFACE @@ -234,7 +267,7 @@ END FUNCTION refelem_GetTopology ! type opertions INTERFACE - MODULE PURE SUBROUTINE refelem_Copy(obj, obj2) + MODULE SUBROUTINE refelem_Copy(obj, obj2) CLASS(AbstractRefElement_), INTENT(INOUT) :: obj CLASS(AbstractRefElement_), INTENT(IN) :: obj2 END SUBROUTINE refelem_Copy @@ -280,7 +313,35 @@ END SUBROUTINE refelem_Display MODULE PROCEDURE refelem_Display END INTERFACE Display -PUBLIC :: Display +!---------------------------------------------------------------------------- +! MdEncode@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the contents in mardown format + +INTERFACE + MODULE FUNCTION refelem_MdEncode(obj) RESULT(ans) + CLASS(AbstractRefElement_), INTENT(IN) :: obj + TYPE(String) :: ans + END FUNCTION refelem_MdEncode +END INTERFACE + +!---------------------------------------------------------------------------- +! ReactEncode@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 20 May 2022 +! summary: Display the reference elements in react components + +INTERFACE + MODULE FUNCTION refelem_ReactEncode(obj) RESULT(ans) + CLASS(AbstractRefElement_), INTENT(IN) :: obj + TYPE(String) :: ans + END FUNCTION refelem_ReactEncode +END INTERFACE !---------------------------------------------------------------------------- ! NNE@Methods @@ -408,7 +469,7 @@ END FUNCTION refelem_GetNodeCoord INTERFACE MODULE FUNCTION refelem_GetInterpolationPoint(obj, order, ipType, layout) & - & RESULT(ans) + & RESULT(ans) CLASS(AbstractRefElement_), INTENT(IN) :: obj INTEGER(I4B), INTENT(IN) :: order INTEGER(I4B), OPTIONAL, INTENT(IN) :: ipType @@ -421,11 +482,23 @@ END FUNCTION refelem_GetInterpolationPoint ! SetParam@Methods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-08 +! summary: Set parameters of reference element + INTERFACE - MODULE PURE SUBROUTINE refelem_SetParam(& - & obj, xij, entityCounts, & - & xidimension, name, nameStr, nsd, & - & pointTopology, edgeTopology, faceTopology, cellTopology) + MODULE SUBROUTINE refelem_SetParam(& + & obj, & + & xij, & + & entityCounts, & + & xidimension, & + & name, & + & nameStr, & + & nsd, & + & topology, & + & baseContinuity, & + & baseInterpolation, & + & refelem) CLASS(AbstractRefElement_), INTENT(INOUT) :: obj REAL(DFP), OPTIONAL, INTENT(IN) :: xij(:, :) INTEGER(I4B), OPTIONAL, INTENT(IN) :: entityCounts(4) @@ -433,13 +506,77 @@ MODULE PURE SUBROUTINE refelem_SetParam(& INTEGER(I4B), OPTIONAL, INTENT(IN) :: name CHARACTER(*), OPTIONAL, INTENT(IN) :: nameStr INTEGER(I4B), OPTIONAL, INTENT(IN) :: nsd - TYPE(Topology_), OPTIONAL, INTENT(IN) :: pointTopology(:) - TYPE(Topology_), OPTIONAL, INTENT(IN) :: edgeTopology(:) - TYPE(Topology_), OPTIONAL, INTENT(IN) :: faceTopology(:) - TYPE(Topology_), OPTIONAL, INTENT(IN) :: cellTopology(:) + TYPE(ReferenceTopology_), OPTIONAL, INTENT(IN) :: topology(:) + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseContinuity + !! Continuity or Conformity of basis function. + !! H1 * Default + !! HDiv + !! HCurl + !! DG + CHARACTER(*), OPTIONAL, INTENT(IN) :: baseInterpolation + !! Basis function family used for interpolation + !! LagrangeInterpolation, LagrangePolynomial + !! SerendipityInterpolation, SerendipityPolynomial + !! HierarchyInterpolation, HierarchyPolynomial + !! OrthogonalInterpolation, OrthogonalPolynomial + !! HermitInterpolation, HermitPolynomial + TYPE(ReferenceElement_), OPTIONAL, INTENT(IN) :: refelem END SUBROUTINE refelem_SetParam END INTERFACE +!---------------------------------------------------------------------------- +! GetParam@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-08 +! summary: Get parameters of reference element + +INTERFACE + MODULE SUBROUTINE refelem_GetParam(& + & obj, & + & xij, & + & entityCounts, & + & xidimension, & + & name, & + & nameStr, & + & nsd, & + & topology, & + & baseContinuity, & + & baseInterpolation, & + & refelem) + CLASS(AbstractRefElement_), INTENT(IN) :: obj + REAL(DFP), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: xij(:, :) + !! Nodal coordiantes of reference element + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: entityCounts(4) + !! Entity counts 0D to 3D + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: xidimension + !! xi dimension of element + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: name + !! name of element + TYPE(String), OPTIONAL, INTENT(OUT) :: nameStr + !! string name of element + INTEGER(I4B), OPTIONAL, INTENT(OUT) :: nsd + !! spatial dimension of element + TYPE(ReferenceTopology_), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: topology(:) + !! vector of point topology + TYPE(String), OPTIONAL, INTENT(OUT) :: baseContinuity + !! Continuity or Conformity of basis function. + !! H1 * Default + !! HDiv + !! HCurl + !! DG + TYPE(String), OPTIONAL, INTENT(OUT) :: baseInterpolation + !! Basis function family used for interpolation + !! LagrangeInterpolation, LagrangePolynomial + !! SerendipityInterpolation, SerendipityPolynomial + !! HierarchyInterpolation, HierarchyPolynomial + !! OrthogonalInterpolation, OrthogonalPolynomial + !! HermitInterpolation, HermitPolynomial + TYPE(ReferenceElement_), OPTIONAL, INTENT(OUT) :: refelem + END SUBROUTINE refelem_GetParam +END INTERFACE + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefHexahedron_Class.F90 b/src/modules/RefElement/src/RefHexahedron_Class.F90 index 565af7b97..aaaa985e2 100644 --- a/src/modules/RefElement/src/RefHexahedron_Class.F90 +++ b/src/modules/RefElement/src/RefHexahedron_Class.F90 @@ -17,7 +17,7 @@ !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: Reference element for point is implemented +! summary: Reference element for hexahedron is implemented MODULE RefHexahedron_Class USE GlobalData @@ -25,7 +25,9 @@ MODULE RefHexahedron_Class USE AbstractRefElement_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefHexahedron_Class" +CHARACTER(*), PARAMETER :: modName = "RefHexahedron_Class" +PUBLIC :: RefHexahedron_ +PUBLIC :: RefHexahedronPointer_ !---------------------------------------------------------------------------- ! RefHexahedron_ @@ -35,7 +37,7 @@ MODULE RefHexahedron_Class ! date: 9 Aug 2022 ! summary: RefHexahedron class is defined ! -!{!pages/RefHexahedron_.md!} +!{!pages/docs-api/RefHexahedron/RefHexahedron_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefHexahedron_ CONTAINS @@ -44,13 +46,10 @@ MODULE RefHexahedron_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefHexahedron_ -PUBLIC :: RefHexahedron_ - !---------------------------------------------------------------------------- ! RefHexahedronPointer_ !---------------------------------------------------------------------------- @@ -59,7 +58,23 @@ MODULE RefHexahedron_Class CLASS(RefHexahedron_), POINTER :: ptr => NULL() END TYPE RefHexahedronPointer_ -PUBLIC :: RefHexahedronPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefHexahedron_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -83,10 +98,6 @@ END FUNCTION refelem_GetName !> author: Vikas Sharma, Ph. D. ! date: 16 June 2021 ! summary: This routine returns the facet elements -! -!# Introduction -! -! Returns the facet elements. INTERFACE MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) @@ -95,21 +106,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefHexahedron_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefLine_Class.F90 b/src/modules/RefElement/src/RefLine_Class.F90 index f3880b9d6..b25709fae 100644 --- a/src/modules/RefElement/src/RefLine_Class.F90 +++ b/src/modules/RefElement/src/RefLine_Class.F90 @@ -23,9 +23,12 @@ MODULE RefLine_Class USE GlobalData USE Topology_Class USE AbstractRefElement_Class +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefLine_Class" +CHARACTER(*), PARAMETER :: modName = "RefLine_Class" +PUBLIC :: RefLine_ +PUBLIC :: RefLinePointer_ !---------------------------------------------------------------------------- ! RefLine_ @@ -35,7 +38,7 @@ MODULE RefLine_Class ! date: 9 Aug 2022 ! summary: RefLine class is defined ! -!{!pages/RefLine_.md!} +!{!pages/docs-api/RefLine/RefLine_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefLine_ CONTAINS @@ -44,22 +47,39 @@ MODULE RefLine_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefLine_ -PUBLIC :: RefLine_ - !---------------------------------------------------------------------------- ! RefLinePointer_ !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-08 +! summary: Rererence Line Pointer + TYPE :: RefLinePointer_ CLASS(RefLine_), POINTER :: ptr => NULL() END TYPE RefLinePointer_ -PUBLIC :: RefLinePointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefLine_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -86,7 +106,7 @@ END FUNCTION refelem_GetName ! !# Introduction ! -! Returns the facet elements. +! The facet elements in the case of line are points. INTERFACE MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) @@ -95,21 +115,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefLine_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefPoint_Class.F90 b/src/modules/RefElement/src/RefPoint_Class.F90 index 0fb731a57..e94a7a3c0 100644 --- a/src/modules/RefElement/src/RefPoint_Class.F90 +++ b/src/modules/RefElement/src/RefPoint_Class.F90 @@ -25,7 +25,9 @@ MODULE RefPoint_Class USE AbstractRefElement_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefPoint_Class" +CHARACTER(*), PARAMETER :: modName = "RefPoint_Class" +PUBLIC :: RefPointPointer_ +PUBLIC :: RefPoint_ !---------------------------------------------------------------------------- ! RefPoint_ @@ -35,7 +37,7 @@ MODULE RefPoint_Class ! date: 9 Aug 2022 ! summary: RefPoint class is defined ! -!{!pages/RefPoint_.md!} +!{!pages/docs-api/RefPoint/RefPoint_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefPoint_ CONTAINS @@ -44,13 +46,10 @@ MODULE RefPoint_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefPoint_ -PUBLIC :: RefPoint_ - !---------------------------------------------------------------------------- ! RefPointPointer_ !---------------------------------------------------------------------------- @@ -59,7 +58,23 @@ MODULE RefPoint_Class CLASS(RefPoint_), POINTER :: ptr => NULL() END TYPE RefPointPointer_ -PUBLIC :: RefPointPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefPoint_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -91,21 +106,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefPoint_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefPrism_Class.F90 b/src/modules/RefElement/src/RefPrism_Class.F90 index 4ab03ee6e..b5c1ad838 100644 --- a/src/modules/RefElement/src/RefPrism_Class.F90 +++ b/src/modules/RefElement/src/RefPrism_Class.F90 @@ -23,9 +23,12 @@ MODULE RefPrism_Class USE GlobalData USE Topology_Class USE AbstractRefElement_Class +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefPrism_Class" +CHARACTER(*), PARAMETER :: modName = "RefPrism_Class" +PUBLIC :: RefPrism_ +PUBLIC :: RefPrismPointer_ !---------------------------------------------------------------------------- ! RefPrism_ @@ -35,7 +38,7 @@ MODULE RefPrism_Class ! date: 9 Aug 2022 ! summary: RefPrism class is defined ! -!{!pages/RefPrism_.md!} +!{!pages/docs-api/RefPrism/RefPrism_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefPrism_ CONTAINS @@ -44,13 +47,10 @@ MODULE RefPrism_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefPrism_ -PUBLIC :: RefPrism_ - !---------------------------------------------------------------------------- ! RefPrismPointer_ !---------------------------------------------------------------------------- @@ -59,7 +59,23 @@ MODULE RefPrism_Class CLASS(RefPrism_), POINTER :: ptr => NULL() END TYPE RefPrismPointer_ -PUBLIC :: RefPrismPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefPrism_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -95,21 +111,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefPrism_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefPyramid_Class.F90 b/src/modules/RefElement/src/RefPyramid_Class.F90 index 9af4c2514..e2b363afe 100644 --- a/src/modules/RefElement/src/RefPyramid_Class.F90 +++ b/src/modules/RefElement/src/RefPyramid_Class.F90 @@ -23,9 +23,12 @@ MODULE RefPyramid_Class USE GlobalData USE Topology_Class USE AbstractRefElement_Class +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefPyramid_Class" +CHARACTER(*), PARAMETER :: modName = "RefPyramid_Class" +PUBLIC :: RefPyramidPointer_ +PUBLIC :: RefPyramid_ !---------------------------------------------------------------------------- ! RefPyramid_ @@ -35,7 +38,7 @@ MODULE RefPyramid_Class ! date: 9 Aug 2022 ! summary: RefPyramid class is defined ! -!{!pages/RefPyramid_.md!} +!{!pages/docs-api/RefPyramid/RefPyramid_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefPyramid_ CONTAINS @@ -44,13 +47,10 @@ MODULE RefPyramid_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefPyramid_ -PUBLIC :: RefPyramid_ - !---------------------------------------------------------------------------- ! RefPyramidPointer_ !---------------------------------------------------------------------------- @@ -59,7 +59,23 @@ MODULE RefPyramid_Class CLASS(RefPyramid_), POINTER :: ptr => NULL() END TYPE RefPyramidPointer_ -PUBLIC :: RefPyramidPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefPyramid_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -95,21 +111,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefPyramid_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefQuadrangle_Class.F90 b/src/modules/RefElement/src/RefQuadrangle_Class.F90 index 72c51492e..fc223054e 100644 --- a/src/modules/RefElement/src/RefQuadrangle_Class.F90 +++ b/src/modules/RefElement/src/RefQuadrangle_Class.F90 @@ -17,7 +17,7 @@ !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: Reference element for point is implemented +! summary: Reference element for quadrangle MODULE RefQuadrangle_Class USE GlobalData @@ -25,7 +25,9 @@ MODULE RefQuadrangle_Class USE AbstractRefElement_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefQuadrangle_Class" +CHARACTER(*), PARAMETER :: modName = "RefQuadrangle_Class" +PUBLIC :: RefQuadrangle_ +PUBLIC :: RefQuadranglePointer_ !---------------------------------------------------------------------------- ! RefQuadrangle_ @@ -35,7 +37,7 @@ MODULE RefQuadrangle_Class ! date: 9 Aug 2022 ! summary: RefQuadrangle class is defined ! -!{!pages/RefQuadrangle_.md!} +!{!pages/docs-api/RefQuadrangle/RefQuadrangle_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefQuadrangle_ CONTAINS @@ -44,13 +46,10 @@ MODULE RefQuadrangle_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefQuadrangle_ -PUBLIC :: RefQuadrangle_ - !---------------------------------------------------------------------------- ! RefQuadranglePointer_ !---------------------------------------------------------------------------- @@ -59,7 +58,23 @@ MODULE RefQuadrangle_Class CLASS(RefQuadrangle_), POINTER :: ptr => NULL() END TYPE RefQuadranglePointer_ -PUBLIC :: RefQuadranglePointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefQuadrangle_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -95,21 +110,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefQuadrangle_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefTetrahedron_Class.F90 b/src/modules/RefElement/src/RefTetrahedron_Class.F90 index 2f8e8d4b7..5577d30ac 100644 --- a/src/modules/RefElement/src/RefTetrahedron_Class.F90 +++ b/src/modules/RefElement/src/RefTetrahedron_Class.F90 @@ -17,15 +17,18 @@ !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: Reference element for point is implemented +! summary: Reference element for tetrahedron is implemented MODULE RefTetrahedron_Class USE GlobalData USE Topology_Class USE AbstractRefElement_Class +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefTetrahedron_Class" +CHARACTER(*), PARAMETER :: modName = "RefTetrahedron_Class" +PUBLIC :: RefTetrahedron_ +PUBLIC :: RefTetrahedronPointer_ !---------------------------------------------------------------------------- ! RefTetrahedron_ @@ -35,7 +38,7 @@ MODULE RefTetrahedron_Class ! date: 9 Aug 2022 ! summary: RefTetrahedron class is defined ! -!{!pages/RefTetrahedron_.md!} +!{!pages/docs-api/RefTetrahedron/RefTetrahedron_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefTetrahedron_ CONTAINS @@ -44,13 +47,10 @@ MODULE RefTetrahedron_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefTetrahedron_ -PUBLIC :: RefTetrahedron_ - !---------------------------------------------------------------------------- ! RefTetrahedronPointer_ !---------------------------------------------------------------------------- @@ -59,7 +59,23 @@ MODULE RefTetrahedron_Class CLASS(RefTetrahedron_), POINTER :: ptr => NULL() END TYPE RefTetrahedronPointer_ -PUBLIC :: RefTetrahedronPointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefTetrahedron_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -95,21 +111,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefTetrahedron_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/RefTriangle_Class.F90 b/src/modules/RefElement/src/RefTriangle_Class.F90 index 93412a9bc..030e78dc9 100644 --- a/src/modules/RefElement/src/RefTriangle_Class.F90 +++ b/src/modules/RefElement/src/RefTriangle_Class.F90 @@ -17,7 +17,7 @@ !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: Reference element for point is implemented +! summary: Reference element for triangle MODULE RefTriangle_Class USE GlobalData @@ -25,7 +25,9 @@ MODULE RefTriangle_Class USE AbstractRefElement_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "RefTriangle_Class" +CHARACTER(*), PARAMETER :: modName = "RefTriangle_Class" +PUBLIC :: RefTriangle_ +PUBLIC :: RefTrianglePointer_ !---------------------------------------------------------------------------- ! RefTriangle_ @@ -33,9 +35,9 @@ MODULE RefTriangle_Class !> author: Vikas Sharma, Ph. D. ! date: 9 Aug 2022 -! summary: RefTriangle class is defined +! summary: RefTriangle class is defined ! -!{!pages/RefTriangle_.md!} +!{!pages/docs-api/RefTriangle/RefTriangle_.md!} TYPE, EXTENDS(AbstractRefElement_) :: RefTriangle_ CONTAINS @@ -44,13 +46,10 @@ MODULE RefTriangle_Class PROCEDURE, PUBLIC, PASS(obj) :: GetFacetElements => & & refelem_GetFacetElements !! Returns the facet elements - PROCEDURE, PUBLIC, PASS(obj) :: GenerateTopology => & - & refelem_GenerateTopology - !! returns the facet topology + PROCEDURE, PUBLIC, PASS(obj) :: RefCoord => refelem_RefCoord + !! returns coordiantes of linear reference elements END TYPE RefTriangle_ -PUBLIC :: RefTriangle_ - !---------------------------------------------------------------------------- ! RefTrianglePointer_ !---------------------------------------------------------------------------- @@ -59,7 +58,23 @@ MODULE RefTriangle_Class CLASS(RefTriangle_), POINTER :: ptr => NULL() END TYPE RefTrianglePointer_ -PUBLIC :: RefTrianglePointer_ +!---------------------------------------------------------------------------- +! RefCoord@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-08-09 +! summary: Return the reference coordiante of linear element + +INTERFACE + MODULE FUNCTION refelem_RefCoord(obj, baseInterpolation, baseContinuity) & + & RESULT(ans) + CLASS(RefTriangle_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: baseInterpolation + CHARACTER(*), INTENT(IN) :: baseContinuity + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION refelem_RefCoord +END INTERFACE !---------------------------------------------------------------------------- ! GetName@Methods @@ -95,21 +110,6 @@ MODULE SUBROUTINE refelem_GetFacetElements(obj, ans) END SUBROUTINE refelem_GetFacetElements END INTERFACE -!---------------------------------------------------------------------------- -! GenerateTopology@Methods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 16 June 2022 -! summary: Generate topology of reference element -! - -INTERFACE - MODULE SUBROUTINE refelem_GenerateTopology(obj) - CLASS(RefTriangle_), INTENT(INOUT) :: obj - END SUBROUTINE refelem_GenerateTopology -END INTERFACE - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/RefElement/src/Topology_Class.F90 b/src/modules/RefElement/src/Topology_Class.F90 index 216f14c62..49780b47a 100644 --- a/src/modules/RefElement/src/Topology_Class.F90 +++ b/src/modules/RefElement/src/Topology_Class.F90 @@ -21,6 +21,7 @@ MODULE Topology_Class USE GlobalData +USE String_Class, ONLY: String IMPLICIT NONE PRIVATE @@ -32,22 +33,27 @@ MODULE Topology_Class ! date: 9 Aug 2022 ! summary: Topology class is defined ! -!{!pages/Topology_.md!} +!{!pages/docs-api/Topology/Topology_.md!} TYPE :: Topology_ PRIVATE INTEGER(I4B), ALLOCATABLE :: nptrs(:) + !! node numbers INTEGER(I4B) :: name = 0 + !! name of topology INTEGER(I4B) :: xiDimension = 0 + !! xidimension !! CONTAINS !! PROCEDURE, PUBLIC, PASS(obj) :: Initiate => topo_Initiate !! Initiate the topology object - PROCEDURE, PUBLIC, PASS(obj) :: Deallocate => obj_Deallocate + PROCEDURE, PUBLIC, PASS(obj) :: DEALLOCATE => obj_Deallocate !! Deallocate the topology object PROCEDURE, PUBLIC, PASS(obj) :: Display => obj_Display !! Display the content + PROCEDURE, PUBLIC, PASS(obj) :: MdEncode => obj_MdEncode + !! Display the content PROCEDURE, PUBLIC, PASS(obj) :: GetNptrs => obj_GetNptrs !! Get the nptrs PROCEDURE, PUBLIC, PASS(obj) :: GetName => obj_GetName @@ -112,11 +118,26 @@ END SUBROUTINE obj_Deallocate INTERFACE MODULE SUBROUTINE obj_Display(obj, msg, unitno) CLASS(Topology_), INTENT(IN) :: obj - CHARACTER(LEN=*), INTENT(IN) :: msg + CHARACTER(*), INTENT(IN) :: msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno END SUBROUTINE obj_Display END INTERFACE +!---------------------------------------------------------------------------- +! Display@Methods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 9 Aug 2022 +! summary: Display the contents + +INTERFACE + MODULE FUNCTION obj_MdEncode(obj) RESULT(ans) + CLASS(Topology_), INTENT(IN) :: obj + TYPE(String) :: ans + END FUNCTION obj_MdEncode +END INTERFACE + !---------------------------------------------------------------------------- ! GetNptrs@Methods !---------------------------------------------------------------------------- diff --git a/src/modules/STScalarMeshField/src/STScalarMeshField_Class.F90 b/src/modules/STScalarMeshField/src/STScalarMeshField_Class.F90 index 3c8c4c401..7dab565a9 100644 --- a/src/modules/STScalarMeshField/src/STScalarMeshField_Class.F90 +++ b/src/modules/STScalarMeshField/src/STScalarMeshField_Class.F90 @@ -26,6 +26,7 @@ MODULE STScalarMeshField_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "STScalarMeshField_Class" +PUBLIC :: DEALLOCATE !---------------------------------------------------------------------------- ! STScalarMeshField_Class @@ -115,4 +116,32 @@ MODULE SUBROUTINE aField_Initiate1(obj, param, mesh) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(STScalarMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(STScalarMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + END MODULE STScalarMeshField_Class diff --git a/src/modules/STTensorMeshField/src/STTensorMeshField_Class.F90 b/src/modules/STTensorMeshField/src/STTensorMeshField_Class.F90 index 355e34282..8adf38639 100644 --- a/src/modules/STTensorMeshField/src/STTensorMeshField_Class.F90 +++ b/src/modules/STTensorMeshField/src/STTensorMeshField_Class.F90 @@ -26,6 +26,10 @@ MODULE STTensorMeshField_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "STTensorMeshField_Class" +PUBLIC :: DEALLOCATE +PUBLIC :: STTensorMeshField_ +PUBLIC :: STTensorMeshFieldPointer_ +PUBLIC :: SetSTTensorMeshFieldParam !---------------------------------------------------------------------------- ! STTensorMeshField_Class @@ -45,8 +49,6 @@ MODULE STTensorMeshField_Class !! Initiate the field by reading param and a given mesh END TYPE STTensorMeshField_ -PUBLIC :: STTensorMeshField_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -55,8 +57,6 @@ MODULE STTensorMeshField_Class CLASS(STTensorMeshField_), POINTER :: ptr => NULL() END TYPE STTensorMeshFieldPointer_ -PUBLIC :: STTensorMeshFieldPointer_ - !---------------------------------------------------------------------------- ! setAbstractMeshFieldParam@ConstructorMethods !---------------------------------------------------------------------------- @@ -83,8 +83,6 @@ MODULE SUBROUTINE SetSTTensorMeshFieldParam(param, name, & END SUBROUTINE SetSTTensorMeshFieldParam END INTERFACE -PUBLIC :: SetSTTensorMeshFieldParam - !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods !---------------------------------------------------------------------------- @@ -116,4 +114,32 @@ MODULE SUBROUTINE aField_Initiate1(obj, param, mesh) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(STTensorMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(STTensorMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + END MODULE STTensorMeshField_Class diff --git a/src/modules/STVectorMeshField/src/STVectorMeshField_Class.F90 b/src/modules/STVectorMeshField/src/STVectorMeshField_Class.F90 index c87c57362..41755d0b0 100644 --- a/src/modules/STVectorMeshField/src/STVectorMeshField_Class.F90 +++ b/src/modules/STVectorMeshField/src/STVectorMeshField_Class.F90 @@ -17,7 +17,7 @@ MODULE STVectorMeshField_Class USE GlobalData -USE BaseType +USE BaSetype USE FPL, ONLY: ParameterList_ USE Mesh_Class, ONLY: Mesh_ USE ExceptionHandler_Class, ONLY: e @@ -25,7 +25,8 @@ MODULE STVectorMeshField_Class USE AbstractMeshField_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "STVectorMeshField_Class" +CHARACTER(*), PARAMETER :: modName = "STVectorMeshField_Class" +PUBLIC :: DEALLOCATE !---------------------------------------------------------------------------- ! STVectorMeshField_Class @@ -58,7 +59,7 @@ MODULE STVectorMeshField_Class PUBLIC :: STVectorMeshFieldPointer_ !---------------------------------------------------------------------------- -! setAbstractMeshFieldParam@ConstructorMethods +! SetAbstractMeshFieldParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -66,23 +67,23 @@ MODULE STVectorMeshField_Class ! summary: This routine check the essential parameters in param. INTERFACE - MODULE SUBROUTINE setSTVectorMeshFieldParam(param, name, & + MODULE SUBROUTINE SetSTVectorMeshFieldParam(param, name, & & fieldType, varType, engine, defineOn, spaceCompo, nns, nnt) TYPE(ParameterList_), INTENT(INOUT) :: param - CHARACTER(LEN=*), INTENT(IN) :: name + CHARACTER(*), INTENT(IN) :: name INTEGER(I4B), INTENT(IN) :: fieldType INTEGER(I4B), INTENT(IN) :: varType - CHARACTER(LEN=*), INTENT(IN) :: engine + CHARACTER(*), INTENT(IN) :: engine INTEGER(I4B), INTENT(IN) :: defineOn !! Nodal, Quadrature INTEGER(I4B), INTENT(IN) :: spaceCompo INTEGER(I4B), INTENT(IN) :: nns INTEGER(I4B), INTENT(IN) :: nnt !! Number of node in space - END SUBROUTINE setSTVectorMeshFieldParam + END SUBROUTINE SetSTVectorMeshFieldParam END INTERFACE -PUBLIC :: setSTVectorMeshFieldParam +PUBLIC :: SetSTVectorMeshFieldParam !---------------------------------------------------------------------------- ! checkEssentialParam@ConstructorMethods @@ -115,4 +116,32 @@ MODULE SUBROUTINE aField_Initiate1(obj, param, mesh) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(STVectorMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(STVectorMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + END MODULE STVectorMeshField_Class diff --git a/src/modules/ScalarField/src/ScalarField_Class.F90 b/src/modules/ScalarField/src/ScalarField_Class.F90 index 81fe7f539..38e6586c1 100644 --- a/src/modules/ScalarField/src/ScalarField_Class.F90 +++ b/src/modules/ScalarField/src/ScalarField_Class.F90 @@ -33,6 +33,14 @@ MODULE ScalarField_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "ScalarField_Class" CHARACTER(*), PARAMETER :: myprefix = "ScalarField" +PUBLIC :: ScalarField_ +PUBLIC :: ScalarFieldPointer_ +PUBLIC :: SetScalarFieldParam +PUBLIC :: sField_CheckEssentialParam +PUBLIC :: ScalarFieldInitiate1 +PUBLIC :: ScalarField +PUBLIC :: ScalarField_Pointer +PUBLIC :: ScalarFieldImport !---------------------------------------------------------------------------- ! ScalarField_ @@ -42,13 +50,13 @@ MODULE ScalarField_Class ! date: 25 June 2021 ! summary: Native vector type ! -!{!pages/ScalarField_.md} +!{!pages/docs-api/ScalarField/ScalarField_.md} TYPE, EXTENDS(AbstractNodeField_) :: ScalarField_ CONTAINS PRIVATE - PROCEDURE, PUBLIC, PASS(obj) :: checkEssentialParam => & - & sField_checkEssentialParam + PROCEDURE, PUBLIC, PASS(obj) :: CheckEssentialParam => & + & sField_CheckEssentialParam PROCEDURE, PUBLIC, PASS(obj) :: Initiate1 => sField_Initiate1 FINAL :: sField_Final PROCEDURE, PASS(obj) :: set1 => sField_set1 @@ -100,8 +108,8 @@ MODULE ScalarField_Class PROCEDURE, PUBLIC, PASS(obj) :: IMPORT => sField_Import END TYPE ScalarField_ -PUBLIC :: ScalarField_ -TYPE(ScalarField_), PARAMETER, PUBLIC :: TypeScalarField = ScalarField_(domains=NULL()) +TYPE(ScalarField_), PARAMETER, PUBLIC :: & + & TypeScalarField = ScalarField_(domains=NULL()) !---------------------------------------------------------------------------- ! ScalarFieldPointer_ @@ -111,8 +119,6 @@ MODULE ScalarField_Class CLASS(ScalarField_), POINTER :: ptr => NULL() END TYPE ScalarFieldPointer_ -PUBLIC :: ScalarFieldPointer_ - !---------------------------------------------------------------------------- ! setScalarFieldParam@Constructor !---------------------------------------------------------------------------- @@ -139,25 +145,21 @@ MODULE SUBROUTINE SetScalarFieldParam(param, name, engine, fieldType, comm, loca END SUBROUTINE SetScalarFieldParam END INTERFACE -PUBLIC :: SetScalarFieldParam - !---------------------------------------------------------------------------- -! checkEssentialParam@Constructor +! CheckEssentialParam@Constructor !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine check the essential parameters in param. +! summary: This routine Check the essential parameters in param. INTERFACE - MODULE SUBROUTINE sField_checkEssentialParam(obj, param) + MODULE SUBROUTINE sField_CheckEssentialParam(obj, param) CLASS(ScalarField_), INTENT(IN) :: obj TYPE(ParameterList_), INTENT(IN) :: param - END SUBROUTINE sField_checkEssentialParam + END SUBROUTINE sField_CheckEssentialParam END INTERFACE -PUBLIC :: sField_checkEssentialParam - !---------------------------------------------------------------------------- ! Initiate@Constructor !---------------------------------------------------------------------------- @@ -185,8 +187,6 @@ END SUBROUTINE sField_Initiate1 MODULE PROCEDURE sField_Initiate1 END INTERFACE ScalarFieldInitiate1 -PUBLIC :: ScalarFieldInitiate1 - !---------------------------------------------------------------------------- ! Final@Constructor !---------------------------------------------------------------------------- @@ -217,8 +217,6 @@ END FUNCTION sField_Constructor1 MODULE PROCEDURE sField_Constructor1 END INTERFACE ScalarField -PUBLIC :: ScalarField - !---------------------------------------------------------------------------- ! ScalarField_Pointer@Constructor !---------------------------------------------------------------------------- @@ -239,8 +237,6 @@ END FUNCTION sField_Constructor_1 MODULE PROCEDURE sField_Constructor_1 END INTERFACE ScalarField_Pointer -PUBLIC :: ScalarField_Pointer - !---------------------------------------------------------------------------- ! Import@IO !---------------------------------------------------------------------------- @@ -263,8 +259,6 @@ END SUBROUTINE sField_Import MODULE PROCEDURE sField_Import END INTERFACE ScalarFieldImport -PUBLIC :: ScalarFieldImport - !---------------------------------------------------------------------------- ! Set@SetMethods !---------------------------------------------------------------------------- diff --git a/src/modules/ScalarMeshField/src/ScalarMeshField_Class.F90 b/src/modules/ScalarMeshField/src/ScalarMeshField_Class.F90 index 787decffd..474b7834f 100644 --- a/src/modules/ScalarMeshField/src/ScalarMeshField_Class.F90 +++ b/src/modules/ScalarMeshField/src/ScalarMeshField_Class.F90 @@ -17,7 +17,7 @@ MODULE ScalarMeshField_Class USE GlobalData -USE BaseType +USE BaSetype USE FPL, ONLY: ParameterList_ USE Mesh_Class, ONLY: Mesh_ USE ExceptionHandler_Class, ONLY: e @@ -26,6 +26,10 @@ MODULE ScalarMeshField_Class IMPLICIT NONE PRIVATE CHARACTER(*), PARAMETER :: modName = "ScalarMeshField_Class" +PUBLIC :: ScalarMeshField_ +PUBLIC :: ScalarMeshFieldPointer_ +PUBLIC :: SetScalarMeshFieldParam +PUBLIC :: DEALLOCATE !---------------------------------------------------------------------------- ! ScalarMeshField_Class @@ -38,15 +42,13 @@ MODULE ScalarMeshField_Class TYPE, EXTENDS(AbstractMeshField_) :: ScalarMeshField_ CONTAINS PRIVATE - PROCEDURE, PUBLIC, PASS(obj) :: checkEssentialParam => & - & aField_checkEssentialParam - !! check essential parameters + PROCEDURE, PUBLIC, PASS(obj) :: CheckEssentialParam => & + & aField_CheckEssentialParam + !! Check essential parameters PROCEDURE, PASS(obj) :: Initiate1 => aField_Initiate1 !! Initiate the field by reading param and a given mesh END TYPE ScalarMeshField_ -PUBLIC :: ScalarMeshField_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -55,18 +57,44 @@ MODULE ScalarMeshField_Class CLASS(ScalarMeshField_), POINTER :: ptr => NULL() END TYPE ScalarMeshFieldPointer_ -PUBLIC :: ScalarMeshFieldPointer_ +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(ScalarMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE !---------------------------------------------------------------------------- -! setAbstractMeshFieldParam@ConstructorMethods +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(ScalarMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! SetAbstractMeshFieldParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 17 Feb 2022 -! summary: This routine check the essential parameters in param. +! summary: This routine Check the essential parameters in param. INTERFACE - MODULE SUBROUTINE setScalarMeshFieldParam(param, name, & + MODULE SUBROUTINE SetScalarMeshFieldParam(param, name, & & fieldType, varType, engine, defineOn, nns) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: name @@ -77,24 +105,22 @@ MODULE SUBROUTINE setScalarMeshFieldParam(param, name, & !! Nodal, Quadrature INTEGER(I4B), INTENT(IN) :: nns !! Number of node in space - END SUBROUTINE setScalarMeshFieldParam + END SUBROUTINE SetScalarMeshFieldParam END INTERFACE -PUBLIC :: setScalarMeshFieldParam - !---------------------------------------------------------------------------- -! checkEssentialParam@ConstructorMethods +! CheckEssentialParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 17 Feb 2022 -! summary: This routine check the essential parameters in param. +! summary: This routine Check the essential parameters in param. INTERFACE - MODULE SUBROUTINE aField_checkEssentialParam(obj, param) + MODULE SUBROUTINE aField_CheckEssentialParam(obj, param) CLASS(ScalarMeshField_), INTENT(IN) :: obj TYPE(ParameterList_), INTENT(IN) :: param - END SUBROUTINE aField_checkEssentialParam + END SUBROUTINE aField_CheckEssentialParam END INTERFACE !---------------------------------------------------------------------------- diff --git a/src/modules/TensorMeshField/src/TensorMeshField_Class.F90 b/src/modules/TensorMeshField/src/TensorMeshField_Class.F90 index dacbc5468..de41d1407 100644 --- a/src/modules/TensorMeshField/src/TensorMeshField_Class.F90 +++ b/src/modules/TensorMeshField/src/TensorMeshField_Class.F90 @@ -17,7 +17,7 @@ MODULE TensorMeshField_Class USE GlobalData -USE BaseType +USE BaSetype USE FPL, ONLY: ParameterList_ USE Mesh_Class, ONLY: Mesh_ USE ExceptionHandler_Class, ONLY: e @@ -27,6 +27,10 @@ MODULE TensorMeshField_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "TensorMeshField_Class" CHARACTER(*), PARAMETER :: myPrefix = "TensorMeshField" +PUBLIC :: DEALLOCATE +PUBLIC :: TensorMeshField_ +PUBLIC :: TensorMeshFieldPointer_ +PUBLIC :: SetTensorMeshFieldParam !---------------------------------------------------------------------------- ! TensorMeshField_Class @@ -39,15 +43,13 @@ MODULE TensorMeshField_Class TYPE, EXTENDS(AbstractMeshField_) :: TensorMeshField_ CONTAINS PRIVATE - PROCEDURE, PUBLIC, PASS(obj) :: checkEssentialParam => & - & aField_checkEssentialParam - !! check essential parameters + PROCEDURE, PUBLIC, PASS(obj) :: CheckEssentialParam => & + & aField_CheckEssentialParam + !! Check essential parameters PROCEDURE, PASS(obj) :: Initiate1 => aField_Initiate1 !! Initiate the field by reading param and a given mesh END TYPE TensorMeshField_ -PUBLIC :: TensorMeshField_ - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -56,18 +58,16 @@ MODULE TensorMeshField_Class CLASS(TensorMeshField_), POINTER :: ptr => NULL() END TYPE TensorMeshFieldPointer_ -PUBLIC :: TensorMeshFieldPointer_ - !---------------------------------------------------------------------------- -! setAbstractMeshFieldParam@ConstructorMethods +! SetAbstractMeshFieldParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 17 Feb 2022 -! summary: This routine check the essential parameters in param. +! summary: This routine Check the essential parameters in param. INTERFACE - MODULE SUBROUTINE setTensorMeshFieldParam(param, name, & + MODULE SUBROUTINE SetTensorMeshFieldParam(param, name, & & fieldType, varType, engine, defineOn, dim1, dim2, nns) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: name @@ -80,24 +80,22 @@ MODULE SUBROUTINE setTensorMeshFieldParam(param, name, & INTEGER(I4B), INTENT(IN) :: dim2 INTEGER(I4B), INTENT(IN) :: nns !! Number of node in space - END SUBROUTINE setTensorMeshFieldParam + END SUBROUTINE SetTensorMeshFieldParam END INTERFACE -PUBLIC :: setTensorMeshFieldParam - !---------------------------------------------------------------------------- -! checkEssentialParam@ConstructorMethods +! CheckEssentialParam@ConstructorMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 17 Feb 2022 -! summary: This routine check the essential parameters in param. +! summary: This routine Check the essential parameters in param. INTERFACE - MODULE SUBROUTINE aField_checkEssentialParam(obj, param) + MODULE SUBROUTINE aField_CheckEssentialParam(obj, param) CLASS(TensorMeshField_), INTENT(IN) :: obj TYPE(ParameterList_), INTENT(IN) :: param - END SUBROUTINE aField_checkEssentialParam + END SUBROUTINE aField_CheckEssentialParam END INTERFACE !---------------------------------------------------------------------------- @@ -116,4 +114,32 @@ MODULE SUBROUTINE aField_Initiate1(obj, param, mesh) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(TensorMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(TensorMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + END MODULE TensorMeshField_Class diff --git a/src/modules/VTKPlot/src/VTKPlot_Class.F90 b/src/modules/VTKPlot/src/VTKPlot_Class.F90 index 2357429ee..d11576f9f 100644 --- a/src/modules/VTKPlot/src/VTKPlot_Class.F90 +++ b/src/modules/VTKPlot/src/VTKPlot_Class.F90 @@ -18,6 +18,7 @@ MODULE VTKPlot_Class USE GlobalData USE BaseType +USE String_Class, ONLY: String USE ExceptionHandler_Class, ONLY: e USE ParameterList, ONLY: ParameterList_ USE AbstractPlot_Class @@ -45,17 +46,31 @@ MODULE VTKPlot_Class PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x1y1 PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x1y1f PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x1y1z1 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x1y1z1w1 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x3y3z3w2 PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x2y2 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x2y2w2 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x2y2w2b + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x2y2w3 PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x2y2f PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x3y3z3 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x3y3z3w3 + PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x3y3z3w4 PROCEDURE, PUBLIC, PASS(obj) :: vts_plot_x3y3z3f GENERIC, PUBLIC :: Plot => & & vts_plot_x1y1, & & vts_plot_x1y1f, & & vts_plot_x1y1z1, & + & vts_plot_x1y1z1w1, & + & vts_plot_x3y3z3w2, & & vts_plot_x2y2, & + & vts_plot_x2y2w2, & + & vts_plot_x2y2w2b, & + & vts_plot_x2y2w3, & & vts_plot_x2y2f, & & vts_plot_x3y3z3, & + & vts_plot_x3y3z3w3, & + & vts_plot_x3y3z3w4, & & vts_plot_x3y3z3f PROCEDURE, PUBLIC, PASS(obj) :: vts_surface_x1y1f PROCEDURE, PUBLIC, PASS(obj) :: vts_surface_x2y2f @@ -68,8 +83,12 @@ MODULE VTKPlot_Class PROCEDURE, PASS(obj) :: plot_scatter3D_1 PROCEDURE, PASS(obj) :: plot_scatter3D_2 PROCEDURE, PASS(obj) :: plot_scatter3D_3 - GENERIC, PUBLIC :: Scatter3D => plot_scatter3D_1, & - & plot_scatter3D_2, plot_scatter3D_3 + PROCEDURE, PASS(obj) :: plot_scatter3D_4 + GENERIC, PUBLIC :: Scatter3D => & + & plot_scatter3D_1, & + & plot_scatter3D_2, & + & plot_scatter3D_3, & + & plot_scatter3D_4 END TYPE VTKPlot_ PUBLIC :: VTKPlot_ @@ -168,6 +187,48 @@ END SUBROUTINE vts_plot_x1y1z1 ! Plot@StructuredGridMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: Create mesh grid using x, y, z, and plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x1y1z1w1(obj, x, y, z, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:) + REAL(DFP), INTENT(IN) :: y(:) + REAL(DFP), INTENT(IN) :: z(:) + REAL(DFP), INTENT(IN) :: w(:) + CHARACTER(*), INTENT(IN) :: label + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x1y1z1w1 +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: Create mesh grid using x, y, z, and plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x3y3z3w2(obj, x, y, z, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :, :) + REAL(DFP), INTENT(IN) :: y(:, :, :) + REAL(DFP), INTENT(IN) :: z(:, :, :) + REAL(DFP), INTENT(IN) :: w(:, :) + !! each columns represents a data set + TYPE(string), INTENT(IN) :: label(:) + !! label of each dataset + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x3y3z3w2 +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + !> author: Vikas Sharma, Ph. D. ! date: 28 Oct 2022 ! summary: Create plot structured grid @@ -187,6 +248,75 @@ END SUBROUTINE vts_plot_x2y2 ! Plot@StructuredGridMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: Create plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x2y2w2(obj, x, y, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :) + !! x coordinate of mesh grid + REAL(DFP), INTENT(IN) :: y(:, :) + !! y coordinate of mesh grid + REAL(DFP), INTENT(IN) :: w(:, :) + !! z coordinate of mesh grid + CHARACTER(*), INTENT(IN) :: label + !! label of dataset + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x2y2w2 +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: Create plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x2y2w2b(obj, x, y, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :) + !! x coordinate of mesh grid + REAL(DFP), INTENT(IN) :: y(:, :) + !! y coordinate of mesh grid + REAL(DFP), INTENT(IN) :: w(:, :) + !! each col of w denotes data + !! number of cols of w should be same as size of label + TYPE(String), INTENT(IN) :: label(:) + !! label of dataset + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x2y2w2b +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: Create plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x2y2w3(obj, x, y, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :) + !! x coordinate of mesh grid + REAL(DFP), INTENT(IN) :: y(:, :) + !! y coordinate of mesh grid + REAL(DFP), INTENT(IN) :: w(:, :, :) + !! z coordinate of mesh grid + TYPE(String), INTENT(IN) :: label(:) + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x2y2w3 +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + !> author: Vikas Sharma, Ph. D. ! date: 28 Oct 2022 ! summary: plot structured grid @@ -204,6 +334,56 @@ MODULE SUBROUTINE vts_plot_x3y3z3(obj, x, y, z, filename) END SUBROUTINE vts_plot_x3y3z3 END INTERFACE +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x3y3z3w3(obj, x, y, z, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :, :) + !! x ccoord of mesh grid + REAL(DFP), INTENT(IN) :: y(:, :, :) + !! y coord of mesh grid + REAL(DFP), INTENT(IN) :: z(:, :, :) + !! z coord of mesh grid + REAL(DFP), INTENT(IN) :: w(:, :, :) + !! w coord of mesh grid + CHARACTER(*), INTENT(IN) :: label + !! label of dataset + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x3y3z3w3 +END INTERFACE + +!---------------------------------------------------------------------------- +! Plot@StructuredGridMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 28 Oct 2022 +! summary: plot structured grid + +INTERFACE + MODULE SUBROUTINE vts_plot_x3y3z3w4(obj, x, y, z, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:, :, :) + !! x ccoord of mesh grid + REAL(DFP), INTENT(IN) :: y(:, :, :) + !! y coord of mesh grid + REAL(DFP), INTENT(IN) :: z(:, :, :) + !! z coord of mesh grid + REAL(DFP), INTENT(IN) :: w(:, :, :, :) + !! w coord of mesh grid + TYPE(String), INTENT(IN) :: label(:) + !! label of dataset + CHARACTER(*), INTENT(IN) :: filename + END SUBROUTINE vts_plot_x3y3z3w4 +END INTERFACE + !---------------------------------------------------------------------------- ! Scatter3D@ScatterMethods !---------------------------------------------------------------------------- @@ -216,11 +396,11 @@ END SUBROUTINE vts_plot_x3y3z3 MODULE SUBROUTINE plot_scatter3D_1(obj, x, y, z, label, filename) CLASS(VTKPlot_), INTENT(IN) :: obj REAL(DFP), INTENT(IN) :: x(:) - !! x coordinates + !! x coordinates of all points REAL(DFP), INTENT(IN) :: y(:) - !! y coords + !! y coords of all points REAL(DFP), INTENT(IN) :: z(:) - !! z coords + !! z coords of all points CHARACTER(*), INTENT(IN) :: label !! label CHARACTER(*), INTENT(IN) :: filename @@ -237,9 +417,9 @@ END SUBROUTINE plot_scatter3D_1 MODULE SUBROUTINE plot_scatter3D_2(obj, x, y, z, label, filename) CLASS(VTKPlot_), INTENT(IN) :: obj REAL(DFP), INTENT(IN) :: x(:) - !! x coordinates + !! x coordinates of all points REAL(DFP), INTENT(IN) :: y(:) - !! y coordinates + !! y coordinates of all points REAL(DFP), INTENT(IN) :: z(:, :) !! each column of z is considered as data !! for jth column data label will be label+j @@ -270,6 +450,33 @@ MODULE SUBROUTINE plot_scatter3D_3(obj, x, y, label, filename) END SUBROUTINE plot_scatter3D_3 END INTERFACE +!---------------------------------------------------------------------------- +! Scatter3D@ScatterMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-07-10 +! summary: Scatter3D plot using VTK + +INTERFACE + MODULE SUBROUTINE plot_scatter3D_4(obj, x, y, z, w, label, filename) + CLASS(VTKPlot_), INTENT(IN) :: obj + REAL(DFP), INTENT(IN) :: x(:) + !! x coordinates of all points + REAL(DFP), INTENT(IN) :: y(:) + !! y coords of all points + REAL(DFP), INTENT(IN) :: z(:) + !! z coords of all points + REAL(DFP), INTENT(IN) :: w(:, :) + !! each column of w represents data on x,y,z + CHARACTER(*), INTENT(IN) :: label + !! label + CHARACTER(*), INTENT(IN) :: filename + !! vtkfile name, this file will be opened and closed by this + !! routine, the extension should be .vtp + END SUBROUTINE plot_scatter3D_4 +END INTERFACE + CONTAINS !---------------------------------------------------------------------------- diff --git a/src/modules/VectorField/src/VectorField_Class.F90 b/src/modules/VectorField/src/VectorField_Class.F90 index 84b453ce4..f4f1a722e 100644 --- a/src/modules/VectorField/src/VectorField_Class.F90 +++ b/src/modules/VectorField/src/VectorField_Class.F90 @@ -20,7 +20,7 @@ MODULE VectorField_Class USE GlobalData -USE BaseType +USE BaSetype USE String_Class USE AbstractField_Class USE AbstractNodeField_Class @@ -33,6 +33,16 @@ MODULE VectorField_Class PRIVATE CHARACTER(*), PARAMETER :: modName = "VectorField_Class" CHARACTER(*), PARAMETER :: myprefix = "VectorField" +PUBLIC :: VectorField_ +PUBLIC :: VectorFieldPointer_ +PUBLIC :: SetVectorFieldParam +PUBLIC :: VectorFieldInitiate1 +PUBLIC :: VectorFieldInitiate2 +PUBLIC :: VectorFieldDeallocate +PUBLIC :: VectorField +PUBLIC :: VectorField_Pointer +PUBLIC :: VectorFieldDisplay +PUBLIC :: VectorFieldExport !---------------------------------------------------------------------------- ! VectorField_ @@ -42,7 +52,7 @@ MODULE VectorField_Class ! date: 25 June 2021 ! summary: Vector field ! -!{!pages/VectorField_.md} +!{!pages/docs-api/VectorField/VectorField_.md} TYPE, EXTENDS(AbstractNodeField_) :: VectorField_ INTEGER(I4B) :: spaceCompo = 0_I4B @@ -60,38 +70,38 @@ MODULE VectorField_Class PROCEDURE, PUBLIC, PASS(obj) :: Export => vField_Export FINAL :: vField_Final !! SetMethods - PROCEDURE, PASS(obj) :: set1 => vField_set1 - !! set single entry - PROCEDURE, PASS(obj) :: set2 => vField_set2 - !! set all values to a Vector values - PROCEDURE, PASS(obj) :: set3 => vField_set3 - !! set all values to a given vector - PROCEDURE, PASS(obj) :: set4 => vField_set4 - !! set selected values to given Vector - PROCEDURE, PASS(obj) :: set5 => vField_set5 - !! set selected values to given vector - PROCEDURE, PASS(obj) :: set6 => vField_set6 - !! set values to a Vector by using triplet - PROCEDURE, PASS(obj) :: set7 => vField_set7 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set8 => vField_set8 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set9 => vField_set9 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set10 => vField_set10 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set11 => vField_set11 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set12 => vField_set12 - !! set values to a vector by using triplet - PROCEDURE, PASS(obj) :: set13 => vField_set13 - PROCEDURE, PASS(obj) :: set14 => vField_set14 - PROCEDURE, PASS(obj) :: set15 => vField_set15 - !! set selected values using FEVariable - GENERIC, PUBLIC :: set => & - & set1, set2, set3, set4, set5, set6, & - & set7, set8, set9, set10, set11, set12, & - & set13, set14, set15 + PROCEDURE, PASS(obj) :: Set1 => vField_set1 + !! Set single entry + PROCEDURE, PASS(obj) :: Set2 => vField_set2 + !! Set all values to a Vector values + PROCEDURE, PASS(obj) :: Set3 => vField_set3 + !! Set all values to a given vector + PROCEDURE, PASS(obj) :: Set4 => vField_set4 + !! Set selected values to given Vector + PROCEDURE, PASS(obj) :: Set5 => vField_set5 + !! Set selected values to given vector + PROCEDURE, PASS(obj) :: Set6 => vField_set6 + !! Set values to a Vector by using triplet + PROCEDURE, PASS(obj) :: Set7 => vField_set7 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set8 => vField_set8 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set9 => vField_set9 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set10 => vField_set10 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set11 => vField_set11 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set12 => vField_set12 + !! Set values to a vector by using triplet + PROCEDURE, PASS(obj) :: Set13 => vField_set13 + PROCEDURE, PASS(obj) :: Set14 => vField_set14 + PROCEDURE, PASS(obj) :: Set15 => vField_set15 + !! Set selected values using FEVariable + GENERIC, PUBLIC :: Set => & + & Set1, set2, set3, set4, set5, set6, & + & Set7, set8, set9, set10, set11, set12, & + & Set13, set14, set15 PROCEDURE, PASS(obj) :: get1 => vField_get1 !! returns the single entry @@ -117,7 +127,6 @@ MODULE VectorField_Class & vField_applyDirichletBC2 END TYPE VectorField_ -PUBLIC :: VectorField_ TYPE(VectorField_), PARAMETER, PUBLIC :: TypeVectorField = & & VectorField_(domains=NULL()) @@ -129,10 +138,8 @@ MODULE VectorField_Class CLASS(VectorField_), POINTER :: ptr => NULL() END TYPE VectorFieldPointer_ -PUBLIC :: VectorFieldPointer_ - !---------------------------------------------------------------------------- -! setVectorFieldParam@Constructor +! SetVectorFieldParam@Constructor !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. @@ -140,18 +147,16 @@ MODULE VectorField_Class ! summary: Sets parameters for creating the vector field ! INTERFACE - MODULE SUBROUTINE setVectorFieldParam(param, name, engine, & + MODULE SUBROUTINE SetVectorFieldParam(param, name, engine, & & spaceCompo, fieldType) TYPE(ParameterList_), INTENT(INOUT) :: param CHARACTER(*), INTENT(IN) :: name CHARACTER(*), INTENT(IN) :: engine INTEGER(I4B), INTENT(IN) :: spaceCompo INTEGER(I4B), OPTIONAL, INTENT(IN) :: fieldType - END SUBROUTINE setVectorFieldParam + END SUBROUTINE SetVectorFieldParam END INTERFACE -PUBLIC :: setVectorFieldParam - !---------------------------------------------------------------------------- ! checkEssentialParam@Constructor !---------------------------------------------------------------------------- @@ -191,20 +196,14 @@ END SUBROUTINE vField_checkEssentialParam ! - `spaceCompo` is the total degree of freedom or components ! - `fieldType` type of field type; FIELD_TYPE_CONSTANT, FIELD_TYPE_NORMAL -INTERFACE +INTERFACE VectorFieldInitiate1 MODULE SUBROUTINE vField_Initiate1(obj, param, dom) CLASS(VectorField_), INTENT(INOUT) :: obj TYPE(ParameterList_), INTENT(IN) :: param TYPE(Domain_), TARGET, INTENT(IN) :: dom END SUBROUTINE vField_Initiate1 -END INTERFACE - -INTERFACE VectorFieldInitiate1 - MODULE PROCEDURE vField_Initiate1 END INTERFACE VectorFieldInitiate1 -PUBLIC :: VectorFieldInitiate1 - !---------------------------------------------------------------------------- ! Initiate@ConstructorMethods !---------------------------------------------------------------------------- @@ -213,7 +212,7 @@ END SUBROUTINE vField_Initiate1 ! date: 2023-03-29 ! summary: Initiate2 -INTERFACE +INTERFACE VectorFieldInitiate2 MODULE SUBROUTINE vField_Initiate2(obj, obj2, copyFull, copyStructure, & & usePointer) CLASS(VectorField_), INTENT(INOUT) :: obj @@ -223,14 +222,8 @@ MODULE SUBROUTINE vField_Initiate2(obj, obj2, copyFull, copyStructure, & LOGICAL(LGT), OPTIONAL, INTENT(IN) :: copyStructure LOGICAL(LGT), OPTIONAL, INTENT(IN) :: usePointer END SUBROUTINE vField_Initiate2 -END INTERFACE - -INTERFACE VectorFieldInitiate2 - MODULE PROCEDURE vField_Initiate2 END INTERFACE VectorFieldInitiate2 -PUBLIC :: VectorFieldInitiate2 - !---------------------------------------------------------------------------- ! Deallocate@Constructor !---------------------------------------------------------------------------- @@ -239,18 +232,12 @@ END SUBROUTINE vField_Initiate2 ! date: 25 June 2021 ! summary: This routine deallocates the data stored inside the VectorField_ obj -INTERFACE +INTERFACE VectorFieldDeallocate MODULE SUBROUTINE vField_Deallocate(obj) CLASS(VectorField_), INTENT(INOUT) :: obj END SUBROUTINE vField_Deallocate -END INTERFACE - -INTERFACE VectorFieldDeallocate - MODULE PROCEDURE vField_Deallocate END INTERFACE VectorFieldDeallocate -PUBLIC :: VectorFieldDeallocate - !---------------------------------------------------------------------------- ! Final@Constructor !---------------------------------------------------------------------------- @@ -269,20 +256,14 @@ END SUBROUTINE vField_Final ! date: 25 June 2021 ! summary: This function returns an instance of [[VectorField_]] -INTERFACE +INTERFACE VectorField MODULE FUNCTION vField_Constructor1(param, dom) RESULT(Ans) TYPE(ParameterList_), INTENT(IN) :: param TYPE(Domain_), TARGET, INTENT(IN) :: dom TYPE(VectorField_) :: ans END FUNCTION vField_Constructor1 -END INTERFACE - -INTERFACE VectorField - MODULE PROCEDURE vField_Constructor1 END INTERFACE VectorField -PUBLIC :: VectorField - !---------------------------------------------------------------------------- ! VectorField_Pointer@Constructor !---------------------------------------------------------------------------- @@ -291,20 +272,14 @@ END FUNCTION vField_Constructor1 ! date: 25 June 2021 ! summary: This function returns an instance of [[VectorField_]] -INTERFACE +INTERFACE VectorField_Pointer MODULE FUNCTION vField_Constructor_1(param, dom) RESULT(Ans) TYPE(ParameterList_), INTENT(IN) :: param TYPE(Domain_), TARGET, INTENT(IN) :: dom CLASS(VectorField_), POINTER :: ans END FUNCTION vField_Constructor_1 -END INTERFACE - -INTERFACE VectorField_Pointer - MODULE PROCEDURE vField_Constructor_1 END INTERFACE VectorField_Pointer -PUBLIC :: VectorField_Pointer - !---------------------------------------------------------------------------- ! Display@IO !---------------------------------------------------------------------------- @@ -313,20 +288,14 @@ END FUNCTION vField_Constructor_1 ! date: 26 June 2021 ! summary: Display the content of [[VectorField_]] -INTERFACE +INTERFACE VectorFieldDisplay MODULE SUBROUTINE vField_Display(obj, msg, unitNo) CLASS(VectorField_), INTENT(INOUT) :: obj CHARACTER(*), INTENT(IN) :: msg INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitNo END SUBROUTINE vField_Display -END INTERFACE - -INTERFACE VectorFieldDisplay - MODULE PROCEDURE vField_Display END INTERFACE VectorFieldDisplay -PUBLIC :: VectorFieldDisplay - !---------------------------------------------------------------------------- ! Import@IO !---------------------------------------------------------------------------- @@ -353,30 +322,24 @@ END SUBROUTINE vField_Import ! date: 16 July 2021 ! summary: This routine Exports the content -INTERFACE +INTERFACE VectorFieldExport MODULE SUBROUTINE vField_Export(obj, hdf5, group) CLASS(VectorField_), INTENT(INOUT) :: obj TYPE(HDF5File_), INTENT(INOUT) :: hdf5 CHARACTER(*), INTENT(IN) :: group END SUBROUTINE vField_Export -END INTERFACE - -INTERFACE VectorFieldExport - MODULE PROCEDURE vField_Export END INTERFACE VectorFieldExport -PUBLIC :: VectorFieldExport - !---------------------------------------------------------------------------- ! Set@SetMethods !---------------------------------------------------------------------------- !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the single entry of the Vector field +! summary: This routine Sets the single entry of the Vector field ! !# Introduction -! This routine sets the single entry of the vector field. Here, val should +! This routine Sets the single entry of the vector field. Here, val should ! be a vector representing the components of a vector. The size of `value` ! should be same as `obj%spaceCompo`. In simple words it does following. ! @@ -386,19 +349,19 @@ END SUBROUTINE vField_Export !### Usage ! !```fortran -! call obj%set( globalNode = 10, value= 100.0_DFP*[1,1,1] ) +! call obj%Set( globalNode = 10, value= 100.0_DFP*[1,1,1] ) ! call obj%display( "test-1: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set1(obj, globalNode, VALUE, & + MODULE SUBROUTINE vField_Set1(obj, globalNode, VALUE, & & scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: globalNode REAL(DFP), INTENT(IN) :: VALUE(:) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set1 + END SUBROUTINE vField_Set1 END INTERFACE !---------------------------------------------------------------------------- @@ -407,11 +370,11 @@ END SUBROUTINE vField_set1 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets all the entries of a Vector field +! summary: This routine Sets all the entries of a Vector field ! !# Introduction ! This routine work as follows. The size of value should be same as -! obj%spaceCompo, then this value is set for all the nodal values +! obj%spaceCompo, then this value is Set for all the nodal values ! ! vector( :, i ) = value( : ), for i = 1, tNodes ! @@ -419,17 +382,17 @@ END SUBROUTINE vField_set1 !### Usage ! !```fortran -! call obj%set( value= 10.0_DFP*[1,1,1] ) +! call obj%Set( value= 10.0_DFP*[1,1,1] ) ! call obj%display( "test-2: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set2(obj, VALUE, scale, addContribution) + MODULE SUBROUTINE vField_Set2(obj, VALUE, scale, addContribution) CLASS(VectorField_), TARGET, INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE(:) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set2 + END SUBROUTINE vField_Set2 END INTERFACE !---------------------------------------------------------------------------- @@ -438,10 +401,10 @@ END SUBROUTINE vField_set2 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets all the entries of a Vector field +! summary: This routine Sets all the entries of a Vector field ! !# Introduction -! This routine sets all values of `spaceCompo` component of the vector field +! This routine Sets all values of `spaceCompo` component of the vector field ! to given scalar value `value` ! ! vector( spaceCompo, i ) = value, for i = 1, tNodes @@ -450,20 +413,20 @@ END SUBROUTINE vField_set2 !### Usage ! !```fortran -! call obj%set( value= -10.0_DFP, spaceCompo=1 ) -! call obj%set( value= -20.0_DFP, spaceCompo=2 ) -! call obj%set( value= -30.0_DFP, spaceCompo=3 ) +! call obj%Set( value= -10.0_DFP, spaceCompo=1 ) +! call obj%Set( value= -20.0_DFP, spaceCompo=2 ) +! call obj%Set( value= -30.0_DFP, spaceCompo=3 ) ! call obj%display( "test-3: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set3(obj, VALUE, spaceCompo, scale, addContribution) + MODULE SUBROUTINE vField_Set3(obj, VALUE, spaceCompo, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE INTEGER(I4B), INTENT(IN) :: spaceCompo REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set3 + END SUBROUTINE vField_Set3 END INTERFACE !---------------------------------------------------------------------------- @@ -472,10 +435,10 @@ END SUBROUTINE vField_set3 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine set all the entries by using given Vector field +! summary: This routine Set all the entries by using given Vector field ! !# Introduction -! This routine set all entries of vector field to given vector +! This routine Set all entries of vector field to given vector ! Here shape of should be value(1:spaceCompo, tNodes). ! ! vector( :, : ) = value( :, : ) @@ -486,17 +449,17 @@ END SUBROUTINE vField_set3 !```fortran ! call reallocate( real2, 3, dom%getTotalNodes() ) ! real2 = 1.0_DFP -! call obj%set( value=real2 ) +! call obj%Set( value=real2 ) ! call obj%display( "test-4: vector field = " ) !``` INTERFACE - MODULE SUBROUTINE vField_set4(obj, VALUE, scale, addContribution) + MODULE SUBROUTINE vField_Set4(obj, VALUE, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE(:, :) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set4 + END SUBROUTINE vField_Set4 END INTERFACE !---------------------------------------------------------------------------- @@ -505,10 +468,10 @@ END SUBROUTINE vField_set4 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine set all the entries by using given Vector field +! summary: This routine Set all the entries by using given Vector field ! !# Introduction -! This routine set all entries of the component `spaceCompo` vector +! This routine Set all entries of the component `spaceCompo` vector ! field to given fortran vector `value` ! ! vector( spaceCompo, : ) = value( : ) @@ -519,18 +482,18 @@ END SUBROUTINE vField_set4 !```fortran ! call reallocate( real1, dom%getTotalNodes() ) ! real1 = 3.0_DFP -! call obj%set( value=real1, spaceCompo=3 ) +! call obj%Set( value=real1, spaceCompo=3 ) ! call obj%display( "test-5: vector field = " ) !``` INTERFACE - MODULE SUBROUTINE vField_set5(obj, VALUE, spaceCompo, scale, addContribution) + MODULE SUBROUTINE vField_Set5(obj, VALUE, spaceCompo, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE(:) INTEGER(I4B), INTENT(IN) :: spaceCompo REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set5 + END SUBROUTINE vField_Set5 END INTERFACE !---------------------------------------------------------------------------- @@ -539,10 +502,10 @@ END SUBROUTINE vField_set5 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine set all the entries by using given Vector field +! summary: This routine Set all the entries by using given Vector field ! !# Introduction -! This routine set all entries of the component `spaceCompo` vector +! This routine Set all entries of the component `spaceCompo` vector ! field to given scalar field `value` ! ! vector( spaceCompo, : ) = value @@ -552,25 +515,25 @@ END SUBROUTINE vField_set5 ! !```fortran ! call scalarObj%initiate( param, dom ) -! call scalarObj%set( value = 2.0_DFP ) -! call obj%set( value=scalarObj, spaceCompo=2 ) +! call scalarObj%Set( value = 2.0_DFP ) +! call obj%Set( value=scalarObj, spaceCompo=2 ) ! call obj%display( "test-6: vector field = ") -! ierr = param%set( key="fieldType", value=FIELD_TYPE_CONSTANT) +! ierr = param%Set( key="fieldType", value=FIELD_TYPE_CONSTANT) ! call scalarObj%Deallocate() ! call scalarObj%initiate( param, dom ) -! call scalarObj%set( value=10.0_DFP ) -! call obj%set( value=scalarObj, spaceCompo=1 ) +! call scalarObj%Set( value=10.0_DFP ) +! call obj%Set( value=scalarObj, spaceCompo=1 ) ! call obj%display( "test-7: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set6(obj, VALUE, spaceCompo, scale, addContribution) + MODULE SUBROUTINE vField_Set6(obj, VALUE, spaceCompo, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj CLASS(AbstractNodeField_), INTENT(IN) :: VALUE INTEGER(I4B), INTENT(IN) :: spaceCompo REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set6 + END SUBROUTINE vField_Set6 END INTERFACE !---------------------------------------------------------------------------- @@ -579,10 +542,10 @@ END SUBROUTINE vField_set6 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries ! !# Introduction -! This soubroutine sets the selected enties to a vector entry value( : ) +! This soubroutine Sets the selected enties to a vector entry value( : ) ! Effectively it does the following: ! ! vector( :, globalNode ) = value( : ), for entries in global nodes @@ -594,18 +557,18 @@ END SUBROUTINE vField_set6 ! call reallocate( real2, 3, 4) ! real2( :, 1 ) = -1.0; real2( :, 2 ) = -2.0; real2( :, 3 ) = -3.0 ! real2( :, 4 ) = -4.0 -! call obj%set( value=real2, globalNode=[1,3,5,7] ) +! call obj%Set( value=real2, globalNode=[1,3,5,7] ) ! call obj%display( "test-8: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set7(obj, VALUE, globalNode, scale, addContribution) + MODULE SUBROUTINE vField_Set7(obj, VALUE, globalNode, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) REAL(DFP), INTENT(IN) :: VALUE(:) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set7 + END SUBROUTINE vField_Set7 END INTERFACE !---------------------------------------------------------------------------- @@ -614,10 +577,10 @@ END SUBROUTINE vField_set7 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries ! !# Introduction -! This routine sets all selected entries. +! This routine Sets all selected entries. ! vector( :, globalNode ) = value( :, : ) ! ! @@ -627,12 +590,12 @@ END SUBROUTINE vField_set7 ! call reallocate( real2, 3, 4) ! real2( :, 1 ) = -1.0; real2( :, 2 ) = -2.0; real2( :, 3 ) = -3.0 ! real2( :, 4 ) = -4.0 -! call obj%set( value=real2, globalNode=[1,3,5,7] ) +! call obj%Set( value=real2, globalNode=[1,3,5,7] ) ! call obj%display( "test-8: vector field = ") !``` INTERFACE - MODULE SUBROUTINE vField_set8(obj, globalNode, VALUE, scale, & + MODULE SUBROUTINE vField_Set8(obj, globalNode, VALUE, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: globalNode(:) @@ -640,7 +603,7 @@ MODULE SUBROUTINE vField_set8(obj, globalNode, VALUE, scale, & !! value is in value(i,J) format. REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set8 + END SUBROUTINE vField_Set8 END INTERFACE !---------------------------------------------------------------------------- @@ -649,10 +612,10 @@ END SUBROUTINE vField_set8 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries ! !# Introduction -! This routine sets the selected components of selected nodes to given value +! This routine Sets the selected components of selected nodes to given value ! ! vector( spaceCompo, globalNode ) = value( : ) ! @@ -662,12 +625,12 @@ END SUBROUTINE vField_set8 !```fortran ! call reallocate( real1, 4) ! real1 = [1,10,100,1000] -! call obj%set( value=real1, globalNode=[1,3,5,7], spaceCompo=1 ) +! call obj%Set( value=real1, globalNode=[1,3,5,7], spaceCompo=1 ) ! call obj%display( "test-9: vector field = " ) !``` INTERFACE - MODULE SUBROUTINE vField_set9(obj, VALUE, globalNode, spaceCompo, scale, & + MODULE SUBROUTINE vField_Set9(obj, VALUE, globalNode, spaceCompo, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE(:) @@ -675,7 +638,7 @@ MODULE SUBROUTINE vField_set9(obj, VALUE, globalNode, spaceCompo, scale, & INTEGER(I4B), INTENT(IN) :: spaceCompo REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set9 + END SUBROUTINE vField_Set9 END INTERFACE !---------------------------------------------------------------------------- @@ -684,7 +647,7 @@ END SUBROUTINE vField_set9 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries ! !# Introduction ! selected components, selected nodes @@ -692,7 +655,7 @@ END SUBROUTINE vField_set9 ! vector( spaceCompo, globalNode ) = value INTERFACE - MODULE SUBROUTINE vField_set10(obj, VALUE, globalNode, spaceCompo, scale, & + MODULE SUBROUTINE vField_Set10(obj, VALUE, globalNode, spaceCompo, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE @@ -700,7 +663,7 @@ MODULE SUBROUTINE vField_set10(obj, VALUE, globalNode, spaceCompo, scale, & INTEGER(I4B), INTENT(IN) :: spaceCompo REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set10 + END SUBROUTINE vField_Set10 END INTERFACE !---------------------------------------------------------------------------- @@ -709,14 +672,14 @@ END SUBROUTINE vField_set10 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries ! !# Introduction ! Set entries using the selected nodes using triplet. ! INTERFACE - MODULE SUBROUTINE vField_set11(obj, VALUE, istart, iend, stride, scale, & + MODULE SUBROUTINE vField_Set11(obj, VALUE, istart, iend, stride, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: istart @@ -725,7 +688,7 @@ MODULE SUBROUTINE vField_set11(obj, VALUE, istart, iend, stride, scale, & REAL(DFP), INTENT(IN) :: VALUE(:) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set11 + END SUBROUTINE vField_Set11 END INTERFACE !---------------------------------------------------------------------------- @@ -734,13 +697,13 @@ END SUBROUTINE vField_set11 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: set the vector values using triplet +! summary: Set the vector values using triplet ! !# Introduction ! Set entries using the selected nodes using triplet. INTERFACE - MODULE SUBROUTINE vField_set12(obj, VALUE, istart, iend, stride, scale, & + MODULE SUBROUTINE vField_Set12(obj, VALUE, istart, iend, stride, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE(:, :) @@ -749,7 +712,7 @@ MODULE SUBROUTINE vField_set12(obj, VALUE, istart, iend, stride, scale, & INTEGER(I4B), INTENT(IN) :: stride REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set12 + END SUBROUTINE vField_Set12 END INTERFACE !---------------------------------------------------------------------------- @@ -758,17 +721,17 @@ END SUBROUTINE vField_set12 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: set the values using FEVariable +! summary: Set the values using FEVariable INTERFACE - MODULE SUBROUTINE vField_set13(obj, VALUE, globalNode, scale, & + MODULE SUBROUTINE vField_Set13(obj, VALUE, globalNode, scale, & & addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj TYPE(FEVariable_), INTENT(IN) :: VALUE INTEGER(I4B), INTENT(IN) :: globalNode(:) REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set13 + END SUBROUTINE vField_Set13 END INTERFACE !---------------------------------------------------------------------------- @@ -777,15 +740,15 @@ END SUBROUTINE vField_set13 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: set the values using FEVariable +! summary: Set the values using FEVariable INTERFACE - MODULE SUBROUTINE vField_set14(obj, VALUE, scale, addContribution) + MODULE SUBROUTINE vField_Set14(obj, VALUE, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj REAL(DFP), INTENT(IN) :: VALUE REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set14 + END SUBROUTINE vField_Set14 END INTERFACE !---------------------------------------------------------------------------- @@ -797,7 +760,7 @@ END SUBROUTINE vField_set14 ! summary: Set values INTERFACE - MODULE SUBROUTINE vField_set15(obj, ivar, idof, VALUE, ivar_value, & + MODULE SUBROUTINE vField_Set15(obj, ivar, idof, VALUE, ivar_value, & & idof_value, scale, addContribution) CLASS(VectorField_), INTENT(INOUT) :: obj INTEGER(I4B), INTENT(IN) :: ivar @@ -807,7 +770,7 @@ MODULE SUBROUTINE vField_set15(obj, ivar, idof, VALUE, ivar_value, & INTEGER(I4B), INTENT(IN) :: idof_value REAL(DFP), OPTIONAL, INTENT(IN) :: scale LOGICAL(LGT), OPTIONAL, INTENT(IN) :: addContribution - END SUBROUTINE vField_set15 + END SUBROUTINE vField_Set15 END INTERFACE !---------------------------------------------------------------------------- @@ -908,7 +871,7 @@ END SUBROUTINE vField_get5 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries INTERFACE MODULE SUBROUTINE vField_get6(obj, VALUE, istart, iend, stride) @@ -926,7 +889,7 @@ END SUBROUTINE vField_get6 !> authors: Vikas Sharma, Ph. D. ! date: 25 June 2021 -! summary: This routine sets the selected entries +! summary: This routine Sets the selected entries INTERFACE MODULE SUBROUTINE vField_get7(obj, VALUE, istart, iend, stride, spaceCompo) diff --git a/src/modules/VectorMeshField/src/VectorMeshField_Class.F90 b/src/modules/VectorMeshField/src/VectorMeshField_Class.F90 index 0d68d6d11..9116ba56a 100644 --- a/src/modules/VectorMeshField/src/VectorMeshField_Class.F90 +++ b/src/modules/VectorMeshField/src/VectorMeshField_Class.F90 @@ -25,7 +25,8 @@ MODULE VectorMeshField_Class USE AbstractMeshField_Class IMPLICIT NONE PRIVATE -CHARACTER(LEN=*), PARAMETER :: modName = "VectorMeshField_Class" +CHARACTER(*), PARAMETER :: modName = "VectorMeshField_Class" +PUBLIC :: DEALLOCATE !---------------------------------------------------------------------------- ! VectorMeshField_Class @@ -114,4 +115,32 @@ MODULE SUBROUTINE aField_Initiate1(obj, param, mesh) END SUBROUTINE aField_Initiate1 END INTERFACE +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Vector(obj) + TYPE(VectorMeshField_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Vector +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-09-12 +! summary: Deallocate the vector of NeumannBC_ + +INTERFACE DEALLOCATE + MODULE SUBROUTINE aField_Deallocate_Ptr_Vector(obj) + TYPE(VectorMeshFieldPointer_), ALLOCATABLE :: obj(:) + END SUBROUTINE aField_Deallocate_Ptr_Vector +END INTERFACE DEALLOCATE + END MODULE VectorMeshField_Class diff --git a/src/submodules/AbstractField/src/AbstractField_Class@Methods.F90 b/src/submodules/AbstractField/src/AbstractField_Class@Methods.F90 index 8333c2e3b..d6e700e8f 100644 --- a/src/submodules/AbstractField/src/AbstractField_Class@Methods.F90 +++ b/src/submodules/AbstractField/src/AbstractField_Class@Methods.F90 @@ -16,6 +16,7 @@ SUBMODULE(AbstractField_Class) Methods USE BaseMethod +USE FPL_Method, ONLY: GetValue IMPLICIT NONE CONTAINS @@ -78,6 +79,26 @@ END PROCEDURE aField_Display +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE AbstractFieldInitiate +CHARACTER(*), PARAMETER :: myName = "AbstractFieldInitiate()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This routine is under development') +CALL obj%DEALLOCATE() +CALL obj%CheckEssentialParam(param) +obj%isInitiated = .TRUE. +CALL GetValue(obj=param, prefix=prefix, key="fieldType", VALUE=obj%fieldType) +CALL GetValue(obj=param, prefix=prefix, key="name", VALUE=obj%name) +CALL GetValue(obj=param, prefix=prefix, key="engine", VALUE=obj%engine) +CALL GetValue(obj=param, prefix=prefix, key="comm", VALUE=obj%comm) +CALL GetValue(obj=param, prefix=prefix, key="global_n", VALUE=obj%global_n) +CALL GetValue(obj=param, prefix=prefix, key="local_n", VALUE=obj%local_n) +obj%domain => dom +END PROCEDURE AbstractFieldInitiate + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -121,7 +142,7 @@ obj%name = "" obj%engine = "" obj%isInitiated = .FALSE. -obj%fieldType = 0 +obj%fieldType = FIELD_TYPE_NORMAL obj%comm = 0 obj%myRank = 0 obj%numProcs = 1 @@ -309,13 +330,13 @@ & 'Instnace of MatrixField_ is not initiated') END IF -! check +! Check IF (.NOT. hdf5%isOpen()) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & 'HDF5 file is not opened') END IF -! check +! Check IF (.NOT. hdf5%isWrite()) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & 'HDF5 file does not have write permission') @@ -390,13 +411,13 @@ & 'The instance of AbstractField_ is already initiated') END IF -! check +! Check IF (.NOT. hdf5%isOpen()) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & 'HDF5 file is not opened') END IF -! check +! Check IF (.NOT. hdf5%isRead()) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & 'HDF5 file does not have read permission') @@ -513,4 +534,49 @@ END PROCEDURE aField_Import +!---------------------------------------------------------------------------- +! GetSpaceCompo +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_GetSpaceCompo +CHARACTER(*), PARAMETER :: myName = "aField_GetSpaceCompo" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[IMPLEMENTATION ERROR] :: This routine should be implemented by '// & + & " child classes.") +END PROCEDURE aField_GetSpaceCompo + +!---------------------------------------------------------------------------- +! GetTimeCompo +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_GetTimeCompo +CHARACTER(*), PARAMETER :: myName = "aField_GetTimeCompo" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[IMPLEMENTATION ERROR] :: This routine should be implemented by '// & + & " child classes.") +END PROCEDURE aField_GetTimeCompo + +!---------------------------------------------------------------------------- +! GetStorageFMT +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_GetStorageFMT +CHARACTER(*), PARAMETER :: myName = "aField_GetStorageFMT" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[IMPLEMENTATION ERROR] :: This routine should be implemented by '// & + & " child classes.") +END PROCEDURE aField_GetStorageFMT + +!---------------------------------------------------------------------------- +! isConstant +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_isConstant +IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN + ans = .TRUE. +ELSE + ans = .FALSE. +END IF +END PROCEDURE aField_isConstant + END SUBMODULE Methods diff --git a/src/submodules/AbstractMeshField/src/AbstractMeshField_Class@ConstructorMethods.F90 b/src/submodules/AbstractMeshField/src/AbstractMeshField_Class@ConstructorMethods.F90 index e4bd039e8..2e64592a1 100644 --- a/src/submodules/AbstractMeshField/src/AbstractMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/AbstractMeshField/src/AbstractMeshField_Class@ConstructorMethods.F90 @@ -23,17 +23,17 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setAbstractMeshFieldParam +MODULE PROCEDURE SetAbstractMeshFieldParam INTEGER(I4B) :: ierr -ierr = param%set(key=TRIM(prefix)//"/name", VALUE=name) -ierr = param%set(key=TRIM(prefix)//"/fieldType", VALUE=fieldType) -ierr = param%set(key=TRIM(prefix)//"/engine", VALUE=engine) -ierr = param%set(key=TRIM(prefix)//"/defineOn", VALUE=defineOn) -ierr = param%set(key=TRIM(prefix)//"/varType", VALUE=varType) -ierr = param%set(key=TRIM(prefix)//"/rank", VALUE=rank) -ierr = param%set(key=TRIM(prefix)//"/s", VALUE=s) -ierr = param%set(key=TRIM(prefix)//"/totalShape", VALUE=SIZE(s)) -END PROCEDURE setAbstractMeshFieldParam +ierr = param%Set(key=TRIM(prefix)//"/name", VALUE=name) +ierr = param%Set(key=TRIM(prefix)//"/fieldType", VALUE=fieldType) +ierr = param%Set(key=TRIM(prefix)//"/engine", VALUE=engine) +ierr = param%Set(key=TRIM(prefix)//"/defineOn", VALUE=defineOn) +ierr = param%Set(key=TRIM(prefix)//"/varType", VALUE=varType) +ierr = param%Set(key=TRIM(prefix)//"/rank", VALUE=rank) +ierr = param%Set(key=TRIM(prefix)//"/s", VALUE=s) +ierr = param%Set(key=TRIM(prefix)//"/totalShape", VALUE=SIZE(s)) +END PROCEDURE SetAbstractMeshFieldParam !---------------------------------------------------------------------------- ! checkEssentialParam @@ -138,7 +138,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE AbstractMeshFieldInitiate -TYPE(String) :: dsetname +TYPE(String) :: dSetname INTEGER(I4B) :: ierr, nrow, totalShape CHARACTER(:), ALLOCATABLE :: char_var CHARACTER(*), PARAMETER :: myName = "AbstractMeshFieldInitiate" @@ -158,7 +158,7 @@ ! ! fieldType ! -dsetname = TRIM(prefix)//"/fieldType" +dSetname = TRIM(prefix)//"/fieldType" IF (param%isPresent(key=dsetname%chars())) THEN ierr = param%get(key=dsetname%chars(), VALUE=obj%fieldType) ELSE @@ -386,7 +386,24 @@ END PROCEDURE aField_Shape !---------------------------------------------------------------------------- -! +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + +!---------------------------------------------------------------------------- +! !---------------------------------------------------------------------------- END SUBMODULE ConstructorMethods diff --git a/src/submodules/AbstractNodeField/src/AbstractNodeField_Class@Methods.F90 b/src/submodules/AbstractNodeField/src/AbstractNodeField_Class@Methods.F90 index 2429797b5..16784b8be 100644 --- a/src/submodules/AbstractNodeField/src/AbstractNodeField_Class@Methods.F90 +++ b/src/submodules/AbstractNodeField/src/AbstractNodeField_Class@Methods.F90 @@ -18,6 +18,8 @@ USE BaseMethod USE ExceptionHandler_Class, ONLY: e USE HDF5File_Method +USE FiniteElement_Class, ONLY: Deallocate_FE => DEALLOCATE, & +& Initiate_FE => Initiate IMPLICIT NONE CONTAINS @@ -32,21 +34,80 @@ END PROCEDURE anf_Display !---------------------------------------------------------------------------- -! getPointer +! GetPointer !---------------------------------------------------------------------------- -MODULE PROCEDURE anf_getPointer -ans => getPointer(obj%realVec) -END PROCEDURE anf_getPointer +MODULE PROCEDURE anf_GetPointer +ans => GetPointer(obj%realVec) +END PROCEDURE anf_GetPointer !---------------------------------------------------------------------------- ! Size !---------------------------------------------------------------------------- MODULE PROCEDURE anf_size -ans = obj%tSize +CHARACTER(*), PARAMETER :: myName = "anf_size" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +! ans = obj%tSize END PROCEDURE anf_size +!---------------------------------------------------------------------------- +! GetTotalDOF +!---------------------------------------------------------------------------- + +MODULE PROCEDURE anf_GetTotalDOF +CHARACTER(*), PARAMETER :: myName = "anf_GetTotalDOF()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +! IF (ASSOCIATED(obj%domain)) THEN +! ! ans = GetTotalDOF(obj=fem, dom=obj%domain) +! END IF +! +! IF (ALLOCATED(obj%domains)) THEN +! END IF +END PROCEDURE anf_GetTotalDOF + +!---------------------------------------------------------------------------- +! GetTotalVertexDOF +!---------------------------------------------------------------------------- + +MODULE PROCEDURE anf_GetTotalVertexDOF +CHARACTER(*), PARAMETER :: myName = "anf_GetTotalVertexDOF()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +END PROCEDURE anf_GetTotalVertexDOF + +!---------------------------------------------------------------------------- +! GetTotalEdgeDOF +!---------------------------------------------------------------------------- + +MODULE PROCEDURE anf_GetTotalEdgeDOF +CHARACTER(*), PARAMETER :: myName = "anf_GetTotalEdgeDOF()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +END PROCEDURE anf_GetTotalEdgeDOF + +!---------------------------------------------------------------------------- +! GetTotalFaceDOF +!---------------------------------------------------------------------------- + +MODULE PROCEDURE anf_GetTotalFaceDOF +CHARACTER(*), PARAMETER :: myName = "anf_GetTotalFaceDOF()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +END PROCEDURE anf_GetTotalFaceDOF + +!---------------------------------------------------------------------------- +! GetTotalCellDOF +!---------------------------------------------------------------------------- + +MODULE PROCEDURE anf_GetTotalCellDOF +CHARACTER(*), PARAMETER :: myName = "anf_GetTotalCellDOF()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This method is under development') +END PROCEDURE anf_GetTotalCellDOF + !---------------------------------------------------------------------------- ! Initiate2 !---------------------------------------------------------------------------- @@ -55,6 +116,7 @@ CHARACTER(*), PARAMETER :: myName = "anf_initiate2" INTEGER(I4B) :: ii, tsize +CALL obj%DEALLOCATE() CALL AbstractFieldInitiate2( & & obj=obj, & & obj2=obj2, & @@ -66,6 +128,7 @@ obj%tSize = obj2%tSize obj%realVec = obj2%realVec obj%dof = obj2%dof + ! CALL obj%fe%Copy(obj2%fe) END SELECT END PROCEDURE anf_initiate2 @@ -77,7 +140,8 @@ MODULE PROCEDURE anf_initiate3 CHARACTER(*), PARAMETER :: myName = "anf_Initiate3" CALL e%raiseError(modName//'::'//myName//" - "// & - & 'Initiate3 should be implemented by the child of AbstractNodeField_') + & '[IMPLEMENTATION ERROR] :: Initiate3 should be implemented by the'// & + & ' child of AbstractNodeField_') END PROCEDURE anf_initiate3 !---------------------------------------------------------------------------- @@ -89,10 +153,14 @@ obj%tSize = 0 CALL DEALLOCATE (obj%realVec) CALL DEALLOCATE (obj%dof) +IF (ALLOCATED(obj%fe)) THEN + CALL DEALLOCATE_FE(obj%fe) + ! NOTE: This module is called from FiniteElement_Class +END IF END PROCEDURE anf_Deallocate !---------------------------------------------------------------------------- -! +! Norm2 !---------------------------------------------------------------------------- MODULE PROCEDURE anf_Norm2 @@ -107,7 +175,7 @@ END PROCEDURE anf_Norm2 !---------------------------------------------------------------------------- -! Import +! Import !---------------------------------------------------------------------------- MODULE PROCEDURE anf_Import @@ -152,7 +220,7 @@ END PROCEDURE anf_Import !---------------------------------------------------------------------------- -! Export +! Export !---------------------------------------------------------------------------- MODULE PROCEDURE anf_Export @@ -207,19 +275,69 @@ ! GetSingle !---------------------------------------------------------------------------- -MODULE PROCEDURE anf_getSingle +MODULE PROCEDURE anf_GetSingle IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - VALUE = get( & + VALUE = Get( & & obj=obj%realVec, & & nodenum=1, & & dataType=1.0_DFP) ELSE - VALUE = get( & + VALUE = Get( & & obj=obj%realVec, & & nodenum=indx, & & dataType=1.0_DFP) END IF -END PROCEDURE anf_getSingle +END PROCEDURE anf_GetSingle + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE AbstractNodeFieldInitiate +CHARACTER(*), PARAMETER :: myName = "AbstractNodeFieldInitiate" +INTEGER(I4B), ALLOCATABLE :: spaceCompo(:) +INTEGER(I4B), ALLOCATABLE :: timeCompo(:) +INTEGER(I4B) :: storageFMT +CHARACTER(1), ALLOCATABLE :: names_char(:) + +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[WIP] :: This routine is under development') + +! CALL AbstractFieldInitiate(obj=obj, param=param, prefix=prefix, dom=dom) +! CALL Initiate_FE(obj=obj%fe, param=param, dom=dom) +! !INFO: Initiate_FE is defined in FiniteElement_Class +! spaceCompo = obj%GetSpaceCompo() +! timeCompo = obj%GetTimeCompo() +! storageFMT = obj%GetStorageFMT() +! ! names_char = obj%GetNames() +! !FIXME: How to get the names in the vase of block matrix? +! +! IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN +! tNodes = 1 +! ELSE +! tNodes = obj%GetTotalDOF() +! END IF +! +! CALL Initiate( & +! & obj=obj%dof, & +! & tNodes=tNodes, & +! & names=names_char, & +! & spaceCompo=spaceCompo, & +! & timeCompo=timeCompo, & +! & storageFMT=storageFMT) +! +! CALL Initiate(obj%realVec, obj%dof) +! +! obj%tSize = SIZE(obj%realVec) +! +! IF (obj%local_n .EQ. 0) THEN +! obj%local_n = obj%tSize +! END IF +! IF (obj%global_n .EQ. 0) THEN +! obj%global_n = obj%tSize +! END IF + +END PROCEDURE AbstractNodeFieldInitiate !---------------------------------------------------------------------------- ! diff --git a/src/submodules/DirichletBC/src/DirichletBC_Class@ConstructorMethods.F90 b/src/submodules/DirichletBC/src/DirichletBC_Class@ConstructorMethods.F90 index c7fff8c79..b37d055f4 100644 --- a/src/submodules/DirichletBC/src/DirichletBC_Class@ConstructorMethods.F90 +++ b/src/submodules/DirichletBC/src/DirichletBC_Class@ConstructorMethods.F90 @@ -34,18 +34,17 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setDirichletBCParam -CALL setAbstractBCParam(& -& param=param, & -& prefix=myprefix, & -& name=name, & -& idof=idof, & -& nodalValueType=nodalValueType, & -& useFunction=input(option=useFunction, default=.FALSE.), & -& isNormal=input(option=isNormal, default=.FALSE.), & -& isTangent=input(option=isTangent, default=.FALSE.) & -) -END PROCEDURE setDirichletBCParam +MODULE PROCEDURE SetDirichletBCParam +CALL SetAbstractBCParam(& + & param=param, & + & prefix=myprefix, & + & name=name, & + & idof=idof, & + & nodalValueType=nodalValueType, & + & useFunction=input(option=useFunction, default=.FALSE.), & + & isNormal=input(option=isNormal, default=.FALSE.), & + & isTangent=input(option=isTangent, default=.FALSE.)) +END PROCEDURE SetDirichletBCParam !---------------------------------------------------------------------------- ! @@ -67,4 +66,64 @@ CALL obj%DEALLOCATE() END PROCEDURE bc_Final +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE bc_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Ptr_Vector +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 bc_Deallocate_Ptr_Vector + +!---------------------------------------------------------------------------- +! AddDirichletBC +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_AddDirichletBC +CHARACTER(*), PARAMETER :: myName = "bc_AddDirichletBC" + +IF (dbcNo .GT. SIZE(dbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: dbcNo [= '//TOSTRING(dbcNo)// & + & '] is out of bound for dbc [= '// & + & TOSTRING(SIZE(dbc))//']') +END IF + +IF (ASSOCIATED(dbc(dbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: DBC( '//TOSTRING(dbcNo)// & + & ')%ptr is already associated, deallocate and nullify it first.') +END IF + +ALLOCATE (dbc(dbcNo)%ptr) + +CALL dbc(dbcNo)%ptr%initiate( & + & param=param, & + & boundary=boundary, & + & dom=dom) + +END PROCEDURE bc_AddDirichletBC + END SUBMODULE ConstructorMethods diff --git a/src/submodules/DirichletBC/src/DirichletBC_Class@GetMethods.F90 b/src/submodules/DirichletBC/src/DirichletBC_Class@GetMethods.F90 index 0212ca7fc..a5e2676b3 100644 --- a/src/submodules/DirichletBC/src/DirichletBC_Class@GetMethods.F90 +++ b/src/submodules/DirichletBC/src/DirichletBC_Class@GetMethods.F90 @@ -16,7 +16,30 @@ ! SUBMODULE(DirichletBC_Class) GetMethods +USE BaseMethod, ONLY: TOSTRING IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! GetDirichletBCPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_GetDirichletBCPointer +CHARACTER(*), PARAMETER :: myName = "bc_GetDirichletBCPointer" + +IF (dbcNo .GT. SIZE(dbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: dbcNo is out of bound for dbc') +END IF + +IF (.NOT. ASSOCIATED(dbc(dbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: dbc( '//TOSTRING(dbcNo) & + & //')%ptr is not ASSOCIATED') +END IF + +ans => dbc(dbcNo)%ptr + +END PROCEDURE bc_GetDirichletBCPointer + END SUBMODULE GetMethods diff --git a/src/submodules/Domain/src/Domain_Class@GetMethods.F90 b/src/submodules/Domain/src/Domain_Class@GetMethods.F90 index f4c50b436..958afea09 100644 --- a/src/submodules/Domain/src/Domain_Class@GetMethods.F90 +++ b/src/submodules/Domain/src/Domain_Class@GetMethods.F90 @@ -27,20 +27,20 @@ ! isNodePresent !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_isNodePresent +MODULE PROCEDURE Domain_IsNodePresent ans = .TRUE. IF (globalNode .GT. obj%maxNptrs .OR. globalNode .LT. obj%minNptrs) THEN ans = .FALSE. ELSE IF (obj%local_nptrs(globalNode) .EQ. 0) THEN ans = .FALSE. END IF -END PROCEDURE Domain_isNodePresent +END PROCEDURE Domain_IsNodePresent !---------------------------------------------------------------------------- ! isElementPresent !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_isElementPresent +MODULE PROCEDURE Domain_IsElementPresent CLASS(Mesh_), POINTER :: meshptr INTEGER(I4B) :: dim, entityNum !> main @@ -53,38 +53,37 @@ END DO END DO dimloop NULLIFY (meshptr) -END PROCEDURE Domain_isElementPresent +END PROCEDURE Domain_IsElementPresent !---------------------------------------------------------------------------- ! getConnectivity !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getConnectivity +MODULE PROCEDURE Domain_GetConnectivity CLASS(Mesh_), POINTER :: meshptr -! + ! main -! meshptr => NULL() meshptr => obj%getMeshPointer(globalElement=globalElement) -! + IF (ASSOCIATED(meshptr)) THEN ans = meshptr%getConnectivity(globalElement) ELSE ALLOCATE (ans(0)) END IF -! + NULLIFY (meshptr) -END PROCEDURE Domain_getConnectivity +END PROCEDURE Domain_GetConnectivity !---------------------------------------------------------------------------- ! getNodeToElements !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNodeToElements1 +MODULE PROCEDURE Domain_GetNodeToElements1 CLASS(Mesh_), POINTER :: meshptr INTEGER(I4B) :: dim, entityNum INTEGER(I4B), ALLOCATABLE :: ivec(:) -!> main + meshptr => NULL() IF (obj%isNodePresent(globalNode=globalNode)) THEN dimloop: DO dim = 0, obj%nsd @@ -99,17 +98,17 @@ ELSE ALLOCATE (ans(0)) END IF -END PROCEDURE Domain_getNodeToElements1 +END PROCEDURE Domain_GetNodeToElements1 !---------------------------------------------------------------------------- ! getNodeToElements !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNodeToElements2 +MODULE PROCEDURE Domain_GetNodeToElements2 TYPE(IntVector_) :: intvec INTEGER(I4B), ALLOCATABLE :: ivec(:) INTEGER(I4B) :: ii -!> main + DO ii = 1, SIZE(GlobalNode) ivec = obj%getNodeToElements(GlobalNode=GlobalNode(ii)) CALL append(intvec, ivec) @@ -117,17 +116,17 @@ ans = intvec CALL DEALLOCATE (intvec) IF (ALLOCATED(ivec)) DEALLOCATE (ivec) -END PROCEDURE Domain_getNodeToElements2 +END PROCEDURE Domain_GetNodeToElements2 !---------------------------------------------------------------------------- ! getTotalNodes !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getTotalNodes -CHARACTER(*), PARAMETER :: myName = "Domain_getTotalNodes" +MODULE PROCEDURE Domain_GetTotalNodes +CHARACTER(*), PARAMETER :: myName = "Domain_GetTotalNodes" CLASS(Mesh_), POINTER :: meshPtr INTEGER(I4B) :: ii -!> + IF (PRESENT(entityNum) .AND. PRESENT(dim)) THEN IF (obj%meshList(dim)%isEmpty()) & & CALL e%raiseError(modName//'::'//myName//'-'// & @@ -157,7 +156,7 @@ ELSE ans = obj%tNodes END IF -END PROCEDURE Domain_getTotalNodes +END PROCEDURE Domain_GetTotalNodes !---------------------------------------------------------------------------- ! tNodes @@ -187,7 +186,7 @@ ! getTotalElements !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getTotalElements +MODULE PROCEDURE Domain_GetTotalElements CLASS(Mesh_), POINTER :: meshptr ! main IF (PRESENT(dim) .AND. PRESENT(entityNum)) THEN @@ -199,7 +198,7 @@ ELSE ans = SUM(obj%tElements) END IF -END PROCEDURE Domain_getTotalElements +END PROCEDURE Domain_GetTotalElements !---------------------------------------------------------------------------- ! tElements @@ -229,49 +228,47 @@ ! getLocalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getLocalNodeNumber1 +MODULE PROCEDURE Domain_GetLocalNodeNumber1 IF (obj%isNodePresent(globalNode)) THEN ans = obj%local_nptrs(globalNode) ELSE ans = 0 END IF -END PROCEDURE Domain_getLocalNodeNumber1 +END PROCEDURE Domain_GetLocalNodeNumber1 !---------------------------------------------------------------------------- ! getLocalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getLocalNodeNumber2 +MODULE PROCEDURE Domain_GetLocalNodeNumber2 INTEGER(I4B) :: ii -! DO ii = 1, SIZE(globalNode) IF (obj%isNodePresent(globalNode(ii))) THEN ans(ii) = obj%local_nptrs(globalNode(ii)) ELSE ans(ii) = 0 END IF - ! ans(ii) = Domain_getLocalNodeNumber1(obj, globalNode(ii)) + ! ans(ii) = Domain_GetLocalNodeNumber1(obj, globalNode(ii)) END DO -! -END PROCEDURE Domain_getLocalNodeNumber2 +END PROCEDURE Domain_GetLocalNodeNumber2 !---------------------------------------------------------------------------- ! getGlobalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getGlobalNodeNumber1 +MODULE PROCEDURE Domain_GetGlobalNodeNumber1 IF (localNode .LE. obj%tNodes) THEN ans = obj%global_nptrs(localNode) ELSE ans = 0 END IF -END PROCEDURE Domain_getGlobalNodeNumber1 +END PROCEDURE Domain_GetGlobalNodeNumber1 !---------------------------------------------------------------------------- ! getGlobalNodeNumber !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getGlobalNodeNumber2 +MODULE PROCEDURE Domain_GetGlobalNodeNumber2 INTEGER(I4B) :: ii DO ii = 1, SIZE(localNode) IF (localNode(ii) .LE. obj%tNodes) THEN @@ -280,14 +277,14 @@ ans(ii) = 0 END IF END DO -END PROCEDURE Domain_getGlobalNodeNumber2 +END PROCEDURE Domain_GetGlobalNodeNumber2 !---------------------------------------------------------------------------- ! getTotalMesh !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getTotalMesh -CHARACTER(*), PARAMETER :: myName = "Domain_getTotalMesh" +MODULE PROCEDURE Domain_GetTotalMesh +CHARACTER(*), PARAMETER :: myName = "Domain_GetTotalMesh" IF (dim .LT. 0 .OR. dim .GT. 3) THEN CALL e%raiseError(modName//"::"//myName//" - "// & & "dim of the mesh should be in [0,1,2,3]") @@ -297,14 +294,14 @@ ELSE ans = obj%meshList(dim)%SIZE() END IF -END PROCEDURE Domain_getTotalMesh +END PROCEDURE Domain_GetTotalMesh !---------------------------------------------------------------------------- ! getMeshPointer !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getMeshPointer1 -CHARACTER(*), PARAMETER :: myName = "Domain_getMeshPointer" +MODULE PROCEDURE Domain_GetMeshPointer1 +CHARACTER(*), PARAMETER :: myName = "Domain_GetMeshPointer" INTEGER(I4B) :: tsize, imesh TYPE(MeshPointerIterator_) :: iterator !> main @@ -319,16 +316,16 @@ END DO ans => iterator%VALUE%ptr CALL iterator%DEALLOCATE() -END PROCEDURE Domain_getMeshPointer1 +END PROCEDURE Domain_GetMeshPointer1 !---------------------------------------------------------------------------- ! getMeshPointer !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getMeshPointer2 -CHARACTER(*), PARAMETER :: myname = "Domain_getMeshPointer2" +MODULE PROCEDURE Domain_GetMeshPointer2 +CHARACTER(*), PARAMETER :: myname = "Domain_GetMeshPointer2" INTEGER(i4b) :: dim, entityNum -!> main +! main ans => NULL() dimloop: DO dim = 0, obj%nsd DO entityNum = 1, obj%getTotalMesh(dim=dim) @@ -340,18 +337,17 @@ END IF END DO END DO dimloop -END PROCEDURE Domain_getMeshPointer2 +END PROCEDURE Domain_GetMeshPointer2 !---------------------------------------------------------------------------- ! getDimEntityNum !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getDimEntityNum +MODULE PROCEDURE Domain_GetDimEntityNum INTEGER(i4b) :: dim, entityNum CLASS(Mesh_), POINTER :: meshptr ! main ans = 0 -! dimloop: DO dim = 0, obj%nsd DO entityNum = 1, obj%getTotalMesh(dim=dim) meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) @@ -361,14 +357,14 @@ END IF END DO END DO dimloop -END PROCEDURE Domain_getDimEntityNum +END PROCEDURE Domain_GetDimEntityNum !---------------------------------------------------------------------------- ! getNodeCoord !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNodeCoord -CHARACTER(*), PARAMETER :: myName = "Domain_getNodeCoord" +MODULE PROCEDURE Domain_GetNodeCoord +CHARACTER(*), PARAMETER :: myName = "Domain_GetNodeCoord" CLASS(Mesh_), POINTER :: meshPtr INTEGER(I4B) :: np, ii, jj !> main, check @@ -389,35 +385,32 @@ ELSE nodeCoord = obj%nodeCoord END IF -END PROCEDURE Domain_getNodeCoord +END PROCEDURE Domain_GetNodeCoord !---------------------------------------------------------------------------- ! getNodeCoordPointer !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNodeCoordPointer +MODULE PROCEDURE Domain_GetNodeCoordPointer ans => obj%nodeCoord -END PROCEDURE Domain_getNodeCoordPointer +END PROCEDURE Domain_GetNodeCoordPointer !---------------------------------------------------------------------------- ! getGlobalToLocalNodeNumPointer !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getGlobalToLocalNodeNumPointer +MODULE PROCEDURE Domain_GetGlobalToLocalNodeNumPointer ans => obj%local_nptrs -END PROCEDURE Domain_getGlobalToLocalNodeNumPointer +END PROCEDURE Domain_GetGlobalToLocalNodeNumPointer !---------------------------------------------------------------------------- ! getNptrs !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNptrs +MODULE PROCEDURE Domain_GetNptrs INTEGER(I4B) :: ii CLASS(Mesh_), POINTER :: meshptr TYPE(IntVector_) :: intvec -! -! -! meshptr => NULL() DO ii = 1, SIZE(entityNum) meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum(ii)) @@ -425,27 +418,20 @@ CALL APPEND(intvec, meshptr%getNptrs()) END IF END DO -! CALL RemoveDuplicates(intvec) -! ans = intvec -! CALL DEALLOCATE (intvec) NULLIFY (meshptr) -! -END PROCEDURE Domain_getNptrs +END PROCEDURE Domain_GetNptrs !---------------------------------------------------------------------------- ! getNptrs !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getInternalNptrs +MODULE PROCEDURE Domain_GetInternalNptrs INTEGER(I4B) :: ii CLASS(Mesh_), POINTER :: meshptr TYPE(IntVector_) :: intvec -! -! -! meshptr => NULL() DO ii = 1, SIZE(entityNum) meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum(ii)) @@ -453,29 +439,25 @@ CALL APPEND(intvec, meshptr%getInternalNptrs()) END IF END DO -! CALL RemoveDuplicates(intvec) -! ans = intvec -! CALL DEALLOCATE (intvec) NULLIFY (meshptr) -! -END PROCEDURE Domain_getInternalNptrs +END PROCEDURE Domain_GetInternalNptrs !---------------------------------------------------------------------------- ! getNSD !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getNSD +MODULE PROCEDURE Domain_GetNSD ans = obj%NSD -END PROCEDURE Domain_getNSD +END PROCEDURE Domain_GetNSD !---------------------------------------------------------------------------- ! getNSD !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getOrder +MODULE PROCEDURE Domain_GetOrder INTEGER(I4B) :: ii CLASS(Mesh_), POINTER :: meshptr ! @@ -491,13 +473,13 @@ meshptr => NULL() END DO ! -END PROCEDURE Domain_getOrder +END PROCEDURE Domain_GetOrder !---------------------------------------------------------------------------- ! getBoundingBox !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getBoundingBox +MODULE PROCEDURE Domain_GetBoundingBox REAL(DFP) :: lim(6) INTEGER(I4B) :: nsd !> main @@ -506,16 +488,14 @@ 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 Domain_getBoundingBox +END PROCEDURE Domain_GetBoundingBox !---------------------------------------------------------------------------- ! getTotalMeshFacetData !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getTotalMeshFacetData -! +MODULE PROCEDURE Domain_GetTotalMeshFacetData IF (PRESENT(imeshFacetData)) THEN - ! IF (ALLOCATED(obj%meshFacetData)) THEN IF (obj%meshFacetData(imeshFacetData)%isInitiated()) THEN ans = obj%meshFacetData(imeshFacetData)%SIZE() @@ -525,33 +505,31 @@ ELSE ans = 0 END IF - ! ELSE - ! IF (ALLOCATED(obj%meshFacetData)) THEN ans = SIZE(obj%meshFacetData) ELSE ans = 0 END IF - ! END IF -END PROCEDURE Domain_getTotalMeshFacetData +END PROCEDURE Domain_GetTotalMeshFacetData !---------------------------------------------------------------------------- ! getTotalMaterial !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_getTotalMaterial1 +MODULE PROCEDURE Domain_GetTotalMaterial1 INTEGER(I4B) :: ii, n -CLASS(mesh_), POINTER :: meshptr -n = obj%getTotalMesh(dim=dim) +CLASS(Mesh_), POINTER :: meshptr +meshptr => NULL() +n = obj%GetTotalMesh(dim=dim) ALLOCATE (ans(n)) DO ii = 1, n - meshptr => obj%getMeshPointer(dim=dim, entityNum=ii) - ans(ii) = meshptr%getTotalMaterial() + meshptr => obj%GetMeshPointer(dim=dim, entityNum=ii) + ans(ii) = meshptr%GetTotalMaterial() END DO meshptr => NULL() -END PROCEDURE Domain_getTotalMaterial1 +END PROCEDURE Domain_GetTotalMaterial1 !---------------------------------------------------------------------------- ! GetTotalMaterial @@ -559,11 +537,75 @@ MODULE PROCEDURE Domain_GetTotalMaterial2 CLASS(mesh_), POINTER :: meshptr -meshptr => obj%getMeshPointer(dim=dim, entityNum=entityNum) -ans = meshptr%getTotalMaterial() +meshptr => obj%GetMeshPointer(dim=dim, entityNum=entityNum) +ans = meshptr%GetTotalMaterial() meshptr => NULL() END PROCEDURE Domain_GetTotalMaterial2 +!---------------------------------------------------------------------------- +! Domain_GetElemType +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Domain_GetElemType +CHARACTER(*), PARAMETER :: myName = "Domain_GetTotalMesh" +CLASS(mesh_), POINTER :: meshptr +INTEGER(I4B) :: ii, tMesh, idim, nsd, jj + +IF (dim .GT. 3) THEN + CALL e%raiseError(modName//"::"//myName//" - "// & + & "[ARG ERROR] Dim of the mesh should be in [0,1,2,3]"// & + & " given dim is equal to "//tostring(dim)) + RETURN +END IF + +IF (dim .LT. 0) THEN + tMesh = 0 + nsd = obj%GetNSD() + jj = 0 + + DO idim = 1, nsd + tMesh = tMesh + obj%GetTotalMesh(dim=idim) + END DO + + CALL Reallocate(ans, tMesh) + + DO idim = 1, nsd + DO ii = 1, obj%GetTotalMesh(dim=idim) + meshptr => obj%GetMeshPointer( & + & dim=idim, & + & entityNum=ii) + jj = jj + 1 + CALL meshptr%GetParam(elemType=ans(jj)) + END DO + END DO + + meshptr => NULL() + RETURN +END IF + +tMesh = obj%GetTotalMesh(dim=dim) +CALL Reallocate(ans, tMesh) + +DO ii = 1, tMesh + meshptr => obj%GetMeshPointer( & + & dim=dim, & + & entityNum=ii) + CALL meshptr%GetParam(elemType=ans(ii)) +END DO + +meshptr => NULL() + +END PROCEDURE Domain_GetElemType + +!---------------------------------------------------------------------------- +! GetUniqueElemType +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Domain_GetUniqueElemType +ans = obj%GetElemType(dim=dim) +CALL RemoveDuplicates(ans) +END PROCEDURE Domain_GetUniqueElemType + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 b/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 index a5a34bd41..45c8df029 100644 --- a/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 +++ b/src/submodules/Domain/src/Domain_Class@MeshDataMethods.F90 @@ -182,7 +182,7 @@ IF (jj .NE. ii) THEN slaveMesh => obj%getMeshPointer(dim=obj%nsd, entityNum=jj) IF (slaveMesh%isAllNodePresent(faceNptrs)) THEN - CALL masterMesh%setFacetElementType(globalElement=iel, & + CALL masterMesh%SetFacetElementType(globalElement=iel, & & iface=kk, facetElementType=BOUNDARY_ELEMENT) EXIT END IF @@ -206,12 +206,12 @@ ! SetDomainFacetElement !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_setDomainFacetElement +MODULE PROCEDURE Domain_SetDomainFacetElement CLASS(Mesh_), POINTER :: masterMesh, slaveMesh INTEGER(I4B) :: tsize, ii, jj, iel, tDomFacet, tMeshFacet INTEGER(I4B), ALLOCATABLE :: faceNptrs(:) LOGICAL(LGT) :: faceFound, isVar -CHARACTER(*), PARAMETER :: myName = "Domain_setDomainFacetElement" +CHARACTER(*), PARAMETER :: myName = "Domain_SetDomainFacetElement" tsize = obj%getTotalMesh(dim=obj%nsd) @@ -273,14 +273,14 @@ NULLIFY (masterMesh, slaveMesh) IF (ALLOCATED(faceNptrs)) DEALLOCATE (faceNptrs) -END PROCEDURE Domain_setDomainFacetElement +END PROCEDURE Domain_SetDomainFacetElement !---------------------------------------------------------------------------- -! setMeshMap +! SetMeshMap !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_setMeshmap -CHARACTER(*), PARAMETER :: myName = "Domain_setMeshmap" +MODULE PROCEDURE Domain_SetMeshmap +CHARACTER(*), PARAMETER :: myName = "Domain_SetMeshmap" CLASS(Mesh_), POINTER :: masterMesh, slaveMesh INTEGER(I4B) :: tsize, ii, jj, iel, tDomFacet, tMeshFacet INTEGER(I4B), ALLOCATABLE :: nptrs(:), meshmap(:, :) @@ -355,40 +355,37 @@ IF (ALLOCATED(meshmap)) DEALLOCATE (meshmap) NULLIFY (masterMesh, slaveMesh) -END PROCEDURE Domain_setMeshmap +END PROCEDURE Domain_SetMeshmap !---------------------------------------------------------------------------- -! setMeshFacetElement +! SetMeshFacetElement !---------------------------------------------------------------------------- -MODULE PROCEDURE Domain_setMeshFacetElement -CHARACTER(*), PARAMETER :: myName = "Domain_setMeshFacetElement" +MODULE PROCEDURE Domain_SetMeshFacetElement +CHARACTER(*), PARAMETER :: myName = "Domain_SetMeshFacetElement" 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(:) -! + ! main -! IF (.NOT. obj%meshmap%isInitiated) THEN CALL e%raiseInformation(modName//'::'//myName//' - '// & - & 'Domain_::obj%meshMap is not initiated, calling obj%setMeshMap()') - CALL obj%setMeshMap() + & 'Domain_::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 -! + +! 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) @@ -402,101 +399,96 @@ ! 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) -! -END PROCEDURE Domain_setMeshFacetElement + +END PROCEDURE Domain_SetMeshFacetElement !---------------------------------------------------------------------------- ! diff --git a/src/submodules/DomainConnectivity/src/DomainConnectivity_Class@ConstructorMethods.F90 b/src/submodules/DomainConnectivity/src/DomainConnectivity_Class@ConstructorMethods.F90 index 748cf5947..dde5f5ce0 100644 --- a/src/submodules/DomainConnectivity/src/DomainConnectivity_Class@ConstructorMethods.F90 +++ b/src/submodules/DomainConnectivity/src/DomainConnectivity_Class@ConstructorMethods.F90 @@ -35,12 +35,43 @@ IF (ALLOCATED(obj%elemToElem)) DEALLOCATE (obj%elemToElem) END PROCEDURE dc_Deallocate +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE dc_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 dc_Deallocate2 + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE dc_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 dc_Deallocate3 + !---------------------------------------------------------------------------- ! Final !---------------------------------------------------------------------------- MODULE PROCEDURE dc_Final -CALL obj%Deallocate() +CALL obj%DEALLOCATE() END PROCEDURE dc_Final !---------------------------------------------------------------------------- diff --git a/src/submodules/FieldFactory/src/FieldFactory@Methods.F90 b/src/submodules/FieldFactory/src/FieldFactory@Methods.F90 index 1c3e3476f..02c014497 100644 --- a/src/submodules/FieldFactory/src/FieldFactory@Methods.F90 +++ b/src/submodules/FieldFactory/src/FieldFactory@Methods.F90 @@ -20,45 +20,105 @@ ! summary: This modules is a factory for linear solvers SUBMODULE(FieldFactory) Methods +USE FPL, ONLY: ParameterList_ +USE BaseMethod IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! MeshFieldFactory +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MeshFieldFactory +CHARACTER(*), PARAMETER :: myName = "MatrixFieldFactory" +! TYPE(String) :: engine0 +TYPE(String) :: name0 + +! engine0 = UpperCase(TRIM(engine)) +name0 = UpperCase(TRIM(name)) + +SELECT CASE (name0%chars()) + +CASE ("SCALAR") + ALLOCATE (ScalarMeshField_ :: ans) + +CASE ("STSCALAR") + + ALLOCATE (STScalarMeshField_ :: ans) + +CASE ("VECTOR") + + ALLOCATE (VectorMeshField_ :: ans) + +CASE ("STVECTOR") + + ALLOCATE (STVectorMeshField_ :: ans) + +CASE ("TENSOR") + + ALLOCATE (TensorMeshField_ :: ans) + +CASE ("STTENSOR") + + ALLOCATE (STTensorMeshField_ :: ans) + +CASE DEFAULT + + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] :: No case found for given name'// & + & " following values are accepted = "// & + & "[Scalar, STScalar, Vector, STVector, Tensor, STTensor]"// & + & " but found "//TRIM(name)) + +END SELECT +END PROCEDURE MeshFieldFactory + !---------------------------------------------------------------------------- ! MatrixFieldFactory !---------------------------------------------------------------------------- MODULE PROCEDURE MatrixFieldFactory CHARACTER(*), PARAMETER :: myName = "MatrixFieldFactory" +TYPE(String) :: engine0 -SELECT CASE (TRIM(engine)) +engine0 = UpperCase(TRIM(engine)) + +SELECT CASE (engine0%chars()) CASE ("NATIVE_SERIAL", "LIS_OMP") ALLOCATE (MatrixField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & - & 'NATIVE_OMP engine is not available currently!!') + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[WORK IN PROGRESS] :: NATIVE_OMP engine is not available currently!!') + !! TODO: Implement MatrixFieldFactory for NATIVE_OMP CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & - & 'NATIVE_MPI engine is not available currently!!') + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[WORK IN PROGRESS] :: NATIVE_MPI engine is not available currently!!') + !! TODO: Implement MatrixFieldFactory for NATIVE_MPI CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & - & 'PETSC engine is not available currently!!') + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[WORK IN PROGRESS] :: PETSC engine is not available currently!!') + !! TODO: Implement MatrixFieldFactory for PETSC CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & - & 'LIS_MPI engine is not available currently!!') + CALL e%RaiseError(modName//'::'//myName//" - "// & + & '[WORK IN PROGRESS] :: LIS_MPI engine is not available currently!!') + !! TODO: Implement MatrixFieldFactory for LIS_MPI CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & - & 'No case found for given engine') + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] :: No case found for given engine '// & + & "following values are acceptable = "// & + & "[NATIVE_SERIAL, LIS_OMP, NATIVE_OMP, NATIVE_MPI, PETSC, LIS_MPI]"// & + & " but found engine = "//TRIM(engine0)) END SELECT END PROCEDURE MatrixFieldFactory @@ -77,22 +137,22 @@ CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') END SELECT @@ -123,32 +183,32 @@ CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT @@ -167,27 +227,27 @@ ALLOCATE (BlockNodeField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT @@ -206,27 +266,27 @@ ALLOCATE (ScalarField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT @@ -245,27 +305,27 @@ ALLOCATE (VectorField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT @@ -284,27 +344,27 @@ ALLOCATE (STVectorField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT @@ -324,30 +384,126 @@ ALLOCATE (STScalarField_ :: ans) CASE ("NATIVE_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_OMP engine is not available, currently!!') CASE ("NATIVE_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'NATIVE_MPI engine is not available currently!!') CASE ("PETSC") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'PETSC engine is not available currently!!') CASE ("LIS_OMP") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_OMP engine is not available currently!!') CASE ("LIS_MPI") - CALL e%raiseError(modName//'::'//myName//" - "// & + CALL e%RaiseError(modName//'::'//myName//" - "// & & 'LIS_MPI engine is not available currently!!') CASE DEFAULT - CALL e%raiseError(modName//'::'//myName//' - '// & + CALL e%RaiseError(modName//'::'//myName//' - '// & & 'No case found for given engine') END SELECT END PROCEDURE STScalarFieldFactory +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE VectorField_Initiate1 +CHARACTER(*), PARAMETER :: myName = "VectorFieldIntiate1" +INTEGER(I4B) :: tsize, ii +TYPE(ParameterList_) :: param + +CALL param%Initiate() + +tsize = SIZE(obj) + +IF (SIZE(names) .LT. tsize) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[ARG ERROR] :: The size of names should be atleast the size of obj') +END IF + +DO ii = 1, tsize + IF (ASSOCIATED(obj(ii)%ptr)) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[ALLOCATION ERROR] :: obj('//tostring(ii)// & + & ") is already associated. We don't allocate like this"// & + & " as it may cause memory leak.") + END IF + + obj(ii)%ptr => VectorFieldFactory(engine) + + CALL SetVectorFieldParam( & + & param=param, & + & name=names(ii)%Chars(), & + & spaceCompo=spaceCompo, & + & fieldType=fieldType, & + & engine=engine) + + CALL obj(ii)%ptr%Initiate(param=param, dom=dom) +END DO + +CALL param%DEALLOCATE() + +END PROCEDURE VectorField_Initiate1 + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE VectorField_Initiate2 +CHARACTER(*), PARAMETER :: myName = "VectorFieldIntiate2" +INTEGER(I4B) :: tsize, ii, nn(6) +TYPE(ParameterList_) :: param + +CALL param%Initiate() + +tsize = SIZE(obj) + +nn = [ & + & tsize, SIZE(names), SIZE(spaceCompo), SIZE(fieldType), SIZE(engine), & + & SIZE(dom) & +] + +CALL Assert( & + & nn=nn, & + & msg="[ARG ERROR] :: The size of obj, names, spaceCompo, fileType, "// & + & "engine, dom should be the same", & + & file=__FILE__, line=__LINE__, routine=myName) + +DO ii = 1, tsize + IF (ASSOCIATED(obj(ii)%ptr)) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[ALLOCATION ERROR] :: VectorField_::obj('//tostring(ii)// & + & ") is already associated. We don't allocate like this"// & + & ", as it may cause memory leak.") + END IF + + IF (.NOT. ASSOCIATED(dom(ii)%ptr)) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[POINTER ERROR] :: Domain_::dom('//tostring(ii)// & + & ") is not associated. It will lead to segmentation fault.") + END IF + + obj(ii)%ptr => VectorFieldFactory(engine(ii)%Chars()) + + CALL SetVectorFieldParam( & + & param=param, & + & name=names(ii)%Chars(), & + & spaceCompo=spaceCompo(ii), & + & fieldType=fieldType(ii), & + & engine=engine(ii)%Chars()) + + CALL obj(ii)%ptr%Initiate(param=param, dom=dom(ii)%ptr) +END DO + +CALL param%DEALLOCATE() + +END PROCEDURE VectorField_Initiate2 + END SUBMODULE Methods diff --git a/src/submodules/FiniteElement/CMakeLists.txt b/src/submodules/FiniteElement/CMakeLists.txt index 8857fea93..5eadeed80 100644 --- a/src/submodules/FiniteElement/CMakeLists.txt +++ b/src/submodules/FiniteElement/CMakeLists.txt @@ -13,11 +13,18 @@ # # 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}/AbstractFE_Class@Methods.F90 - ${src_path}/LagrangeFE_Class@Methods.F90 -) \ No newline at end of file + ${src_path}/AbstractFE_Class@ConstructorMethods.F90 + ${src_path}/AbstractFE_Class@IOMethods.F90 + ${src_path}/AbstractFE_Class@GetMethods.F90 + ${src_path}/AbstractFE_Class@SetMethods.F90 + ${src_path}/AbstractFE_Class@H1Methods.F90 + ${src_path}/AbstractFE_Class@HDivMethods.F90 + ${src_path}/AbstractFE_Class@HCurlMethods.F90 + ${src_path}/AbstractFE_Class@DGMethods.F90 + ${src_path}/AbstractFE_Class@QuadratureMethods.F90 + ${src_path}/FiniteElement_Class@Methods.F90 +) diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@ConstructorMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@ConstructorMethods.F90 new file mode 100644 index 000000000..71f25edb9 --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@ConstructorMethods.F90 @@ -0,0 +1,977 @@ +! 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(AbstractFE_Class) ConstructorMethods +USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +USE FPL_Method, ONLY: GetValue +USE RefElementFactory, ONLY: RefElement_Pointer +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! CheckEssentialParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_CheckEssentialParam +CHARACTER(*), PARAMETER :: myName = "fe_CheckEssentialParam" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[IMPLEMENTATION ERROR] :: This routine should be implemented '// & + & ' by the child class.') +END PROCEDURE fe_CheckEssentialParam + +!---------------------------------------------------------------------------- +! CheckEssentialParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE AbstractFECheckEssentialParam +CHARACTER(*), PARAMETER :: myName = "AbstractFECheckEssentialParam()" +INTEGER(I4B), PARAMETER :: jj = 26 +TYPE(String) :: necessary(jj) +INTEGER(I4B) :: ii, ierr + +necessary(1) = prefix//"/nsd" +necessary(2) = prefix//"/order" +necessary(3) = prefix//"/anisoOrder" +necessary(4) = prefix//"/tEdgeOrder" +necessary(5) = prefix//"/edgeOrder" +necessary(6) = prefix//"/tFaceOrder" +necessary(7) = prefix//"/faceOrder" +necessary(8) = prefix//"/cellOrder" +necessary(9) = prefix//"/feType" +necessary(10) = prefix//"/elemType" +necessary(11) = prefix//"/ipType" +necessary(12) = prefix//"/dofType" +necessary(13) = prefix//"/transformType" +necessary(14) = prefix//"/refElemDomain" +necessary(15) = prefix//"/baseContinuity" +necessary(16) = prefix//"/baseInterpolation" +necessary(17) = prefix//"/isIsotropicOrder" +necessary(18) = prefix//"/isAnisotropicOrder" +necessary(19) = prefix//"/isEdgeOrder" +necessary(20) = prefix//"/isFaceOrder" +necessary(21) = prefix//"/isCellOrder" +necessary(22) = prefix//"/tCellOrder" +necessary(23) = prefix//"/basisType" +necessary(24) = prefix//"/alpha" +necessary(25) = prefix//"/beta" +necessary(26) = prefix//"/lambda" + +DO ii = 1, jj + IF (.NOT. param%isPresent(key=necessary(ii)%chars())) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & necessary(ii)//' should be present in param') + END IF +END DO + +END PROCEDURE AbstractFECheckEssentialParam + +!---------------------------------------------------------------------------- +! SetAbstractFEParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE SetAbstractFEParam +INTEGER(I4B) :: ierr, ii, ipType0 +TYPE(String) :: astr +CHARACTER(*), PARAMETER :: myName = "SetAbstractFEParam()" +TYPE(ParameterList_), POINTER :: sublist + +sublist => NULL() +sublist => param%NewSubList(key=prefix) + +ierr = sublist%Set(key=prefix//"/nsd", VALUE=nsd) +ierr = sublist%Set(key=prefix//"/elemType", VALUE=elemType) +ierr = sublist%Set(key=prefix//"/baseContinuity", VALUE=baseContinuity) +ierr = sublist%Set(key=prefix//"/baseInterpolation", VALUE=baseInterpolation) + +! TODO finite element type +CALL e%raiseWarning(modName//'::'//myName//' - '// & + & '[BUG] feType, dofType, transformType are not handled properly.') + +ierr = sublist%Set(key=prefix//"/feType", VALUE=Scalar) +ierr = sublist%Set(key=prefix//"/dofType", VALUE=DEFAULT_DOF_TYPE) +ierr = sublist%Set(key=prefix//"/transformType", VALUE=DEFAULT_TRANSFORM_TYPE) + +astr = UpperCase(baseInterpolation) +IF (astr%chars() .EQ. "LAGRANGE" .OR. & + & astr%chars() .EQ. "LAGRANGEPOLYNOMIAL") THEN + IF (.NOT. PRESENT(ipType)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[ARGUMENT ERROR] In case of LAGRANGE polynomials & + & ipType should be present.') + END IF +END IF +ipType0 = input(default=Equidistance, option=ipType) +ierr = sublist%Set(key=prefix//"/ipType", VALUE=ipType) + +astr = RefElemDomain( & + & baseInterpol=baseInterpolation, & + & baseContinuity=baseContinuity, & + & elemType=elemType) +ierr = sublist%Set(key=prefix//"/refElemDomain", VALUE=astr%chars()) + +CALL SetFEPram_BasisType( & + & param=sublist, & + & elemType=elemType, & + & nsd=nsd, & + & baseContinuity0=UpperCase(baseContinuity), & + & baseInterpol0=UpperCase(baseInterpolation), & + & basisType=basisType, & + & alpha=alpha, & + & beta=beta, & + & lambda=lambda, & + & prefix=prefix) + +IF (PRESENT(order)) THEN + CALL SetFEPram_Order(param=sublist, order=order, elemType=elemType, & + & prefix=prefix) + sublist => NULL() + RETURN +ELSE + IF (nsd .EQ. 1_I4B) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[ARGUMENT ERROR] For 1D elements Order must be present.') + sublist => NULL() + RETURN + END IF +END IF + +IF (PRESENT(anisoOrder)) THEN + CALL SetFEPram_AnisoOrder( & + & param=sublist, & + & anisoOrder=anisoOrder, & + & elemType=elemType, & + & nsd=nsd, & + & prefix=prefix) + sublist => NULL() + RETURN +END IF + +SELECT CASE (nsd) +CASE (2) + CALL SetFEPram_Heirarchy2D( & + & param=sublist, & + & elemType=elemType, & + & nsd=nsd, & + & edgeOrder=edgeOrder, & + & faceOrder=faceOrder, & + & prefix=prefix) +CASE (3) + CALL SetFEPram_Heirarchy3D( & + & param=sublist, & + & elemType=elemType, & + & nsd=nsd, & + & edgeOrder=edgeOrder, & + & faceOrder=faceOrder, & + & cellOrder=cellOrder, & + & prefix=prefix) +END SELECT + +sublist => NULL() + +END PROCEDURE SetAbstractFEParam + +!---------------------------------------------------------------------------- +! SetFEPram_BasisType +!---------------------------------------------------------------------------- + +SUBROUTINE SetFEPram_BasisType( & + & param, & + & elemType, & + & nsd, & + & baseContinuity0, & + & baseInterpol0, & + & basisType, & + & alpha, & + & beta, lambda, prefix) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: elemType + INTEGER(I4B), INTENT(IN) :: nsd + CHARACTER(*), INTENT(IN) :: baseContinuity0 + CHARACTER(*), INTENT(IN) :: baseInterpol0 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: basisType(:) + REAL(DFP), OPTIONAL, INTENT(IN) :: alpha(:) + REAL(DFP), OPTIONAL, INTENT(IN) :: beta(:) + REAL(DFP), OPTIONAL, INTENT(IN) :: lambda(:) + CHARACTER(*), INTENT(IN) :: prefix + + CHARACTER(*), PARAMETER :: myName = "SetFEPram_BasisType()" + INTEGER(I4B) :: xidim, basisType0(3), ii, ierr + REAL(DFP) :: alpha0(3), beta0(3), lambda0(3) + + alpha0 = 0.0_DFP + beta0 = 0.0_DFP + lambda0 = 0.0_DFP + + SELECT CASE (elemType) + CASE (Line) + IF (baseInterpol0 .EQ. "LAGRANGE" .OR. & + & baseInterpol0 .EQ. "LAGRANGEPOLYNOMIAL") THEN + IF (.NOT. PRESENT(basisType)) THEN + basisType0 = Monomial + ELSE + basisType0 = basisType(1) + END IF + END IF + + IF (baseInterpol0 .EQ. "ORTHOGONAL" .OR. & + & baseInterpol0 .EQ. "ORTHOGONALPOLYNOMIAL") THEN + IF (.NOT. PRESENT(basisType)) THEN + basisType0 = Legendre + ELSE + basisType0 = basisType(1) + END IF + + IF (basisType0(1) .EQ. Jacobi) THEN + IF (PRESENT(alpha)) THEN + alpha0 = alpha(1) + ELSE + alpha0 = 0.0_DFP + END IF + + IF (PRESENT(beta)) THEN + beta0 = beta(1) + ELSE + beta0 = 0.0_DFP + END IF + END IF + + IF (basisType0(1) .EQ. Ultraspherical) THEN + IF (PRESENT(lambda)) THEN + lambda0 = lambda(1) + ELSE + lambda0 = 0.5_DFP + END IF + END IF + END IF + + CASE (Triangle, Tetrahedron, Prism, Pyramid) + IF (baseInterpol0 .EQ. "LAGRANGE" .OR. & + & baseInterpol0 .EQ. "LAGRANGEPOLYNOMIAL") THEN + IF (.NOT. PRESENT(basisType)) THEN + basisType0 = Monomial + ELSE + basisType0 = basisType(1) + END IF + END IF + + CASE (Quadrangle, Hexahedron) + xidim = XiDimension(elemType) + + IF (baseInterpol0 .EQ. "LAGRANGE" .OR. & + & baseInterpol0 .EQ. "LAGRANGEPOLYNOMIAL") THEN + IF (.NOT. PRESENT(basisType)) THEN + basisType0(1:xidim) = Monomial * ones(xidim, 1_I4B) + ELSE + IF (SIZE(basisType) .EQ. 1_I4B) THEN + basisType0 = basisType(1) + ELSE + basisType0(1:xidim) = basisType(1:xidim) + END IF + END IF + END IF + + IF (baseInterpol0 .EQ. "ORTHOGONAL" .OR. & + & baseInterpol0 .EQ. "ORTHOGONALPOLYNOMIAL") THEN + + IF (.NOT. PRESENT(basisType)) THEN + basisType0(1:xidim) = Legendre * ones(xidim, 1_I4B) + ELSE + IF (SIZE(basisType) .EQ. 1_I4B) THEN + basisType0 = basisType(1) + ELSE + basisType0(1:xidim) = basisType(1:xidim) + END IF + END IF + + DO ii = 1, xidim + + IF (basisType0(ii) .EQ. Jacobi) THEN + IF (PRESENT(alpha)) THEN + IF (SIZE(alpha) .EQ. xidim) THEN + alpha0(ii) = alpha(ii) + ELSE + alpha0(ii) = alpha(1) + END IF + END IF + + IF (PRESENT(beta)) THEN + IF (SIZE(beta) .EQ. xidim) THEN + beta0(ii) = beta(ii) + ELSE + beta0(ii) = beta(1) + END IF + END IF + END IF + + IF (basisType0(ii) .EQ. Ultraspherical) THEN + IF (PRESENT(lambda)) THEN + IF (SIZE(lambda) .EQ. xidim) THEN + lambda0(ii) = lambda(ii) + ELSE + lambda0(ii) = lambda(1) + END IF + END IF + END IF + + END DO + END IF + + CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] No case found for given element type') + END SELECT + + ierr = param%Set(key=prefix//"/alpha", VALUE=alpha0) + ierr = param%Set(key=prefix//"/beta", VALUE=beta0) + ierr = param%Set(key=prefix//"/lambda", VALUE=lambda0) + ierr = param%Set(key=prefix//"/basisType", VALUE=basisType0) + +END SUBROUTINE SetFEPram_BasisType + +!---------------------------------------------------------------------------- +! SetFEPram_Order +!---------------------------------------------------------------------------- + +SUBROUTINE SetFEPram_Order(param, order, elemType, prefix) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: order + INTEGER(I4B), INTENT(IN) :: elemType + CHARACTER(*), INTENT(IN) :: prefix + ! Internal variables + INTEGER(I4B) :: tEdgeOrder, tFaceOrder, tCellOrder, order0, & + & cellOrder0(3), anisoOrder0(3), ierr, ii + INTEGER(I4B), ALLOCATABLE :: edgeOrder0(:), faceOrder0(:) + LOGICAL(LGT) :: isIsotropicOrder, isEdgeOrder, isFaceOrder, & + & isCellOrder, isAnisotropicOrder + + tEdgeOrder = 0_I4B + tFaceOrder = 0_I4B + tCellOrder = 0_I4B + + isIsotropicOrder = .FALSE. + isAnisotropicOrder = .FALSE. + isEdgeOrder = .FALSE. + isFaceOrder = .FALSE. + isCellOrder = .FALSE. + + tEdgeOrder = GetTotalEdges(elemType) + tFaceOrder = GetTotalFaces(elemType) * XiDimension(elemType) + + CALL Reallocate(edgeOrder0, tEdgeOrder) + CALL Reallocate(faceOrder0, tFaceOrder) + + order0 = -1 + anisoOrder0 = -1 + cellOrder0 = -1 + DO ii = 1, SIZE(edgeOrder0) + edgeOrder0(ii) = -1 + END DO + + DO ii = 1, SIZE(faceOrder0) + faceOrder0(ii) = -1 + END DO + + isIsotropicOrder = .TRUE. + order0 = order + ierr = param%Set(key=prefix//"/order", VALUE=order0) + ierr = param%Set(key=prefix//"/anisoOrder", VALUE=anisoOrder0) + ierr = param%Set(key=prefix//"/edgeOrder", VALUE=edgeOrder0) + ierr = param%Set(key=prefix//"/faceOrder", VALUE=faceOrder0) + ierr = param%Set(key=prefix//"/cellOrder", VALUE=cellOrder0) + ierr = param%Set(key=prefix//"/isIsotropicOrder", VALUE=isIsotropicOrder) + ierr = param%Set( & + & key=prefix//"/isAnisotropicOrder", & + & VALUE=isAnisotropicOrder) + ierr = param%Set(key=prefix//"/isEdgeOrder", VALUE=isEdgeOrder) + ierr = param%Set(key=prefix//"/isFaceOrder", VALUE=isFaceOrder) + ierr = param%Set(key=prefix//"/isCellOrder", VALUE=isCellOrder) + ierr = param%Set(key=prefix//"/tEdgeOrder", VALUE=tEdgeOrder) + ierr = param%Set(key=prefix//"/tFaceOrder", VALUE=tFaceOrder) + ierr = param%Set(key=prefix//"/tCellOrder", VALUE=tCellOrder) + + DEALLOCATE (edgeOrder0, faceOrder0) +END SUBROUTINE SetFEPram_Order + +!---------------------------------------------------------------------------- +! SetFEPram_AnisoOrder +!---------------------------------------------------------------------------- + +SUBROUTINE SetFEPram_AnisoOrder(param, anisoOrder, elemType, nsd, prefix) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: anisoOrder(3) + INTEGER(I4B), INTENT(IN) :: elemType + INTEGER(I4B), INTENT(IN) :: nsd + CHARACTER(*), INTENT(IN) :: prefix + + ! internal variables + INTEGER(I4B) :: tEdgeOrder, tFaceOrder, tCellOrder, order0, & + & cellOrder0(3), anisoOrder0(3), ierr, ii + INTEGER(I4B), ALLOCATABLE :: edgeOrder0(:), faceOrder0(:) + LOGICAL(LGT) :: isIsotropicOrder, isEdgeOrder, isFaceOrder, & + & isCellOrder, isAnisotropicOrder + CHARACTER(*), PARAMETER :: myName = "SetFEPram_AnisoOrder()" + + IF (.NOT. isQuadrangle(elemType) & + & .AND. .NOT. isHexahedron(elemType)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[ARGUMENT ERROR] anisoOrder is allowed '// & + & 'for Quadrangle and Hexahedron only') + END IF + + IF (SIZE(anisoOrder) .NE. nsd) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[ARGUMENT ERROR] The size of anisoOrder should be nsd') + END IF + + isIsotropicOrder = .FALSE. + isAnisotropicOrder = .TRUE. + isEdgeOrder = .FALSE. + isFaceOrder = .FALSE. + isCellOrder = .FALSE. + + tEdgeOrder = 0_I4B + tFaceOrder = 0_I4B + tCellOrder = 0_I4B + + CALL Reallocate(edgeOrder0, tEdgeOrder) + CALL Reallocate(faceOrder0, tFaceOrder) + + order0 = -1 + anisoOrder0 = anisoOrder + cellOrder0 = -1 + + ierr = param%Set(key=prefix//"/order", VALUE=order0) + ierr = param%Set(key=prefix//"/anisoOrder", VALUE=anisoOrder0) + ierr = param%Set(key=prefix//"/edgeOrder", VALUE=edgeOrder0) + ierr = param%Set(key=prefix//"/faceOrder", VALUE=faceOrder0) + ierr = param%Set(key=prefix//"/cellOrder", VALUE=cellOrder0) + ierr = param%Set(key=prefix//"/isIsotropicOrder", VALUE=isIsotropicOrder) + ierr = param%Set( & + & key=prefix//"/isAnisotropicOrder", & + & VALUE=isAnisotropicOrder) + ierr = param%Set(key=prefix//"/isEdgeOrder", VALUE=isEdgeOrder) + ierr = param%Set(key=prefix//"/isFaceOrder", VALUE=isFaceOrder) + ierr = param%Set(key=prefix//"/isCellOrder", VALUE=isCellOrder) + ierr = param%Set(key=prefix//"/tEdgeOrder", VALUE=tEdgeOrder) + ierr = param%Set(key=prefix//"/tFaceOrder", VALUE=tFaceOrder) + ierr = param%Set(key=prefix//"/tCellOrder", VALUE=tCellOrder) + + DEALLOCATE (edgeOrder0, faceOrder0) + +END SUBROUTINE SetFEPram_AnisoOrder + +!---------------------------------------------------------------------------- +! SetFEPram_Heirarchy2D +!---------------------------------------------------------------------------- + +SUBROUTINE SetFEPram_Heirarchy2D(param, elemType, nsd, edgeOrder, & + & faceOrder, prefix) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: elemType + INTEGER(I4B), INTENT(IN) :: nsd + INTEGER(I4B), OPTIONAL, INTENT(IN) :: edgeOrder(:) + INTEGER(I4B), OPTIONAL, INTENT(IN) :: faceOrder(:) + CHARACTER(*), INTENT(IN) :: prefix + ! internal variables + INTEGER(I4B) :: tEdgeOrder, tFaceOrder, tCellOrder, order0, & + & cellOrder0(3), anisoOrder0(3), ierr, ii, xidim + INTEGER(I4B), ALLOCATABLE :: edgeOrder0(:), faceOrder0(:) + LOGICAL(LGT) :: isIsotropicOrder, isEdgeOrder, isFaceOrder, & + & isCellOrder, isAnisotropicOrder + CHARACTER(*), PARAMETER :: myName = "SetFEPram_Heirarchy2D()" + TYPE(String) :: amsg + + isIsotropicOrder = .FALSE. + isAnisotropicOrder = .FALSE. + isEdgeOrder = .TRUE. + isFaceOrder = .TRUE. + isCellOrder = .FALSE. + + tEdgeOrder = GetTotalEdges(elemType) + xidim = XiDimension(elemType) + tFaceOrder = GetTotalFaces(elemType) * xidim + tCellOrder = 0_I4B + + IF (.NOT. PRESENT(edgeOrder) .OR. .NOT. PRESENT(faceOrder)) THEN + amsg = "[ARGUMENT ERROR] For 2D elements, you should specify \n"// & + & "one of the entries from following Sets: \n"// & + & "[order, anisoOrder, (edgeOrder, faceOrder)]" + CALL e%raiseError(modName//'::'//myName//' - '// & + & amsg) + RETURN + END IF + + IF (SIZE(edgeOrder) .NE. tEdgeOrder) THEN + amsg = "[ARGUMENT ERROR] The size of edgeOrder \n"// & + & "should be equal to the \n"// & + & "total number of edges in the element." + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + IF (isQuadrangle(elemType)) THEN + + IF (SIZE(faceOrder) .NE. xidim) THEN + amsg = "[ARGUMENT ERROR] In case of a Quadrangle element \n"// & + & "the size of faceOrder="//tostring(SIZE(faceOrder))// & + & " should be equal to xidim="//tostring(xidim) + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + ELSE + tFaceOrder = xidim + END IF + + ELSE + + IF (SIZE(faceOrder) .NE. 1) THEN + amsg = "[ARGUMENT ERROR] In case of a Triangle element \n"// & + & "the size of faceOrder="//tostring(SIZE(faceOrder))// & + & " should be equal to 1=" + CALL e%raiseError(modName//'::'//myName//' - '// & + & amsg) + RETURN + ELSE + tFaceOrder = 1_I4B + END IF + + END IF + + CALL Reallocate(edgeOrder0, tEdgeOrder) + CALL Reallocate(faceOrder0, tFaceOrder) + + edgeOrder0 = edgeOrder + faceOrder0(1:tFaceOrder) = faceOrder(1:tFaceOrder) + order0 = -1 + anisoOrder0 = -1 + cellOrder0 = -1 + + ierr = param%Set(key=prefix//"/order", VALUE=order0) + ierr = param%Set(key=prefix//"/anisoOrder", VALUE=anisoOrder0) + ierr = param%Set(key=prefix//"/edgeOrder", VALUE=edgeOrder0) + ierr = param%Set(key=prefix//"/faceOrder", VALUE=faceOrder0) + ierr = param%Set(key=prefix//"/cellOrder", VALUE=cellOrder0) + ierr = param%Set(key=prefix//"/isIsotropicOrder", VALUE=isIsotropicOrder) + ierr = param%Set( & + & key=prefix//"/isAnisotropicOrder", & + & VALUE=isAnisotropicOrder) + ierr = param%Set(key=prefix//"/isEdgeOrder", VALUE=isEdgeOrder) + ierr = param%Set(key=prefix//"/isFaceOrder", VALUE=isFaceOrder) + ierr = param%Set(key=prefix//"/isCellOrder", VALUE=isCellOrder) + ierr = param%Set(key=prefix//"/tEdgeOrder", VALUE=tEdgeOrder) + ierr = param%Set(key=prefix//"/tFaceOrder", VALUE=tFaceOrder) + ierr = param%Set(key=prefix//"/tCellOrder", VALUE=tCellOrder) + + DEALLOCATE (edgeOrder0, faceOrder0) +END SUBROUTINE SetFEPram_Heirarchy2D + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Initiate +CHARACTER(*), PARAMETER :: myName = "fe_Initiate()" +CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[IMPLEMENTATION ERROR] :: This routine should be implemented '// & + & ' by the child class.') +END PROCEDURE fe_Initiate + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE AbstractFEInitiate +CHARACTER(*), PARAMETER :: myName = "AbstractFEInitiate()" +INTEGER(I4B) :: ierr, nsd, elemType, order, anisoOrder(3), & + & cellOrder(3), feType, ipType, dofType(4), transformType, basisType(3), & + & tEdgeOrder, tFaceOrder, tCellOrder, ii +INTEGER(I4B), ALLOCATABLE :: edgeOrder(:), faceOrder(:) +TYPE(String) :: baseInterpol, baseCont, refElemDomain0 +REAL(DFP) :: alpha(3), beta(3), lambda(3) +LOGICAL(LGT) :: isEdgeOrder, isFaceOrder, isCellOrder, & + & isIsotropicOrder, isAnisotropicOrder +TYPE(AbstractRefElementPointer_), ALLOCATABLE :: facetElemPtrs(:) +TYPE(ParameterList_), POINTER :: sublist + +sublist => NULL() +ierr = param%GetSubList(key=prefix, sublist=sublist) +CALL obj%DEALLOCATE() +CALL obj%CheckEssentialParam(sublist) + +!! Get sublisteters +ierr = sublist%get(key=prefix//"/nsd", VALUE=nsd) +ierr = sublist%get(key=prefix//"/elemType", VALUE=elemType) +CALL GetValue( & + & obj=sublist, & + & key=prefix//"/baseContinuity", & + & VALUE=baseCont) + +CALL GetValue( & + & obj=sublist, & + & key=prefix//"/baseInterpolation", & + & VALUE=baseInterpol) + +ierr = sublist%get(key=prefix//"/feType", VALUE=feType) +ierr = sublist%get(key=prefix//"/ipType", VALUE=ipType) +ierr = sublist%get(key=prefix//"/dofType", VALUE=dofType) +ierr = sublist%get(key=prefix//"/transformType", VALUE=transformType) +ierr = sublist%get(key=prefix//"/basisType", VALUE=basisType) +ierr = sublist%get(key=prefix//"/alpha", VALUE=alpha) +ierr = sublist%get(key=prefix//"/beta", VALUE=beta) +ierr = sublist%get(key=prefix//"/lambda", VALUE=lambda) + +CALL GetValue( & + & obj=sublist, & + & key=prefix//"/refElemDomain", & + & VALUE=refElemDomain0) + +!! Initiate ReferenceElement +obj%refelem => RefElement_Pointer(elemType) +CALL obj%refelem%Initiate( & + & nsd=nsd, & + & baseContinuity=baseCont%chars(), & + & baseInterpolation=baseInterpol%chars()) + +!! Set parameters + +CALL obj%SetParam(& + & nsd=nsd, & + & elemType=elemType, & + & feType=feType, & + & baseContinuity=baseCont%chars(), & + & baseInterpolation=baseInterpol%chars(), & + & refElemDomain=refElemDomain0%chars(), & + & transformType=transformType, & + & dofType=dofType, & + & ipType=ipType, & + & basisType=basisType, & + & alpha=alpha, & + & beta=beta, & + & lambda=lambda) + +ierr = sublist%get(key=prefix//"/isIsotropicOrder", VALUE=isIsotropicOrder) +ierr = sublist%get(key=prefix//"/isAnisotropicOrder", VALUE=isAnisotropicOrder) +ierr = sublist%get(key=prefix//"/isEdgeOrder", VALUE=isEdgeOrder) +ierr = sublist%get(key=prefix//"/isFaceOrder", VALUE=isFaceOrder) +ierr = sublist%get(key=prefix//"/isCellOrder", VALUE=isCellOrder) + +IF (isIsotropicOrder) THEN + ierr = sublist%get(key=prefix//"/order", VALUE=order) + CALL obj%SetParam(order=order, isIsotropicOrder=isIsotropicOrder) +END IF + +IF (isAnisotropicOrder) THEN + ierr = sublist%get(key=prefix//"/anisoOrder", VALUE=anisoOrder) + CALL obj%SetParam( & + & anisoOrder=anisoOrder, & + & isAnisotropicOrder=isAnisotropicOrder) +END IF + +IF (isEdgeOrder) THEN + ierr = sublist%get(key=prefix//"/tEdgeOrder", VALUE=tEdgeOrder) + IF (tEdgeOrder .GT. 0_I4B) THEN + CALL Reallocate(edgeOrder, tEdgeOrder) + ierr = sublist%get(key=prefix//"/edgeOrder", VALUE=edgeOrder) + CALL obj%SetParam( & + & isEdgeOrder=isEdgeOrder, & + & edgeOrder=edgeOrder, & + & tEdgeOrder=tEdgeOrder) + END IF +END IF + +IF (isFaceOrder) THEN + ierr = sublist%get(key=prefix//"/tFaceOrder", VALUE=tFaceOrder) + IF (tFaceOrder .GT. 0_I4B) THEN + CALL Reallocate(faceOrder, tFaceOrder) + ierr = sublist%get(key=prefix//"/faceOrder", VALUE=faceOrder) + CALL obj%SetParam( & + & isFaceOrder=isFaceOrder, & + & faceOrder=faceOrder, & + & tFaceOrder=tFaceOrder) + END IF +END IF + +IF (isCellOrder) THEN + ierr = sublist%get(key=prefix//"/tCellOrder", VALUE=tCellOrder) + ierr = sublist%get(key=prefix//"/cellOrder", VALUE=cellOrder) + CALL obj%SetParam( & + & isCellOrder=isCellOrder, & + & cellOrder=cellOrder, & + & tCellOrder=tCellOrder) +END IF + +obj%isInitiated = .TRUE. + +CALL obj%refelem%GetParam(refelem=obj%refelem0) + +CALL obj%refelem%GetFacetElements(ans=facetElemPtrs) + +DO ii = 1, SIZE(facetElemPtrs) + CALL facetElemPtrs(ii)%ptr%GetParam(refelem=obj%facetElem0(ii)) + CALL facetElemPtrs(ii)%ptr%DEALLOCATE() + facetElemPtrs(ii)%ptr => NULL() +END DO +DEALLOCATE (facetElemPtrs) + +END PROCEDURE AbstractFEInitiate + +!---------------------------------------------------------------------------- +! Copy +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Copy +INTEGER(I4B) :: ii, elemType + +CALL obj%DEALLOCATE() +obj%firstCall = obj2%firstCall +obj%isInitiated = obj2%isInitiated +obj%nsd = obj2%nsd +obj%order = obj2%order +obj%isIsotropicOrder = obj2%isIsotropicOrder +obj%anisoOrder = obj2%anisoOrder +obj%isAnisotropicOrder = obj2%isAnisotropicOrder +obj%edgeOrder = obj2%edgeOrder +obj%tEdgeOrder = obj2%tEdgeOrder +obj%isEdgeOrder = obj2%isEdgeOrder +obj%faceOrder = obj2%faceOrder +obj%tFaceOrder = obj2%tFaceOrder +obj%isFaceOrder = obj2%isFaceOrder +obj%cellOrder = obj2%cellOrder +obj%tCellOrder = obj2%tCellOrder +obj%isCellOrder = obj2%isCellOrder +obj%feType = obj2%feType +obj%elemType = obj2%elemType +obj%ipType = obj2%ipType +obj%dofType = obj2%dofType +obj%transformType = obj2%transformType +obj%baseContinuity0 = obj2%baseContinuity0 +obj%baseInterpolation0 = obj2%baseInterpolation0 +obj%basisType = obj2%basisType +obj%alpha = obj2%alpha +obj%beta = obj2%beta +obj%lambda = obj2%lambda +obj%refElemDomain = obj2%refElemDomain +obj%refelem0 = obj2%refelem0 + +IF (ALLOCATED(obj2%baseContinuity)) THEN + ALLOCATE (obj%baseContinuity, source=obj2%baseContinuity) +END IF + +IF (ALLOCATED(obj2%baseInterpolation)) THEN + ALLOCATE (obj%baseInterpolation, source=obj2%baseInterpolation) +END IF + +! obj%refelem +IF (ASSOCIATED(obj2%refelem)) THEN + elemType = obj2%refelem%GetName() + obj%refelem => RefElement_Pointer(elemType) + CALL obj%refelem%Copy(obj2%refelem) +END IF + +DO ii = 1, SIZE(obj2%facetElem0) + obj%facetElem0(ii) = obj2%facetElem0(ii) +END DO + +IF (ALLOCATED(obj2%coeff)) THEN + obj%coeff = obj2%coeff +END IF + +END PROCEDURE fe_Copy + +!---------------------------------------------------------------------------- +! SetFEPram_Heirarchy2D +!---------------------------------------------------------------------------- + +SUBROUTINE SetFEPram_Heirarchy3D(param, elemType, nsd, edgeOrder, & + & faceOrder, cellOrder, prefix) + TYPE(ParameterList_), INTENT(INOUT) :: param + INTEGER(I4B), INTENT(IN) :: elemType + INTEGER(I4B), INTENT(IN) :: nsd + INTEGER(I4B), OPTIONAL, INTENT(IN) :: edgeOrder(:) + INTEGER(I4B), OPTIONAL, INTENT(IN) :: faceOrder(:) + INTEGER(I4B), OPTIONAL, INTENT(IN) :: cellOrder(:) + CHARACTER(*), INTENT(IN) :: prefix + + INTEGER(I4B) :: tEdgeOrder, tFaceOrder, tCellOrder, order0, & + & cellOrder0(3), anisoOrder0(3), ierr, ii, xidim + INTEGER(I4B), ALLOCATABLE :: edgeOrder0(:), faceOrder0(:) + LOGICAL(LGT) :: isIsotropicOrder, isEdgeOrder, isFaceOrder, & + & isCellOrder, isAnisotropicOrder + CHARACTER(*), PARAMETER :: myName = "SetFEPram_Heirarchy2D()" + TYPE(String) :: amsg + + isIsotropicOrder = .FALSE. + isAnisotropicOrder = .FALSE. + isEdgeOrder = .TRUE. + isFaceOrder = .TRUE. + isCellOrder = .TRUE. + + tEdgeOrder = GetTotalEdges(elemType) + xidim = XiDimension(elemType) + tFaceOrder = GetTotalFaces(elemType) + tCellOrder = GetTotalCells(elemType) + + IF (.NOT. PRESENT(edgeOrder) .OR. & + & .NOT. PRESENT(faceOrder) .OR. & + & .NOT. PRESENT(cellOrder)) THEN + amsg = "[ARGUMENT ERROR] For 3D elements, you should specify \n"// & + & "one of the entries from following Sets: \n"// & + & "[order, anisoOrder, (edgeOrder, faceOrder, cellOrder)]" + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + IF (SIZE(edgeOrder) .NE. tEdgeOrder) THEN + amsg = "[ARGUMENT ERROR] The size of edgeOrder \n"// & + & "should be equal to the \n"// & + & "total number of edges in the element." + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + IF (isHexahedron(elemType)) THEN + + tFaceOrder = tFaceOrder * xidim + IF (SIZE(faceOrder) .NE. tFaceOrder) THEN + amsg = "[ARGUMENT ERROR] In case of a Hexahedron element \n"// & + & "the size of faceOrder="//tostring(SIZE(cellOrder))// & + & " should be equal to "//tostring(tFaceOrder) + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + tCellOrder = tCellOrder * xidim + IF (SIZE(cellOrder) .NE. tCellOrder) THEN + amsg = "[ARGUMENT ERROR] In case of a Hexahedron element \n"// & + & "the size of cellOrder="//tostring(SIZE(cellOrder))// & + & " should be equal to "//tostring(tCellOrder) + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + END IF + + IF (isTetrahedron(elemType)) THEN + + tFaceOrder = tFaceOrder + IF (SIZE(faceOrder) .NE. tFaceOrder) THEN + amsg = "[ARGUMENT ERROR] In case of a Tetrahedron element \n"// & + & "the size of faceOrder="//tostring(SIZE(cellOrder))// & + & " should be equal to "//tostring(tFaceOrder) + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + ! tCellOrder = tCellOrder + IF (SIZE(cellOrder) .NE. tCellOrder) THEN + amsg = "[ARGUMENT ERROR] In case of a Tetrahedron element \n"// & + & "the size of cellOrder="//tostring(SIZE(cellOrder))// & + & " should be equal to "//tostring(tCellOrder) + CALL e%raiseError(modName//'::'//myName//' - '//amsg) + RETURN + END IF + + END IF + + IF (isPrism(elemType) .OR. isPyramid(elemType)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS] Currently Prism and Pyramid elements & + & are not supported') + RETURN + END IF + + CALL Reallocate(edgeOrder0, tEdgeOrder) + CALL Reallocate(faceOrder0, tFaceOrder) + + order0 = -1 + anisoOrder0 = -1 + edgeOrder0 = edgeOrder + faceOrder0(1:tFaceOrder) = faceOrder(1:tFaceOrder) + cellOrder0(1:tCellOrder) = cellOrder(1:tCellOrder) + + ierr = param%Set(key=prefix//"/order", VALUE=order0) + ierr = param%Set(key=prefix//"/anisoOrder", VALUE=anisoOrder0) + ierr = param%Set(key=prefix//"/edgeOrder", VALUE=edgeOrder0) + ierr = param%Set(key=prefix//"/faceOrder", VALUE=faceOrder0) + ierr = param%Set(key=prefix//"/cellOrder", VALUE=cellOrder0) + ierr = param%Set(key=prefix//"/isIsotropicOrder", VALUE=isIsotropicOrder) + ierr = param%Set( & + & key=prefix//"/isAnisotropicOrder", & + & VALUE=isAnisotropicOrder) + ierr = param%Set(key=prefix//"/isEdgeOrder", VALUE=isEdgeOrder) + ierr = param%Set(key=prefix//"/isFaceOrder", VALUE=isFaceOrder) + ierr = param%Set(key=prefix//"/isCellOrder", VALUE=isCellOrder) + ierr = param%Set(key=prefix//"/tEdgeOrder", VALUE=tEdgeOrder) + ierr = param%Set(key=prefix//"/tFaceOrder", VALUE=tFaceOrder) + ierr = param%Set(key=prefix//"/tCellOrder", VALUE=tCellOrder) + + DEALLOCATE (edgeOrder0, faceOrder0) +END SUBROUTINE SetFEPram_Heirarchy3D + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Deallocate +INTEGER(I4B) :: ii +DO ii = 1, SIZE(obj%facetElem0) + CALL DEALLOCATE (obj%facetElem0(ii)) +END DO + +CALL DEALLOCATE (obj%refelem0) +IF (ALLOCATED(obj%coeff)) DEALLOCATE (obj%coeff) +obj%firstCall = .TRUE. +IF (ASSOCIATED(obj%refelem)) THEN + CALL obj%refelem%DEALLOCATE() + DEALLOCATE (obj%refelem) + obj%refelem => NULL() +END IF +obj%nsd = 0 +obj%order = 0 +obj%isIsotropicOrder = .FALSE. +obj%anisoOrder = 0_I4B +obj%isAnisotropicOrder = .FALSE. +obj%edgeOrder = 0_I4B +obj%tEdgeOrder = 0_I4B +obj%isEdgeOrder = .FALSE. +obj%faceOrder = 0 +obj%tFaceOrder = 0 +obj%isFaceOrder = .FALSE. +obj%cellOrder = 0 +obj%tCellOrder = 0 +obj%isCellOrder = .FALSE. +obj%feType = 0 +obj%elemType = 0 +obj%ipType = 0 +obj%dofType = 0 +obj%transformType = 0 +obj%baseContinuity0 = "" +obj%baseInterpolation0 = "" +obj%basisType = 0 +obj%alpha = 0.0 +obj%beta = 0.0 +obj%lambda = 0.0 +obj%refElemDomain = "" +IF (ALLOCATED(obj%baseContinuity)) DEALLOCATE (obj%baseContinuity) +IF (ALLOCATED(obj%baseInterpolation)) DEALLOCATE (obj%baseInterpolation) +obj%isInitiated = .FALSE. +END PROCEDURE fe_Deallocate + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE ConstructorMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@DGMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@DGMethods.F90 new file mode 100644 index 000000000..6612eb943 --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@DGMethods.F90 @@ -0,0 +1,49 @@ +! 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(AbstractFE_Class) DGMethods +! USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData_DG +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalElemShapeData_DG_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetLocalElemShapeData_DG()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement fe_GetLocalElemShapeData_DG_Master +END PROCEDURE fe_GetLocalElemShapeData_DG_Master + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData_DG +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetGlobalElemShapeData_DG_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetGlobalElemShapeData_DG()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement fe_GetGlobalElemShapeData_DG_Master +END PROCEDURE fe_GetGlobalElemShapeData_DG_Master + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE DGMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@GetMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@GetMethods.F90 new file mode 100644 index 000000000..b54592168 --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@GetMethods.F90 @@ -0,0 +1,97 @@ +! 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(AbstractFE_Class) GetMethods +USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalElemShapeData +CHARACTER(*), PARAMETER :: myName = "fe_GetLocalElemShapeData()" +IF (.NOT. obj%isInitiated) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NOT INITIATED] It seems AbstractFE_::obj is not initiated.') + RETURN +END IF + +SELECT TYPE (baseContinuity => obj%baseContinuity) +CLASS IS (H1_) + CALL obj%GetLocalElemShapeData_H1(elemsd=elemsd, quad=quad) +CLASS is (HDIV_) + CALL obj%GetLocalElemShapeData_HDiv(elemsd=elemsd, quad=quad) +CLASS is (HCURL_) + CALL obj%GetLocalElemShapeData_HCurl(elemsd=elemsd, quad=quad) +CLASS IS (DG_) + CALL obj%GetLocalElemShapeData_DG(elemsd=elemsd, quad=quad) +CLASS DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] No case found for type of & + & AbstractFE_::obj%baseContinuity') +END SELECT +END PROCEDURE fe_GetLocalElemShapeData + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetGlobalElemShapeData +CHARACTER(*), PARAMETER :: myName = "fe_GetGlobalElemShapeData()" +IF (.NOT. obj%isInitiated) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NOT INITIATED] It seems AbstractFE_::obj is not initiated.') + RETURN +END IF + +SELECT TYPE (baseContinuity => obj%baseContinuity) +CLASS IS (H1_) + CALL obj%GetGlobalElemShapeData_H1(elemsd=elemsd, xij=xij, & + & geoElemsd=geoElemsd) +CLASS is (HDIV_) + CALL obj%GetGlobalElemShapeData_HDiv(elemsd=elemsd, xij=xij, & + & geoElemsd=geoElemsd) +CLASS is (HCURL_) + CALL obj%GetGlobalElemShapeData_HCurl(elemsd=elemsd, xij=xij, & + & geoElemsd=geoElemsd) +CLASS IS (DG_) + CALL obj%GetGlobalElemShapeData_DG(elemsd=elemsd, xij=xij, & + & geoElemsd=geoElemsd) +CLASS DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] No case found for type of & + & AbstractFE_::obj%baseContinuity') +END SELECT +END PROCEDURE fe_GetGlobalElemShapeData + +!---------------------------------------------------------------------------- +! GetParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetParam +CHARACTER(*), PARAMETER :: myName = "fe_GetParam()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +END PROCEDURE fe_GetParam + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE GetMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@H1Methods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@H1Methods.F90 new file mode 100644 index 000000000..d6fe6e95b --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@H1Methods.F90 @@ -0,0 +1,293 @@ +! 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(AbstractFE_Class) H1Methods +USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE + +INTERFACE GetLocalElemShapeData_H1 + MODULE PROCEDURE fe_GetLocalElemshapeData_H1_Lagrange + MODULE PROCEDURE fe_GetLocalElemshapeData_H1_Orthogonal + MODULE PROCEDURE fe_GetLocalElemshapeData_H1_Hierarchy + MODULE PROCEDURE fe_GetLocalElemshapeData_H1_Hermit + MODULE PROCEDURE fe_GetLocalElemshapeData_H1_Serendipity +END INTERFACE GetLocalElemShapeData_H1 + +CONTAINS + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData_H1 +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalElemShapeData_H1_Master +CHARACTER(*), PARAMETER :: myName = "GetLocalElemShapeData_H1_Master()" + +SELECT TYPE (baseInterpolation => obj%baseInterpolation) +CLASS IS (LagrangeInterpolation_) + CALL GetLocalElemShapeData_H1(obj, elemsd, quad, baseInterpolation) +CLASS IS (OrthogonalInterpolation_) + CALL GetLocalElemShapeData_H1(obj, elemsd, quad, baseInterpolation) +CLASS IS (HierarchyInterpolation_) + CALL GetLocalElemShapeData_H1(obj, elemsd, quad, baseInterpolation) +CLASS IS (HermitInterpolation_) + CALL GetLocalElemShapeData_H1(obj, elemsd, quad, baseInterpolation) +CLASS IS (SerendipityInterpolation_) + CALL GetLocalElemShapeData_H1(obj, elemsd, quad, baseInterpolation) +CLASS DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] no case found for AbstractFE_::obj%baseInterpolation') +END SELECT +END PROCEDURE fe_GetLocalElemShapeData_H1_Master + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData_H1 +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetGlobalElemShapeData_H1_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetGlobalElemShapeData_H1_Master" +IF (SIZE(xij, 1) .NE. obj%nsd) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WRONG ARGS] size(xij, 1) .NE. obj%nsd') +END IF +IF (PRESENT(geoElemsd)) THEN + IF (SIZE(xij, 2) .NE. SIZE(geoElemsd%N, 1)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WRONG ARGS] size(xij, 2) .NE. size(geoElemsd%N, 1)') + END IF + CALL Set(obj=elemsd, val=xij, N=geoElemsd%N, dNdXi=geoElemsd%dNdXi) + RETURN +END IF +IF (SIZE(xij, 2) .NE. SIZE(elemsd%N, 1)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WRONG ARGS] size(xij, 2) .NE. size(elemsd%N, 1)') +END IF +CALL Set(obj=elemsd, val=xij, N=elemsd%N, dNdXi=elemsd%dNdXi) +END PROCEDURE fe_GetGlobalElemShapeData_H1_Master + +!---------------------------------------------------------------------------- +! GetLocalElemshapeData_H1_Lagrange +!---------------------------------------------------------------------------- + +SUBROUTINE fe_GetLocalElemshapeData_H1_Lagrange(obj, elemsd, quad, & + & baseInterpolation) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + CLASS(LagrangeInterpolation_), INTENT(IN) :: baseInterpolation + CHARACTER(*), PARAMETER :: myName = "GetLocalElemshapeData_H1_Lagrange" + IF (obj%isIsotropicOrder) THEN + CALL Initiate( & + & obj=elemsd, & + & quad=quad, & + & refelem=obj%refelem0, & + & baseContinuity=TypeH1, & + & baseInterpolation=baseInterpolation, & + & order=obj%order, & + & ipType=obj%ipType, & + & basisType=obj%basisType(1), & + & coeff=obj%coeff, & + & firstCall=obj%firstCall, & + & alpha=obj%alpha(1), & + & beta=obj%beta(1), & + & lambda=obj%lambda(1)) + obj%firstCall = .TRUE. + RETURN + END IF + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine at present support isIsotropicOrder & + & for H1 Lagrange shape functions') +! TODO: Implement GetLocalElemshapeData_H1_Lagrange for anisotropic order +END SUBROUTINE fe_GetLocalElemshapeData_H1_Lagrange + +!---------------------------------------------------------------------------- +! GetLocalElemshapeData_H1_Orthogonal +!---------------------------------------------------------------------------- + +SUBROUTINE fe_GetLocalElemshapeData_H1_Orthogonal(obj, elemsd, quad, & + & baseInterpolation) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + CLASS(OrthogonalInterpolation_), INTENT(IN) :: baseInterpolation + CHARACTER(*), PARAMETER :: myName = "GetLocalElemshapeData_H1_Orthogonal" + TYPE(ReferenceElement_) :: refelem + + CALL obj%refelem%GetParam(refelem=refelem) + IF (obj%isIsotropicOrder) THEN + CALL Initiate( & + & obj=elemsd, & + & quad=quad, & + & refelem=obj%refelem0, & + & baseContinuity=TypeH1, & + & baseInterpolation=baseInterpolation, & + & order=obj%order, & + & ipType=obj%ipType, & + & basisType=obj%basisType(1), & + & alpha=obj%alpha(1), & + & beta=obj%beta(1), & + & lambda=obj%lambda(1)) + RETURN + END IF + + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine at present support isIsotropicOrder & + & for H1 Lagrange shape functions') + +! TODO: Implement GetLocalElemshapeData_H1_Orthogonal for anisotropic order + +END SUBROUTINE fe_GetLocalElemshapeData_H1_Orthogonal + +!---------------------------------------------------------------------------- +! GetLocalElemshapeData_H1_Hierarchy +!---------------------------------------------------------------------------- + +SUBROUTINE fe_GetLocalElemshapeData_H1_Hierarchy(obj, elemsd, quad, & + & baseInterpolation) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + CLASS(HierarchyInterpolation_), INTENT(IN) :: baseInterpolation + CHARACTER(*), PARAMETER :: myName = "GetLocalElemshapeData_H1_Hierarchy" + TYPE(ReferenceElement_) :: refelem + + CALL obj%refelem%GetParam(refelem=refelem) + + IF (obj%isIsotropicOrder) THEN + CALL Initiate( & + & obj=elemsd, & + & quad=quad, & + & refelem=obj%refelem0, & + & baseContinuity=TypeH1, & + & baseInterpolation=baseInterpolation, & + & order=obj%order, & + & ipType=obj%ipType, & + & basisType=obj%basisType(1), & + & alpha=obj%alpha(1), & + & beta=obj%beta(1), & + & lambda=obj%lambda(1)) + RETURN + END IF + + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine at present support isIsotropicOrder & + & for H1 Lagrange shape functions') + +! TODO: Implement GetLocalElemshapeData_H1_Hierarchy for anisotropic order +END SUBROUTINE fe_GetLocalElemshapeData_H1_Hierarchy + +!---------------------------------------------------------------------------- +! GetLocalElemshapeData_H1_Hermit +!---------------------------------------------------------------------------- + +SUBROUTINE fe_GetLocalElemshapeData_H1_Serendipity(obj, elemsd, quad, & + & baseInterpolation) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + CLASS(SerendipityInterpolation_), INTENT(IN) :: baseInterpolation + + CHARACTER(*), PARAMETER :: myName = "GetLocalElemshapeData_H1_Hermit" + TYPE(ReferenceElement_) :: refelem + + CALL obj%refelem%GetParam(refelem=refelem) + + IF (obj%isIsotropicOrder) THEN + CALL Initiate( & + & obj=elemsd, & + & quad=quad, & + & refelem=obj%refelem0, & + & baseContinuity=TypeH1, & + & baseInterpolation=baseInterpolation, & + & order=obj%order, & + & ipType=obj%ipType, & + & basisType=obj%basisType(1), & + & alpha=obj%alpha(1), & + & beta=obj%beta(1), & + & lambda=obj%lambda(1)) + RETURN + END IF + + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine at present support isIsotropicOrder & + & for H1 Lagrange shape functions') + +! TODO: Implement GetLocalElemshapeData_H1_Serendipity for anisotropic order +END SUBROUTINE fe_GetLocalElemshapeData_H1_Serendipity + +!---------------------------------------------------------------------------- +! GetLocalElemshapeData_H1_Serendipity +!---------------------------------------------------------------------------- + +SUBROUTINE fe_GetLocalElemshapeData_H1_Hermit(obj, elemsd, quad, & + & baseInterpolation) + CLASS(AbstractFE_), INTENT(INOUT) :: obj + CLASS(ElemShapedata_), INTENT(INOUT) :: elemsd + CLASS(QuadraturePoint_), INTENT(IN) :: quad + CLASS(HermitInterpolation_), INTENT(IN) :: baseInterpolation + CHARACTER(*), PARAMETER :: myName = "GetLocalElemshapeData_H1_Serendipity" + TYPE(ReferenceElement_) :: refelem + + CALL obj%refelem%GetParam(refelem=refelem) + + IF (obj%isIsotropicOrder) THEN + CALL Initiate( & + & obj=elemsd, & + & quad=quad, & + & refelem=obj%refelem0, & + & baseContinuity=TypeH1, & + & baseInterpolation=baseInterpolation, & + & order=obj%order, & + & ipType=obj%ipType, & + & basisType=obj%basisType(1), & + & alpha=obj%alpha(1), & + & beta=obj%beta(1), & + & lambda=obj%lambda(1)) + RETURN + END IF + + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine at present support isIsotropicOrder & + & for H1 Lagrange shape functions') + +! TODO: Implement GetLocalElemshapeData_H1_Serendipity +! for anisotropic order +END SUBROUTINE fe_GetLocalElemshapeData_H1_Hermit + +!---------------------------------------------------------------------------- +! GetLocalFacetElemShapeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalFacetElemShapeData +CHARACTER(*), PARAMETER :: myName="get_GetLocalFacetElemShapeData" + +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WIP] This routine is not avaiable yet.') + +! TODO: Implement fe_GetLocalFacetElemShapeData +! for anisotropic order + +! CALL Set( & +! & facetobj=facetobj, & +! & cellobj=cellobj, & +! & cellval=cellval, & +! & cellN=cellN, & +! & celldNdXi=celldNdXi, & +! & facetN=facetN, & +! & ffacetdNdXi=facetdNdXi) +END PROCEDURE fe_GetLocalFacetElemShapeData + +END SUBMODULE H1Methods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@HCurlMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@HCurlMethods.F90 new file mode 100644 index 000000000..5db9eadf7 --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@HCurlMethods.F90 @@ -0,0 +1,49 @@ +! 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(AbstractFE_Class) HCurlMethods +! USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalElemShapeData_HCurl_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetLocalElemShapeData_HCurl()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement get_GetLocalElemShapeData_HCurl_Master +END PROCEDURE fe_GetLocalElemShapeData_HCurl_Master + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetGlobalElemShapeData_HCurl_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetGlobalElemShapeData_HCurl()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement get_GetGlobalElemShapeData_HCurl_Master +END PROCEDURE fe_GetGlobalElemShapeData_HCurl_Master + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE HCurlMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@HDivMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@HDivMethods.F90 new file mode 100644 index 000000000..608d9422a --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@HDivMethods.F90 @@ -0,0 +1,49 @@ +! 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(AbstractFE_Class) HDivMethods +! USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! GetLocalElemShapeData_HDiv +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetLocalElemShapeData_HDiv_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetLocalElemShapeData_HDiv()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement fe_GetLocalElemShapeData_HDiv_Master +END PROCEDURE fe_GetLocalElemShapeData_HDiv_Master + +!---------------------------------------------------------------------------- +! GetGlobalElemShapeData_HDiv +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetGlobalElemShapeData_HDiv_Master +CHARACTER(*), PARAMETER :: myName = "fe_GetGlobalElemShapeData_HDiv()" +CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WORK IN PROGRESS]') +!TODO: Implement fe_GetGlobalElemShapeData_HDiv_Master +END PROCEDURE fe_GetGlobalElemShapeData_HDiv_Master + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE HDivMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@IOMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@IOMethods.F90 new file mode 100644 index 000000000..5dfdc8ae0 --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@IOMethods.F90 @@ -0,0 +1,249 @@ +! 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(AbstractFE_Class) IOMethods +USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Display +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Display +IF (.NOT. obj%isInitiated) THEN + CALL Display("Element is Empty", unitno=unitno) +END IF + +IF (ASSOCIATED(obj%refelem)) THEN + CALL obj%refelem%Display( & + & msg="ReferenceElement: ", & + & unitno=unitno, & + & notFull=notFull) +END IF + +CALL Display(obj%nsd, msg="nsd: ", unitno=unitno) +CALL Display(obj%feType, msg="feType: ", unitno=unitno) +CALL Display(obj%elemType, msg="elemType: ", unitno=unitno) +CALL Display(obj%ipType, msg="ipType: ", unitno=unitno) +CALL Display(obj%basisType, msg="basisType: ", unitno=unitno) +CALL Display(obj%alpha, msg="alpha: ", unitno=unitno) +CALL Display(obj%beta, msg="beta: ", unitno=unitno) +CALL Display(obj%lambda, msg="lambda: ", unitno=unitno) +CALL Display(obj%dofType, msg="dofType: ", unitno=unitno) +CALL Display(obj%transformType, msg="transformType: ", unitno=unitno) +CALL Display(obj%baseContinuity0, msg="baseContinuity: ", unitno=unitno) +CALL Display(obj%baseInterpolation0, msg="baseInterpolation: ", unitno=unitno) +CALL Display(obj%refElemDomain, msg="refElemDomain: ", unitno=unitno) + +IF (obj%isIsotropicOrder) THEN + CALL Display("isIsotropicOrder: TRUE", unitno=unitno) + CALL Display(obj%order, msg="order: ", unitno=unitno) +END IF + +IF (obj%isAnisotropicOrder) THEN + CALL Display("isAnisotropicOrder: TRUE", unitno=unitno) + CALL Display(obj%anisoOrder, msg="anisoOrder: ", unitno=unitno) +END IF + +IF (obj%isEdgeOrder) THEN + CALL Display("isEdgeOrder: TRUE", unitno=unitno) + IF (obj%tEdgeOrder .GT. 0_I4B) THEN + CALL Display( & + & obj%edgeOrder(:obj%tEdgeOrder), & + & msg="edgeOrder: ", & + & unitno=unitno) + END IF +END IF + +IF (obj%isFaceOrder) THEN + CALL Display("isFaceOrder: TRUE", unitno=unitno) + IF (obj%tFaceOrder .GT. 0_I4B) THEN + CALL Display( & + & obj%faceOrder(:obj%tFaceOrder), & + & msg="faceOrder: ", & + & unitno=unitno) + END IF +END IF + +IF (obj%isCellOrder) THEN + CALL Display("isCellOrder: TRUE", unitno=unitno) + IF (obj%tCellOrder .GT. 0_I4B) THEN + CALL Display( & + & obj%cellOrder(:obj%tCellOrder), & + & msg="cellOrder: ", & + & unitno=unitno) + END IF +END IF + +END PROCEDURE fe_Display + +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_MdEncode +CHARACTER(*), PARAMETER :: myName = "fe_MdEncode" +INTEGER(I4B), PARAMETER :: jj = 21 +TYPE(String) :: rowTitle(jj), colTitle(1), astr(jj) + +colTitle(1) = "" +rowTitle(1) = "**nsd**"; astr(1) = tostring(obj%nsd) +rowTitle(2) = "**feType**"; astr(2) = tostring(obj%feType) +rowTitle(3) = "**elemType**"; astr(3) = ElementName(obj%elemType) +rowTitle(4) = "**ipType**"; astr(4) = tostring(obj%ipType) +rowTitle(5) = "**basisType**"; astr(5) = tostring(obj%basisType) +rowTitle(6) = "**alpha**"; astr(6) = tostring(obj%alpha) +rowTitle(7) = "**beta**"; astr(7) = tostring(obj%beta) +rowTitle(8) = "**lambda**"; astr(8) = tostring(obj%lambda) +rowTitle(9) = "**dofType**"; astr(9) = tostring(obj%dofType) +rowTitle(10) = "**transformType**"; astr(10) = tostring(obj%transformType) +rowTitle(11) = "**baseContinuity**"; astr(11) = obj%baseContinuity0%chars() +rowTitle(12) = "**baseInterpolion**"; astr(12) = obj%baseInterpolation0%chars() +rowTitle(13) = "**refElemDomain**"; astr(13) = obj%refElemDomain%chars() +rowTitle(14) = "**isIsotropicOrder**"; astr(14) = tostring(obj%isIsotropicOrder) +rowTitle(15) = "**isAnisotropicOrder**"; astr(15) = tostring(obj%isAnisotropicOrder) +rowTitle(16) = "**isEdgeOrder**"; astr(16) = tostring(obj%isEdgeOrder) +rowTitle(17) = "**isFaceOrder**"; astr(17) = tostring(obj%isFaceOrder) +rowTitle(18) = "**isCellOrder**"; astr(18) = tostring(obj%isCellOrder) +IF (obj%isEdgeOrder) THEN + rowTitle(19) = "**edgeOrder**"; astr(19) = tostring(obj%edgeOrder) +ELSE + rowTitle(19) = "**edgeOrder**"; astr(19) = " " +END IF + +IF (obj%isFaceOrder) THEN + rowTitle(20) = "**faceOrder**"; astr(20) = tostring(obj%faceOrder) +ELSE + rowTitle(20) = "**faceOrder**"; astr(20) = " " +END IF + +IF (obj%iscellOrder) THEN + rowTitle(21) = "**cellOrder**"; astr(21) = tostring(obj%cellOrder) +ELSE + rowTitle(21) = "**cellOrder**"; astr(21) = " " +END IF + +ans = MdEncode( & + & val=astr(1:21), & + & rh=rowTitle(1:21), & + & ch=colTitle)//char_lf//"**Reference Element**"// & + & char_lf//char_lf//obj%refelem%MdEncode() + +END PROCEDURE fe_MdEncode + +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_ReactEncode +CHARACTER(*), PARAMETER :: myName = "fe_ReactEncode" +INTEGER(I4B), PARAMETER :: jj = 21 +TYPE(String) :: rowTitle(jj), colTitle(1), astr(jj) + +colTitle(1) = "" +rowTitle(1) = "**nsd**" +astr(1) = tostring(obj%nsd) + +rowTitle(2) = "**feType**" +astr(2) = tostring(obj%feType) + +rowTitle(3) = "**elemType**" +astr(3) = ElementName(obj%elemType) + +rowTitle(4) = "**ipType**" +astr(4) = tostring(obj%ipType) + +rowTitle(5) = "**basisType**" +astr(5) = tostring(obj%basisType) + +rowTitle(6) = "**alpha**" +astr(6) = tostring(obj%alpha) + +rowTitle(7) = "**beta**" +astr(7) = tostring(obj%beta) + +rowTitle(8) = "**lambda**" +astr(8) = tostring(obj%lambda) + +rowTitle(9) = "**dofType**" +astr(9) = tostring(obj%dofType) + +rowTitle(10) = "**transformType**" +astr(10) = tostring(obj%transformType) + +rowTitle(11) = "**baseContinuity**" +astr(11) = obj%baseContinuity0%chars() + +rowTitle(12) = "**baseInterpolation**" +astr(12) = obj%baseInterpolation0%chars() + +rowTitle(13) = "**refElemDomain**" +astr(13) = obj%refElemDomain%chars() + +rowTitle(14) = "**isIsotropicOrder**" +astr(14) = tostring(obj%isIsotropicOrder) + +rowTitle(15) = "**isAnisotropicOrder**" +astr(15) = tostring(obj%isAnisotropicOrder) + +rowTitle(16) = "**isEdgeOrder**" +astr(16) = tostring(obj%isEdgeOrder) + +rowTitle(17) = "**isFaceOrder**" +astr(17) = tostring(obj%isFaceOrder) + +rowTitle(18) = "**isCellOrder**" +astr(18) = tostring(obj%isCellOrder) + +IF (obj%isEdgeOrder) THEN + rowTitle(19) = "**edgeOrder**" + astr(19) = tostring(obj%edgeOrder) +ELSE + rowTitle(19) = "**edgeOrder**" + astr(19) = " " +END IF + +IF (obj%isFaceOrder) THEN + rowTitle(20) = "**faceOrder**" + astr(20) = tostring(obj%faceOrder) +ELSE + rowTitle(20) = "**faceOrder**" + astr(20) = " " +END IF + +IF (obj%iscellOrder) THEN + rowTitle(21) = "**cellOrder**" + astr(21) = tostring(obj%cellOrder) +ELSE + rowTitle(21) = "**cellOrder**" + astr(21) = " " +END IF + +ans = React_StartTabs()//char_lf +ans = ans//React_StartTabItem(VALUE="0", label="Finite Element")//char_lf// & + & MdEncode( & + & val=astr(1:21), & + & rh=rowTitle(1:21), & + & ch=colTitle)//char_lf// & + & React_EndTabItem()//char_lf// & + & React_StartTabItem(VALUE="1", label="Reference Element")//char_lf// & + & char_lf//obj%refelem%ReactEncode()//char_lf// & + & React_EndTabItem()//char_lf//React_EndTabs()//char_lf +END PROCEDURE fe_ReactEncode + +END SUBMODULE IOMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@Methods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@Methods.F90 deleted file mode 100644 index 9e7c5240b..000000000 --- a/src/submodules/FiniteElement/src/AbstractFE_Class@Methods.F90 +++ /dev/null @@ -1,71 +0,0 @@ -! 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(AbstractFE_Class) Methods -USE BaseMethod -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! Deallocate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Deallocate -IF (ASSOCIATED(obj%refelem)) THEN - CALL obj%refelem%Deallocate() - DEALLOCATE (obj%refelem) - obj%refelem => NULL() -END IF -obj%nsd = 0 -obj%order = 0 -obj%feType = 0 -obj%ipType = 0 -obj%dofType = 0 -obj%transformType = 0 -END PROCEDURE fe_Deallocate - -!---------------------------------------------------------------------------- -! Display -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Display -IF (ASSOCIATED(obj%refelem)) THEN - CALL obj%refelem%Display(msg="ReferenceElement=", unitno=unitno, & - & notFull=.TRUE.) -END IF -CALL Display(obj%nsd, msg="nsd=", unitno=unitno) -CALL Display(obj%order, msg="order=", unitno=unitno) -CALL Display(obj%feType, msg="feType=", unitno=unitno) -CALL Display(obj%ipType, msg="ipType=", unitno=unitno) -CALL Display(obj%dofType, msg="dofType=", unitno=unitno) -CALL Display(obj%transformType, msg="transformType=", unitno=unitno) -END PROCEDURE fe_Display - -!---------------------------------------------------------------------------- -! SetParam -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_SetParam -IF (PRESENT(order)) obj%order = order -IF (PRESENT(order)) obj%nsd = nsd -IF (PRESENT(feType)) obj%feType = feType -IF (PRESENT(ipType)) obj%ipType = ipType -IF (PRESENT(dofType)) obj%dofType = dofType -IF (PRESENT(transformType)) obj%transformType = transformType -END PROCEDURE fe_SetParam - -END SUBMODULE Methods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@QuadratureMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@QuadratureMethods.F90 new file mode 100644 index 000000000..6cc4daefb --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@QuadratureMethods.F90 @@ -0,0 +1,144 @@ +! 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(AbstractFE_Class) QuadratureMethods +USE BaseMethod +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! GetQuadraturePoints1 +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_GetQuadraturePoints1 +CHARACTER(*), PARAMETER :: myName = "GetQuadraturePoints1" +INTEGER(I4B) :: order0(3), nips0(3), quadratureType0(3) +REAL(DFP) :: alpha0(3), beta0(3), lambda0(3) + +IF (PRESENT(order) .AND. PRESENT(nips)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[WRONG ARGUMENTS] both nips and order cannot be present'// & + & ' either give nips (number of integration points) or '// & + & ' give order (order of integrand)') + RETURN +END IF + +SELECT CASE (SIZE(quadratureType)) +CASE (1) + quadratureType0 = quadratureType(1) +CASE (2) + quadratureType0(1) = quadratureType(1) + quadratureType0(2:) = quadratureType(2) +CASE (3) + quadratureType0 = quadratureType +END SELECT + +IF (PRESENT(alpha)) THEN + SELECT CASE (SIZE(alpha)) + CASE (1) + alpha0 = alpha(1) + CASE (2) + alpha0(1) = alpha(1) + alpha0(2:) = alpha(2) + CASE (3) + alpha0 = alpha + END SELECT +END IF + +IF (PRESENT(beta)) THEN + SELECT CASE (SIZE(beta)) + CASE (1) + beta0 = beta(1) + CASE (2) + beta0(1) = beta(1) + beta0(2:) = beta(2) + CASE (3) + beta0 = beta + END SELECT +END IF + +IF (PRESENT(lambda)) THEN + SELECT CASE (SIZE(lambda)) + CASE (1) + lambda0 = lambda(1) + CASE (2) + lambda0(1) = lambda(1) + lambda0(2:) = lambda(2) + CASE (3) + lambda0 = lambda + END SELECT +END IF + +IF (PRESENT(order)) THEN + + SELECT CASE (SIZE(order)) + CASE (1) + order0 = order(1) + CASE (2) + order0(1) = order(1) + order0(2:) = order(2) + CASE (3) + order0 = order + END SELECT + + CALL Initiate( & + & obj=quad, & + & refelem=obj%refelem0, & + & p=order0(1), & + & q=order0(2), & + & r=order0(3), & + & quadratureType1=quadratureType0(1), & + & quadratureType2=quadratureType0(2), & + & quadratureType3=quadratureType0(3), & + & alpha1=alpha0(1), beta1=beta0(1), lambda1=lambda0(1), & + & alpha2=alpha0(2), beta2=beta0(2), lambda2=lambda0(2), & + & alpha3=alpha0(3), beta3=beta0(3), lambda3=lambda0(3) & + & ) + RETURN +END IF + +IF (PRESENT(nips)) THEN + + SELECT CASE (SIZE(nips)) + CASE (1) + nips0 = nips(1) + CASE (2) + nips0(1) = nips(1) + nips0(2:) = nips(2) + CASE (3) + nips0 = nips + END SELECT + + CALL Initiate( & + & obj=quad, & + & refelem=obj%refelem0, & + & nipsx=nips0(1:1), & + & nipsy=nips0(2:2), & + & nipsz=nips0(3:3), & + & quadratureType1=quadratureType0(1), & + & quadratureType2=quadratureType0(2), & + & quadratureType3=quadratureType0(3), & + & alpha1=alpha0(1), beta1=beta0(1), lambda1=lambda0(1), & + & alpha2=alpha0(2), beta2=beta0(2), lambda2=lambda0(2), & + & alpha3=alpha0(3), beta3=beta0(3), lambda3=lambda0(3) & + & ) + RETURN +END IF +END PROCEDURE fe_GetQuadraturePoints1 + +END SUBMODULE QuadratureMethods diff --git a/src/submodules/FiniteElement/src/AbstractFE_Class@SetMethods.F90 b/src/submodules/FiniteElement/src/AbstractFE_Class@SetMethods.F90 new file mode 100644 index 000000000..511fd16cf --- /dev/null +++ b/src/submodules/FiniteElement/src/AbstractFE_Class@SetMethods.F90 @@ -0,0 +1,71 @@ +! 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(AbstractFE_Class) SetMethods +USE BaseMethod +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! SetParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_SetParam +IF (PRESENT(nsd)) obj%nsd = nsd +IF (PRESENT(order)) obj%order = order +IF (PRESENT(anisoOrder)) obj%anisoOrder = anisoOrder +IF (PRESENT(edgeOrder)) obj%edgeOrder(1:SIZE(edgeOrder)) = edgeOrder +IF (PRESENT(faceOrder)) obj%faceOrder(1:SIZE(faceOrder)) = faceOrder +IF (PRESENT(cellOrder)) obj%cellOrder(1:SIZE(cellOrder)) = cellOrder +IF (PRESENT(feType)) obj%feType = feType +IF (PRESENT(elemType)) obj%elemType = elemType +IF (PRESENT(ipType)) obj%ipType = ipType +IF (PRESENT(dofType)) obj%dofType = dofType +IF (PRESENT(transformType)) obj%transformType = transformType +IF (PRESENT(baseContinuity)) THEN + CALL BaseContinuity_fromString( & + & obj=obj%baseContinuity, & + & name=baseContinuity) + obj%baseContinuity0 = baseContinuity +END IF +IF (PRESENT(baseInterpolation)) THEN + CALL BaseInterpolation_fromString( & + & obj=obj%baseInterpolation, & + & name=baseInterpolation) + obj%baseInterpolation0 = baseInterpolation +END IF +IF (PRESENT(refElemDomain)) obj%refElemDomain = refElemDomain +IF (PRESENT(isIsotropicOrder)) obj%isIsotropicOrder = isIsotropicOrder +IF (PRESENT(isAnisotropicOrder)) obj%isAnisotropicOrder = isAnisotropicOrder +IF (PRESENT(isEdgeOrder)) obj%isEdgeOrder = isEdgeOrder +IF (PRESENT(isFaceOrder)) obj%isFaceOrder = isFaceOrder +IF (PRESENT(isCellOrder)) obj%isCellOrder = isCellOrder + +IF (PRESENT(tEdgeOrder)) obj%tEdgeOrder = tEdgeOrder +IF (PRESENT(tFaceOrder)) obj%tFaceOrder = tFaceOrder +IF (PRESENT(tCellOrder)) obj%tCellOrder = tCellOrder + +IF (PRESENT(basisType)) obj%basisType = basisType +IF (PRESENT(alpha)) obj%alpha = alpha +IF (PRESENT(beta)) obj%beta = beta +IF (PRESENT(lambda)) obj%lambda = lambda +END PROCEDURE fe_SetParam + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +END SUBMODULE SetMethods diff --git a/src/submodules/FiniteElement/src/FiniteElement_Class@Methods.F90 b/src/submodules/FiniteElement/src/FiniteElement_Class@Methods.F90 new file mode 100644 index 000000000..b5f9e9de3 --- /dev/null +++ b/src/submodules/FiniteElement/src/FiniteElement_Class@Methods.F90 @@ -0,0 +1,128 @@ +! 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(FiniteElement_Class) Methods +USE ExceptionHandler_Class, ONLY: e +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Initiate +CALL AbstractFEInitiate(obj=obj, param=param, prefix=myprefix) +END PROCEDURE fe_Initiate + +!---------------------------------------------------------------------------- +! CheckEssentialParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_CheckEssentialParam +CALL AbstractFECheckEssentialParam(obj=obj, param=param, prefix=myprefix) +END PROCEDURE fe_CheckEssentialParam + +!---------------------------------------------------------------------------- +! SetFiniteElementParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE SetFiniteElementParam +CALL SetAbstractFEParam( & +& param=param, & +& prefix=myprefix, & +& nsd=nsd, & +& elemType=elemType, & +& baseContinuity=baseContinuity, & +& baseInterpolation=baseInterpolation, & +& ipType=ipType, & +& basisType=basisType, & +& alpha=alpha, & +& beta=beta, & +& lambda=lambda, & +& order=order, & +& anisoOrder=anisoOrder, & +& edgeOrder=edgeOrder, & +& faceOrder=faceOrder, & +& cellOrder=cellOrder) +END PROCEDURE SetFiniteElementParam + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Deallocate_Ptr_Vector +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 Deallocate_Ptr_Vector + +!---------------------------------------------------------------------------- +! Initiate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE fe_Initiate1 +CHARACTER(*), PARAMETER :: myName = "fe_Initiate1()" +TYPE(ParameterList_), POINTER :: sublist +INTEGER(I4B) :: ierr, ii, tElemType +INTEGER(I4B), ALLOCATABLE :: elemType(:) + +sublist => NULL() + +IF (.NOT. param%isSubList(key=myPrefix)) THEN + CALL e%RaiseError(modName//'::'//myName//' - '// & + & '[ARGUMENT ERROR] :: '//myprefix//' should be a sublist') +END IF + +ierr = param%GetSubList(key=myprefix, sublist=sublist) + +elemType = dom%GetElemType(dim=-1_I4B) +tElemType = SIZE(elemType) + +CALL DEALLOCATE (obj) +ALLOCATE(obj(tElemType) ) + +DO ii = 1, SIZE(elemType) + ierr = sublist%Set(key=myprefix//"/elemType", VALUE=elemType(ii)) + ALLOCATE(FiniteElement_::obj(ii)%ptr) + CALL obj(ii)%ptr%Initiate(param=param) +END DO + +sublist => NULL() +IF (ALLOCATED(elemType)) DEALLOCATE (elemType) +END PROCEDURE fe_Initiate1 + +END SUBMODULE Methods diff --git a/src/submodules/FiniteElement/src/LagrangeFE_Class@Methods.F90 b/src/submodules/FiniteElement/src/LagrangeFE_Class@Methods.F90 deleted file mode 100644 index 8d6b49586..000000000 --- a/src/submodules/FiniteElement/src/LagrangeFE_Class@Methods.F90 +++ /dev/null @@ -1,120 +0,0 @@ -! 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(LagrangeFE_Class) Methods -USE BaseMethod -USE RefElementFactory -IMPLICIT NONE -CONTAINS - -!---------------------------------------------------------------------------- -! Initiate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Initiate -INTEGER(I4B), PARAMETER :: dofType(4) = FE_DOF_POINT_EVAL -INTEGER(I4B) :: nsd -REAL(DFP), ALLOCATABLE :: xij(:, :) -!! -!! initiate reference element -!! -CALL obj%Deallocate() -obj%refelem => RefElement_Pointer(elemType=elemType) -nsd = XiDimension(elemType) -CALL obj%refelem%Initiate(nsd=nsd) -!! -CALL obj%SetParam( & - & nsd=nsd, & - & order=order, & - & ipType=ipType, & - & feType=H1_LAGRANGE, & - & dofType=dofType, & - & transformType=FE_TRANSFORM_IDENTITY & - & ) -!! -!! generate lattice point -!! -xij = obj%refelem%GetInterpolationPoint(order=order, ipType=ipType, layout="VEFC") -!! -!! Generate shape functions -!! -SELECT CASE (nsd) -CASE (1_I4B) - obj%oneD = LagrangeSpace1D( & - & x=xij(1, :), & - & order=order, & - & varname="x") -CASE (2_I4B) - obj%twoD = LagrangeSpace2D( & - & x=xij, & - & order=order, & - & varname1="x", & - & varname2="y", & - & elemType=elemType) -CASE (3_I4B) - obj%threeD = LagrangeSpace3D( & - & x=xij, & - & order=order, & - & varname1="x", & - & varname2="y", & - & varname3="z", & - & elemType=elemType) -END SELECT -END PROCEDURE fe_Initiate - -!---------------------------------------------------------------------------- -! Deallocate -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Deallocate -CALL AbstractFEDeallocate(obj) -CALL obj%oneD%Deallocate() -CALL obj%twoD%Deallocate() -CALL obj%threeD%Deallocate() -END PROCEDURE fe_Deallocate - -!---------------------------------------------------------------------------- -! Final -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Final -CALL obj%Deallocate() -END PROCEDURE fe_Final - -!---------------------------------------------------------------------------- -! Display -!---------------------------------------------------------------------------- - -MODULE PROCEDURE fe_Display -INTEGER(I4B) :: nsd -CALL AbstractFEDisplay(obj=obj, msg=msg, unitno=unitno) -nsd = obj%refelem%GetNSD() -SELECT CASE (nsd) -CASE (1) - CALL obj%oneD%Display(msg="LagrangeShapeFunctions=", unitno=unitno) -CASE (2) - CALL obj%twoD%Display(msg="LagrangeShapeFunctions=", unitno=unitno) -CASE (3) - CALL obj%threeD%Display(msg="LagrangeShapeFunctions=", unitno=unitno) -END SELECT -END PROCEDURE fe_Display - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -END SUBMODULE Methods diff --git a/src/submodules/HDF5File/src/HDF5File_Class@ReadBool.F90 b/src/submodules/HDF5File/src/HDF5File_Class@ReadBool.F90 index 95f2985bc..b4b0766f2 100644 --- a/src/submodules/HDF5File/src/HDF5File_Class@ReadBool.F90 +++ b/src/submodules/HDF5File/src/HDF5File_Class@ReadBool.F90 @@ -25,27 +25,27 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE hdf5_read_b0 - CHARACTER( LEN=1 ) :: valsc - CHARACTER( LEN=LEN(dsetname)+1 ) :: path - INTEGER( HSIZE_T ), DIMENSION( 1 ) :: dims - INTEGER( I4B ), PARAMETER :: rank=0 - INTEGER( I4B ) :: error - INTEGER(HID_T) :: mem, dspace_id,dset_id +CHARACTER(1) :: valsc +CHARACTER(LEN(dsetname) + 1) :: path +INTEGER(HSIZE_T), DIMENSION(1) :: dims +INTEGER(I4B), PARAMETER :: rank = 0 +INTEGER(I4B) :: error +INTEGER(HID_T) :: mem, dspace_id, dset_id - path=dsetname - ! Read the dataset - mem=H5T_NATIVE_CHARACTER - CALL preRead(obj,path,rank,dset_id,dspace_id,dims,error) - IF(error >= 0) THEN - CALL h5dread_f(dset_id,mem,valsc,dims,error) +path = dsetname +! Read the dataset +mem = H5T_NATIVE_CHARACTER +CALL preRead(obj, path, rank, dset_id, dspace_id, dims, error) +IF (error >= 0) THEN + CALL h5dread_f(dset_id, mem, valsc, dims, error) ! Convert to logical from character - IF(valsc=='F') THEN - vals=.FALSE. - ELSE - vals=.TRUE. - ENDIF - ENDIF - CALL postRead(obj,path,dset_id,dspace_id,error) + IF (valsc == 'F') THEN + vals = .FALSE. + ELSE + vals = .TRUE. + END IF +END IF +CALL postRead(obj, path, dset_id, dspace_id, error) END PROCEDURE hdf5_read_b0 !---------------------------------------------------------------------------- @@ -53,35 +53,35 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE hdf5_read_b1 - CHARACTER, ALLOCATABLE :: valsc(:) - CHARACTER( LEN=LEN(dsetname)+1 ) :: path - INTEGER( I4B ) :: i, error - INTEGER( HSIZE_T ), DIMENSION( 1 ) :: dims - INTEGER( I4B ), PARAMETER :: rank=1 - INTEGER( HID_T ) :: mem, dspace_id,dset_id +CHARACTER, ALLOCATABLE :: valsc(:) +CHARACTER(LEN(dsetname) + 1) :: path +INTEGER(I4B) :: i, error +INTEGER(HSIZE_T), DIMENSION(1) :: dims +INTEGER(I4B), PARAMETER :: rank = 1 +INTEGER(HID_T) :: mem, dspace_id, dset_id - path=dsetname - ! Allocate space in data if needed, make sure it is the right size - CALL preRead(obj,path,rank,dset_id,dspace_id,dims,error) - IF(error >= 0) THEN - IF(ALLOCATED(vals)) THEN - IF(ANY(SHAPE(vals) /= dims)) THEN - DEALLOCATE(vals) - ALLOCATE(vals(dims(1))) - ENDIF - ELSE - ALLOCATE(vals(dims(1))) - ENDIF - ALLOCATE(valsc(dims(1))) - mem=H5T_NATIVE_CHARACTER - CALL h5dread_f(dset_id,mem,valsc,dims,error) - vals=.FALSE. - FORALL(i=1:SIZE(vals),valsc(i) == 'T') - vals(i)=.TRUE. - ENDFORALL - DEALLOCATE(valsc) - ENDIF - CALL postRead(obj,path,dset_id,dspace_id,error) +path = dsetname +! Allocate space in data if needed, make sure it is the right size +CALL preRead(obj, path, rank, dset_id, dspace_id, dims, error) +IF (error >= 0) THEN + IF (ALLOCATED(vals)) THEN + IF (ANY(SHAPE(vals) /= dims)) THEN + DEALLOCATE (vals) + ALLOCATE (vals(dims(1))) + END IF + ELSE + ALLOCATE (vals(dims(1))) + END IF + ALLOCATE (valsc(dims(1))) + mem = H5T_NATIVE_CHARACTER + CALL h5dread_f(dset_id, mem, valsc, dims, error) + vals = .FALSE. + DO CONCURRENT(i=1:SIZE(vals), valsc(i) == 'T') + vals(i) = .TRUE. + END DO + DEALLOCATE (valsc) +END IF +CALL postRead(obj, path, dset_id, dspace_id, error) END PROCEDURE hdf5_read_b1 !---------------------------------------------------------------------------- @@ -89,38 +89,38 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE hdf5_read_b2 - CHARACTER( LEN=1 ), ALLOCATABLE :: valsc(:,:) - CHARACTER( LEN=LEN(dsetname)+1 ) :: path - INTEGER( I4B ) :: i,j,error - INTEGER( HSIZE_T ), DIMENSION( 2 ) :: dims - INTEGER( I4B ), PARAMETER :: rank=2 - INTEGER( HID_T ) :: mem, dspace_id,dset_id +CHARACTER(1), ALLOCATABLE :: valsc(:, :) +CHARACTER(LEN(dsetname) + 1) :: path +INTEGER(I4B) :: i, j, error +INTEGER(HSIZE_T), DIMENSION(2) :: dims +INTEGER(I4B), PARAMETER :: rank = 2 +INTEGER(HID_T) :: mem, dspace_id, dset_id - path=dsetname - CALL preRead(obj,path,rank,dset_id,dspace_id,dims,error) - IF(error >= 0) THEN - IF(ALLOCATED(vals)) THEN - IF(ANY(SHAPE(vals) /= dims)) THEN - DEALLOCATE(vals) - ALLOCATE(vals(dims(1),dims(2))) - ENDIF - ELSE - ALLOCATE(vals(dims(1),dims(2))) - ENDIF - ALLOCATE(valsc(dims(1),dims(2))) +path = dsetname +CALL preRead(obj, path, rank, dset_id, dspace_id, dims, error) +IF (error >= 0) THEN + IF (ALLOCATED(vals)) THEN + IF (ANY(SHAPE(vals) /= dims)) THEN + DEALLOCATE (vals) + ALLOCATE (vals(dims(1), dims(2))) + END IF + ELSE + ALLOCATE (vals(dims(1), dims(2))) + END IF + ALLOCATE (valsc(dims(1), dims(2))) - ! Read the dataset - mem=H5T_NATIVE_CHARACTER - CALL h5dread_f(dset_id,mem,valsc,dims,error) - ! Convert from surrogate character array to boolean array - vals=.FALSE. - FORALL(i=1:SIZE(vals,DIM=1),j=1:SIZE(vals,DIM=2),valsc(i,j) == 'T') - vals(i,j)=.TRUE. - ENDFORALL + ! Read the dataset + mem = H5T_NATIVE_CHARACTER + CALL h5dread_f(dset_id, mem, valsc, dims, error) + ! Convert from surrogate character array to boolean array + vals = .FALSE. + DO concurrent(i=1:SIZE(vals, DIM=1), j=1:SIZE(vals, DIM=2), valsc(i, j) == 'T') + vals(i, j) = .TRUE. + END DO - DEALLOCATE(valsc) - ENDIF - CALL postRead(obj,path,dset_id,dspace_id,error) + DEALLOCATE (valsc) +END IF +CALL postRead(obj, path, dset_id, dspace_id, error) END PROCEDURE hdf5_read_b2 !---------------------------------------------------------------------------- @@ -130,4 +130,4 @@ MODULE PROCEDURE hdf5_read_b3 END PROCEDURE hdf5_read_b3 -END SUBMODULE ReadBool \ No newline at end of file +END SUBMODULE ReadBool diff --git a/src/submodules/HDF5File/src/write.inc b/src/submodules/HDF5File/src/write.inc index 430a193ed..8af11820d 100644 --- a/src/submodules/HDF5File/src/write.inc +++ b/src/submodules/HDF5File/src/write.inc @@ -1,93 +1,93 @@ #ifdef mem_type_bool #if rank==0 - CHARACTER( LEN = 1 ) :: charvals + CHARACTER(LEN=1) :: charvals #endif #if rank==1 - CHARACTER( LEN = 1 ) :: charvals(1:SIZE(vals)) + CHARACTER(LEN=1) :: charvals(1:SIZE(vals)) #endif #if rank==2 - CHARACTER :: charvals( SIZE(vals, 1), SIZE(vals, 2)) + CHARACTER :: charvals(SIZE(vals, 1), SIZE(vals, 2)) #endif #if rank==3 - CHARACTER :: charvals( SIZE(vals, 1), SIZE(vals,DIM=2), SIZE(vals, 3)) + CHARACTER :: charvals(SIZE(vals, 1), SIZE(vals, DIM=2), SIZE(vals, 3)) #endif #endif -CHARACTER( LEN = LEN( dsetname ) + 1 ) :: path + CHARACTER(LEN=LEN(dsetname) + 1) :: path #if rank==0 -INTEGER( HSIZE_T ), DIMENSION( 1 ) :: ldims, gdims, offset, cnt + INTEGER(HSIZE_T), DIMENSION(1) :: ldims, gdims, offset, cnt #else -INTEGER( HSIZE_T ), DIMENSION( rank ) :: ldims, gdims, offset, cnt + INTEGER(HSIZE_T), DIMENSION(rank) :: ldims, gdims, offset, cnt #endif -INTEGER( HID_T ) :: mem, dspace_id, dset_id, gspace_id, plist_id -INTEGER( I4B ) :: ii, jj, kk + INTEGER(HID_T) :: mem, dspace_id, dset_id, gspace_id, plist_id + INTEGER(I4B) :: ii, jj, kk ! stash offset -DO ii = 1, rank + DO ii = 1, rank #if rank==0 - offset( ii ) = 0 + offset(ii) = 0 #else - offset( ii ) = LBOUND(vals, ii) - 1 + offset(ii) = LBOUND(vals, ii) - 1 #endif -END DO -IF( PRESENT( offset_in ) ) offset = offset_in -path=dsetname + END DO + IF (PRESENT(offset_in)) offset = offset_in + path = dsetname #if rank==0 -ldims = 1 + ldims = 1 #else -ldims=SHAPE(vals) + ldims = SHAPE(vals) #endif -IF(PRESENT(gdims_in)) THEN - gdims=gdims_in -ELSE - gdims=ldims -ENDIF -cnt=gdims -IF( PRESENT( cnt_in ) ) cnt = cnt_in + IF (PRESENT(gdims_in)) THEN + gdims = gdims_in + ELSE + gdims = ldims + END IF + cnt = gdims + IF (PRESENT(cnt_in)) cnt = cnt_in #ifdef mem_type_bool #if rank==0 - IF(vals) THEN - charvals='T' + IF (vals) THEN + charvals = 'T' ELSE - charvals='F' - ENDIF + charvals = 'F' + END IF #endif #if rank==1 - charvals='F' - FORALL(ii=1:SIZE(vals),vals(ii)) - charvals(ii)='T' - END FORALL + charvals = 'F' + DO CONCURRENT(ii=1:SIZE(vals), vals(ii)) + charvals(ii) = 'T' + END DO #endif #if rank==2 - charvals( :, : ) = 'F' - FORALL( ii=1:SIZE( vals, 1 ), jj=1:SIZE( vals, 2 ), vals( ii, jj ) ) - charvals( ii, jj ) = 'T' - END FORALL + charvals(:, :) = 'F' + DO CONCURRENT(ii=1:SIZE(vals, 1), jj=1:SIZE(vals, 2), vals(ii, jj)) + charvals(ii, jj) = 'T' + END DO #endif #if rank==3 - charvals( :, :, : ) = 'F' - FORALL( ii = 1:SIZE( vals, 1 ), jj = 1:SIZE( vals, 2 ), kk=1:SIZE( vals, 3 ), vals( ii, jj, kk ) ) - charvals( ii, jj, kk ) = 'T' - END FORALL + charvals(:, :, :) = 'F' + do CONCURRENT ( ii = 1:SIZE( vals, 1 ), jj = 1:SIZE( vals, 2 ), kk=1:SIZE( vals, 3 ), vals( ii, jj, kk ) ) + charvals(ii, jj, kk) = 'T' + END DO #endif #endif - mem=mem_type - CALL preWrite(obj,rank,gdims,ldims,path,mem,dset_id,dspace_id, & - & gspace_id,plist_id,ierr,cnt,offset) + mem = mem_type + CALL preWrite(obj, rank, gdims, ldims, path, mem, dset_id, dspace_id, & + & gspace_id, plist_id, ierr, cnt, offset) #ifdef mem_type_bool - IF(ierr == 0) & - CALL h5dwrite_f(dset_id,mem,charvals,gdims,ierr,dspace_id,gspace_id,plist_id) + IF (ierr == 0) & + CALL h5dwrite_f(dset_id,mem,charvals,gdims,ierr,dspace_id,gspace_id,plist_id) #else - IF(ierr == 0) & - CALL h5dwrite_f(dset_id,mem,vals,gdims,ierr,dspace_id,gspace_id,plist_id) + IF (ierr == 0) & + CALL h5dwrite_f(dset_id,mem,vals,gdims,ierr,dspace_id,gspace_id,plist_id) #endif - CALL postWrite(Obj,ierr,dset_id,dspace_id,gspace_id,plist_id) + CALL postWrite(Obj, ierr, dset_id, dspace_id, gspace_id, plist_id) diff --git a/src/submodules/LinSolver/src/LinSolver_Class@SetMethods.F90 b/src/submodules/LinSolver/src/LinSolver_Class@SetMethods.F90 index 7e7297c20..e6cb3590a 100644 --- a/src/submodules/LinSolver/src/LinSolver_Class@SetMethods.F90 +++ b/src/submodules/LinSolver/src/LinSolver_Class@SetMethods.F90 @@ -95,6 +95,7 @@ END SUBROUTINE AllocateWorkSpace MODULE PROCEDURE setLinSolverParam CHARACTER(*), PARAMETER :: myName = "setLinSolverParam" +INTEGER(I4B) :: p_name0 IF (.NOT. PRESENT(solverName)) THEN CALL e%raiseError(modName//'::'//myName//' - '// & @@ -120,6 +121,8 @@ END SUBROUTINE AllocateWorkSpace & 'preconditionOption should be present') END IF +p_name0 = input(option=p_name, default=PRECOND_NONE) + IF (preconditionOption .NE. PRECOND_NONE) THEN IF (.NOT. PRESENT(p_name)) THEN CALL e%raiseError(modName//'::'//myName//' - '// & @@ -128,7 +131,9 @@ END SUBROUTINE AllocateWorkSpace END IF END IF -SELECT CASE (p_name) +SELECT CASE (p_name0) +CASE( PRECOND_NONE ) + !! Do nothing CASE (PRECOND_ILUT) IF (.NOT. PRESENT(p_ilu_droptol) .OR. & & .NOT. PRESENT(p_ilu_lfil)) THEN @@ -263,11 +268,11 @@ END SUBROUTINE AllocateWorkSpace CALL setAbstractLinSolverParam( & & param=param, & -& prefix="LinSolver", & +& prefix=myprefix, & & engine="NATIVE_SERIAL", & & solverName=solverName, & & preconditionOption=preconditionOption, & -& p_name=p_name, & +& p_name=p_name0, & & convergenceIn=INPUT(option=convergenceIn, default=default_convergenceIn), & & convergenceType=INPUT(option=convergenceType, default=default_convergenceType), & & maxIter=INPUT(option=maxIter, default=default_maxIter), & diff --git a/src/submodules/MSHFile/CMakeLists.txt b/src/submodules/MSHFile/CMakeLists.txt index d8336e0f9..d6dee25aa 100644 --- a/src/submodules/MSHFile/CMakeLists.txt +++ b/src/submodules/MSHFile/CMakeLists.txt @@ -1,3 +1,21 @@ +# 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 @@ -8,4 +26,4 @@ TARGET_SOURCES( ${src_path}/mshElements_Class@Methods.F90 ${src_path}/MSHFile_Class@ConstructorMethods.F90 ${src_path}/MSHFile_Class@IOMethods.F90 - ) \ No newline at end of file + ) diff --git a/src/submodules/MSHFile/src/MSHFile_Class@IOMethods.F90 b/src/submodules/MSHFile/src/MSHFile_Class@IOMethods.F90 index 83bdecc6f..674be0e65 100644 --- a/src/submodules/MSHFile/src/MSHFile_Class@IOMethods.F90 +++ b/src/submodules/MSHFile/src/MSHFile_Class@IOMethods.F90 @@ -17,6 +17,7 @@ SUBMODULE(MSHFile_Class) IOMethods USE BaseMethod +USE mshEntity_Class, ONLY: GetIndex IMPLICIT NONE CONTAINS @@ -36,7 +37,7 @@ MODULE PROCEDURE msh_Export_hdf5 CHARACTER(*), PARAMETER :: myName = "msh_Export_hdf5" -INTEGER(I4B) :: ii, tsize, tNodes, count +INTEGER(I4B) :: ii, tsize, tNodes, count_ REAL(DFP), ALLOCATABLE :: nodeCoord(:, :) INTEGER(I4B), ALLOCATABLE :: local_nptrs(:) TYPE(String) :: dsetname @@ -56,7 +57,7 @@ tNodes = obj%nodes%getNumNodes() ALLOCATE (nodeCoord(3, tNodes)) ALLOCATE (local_nptrs(obj%Nodes%getMaxNodeTag())) -count = 0 +count_ = 0 local_nptrs = 0 CALL hdf5%WRITE(dsetname=dsetname%chars()//"/NSD", vals=obj%nsd) @@ -77,7 +78,7 @@ & dsetname=dsetname%chars()//"/pointEntities_"// & & TRIM(str(ii, .TRUE.)), nsd=obj%nsd) CALL getNodeCoord(obj=obj%pointEntities(ii), nodeCoord=nodeCoord, & - & local_nptrs=local_nptrs, count=count) + & local_nptrs=local_nptrs, count_=count_) END DO IF (ALLOCATED(obj%curveEntities)) THEN tsize = SIZE(obj%curveEntities) @@ -91,7 +92,7 @@ & dsetname=dsetname%chars()//"/curveEntities_"// & & TRIM(str(ii, .TRUE.)), nsd=obj%nsd) CALL getNodeCoord(obj=obj%curveEntities(ii), nodeCoord=nodeCoord, & - & local_nptrs=local_nptrs, count=count) + & local_nptrs=local_nptrs, count_=count_) END DO IF (ALLOCATED(obj%surfaceEntities)) THEN tsize = SIZE(obj%surfaceEntities) @@ -105,7 +106,7 @@ & dsetname=dsetname%chars()//"/surfaceEntities_"// & & TRIM(str(ii, .TRUE.)), nsd=obj%nsd) CALL getNodeCoord(obj=obj%surfaceEntities(ii), nodeCoord=nodeCoord, & - & local_nptrs=local_nptrs, count=count) + & local_nptrs=local_nptrs, count_=count_) END DO IF (ALLOCATED(obj%volumeEntities)) THEN tsize = SIZE(obj%volumeEntities) @@ -119,7 +120,7 @@ & dsetname=dsetname%chars()//"/volumeEntities_"// & & TRIM(str(ii, .TRUE.)), nsd=obj%nsd) CALL getNodeCoord(obj=obj%volumeEntities(ii), nodeCoord=nodeCoord, & - & local_nptrs=local_nptrs, count=count) + & local_nptrs=local_nptrs, count_=count_) END DO CALL hdf5%WRITE(dsetname=dsetname%chars()//"/nodeCoord", & &vals=nodeCoord) @@ -272,11 +273,11 @@ END SUBROUTINE ExportMeshEntity ! ExportNodeCoord !---------------------------------------------------------------------------- -SUBROUTINE getNodeCoord(obj, nodeCoord, local_nptrs, count) +SUBROUTINE getNodeCoord(obj, nodeCoord, local_nptrs, count_) TYPE(mshEntity_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT) :: nodeCoord(:, :) INTEGER(I4B), INTENT(INOUT) :: local_nptrs(:) - INTEGER(I4B), INTENT(INOUT) :: count + INTEGER(I4B), INTENT(INOUT) :: count_ ! internal data REAL(DFP), ALLOCATABLE :: myNodeCoord(:, :) INTEGER(I4B), ALLOCATABLE :: myNptrs(:) @@ -284,9 +285,9 @@ SUBROUTINE getNodeCoord(obj, nodeCoord, local_nptrs, count) myNodeCoord = obj%getNodeCoord() myNptrs = obj%getIntNodeNumber() DO ii = 1, SIZE(myNptrs) - count = count + 1 - local_nptrs(myNptrs(ii)) = count - nodeCoord(:, count) = myNodeCoord(:, ii) + count_ = count_ + 1 + local_nptrs(myNptrs(ii)) = count_ + nodeCoord(:, count_) = myNodeCoord(:, ii) END DO IF (ALLOCATED(myNodeCoord)) DEALLOCATE (myNodeCoord) IF (ALLOCATED(myNptrs)) DEALLOCATE (myNptrs) @@ -377,7 +378,7 @@ END SUBROUTINE getNodeCoord INTEGER(I4B) :: unitNo CHARACTER(*), PARAMETER :: myName = "ReadPointEntities" INTEGER(I4B) :: i, j, k, tpt, error, dim -INTEGER(I4B), ALLOCATABLE :: PhysicalTag(:) +INTEGER(I4B), ALLOCATABLE :: PhysicalTag0(:) !> main program dim = 0; unitNo = obj%getUnitNo() CALL e%raiseInformation(modName//'::'//myName//' - ' & @@ -393,10 +394,10 @@ END SUBROUTINE getNodeCoord tpt = obj%PointEntities(i)%getTotalPhysicalTags() IF (tpt .NE. 0) THEN ! get physical tag int vector - PhysicalTag = obj%PointEntities(i)%getPhysicalTag() + PhysicalTag0 = obj%PointEntities(i)%getPhysicalTag() DO j = 1, tpt ! get index of physical tag - k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag(j)) + k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag0(j)) ! append this index to entities CALL obj%PhysicalNames%AppendEntities(indx=k, EntityTag=[i]) END DO @@ -414,7 +415,7 @@ END SUBROUTINE getNodeCoord INTEGER(I4B) :: unitNo CHARACTER(*), PARAMETER :: myName = "ReadCurveEntities" INTEGER(I4B) :: i, j, k, tpt, error, dim -INTEGER(I4B), ALLOCATABLE :: PhysicalTag(:) +INTEGER(I4B), ALLOCATABLE :: PhysicalTag0(:) !> main program dim = 1; unitNo = obj%getUnitNo() CALL e%raiseInformation(modName//'::'//myName//' - ' & @@ -430,10 +431,10 @@ END SUBROUTINE getNodeCoord tpt = obj%CurveEntities(i)%getTotalPhysicalTags() IF (tpt .NE. 0) THEN ! get physical tag int vector - PhysicalTag = obj%CurveEntities(i)%getPhysicalTag() + PhysicalTag0 = obj%CurveEntities(i)%getPhysicalTag() DO j = 1, tpt ! get index of physical tag - k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag(j)) + k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag0(j)) ! append this index to entities CALL obj%PhysicalNames%AppendEntities(indx=k, EntityTag=[i]) END DO @@ -451,7 +452,7 @@ END SUBROUTINE getNodeCoord INTEGER(I4B) :: unitNo CHARACTER(*), PARAMETER :: myName = "ReadSurfaceEntities" INTEGER(I4B) :: i, j, k, tpt, error, dim -INTEGER(I4B), ALLOCATABLE :: PhysicalTag(:) +INTEGER(I4B), ALLOCATABLE :: PhysicalTag0(:) !> main program dim = 2; unitNo = obj%getUnitNo() CALL e%raiseInformation(modName//'::'//myName//' - ' & @@ -467,10 +468,10 @@ END SUBROUTINE getNodeCoord tpt = obj%SurfaceEntities(i)%getTotalPhysicalTags() IF (tpt .NE. 0) THEN ! get physical tag int vector - PhysicalTag = obj%SurfaceEntities(i)%getPhysicalTag() + PhysicalTag0 = obj%SurfaceEntities(i)%getPhysicalTag() DO j = 1, tpt ! get index of physical tag - k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag(j)) + k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag0(j)) ! append this index to entities CALL obj%PhysicalNames%AppendEntities(indx=k, EntityTag=[i]) END DO @@ -488,7 +489,7 @@ END SUBROUTINE getNodeCoord INTEGER(I4B) :: unitNo CHARACTER(*), PARAMETER :: myName = "ReadVolumeEntities" INTEGER(I4B) :: i, j, k, tpt, error, dim -INTEGER(I4B), ALLOCATABLE :: PhysicalTag(:) +INTEGER(I4B), ALLOCATABLE :: PhysicalTag0(:) !> main program dim = 3; unitNo = obj%getUnitNo() CALL e%raiseInformation(modName//'::'//myName//' - ' & @@ -504,10 +505,10 @@ END SUBROUTINE getNodeCoord tpt = obj%VolumeEntities(i)%getTotalPhysicalTags() IF (tpt .NE. 0) THEN ! get physical tag int vector - PhysicalTag = obj%VolumeEntities(i)%getPhysicalTag() + PhysicalTag0 = obj%VolumeEntities(i)%getPhysicalTag() DO j = 1, tpt ! get index of physical tag - k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag(j)) + k = obj%PhysicalNames%getIndex(dim=dim, tag=PhysicalTag0(j)) ! append this index to entities CALL obj%PhysicalNames%AppendEntities(indx=k, EntityTag=[i]) END DO diff --git a/src/submodules/Mesh/src/Mesh_Class@BoundaryDataMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@BoundaryDataMethods.F90 index b097e1dbb..59ef12bca 100644 --- a/src/submodules/Mesh/src/Mesh_Class@BoundaryDataMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@BoundaryDataMethods.F90 @@ -29,49 +29,44 @@ INTEGER(I4B) :: iel, tFace, ii, jj, kk INTEGER(I4B), ALLOCATABLE :: global_nptrs(:), ElemToElem(:, :) CHARACTER(*), PARAMETER :: myName = "mesh_InitiateBoundaryData" -! + ! 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) @@ -80,7 +75,7 @@ & 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) diff --git a/src/submodules/Mesh/src/Mesh_Class@FacetDataMethods.F90 b/src/submodules/Mesh/src/Mesh_Class@FacetDataMethods.F90 index 02f52da24..f366e4aec 100644 --- a/src/submodules/Mesh/src/Mesh_Class@FacetDataMethods.F90 +++ b/src/submodules/Mesh/src/Mesh_Class@FacetDataMethods.F90 @@ -1,7 +1,7 @@ -! This program is a part of EASIFEM library +! 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 +! 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. @@ -29,89 +29,70 @@ INTEGER(I4B) :: iel, ii, jj, iintface, idomainFace, kk, telements, & & tIntFace, tDomainFace INTEGER(I4B), ALLOCATABLE :: e2e(:, :), indx(:), cellNptrs(:) -! -! check -! + IF (obj%elemType .EQ. 0 .OR. obj%elemType .EQ. Point1) RETURN -! -! check -! -IF (obj%isFacetDataInitiated) THEN + +IF (obj%IsFacetDataInitiated) THEN CALL e%raiseInformation(modName//"::"//myName//" - "// & & "InternalFacetData and boundary facet data is already initiated. & & If you want to Reinitiate it then deallocate nodeData, first!") RETURN END IF -! -! InitiateElementToElements -! -IF (.NOT. obj%isElementToElementsInitiated) THEN - CALL obj%InitiateElementToElements() -END IF -! -! InitiateBoundaryData -! -IF (.NOT. obj%isBoundaryDataInitiated) THEN - CALL obj%InitiateBoundaryData() -END IF -! -! main -! + +IF (.NOT. obj%IsElementToElementsInitiated) & + & CALL obj%InitiateElementToElements() + +IF (.NOT. obj%IsBoundaryDataInitiated) & + & CALL obj%InitiateBoundaryData() + tDomainFace = 0 tIntFace = 0 obj%isFacetDataInitiated = .TRUE. -DO iel = 1, obj%getTotalElements() +DO iel = 1, obj%GetTotalElements() - jj = obj%getGlobalElemNumber(iel) + jj = obj%GetGlobalElemNumber(iel) - IF (obj%isBoundaryElement(globalElement=jj)) THEN - tDomainFace = tDomainFace + & - & SIZE(obj%getBoundaryElementData(globalElement=jj)) - END IF + IF (obj%IsBoundaryElement(globalElement=jj)) & + & tDomainFace = tDomainFace + & + & SIZE(obj%GetBoundaryElementData(globalElement=jj)) + + e2e = obj%GetElementToElements(globalElement=jj, onlyElements=.TRUE.) - 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() +telements = obj%GetTotalElements() CALL Reallocate(obj%facetElementType, SIZE(obj%facetElements), telements) iintface = 0; idomainFace = 0 -! -! start the loop for each cell element of the mesh -! + DO iel = 1, telements - ! - jj = obj%getGlobalElemNumber(iel) - cellNptrs = obj%getConnectivity(globalElement=jj) - e2e = obj%getElementToElements(globalElement=jj, onlyElements=.FALSE.) - ! + + 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) - ! + 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 @@ -119,13 +100,12 @@ 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 @@ -137,13 +117,13 @@ 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) -! + END PROCEDURE mesh_InitiateFacetElements !---------------------------------------------------------------------------- diff --git a/src/submodules/MeshSelection/src/MeshSelection_Class@ConstructorMethods.F90 b/src/submodules/MeshSelection/src/MeshSelection_Class@ConstructorMethods.F90 index 2c7d00631..45b9374c3 100644 --- a/src/submodules/MeshSelection/src/MeshSelection_Class@ConstructorMethods.F90 +++ b/src/submodules/MeshSelection/src/MeshSelection_Class@ConstructorMethods.F90 @@ -76,15 +76,15 @@ obj%isSelectionByNodeNum = .FALSE. obj%isSelectionByMeshID = .FALSE. obj%isSelectionByBox = .FALSE. -CALL Deallocate (obj%PointMeshID) -CALL Deallocate (obj%CurveMeshID) -CALL Deallocate (obj%SurfaceMeshID) -CALL Deallocate (obj%VolumeMeshID) -CALL Deallocate (obj%PointElemNum) -CALL Deallocate (obj%CurveElemNum) -CALL Deallocate (obj%SurfaceElemNum) -CALL Deallocate (obj%VolumeElemNum) -CALL Deallocate (obj%NodeNum) +CALL DEALLOCATE (obj%PointMeshID) +CALL DEALLOCATE (obj%CurveMeshID) +CALL DEALLOCATE (obj%SurfaceMeshID) +CALL DEALLOCATE (obj%VolumeMeshID) +CALL DEALLOCATE (obj%PointElemNum) +CALL DEALLOCATE (obj%CurveElemNum) +CALL DEALLOCATE (obj%SurfaceElemNum) +CALL DEALLOCATE (obj%VolumeElemNum) +CALL DEALLOCATE (obj%NodeNum) END PROCEDURE meshSelect_Deallocate !---------------------------------------------------------------------------- @@ -92,7 +92,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE meshSelect_Final -CALL obj%Deallocate() +CALL obj%DEALLOCATE() END PROCEDURE meshSelect_Final !---------------------------------------------------------------------------- @@ -119,4 +119,35 @@ IF (isAllocated(obj2%NodeNum)) obj%NodeNum = obj2%NodeNum END PROCEDURE meshSelect_Copy +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Deallocate_Ptr_Vector +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 Deallocate_Ptr_Vector + END SUBMODULE ConstructorMethods diff --git a/src/submodules/NeumannBC/src/NeumannBC_Class@ConstructorMethods.F90 b/src/submodules/NeumannBC/src/NeumannBC_Class@ConstructorMethods.F90 index 8b7ead007..e9807fd92 100644 --- a/src/submodules/NeumannBC/src/NeumannBC_Class@ConstructorMethods.F90 +++ b/src/submodules/NeumannBC/src/NeumannBC_Class@ConstructorMethods.F90 @@ -68,4 +68,64 @@ CALL obj%DEALLOCATE() END PROCEDURE bc_Final +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE bc_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Ptr_Vector +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 bc_Deallocate_Ptr_Vector + +!---------------------------------------------------------------------------- +! AddNeumannBC +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_AddNeumannBC +CHARACTER(*), PARAMETER :: myName = "bc_AddNeumannBC" + +IF (nbcNo .GT. SIZE(nbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: nbcNo [= '//TOSTRING(nbcNo)// & + & '] is out of bound for nbc [= '// & + & TOSTRING(SIZE(nbc))//']') +END IF + +IF (ASSOCIATED(nbc(nbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: nbc( '//TOSTRING(nbcNo)// & + & ')%ptr is already associated, deallocate and nullify it first.') +END IF + +ALLOCATE (nbc(nbcNo)%ptr) + +CALL nbc(nbcNo)%ptr%initiate( & + & param=param, & + & boundary=boundary, & + & dom=dom) + +END PROCEDURE bc_AddNeumannBC + END SUBMODULE ConstructorMethods diff --git a/src/submodules/NeumannBC/src/NeumannBC_Class@GetMethods.F90 b/src/submodules/NeumannBC/src/NeumannBC_Class@GetMethods.F90 index d05ec146a..f3859271c 100644 --- a/src/submodules/NeumannBC/src/NeumannBC_Class@GetMethods.F90 +++ b/src/submodules/NeumannBC/src/NeumannBC_Class@GetMethods.F90 @@ -16,6 +16,28 @@ ! SUBMODULE(NeumannBC_Class) GetMethods +USE BaseMethod, ONLY: TOSTRING IMPLICIT NONE CONTAINS + +!---------------------------------------------------------------------------- +! GetNeumannBCPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_GetNeumannBCPointer +CHARACTER(*), PARAMETER :: myName = "bc_GetNeumannBCPointer" + +IF (nbcNo .GT. SIZE(nbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: nbcNo is out of bound for nbc') +END IF + +IF (.NOT. ASSOCIATED(nbc(nbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: nbc( '//TOSTRING(nbcNo) & + & //')%ptr is not ASSOCIATED') +END IF +ans => nbc(nbcNo)%ptr +END PROCEDURE bc_GetNeumannBCPointer + END SUBMODULE GetMethods diff --git a/src/submodules/NitscheBC/src/NitscheBC_Class@ConstructorMethods.F90 b/src/submodules/NitscheBC/src/NitscheBC_Class@ConstructorMethods.F90 index da7a31e42..bbc2ee44b 100644 --- a/src/submodules/NitscheBC/src/NitscheBC_Class@ConstructorMethods.F90 +++ b/src/submodules/NitscheBC/src/NitscheBC_Class@ConstructorMethods.F90 @@ -69,4 +69,64 @@ CALL obj%DEALLOCATE() END PROCEDURE bc_Final +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE bc_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_Deallocate_Ptr_Vector +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 bc_Deallocate_Ptr_Vector + +!---------------------------------------------------------------------------- +! AddNitscheBC +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_AddNitscheBC +CHARACTER(*), PARAMETER :: myName = "bc_AddNitscheBC" + +IF (dbcNo .GT. SIZE(dbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: dbcNo [= '//TOSTRING(dbcNo)// & + & '] is out of bound for dbc [= '// & + & TOSTRING(SIZE(dbc))//']') +END IF + +IF (ASSOCIATED(dbc(dbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: DBC( '//TOSTRING(dbcNo)// & + & ')%ptr is already associated, deallocate and nullify it first.') +END IF + +ALLOCATE (dbc(dbcNo)%ptr) + +CALL dbc(dbcNo)%ptr%initiate( & + & param=param, & + & boundary=boundary, & + & dom=dom) + +END PROCEDURE bc_AddNitscheBC + END SUBMODULE ConstructorMethods diff --git a/src/submodules/NitscheBC/src/NitscheBC_Class@GetMethods.F90 b/src/submodules/NitscheBC/src/NitscheBC_Class@GetMethods.F90 index 7d9b95fc8..705f0af65 100644 --- a/src/submodules/NitscheBC/src/NitscheBC_Class@GetMethods.F90 +++ b/src/submodules/NitscheBC/src/NitscheBC_Class@GetMethods.F90 @@ -16,9 +16,14 @@ ! SUBMODULE(NitscheBC_Class) GetMethods +USE BaseMethod, ONLY: TOSTRING IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! GetMinCellEntity +!---------------------------------------------------------------------------- + MODULE PROCEDURE bc_GetMinCellEntity IF (ALLOCATED(obj%cellEntity)) THEN ans = LBOUND(obj%cellEntity, 1) @@ -86,4 +91,26 @@ ans = obj%localFacetID(entityNum) END PROCEDURE bc_getLocalFacetID +!---------------------------------------------------------------------------- +! GetNitscheBCPointer +!---------------------------------------------------------------------------- + +MODULE PROCEDURE bc_GetNitscheBCPointer +CHARACTER(*), PARAMETER :: myName = "bc_GetNitscheBCPointer" + +IF (dbcNo .GT. SIZE(dbc)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[OUT OF BOUND ERROR] :: dbcNo is out of bound for dbc') +END IF + +IF (.NOT. ASSOCIATED(dbc(dbcNo)%ptr)) THEN + CALL e%raiseError(modName//'::'//myName//" - "// & + & '[ALLOCATION ERROR] :: obj%dbc( '//TOSTRING(dbcNo) & + & //')%ptr is not ASSOCIATED') +END IF + +ans => dbc(dbcNo)%ptr + +END PROCEDURE bc_GetNitscheBCPointer + END SUBMODULE GetMethods diff --git a/src/submodules/RefElement/CMakeLists.txt b/src/submodules/RefElement/CMakeLists.txt index 695d60ec8..b838a2460 100644 --- a/src/submodules/RefElement/CMakeLists.txt +++ b/src/submodules/RefElement/CMakeLists.txt @@ -28,4 +28,4 @@ TARGET_SOURCES( ${src_path}/RefHexahedron_Class@Methods.F90 ${src_path}/RefPrism_Class@Methods.F90 ${src_path}/RefPyramid_Class@Methods.F90 -) \ No newline at end of file +) diff --git a/src/submodules/RefElement/src/AbstractRefElement_Class@Methods.F90 b/src/submodules/RefElement/src/AbstractRefElement_Class@Methods.F90 index 3bb4f9e73..ff9eb6032 100644 --- a/src/submodules/RefElement/src/AbstractRefElement_Class@Methods.F90 +++ b/src/submodules/RefElement/src/AbstractRefElement_Class@Methods.F90 @@ -13,7 +13,6 @@ ! ! You should have received a copy of the GNU General Public License ! along with this program. If not, see -! SUBMODULE(AbstractRefElement_Class) Methods USE BaseMethod @@ -25,20 +24,70 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_Initiate +CHARACTER(*), PARAMETER :: myName = "refelem_Initiate" INTEGER(I4B) :: name -!! +CHARACTER(20) :: domainName +REAL(DFP), ALLOCATABLE :: xij0(:, :) + +CALL obj%DEALLOCATE() + +IF (PRESENT(xij)) THEN + + IF (SIZE(xij, 1) .NE. nsd) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[ARG MISMATCH] size(xij, 1) .NE. NSD') + END IF + + xij0 = xij + +ELSE + + IF (.NOT. PRESENT(baseContinuity)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[MISSING ARG] baseContinuity should be present.') + END IF + + IF (.NOT. PRESENT(baseInterpolation)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[MISSING ARG] baseInterpolation should be present.') + END IF + + xij0 = obj%RefCoord( & + & baseInterpolation=baseInterpolation, & + & baseContinuity=baseContinuity) + +END IF + name = obj%GetName() -!! + +SELECT CASE (name) +CASE (Point) + obj%refelem = ReferencePoint(nsd=nsd, xij=xij0) +CASE (Line) + obj%refelem = ReferenceLine(nsd=nsd, xij=xij0) +CASE (Triangle) + obj%refelem = ReferenceTriangle(nsd=nsd, xij=xij0) +CASE (Quadrangle) + obj%refelem = ReferenceQuadrangle(nsd=nsd, xij=xij0) +CASE (Tetrahedron) + obj%refelem = ReferenceTetrahedron(nsd=nsd, xij=xij0) +CASE (Hexahedron) + obj%refelem = ReferenceHexahedron(nsd=nsd, xij=xij0) +CASE (Prism) + obj%refelem = ReferencePrism(nsd=nsd, xij=xij0) +CASE (Pyramid) + obj%refelem = ReferencePyramid(nsd=nsd, xij=xij0) +CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & '[NO CASE FOUND] no case found for given refelem name') +END SELECT + CALL obj%SetParam( & - & xij=EquidistancePoint(order=1_I4B, elemType=name), & - & entityCounts=TotalEntities(elemType=name), & - & nsd=nsd, & - & xidimension=Xidimension(elemType=name), & - & name=name, & - & nameStr=ElementName(name)) -!! -CALL obj%GenerateTopology() -!! + & nameStr=ElementName(name), & + & baseContinuity=baseContinuity, & + & baseInterpolation=baseInterpolation) + +! CALL obj%GenerateTopology() END PROCEDURE refelem_Initiate !---------------------------------------------------------------------------- @@ -46,60 +95,30 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetTopology -INTEGER(I4B) :: ii, n -!! +INTEGER(I4B) :: ii, n, jj + IF (PRESENT(xidim)) THEN - n = obj%entityCounts(xidim + 1) + n = obj%refelem%entityCounts(xidim + 1) + ALLOCATE (ans(n)) - !! - SELECT CASE (xidim) - CASE (0_I4B) - DO ii = 1, n - ans(ii) = obj%pointTopology(ii) - END DO - CASE (1_I4B) - DO ii = 1, n - ans(ii) = obj%edgeTopology(ii) - END DO - CASE (2_I4B) - DO ii = 1, n - ans(ii) = obj%faceTopology(ii) - END DO - CASE (3_I4B) - DO ii = 1, n - ans(ii) = obj%cellTopology(ii) - END DO - END SELECT + + IF (xidim .EQ. 0) THEN + jj = 0 + ELSE + jj = SUM(obj%refelem%entityCounts(1:xidim)) + END IF + + DO ii = 1, n + ans(ii) = obj%refelem%topology(jj + ii) + END DO + ELSE - n = SUM(obj%entityCounts) + n = SUM(obj%refelem%entityCounts) ALLOCATE (ans(n)) - !! - !! points - !! - DO ii = 1, obj%entityCounts(1) - ans(ii) = obj%pointTopology(ii) - END DO - !! - !! edge - !! - DO ii = 1, obj%entityCounts(2) - ans(obj%entityCounts(1) + ii) = obj%edgeTopology(ii) - END DO - !! - !! face - !! - DO ii = 1, obj%entityCounts(3) - ans(obj%entityCounts(2) + ii) = obj%faceTopology(ii) - END DO - !! - !! cell - !! - DO ii = 1, obj%entityCounts(4) - ans(obj%entityCounts(3) + ii) = obj%cellTopology(ii) + DO ii = 1, n + ans(ii) = obj%refelem%topology(ii) END DO - !! END IF -!! END PROCEDURE refelem_GetTopology !---------------------------------------------------------------------------- @@ -108,56 +127,17 @@ MODULE PROCEDURE refelem_Copy INTEGER(I4B) :: ii, n - !! -CALL obj%Deallocate() - !! -IF (ALLOCATED(obj2%xij)) obj%xij = obj2%xij -obj%entityCounts = obj2%entityCounts -obj%xidimension = obj2%xidimension -obj%name = obj2%name +CALL obj%DEALLOCATE() +obj%refelem = obj2%refelem obj%nameStr = obj2%nameStr -obj%nsd = obj2%nsd -!! -!! point topology -!! -IF (ALLOCATED(obj2%pointTopology)) THEN - n = SIZE(obj2%pointTopology) - ALLOCATE (obj%pointTopology(n)) - DO ii = 1, n - obj%pointTopology(ii) = obj2%pointTopology(ii) - END DO -END IF -!! -!! edge topology -!! -IF (ALLOCATED(obj2%edgeTopology)) THEN - n = SIZE(obj2%edgeTopology) - ALLOCATE (obj%edgeTopology(n)) - DO ii = 1, n - obj%edgeTopology(ii) = obj2%edgeTopology(ii) - END DO -END IF -!! -!! face topology -!! -IF (ALLOCATED(obj2%faceTopology)) THEN - n = SIZE(obj2%faceTopology) - ALLOCATE (obj%faceTopology(n)) - DO ii = 1, n - obj%faceTopology(ii) = obj2%faceTopology(ii) - END DO +!! baseInterpolation +IF (ALLOCATED(obj2%baseInterpolation)) THEN + ALLOCATE (obj%baseInterpolation, source=obj2%baseInterpolation) END IF -!! -!! cell topology -!! -IF (ALLOCATED(obj2%cellTopology)) THEN - n = SIZE(obj2%cellTopology) - ALLOCATE (obj%cellTopology(n)) - DO ii = 1, n - obj%cellTopology(ii) = obj2%cellTopology(ii) - END DO +!! baseContinuity +IF (ALLOCATED(obj2%baseContinuity)) THEN + ALLOCATE (obj%baseContinuity, source=obj2%baseContinuity) END IF -!! END PROCEDURE refelem_Copy !---------------------------------------------------------------------------- @@ -166,52 +146,10 @@ MODULE PROCEDURE refelem_Deallocate INTEGER(I4B) :: ii, n -IF (ALLOCATED(obj%xij)) DEALLOCATE (obj%xij) -obj%entityCounts = 0 -obj%xidimension = -1 -obj%name = -1 +CALL DEALLOCATE (obj%refelem) obj%nameStr = "" -obj%nsd = -1 -!! -!! point topology -!! -IF (ALLOCATED(obj%pointTopology)) THEN - n = SIZE(obj%pointTopology) - DO ii = 1, n - CALL obj%pointTopology(ii)%Deallocate() - END DO - DEALLOCATE (obj%pointTopology) -END IF -!! -!! edge topology -!! -IF (ALLOCATED(obj%edgeTopology)) THEN - n = SIZE(obj%edgeTopology) - DO ii = 1, n - CALL obj%edgeTopology(ii)%Deallocate() - END DO - DEALLOCATE (obj%edgeTopology) -END IF -!! -!! face topology -!! -IF (ALLOCATED(obj%faceTopology)) THEN - n = SIZE(obj%faceTopology) - DO ii = 1, n - CALL obj%faceTopology(ii)%Deallocate() - END DO - DEALLOCATE (obj%faceTopology) -END IF -!! -!! cell topology -!! -IF (ALLOCATED(obj%cellTopology)) THEN - n = SIZE(obj%cellTopology) - DO ii = 1, n - CALL obj%cellTopology(ii)%Deallocate() - END DO - DEALLOCATE (obj%cellTopology) -END IF +IF (ALLOCATED(obj%baseContinuity)) DEALLOCATE (obj%baseContinuity) +IF (ALLOCATED(obj%baseInterpolation)) DEALLOCATE (obj%baseInterpolation) END PROCEDURE refelem_Deallocate !---------------------------------------------------------------------------- @@ -222,84 +160,171 @@ !! Define internal variable INTEGER(I4B) :: j LOGICAL(LGT) :: notFull0 -!! + notFull0 = INPUT(option=notFull, default=.FALSE.) -!! CALL Display(msg, unitno=unitno) -!! -CALL Display("element type : "//trim(ElementName(obj%name)), & - & unitno=unitno) -!! -CALL Display(obj%xidimension, "xidimension :: ", & - & unitno=unitno) -!! -CALL Display(obj%nsd, "nsd : ", unitno=unitno) -!! -IF (notFull0) RETURN -!! -CALL Display(obj%entityCounts(1), "entityCounts(0) : ", & - & unitno=unitno) -!! -CALL Display(obj%entityCounts(2), "entityCounts(1) : ", & - & unitno=unitno) -!! -CALL Display(obj%entityCounts(3), "entityCounts(2) : ", & - & unitno=unitno) -!! -CALL Display(obj%entityCounts(4), "entityCounts(3) : ", & +CALL Display(obj%refelem, "refelem: ", unitno=unitno) +!! baseContinuity +IF (ALLOCATED(obj%baseContinuity)) THEN + CALL Display( & + & "baseContinuity: "//BaseContinuity_toString(obj%baseContinuity), & & unitno=unitno) -!! -DO j = 1, SIZE(obj%xiJ, 2) +ELSE + CALL Display("baseContinuity: NOT ALLOCATED") +END IF +!! baseInterpolation +IF (ALLOCATED(obj%baseInterpolation)) THEN CALL Display( & - & obj%xiJ(:, j), & - & "Node( "//tostring(j)//" ) : ", & - & unitno=unitno) -END DO -!! -!! pointTopology -!! -DO j = 1, obj%entityCounts(1) - CALL obj%pointTopology(j)%Display( & - & "pointTopology( "//tostring(j)//" ) : ", & - & unitno=unitno) -END DO -!! -!! edgeTopology -!! -DO j = 1, obj%entityCounts(2) - CALL obj%edgeTopology(j)%Display( & - & "edgeTopology( "//tostring(j)//" ) : ", & - & unitno=unitno) -END DO -!! -!! faceTopology -!! -DO j = 1, obj%entityCounts(3) - CALL obj%faceTopology(j)%Display( & - & "faceTopology( "//tostring(j)//" ) : ", & - & unitno=unitno) -END DO -!! -!! cellTopology -!! -DO j = 1, obj%entityCounts(4) - CALL obj%cellTopology(j)%Display( & - & "cellTopology( "//tostring(j)//" ) : ", & - & unitno=unitno) -END DO - !! + & "baseInterpolation: "//BaseInterpolation_toString(obj%baseInterpolation), & + & unitno=unitno) +ELSE + CALL Display("baseInterpolation: NOT ALLOCATED") +END IF END PROCEDURE refelem_Display !---------------------------------------------------------------------------- -! GetNNE +! MdEncode !---------------------------------------------------------------------------- -MODULE PROCEDURE refelem_GetNNE -IF (ALLOCATED(obj%xij)) THEN - ans = SIZE(obj%xij, 2) +MODULE PROCEDURE refelem_MdEncode +TYPE(String) :: astr(2) +TYPE(String) :: rowTitle(2), colTitle(1) +colTitle(1) = "" + +rowTitle(1) = "BaseContinuity" +!! baseContinuity +IF (ALLOCATED(obj%baseContinuity)) THEN + astr(1) = BaseContinuity_toString(obj%baseContinuity) ELSE - ans = 0 + astr(1) = "NOT ALLOCATED" END IF + +rowTitle(2) = "BaseInterpolation" +!! baseContinuity +IF (ALLOCATED(obj%baseInterpolation)) THEN + astr(2) = BaseInterpolation_toString(obj%baseInterpolation) +ELSE + astr(2) = "NOT ALLOCATED" +END IF + +ans = MdEncode(obj%refelem) & + & //MdEncode(val=astr(1:2), rh=rowTitle(1:2), ch=colTitle) +END PROCEDURE refelem_MdEncode + +!---------------------------------------------------------------------------- +! ReactEncode@Methods +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_ReactEncode +! !! Define internal variable +! INTEGER(I4B) :: j, tsize +! LOGICAL(LGT) :: notFull0 +! TYPE(String) :: rowTitle(20), colTitle(1) +! TYPE(String) :: astr(20) +! CHARACTER(1), PARAMETER, DIMENSION(3) :: xyz = ["x", "y", "z"] +! +! colTitle(1) = "" +! rowTitle(1) = "Element type"; astr(1) = ElementName(obj%name) +! rowTitle(2) = "Xidimension"; astr(2) = tostring(obj%xiDimension) +! rowTitle(3) = "NSD"; astr(3) = tostring(obj%nsd) +! rowTitle(4) = "tPoints"; astr(4) = tostring(obj%entityCounts(1)) +! rowTitle(5) = "tLines"; astr(5) = tostring(obj%entityCounts(2)) +! rowTitle(6) = "tSurfaces"; astr(6) = tostring(obj%entityCounts(3)) +! rowTitle(7) = "tVolumes"; astr(7) = tostring(obj%entityCounts(4)) +! +! rowTitle(8) = "BaseContinuity" +! !! baseContinuity +! IF (ALLOCATED(obj%baseContinuity)) THEN +! astr(8) = BaseContinuity_toString(obj%baseContinuity) +! ELSE +! astr(8) = "NOT ALLOCATED" +! END IF +! +! rowTitle(9) = "BaseInterpolation" +! !! baseContinuity +! IF (ALLOCATED(obj%baseInterpolation)) THEN +! astr(9) = BaseInterpolation_toString(obj%baseInterpolation) +! ELSE +! astr(9) = "NOT ALLOCATED" +! END IF +! +! tsize = SIZE(obj%xij, 1) +! DO j = 1, tsize +! rowTitle(9 + j) = xyz(j) +! END DO +! +! ans = MdEncode(val=astr(1:9), rh=rowTitle(1:9), ch=colTitle)// & +! & char_lf//"Nodal Coordinates:"//char_lf//char_lf// & +! & MdEncode(obj%xij, rh=rowTitle(10:9 + tsize), ch=colTitle) +! +! IF (obj%entityCounts(1) .GT. 0_I4B) THEN +! ans = ans//React_StartTabs()//char_lf +! +! !! pointTopology +! DO j = 1, obj%entityCounts(1) +! ans = ans//React_StartTabItem( & +! & VALUE=tostring(j), & +! & label="PointTopology( "//tostring(j)//" ) : ")//char_lf// & +! & obj%pointTopology(j)%MdEncode()//char_lf & +! & //React_EndTabItem()//char_lf +! END DO +! +! ans = ans//React_EndTabs()//char_lf +! END IF +! +! IF (obj%entityCounts(2) .GT. 0_I4B) THEN +! ans = ans//React_StartTabs()//char_lf +! +! !! pointTopology +! DO j = 1, obj%entityCounts(2) +! ans = ans//React_StartTabItem( & +! & VALUE=tostring(j), & +! & label="EdgeTopology( "//tostring(j)//" ) : ")//char_lf// & +! & obj%EdgeTopology(j)%MdEncode()//char_lf & +! & //React_EndTabItem()//char_lf +! END DO +! +! ans = ans//React_EndTabs()//char_lf +! END IF +! +! IF (obj%entityCounts(3) .GT. 0_I4B) THEN +! ans = ans//React_StartTabs()//char_lf +! +! !! pointTopology +! DO j = 1, obj%entityCounts(3) +! ans = ans//React_StartTabItem( & +! & VALUE=tostring(j), & +! & label="FaceTopology( "//tostring(j)//" ) : ")//char_lf// & +! & obj%FaceTopology(j)%MdEncode()//char_lf & +! & //React_EndTabItem()//char_lf +! END DO +! +! ans = ans//React_EndTabs()//char_lf +! END IF +! +! IF (obj%entityCounts(4) .GT. 0_I4B) THEN +! ans = ans//React_StartTabs()//char_lf +! +! !! pointTopology +! DO j = 1, obj%entityCounts(4) +! ans = ans//React_StartTabItem( & +! & VALUE=tostring(j), & +! & label="CellTopology( "//tostring(j)//" ) : ")//char_lf// & +! & obj%CellTopology(j)%MdEncode()//char_lf & +! & //React_EndTabItem()//char_lf +! END DO +! +! ans = ans//React_EndTabs()//char_lf +! END IF + +END PROCEDURE refelem_ReactEncode + +!---------------------------------------------------------------------------- +! GetNNE +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_GetNNE +ans = .NNE.obj%refelem END PROCEDURE refelem_GetNNE !---------------------------------------------------------------------------- @@ -307,7 +332,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetNSD -ans = obj%NSD +ans = obj%refelem%NSD END PROCEDURE refelem_GetNSD !---------------------------------------------------------------------------- @@ -315,7 +340,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetXidimension -ans = obj%xidimension +ans = obj%refelem%xidimension END PROCEDURE refelem_GetXidimension !---------------------------------------------------------------------------- @@ -323,7 +348,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetElementTopology -ans = ElementTopology(obj%name) +ans = ElementTopology(obj%refelem%name) END PROCEDURE refelem_GetElementTopology !---------------------------------------------------------------------------- @@ -331,16 +356,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetNptrs -SELECT CASE (obj%xidimension) -CASE (0_I4B) - ans = obj%pointTopology(1)%GetNptrs() -CASE (1_I4B) - ans = obj%edgeTopology(1)%GetNptrs() -CASE (2_I4B) - ans = obj%faceTopology(1)%GetNptrs() -CASE (3_I4B) - ans = obj%cellTopology(1)%GetNptrs() -END SELECT +ans = GetConnectivity(obj%refelem) END PROCEDURE refelem_GetNptrs !---------------------------------------------------------------------------- @@ -348,33 +364,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetFacetMatrix -!! -INTEGER(I4B) :: xicell, i, max_nns, nns, tFacet -TYPE(Topology_), ALLOCATABLE :: faceTopology(:) -!! -!! main -!! -xicell = obj%xidimension -faceTopology = obj%GetTopology(xidim=xicell) -tFacet = obj%entityCounts(xicell) -max_nns = 0 -!! -DO i = 1, tFacet - nns = obj%faceTopology(i)%GetNNE() - IF (max_nns .LT. nns) max_nns = nns -END DO -!! -ALLOCATE (ans(tFacet, max_nns + 3)) -ans = 0 -!! -DO i = 1, tFacet - ans(i, 1) = faceTopology(i)%GetName() - ans(i, 2) = faceTopology(i)%GetXiDimension() - nns = faceTopology(i)%GetNNE() - ans(i, 3) = nns - ans(i, 4:(3 + nns)) = faceTopology(i)%GetNptrs() -END DO -!! +ans = FacetMatrix(obj%refelem) END PROCEDURE refelem_GetFacetMatrix !---------------------------------------------------------------------------- @@ -382,11 +372,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetNodeCoord -IF (ALLOCATED(obj%xij)) THEN - ans = obj%xij -ELSE - ALLOCATE (ans(0, 0)) -END IF +ans = LocalNodeCoord(obj%refelem) END PROCEDURE refelem_GetNodeCoord !---------------------------------------------------------------------------- @@ -394,7 +380,16 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetInterpolationPoint -ans = InterpolationPoint(order=order, ipType=ipType, elemType=obj%name, layout=layout) +IF (isPoint(obj%refelem%name)) THEN + CALL Reallocate(ans, 3_I4B, 1_I4B) +ELSE + ans = InterpolationPoint( & + & order=order, & + & ipType=ipType, & + & elemType=obj%refelem%name, & + & layout=layout, & + & xij=obj%refelem%xij) +END IF END PROCEDURE refelem_GetInterpolationPoint !---------------------------------------------------------------------------- @@ -403,52 +398,94 @@ MODULE PROCEDURE refelem_SetParam INTEGER(I4B) :: ii, n -!! -IF (PRESENT(xij)) obj%xij = xij -IF (PRESENT(entityCounts)) obj%entityCounts = entityCounts -IF (PRESENT(xidimension)) obj%xidimension = xidimension -IF (PRESENT(name)) obj%name = name + +IF (PRESENT(xij)) obj%refelem%xij = xij +IF (PRESENT(entityCounts)) obj%refelem%entityCounts = entityCounts +IF (PRESENT(xidimension)) obj%refelem%xidimension = xidimension +IF (PRESENT(name)) obj%refelem%name = name IF (PRESENT(nameStr)) obj%nameStr = nameStr -IF (PRESENT(nsd)) obj%nsd = nsd -!! -IF (PRESENT(pointTopology)) THEN - IF (ALLOCATED(obj%pointTopology)) DEALLOCATE (obj%pointTopology) - n = SIZE(pointTopology) - ALLOCATE (obj%pointTopology(n)) +IF (PRESENT(nsd)) obj%refelem%nsd = nsd + +IF (PRESENT(topology)) THEN + IF (ALLOCATED(obj%refelem%topology)) DEALLOCATE (obj%refelem%topology) + n = SIZE(topology) + ALLOCATE (obj%refelem%topology(n)) DO ii = 1, n - obj%pointTopology(ii) = pointTopology(ii) + obj%refelem%topology(ii) = topology(ii) END DO END IF -!! -IF (PRESENT(edgeTopology)) THEN - IF (ALLOCATED(obj%edgeTopology)) DEALLOCATE (obj%edgeTopology) - n = SIZE(edgeTopology) - ALLOCATE (obj%edgeTopology(n)) - DO ii = 1, n - obj%edgeTopology(ii) = edgeTopology(ii) - END DO + +IF (PRESENT(baseContinuity)) THEN + CALL BaseContinuity_fromString(obj=obj%baseContinuity, name=baseContinuity) END IF -!! -IF (PRESENT(faceTopology)) THEN - IF (ALLOCATED(obj%faceTopology)) DEALLOCATE (obj%faceTopology) - n = SIZE(faceTopology) - ALLOCATE (obj%faceTopology(n)) - DO ii = 1, n - obj%faceTopology(ii) = faceTopology(ii) - END DO + +IF (PRESENT(baseInterpolation)) THEN + CALL BaseInterpolation_fromString( & + & obj=obj%baseInterpolation, & + & name=baseInterpolation) END IF -!! -IF (PRESENT(cellTopology)) THEN - IF (ALLOCATED(obj%cellTopology)) DEALLOCATE (obj%cellTopology) - n = SIZE(cellTopology) - ALLOCATE (obj%cellTopology(n)) - DO ii = 1, n - obj%cellTopology(ii) = cellTopology(ii) - END DO + +IF (PRESENT(refelem)) THEN + obj%refelem = refelem END IF -!! + END PROCEDURE refelem_SetParam +!---------------------------------------------------------------------------- +! GetParam +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_GetParam +INTEGER(I4B) :: ii, n +CHARACTER(*), PARAMETER :: myName = "refelem_GetParam" + +IF (PRESENT(entityCounts)) entityCounts = obj%refelem%entityCounts +IF (PRESENT(xidimension)) xidimension = obj%refelem%xidimension +IF (PRESENT(name)) name = obj%refelem%name +IF (PRESENT(nameStr)) nameStr = obj%nameStr +IF (PRESENT(nsd)) nsd = obj%refelem%nsd + +IF (PRESENT(xij)) THEN + IF (ALLOCATED(obj%refelem%xij)) THEN + xij = obj%refelem%xij + END IF +END IF + +IF (PRESENT(topology)) THEN + IF (ALLOCATED(obj%refelem%topology)) THEN + IF (ALLOCATED(topology)) DEALLOCATE (topology) + n = SIZE(obj%refelem%topology) + ALLOCATE (topology(n)) + DO ii = 1, n + topology(ii) = obj%refelem%topology(ii) + END DO + END IF +END IF + +IF (PRESENT(baseInterpolation)) THEN + IF (ALLOCATED(obj%baseInterpolation)) THEN + baseInterpolation = BaseInterpolation_toString(obj%baseInterpolation) + ELSE + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'AbstractRefElement_::obj%baseInterpolation is not allocated.') + END IF +END IF + +IF (PRESENT(baseContinuity)) THEN + IF (ALLOCATED(obj%baseContinuity)) THEN + baseContinuity = baseContinuity_toString(obj%baseContinuity) + ELSE + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'AbstractRefElement_::obj%baseContinuity is not allocated.') + END IF +END IF + +IF (PRESENT(refelem)) THEN + refelem = obj%refelem +END IF + +END PROCEDURE refelem_GetParam + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/RefElement/src/RefHexahedron_Class@Methods.F90 b/src/submodules/RefElement/src/RefHexahedron_Class@Methods.F90 index 0da637684..f01a7d62b 100644 --- a/src/submodules/RefElement/src/RefHexahedron_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefHexahedron_Class@Methods.F90 @@ -20,6 +20,18 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) +ans = RefCoord_Hexahedron("BIUNIT") +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -33,92 +45,34 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetFacetElements -INTEGER(I4B), PARAMETER :: n = 6_I4B +INTEGER(I4B), PARAMETER :: tface = 6_I4B INTEGER(I4B) :: ii -!! -ALLOCATE (ans(n)) -!! -DO ii = 1, n - ALLOCATE (RefQuadrangle_ :: ans(ii)%ptr) - CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) -END DO -!! -END PROCEDURE refelem_GetFacetElements +TYPE(string) :: baseContinuity0, baseInterpolation0 +INTEGER(I4B) :: faceCon(4, tface) +REAL(DFP), ALLOCATABLE :: xij(:, :) -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- +CALL obj%getParam( & + & baseInterpolation=baseInterpolation0, & + & baseContinuity=baseContinuity0, & + & xij=xij) -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 8_I4B -INTEGER(I4B), PARAMETER :: ne = 12_I4B -INTEGER(I4B), PARAMETER :: nf = 6_I4B -INTEGER(I4B), PARAMETER :: nc = 1_I4B -INTEGER(I4B), PARAMETER :: nptrs(8) = [1, 2, 3, 4, 5, 6, 7, 8] -INTEGER(I4B) :: edges(2, ne) -INTEGER(I4B) :: faces(4, nf) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -ALLOCATE (obj%cellTopology(nc)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! edges -!! -edges(:, 1) = [1, 2] -edges(:, 2) = [1, 4] -edges(:, 3) = [1, 5] -edges(:, 4) = [2, 3] -edges(:, 5) = [2, 6] -edges(:, 6) = [3, 4] -edges(:, 7) = [3, 7] -edges(:, 8) = [4, 8] -edges(:, 9) = [5, 6] -edges(:, 10) = [5, 8] -edges(:, 11) = [6, 7] -edges(:, 12) = [8, 7] -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) -END DO -!! -!! faces -!! -faces(:, 1) = [1, 2, 6, 5] -faces(:, 2) = [5, 6, 7, 8] -faces(:, 3) = [1, 5, 8, 4] -faces(:, 4) = [2, 3, 7, 6] -faces(:, 5) = [1, 4, 3, 2] -faces(:, 6) = [3, 4, 8, 7] -!! -DO ii = 1, nf - CALL obj%faceTopology(ii)%Initiate( & - & nptrs=faces(:, ii), & - & name=Quadrangle4, & - & xidimension=2_I4B) +faceCon = FacetConnectivity_Hexahedron( & + & baseInterpolation0%chars(), & + & baseContinuity0%chars()) + +ALLOCATE (ans(tface)) + +DO ii = 1, tface + ALLOCATE (RefQuadrangle_ :: ans(ii)%ptr) + CALL ans(ii)%ptr%Initiate( & + & nsd=obj%getNSD(), & + & baseContinuity=baseContinuity0%chars(), & + & baseInterpolation=baseInterpolation0%chars(), & + & xij=xij(:, faceCon(:, ii)) & + & ) END DO -!! -!! cell -!! -CALL obj%cellTopology(1)%Initiate( & - & nptrs=nptrs, & - & name=Hexahedron8, & - & xidimension=3_I4B) -!! -END PROCEDURE refelem_GenerateTopology + +END PROCEDURE refelem_GetFacetElements !---------------------------------------------------------------------------- ! diff --git a/src/submodules/RefElement/src/RefLine_Class@Methods.F90 b/src/submodules/RefElement/src/RefLine_Class@Methods.F90 index 107e4592a..339fe03fb 100644 --- a/src/submodules/RefElement/src/RefLine_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefLine_Class@Methods.F90 @@ -20,6 +20,14 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +ans = RefCoord_Line("BIUNIT") +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -35,40 +43,23 @@ MODULE PROCEDURE refelem_GetFacetElements INTEGER(I4B), PARAMETER :: tFacet = 2_I4B INTEGER(I4B) :: ii -!! +TYPE(string) :: baseContinuity0, baseInterpolation0 +REAL(DFP), ALLOCATABLE :: xij(:, :) ALLOCATE (ans(tFacet)) -!! +CALL obj%getParam( & +& baseInterpolation=baseInterpolation0, & +& baseContinuity=baseContinuity0, & +& xij=xij) DO ii = 1, tFacet ALLOCATE (RefPoint_ :: ans(ii)%ptr) - CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) + CALL ans(ii)%ptr%Initiate( & + & nsd=obj%getNSD(), & + & baseContinuity=baseContinuity0%chars(), & + & baseInterpolation=baseInterpolation0%chars(), & + & xij=xij(:, ii:ii)) END DO -!! END PROCEDURE refelem_GetFacetElements -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- - -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 2_I4B, ne = 1_I4B -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -!! -CALL obj%pointTopology(1)%Initiate(& - & nptrs=[1_I4B], & - & name=Point, & - & xidimension=0_I4B) -CALL obj%pointTopology(2)%Initiate( & - & nptrs=[2_I4B], & - & name=Point, & - & xidimension=0_I4B) -!! -CALL obj%edgeTopology(1)%Initiate(nptrs=[1_I4B, 2_I4B], & - & name=Line2, xidimension=1_I4B) -!! -END PROCEDURE refelem_GenerateTopology - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/RefElement/src/RefPoint_Class@Methods.F90 b/src/submodules/RefElement/src/RefPoint_Class@Methods.F90 index 30334ff2f..e0c968c13 100644 --- a/src/submodules/RefElement/src/RefPoint_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefPoint_Class@Methods.F90 @@ -19,6 +19,15 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +CALL Reallocate(ans, 3_I4B, 1_I4B) +ans = 0.0_DFP +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -35,18 +44,6 @@ ALLOCATE (ans(0)) END PROCEDURE refelem_GetFacetElements -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- - -MODULE PROCEDURE refelem_GenerateTopology -ALLOCATE (obj%pointTopology(1)) -CALL obj%pointTopology(1)%Initiate( & - & nptrs=[1_I4B], & - & name=Point1, & - & xidimension=0_I4B) -END PROCEDURE refelem_GenerateTopology - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/RefElement/src/RefPrism_Class@Methods.F90 b/src/submodules/RefElement/src/RefPrism_Class@Methods.F90 index 7a22feec5..abfe2cf18 100644 --- a/src/submodules/RefElement/src/RefPrism_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefPrism_Class@Methods.F90 @@ -20,6 +20,60 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" + +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) + +SELECT CASE (baseContinuity0%chars()) +CASE ("H1") + SELECT CASE (baseInterpolation0%chars()) + CASE ( & + & "LAGRANGEPOLYNOMIAL", & + & "LAGRANGE", & + & "LAGRANGEINTERPOLATION", & + & "SERENDIPITYPOLYNOMIAL", & + & "SERENDIPITY", & + & "SERENDIPITYINTERPOLATION") + + ans = RefCoord_Prism("UNIT") + + CASE ("HERMITPOLYNOMIAL", "HERMIT", "HERMITINTERPOLATION") + + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NOT IMPLEMETED! WIP! baseInterpolation='//baseInterpolation0) + + CASE ( & + & "HIERARCHICALPOLYNOMIAL", & + & "HIERARCHY", & + & "HEIRARCHICALPOLYNOMIAL", & + & "HEIRARCHY", & + & "HIERARCHYINTERPOLATION", & + & "HEIRARCHYINTERPOLATION", & + & "ORTHOGONALPOLYNOMIAL", & + & "ORTHOGONAL", & + & "ORTHOGONALINTERPOLATION") + + ans = RefCoord_Prism("BIUNIT") + + CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NO CASE FOUND! for baseContinuity='//baseContinuity0) + END SELECT + +CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Currently, only baseContinuity=H1 allowed!') +END SELECT + +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -35,92 +89,20 @@ MODULE PROCEDURE refelem_GetFacetElements INTEGER(I4B), PARAMETER :: n = 5_I4B INTEGER(I4B) :: ii -!! + ALLOCATE (ans(n)) -!! + ALLOCATE (RefTriangle_ :: ans(1)%ptr) CALL ans(1)%ptr%Initiate(nsd=obj%getNSD()) ALLOCATE (RefTriangle_ :: ans(5)%ptr) CALL ans(5)%ptr%Initiate(nsd=obj%getNSD()) -!! + DO ii = 2, 4 ALLOCATE (RefQuadrangle_ :: ans(ii)%ptr) CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) END DO -!! END PROCEDURE refelem_GetFacetElements -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- - -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 6_I4B -INTEGER(I4B), PARAMETER :: ne = 9_I4B -INTEGER(I4B), PARAMETER :: nf = 5_I4B -INTEGER(I4B), PARAMETER :: nc = 1_I4B -INTEGER(I4B), PARAMETER :: nptrs(np) = [1, 2, 3, 4, 5, 6] -INTEGER(I4B) :: edges(2, ne) -INTEGER(I4B) :: faces(4, nf), faceHelp(2, nf) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -ALLOCATE (obj%cellTopology(nc)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! edges -!! -edges(:, 1) = [1, 2] -edges(:, 2) = [1, 3] -edges(:, 3) = [1, 4] -edges(:, 4) = [2, 3] -edges(:, 5) = [2, 5] -edges(:, 6) = [3, 6] -edges(:, 7) = [4, 5] -edges(:, 8) = [4, 6] -edges(:, 9) = [5, 6] -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) -END DO -!! -!! faces -!! -faces(:, 1) = [1, 3, 2, 0]; faceHelp(:, 1) = [3, Triangle3] -faces(:, 2) = [2, 3, 6, 5]; faceHelp(:, 2) = [4, Quadrangle4] -faces(:, 3) = [1, 2, 5, 4]; faceHelp(:, 3) = [4, Quadrangle4] -faces(:, 4) = [1, 4, 6, 3]; faceHelp(:, 4) = [4, Quadrangle4] -faces(:, 5) = [4, 5, 6, 0]; faceHelp(:, 5) = [3, Triangle3] -!! -DO ii = 1, nf - CALL obj%faceTopology(ii)%Initiate( & - & nptrs=faces(1:faceHelp(1, ii), ii), & - & name=faceHelp(2, ii), & - & xidimension=2_I4B) -END DO -!! -!! cell -!! -CALL obj%cellTopology(1)%Initiate( & - & nptrs=nptrs, & - & name=Prism6, & - & xidimension=3_I4B) -!! -END PROCEDURE refelem_GenerateTopology - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/RefElement/src/RefPyramid_Class@Methods.F90 b/src/submodules/RefElement/src/RefPyramid_Class@Methods.F90 index af1721b25..35f1073eb 100644 --- a/src/submodules/RefElement/src/RefPyramid_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefPyramid_Class@Methods.F90 @@ -20,6 +20,60 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" + +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) + +SELECT CASE (baseContinuity0%chars()) +CASE ("H1") + SELECT CASE (baseInterpolation0%chars()) + CASE ( & + & "LAGRANGEPOLYNOMIAL", & + & "LAGRANGE", & + & "LAGRANGEINTERPOLATION", & + & "SERENDIPITYPOLYNOMIAL", & + & "SERENDIPITY", & + & "SERENDIPITYINTERPOLATION") + + ans = RefCoord_Pyramid("UNIT") + + CASE ("HERMITPOLYNOMIAL", "HERMIT", "HERMITINTERPOLATION") + + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NOT IMPLEMETED! WIP! baseInterpolation='//baseInterpolation0) + + CASE ( & + & "HIERARCHICALPOLYNOMIAL", & + & "HIERARCHY", & + & "HEIRARCHICALPOLYNOMIAL", & + & "HEIRARCHY", & + & "HIERARCHYINTERPOLATION", & + & "HEIRARCHYINTERPOLATION", & + & "ORTHOGONALPOLYNOMIAL", & + & "ORTHOGONAL", & + & "ORTHOGONALINTERPOLATION") + + ans = RefCoord_Pyramid("BIUNIT") + + CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NO CASE FOUND! for baseContinuity='//baseContinuity0) + END SELECT + +CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Currently, only baseContinuity=H1 allowed!') +END SELECT + +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -35,89 +89,15 @@ MODULE PROCEDURE refelem_GetFacetElements INTEGER(I4B), PARAMETER :: n = 5_I4B INTEGER(I4B) :: ii -!! ALLOCATE (ans(n)) -!! ALLOCATE (RefQuadrangle_ :: ans(1)%ptr) CALL ans(1)%ptr%Initiate(nsd=obj%getNSD()) -!! DO ii = 2, 5 ALLOCATE (RefTriangle_ :: ans(ii)%ptr) CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) END DO -!! END PROCEDURE refelem_GetFacetElements -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- - -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 5_I4B -INTEGER(I4B), PARAMETER :: ne = 8_I4B -INTEGER(I4B), PARAMETER :: nf = 5_I4B -INTEGER(I4B), PARAMETER :: nc = 1_I4B -INTEGER(I4B), PARAMETER :: nptrs(np) = [1, 2, 3, 4, 5] -INTEGER(I4B) :: edges(2, ne) -INTEGER(I4B) :: faces(4, nf), faceHelp(2, nf) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -ALLOCATE (obj%cellTopology(nc)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! Lines = 8 -!! -edges(:, 1) = [1, 2] -edges(:, 2) = [1, 4] -edges(:, 3) = [1, 5] -edges(:, 4) = [2, 3] -edges(:, 5) = [2, 5] -edges(:, 6) = [3, 4] -edges(:, 7) = [3, 5] -edges(:, 8) = [4, 5] -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) -END DO -!! -!! face -!! -faces(:, 1) = [1, 4, 3, 2]; faceHelp(:, 1) = [4, Quadrangle4] -faces(:, 2) = [2, 3, 5, 0]; faceHelp(:, 2) = [3, Triangle3] -faces(:, 3) = [3, 4, 5, 0]; faceHelp(:, 3) = [3, Triangle3] -faces(:, 4) = [1, 5, 4, 0]; faceHelp(:, 4) = [3, Triangle3] -faces(:, 5) = [1, 2, 5, 0]; faceHelp(:, 5) = [3, Triangle3] -!! -DO ii = 1, nf - CALL obj%faceTopology(ii)%Initiate( & - & nptrs=faces(1:faceHelp(1, ii), ii), & - & name=faceHelp(2, ii), & - & xidimension=2_I4B) -END DO -!! -!! cell -!! -CALL obj%cellTopology(1)%Initiate( & - & nptrs=nptrs, & - & name=Pyramid5, & - & xidimension=3_I4B) -!! -END PROCEDURE refelem_GenerateTopology - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/RefElement/src/RefQuadrangle_Class@Methods.F90 b/src/submodules/RefElement/src/RefQuadrangle_Class@Methods.F90 index d484c2ff2..c191244d8 100644 --- a/src/submodules/RefElement/src/RefQuadrangle_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefQuadrangle_Class@Methods.F90 @@ -17,9 +17,22 @@ SUBMODULE(RefQuadrangle_Class) Methods USE BaseMethod USE RefElementFactory +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) +ans = RefCoord_Quadrangle("BIUNIT") +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -33,60 +46,35 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetFacetElements -INTEGER(I4B), PARAMETER :: n = 4_I4B +INTEGER(I4B), PARAMETER :: tface = 4_I4B INTEGER(I4B) :: ii -!! -ALLOCATE (ans(n)) -!! -DO ii = 1, n - ALLOCATE (RefLine_ :: ans(ii)%ptr) - CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) -END DO -!! -END PROCEDURE refelem_GetFacetElements +TYPE(string) :: baseContinuity0, baseInterpolation0 +INTEGER(I4B) :: faceCon(2, tface) +REAL(DFP), ALLOCATABLE :: xij(:, :) -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- +CALL obj%getParam( & + & baseInterpolation=baseInterpolation0, & + & baseContinuity=baseContinuity0, & + & xij=xij) -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 4_I4B -INTEGER(I4B), PARAMETER :: ne = 4_I4B -INTEGER(I4B), PARAMETER :: nf = 1_I4B -INTEGER(I4B), PARAMETER :: edges(2, ne) = & - & RESHAPE([1, 2, 2, 3, 3, 4, 4, 1], [2, ne]) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! edge -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) +faceCon = FacetConnectivity_Quadrangle( & + & baseInterpolation0%chars(), & + & baseContinuity0%chars()) + +ALLOCATE (ans(tface)) + +DO ii = 1, tface + ALLOCATE (RefLine_ :: ans(ii)%ptr) + CALL ans(ii)%ptr%Initiate( & + & nsd=obj%getNSD(), & + & baseContinuity=baseContinuity0%chars(), & + & baseInterpolation=baseInterpolation0%chars(), & + & xij=xij(:, faceCon(:, ii)) & + & ) END DO -!! -!! face -!! -CALL obj%faceTopology(1)%Initiate( & - & nptrs=[1_I4B, 2_I4B, 3_I4B, 4_I4B], & - & name=Quadrangle4, & - & xidimension=2_I4B) -!! -END PROCEDURE refelem_GenerateTopology + +IF (ALLOCATED(xij)) DEALLOCATE (xij) +END PROCEDURE refelem_GetFacetElements !---------------------------------------------------------------------------- ! diff --git a/src/submodules/RefElement/src/RefTetrahedron_Class@Methods.F90 b/src/submodules/RefElement/src/RefTetrahedron_Class@Methods.F90 index 135f994fd..a3f7dfac2 100644 --- a/src/submodules/RefElement/src/RefTetrahedron_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefTetrahedron_Class@Methods.F90 @@ -20,6 +20,60 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" + +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) + +SELECT CASE (baseContinuity0%chars()) +CASE ("H1") + SELECT CASE (baseInterpolation0%chars()) + CASE ( & + & "LAGRANGEPOLYNOMIAL", & + & "LAGRANGE", & + & "LAGRANGEINTERPOLATION", & + & "SERENDIPITYPOLYNOMIAL", & + & "SERENDIPITY", & + & "SERENDIPITYINTERPOLATION") + + ans = RefCoord_Tetrahedron("UNIT") + + CASE ("HERMITPOLYNOMIAL", "HERMIT", "HERMITINTERPOLATION") + + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NOT IMPLEMETED! WIP! baseInterpolation='//baseInterpolation0) + + CASE ( & + & "HIERARCHYPOLYNOMIAL", & + & "HEIRARCHYPOLYNOMIAL", & + & "HIERARCHY", & + & "HEIRARCHY", & + & "HIERARCHYINTERPOLATION", & + & "HEIRARCHYINTERPOLATION", & + & "ORTHOGONALPOLYNOMIAL", & + & "ORTHOGONAL", & + & "ORTHOGONALINTERPOLATION") + + ans = RefCoord_Tetrahedron("BIUNIT") + + CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NO CASE FOUND! for baseContinuity='//baseContinuity0) + END SELECT + +CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Currently, only baseContinuity=H1 allowed!') +END SELECT + +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -33,84 +87,34 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetFacetElements -INTEGER(I4B), PARAMETER :: n = 4_I4B +INTEGER(I4B), PARAMETER :: tface = 4_I4B INTEGER(I4B) :: ii -!! -ALLOCATE (ans(n)) -!! -DO ii = 1, n - ALLOCATE (RefTriangle_ :: ans(ii)%ptr) - CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) -END DO -!! -END PROCEDURE refelem_GetFacetElements +TYPE(string) :: baseContinuity0, baseInterpolation0 +INTEGER(I4B) :: faceCon(3, tface) +REAL(DFP), ALLOCATABLE :: xij(:, :) -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- +CALL obj%getParam( & + & baseInterpolation=baseInterpolation0, & + & baseContinuity=baseContinuity0, & + & xij=xij) -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 4_I4B -INTEGER(I4B), PARAMETER :: ne = 6_I4B -INTEGER(I4B), PARAMETER :: nf = 4_I4B -INTEGER(I4B), PARAMETER :: nc = 1_I4B -INTEGER(I4B), PARAMETER :: nptrs(4) = [1, 2, 3, 4] -INTEGER(I4B) :: edges(2, ne) -INTEGER(I4B) :: faces(3, nf) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -ALLOCATE (obj%cellTopology(nc)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! edges -!! -edges(:, 1) = [3, 4] -edges(:, 2) = [2, 4] -edges(:, 3) = [2, 3] -edges(:, 4) = [1, 4] -edges(:, 5) = [1, 3] -edges(:, 6) = [1, 2] -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) -END DO -!! -!! faces -!! -faces(:, 1) = [2, 3, 4] -faces(:, 2) = [1, 4, 3] -faces(:, 3) = [1, 2, 4] -faces(:, 4) = [1, 3, 2] -!! -DO ii = 1, nf - CALL obj%faceTopology(ii)%Initiate( & - & nptrs=faces(:, ii), & - & name=Triangle3, & - & xidimension=2_I4B) +faceCon = FacetConnectivity_Tetrahedron( & + & baseInterpolation0%chars(), & + & baseContinuity0%chars()) + +ALLOCATE (ans(tface)) +DO ii = 1, tface + ALLOCATE (RefTriangle_ :: ans(ii)%ptr) + CALL ans(ii)%ptr%Initiate( & + & nsd=obj%getNSD(), & + & baseContinuity=baseContinuity0%chars(), & + & baseInterpolation=baseInterpolation0%chars(), & + & xij=xij(:, faceCon(:, ii)) & + & ) END DO -!! -!! cell -!! -CALL obj%cellTopology(1)%Initiate( & - & nptrs=nptrs, & - & name=Tetrahedron4, & - & xidimension=3_I4B) -!! -END PROCEDURE refelem_GenerateTopology + +IF (ALLOCATED(xij)) DEALLOCATE (xij) +END PROCEDURE refelem_GetFacetElements !---------------------------------------------------------------------------- ! diff --git a/src/submodules/RefElement/src/RefTriangle_Class@Methods.F90 b/src/submodules/RefElement/src/RefTriangle_Class@Methods.F90 index bc04818ef..85658eac9 100644 --- a/src/submodules/RefElement/src/RefTriangle_Class@Methods.F90 +++ b/src/submodules/RefElement/src/RefTriangle_Class@Methods.F90 @@ -17,9 +17,64 @@ SUBMODULE(RefTriangle_Class) Methods USE BaseMethod USE RefElementFactory +USE ExceptionHandler_Class, ONLY: e IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! RefCoord +!---------------------------------------------------------------------------- + +MODULE PROCEDURE refelem_RefCoord +TYPE(String) :: baseContinuity0, baseInterpolation0 +CHARACTER(*), PARAMETER :: myName = "refelem_RefCoord" + +baseContinuity0 = UpperCase(baseContinuity) +baseInterpolation0 = UpperCase(baseInterpolation) + +SELECT CASE (baseContinuity0%chars()) +CASE ("H1") + SELECT CASE (baseInterpolation0%chars()) + CASE ( & + & "LAGRANGEPOLYNOMIAL", & + & "LAGRANGE", & + & "LAGRANGEINTERPOLATION", & + & "SERENDIPITYPOLYNOMIAL", & + & "SERENDIPITY", & + & "SERENDIPITYINTERPOLATION") + + ans = RefCoord_Triangle("UNIT") + + CASE ("HERMITPOLYNOMIAL", "HERMIT", "HERMITINTERPOLATION") + + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NOT IMPLEMETED! WIP! baseInterpolation='//baseInterpolation0) + + CASE ( & + & "HIERARCHYPOLYNOMIAL", & + & "HIERARCHY", & + & "HEIRARCHYPOLYNOMIAL", & + & "HEIRARCHY", & + & "HIERARCHYINTERPOLATION", & + & "HEIRARCHYINTERPOLATION", & + & "ORTHOGONALPOLYNOMIAL", & + & "ORTHOGONAL", & + & "ORTHOGONALINTERPOLATION") + + ans = RefCoord_Triangle("BIUNIT") + + CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'NO CASE FOUND! for baseContinuity='//baseContinuity0) + END SELECT + +CASE DEFAULT + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Currently, only baseContinuity=H1 allowed!') +END SELECT + +END PROCEDURE refelem_RefCoord + !---------------------------------------------------------------------------- ! GetName !---------------------------------------------------------------------------- @@ -33,59 +88,35 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE refelem_GetFacetElements -INTEGER(I4B), PARAMETER :: n = 3_I4B +INTEGER(I4B), PARAMETER :: tfacet = 3_I4B INTEGER(I4B) :: ii -!! -ALLOCATE (ans(n)) -!! -DO ii = 1, n - ALLOCATE (RefLine_ :: ans(ii)%ptr) - CALL ans(ii)%ptr%Initiate(nsd=obj%getNSD()) -END DO -!! -END PROCEDURE refelem_GetFacetElements +TYPE(string) :: baseContinuity0, baseInterpolation0 +REAL(DFP), ALLOCATABLE :: xij(:, :) +INTEGER(I4B) :: faceCon(2, 3) -!---------------------------------------------------------------------------- -! GenerateTopology -!---------------------------------------------------------------------------- +CALL obj%getParam( & + & baseInterpolation=baseInterpolation0, & + & baseContinuity=baseContinuity0, & + & xij=xij) -MODULE PROCEDURE refelem_GenerateTopology -INTEGER(I4B), PARAMETER :: np = 3_I4B -INTEGER(I4B), PARAMETER :: ne = 3_I4B -INTEGER(I4B), PARAMETER :: nf = 1_I4B -INTEGER(I4B), PARAMETER :: edges(2, ne) = RESHAPE([2, 3, 3, 1, 1, 2], [2, ne]) -INTEGER(I4B) :: ii -!! -ALLOCATE (obj%pointTopology(np)) -ALLOCATE (obj%edgeTopology(ne)) -ALLOCATE (obj%faceTopology(nf)) -!! -!! point -!! -DO ii = 1, np - CALL obj%pointTopology(ii)%Initiate( & - & nptrs=[ii], & - & name=Point, & - & xidimension=0_I4B) -END DO -!! -!! edge -!! -DO ii = 1, ne - CALL obj%edgeTopology(ii)%Initiate( & - & nptrs=edges(:, ii), & - & name=Line2, & - & xidimension=1_I4B) +faceCon = FacetConnectivity_Triangle( & + & baseInterpolation0%chars(), & + & baseContinuity0%chars()) + +ALLOCATE (ans(tfacet)) + +DO ii = 1, tfacet + ALLOCATE (RefLine_ :: ans(ii)%ptr) + CALL ans(ii)%ptr%Initiate( & + & nsd=obj%getNSD(), & + & baseContinuity=baseContinuity0%chars(), & + & baseInterpolation=baseInterpolation0%chars(), & + & xij=xij(:, faceCon(:, ii)) & + & ) END DO -!! -!! face -!! -CALL obj%faceTopology(1)%Initiate( & - & nptrs=[1_I4B, 2_I4B, 3_I4B], & - & name=Triangle3, & - & xidimension=2_I4B) - !! -END PROCEDURE refelem_GenerateTopology + +IF (ALLOCATED(xij)) DEALLOCATE (xij) +END PROCEDURE refelem_GetFacetElements !---------------------------------------------------------------------------- ! diff --git a/src/submodules/RefElement/src/Topology_Class@Methods.F90 b/src/submodules/RefElement/src/Topology_Class@Methods.F90 index e30e87073..ebcc023a8 100644 --- a/src/submodules/RefElement/src/Topology_Class@Methods.F90 +++ b/src/submodules/RefElement/src/Topology_Class@Methods.F90 @@ -53,6 +53,53 @@ CALL Display(obj%nptrs, "nptrs : ", unitno=unitno, orient="ROW") END PROCEDURE obj_Display +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_MdEncode +TYPE(String), ALLOCATABLE :: astr(:, :) +INTEGER(I4B) :: n, ii, jj +TYPE(String) :: rh(3), ch(1) + +rh(1) = "Element type" +rh(2) = "Xidimension" +rh(3) = "Nptrs" +ch(1) = "" + +IF (ALLOCATED(obj%nptrs)) THEN + n = SIZE(obj%nptrs) + CALL reallocate(astr, 3, n) + astr(1, 1) = ElementName(obj%name) + DO ii = 2, n + astr(1, ii) = "" + END DO + + astr(2, 1) = tostring(obj%xidimension) + DO ii = 2, n + astr(2, ii) = "" + END DO + + DO ii = 1, n + astr(3, ii) = tostring(obj%nptrs(ii)) + END DO + +ELSE + + n = 1 + CALL reallocate(astr, 3, n) + astr(1, 1) = ElementName(obj%name) + astr(2, 1) = tostring(obj%xidimension) + astr(3, 1) = "NOT ALLOCATED" + +END IF + +ans = MdEncode(val=astr, rh=rh, ch=ch) + +IF (ALLOCATED(astr)) DEALLOCATE (astr) + +END PROCEDURE obj_MdEncode + !---------------------------------------------------------------------------- ! Getnptrs !---------------------------------------------------------------------------- @@ -98,9 +145,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE obj_GetFacetTopology - !! SELECT CASE (elemType) - !! CASE (Line2) ALLOCATE (ans(2)) ans(1)%nptrs = nptrs(1:1) @@ -110,7 +155,6 @@ ans(2)%nptrs = nptrs(2:2) ans(2)%name = point ans(2)%xidimension = 0 - !! CASE (Triangle3) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2]) @@ -118,7 +162,6 @@ ans(3)%nptrs = nptrs([3, 1]) ans(1:3)%xidimension = 1 ans(1:3)%name = line2 - !! CASE (Quadrangle4) ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2]) @@ -127,7 +170,6 @@ ans(4)%nptrs = nptrs([4, 1]) ans(1:)%xidimension = 1 ans(1:)%name = line2 - !! CASE (Tetrahedron4) ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2, 3]) @@ -136,7 +178,6 @@ ans(4)%nptrs = nptrs([1, 2, 4]) ans(:)%xidimension = 2 ans(:)%name = Triangle3 - !! CASE (Hexahedron8) ALLOCATE (ans(6)) ans(1)%nptrs = nptrs([1, 4, 3, 2]) @@ -147,7 +188,6 @@ ans(6)%nptrs = nptrs([1, 2, 6, 5]) ans(:)%xidimension = 2 ans(:)%name = Quadrangle4 - !! CASE (Prism6) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([5, 4, 1, 2]) @@ -158,7 +198,6 @@ ans(:)%xidimension = 2 ans(1:3)%name = Quadrangle4 ans(4:5)%name = Triangle3 - !! CASE (Pyramid5) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([1, 2, 5]) @@ -169,7 +208,6 @@ ans(:)%xidimension = 2 ans(1:4)%name = Triangle3 ans(5)%name = Quadrangle4 - !! Order=2 elements CASE (Line3) ALLOCATE (ans(2)) ans(1)%nptrs = nptrs([1]) @@ -178,7 +216,6 @@ ans(2)%nptrs = nptrs([2]) ans(2)%name = point ans(2)%xidimension = 0 - !! CASE (Triangle6) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2, 4]) @@ -186,7 +223,6 @@ ans(3)%nptrs = nptrs([3, 1, 6]) ans(1:3)%xidimension = 1 ans(1:3)%name = line3 - !! CASE (Quadrangle9) ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2, 5]) @@ -195,7 +231,6 @@ ans(4)%nptrs = nptrs([4, 1, 8]) ans(1:)%xidimension = 1 ans(1:)%name = line3 - !! CASE (Quadrangle8) ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2, 5]) @@ -204,7 +239,6 @@ ans(4)%nptrs = nptrs([4, 1, 8]) ans(1:)%xidimension = 1 ans(1:)%name = line3 - !! CASE (Tetrahedron10) ALLOCATE (ans(4)) ans(1)%nptrs = nptrs([1, 2, 3, 5, 6, 7]) @@ -213,7 +247,6 @@ ans(4)%nptrs = nptrs([1, 2, 4, 5, 9, 8]) ans(:)%xidimension = 2 ans(:)%name = Triangle6 - !! CASE (Hexahedron20) ALLOCATE (ans(6)) ans(1)%nptrs = nptrs([1, 4, 3, 2, 10, 14, 12, 9]) @@ -224,7 +257,6 @@ ans(6)%nptrs = nptrs([1, 2, 6, 5, 9, 13, 17, 11]) ans(:)%xidimension = 2 ans(:)%name = Quadrangle8 - !! CASE (Hexahedron27) ALLOCATE (ans(6)) ans(1)%nptrs = nptrs([1, 4, 3, 2, 10, 14, 12, 9, 21]) @@ -235,7 +267,6 @@ ans(6)%nptrs = nptrs([1, 2, 6, 5, 9, 13, 17, 11, 22]) ans(:)%xidimension = 2 ans(:)%name = Quadrangle9 - !! CASE (Prism15) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([5, 4, 1, 2, 13, 9, 7, 11]) @@ -246,7 +277,6 @@ ans(:)%xidimension = 2 ans(1:3)%name = Quadrangle8 ans(4:5)%name = Triangle6 - !! CASE (Prism18) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([5, 4, 1, 2, 13, 9, 7, 11, 16]) @@ -257,7 +287,6 @@ ans(:)%xidimension = 2 ans(1:3)%name = Quadrangle9 ans(4:5)%name = Triangle6 - !! CASE (Pyramid13) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([1, 2, 5, 6, 10, 8]) @@ -268,7 +297,6 @@ ans(:)%xidimension = 2 ans(1:4)%name = Triangle6 ans(5)%name = Quadrangle8 - !! CASE (Pyramid14) ALLOCATE (ans(5)) ans(1)%nptrs = nptrs([1, 2, 5, 6, 10, 8]) @@ -279,7 +307,6 @@ ans(:)%xidimension = 2 ans(1:4)%name = Triangle6 ans(5)%name = Quadrangle9 - !! CASE (Triangle9) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2, 4, 5]) @@ -287,69 +314,54 @@ ans(3)%nptrs = nptrs([3, 1, 8, 9]) ans(1:3)%xidimension = 1 ans(1:3)%name = line4 - !! CASE (Triangle10) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2, 4, 5]) ans(2)%nptrs = nptrs([2, 3, 6, 7]) ans(3)%nptrs = nptrs([3, 1, 8, 9]) - ans(1:3)%xidimension = 1 ans(1:3)%name = line4 - CASE (Triangle12) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2, 4, 5, 6]) ans(2)%nptrs = nptrs([2, 3, 7, 8, 9]) ans(3)%nptrs = nptrs([3, 1, 10, 11, 12]) - ans(1:3)%xidimension = 1 ans(1:3)%name = line5 - CASE (Triangle15a) ALLOCATE (ans(3)) ans(1)%nptrs = nptrs([1, 2, 4, 5, 6]) ans(2)%nptrs = nptrs([2, 3, 7, 8, 9]) ans(3)%nptrs = nptrs([3, 1, 10, 11, 12]) - ans(1:3)%xidimension = 1 ans(1:3)%name = line5 - CASE (Line4) ALLOCATE (ans(2)) ans(1)%nptrs = nptrs([1]) ans(1)%name = point ans(1)%xidimension = 0 - ans(2)%nptrs = nptrs([2]) ans(2)%name = point ans(2)%xidimension = 0 - CASE (Line5) ALLOCATE (ans(2)) ans(1)%nptrs = nptrs([1]) ans(1)%name = point ans(1)%xidimension = 0 - ans(2)%nptrs = nptrs([2]) ans(2)%name = point ans(2)%xidimension = 0 - CASE (Line6) ALLOCATE (ans(2)) ans(1)%nptrs = nptrs([1]) ans(1)%name = point ans(1)%xidimension = 0 - ans(2)%nptrs = nptrs([2]) ans(2)%name = point ans(2)%xidimension = 0 - CASE (Triangle15b, Triangle21, Tetrahedron20, Tetrahedron35, & & Tetrahedron56, Hexahedron64, Hexahedron125) - !! END SELECT - !! END PROCEDURE obj_GetFacetTopology END SUBMODULE Methods diff --git a/src/submodules/STScalarField/src/STScalarField_Class@ConstructorMethods.F90 b/src/submodules/STScalarField/src/STScalarField_Class@ConstructorMethods.F90 index cb204a2af..dcd6a8c11 100644 --- a/src/submodules/STScalarField/src/STScalarField_Class@ConstructorMethods.F90 +++ b/src/submodules/STScalarField/src/STScalarField_Class@ConstructorMethods.F90 @@ -21,45 +21,45 @@ CONTAINS !---------------------------------------------------------------------------- -! setSTScalarFieldParam +! SetSTScalarFieldParam !---------------------------------------------------------------------------- -MODULE PROCEDURE setSTScalarFieldParam +MODULE PROCEDURE SetSTScalarFieldParam INTEGER(I4B) :: ierr -ierr = param%set(key=myprefix//"/name", VALUE=TRIM(name)) -ierr = param%set(key=myprefix//"/timeCompo", VALUE=timeCompo) -ierr = param%set(key=myprefix//"/engine", VALUE=TRIM(engine)) +ierr = param%Set(key=myprefix//"/name", VALUE=TRIM(name)) +ierr = param%Set(key=myprefix//"/timeCompo", VALUE=timeCompo) +ierr = param%Set(key=myprefix//"/engine", VALUE=TRIM(engine)) IF (PRESENT(fieldType)) THEN - ierr = param%set(key=myprefix//"/fieldType", VALUE=fieldType) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=fieldType) ELSE - ierr = param%set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) END IF IF (PRESENT(comm)) THEN - ierr = param%set(key=myprefix//"/comm", VALUE=comm) + ierr = param%Set(key=myprefix//"/comm", VALUE=comm) ELSE - ierr = param%set(key=myprefix//"/comm", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/comm", VALUE=0_I4B) END IF IF (PRESENT(local_n)) THEN - ierr = param%set(key=myprefix//"/local_n", VALUE=local_n) + ierr = param%Set(key=myprefix//"/local_n", VALUE=local_n) ELSE - ierr = param%set(key=myprefix//"/local_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/local_n", VALUE=0_I4B) END IF IF (PRESENT(global_n)) THEN - ierr = param%set(key=myprefix//"/global_n", VALUE=global_n) + ierr = param%Set(key=myprefix//"/global_n", VALUE=global_n) ELSE - ierr = param%set(key=myprefix//"/global_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/global_n", VALUE=0_I4B) END IF -END PROCEDURE setSTScalarFieldParam +END PROCEDURE SetSTScalarFieldParam !---------------------------------------------------------------------------- ! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE stsField_checkEssentialParam -CHARACTER(*), PARAMETER :: myName = "stsField_checkEssentialParam" +MODULE PROCEDURE stsField_CheckEssentialParam +CHARACTER(*), PARAMETER :: myName = "stsField_CheckEssentialParam" IF (.NOT. param%isPresent(key=myprefix//"/name")) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & myprefix//'/name should be present in param') @@ -84,7 +84,7 @@ CALL e%raiseError(modName//'::'//myName//" - "// & & 'local_n should be present in param') END IF -END PROCEDURE stsField_checkEssentialParam +END PROCEDURE stsField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -103,37 +103,37 @@ & 'STScalarField_::obj is already initiated') END IF -CALL obj%checkEssentialParam(param) +CALL obj%CheckEssentialParam(param) ! engine ALLOCATE (CHARACTER( & & param%DataSizeInBytes(key=myprefix//"/engine")) :: char_var) -ierr = param%get(key=myprefix//"/engine", VALUE=char_var) +ierr = param%Get(key=myprefix//"/engine", VALUE=char_var) obj%engine = char_var DEALLOCATE (char_var) ! name ALLOCATE (CHARACTER( & & param%DataSizeInBytes(key=myprefix//"/name")) :: char_var) -ierr = param%get(key=myprefix//"/name", VALUE=char_var) +ierr = param%Get(key=myprefix//"/name", VALUE=char_var) obj%name = char_var names_char(1) (1:1) = char_var(1:1) DEALLOCATE (char_var) ! fieldType IF (param%isPresent(key=myprefix//"/fieldType")) THEN - ierr = param%get(key=myprefix//"/fieldType", VALUE=obj%fieldType) + ierr = param%Get(key=myprefix//"/fieldType", VALUE=obj%fieldType) ELSE obj%fieldType = FIELD_TYPE_NORMAL END IF ! comm -ierr = param%get(key=myprefix//"/comm", VALUE=obj%comm) -ierr = param%get(key=myprefix//"/global_n", VALUE=obj%global_n) -ierr = param%get(key=myprefix//"/local_n", VALUE=obj%local_n) +ierr = param%Get(key=myprefix//"/comm", VALUE=obj%comm) +ierr = param%Get(key=myprefix//"/global_n", VALUE=obj%global_n) +ierr = param%Get(key=myprefix//"/local_n", VALUE=obj%local_n) ! timeCompo -ierr = param%get(key=myprefix//"/timeCompo", VALUE=obj%timeCompo) +ierr = param%Get(key=myprefix//"/timeCompo", VALUE=obj%timeCompo) timeCompo = obj%timeCompo spaceCompo = 1 @@ -141,7 +141,7 @@ obj%domain => dom IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN tNodes = 1 - obj%tSize = obj%domain%getTotalNodes() * obj%timeCompo + obj%tSize = obj%domain%GetTotalNodes() * obj%timeCompo IF (obj%local_n .EQ. 0) THEN obj%local_n = tNodes(1) * obj%timeCompo END IF @@ -149,7 +149,7 @@ obj%global_n = tNodes(1) * obj%timeCompo END IF ELSE - tNodes = obj%domain%getTotalNodes() + tNodes = obj%domain%GetTotalNodes() obj%tSize = tNodes(1) * obj%timeCompo IF (obj%local_n .EQ. 0) THEN obj%local_n = obj%tSize diff --git a/src/submodules/STScalarMeshField/src/STScalarMeshField_Class@ConstructorMethods.F90 b/src/submodules/STScalarMeshField/src/STScalarMeshField_Class@ConstructorMethods.F90 index aa92dd7bf..8c3a31b98 100644 --- a/src/submodules/STScalarMeshField/src/STScalarMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/STScalarMeshField/src/STScalarMeshField_Class@ConstructorMethods.F90 @@ -23,10 +23,10 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setSTScalarMeshFieldParam +MODULE PROCEDURE SetSTScalarMeshFieldParam !! IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="STScalarMeshField", & & name=name, & @@ -37,7 +37,7 @@ & rank=Scalar, & & s=[1]) ELSE - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="STScalarMeshField", & & name=name, & @@ -49,18 +49,18 @@ & s=[nns, nnt]) END IF !! -END PROCEDURE setSTScalarMeshFieldParam +END PROCEDURE SetSTScalarMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix="STScalarMeshField", & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -73,6 +73,37 @@ & param=param, mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/STTensorMeshField/src/STTensorMeshField_Class@ConstructorMethods.F90 b/src/submodules/STTensorMeshField/src/STTensorMeshField_Class@ConstructorMethods.F90 index cf8ccf98a..de733d555 100644 --- a/src/submodules/STTensorMeshField/src/STTensorMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/STTensorMeshField/src/STTensorMeshField_Class@ConstructorMethods.F90 @@ -23,7 +23,7 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setSTTensorMeshFieldParam +MODULE PROCEDURE SetSTTensorMeshFieldParam IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN CALL SetAbstractMeshFieldParam( & & param=param, & @@ -47,18 +47,18 @@ & rank=Matrix, & & s=[dim1, dim2, nns, nnt]) END IF -END PROCEDURE setSTTensorMeshFieldParam +END PROCEDURE SetSTTensorMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix="STTensorMeshField", & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -71,6 +71,38 @@ & param=param, mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/STVectorField/src/STVectorField_Class@ConstructorMethods.F90 b/src/submodules/STVectorField/src/STVectorField_Class@ConstructorMethods.F90 index fa84e89c5..c5724de82 100644 --- a/src/submodules/STVectorField/src/STVectorField_Class@ConstructorMethods.F90 +++ b/src/submodules/STVectorField/src/STVectorField_Class@ConstructorMethods.F90 @@ -21,46 +21,46 @@ CONTAINS !---------------------------------------------------------------------------- -! setSTVectorFieldParam +! SetSTVectorFieldParam !---------------------------------------------------------------------------- -MODULE PROCEDURE setSTVectorFieldParam +MODULE PROCEDURE SetSTVectorFieldParam INTEGER(I4B) :: ierr -ierr = param%set(key=myprefix//"/name", VALUE=TRIM(name)) -ierr = param%set(key=myprefix//"/engine", VALUE=TRIM(engine)) -ierr = param%set(key=myprefix//"/spaceCompo", VALUE=spaceCompo) -ierr = param%set(key=myprefix//"/timeCompo", VALUE=timeCompo) +ierr = param%Set(key=myprefix//"/name", VALUE=TRIM(name)) +ierr = param%Set(key=myprefix//"/engine", VALUE=TRIM(engine)) +ierr = param%Set(key=myprefix//"/spaceCompo", VALUE=spaceCompo) +ierr = param%Set(key=myprefix//"/timeCompo", VALUE=timeCompo) IF (PRESENT(fieldType)) THEN - ierr = param%set(key=myprefix//"/fieldType", VALUE=fieldType) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=fieldType) ELSE - ierr = param%set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) END IF IF (PRESENT(comm)) THEN - ierr = param%set(key=myprefix//"/comm", VALUE=comm) + ierr = param%Set(key=myprefix//"/comm", VALUE=comm) ELSE - ierr = param%set(key=myprefix//"/comm", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/comm", VALUE=0_I4B) END IF IF (PRESENT(local_n)) THEN - ierr = param%set(key=myprefix//"/local_n", VALUE=local_n) + ierr = param%Set(key=myprefix//"/local_n", VALUE=local_n) ELSE - ierr = param%set(key=myprefix//"/local_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/local_n", VALUE=0_I4B) END IF IF (PRESENT(global_n)) THEN - ierr = param%set(key=myprefix//"/global_n", VALUE=global_n) + ierr = param%Set(key=myprefix//"/global_n", VALUE=global_n) ELSE - ierr = param%set(key=myprefix//"/global_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/global_n", VALUE=0_I4B) END IF -END PROCEDURE setSTVectorFieldParam +END PROCEDURE SetSTVectorFieldParam !---------------------------------------------------------------------------- ! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE stvField_checkEssentialParam -CHARACTER(*), PARAMETER :: myName = "stvField_checkEssentialParam" +MODULE PROCEDURE stvField_CheckEssentialParam +CHARACTER(*), PARAMETER :: myName = "stvField_CheckEssentialParam" IF (.NOT. param%isPresent(key=myprefix//"/name")) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & myprefix//'/name should be present in param') @@ -89,7 +89,7 @@ CALL e%raiseError(modName//'::'//myName//" - "// & & 'local_n should be present in param') END IF -END PROCEDURE stvField_checkEssentialParam +END PROCEDURE stvField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -108,7 +108,7 @@ & 'STVectorField_::obj is already initiated') END IF -CALL obj%checkEssentialParam(param) +CALL obj%CheckEssentialParam(param) ! engine ALLOCATE (CHARACTER( & diff --git a/src/submodules/STVectorMeshField/src/STVectorMeshField_Class@ConstructorMethods.F90 b/src/submodules/STVectorMeshField/src/STVectorMeshField_Class@ConstructorMethods.F90 index 96268bbdd..918043afb 100644 --- a/src/submodules/STVectorMeshField/src/STVectorMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/STVectorMeshField/src/STVectorMeshField_Class@ConstructorMethods.F90 @@ -23,10 +23,10 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setSTVectorMeshFieldParam -!! +MODULE PROCEDURE SetSTVectorMeshFieldParam + IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="STVectorMeshField", & & name=name, & @@ -37,7 +37,7 @@ & rank=Vector, & & s=[spaceCompo]) ELSE - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="STVectorMeshField", & & name=name, & @@ -48,19 +48,19 @@ & rank=Vector, & & s=[spaceCompo, nns, nnt]) END IF -!! -END PROCEDURE setSTVectorMeshFieldParam + +END PROCEDURE SetSTVectorMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix="STVectorMeshField", & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -73,6 +73,38 @@ & param=param, mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/ScalarField/src/ScalarField_Class@ConstructorMethods.F90 b/src/submodules/ScalarField/src/ScalarField_Class@ConstructorMethods.F90 index 441b58aab..783327b03 100644 --- a/src/submodules/ScalarField/src/ScalarField_Class@ConstructorMethods.F90 +++ b/src/submodules/ScalarField/src/ScalarField_Class@ConstructorMethods.F90 @@ -21,45 +21,45 @@ CONTAINS !---------------------------------------------------------------------------- -! setScalarField +! SetScalarField !---------------------------------------------------------------------------- -MODULE PROCEDURE setScalarFieldParam +MODULE PROCEDURE SetScalarFieldParam INTEGER(I4B) :: ierr -ierr = param%set(key=myprefix//"/name", VALUE=name) -ierr = param%set(key=myprefix//"/engine", VALUE=engine) +ierr = param%Set(key=myprefix//"/name", VALUE=name) +ierr = param%Set(key=myprefix//"/engine", VALUE=engine) IF (PRESENT(fieldType)) THEN - ierr = param%set(key=myprefix//"/fieldType", VALUE=fieldType) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=fieldType) ELSE - ierr = param%set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) + ierr = param%Set(key=myprefix//"/fieldType", VALUE=FIELD_TYPE_NORMAL) END IF IF (PRESENT(comm)) THEN - ierr = param%set(key=myprefix//"/comm", VALUE=comm) + ierr = param%Set(key=myprefix//"/comm", VALUE=comm) ELSE - ierr = param%set(key=myprefix//"/comm", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/comm", VALUE=0_I4B) END IF IF (PRESENT(local_n)) THEN - ierr = param%set(key=myprefix//"/local_n", VALUE=local_n) + ierr = param%Set(key=myprefix//"/local_n", VALUE=local_n) ELSE - ierr = param%set(key=myprefix//"/local_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/local_n", VALUE=0_I4B) END IF IF (PRESENT(global_n)) THEN - ierr = param%set(key=myprefix//"/global_n", VALUE=global_n) + ierr = param%Set(key=myprefix//"/global_n", VALUE=global_n) ELSE - ierr = param%set(key=myprefix//"/global_n", VALUE=0_I4B) + ierr = param%Set(key=myprefix//"/global_n", VALUE=0_I4B) END IF -END PROCEDURE setScalarFieldParam +END PROCEDURE SetScalarFieldParam !---------------------------------------------------------------------------- ! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE sField_checkEssentialParam -CHARACTER(*), PARAMETER :: myName = "sField_checkEssentialParam" +MODULE PROCEDURE sField_CheckEssentialParam +CHARACTER(*), PARAMETER :: myName = "sField_CheckEssentialParam" IF (.NOT. param%isPresent(key=myprefix//"/name")) THEN CALL e%raiseError(modName//'::'//myName//" - "// & & 'names should be present in param') @@ -84,7 +84,7 @@ CALL e%raiseError(modName//'::'//myName//" - "// & & 'local_n should be present in param') END IF -END PROCEDURE sField_checkEssentialParam +END PROCEDURE sField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -98,39 +98,35 @@ CHARACTER(1) :: names_char(1) ! main program -IF (obj%isInitiated) THEN - CALL e%raiseError(modName//'::'//myName//" - "// & - & 'ScalarField_::obj is already initiated') -END IF - -CALL obj%checkEssentialParam(param) +CALL obj%Deallocate() +CALL obj%CheckEssentialParam(param) ! engine ALLOCATE (CHARACTER( & & param%DataSizeInBytes(key=myprefix//"/engine")) :: char_var) -ierr = param%get(key=myprefix//"/engine", VALUE=char_var) +ierr = param%Get(key=myprefix//"/engine", VALUE=char_var) obj%engine = char_var DEALLOCATE (char_var) ! name ALLOCATE (CHARACTER( & & param%DataSizeInBytes(key=myprefix//"/name")) :: char_var) -ierr = param%get(key=myprefix//"/name", VALUE=char_var) +ierr = param%Get(key=myprefix//"/name", VALUE=char_var) obj%name = char_var names_char(1) (1:1) = char_var(1:1) DEALLOCATE (char_var) ! fieldType IF (param%isPresent(key=myprefix//"/fieldType")) THEN - ierr = param%get(key=myprefix//"/fieldType", VALUE=obj%fieldType) + ierr = param%Get(key=myprefix//"/fieldType", VALUE=obj%fieldType) ELSE obj%fieldType = FIELD_TYPE_NORMAL END IF ! comm -ierr = param%get(key=myprefix//"/comm", VALUE=obj%comm) -ierr = param%get(key=myprefix//"/global_n", VALUE=obj%global_n) -ierr = param%get(key=myprefix//"/local_n", VALUE=obj%local_n) +ierr = param%Get(key=myprefix//"/comm", VALUE=obj%comm) +ierr = param%Get(key=myprefix//"/global_n", VALUE=obj%global_n) +ierr = param%Get(key=myprefix//"/local_n", VALUE=obj%local_n) spaceCompo = [1] timeCompo = [1] @@ -138,7 +134,7 @@ obj%domain => dom IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN tNodes = 1 - obj%tSize = obj%domain%getTotalNodes() + obj%tSize = obj%domain%GetTotalNodes() IF (obj%local_n .EQ. 0) THEN obj%local_n = tNodes(1) END IF @@ -146,7 +142,7 @@ obj%global_n = tNodes(1) END IF ELSE - tNodes = obj%domain%getTotalNodes() + tNodes = obj%domain%GetTotalNodes() obj%tSize = tNodes(1) IF (obj%local_n .EQ. 0) THEN obj%local_n = obj%tSize @@ -156,7 +152,7 @@ END IF END IF -CALL initiate( & +CALL Initiate( & & obj=obj%dof, & & tNodes=tNodes, & & names=names_char, & @@ -164,7 +160,7 @@ & timeCompo=timeCompo, & & storageFMT=storageFMT) -CALL initiate(obj%realVec, obj%dof) +CALL Initiate(obj%realVec, obj%dof) obj%isInitiated = .TRUE. diff --git a/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 b/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 index 59aeba39f..e68d3e752 100644 --- a/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 +++ b/src/submodules/ScalarField/src/ScalarField_Class@SetMethods.F90 @@ -34,7 +34,8 @@ IF (obj%fieldType .EQ. FIELD_TYPE_CONSTANT) THEN IF (PRESENT(addContribution)) THEN - CALL add(obj%realVec, nodenum=[1], VALUE=[VALUE], scale=scale) + CALL add(obj%realVec, nodenum=[1], VALUE=[VALUE], & + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, nodenum=[1], VALUE=[VALUE]) END IF @@ -46,7 +47,7 @@ IF (PRESENT(addContribution)) THEN CALL add(obj%realVec, nodenum=[localNode], VALUE=[VALUE], & - & scale=scale) + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, nodenum=[localNode], VALUE=[VALUE]) END IF @@ -71,7 +72,8 @@ ELSE IF (PRESENT(addContribution)) THEN - CALL add(obj%realVec, VALUE=VALUE, scale=scale) + CALL add(obj%realVec, VALUE=VALUE, & + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, VALUE=VALUE) END IF @@ -102,7 +104,8 @@ END IF IF (PRESENT(addContribution)) THEN - CALL add(obj%realVec, VALUE=VALUE, scale=scale) + CALL add(obj%realVec, VALUE=VALUE, & + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, VALUE=VALUE) END IF @@ -133,7 +136,8 @@ & 'Some of the globalNode are out of bound') END IF IF (PRESENT(addContribution)) THEN - CALL add(obj%realVec, nodenum=localNode, VALUE=VALUE, scale=scale) + CALL add(obj%realVec, nodenum=localNode, VALUE=VALUE, & + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, nodenum=localNode, VALUE=VALUE) END IF @@ -163,7 +167,11 @@ & 'Some of the globalNode are out of bound') END IF IF (PRESENT(addContribution)) THEN - CALL add(obj%realVec, nodenum=localNode, VALUE=VALUE, scale=scale) + CALL add( & + & obj=obj%realVec, & + & nodenum=localNode, & + & VALUE=VALUE, & + & scale=Input(option=scale, default=1.0_DFP)) ELSE CALL set(obj%realVec, nodenum=localNode, VALUE=VALUE) END IF diff --git a/src/submodules/ScalarMeshField/src/ScalarMeshField_Class@ConstructorMethods.F90 b/src/submodules/ScalarMeshField/src/ScalarMeshField_Class@ConstructorMethods.F90 index fa9e8d079..86d47547a 100644 --- a/src/submodules/ScalarMeshField/src/ScalarMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/ScalarMeshField/src/ScalarMeshField_Class@ConstructorMethods.F90 @@ -23,10 +23,10 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setScalarMeshFieldParam +MODULE PROCEDURE SetScalarMeshFieldParam !! IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="ScalarMeshField", & & name=name, & @@ -37,7 +37,7 @@ & rank=Scalar, & & s=[1]) ELSE - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="ScalarMeshField", & & name=name, & @@ -49,18 +49,18 @@ & s=[nns]) END IF !! -END PROCEDURE setScalarMeshFieldParam +END PROCEDURE SetScalarMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix="ScalarMeshField", & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -74,6 +74,37 @@ & mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/TensorMeshField/src/TensorMeshField_Class@ConstructorMethods.F90 b/src/submodules/TensorMeshField/src/TensorMeshField_Class@ConstructorMethods.F90 index 81d75be2a..044c8baca 100644 --- a/src/submodules/TensorMeshField/src/TensorMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/TensorMeshField/src/TensorMeshField_Class@ConstructorMethods.F90 @@ -23,9 +23,9 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setTensorMeshFieldParam +MODULE PROCEDURE SetTensorMeshFieldParam IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix=myPrefix, & & name=name, & @@ -36,7 +36,7 @@ & rank=Matrix, & & s=[dim1, dim2]) ELSE - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix=myPrefix, & & name=name, & @@ -47,18 +47,18 @@ & rank=Matrix, & & s=[dim1, dim2, nns]) END IF -END PROCEDURE setTensorMeshFieldParam +END PROCEDURE SetTensorMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix=myPrefix, & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -71,6 +71,37 @@ & param=param, mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/submodules/VTKPlot/src/VTKPlot_Class@ScatterMethods.F90 b/src/submodules/VTKPlot/src/VTKPlot_Class@ScatterMethods.F90 index 18b1dc8e1..8f8e8cd01 100644 --- a/src/submodules/VTKPlot/src/VTKPlot_Class@ScatterMethods.F90 +++ b/src/submodules/VTKPlot/src/VTKPlot_Class@ScatterMethods.F90 @@ -82,65 +82,62 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE plot_scatter3D_2 -! + CHARACTER(*), PARAMETER :: myName = "plot_scatter3D_2" INTEGER(I4B) :: nPoints, ii, ndata TYPE(VTKFile_) :: aVTKfile TYPE(String) :: labelstr REAL(DFP), ALLOCATABLE :: temp(:) -! + ! check -! IF ((SIZE(x) .NE. SIZE(y)) .OR. & & (SIZE(y) .NE. SIZE(z, 1)) .OR. & & (SIZE(z, 1) .NE. SIZE(x))) THEN CALL e%raiseError(modName//'::'//myName//' - '// & & 'Size of x, y, and z should be the same.') END IF -! + nPoints = SIZE(x) ndata = SIZE(z, 2) -! CALL aVTKfile%InitiateVTKFile( & & filename=filename, & & mode="NEW", & & DataFormat=VTK_BINARY, & & DataStructureType=VTK_PolyData) -! + CALL aVTKfile%WritePiece(nPoints=nPoints, & & nVerts=0_I4B, & & nLines=0_I4B, & & nStrips=0_I4B, & & nPolys=0_I4B) -! + CALL aVTKfile%WritePoints(x=x, y=y, z=z(:, 1)) -! + CALL aVTKfile%WriteDataArray(& & location=String("node"), & & action=String("open")) -! + +temp = zeros(nPoints, 1.0_DFP) DO ii = 1, ndata - ! + labelstr = TRIM(label)//tostring(ii) - ! - CALL aVTKfile%WriteDataArray(& - & name=labelstr, & - & x=temp, & - & y=temp, & - & z=z(:, ii)) - ! + ! CALL aVTKfile%WriteDataArray(& + ! & name=labelstr, & + ! & x=temp, & + ! & y=temp, & + ! & z=z(:, ii)) + + CALL aVTKfile%WriteDataArray(name=labelstr, x=z(:, ii)) + END DO -! + CALL aVTKfile%WriteDataArray(& & location=String("node"), & & action=String("close")) -! + CALL aVTKfile%WritePiece() -! CALL aVTKfile%DEALLOCATE() -! IF (ALLOCATED(temp)) DEALLOCATE (temp) -! END PROCEDURE plot_scatter3D_2 !---------------------------------------------------------------------------- @@ -153,4 +150,62 @@ CALL obj%Scatter3D(x=x, y=y, z=z, label=label, filename=filename) END PROCEDURE plot_scatter3D_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE plot_scatter3D_4 +CHARACTER(*), PARAMETER :: myName = "plot_scatter3D_4" +INTEGER(I4B) :: nPoints, ii, ndata +TYPE(VTKFile_) :: aVTKfile +TYPE(String) :: labelstr + +! check +IF ((SIZE(x) .NE. SIZE(y)) .OR. & + & (SIZE(y) .NE. SIZE(z)) .OR. & + & (SIZE(z) .NE. SIZE(x))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Size of x, y, and z should be the same.') +END IF + +! check +IF (SIZE(w, 1) .NE. SIZE(x)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Size of x, y, z, and size(w,1) should be the same.') +END IF + +nPoints = SIZE(x) +ndata = SIZE(w, 2) + +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_PolyData) + +CALL aVTKfile%WritePiece(nPoints=nPoints, & + & nVerts=0_I4B, & + & nLines=0_I4B, & + & nStrips=0_I4B, & + & nPolys=0_I4B) + +CALL aVTKfile%WritePoints(x=x, y=y, z=z) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("open")) + +DO ii = 1, ndata + labelstr = TRIM(label)//tostring(ii) + CALL aVTKfile%WriteDataArray(name=labelstr, x=w(:, ii)) +END DO + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("close")) + +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() +END PROCEDURE plot_scatter3D_4 + END SUBMODULE ScatterMethods diff --git a/src/submodules/VTKPlot/src/VTKPlot_Class@StructuredGridMethods.F90 b/src/submodules/VTKPlot/src/VTKPlot_Class@StructuredGridMethods.F90 index f922f20a6..c276970d9 100644 --- a/src/submodules/VTKPlot/src/VTKPlot_Class@StructuredGridMethods.F90 +++ b/src/submodules/VTKPlot/src/VTKPlot_Class@StructuredGridMethods.F90 @@ -21,89 +21,327 @@ CONTAINS !---------------------------------------------------------------------------- -! Initiate +! Plot !---------------------------------------------------------------------------- MODULE PROCEDURE vts_plot_x1y1 - !! - REAL( DFP ) :: z( 1 ) - REAL( DFP ), ALLOCATABLE :: xx( :, :, : ), yy( :, :, : ), zz( :, :, : ) - !! - z = 0.0_DFP - CALL MeshGrid(x=xx, y=yy, z=zz, xgv=x, ygv=y, zgv=z) - CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) - !! - DEALLOCATE( xx, yy, zz ) - !! +REAL(DFP) :: z(1) +REAL(DFP), ALLOCATABLE :: xx(:, :, :), yy(:, :, :), zz(:, :, :) +z = 0.0_DFP +CALL MeshGrid(x=xx, y=yy, z=zz, xgv=x, ygv=y, zgv=z) +CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) +DEALLOCATE (xx, yy, zz) END PROCEDURE vts_plot_x1y1 !---------------------------------------------------------------------------- -! Display +! Plot !---------------------------------------------------------------------------- MODULE PROCEDURE vts_plot_x1y1z1 - !! - REAL( DFP ), ALLOCATABLE :: xx( :, :, : ), yy( :, :, : ), zz( :, :, : ) - !! - CALL MeshGrid(x=xx, y=yy, z=zz, xgv=x, ygv=y, zgv=z) - CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) - DEALLOCATE( xx, yy, zz) - !! +REAL(DFP), ALLOCATABLE :: xx(:, :, :), yy(:, :, :), zz(:, :, :) +CALL MeshGrid(x=xx, y=yy, z=zz, xgv=x, ygv=y, zgv=z) +CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) +DEALLOCATE (xx, yy, zz) END PROCEDURE vts_plot_x1y1z1 !---------------------------------------------------------------------------- -! Display +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x1y1z1w1 +INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2 +TYPE(VTKFile_) :: aVTKfile +REAL(DFP), ALLOCATABLE :: xx(:, :, :), yy(:, :, :), zz(:, :, :) +CHARACTER(*), PARAMETER :: myName = "vts_plot_x1y1z1w1" + +CALL MeshGrid(x=xx, y=yy, z=zz, xgv=x, ygv=y, zgv=z) + +IF (ANY(SHAPE(xx) .NE. SHAPE(yy)) .OR. & + & ANY(SHAPE(yy) .NE. SHAPE(zz)) .OR. & + & ANY(SHAPE(zz) .NE. SHAPE(xx))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Shape of xx, yy, and zz should be the same.') +END IF + +nx1 = 0; nx2 = SIZE(xx, 1) - 1 +ny1 = 0; ny2 = SIZE(xx, 2) - 1 +nz1 = 0; nz2 = SIZE(xx, 3) - 1 + +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_StructuredGrid, & + & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) + +CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePoints(x=xx, y=yy, z=zz) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("open")) + +CALL aVTKfile%WriteDataArray(& + & name=String(TRIM(label)), & + & x=w) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("close")) + +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() + +DEALLOCATE (xx, yy, zz) +END PROCEDURE vts_plot_x1y1z1w1 + +!---------------------------------------------------------------------------- +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x3y3z3w2 +INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2, ii +TYPE(VTKFile_) :: aVTKfile +CHARACTER(*), PARAMETER :: myName = "vts_plot_x3y3z3w2" + +IF (ANY(SHAPE(x) .NE. SHAPE(y)) .OR. & + & ANY(SHAPE(y) .NE. SHAPE(z)) .OR. & + & ANY(SHAPE(z) .NE. SHAPE(x))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Shape of x, y, and z should be the same.') + RETURN +END IF + +IF (SIZE(label) .NE. SIZE(w, 2)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Size of label should be same as size(w,2).') + RETURN +END IF + +nx1 = 0; nx2 = SIZE(x, 1) - 1 +ny1 = 0; ny2 = SIZE(x, 2) - 1 +nz1 = 0; nz2 = SIZE(x, 3) - 1 + +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_StructuredGrid, & + & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) + +CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePoints(x=x, y=y, z=z) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("open")) + +DO ii = 1, SIZE(w, 2) + CALL aVTKfile%WriteDataArray(& + & name=label(ii), & + & x=w(:, ii)) +END DO + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("close")) + +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() + +END PROCEDURE vts_plot_x3y3z3w2 + +!---------------------------------------------------------------------------- +! Plot !---------------------------------------------------------------------------- MODULE PROCEDURE vts_plot_x2y2 - !! - REAL( DFP ) :: z( 1 ) - REAL( DFP ), DIMENSION( SIZE(x,1), SIZE(x,2), 1 ) :: xx, yy, zz - !! - !! check - !! - z = 0.0_DFP - xx( :, :, 1 ) = x - yy( :, :, 1 ) = y - zz = 0.0_DFP - CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) - !! +REAL(DFP) :: z(1) +REAL(DFP), DIMENSION(SIZE(x, 1), SIZE(x, 2), 1) :: xx, yy, zz +z = 0.0_DFP +xx(:, :, 1) = x +yy(:, :, 1) = y +zz = 0.0_DFP +CALL obj%plot(x=xx, y=yy, z=zz, filename=filename) END PROCEDURE vts_plot_x2y2 !---------------------------------------------------------------------------- -! Display +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x2y2w2 +REAL(DFP) :: z(1) +REAL(DFP), DIMENSION(SIZE(x, 1), SIZE(x, 2), 1) :: xx, yy, zz, ww +z = 0.0_DFP +xx(:, :, 1) = x +yy(:, :, 1) = y +ww(:, :, 1) = w +zz = 0.0_DFP +CALL obj%plot(x=xx, y=yy, z=zz, w=ww, label=label, filename=filename) +END PROCEDURE vts_plot_x2y2w2 + +!---------------------------------------------------------------------------- +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x2y2w2b +REAL(DFP) :: z(1) +REAL(DFP), DIMENSION(SIZE(x, 1), SIZE(x, 2), 1) :: xx, yy, zz +z = 0.0_DFP +xx(:, :, 1) = x +yy(:, :, 1) = y +zz = 0.0_DFP +CALL obj%plot(x=xx, y=yy, z=zz, w=w, label=label, filename=filename) +END PROCEDURE vts_plot_x2y2w2b + +!---------------------------------------------------------------------------- +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x2y2w3 +REAL(DFP) :: z(1) +REAL(DFP), DIMENSION(SIZE(x, 1), SIZE(x, 2), 1) :: xx, yy, zz +REAL(DFP), DIMENSION(SIZE(w, 1), SIZE(w, 2), 1, SIZE(w, 3)) :: ww +z = 0.0_DFP +xx(:, :, 1) = x +yy(:, :, 1) = y +ww(:, :, 1, :) = w +zz = 0.0_DFP +CALL obj%plot(x=xx, y=yy, z=zz, w=ww, label=label, filename=filename) +END PROCEDURE vts_plot_x2y2w3 + +!---------------------------------------------------------------------------- +! Plot !---------------------------------------------------------------------------- MODULE PROCEDURE vts_plot_x3y3z3 - !! - CHARACTER( LEN = * ), PARAMETER :: myName = "vts_plot_x3y3z3" - INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2 - TYPE( VTKFile_ ) :: aVTKfile - !! - !! check - !! - IF( ANY( SHAPE( x ) .NE. SHAPE( y ) ) .OR. & - & ANY( SHAPE( y ) .NE. SHAPE( z ) ) .OR. & - & ANY( SHAPE( z ) .NE. SHAPE( x ) ) ) THEN - CALL e%raiseError(modName //'::'//myName// ' - '// & - & 'Shape of x, y, and z should be the same.') - END IF - !! - nx1 = 0; nx2 = SIZE( x,1 ) - 1 - ny1 = 0; ny2 = SIZE( x,2 ) - 1 - nz1 = 0; nz2 = SIZE( x,3 ) - 1 - !! - CALL aVTKfile%InitiateVTKFile( & - & filename=filename, & - & mode="NEW", & - & DataFormat=VTK_BINARY, & - & DataStructureType=VTK_StructuredGrid, & - & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) - CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) - CALL aVTKfile%WritePoints(x=x, y=y, z=z) - CALL aVTKfile%WritePiece() - CALL aVTKfile%Deallocate() - !! +CHARACTER(*), PARAMETER :: myName = "vts_plot_x3y3z3" +INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2 +TYPE(VTKFile_) :: aVTKfile +IF (ANY(SHAPE(x) .NE. SHAPE(y)) .OR. & + & ANY(SHAPE(y) .NE. SHAPE(z)) .OR. & + & ANY(SHAPE(z) .NE. SHAPE(x))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Shape of x, y, and z should be the same.') +END IF +nx1 = 0; nx2 = SIZE(x, 1) - 1 +ny1 = 0; ny2 = SIZE(x, 2) - 1 +nz1 = 0; nz2 = SIZE(x, 3) - 1 +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_StructuredGrid, & + & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePoints(x=x, y=y, z=z) +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() END PROCEDURE vts_plot_x3y3z3 -END SUBMODULE StructuredGridMethods \ No newline at end of file +!---------------------------------------------------------------------------- +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x3y3z3w3 +CHARACTER(*), PARAMETER :: myName = "vts_plot_x3y3z3w3" +INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2 +TYPE(VTKFile_) :: aVTKfile +REAL(DFP), ALLOCATABLE :: temp(:) + +IF (ANY(SHAPE(x) .NE. SHAPE(y)) .OR. & + & ANY(SHAPE(y) .NE. SHAPE(z)) .OR. & + & ANY(SHAPE(z) .NE. SHAPE(x))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Shape of x, y, and z should be the same.') +END IF +nx1 = 0; nx2 = SIZE(x, 1) - 1 +ny1 = 0; ny2 = SIZE(x, 2) - 1 +nz1 = 0; nz2 = SIZE(x, 3) - 1 +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_StructuredGrid, & + & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePoints(x=x, y=y, z=z) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("open")) + +temp = RESHAPE(w, [SIZE(w)]) +CALL aVTKfile%WriteDataArray(& + & name=String(TRIM(label)), & + & x=temp) +IF (ALLOCATED(temp)) DEALLOCATE (temp) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("close")) + +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() +END PROCEDURE vts_plot_x3y3z3w3 + +!---------------------------------------------------------------------------- +! Plot +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vts_plot_x3y3z3w4 +CHARACTER(*), PARAMETER :: myName = "vts_plot_x3y3z3w4" +INTEGER(I4B) :: nx1, nx2, ny1, ny2, nz1, nz2, ii +TYPE(VTKFile_) :: aVTKfile +REAL(DFP), ALLOCATABLE :: temp(:) + +IF (ANY(SHAPE(x) .NE. SHAPE(y)) .OR. & + & ANY(SHAPE(y) .NE. SHAPE(z)) .OR. & + & ANY(SHAPE(z) .NE. SHAPE(x))) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'Shape of x, y, and z should be the same.') + RETURN +END IF + +IF (SIZE(label) .NE. SIZE(w, 4)) THEN + CALL e%raiseError(modName//'::'//myName//' - '// & + & 'The size of label should be same as size(w, 4)') + RETURN +END IF + +nx1 = 0; nx2 = SIZE(x, 1) - 1 +ny1 = 0; ny2 = SIZE(x, 2) - 1 +nz1 = 0; nz2 = SIZE(x, 3) - 1 + +CALL aVTKfile%InitiateVTKFile( & + & filename=filename, & + & mode="NEW", & + & DataFormat=VTK_BINARY, & + & DataStructureType=VTK_StructuredGrid, & + & WholeExtent=[nx1, nx2, ny1, ny2, nz1, nz2]) + +CALL aVTKfile%WritePiece(extent=[nx1, nx2, ny1, ny2, nz1, nz2]) +CALL aVTKfile%WritePoints(x=x, y=y, z=z) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("open")) + +DO ii = 1, SIZE(label) + temp = RESHAPE(w(:, :, :, ii), [SIZE(x)]) + CALL aVTKfile%WriteDataArray(& + & name=String(label(ii)%chars()), & + & x=temp) +END DO + +IF (ALLOCATED(temp)) DEALLOCATE (temp) + +CALL aVTKfile%WriteDataArray(& + & location=String("node"), & + & action=String("close")) + +CALL aVTKfile%WritePiece() +CALL aVTKfile%DEALLOCATE() +END PROCEDURE vts_plot_x3y3z3w4 + +END SUBMODULE StructuredGridMethods diff --git a/src/submodules/VectorMeshField/src/VectorMeshField_Class@ConstructorMethods.F90 b/src/submodules/VectorMeshField/src/VectorMeshField_Class@ConstructorMethods.F90 index ae9665c97..3111a168e 100644 --- a/src/submodules/VectorMeshField/src/VectorMeshField_Class@ConstructorMethods.F90 +++ b/src/submodules/VectorMeshField/src/VectorMeshField_Class@ConstructorMethods.F90 @@ -23,10 +23,10 @@ ! !---------------------------------------------------------------------------- -MODULE PROCEDURE setVectorMeshFieldParam -!! +MODULE PROCEDURE SetVectorMeshFieldParam + IF (fieldType .EQ. FIELD_TYPE_CONSTANT) THEN - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="VectorMeshField", & & name=name, & @@ -37,7 +37,7 @@ & rank=Vector, & & s=[spaceCompo]) ELSE - CALL setAbstractMeshFieldParam( & + CALL SetAbstractMeshFieldParam( & & param=param, & & prefix="VectorMeshField", & & name=name, & @@ -48,19 +48,19 @@ & rank=Vector, & & s=[spaceCompo, nns]) END IF -!! -END PROCEDURE setVectorMeshFieldParam + +END PROCEDURE SetVectorMeshFieldParam !---------------------------------------------------------------------------- -! checkEssentialParam +! CheckEssentialParam !---------------------------------------------------------------------------- -MODULE PROCEDURE aField_checkEssentialParam +MODULE PROCEDURE aField_CheckEssentialParam CALL AbstractFieldCheckEssentialParam( & & obj=obj, & & prefix="VectorMeshField", & & param=param) -END PROCEDURE aField_checkEssentialParam +END PROCEDURE aField_CheckEssentialParam !---------------------------------------------------------------------------- ! Initiate @@ -73,6 +73,37 @@ & param=param, mesh=mesh) END PROCEDURE aField_Initiate1 +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Vector +INTEGER(I4B) :: ii +IF (ALLOCATED(obj)) THEN + DO ii = 1, SIZE(obj) + CALL obj(ii)%DEALLOCATE() + END DO + DEALLOCATE (obj) +END IF +END PROCEDURE aField_Deallocate_Vector + +!---------------------------------------------------------------------------- +! Deallocate +!---------------------------------------------------------------------------- + +MODULE PROCEDURE aField_Deallocate_Ptr_Vector +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 aField_Deallocate_Ptr_Vector + !---------------------------------------------------------------------------- ! !----------------------------------------------------------------------------