From 55c9d30ed834f3e6c3a1b936e306f47044431aed Mon Sep 17 00:00:00 2001 From: vikas sharma Date: Thu, 22 Jun 2023 21:35:01 +0900 Subject: [PATCH 01/16] update --- src/modules/FEVariable/src/ABS.inc | 34 - src/modules/FEVariable/src/Addition.inc | 81 - src/modules/FEVariable/src/DOT_PRODUCT.inc | 35 - src/modules/FEVariable/src/Division.inc | 81 - src/modules/FEVariable/src/EQUAL.inc | 57 - .../FEVariable/src/FEVariable_Method.F90 | 1476 ++++++++++++++++- src/modules/FEVariable/src/GetMethods.inc | 408 ----- src/modules/FEVariable/src/IOMethods.inc | 39 - src/modules/FEVariable/src/Mean.inc | 98 -- src/modules/FEVariable/src/Multiplication.inc | 81 - src/modules/FEVariable/src/NORM2.inc | 34 - .../src/NodalConstructorMethods.inc | 310 ---- src/modules/FEVariable/src/Power.inc | 39 - .../src/QuadratureConstructorMethods.inc | 295 ---- src/modules/FEVariable/src/SQRT.inc | 38 - src/modules/FEVariable/src/Subtraction.inc | 81 - .../src/LagrangePolynomialUtility.F90 | 2 +- 17 files changed, 1459 insertions(+), 1730 deletions(-) delete mode 100644 src/modules/FEVariable/src/ABS.inc delete mode 100644 src/modules/FEVariable/src/Addition.inc delete mode 100644 src/modules/FEVariable/src/DOT_PRODUCT.inc delete mode 100644 src/modules/FEVariable/src/Division.inc delete mode 100644 src/modules/FEVariable/src/EQUAL.inc delete mode 100644 src/modules/FEVariable/src/GetMethods.inc delete mode 100644 src/modules/FEVariable/src/IOMethods.inc delete mode 100644 src/modules/FEVariable/src/Mean.inc delete mode 100644 src/modules/FEVariable/src/Multiplication.inc delete mode 100644 src/modules/FEVariable/src/NORM2.inc delete mode 100644 src/modules/FEVariable/src/NodalConstructorMethods.inc delete mode 100644 src/modules/FEVariable/src/Power.inc delete mode 100644 src/modules/FEVariable/src/QuadratureConstructorMethods.inc delete mode 100644 src/modules/FEVariable/src/SQRT.inc delete mode 100644 src/modules/FEVariable/src/Subtraction.inc diff --git a/src/modules/FEVariable/src/ABS.inc b/src/modules/FEVariable/src/ABS.inc deleted file mode 100644 index db541c2ac..000000000 --- a/src/modules/FEVariable/src/ABS.inc +++ /dev/null @@ -1,34 +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 -! - -PUBLIC :: ABS - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_abs(obj) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariable_) :: ans - END FUNCTION fevar_abs -END INTERFACE - -INTERFACE ABS - MODULE PROCEDURE fevar_abs -END INTERFACE ABS diff --git a/src/modules/FEVariable/src/Addition.inc b/src/modules/FEVariable/src/Addition.inc deleted file mode 100644 index 7b1ac0c80..000000000 --- a/src/modules/FEVariable/src/Addition.inc +++ /dev/null @@ -1,81 +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 -! - -PUBLIC :: OPERATOR(+) - -!---------------------------------------------------------------------------- -! Addition@AdditioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Addition1(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Addition1 -END INTERFACE - -INTERFACE OPERATOR(+) - MODULE PROCEDURE fevar_Addition1 -END INTERFACE OPERATOR(+) - -!---------------------------------------------------------------------------- -! Addition@AdditioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + Real - -INTERFACE - MODULE PURE FUNCTION fevar_Addition2(obj1, val) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - REAL( DFP ), INTENT(IN) :: val - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Addition2 -END INTERFACE - -INTERFACE OPERATOR(+) - MODULE PROCEDURE fevar_Addition2 -END INTERFACE OPERATOR(+) - -!---------------------------------------------------------------------------- -! Addition@AdditioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = Real + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Addition3(val, obj1) RESULT(Ans) - REAL( DFP ), INTENT(IN) :: val - CLASS(FEVariable_), INTENT(IN) :: obj1 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Addition3 -END INTERFACE - -INTERFACE OPERATOR(+) - MODULE PROCEDURE fevar_Addition3 -END INTERFACE OPERATOR(+) diff --git a/src/modules/FEVariable/src/DOT_PRODUCT.inc b/src/modules/FEVariable/src/DOT_PRODUCT.inc deleted file mode 100644 index 95b4bc6f3..000000000 --- a/src/modules/FEVariable/src/DOT_PRODUCT.inc +++ /dev/null @@ -1,35 +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 -! - -PUBLIC :: DOT_PRODUCT - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_dot_product(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_dot_product -END INTERFACE - -INTERFACE DOT_PRODUCT - MODULE PROCEDURE fevar_dot_product -END INTERFACE DOT_PRODUCT diff --git a/src/modules/FEVariable/src/Division.inc b/src/modules/FEVariable/src/Division.inc deleted file mode 100644 index 68b83ea25..000000000 --- a/src/modules/FEVariable/src/Division.inc +++ /dev/null @@ -1,81 +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 -! - -PUBLIC :: OPERATOR(/) - -!---------------------------------------------------------------------------- -! Division@DivisionMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable - FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Division1(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Division1 -END INTERFACE - -INTERFACE OPERATOR(/) - MODULE PROCEDURE fevar_Division1 -END INTERFACE OPERATOR(/) - -!---------------------------------------------------------------------------- -! Division@DivisionMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable - Real - -INTERFACE - MODULE PURE FUNCTION fevar_Division2(obj1, val) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - REAL(DFP), INTENT(IN) :: val - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Division2 -END INTERFACE - -INTERFACE OPERATOR(/) - MODULE PROCEDURE fevar_Division2 -END INTERFACE OPERATOR(/) - -!---------------------------------------------------------------------------- -! Division@DivisionMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = Real - FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Division3(val, obj1) RESULT(Ans) - REAL(DFP), INTENT(IN) :: val - CLASS(FEVariable_), INTENT(IN) :: obj1 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Division3 -END INTERFACE - -INTERFACE OPERATOR(/) - MODULE PROCEDURE fevar_Division3 -END INTERFACE OPERATOR(/) \ No newline at end of file diff --git a/src/modules/FEVariable/src/EQUAL.inc b/src/modules/FEVariable/src/EQUAL.inc deleted file mode 100644 index 6d847a68d..000000000 --- a/src/modules/FEVariable/src/EQUAL.inc +++ /dev/null @@ -1,57 +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 -! - -PUBLIC :: OPERATOR( .EQ. ) -PUBLIC :: OPERATOR( .NE. ) - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = NORM2(FEVariable) - -INTERFACE - MODULE PURE FUNCTION fevar_isEqual(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - LOGICAL( LGT ) :: ans - END FUNCTION fevar_isEqual -END INTERFACE - -INTERFACE OPERATOR( .EQ. ) - MODULE PROCEDURE fevar_isEqual -END INTERFACE OPERATOR( .EQ. ) - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = NORM2(FEVariable) - -INTERFACE - MODULE PURE FUNCTION fevar_notEqual(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - LOGICAL( LGT ) :: ans - END FUNCTION fevar_notEqual -END INTERFACE - -INTERFACE OPERATOR( .NE. ) - MODULE PROCEDURE fevar_notEqual -END INTERFACE OPERATOR( .NE. ) diff --git a/src/modules/FEVariable/src/FEVariable_Method.F90 b/src/modules/FEVariable/src/FEVariable_Method.F90 index f483e99b3..28e11aeeb 100644 --- a/src/modules/FEVariable/src/FEVariable_Method.F90 +++ b/src/modules/FEVariable/src/FEVariable_Method.F90 @@ -20,24 +20,1464 @@ MODULE FEVariable_Method IMPLICIT NONE PRIVATE -#include "./IOMethods.inc" -#include "./QuadratureConstructorMethods.inc" -#include "./NodalConstructorMethods.inc" -#include "./GetMethods.inc" -#include "./Addition.inc" -#include "./Subtraction.inc" -#include "./Multiplication.inc" -#include "./Division.inc" -#include "./Power.inc" -#include "./SQRT.inc" -#include "./ABS.inc" -#include "./DOT_PRODUCT.inc" -#include "./NORM2.inc" -#include "./EQUAL.inc" -#include "./Mean.inc" - -!---------------------------------------------------------------------------- -! Addition@OperatorMethods +PUBLIC :: Display +PUBLIC :: QuadratureVariable +PUBLIC :: DEALLOCATE +PUBLIC :: NodalVariable +PUBLIC :: SIZE +PUBLIC :: SHAPE +PUBLIC :: OPERATOR(.RANK.) +PUBLIC :: OPERATOR(.vartype.) +PUBLIC :: OPERATOR(.defineon.) +PUBLIC :: isNodalVariable +PUBLIC :: isQuadratureVariable +PUBLIC :: Get +PUBLIC :: OPERATOR(+) +PUBLIC :: OPERATOR(-) +PUBLIC :: OPERATOR(*) +PUBLIC :: ABS +PUBLIC :: DOT_PRODUCT +PUBLIC :: OPERATOR(/) +PUBLIC :: OPERATOR(**) +PUBLIC :: SQRT +PUBLIC :: NORM2 +PUBLIC :: OPERATOR(.EQ.) +PUBLIC :: OPERATOR(.NE.) +PUBLIC :: MEAN + +!---------------------------------------------------------------------------- +! Display@IOMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Displays the content of [[FEVariable_]] + +INTERFACE + MODULE SUBROUTINE fevar_Display(obj, Msg, UnitNo) + TYPE(FEVariable_), INTENT(IN) :: obj + CHARACTER(*), INTENT(IN) :: Msg + INTEGER(I4B), OPTIONAL, INTENT(IN) :: UnitNo + END SUBROUTINE fevar_Display +END INTERFACE + +INTERFACE Display + MODULE PROCEDURE fevar_Display +END INTERFACE Display + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Scalar, Constant + +INTERFACE + MODULE PURE FUNCTION Quadrature_Scalar_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Scalar_Constant +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Scalar_Constant +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Scalar, Space + +INTERFACE + MODULE PURE FUNCTION Quadrature_Scalar_Space(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Scalar_Space +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Scalar_Space +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Scalar, Time + +INTERFACE + MODULE PURE FUNCTION Quadrature_Scalar_Time(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Scalar_Time +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Scalar_Time +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Scalar, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Quadrature_Scalar_SpaceTime(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Scalar_SpaceTime +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Scalar_SpaceTime +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Vector, Constant + +INTERFACE + MODULE PURE FUNCTION Quadrature_Vector_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Vector_Constant +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Vector_Constant +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Vector, Space + +INTERFACE + MODULE PURE FUNCTION Quadrature_Vector_Space(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Vector_Space +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Vector_Space +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Vector, Time + +INTERFACE + MODULE PURE FUNCTION Quadrature_Vector_Time(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Vector_Time +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Vector_Time +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Vector, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Quadrature_Vector_SpaceTime(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Vector_SpaceTime +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Vector_SpaceTime +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Matrix, Constant + +INTERFACE + MODULE PURE FUNCTION Quadrature_Matrix_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Matrix_Constant +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Matrix_Constant +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Matrix, Space + +INTERFACE + MODULE PURE FUNCTION Quadrature_Matrix_Space(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Matrix_Space +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Matrix_Space +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Matrix, Time + +INTERFACE + MODULE PURE FUNCTION Quadrature_Matrix_Time(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Matrix_Time +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Matrix_Time +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! QuadratureVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create quadrature variable, which is Matrix, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Quadrature_Matrix_SpaceTime(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Quadrature_Matrix_SpaceTime +END INTERFACE + +INTERFACE QuadratureVariable + MODULE PROCEDURE Quadrature_Matrix_SpaceTime +END INTERFACE QuadratureVariable + +!---------------------------------------------------------------------------- +! Deallocate@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Deallocates the content of FEVariable + +INTERFACE + MODULE PURE SUBROUTINE fevar_Deallocate(obj) + TYPE(FEVariable_), INTENT(INOUT) :: obj + END SUBROUTINE fevar_Deallocate +END INTERFACE + +INTERFACE DEALLOCATE + MODULE PROCEDURE fevar_Deallocate +END INTERFACE DEALLOCATE + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is scalar, constant + +INTERFACE + MODULE PURE FUNCTION Nodal_Scalar_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val + CLASS(FEVariableScalar_), INTENT(IN) :: rank + CLASS(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Nodal_Scalar_Constant +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Scalar_Constant +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is scalar, Space + +INTERFACE + MODULE PURE FUNCTION Nodal_Scalar_Space(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Nodal_Scalar_Space +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Scalar_Space +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is scalar, Time + +INTERFACE + MODULE PURE FUNCTION Nodal_Scalar_Time(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Scalar_Time +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Scalar_Time +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is scalar, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Nodal_Scalar_SpaceTime(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Scalar_SpaceTime +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Scalar_SpaceTime +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is vector, Constant + +INTERFACE + MODULE PURE FUNCTION Nodal_Vector_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Nodal_Vector_Constant +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Vector_Constant +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is vector, Space + +INTERFACE + MODULE PURE FUNCTION Nodal_Vector_Space(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Nodal_Vector_Space +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Vector_Space +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is vector, Time + +INTERFACE + MODULE PURE FUNCTION Nodal_Vector_Time(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Vector_Time +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Vector_Time +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is vector, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Nodal_Vector_SpaceTime(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Vector_SpaceTime +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Vector_SpaceTime +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is Matrix, Constant + +INTERFACE + MODULE PURE FUNCTION Nodal_Matrix_Constant(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + END FUNCTION Nodal_Matrix_Constant +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Matrix_Constant +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is Matrix, Space + +INTERFACE + MODULE PURE FUNCTION Nodal_Matrix_Space(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + END FUNCTION Nodal_Matrix_Space +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Matrix_Space +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is Matrix, Time + +INTERFACE + MODULE PURE FUNCTION Nodal_Matrix_Time(val, rank, vartype) RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Matrix_Time +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Matrix_Time +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! NodalVariable@ConstructorMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-10 +! update: 2021-12-10 +! summary: Create nodal variable, which is Matrix, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Nodal_Matrix_SpaceTime(val, rank, vartype) & + & RESULT(obj) + TYPE(FEVariable_) :: obj + REAL(DFP), INTENT(IN) :: val(:, :, :, :) + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + END FUNCTION Nodal_Matrix_SpaceTime +END INTERFACE + +INTERFACE NodalVariable + MODULE PROCEDURE Nodal_Matrix_SpaceTime +END INTERFACE NodalVariable + +!---------------------------------------------------------------------------- +! SIZE@GetMethods +!---------------------------------------------------------------------------- + +INTERFACE + MODULE PURE FUNCTION fevar_Size(obj, Dim) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B), OPTIONAL, INTENT(IN) :: Dim + INTEGER(I4B) :: Ans + END FUNCTION fevar_Size +END INTERFACE + +INTERFACE SIZE + MODULE PROCEDURE fevar_Size +END INTERFACE SIZE + +!---------------------------------------------------------------------------- +! SHAPE@GetMethods +!---------------------------------------------------------------------------- + +INTERFACE + MODULE PURE FUNCTION fevar_Shape(obj) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B), ALLOCATABLE :: Ans(:) + END FUNCTION fevar_Shape +END INTERFACE + +INTERFACE Shape + MODULE PROCEDURE fevar_Shape +END INTERFACE Shape + +!---------------------------------------------------------------------------- +! rank@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-11-27 +! update: 2021-11-27 +! summary: Returns the rank of FEvariable + +INTERFACE + MODULE PURE FUNCTION fevar_rank(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION fevar_rank +END INTERFACE + +INTERFACE OPERATOR(.RANK.) + MODULE PROCEDURE fevar_rank +END INTERFACE OPERATOR(.RANK.) + +!---------------------------------------------------------------------------- +! vartype@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-11-27 +! update: 2021-11-27 +! summary: Returns the vartype of FEvariable + +INTERFACE + MODULE PURE FUNCTION fevar_vartype(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION fevar_vartype +END INTERFACE + +INTERFACE OPERATOR(.vartype.) + MODULE PROCEDURE fevar_vartype +END INTERFACE OPERATOR(.varType.) + +!---------------------------------------------------------------------------- +! defineon@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-11-27 +! update: 2021-11-27 +! summary: Returns the defineon of FEvariable + +INTERFACE + MODULE PURE FUNCTION fevar_defineon(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B) :: ans + END FUNCTION fevar_defineon +END INTERFACE + +INTERFACE OPERATOR(.defineon.) + MODULE PROCEDURE fevar_defineon +END INTERFACE OPERATOR(.defineon.) + +!---------------------------------------------------------------------------- +! isNodalVariable@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-11-27 +! update: 2021-11-27 +! summary: Returns the defineon of FEvariable + +INTERFACE + MODULE PURE FUNCTION fevar_isNodalVariable(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + LOGICAL(LGT) :: ans + END FUNCTION fevar_isNodalVariable +END INTERFACE + +INTERFACE isNodalVariable + MODULE PROCEDURE fevar_isNodalVariable +END INTERFACE isNodalVariable + +!---------------------------------------------------------------------------- +! isQuadratureVariable@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-11-27 +! update: 2021-11-27 +! summary: Returns the defineon of FEvariable + +INTERFACE + MODULE PURE FUNCTION fevar_isQuadratureVariable(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + LOGICAL(LGT) :: ans + END FUNCTION fevar_isQuadratureVariable +END INTERFACE + +INTERFACE isQuadratureVariable + MODULE PROCEDURE fevar_isQuadratureVariable +END INTERFACE isQuadratureVariable + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is scalar, constant + +INTERFACE + MODULE PURE FUNCTION Scalar_Constant(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + REAL(DFP) :: val + END FUNCTION Scalar_Constant +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Scalar_Constant +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is scalar, space + +INTERFACE + MODULE PURE FUNCTION Scalar_Space(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:) + END FUNCTION Scalar_Space +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Scalar_Space +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is scalar, time + +INTERFACE + MODULE PURE FUNCTION Scalar_Time(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:) + END FUNCTION Scalar_Time +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Scalar_Time +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is scalar, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Scalar_SpaceTime(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :) + END FUNCTION Scalar_SpaceTime +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Scalar_SpaceTime +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is vector, constant + +INTERFACE + MODULE PURE FUNCTION Vector_Constant(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:) + END FUNCTION Vector_Constant +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Vector_Constant +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is vector, space + +INTERFACE + MODULE PURE FUNCTION Vector_Space(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :) + END FUNCTION Vector_Space +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Vector_Space +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is vector, time + +INTERFACE + MODULE PURE FUNCTION Vector_Time(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :) + END FUNCTION Vector_Time +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Vector_Time +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is vector, spaceTime + +INTERFACE + MODULE PURE FUNCTION Vector_SpaceTime(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :, :) + END FUNCTION Vector_SpaceTime +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Vector_SpaceTime +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is Matrix, Constant + +INTERFACE + MODULE PURE FUNCTION Matrix_Constant(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :) + END FUNCTION Matrix_Constant +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Matrix_Constant +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is Matrix, Space + +INTERFACE + MODULE PURE FUNCTION Matrix_Space(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :, :) + END FUNCTION Matrix_Space +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Matrix_Space +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is Matrix, Time + +INTERFACE + MODULE PURE FUNCTION Matrix_Time(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :, :) + END FUNCTION Matrix_Time +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Matrix_Time +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Get@GetMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2 Jan 2022 +! summary: Returns value which is Matrix, SpaceTime + +INTERFACE + MODULE PURE FUNCTION Matrix_SpaceTime(obj, rank, vartype) RESULT(val) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), ALLOCATABLE :: val(:, :, :, :) + END FUNCTION Matrix_SpaceTime +END INTERFACE + +INTERFACE Get + MODULE PROCEDURE Matrix_SpaceTime +END INTERFACE Get + +!---------------------------------------------------------------------------- +! Addition@AdditioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Addition1(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Addition1 +END INTERFACE + +INTERFACE OPERATOR(+) + MODULE PROCEDURE fevar_Addition1 +END INTERFACE OPERATOR(+) + +!---------------------------------------------------------------------------- +! Addition@AdditioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + Real + +INTERFACE + MODULE PURE FUNCTION fevar_Addition2(obj1, val) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + REAL(DFP), INTENT(IN) :: val + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Addition2 +END INTERFACE + +INTERFACE OPERATOR(+) + MODULE PROCEDURE fevar_Addition2 +END INTERFACE OPERATOR(+) + +!---------------------------------------------------------------------------- +! Addition@AdditioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = Real + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Addition3(val, obj1) RESULT(Ans) + REAL(DFP), INTENT(IN) :: val + CLASS(FEVariable_), INTENT(IN) :: obj1 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Addition3 +END INTERFACE + +INTERFACE OPERATOR(+) + MODULE PROCEDURE fevar_Addition3 +END INTERFACE OPERATOR(+) + +!---------------------------------------------------------------------------- +! Substraction@SubstractioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable - FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Subtraction1(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Subtraction1 +END INTERFACE + +INTERFACE OPERATOR(-) + MODULE PROCEDURE fevar_Subtraction1 +END INTERFACE OPERATOR(-) + +!---------------------------------------------------------------------------- +! Substraction@SubstractioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable - RealVal + +INTERFACE + MODULE PURE FUNCTION fevar_Subtraction2(obj1, val) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + REAL(DFP), INTENT(IN) :: val + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Subtraction2 +END INTERFACE + +INTERFACE OPERATOR(-) + MODULE PROCEDURE fevar_Subtraction2 +END INTERFACE OPERATOR(-) + +!---------------------------------------------------------------------------- +! Substraction@SubstractioMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = RealVal - FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Subtraction3(val, obj1) RESULT(Ans) + REAL(DFP), INTENT(IN) :: val + CLASS(FEVariable_), INTENT(IN) :: obj1 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Subtraction3 +END INTERFACE + +INTERFACE OPERATOR(-) + MODULE PROCEDURE fevar_Subtraction3 +END INTERFACE OPERATOR(-) + +!---------------------------------------------------------------------------- +! Multiplication@MultiplicationMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-1 +! summary: FEVariable = FEVariable * FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Multiplication1(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Multiplication1 +END INTERFACE + +INTERFACE OPERATOR(*) + MODULE PROCEDURE fevar_Multiplication1 +END INTERFACE OPERATOR(*) + +!---------------------------------------------------------------------------- +! Multiplication@MultiplicationMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable * Real + +INTERFACE + MODULE PURE FUNCTION fevar_Multiplication2(obj1, val) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + REAL(DFP), INTENT(IN) :: val + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Multiplication2 +END INTERFACE + +INTERFACE OPERATOR(*) + MODULE PROCEDURE fevar_Multiplication2 +END INTERFACE OPERATOR(*) + +!---------------------------------------------------------------------------- +! Multiplication@MultiplicationMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = Real * FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Multiplication3(val, obj1) RESULT(Ans) + REAL(DFP), INTENT(IN) :: val + CLASS(FEVariable_), INTENT(IN) :: obj1 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Multiplication3 +END INTERFACE + +INTERFACE OPERATOR(*) + MODULE PROCEDURE fevar_Multiplication3 +END INTERFACE OPERATOR(*) + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_abs(obj) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariable_) :: ans + END FUNCTION fevar_abs +END INTERFACE + +INTERFACE ABS + MODULE PROCEDURE fevar_abs +END INTERFACE ABS + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_dot_product(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_dot_product +END INTERFACE + +INTERFACE DOT_PRODUCT + MODULE PROCEDURE fevar_dot_product +END INTERFACE DOT_PRODUCT + +!---------------------------------------------------------------------------- +! Division@DivisionMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable - FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Division1(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Division1 +END INTERFACE + +INTERFACE OPERATOR(/) + MODULE PROCEDURE fevar_Division1 +END INTERFACE OPERATOR(/) + +!---------------------------------------------------------------------------- +! Division@DivisionMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable - Real + +INTERFACE + MODULE PURE FUNCTION fevar_Division2(obj1, val) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + REAL(DFP), INTENT(IN) :: val + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Division2 +END INTERFACE + +INTERFACE OPERATOR(/) + MODULE PROCEDURE fevar_Division2 +END INTERFACE OPERATOR(/) + +!---------------------------------------------------------------------------- +! Division@DivisionMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = Real - FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_Division3(val, obj1) RESULT(Ans) + REAL(DFP), INTENT(IN) :: val + CLASS(FEVariable_), INTENT(IN) :: obj1 + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Division3 +END INTERFACE + +INTERFACE OPERATOR(/) + MODULE PROCEDURE fevar_Division3 +END INTERFACE OPERATOR(/) + +!---------------------------------------------------------------------------- +! Power@PowerMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_power(obj, n) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + INTEGER(I4B), INTENT(IN) :: n + TYPE(FEVariable_) :: ans + END FUNCTION fevar_power +END INTERFACE + +INTERFACE OPERATOR(**) + MODULE PROCEDURE fevar_power +END INTERFACE OPERATOR(**) + +!---------------------------------------------------------------------------- +! Power@PowerMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = FEVariable + FEVariable + +INTERFACE + MODULE PURE FUNCTION fevar_sqrt(obj) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariable_) :: ans + END FUNCTION fevar_sqrt +END INTERFACE + +INTERFACE SQRT + MODULE PROCEDURE fevar_sqrt +END INTERFACE SQRT + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = NORM2(FEVariable) + +INTERFACE + MODULE PURE FUNCTION fevar_norm2(obj) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariable_) :: ans + END FUNCTION fevar_norm2 +END INTERFACE + +INTERFACE NORM2 + MODULE PROCEDURE fevar_norm2 +END INTERFACE NORM2 + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = NORM2(FEVariable) + +INTERFACE + MODULE PURE FUNCTION fevar_isEqual(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + LOGICAL(LGT) :: ans + END FUNCTION fevar_isEqual +END INTERFACE + +INTERFACE OPERATOR(.EQ.) + MODULE PROCEDURE fevar_isEqual +END INTERFACE OPERATOR(.EQ.) + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2021-12-12 +! update: 2021-12-12 +! summary: FEVariable = NORM2(FEVariable) + +INTERFACE + MODULE PURE FUNCTION fevar_notEqual(obj1, obj2) RESULT(Ans) + CLASS(FEVariable_), INTENT(IN) :: obj1 + CLASS(FEVariable_), INTENT(IN) :: obj2 + LOGICAL(LGT) :: ans + END FUNCTION fevar_notEqual +END INTERFACE + +INTERFACE OPERATOR(.NE.) + MODULE PROCEDURE fevar_notEqual +END INTERFACE OPERATOR(.NE.) + +!---------------------------------------------------------------------------- +! MEAN@MeanMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 27 May 2022 +! summary: FEVariable = Mean( obj ) + +INTERFACE + MODULE PURE FUNCTION fevar_Mean1(obj) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariable_) :: ans + END FUNCTION fevar_Mean1 +END INTERFACE + +INTERFACE MEAN + MODULE PROCEDURE fevar_Mean1 +END INTERFACE MEAN + +!---------------------------------------------------------------------------- +! MEAN@MeanMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 27 May 2022 +! summary: FEVariable = Mean( obj ) + +INTERFACE + MODULE PURE FUNCTION fevar_Mean2(obj, dataType) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: dataType + REAL(DFP) :: ans + END FUNCTION fevar_Mean2 +END INTERFACE + +INTERFACE MEAN + MODULE PROCEDURE fevar_Mean2 +END INTERFACE MEAN + +!---------------------------------------------------------------------------- +! MEAN@MeanMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 27 May 2022 +! summary: FEVariable = Mean( obj ) + +INTERFACE + MODULE PURE FUNCTION fevar_Mean3(obj, dataType) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: dataType + REAL(DFP), ALLOCATABLE :: ans(:) + END FUNCTION fevar_Mean3 +END INTERFACE + +INTERFACE MEAN + MODULE PROCEDURE fevar_Mean3 +END INTERFACE MEAN + +!---------------------------------------------------------------------------- +! MEAN@MeanMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 27 May 2022 +! summary: FEVariable = Mean( obj ) + +INTERFACE + MODULE PURE FUNCTION fevar_Mean4(obj, dataType) RESULT(ans) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: dataType + REAL(DFP), ALLOCATABLE :: ans(:, :) + END FUNCTION fevar_Mean4 +END INTERFACE + +INTERFACE MEAN + MODULE PROCEDURE fevar_Mean4 +END INTERFACE MEAN + END MODULE FEVariable_Method diff --git a/src/modules/FEVariable/src/GetMethods.inc b/src/modules/FEVariable/src/GetMethods.inc deleted file mode 100644 index 54d01d242..000000000 --- a/src/modules/FEVariable/src/GetMethods.inc +++ /dev/null @@ -1,408 +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 -! - -PUBLIC :: SIZE -PUBLIC :: SHAPE -PUBLIC :: OPERATOR(.RANK.) -PUBLIC :: OPERATOR(.vartype.) -PUBLIC :: OPERATOR(.defineon.) -PUBLIC :: isNodalVariable -PUBLIC :: isQuadratureVariable -PUBLIC :: Get - -!---------------------------------------------------------------------------- -! SIZE@GetMethods -!---------------------------------------------------------------------------- - -INTERFACE - MODULE PURE FUNCTION fevar_Size(obj, Dim) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B), OPTIONAL, INTENT(IN) :: Dim - INTEGER(I4B) :: Ans - END FUNCTION fevar_Size -END INTERFACE - -INTERFACE SIZE - MODULE PROCEDURE fevar_Size -END INTERFACE SIZE - -!---------------------------------------------------------------------------- -! SHAPE@GetMethods -!---------------------------------------------------------------------------- - -INTERFACE - MODULE PURE FUNCTION fevar_Shape(obj) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B), ALLOCATABLE :: Ans(:) - END FUNCTION fevar_Shape -END INTERFACE - -INTERFACE Shape - MODULE PROCEDURE fevar_Shape -END INTERFACE Shape - -!---------------------------------------------------------------------------- -! rank@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-11-27 -! update: 2021-11-27 -! summary: Returns the rank of FEvariable - -INTERFACE - MODULE PURE FUNCTION fevar_rank(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B) :: ans - END FUNCTION fevar_rank -END INTERFACE - -INTERFACE OPERATOR(.RANK.) - MODULE PROCEDURE fevar_rank -END INTERFACE OPERATOR(.RANK.) - -!---------------------------------------------------------------------------- -! vartype@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-11-27 -! update: 2021-11-27 -! summary: Returns the vartype of FEvariable - -INTERFACE - MODULE PURE FUNCTION fevar_vartype(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B) :: ans - END FUNCTION fevar_vartype -END INTERFACE - -INTERFACE OPERATOR(.vartype.) - MODULE PROCEDURE fevar_vartype -END INTERFACE OPERATOR(.varType.) - -!---------------------------------------------------------------------------- -! defineon@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-11-27 -! update: 2021-11-27 -! summary: Returns the defineon of FEvariable - -INTERFACE - MODULE PURE FUNCTION fevar_defineon(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B) :: ans - END FUNCTION fevar_defineon -END INTERFACE - -INTERFACE OPERATOR(.defineon.) - MODULE PROCEDURE fevar_defineon -END INTERFACE OPERATOR(.defineon.) - -!---------------------------------------------------------------------------- -! isNodalVariable@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-11-27 -! update: 2021-11-27 -! summary: Returns the defineon of FEvariable - -INTERFACE - MODULE PURE FUNCTION fevar_isNodalVariable(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - LOGICAL(LGT) :: ans - END FUNCTION fevar_isNodalVariable -END INTERFACE - -INTERFACE isNodalVariable - MODULE PROCEDURE fevar_isNodalVariable -END INTERFACE isNodalVariable - -!---------------------------------------------------------------------------- -! isQuadratureVariable@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-11-27 -! update: 2021-11-27 -! summary: Returns the defineon of FEvariable - -INTERFACE - MODULE PURE FUNCTION fevar_isQuadratureVariable(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - LOGICAL(LGT) :: ans - END FUNCTION fevar_isQuadratureVariable -END INTERFACE - -INTERFACE isQuadratureVariable - MODULE PROCEDURE fevar_isQuadratureVariable -END INTERFACE isQuadratureVariable - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is scalar, constant - -INTERFACE - MODULE PURE FUNCTION Scalar_Constant(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - REAL(DFP) :: val - END FUNCTION Scalar_Constant -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Scalar_Constant -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is scalar, space - -INTERFACE - MODULE PURE FUNCTION Scalar_Space(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:) - END FUNCTION Scalar_Space -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Scalar_Space -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is scalar, time - -INTERFACE - MODULE PURE FUNCTION Scalar_Time(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:) - END FUNCTION Scalar_Time -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Scalar_Time -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is scalar, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Scalar_SpaceTime(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :) - END FUNCTION Scalar_SpaceTime -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Scalar_SpaceTime -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is vector, constant - -INTERFACE - MODULE PURE FUNCTION Vector_Constant(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:) - END FUNCTION Vector_Constant -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Vector_Constant -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is vector, space - -INTERFACE - MODULE PURE FUNCTION Vector_Space(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :) - END FUNCTION Vector_Space -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Vector_Space -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is vector, time - -INTERFACE - MODULE PURE FUNCTION Vector_Time(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :) - END FUNCTION Vector_Time -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Vector_Time -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is vector, spaceTime - -INTERFACE - MODULE PURE FUNCTION Vector_SpaceTime(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :, :) - END FUNCTION Vector_SpaceTime -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Vector_SpaceTime -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is Matrix, Constant - -INTERFACE - MODULE PURE FUNCTION Matrix_Constant(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :) - END FUNCTION Matrix_Constant -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Matrix_Constant -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is Matrix, Space - -INTERFACE - MODULE PURE FUNCTION Matrix_Space(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :, :) - END FUNCTION Matrix_Space -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Matrix_Space -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is Matrix, Time - -INTERFACE - MODULE PURE FUNCTION Matrix_Time(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :, :) - END FUNCTION Matrix_Time -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Matrix_Time -END INTERFACE Get - -!---------------------------------------------------------------------------- -! Get@GetMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2 Jan 2022 -! summary: Returns value which is Matrix, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Matrix_SpaceTime(obj, rank, vartype) RESULT(val) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - REAL(DFP), ALLOCATABLE :: val(:, :, :, :) - END FUNCTION Matrix_SpaceTime -END INTERFACE - -INTERFACE Get - MODULE PROCEDURE Matrix_SpaceTime -END INTERFACE Get \ No newline at end of file diff --git a/src/modules/FEVariable/src/IOMethods.inc b/src/modules/FEVariable/src/IOMethods.inc deleted file mode 100644 index 2839d2491..000000000 --- a/src/modules/FEVariable/src/IOMethods.inc +++ /dev/null @@ -1,39 +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 -! - -PUBLIC :: Display - -!---------------------------------------------------------------------------- -! Display@IOMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Displays the content of [[FEVariable_]] - -INTERFACE - MODULE SUBROUTINE fevar_Display(obj, Msg, UnitNo) - TYPE(FEVariable_), INTENT(IN) :: obj - CHARACTER(LEN=*), INTENT(IN) :: Msg - INTEGER(I4B), OPTIONAL, INTENT(IN) :: UnitNo - END SUBROUTINE fevar_Display -END INTERFACE - -INTERFACE Display - MODULE PROCEDURE fevar_Display -END INTERFACE Display diff --git a/src/modules/FEVariable/src/Mean.inc b/src/modules/FEVariable/src/Mean.inc deleted file mode 100644 index 48e5d3670..000000000 --- a/src/modules/FEVariable/src/Mean.inc +++ /dev/null @@ -1,98 +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 -! - -PUBLIC :: MEAN - -!---------------------------------------------------------------------------- -! MEAN@MeanMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 May 2022 -! summary: FEVariable = Mean( obj ) - -INTERFACE - MODULE PURE FUNCTION fevar_Mean1(obj) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Mean1 -END INTERFACE - -INTERFACE MEAN - MODULE PROCEDURE fevar_Mean1 -END INTERFACE MEAN - -!---------------------------------------------------------------------------- -! MEAN@MeanMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 May 2022 -! summary: FEVariable = Mean( obj ) - -INTERFACE - MODULE PURE FUNCTION fevar_Mean2(obj, dataType) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableScalar_), INTENT( IN ) :: dataType - REAL(DFP) :: ans - END FUNCTION fevar_Mean2 -END INTERFACE - -INTERFACE MEAN - MODULE PROCEDURE fevar_Mean2 -END INTERFACE MEAN - -!---------------------------------------------------------------------------- -! MEAN@MeanMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 May 2022 -! summary: FEVariable = Mean( obj ) - -INTERFACE - MODULE PURE FUNCTION fevar_Mean3(obj, dataType) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableVector_), INTENT( IN ) :: dataType - REAL(DFP), ALLOCATABLE :: ans( : ) - END FUNCTION fevar_Mean3 -END INTERFACE - -INTERFACE MEAN - MODULE PROCEDURE fevar_Mean3 -END INTERFACE MEAN - -!---------------------------------------------------------------------------- -! MEAN@MeanMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 27 May 2022 -! summary: FEVariable = Mean( obj ) - -INTERFACE - MODULE PURE FUNCTION fevar_Mean4(obj, dataType) RESULT(ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariableMatrix_), INTENT( IN ) :: dataType - REAL(DFP), ALLOCATABLE :: ans( :, : ) - END FUNCTION fevar_Mean4 -END INTERFACE - -INTERFACE MEAN - MODULE PROCEDURE fevar_Mean4 -END INTERFACE MEAN - diff --git a/src/modules/FEVariable/src/Multiplication.inc b/src/modules/FEVariable/src/Multiplication.inc deleted file mode 100644 index fc0dca199..000000000 --- a/src/modules/FEVariable/src/Multiplication.inc +++ /dev/null @@ -1,81 +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 -! - -!---------------------------------------------------------------------------- -! Multiplication@MultiplicationMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-1 -! summary: FEVariable = FEVariable * FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Multiplication1(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Multiplication1 -END INTERFACE - -INTERFACE OPERATOR(*) - MODULE PROCEDURE fevar_Multiplication1 -END INTERFACE OPERATOR(*) - -PUBLIC :: OPERATOR(*) - -!---------------------------------------------------------------------------- -! Multiplication@MultiplicationMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable * Real - -INTERFACE - MODULE PURE FUNCTION fevar_Multiplication2(obj1,val) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - REAL(DFP), INTENT(IN) :: val - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Multiplication2 -END INTERFACE - -INTERFACE OPERATOR(*) - MODULE PROCEDURE fevar_Multiplication2 -END INTERFACE OPERATOR(*) - -!---------------------------------------------------------------------------- -! Multiplication@MultiplicationMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = Real * FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Multiplication3(val, obj1) RESULT(Ans) - REAL(DFP), INTENT(IN) :: val - CLASS(FEVariable_), INTENT(IN) :: obj1 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Multiplication3 -END INTERFACE - -INTERFACE OPERATOR(*) - MODULE PROCEDURE fevar_Multiplication3 -END INTERFACE OPERATOR(*) \ No newline at end of file diff --git a/src/modules/FEVariable/src/NORM2.inc b/src/modules/FEVariable/src/NORM2.inc deleted file mode 100644 index bc419026f..000000000 --- a/src/modules/FEVariable/src/NORM2.inc +++ /dev/null @@ -1,34 +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 -! - -PUBLIC :: NORM2 - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = NORM2(FEVariable) - -INTERFACE - MODULE PURE FUNCTION fevar_norm2(obj) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariable_) :: ans - END FUNCTION fevar_norm2 -END INTERFACE - -INTERFACE NORM2 - MODULE PROCEDURE fevar_norm2 -END INTERFACE NORM2 diff --git a/src/modules/FEVariable/src/NodalConstructorMethods.inc b/src/modules/FEVariable/src/NodalConstructorMethods.inc deleted file mode 100644 index 5b40a6fbf..000000000 --- a/src/modules/FEVariable/src/NodalConstructorMethods.inc +++ /dev/null @@ -1,310 +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 -! - -PUBLIC :: DEALLOCATE -PUBLIC :: NodalVariable - -!---------------------------------------------------------------------------- -! Deallocate@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Deallocates the content of FEVariable - -INTERFACE - MODULE PURE SUBROUTINE fevar_Deallocate(obj) - TYPE(FEVariable_), INTENT(INOUT) :: obj - END SUBROUTINE fevar_Deallocate -END INTERFACE - -INTERFACE DEALLOCATE - MODULE PROCEDURE fevar_Deallocate -END INTERFACE DEALLOCATE - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is scalar, constant - -INTERFACE - MODULE PURE FUNCTION Nodal_Scalar_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val - CLASS(FEVariableScalar_), INTENT(IN) :: rank - CLASS(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Nodal_Scalar_Constant -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Scalar_Constant -END INTERFACE NodalVariable - - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is scalar, Space - -INTERFACE - MODULE PURE FUNCTION Nodal_Scalar_Space(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Nodal_Scalar_Space -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Scalar_Space -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is scalar, Time - -INTERFACE - MODULE PURE FUNCTION Nodal_Scalar_Time(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Scalar_Time -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Scalar_Time -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is scalar, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Nodal_Scalar_SpaceTime(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Scalar_SpaceTime -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Scalar_SpaceTime -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is vector, Constant - -INTERFACE - MODULE PURE FUNCTION Nodal_Vector_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Nodal_Vector_Constant -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Vector_Constant -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is vector, Space - -INTERFACE - MODULE PURE FUNCTION Nodal_Vector_Space(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Nodal_Vector_Space -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Vector_Space -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is vector, Time - -INTERFACE - MODULE PURE FUNCTION Nodal_Vector_Time(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Vector_Time -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Vector_Time -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is vector, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Nodal_Vector_SpaceTime(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Vector_SpaceTime -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Vector_SpaceTime -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is Matrix, Constant - -INTERFACE - MODULE PURE FUNCTION Nodal_Matrix_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Nodal_Matrix_Constant -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Matrix_Constant -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is Matrix, Space - -INTERFACE - MODULE PURE FUNCTION Nodal_Matrix_Space(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Nodal_Matrix_Space -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Matrix_Space -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is Matrix, Time - -INTERFACE - MODULE PURE FUNCTION Nodal_Matrix_Time(val, rank, vartype) RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Matrix_Time -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Matrix_Time -END INTERFACE NodalVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create nodal variable, which is Matrix, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Nodal_Matrix_SpaceTime(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Nodal_Matrix_SpaceTime -END INTERFACE - -INTERFACE NodalVariable - MODULE PROCEDURE Nodal_Matrix_SpaceTime -END INTERFACE NodalVariable diff --git a/src/modules/FEVariable/src/Power.inc b/src/modules/FEVariable/src/Power.inc deleted file mode 100644 index 012ec2cb7..000000000 --- a/src/modules/FEVariable/src/Power.inc +++ /dev/null @@ -1,39 +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 -! - -PUBLIC :: OPERATOR(**) - -!---------------------------------------------------------------------------- -! Power@PowerMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_power(obj, n) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - INTEGER(I4B), INTENT( IN ) :: n - TYPE(FEVariable_) :: ans - END FUNCTION fevar_power -END INTERFACE - -INTERFACE OPERATOR(**) - MODULE PROCEDURE fevar_power -END INTERFACE OPERATOR(**) diff --git a/src/modules/FEVariable/src/QuadratureConstructorMethods.inc b/src/modules/FEVariable/src/QuadratureConstructorMethods.inc deleted file mode 100644 index d89506f81..000000000 --- a/src/modules/FEVariable/src/QuadratureConstructorMethods.inc +++ /dev/null @@ -1,295 +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 -! - -PUBLIC :: QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Scalar, Constant - -INTERFACE - MODULE PURE FUNCTION Quadrature_Scalar_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Scalar_Constant -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Scalar_Constant -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Scalar, Space - -INTERFACE - MODULE PURE FUNCTION Quadrature_Scalar_Space(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Scalar_Space -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Scalar_Space -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Scalar, Time - -INTERFACE - MODULE PURE FUNCTION Quadrature_Scalar_Time(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Scalar_Time -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Scalar_Time -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Scalar, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Quadrature_Scalar_SpaceTime(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableScalar_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Scalar_SpaceTime -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Scalar_SpaceTime -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! NodalVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Vector, Constant - -INTERFACE - MODULE PURE FUNCTION Quadrature_Vector_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Vector_Constant -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Vector_Constant -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Vector, Space - -INTERFACE - MODULE PURE FUNCTION Quadrature_Vector_Space(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Vector_Space -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Vector_Space -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Vector, Time - -INTERFACE - MODULE PURE FUNCTION Quadrature_Vector_Time(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Vector_Time -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Vector_Time -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Vector, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Quadrature_Vector_SpaceTime(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableVector_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Vector_SpaceTime -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Vector_SpaceTime -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Matrix, Constant - -INTERFACE - MODULE PURE FUNCTION Quadrature_Matrix_Constant(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableConstant_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Matrix_Constant -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Matrix_Constant -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Matrix, Space - -INTERFACE - MODULE PURE FUNCTION Quadrature_Matrix_Space(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpace_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Matrix_Space -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Matrix_Space -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Matrix, Time - -INTERFACE - MODULE PURE FUNCTION Quadrature_Matrix_Time(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Matrix_Time -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Matrix_Time -END INTERFACE QuadratureVariable - -!---------------------------------------------------------------------------- -! QuadratureVariable@ConstructorMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-10 -! update: 2021-12-10 -! summary: Create quadrature variable, which is Matrix, SpaceTime - -INTERFACE - MODULE PURE FUNCTION Quadrature_Matrix_SpaceTime(val, rank, vartype) & - & RESULT(obj) - TYPE(FEVariable_) :: obj - REAL(DFP), INTENT(IN) :: val(:, :, :, :) - TYPE(FEVariableMatrix_), INTENT(IN) :: rank - TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype - END FUNCTION Quadrature_Matrix_SpaceTime -END INTERFACE - -INTERFACE QuadratureVariable - MODULE PROCEDURE Quadrature_Matrix_SpaceTime -END INTERFACE QuadratureVariable \ No newline at end of file diff --git a/src/modules/FEVariable/src/SQRT.inc b/src/modules/FEVariable/src/SQRT.inc deleted file mode 100644 index 5a1dbfc48..000000000 --- a/src/modules/FEVariable/src/SQRT.inc +++ /dev/null @@ -1,38 +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 -! - -PUBLIC :: SQRT - -!---------------------------------------------------------------------------- -! Power@PowerMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable + FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_sqrt(obj) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj - TYPE(FEVariable_) :: ans - END FUNCTION fevar_sqrt -END INTERFACE - -INTERFACE SQRT - MODULE PROCEDURE fevar_sqrt -END INTERFACE SQRT diff --git a/src/modules/FEVariable/src/Subtraction.inc b/src/modules/FEVariable/src/Subtraction.inc deleted file mode 100644 index c13d3b4ae..000000000 --- a/src/modules/FEVariable/src/Subtraction.inc +++ /dev/null @@ -1,81 +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 -! - -PUBLIC :: OPERATOR(-) - -!---------------------------------------------------------------------------- -! Substraction@SubstractioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable - FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Subtraction1(obj1, obj2) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - CLASS(FEVariable_), INTENT(IN) :: obj2 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Subtraction1 -END INTERFACE - -INTERFACE OPERATOR(-) - MODULE PROCEDURE fevar_Subtraction1 -END INTERFACE OPERATOR(-) - -!---------------------------------------------------------------------------- -! Substraction@SubstractioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = FEVariable - RealVal - -INTERFACE - MODULE PURE FUNCTION fevar_Subtraction2(obj1, val) RESULT(Ans) - CLASS(FEVariable_), INTENT(IN) :: obj1 - REAL(DFP), INTENT(IN) :: val - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Subtraction2 -END INTERFACE - -INTERFACE OPERATOR(-) - MODULE PROCEDURE fevar_Subtraction2 -END INTERFACE OPERATOR(-) - -!---------------------------------------------------------------------------- -! Substraction@SubstractioMethods -!---------------------------------------------------------------------------- - -!> author: Vikas Sharma, Ph. D. -! date: 2021-12-12 -! update: 2021-12-12 -! summary: FEVariable = RealVal - FEVariable - -INTERFACE - MODULE PURE FUNCTION fevar_Subtraction3(val, obj1) RESULT(Ans) - REAL(DFP), INTENT(IN) :: val - CLASS(FEVariable_), INTENT(IN) :: obj1 - TYPE(FEVariable_) :: ans - END FUNCTION fevar_Subtraction3 -END INTERFACE - -INTERFACE OPERATOR(-) - MODULE PROCEDURE fevar_Subtraction3 -END INTERFACE OPERATOR(-) diff --git a/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 b/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 index cc6bde8ed..8ed395d29 100644 --- a/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 +++ b/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 @@ -154,7 +154,7 @@ MODULE FUNCTION InterpolationPoint(order, elemType, ipType, & !! line = [-1,1] !! triangle = (0,0), (0,1), (1,0) !! quadrangle = [-1,1]x[-1,1] - CHARACTER(LEN=*), INTENT(IN) :: layout + CHARACTER(*), INTENT(IN) :: layout !! "VEFC" Vertex, Edge, Face, Cell !! "INCREASING" incresing order !! "DECREASING" decreasing order From 40e70949f6cb1dbd0228588e2781fc844d85049a Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:30:26 +0900 Subject: [PATCH 02/16] Minor formating in ErrorHandling.F90 --- .../ErrorHandling/src/ErrorHandling.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/modules/ErrorHandling/src/ErrorHandling.F90 b/src/modules/ErrorHandling/src/ErrorHandling.F90 index 23389ff5b..505e502e9 100644 --- a/src/modules/ErrorHandling/src/ErrorHandling.F90 +++ b/src/modules/ErrorHandling/src/ErrorHandling.F90 @@ -46,11 +46,11 @@ MODULE ErrorHandling ! ``` SUBROUTINE Errormsg(msg, file, routine, line, unitno) - CHARACTER(LEN=*), INTENT(IN) :: msg + CHARACTER(*), INTENT(IN) :: msg !! Message - CHARACTER(LEN=*), INTENT(IN) :: file + CHARACTER(*), INTENT(IN) :: file !! Name of the file - CHARACTER(LEN=*), INTENT(IN) :: routine + CHARACTER(*), INTENT(IN) :: routine !! Name of the routine where error has occured INTEGER(I4B), INTENT(IN) :: line !! line number where error has occured @@ -76,11 +76,11 @@ END SUBROUTINE Errormsg SUBROUTINE Warningmsg(msg, file, routine, line, unitno) !! This subroutine prints the warning message - CHARACTER(LEN=*), INTENT(IN) :: msg + CHARACTER(*), INTENT(IN) :: msg !! Message - CHARACTER(LEN=*), INTENT(IN) :: file + CHARACTER(*), INTENT(IN) :: file !! Name of the file - CHARACTER(LEN=*), INTENT(IN) :: routine + CHARACTER(*), INTENT(IN) :: routine !! Name of the routine where error has occured INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno !! file id to write the message to @@ -108,19 +108,19 @@ SUBROUTINE fileError(istat, filename, flg, unitno, file, routine, line) ! Dummy argumnet INTEGER(I4B), INTENT(IN) :: istat !! Result of iostat=istat for open,read,write,close - CHARACTER(len=*), INTENT(IN) :: filename + CHARACTER(*), INTENT(IN) :: filename !! Name of the file (IO related) INTEGER(I4B), INTENT(IN) :: flg !! IO_OPEN=Open, IO_READ=Read, IO_WRITE=Write, IO_CLOSE=Close INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno !! file id to write the error to - CHARACTER(LEN=*), INTENT(IN) :: file, routine + CHARACTER(*), INTENT(IN) :: file, routine !! Name of the source code file and routine name INTEGER(I4B), INTENT(IN) :: line !! line number !! ! Define internal variables - CHARACTER(len=:), allocatable :: Amsg + CHARACTER(:), ALLOCATABLE :: Amsg !! ! Return if no error IF (istat == 0) THEN @@ -163,18 +163,18 @@ END SUBROUTINE fileError SUBROUTINE AllocationErr(istat, amsg, alloc, unitno, file, routine, line) INTEGER(I4B), INTENT(IN) :: istat !! results of stat=istat in (de)allocate - CHARACTER(LEN=*), INTENT(IN) :: amsg + CHARACTER(*), INTENT(IN) :: amsg !! Message associated with the (de)allocate INTEGER(I4B), INTENT(IN) :: alloc !! For OPT_ALLOC = allocate, for OPT_DEALLOC = deallocate INTEGER(I4B), OPTIONAL, INTENT(IN) :: unitno !! Optional file id to write the message to - CHARACTER(LEN=*), INTENT(IN) :: file, routine + CHARACTER(*), INTENT(IN) :: file, routine !! filename and routine name INTEGER(I4B), INTENT(IN) :: line !! ! Define internal variables - CHARACTER(LEN=:), ALLOCATABLE :: tmp + CHARACTER(:), ALLOCATABLE :: tmp !! IF (istat == 0) RETURN !! From 640dfc41329d8bdc3bb5b1a92a58a14bda2e0768 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:33:07 +0900 Subject: [PATCH 03/16] Minor formating in ErrorMessages.F90 --- src/modules/FPL/src/ErrorMessages.F90 | 145 +++++++++++++------------- 1 file changed, 75 insertions(+), 70 deletions(-) diff --git a/src/modules/FPL/src/ErrorMessages.F90 b/src/modules/FPL/src/ErrorMessages.F90 index 6236d06e7..b01db881a 100644 --- a/src/modules/FPL/src/ErrorMessages.F90 +++ b/src/modules/FPL/src/ErrorMessages.F90 @@ -22,97 +22,102 @@ MODULE ErrorMessages USE ISO_FORTRAN_ENV, ONLY: OUTPUT_UNIT, ERROR_UNIT USE PENF, ONLY: I4P, str -IMPLICIT none +IMPLICIT NONE PRIVATE -integer(I4P), public, parameter :: FPLSuccess = 0 -integer(I4P), public, parameter :: FPLWrapperFactoryError = -1 -integer(I4P), public, parameter :: FPLWrapperError = -2 -integer(I4P), public, parameter :: FPLSublistError = -3 -integer(I4P), public, parameter :: FPLParameterListIteratorError = -4 +INTEGER(I4P), PUBLIC, PARAMETER :: FPLSuccess = 0 +INTEGER(I4P), PUBLIC, PARAMETER :: FPLWrapperFactoryError = -1 +INTEGER(I4P), PUBLIC, PARAMETER :: FPLWrapperError = -2 +INTEGER(I4P), PUBLIC, PARAMETER :: FPLSublistError = -3 +INTEGER(I4P), PUBLIC, PARAMETER :: FPLParameterListIteratorError = -4 -type :: MessageHandler_t - private - character(len=5) :: prefix = '[FPL]' -contains - procedure, non_overridable :: Print => MessageHandler_Print - procedure, non_overridable :: Warn => MessageHandler_Warn - procedure, non_overridable :: Error => MessageHandler_Error -end type +TYPE :: MessageHandler_t + PRIVATE + CHARACTER(5) :: prefix = '[FPL]' +CONTAINS + PROCEDURE, NON_OVERRIDABLE :: PRINT => MessageHandler_Print + PROCEDURE, NON_OVERRIDABLE :: Warn => MessageHandler_Warn + PROCEDURE, NON_OVERRIDABLE :: Error => MessageHandler_Error +END TYPE -type(MessageHandler_t), save :: msg +TYPE(MessageHandler_t), SAVE :: msg !$OMP THREADPRIVATE(msg) -public :: msg +PUBLIC :: msg -contains +CONTAINS -subroutine MessageHandler_Print(this, txt, unit, iostat, iomsg) +SUBROUTINE MessageHandler_Print(this, txt, unit, iostat, iomsg) !----------------------------------------------------------------- !< Print a txt message preceding for prefix !----------------------------------------------------------------- - class(MessageHandler_t), intent(IN) :: this !< Message handler - character(len=*), intent(IN) :: txt !< Text to print - integer(I4P), optional, intent(IN) :: unit !< Unit where to print - integer(I4P), optional, intent(OUT) :: iostat !< IO error. - character(*), optional, intent(OUT) :: iomsg !< IO error message. - integer(I4P) :: iostatd !< Real IO error. - integer(I4P) :: u !< Real unit - character(500) :: iomsgd !< Real IO error message. + CLASS(MessageHandler_t), INTENT(IN) :: this !< Message handler + CHARACTER(*), INTENT(IN) :: txt !< Text to print + INTEGER(I4P), OPTIONAL, INTENT(IN) :: unit !< Unit where to print + INTEGER(I4P), OPTIONAL, INTENT(OUT) :: iostat !< IO error. + CHARACTER(*), OPTIONAL, INTENT(OUT) :: iomsg !< IO error message. + INTEGER(I4P) :: iostatd !< Real IO error. + INTEGER(I4P) :: u !< Real unit + CHARACTER(500) :: iomsgd !< Real IO error message. !----------------------------------------------------------------- - u = OUTPUT_UNIT; if (present(unit)) u = unit; iostatd = 0; iomsgd = '' - write (unit=u, fmt='(A)', iostat=iostatd, iomsg=iomsgd) this%Prefix//' '//txt - if (present(iostat)) iostat = iostatd - if (present(iomsg)) iomsg = iomsgd -end subroutine + u = OUTPUT_UNIT; IF (PRESENT(unit)) u = unit; iostatd = 0; + iomsgd = '' + WRITE (unit=u, fmt='(A)', iostat=iostatd, iomsg=iomsgd) & + & this%Prefix//' '//txt + IF (PRESENT(iostat)) iostat = iostatd + IF (PRESENT(iomsg)) iomsg = iomsgd +END SUBROUTINE -subroutine MessageHandler_Warn(this, txt, unit, file, line, iostat, iomsg) +SUBROUTINE MessageHandler_Warn(this, txt, unit, file, line, iostat, iomsg) !----------------------------------------------------------------- !< Warn a with txt message preceding for WARNING! !----------------------------------------------------------------- - class(MessageHandler_t), intent(IN) :: this !< Message handler - character(len=*), intent(IN) :: txt !< Text to print - integer(I4P), optional, intent(IN) :: unit !< Unit where to print - character(*), optional, intent(IN) :: file !< Source file - integer(I4P), optional, intent(IN) :: line !< Number of line in source file - integer(I4P), optional, intent(OUT) :: iostat !< IO error. - character(*), optional, intent(OUT) :: iomsg !< IO error message. - character(len=:), allocatable :: loc !< Warning location string - integer(I4P) :: iostatd !< Real IO error. - integer(I4P) :: u !< Real unit - character(500) :: iomsgd !< Real IO error message. + CLASS(MessageHandler_t), INTENT(IN) :: this !< Message handler + CHARACTER(*), INTENT(IN) :: txt !< Text to print + INTEGER(I4P), OPTIONAL, INTENT(IN) :: unit !< Unit where to print + CHARACTER(*), OPTIONAL, INTENT(IN) :: file !< Source file + INTEGER(I4P), OPTIONAL, INTENT(IN) :: line !< Number of line in source file + INTEGER(I4P), OPTIONAL, INTENT(OUT) :: iostat !< IO error. + CHARACTER(*), OPTIONAL, INTENT(OUT) :: iomsg !< IO error message. + CHARACTER(:), ALLOCATABLE :: loc !< Warning location string + INTEGER(I4P) :: iostatd !< Real IO error. + INTEGER(I4P) :: u !< Real unit + CHARACTER(500) :: iomsgd !< Real IO error message. !----------------------------------------------------------------- - u = ERROR_UNIT; if (present(unit)) u = unit; iostatd = 0; iomsgd = ''; loc = '' - if (present(file) .and. present(line)) & - loc = '('//file//':'//trim(str(no_sign=.true., n=line))//') ' - call this%Print('WARNING! '//trim(adjustl(loc//txt)), unit=u, iostat=iostatd, iomsg=iomsgd) - if (present(iostat)) iostat = iostatd - if (present(iomsg)) iomsg = iomsgd -end subroutine + u = ERROR_UNIT; IF (PRESENT(unit)) u = unit; iostatd = 0; + iomsgd = ''; loc = '' + IF (PRESENT(file) .AND. PRESENT(line)) & + & loc = '('//file//':'//TRIM(str(no_sign=.TRUE., n=line))//') ' + call this%Print('WARNING! '//trim(adjustl(loc//txt)), & + & unit=u, iostat=iostatd, iomsg=iomsgd) + IF (PRESENT(iostat)) iostat = iostatd + IF (PRESENT(iomsg)) iomsg = iomsgd +END SUBROUTINE -subroutine MessageHandler_Error(this, txt, unit, file, line, iostat, iomsg) +SUBROUTINE MessageHandler_Error(this, txt, unit, file, line, iostat, iomsg) !----------------------------------------------------------------- !< Print a txt message preceding for ERROR! !----------------------------------------------------------------- - class(MessageHandler_t), intent(IN) :: this !< Message handler - character(len=*), intent(IN) :: txt !< Text to print - integer(I4P), optional, intent(IN) :: unit !< Unit where to print - character(*), optional, intent(IN) :: file !< Source file - integer(I4P), optional, intent(IN) :: line !< Number of line in source file - integer(I4P), optional, intent(OUT) :: iostat !< IO error. - character(*), optional, intent(OUT) :: iomsg !< IO error message. - character(len=:), allocatable :: loc !< Error location string - integer(I4P) :: iostatd !< Real IO error. - integer(I4P) :: u !< Real unit - character(500) :: iomsgd !< Real IO error message. + CLASS(MessageHandler_t), INTENT(IN) :: this !< Message handler + CHARACTER(*), INTENT(IN) :: txt !< Text to print + INTEGER(I4P), OPTIONAL, INTENT(IN) :: unit !< Unit where to print + CHARACTER(*), OPTIONAL, INTENT(IN) :: file !< Source file + INTEGER(I4P), OPTIONAL, INTENT(IN) :: line !< Number of line in source file + INTEGER(I4P), OPTIONAL, INTENT(OUT) :: iostat !< IO error. + CHARACTER(*), OPTIONAL, INTENT(OUT) :: iomsg !< IO error message. + CHARACTER(:), ALLOCATABLE :: loc !< Error location string + INTEGER(I4P) :: iostatd !< Real IO error. + INTEGER(I4P) :: u !< Real unit + CHARACTER(500) :: iomsgd !< Real IO error message. !----------------------------------------------------------------- - u = ERROR_UNIT; if (present(unit)) u = unit; iostatd = 0; iomsgd = '' + u = ERROR_UNIT; IF (PRESENT(unit)) u = unit; iostatd = 0; iomsgd = '' loc = '' - if (present(file) .and. present(line)) & - loc = '('//file//':'//trim(str(no_sign=.true., n=line))//') ' - call this%Print('ERROR! '//trim(adjustl(loc//txt)), unit=u, iostat=iostatd, iomsg=iomsgd) - if (present(iostat)) iostat = iostatd - if (present(iomsg)) iomsg = iomsgd -end subroutine + IF (PRESENT(file) .AND. PRESENT(line)) & + & loc = '('//file//':'//TRIM(str(no_sign=.TRUE., n=line))//') ' + call this%Print('ERROR! '//trim(adjustl(loc//txt)), & + & unit=u, iostat=iostatd, iomsg=iomsgd) + IF (PRESENT(iostat)) iostat = iostatd + IF (PRESENT(iomsg)) iomsg = iomsgd +END SUBROUTINE -end module +END MODULE From ba244b5e515a8ead56e41d5dd7d61d613aae0d3b Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:34:02 +0900 Subject: [PATCH 04/16] Minor formating in LagrangePolynomialUtility and LegendrePolynomialUtility. --- .../src/LagrangePolynomialUtility.F90 | 35 ++++++++---------- .../src/LegendrePolynomialUtility.F90 | 37 ++++++++----------- 2 files changed, 30 insertions(+), 42 deletions(-) diff --git a/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 b/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 index 8ed395d29..8b40afd06 100644 --- a/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 +++ b/src/modules/Polynomial/src/LagrangePolynomialUtility.F90 @@ -26,6 +26,14 @@ MODULE LagrangePolynomialUtility IMPLICIT NONE PRIVATE +PUBLIC :: LagrangeDOF +PUBLIC :: LagrangeInDOF +PUBLIC :: LagrangeDegree +PUBLIC :: LagrangeVandermonde +PUBLIC :: EquidistancePoint +PUBLIC :: InterpolationPoint +PUBLIC :: LagrangeCoeff + !---------------------------------------------------------------------------- ! LagrangeDOF@BasisMethods !---------------------------------------------------------------------------- @@ -44,8 +52,6 @@ MODULE PURE FUNCTION LagrangeDOF(order, elemType) RESULT(ans) END FUNCTION LagrangeDOF END INTERFACE -PUBLIC :: LagrangeDOF - !---------------------------------------------------------------------------- ! LagrangeInDOF@BasisMethods !---------------------------------------------------------------------------- @@ -64,8 +70,6 @@ MODULE PURE FUNCTION LagrangeInDOF(order, elemType) RESULT(ans) END FUNCTION LagrangeInDOF END INTERFACE -PUBLIC :: LagrangeInDOF - !---------------------------------------------------------------------------- ! LagrangeDegree !---------------------------------------------------------------------------- @@ -83,8 +87,6 @@ MODULE PURE FUNCTION LagrangeDegree(order, elemType) RESULT(ans) END FUNCTION LagrangeDegree END INTERFACE -PUBLIC :: LagrangeDegree - !---------------------------------------------------------------------------- ! LagrangeVandermonde !---------------------------------------------------------------------------- @@ -97,19 +99,18 @@ END FUNCTION LagrangeDegree MODULE PURE FUNCTION LagrangeVandermonde(xij, order, elemType) & & RESULT(ans) REAL(DFP), INTENT(IN) :: xij(:, :) - !! points in $x_{iJ}$ format + !! points in $x_{iJ}$ format INTEGER(I4B), INTENT(IN) :: order - !! order + !! order INTEGER(I4B), INTENT(IN) :: elemType - !! element type + !! element type REAL(DFP), ALLOCATABLE :: ans(:, :) - !! vandermonde matrix nrows = number of points - !! ncols = number of dof + !! vandermonde matrix + !! nrows := number of points + !! ncols := number of dof END FUNCTION LagrangeVandermonde END INTERFACE -PUBLIC :: LagrangeVandermonde - !---------------------------------------------------------------------------- ! EquidistancePoint !---------------------------------------------------------------------------- @@ -128,8 +129,6 @@ MODULE PURE FUNCTION EquidistancePoint(order, elemType, xij) & END FUNCTION EquidistancePoint END INTERFACE -PUBLIC :: EquidistancePoint - !---------------------------------------------------------------------------- ! InterpolationPoint !---------------------------------------------------------------------------- @@ -165,15 +164,13 @@ MODULE FUNCTION InterpolationPoint(order, elemType, ipType, & END FUNCTION InterpolationPoint END INTERFACE -PUBLIC :: InterpolationPoint - !---------------------------------------------------------------------------- ! LagrangeCoeff !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 18 Oct 2022 -! summary: Returns the coefficient of ith lagrange poly +! summary: Returns the coefficient of ith lagrange poly INTERFACE MODULE FUNCTION LagrangeCoeff1(order, elemType, i, xij) RESULT(ans) @@ -194,8 +191,6 @@ END FUNCTION LagrangeCoeff1 MODULE PROCEDURE LagrangeCoeff1 END INTERFACE LagrangeCoeff -PUBLIC :: LagrangeCoeff - !---------------------------------------------------------------------------- ! LagrangeCoeff !---------------------------------------------------------------------------- diff --git a/src/modules/Polynomial/src/LegendrePolynomialUtility.F90 b/src/modules/Polynomial/src/LegendrePolynomialUtility.F90 index 15d21f2d8..2288cae3b 100644 --- a/src/modules/Polynomial/src/LegendrePolynomialUtility.F90 +++ b/src/modules/Polynomial/src/LegendrePolynomialUtility.F90 @@ -488,23 +488,18 @@ END SUBROUTINE LegendreQuadrature !> author: Vikas Sharma, Ph. D. ! date: 6 Sept 2022 -! summary: Evaluate Legendre polynomials from order = 0 to n at several points +! summary: Evaluate Legendre polynomial of order n at single points ! !# Introduction ! -! Evaluate Legendre polynomials from order = 0 to n at several points -! -!- N, the highest order polynomial to compute. Note that polynomials 0 -! through N will be computed. -!- alpha, beta are parameters -!- x: the point at which the polynomials are to be evaluated. -!- ans(M,1:N+1), the values of the first N+1 Legendre polynomials at the point -! X. +! Evaluate Legendre polynomial of order n at single points INTERFACE MODULE PURE FUNCTION LegendreEval1(n, x) RESULT(ans) INTEGER(I4B), INTENT(IN) :: n + !! order of polynomial REAL(DFP), INTENT(IN) :: x + !! point of evaluation, it should be between -1 and 1 REAL(DFP) :: ans !! Evaluate Legendre polynomial of order n at point x END FUNCTION LegendreEval1 @@ -522,25 +517,20 @@ END FUNCTION LegendreEval1 !> author: Vikas Sharma, Ph. D. ! date: 6 Sept 2022 -! summary: Evaluate Legendre polynomials from order = 0 to n at several points +! summary: Evaluate Legendre polynomials of order n at several points ! !# Introduction ! -! Evaluate Legendre polynomials from order = 0 to n at several points -! -!- N, the highest order polynomial to compute. Note that polynomials 0 -! through N will be computed. -!- alpha, beta are parameters -!- x: the point at which the polynomials are to be evaluated. -!- ans(M,1:N+1), the values of the first N+1 Legendre polynomials at the point -! X. +! Evaluate Legendre polynomials of order n at several points INTERFACE MODULE PURE FUNCTION LegendreEval2(n, x) RESULT(ans) INTEGER(I4B), INTENT(IN) :: n + !! order of polynomial REAL(DFP), INTENT(IN) :: x(:) + !! several points of evaluation REAL(DFP) :: ans(SIZE(x)) - !! Evaluate Legendre polynomial of order n at point x + !! Evaluate Legendre polynomial of order n at points x END FUNCTION LegendreEval2 END INTERFACE @@ -549,7 +539,7 @@ END FUNCTION LegendreEval2 END INTERFACE LegendreEval !---------------------------------------------------------------------------- -! LegendreEvalAll +! LegendreEvalAll !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. @@ -560,14 +550,15 @@ END FUNCTION LegendreEval2 ! ! Evaluate Legendre polynomials from order = 0 to n at single points ! -!- N, the highest order polynomial to compute. Note that polynomials 0 -! through N will be computed. !- x: the point at which the polynomials are to be evaluated. INTERFACE MODULE PURE FUNCTION LegendreEvalAll1(n, x) RESULT(ans) INTEGER(I4B), INTENT(IN) :: n + !! Highest order of polynomial. + !! Polynomials from 0 to n will be computed. REAL(DFP), INTENT(IN) :: x + !! Point of evaluation, $x \in [-1, 1]$ REAL(DFP) :: ans(n + 1) !! Evaluate Legendre polynomial of order = 0 to n (total n+1) !! at point x @@ -607,6 +598,8 @@ END FUNCTION LegendreEvalAll1 INTERFACE MODULE PURE FUNCTION LegendreEvalAll2(n, x) RESULT(ans) INTEGER(I4B), INTENT(IN) :: n + !! Highest order of polynomial. + !! Polynomials from 0 to n will be computed. REAL(DFP), INTENT(IN) :: x(:) !! number of points, SIZE(x)=M REAL(DFP) :: ans(SIZE(x), n + 1) From fe6235a84c7fdc747e75c1d23731a61bf0d8f4a0 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:35:51 +0900 Subject: [PATCH 05/16] Update in LineInterpolationUtility Adding PUBLIC :: LagrangeEvalAll_Line --- .../src/LineInterpolationUtility.F90 | 119 +++++++++++++++--- 1 file changed, 100 insertions(+), 19 deletions(-) diff --git a/src/modules/Polynomial/src/LineInterpolationUtility.F90 b/src/modules/Polynomial/src/LineInterpolationUtility.F90 index e3ce73b27..599202bc9 100644 --- a/src/modules/Polynomial/src/LineInterpolationUtility.F90 +++ b/src/modules/Polynomial/src/LineInterpolationUtility.F90 @@ -20,13 +20,23 @@ MODULE LineInterpolationUtility IMPLICIT NONE PRIVATE +PUBLIC :: LagrangeDegree_Line +PUBLIC :: LagrangeDOF_Point +PUBLIC :: LagrangeDOF_Line +PUBLIC :: LagrangeInDOF_Line +PUBLIC :: EquidistanceInPoint_Line +PUBLIC :: EquidistancePoint_Line +PUBLIC :: InterpolationPoint_Line +PUBLIC :: LagrangeCoeff_Line +PUBLIC :: LagrangeEvalAll_Line + !---------------------------------------------------------------------------- ! LagrangeDegree_Line !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 18 Aug 2022 -! summary: Returns the degree of monomials for Lagrange polynomials +! summary: Returns the degree of monomials for Lagrange polynomials INTERFACE MODULE PURE FUNCTION LagrangeDegree_Line(order) RESULT(ans) @@ -35,15 +45,13 @@ MODULE PURE FUNCTION LagrangeDegree_Line(order) RESULT(ans) END FUNCTION LagrangeDegree_Line END INTERFACE -PUBLIC :: LagrangeDegree_Line - !---------------------------------------------------------------------------- ! LagrangeDOF_Point !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 14 Aug 2022 -! summary: Returns the total number of degree of freedom for a +! summary: Returns the total number of degree of freedom for a ! lagrange polynomial on a point of Line INTERFACE @@ -53,15 +61,13 @@ MODULE PURE FUNCTION LagrangeDOF_Point(order) RESULT(ans) END FUNCTION LagrangeDOF_Point END INTERFACE -PUBLIC :: LagrangeDOF_Point - !---------------------------------------------------------------------------- ! GetDOF_Line !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. ! date: 14 Aug 2022 -! summary: Returns the total number of degree of freedom for a +! summary: Returns the total number of degree of freedom for a ! lagrange polynomial on Line INTERFACE @@ -71,8 +77,6 @@ MODULE PURE FUNCTION LagrangeDOF_Line(order) RESULT(ans) END FUNCTION LagrangeDOF_Line END INTERFACE -PUBLIC :: LagrangeDOF_Line - !---------------------------------------------------------------------------- ! LagrangeInDOF_Line !---------------------------------------------------------------------------- @@ -95,8 +99,6 @@ MODULE PURE FUNCTION LagrangeInDOF_Line(order) RESULT(ans) END FUNCTION LagrangeInDOF_Line END INTERFACE -PUBLIC :: LagrangeInDOF_Line - !---------------------------------------------------------------------------- ! EquidistanceInPoint_Line !---------------------------------------------------------------------------- @@ -125,8 +127,6 @@ END FUNCTION EquidistanceInPoint_Line1 MODULE PROCEDURE EquidistanceInPoint_Line1 END INTERFACE EquidistanceInPoint_Line -PUBLIC :: EquidistanceInPoint_Line - !---------------------------------------------------------------------------- ! EquidistanceInPoint_Line !---------------------------------------------------------------------------- @@ -186,8 +186,6 @@ END FUNCTION EquidistancePoint_Line1 MODULE PROCEDURE EquidistancePoint_Line1 END INTERFACE EquidistancePoint_Line -PUBLIC :: EquidistancePoint_Line - !---------------------------------------------------------------------------- ! EquidistancePoint_Line !---------------------------------------------------------------------------- @@ -279,8 +277,6 @@ END FUNCTION InterpolationPoint_Line1 MODULE PROCEDURE InterpolationPoint_Line1 END INTERFACE InterpolationPoint_Line -PUBLIC :: InterpolationPoint_Line - !---------------------------------------------------------------------------- ! InterpolationPoint_Line !---------------------------------------------------------------------------- @@ -335,8 +331,6 @@ END FUNCTION LagrangeCoeff_Line1 MODULE PROCEDURE LagrangeCoeff_Line1 END INTERFACE LagrangeCoeff_Line -PUBLIC :: LagrangeCoeff_Line - !---------------------------------------------------------------------------- ! LagrangeCoeff_Line !---------------------------------------------------------------------------- @@ -395,6 +389,8 @@ MODULE FUNCTION LagrangeCoeff_Line4(order, xij) RESULT(ans) !! points in xij format, size(xij,2) = order+1 REAL(DFP) :: ans(order + 1, order + 1) !! coefficients + !! jth column of ans corresponds to the coeff of lagrange polynomial + !! at the jth point END FUNCTION LagrangeCoeff_Line4 END INTERFACE @@ -402,4 +398,89 @@ END FUNCTION LagrangeCoeff_Line4 MODULE PROCEDURE LagrangeCoeff_Line4 END INTERFACE LagrangeCoeff_Line +!---------------------------------------------------------------------------- +! LagrangeEvalAll_Line +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-23 +! summary: Evaluate Lagrange polynomials from 0 to n at single points +! +!# Introduction +! +! Evaluate Lagrangepolynomials at single point +! +!- Two indicate the first call to subroutine set `firstCall` to True. +! +!- If `firstCall` is True, then +! - If `V` is present and `ipiv` is absent, then on return V contains +! vandermonde matrix +! - If `V` is present and `ipiv` is present, then on return V contains +! LU decomposition of vandermonde matrix and `ipiv` contains +! inverse map of pivoting. +! +!- If `firstCall` is FALSE, then +! - If `V` is present and `ipiv` is absent, then V denotes vandermonde +! matrix, which will be used in the computations. +! - If `V` is present and `ipiv` is present, then V denotes the +! LU decomposition of vandermonde matrix and `ipiv` denotes the +! inverse map of pivoting. These information will be used. + +INTERFACE + MODULE FUNCTION LagrangeEvalAll_Line1(order, x, xij, coeff, firstCall) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: order + !! order of Lagrange polynomials + REAL(DFP), INTENT(IN) :: x + !! point of evaluation + REAL(DFP), OPTIONAL, INTENT(INOUT) :: xij(1, order + 1) + !! interpolation points + REAL(DFP), OPTIONAL, INTENT(INOUT) :: coeff(order + 1, order + 1) + !! coefficient of Lagrange polynomials + LOGICAL(LGT), OPTIONAL :: firstCall + !! If firstCall is true, then coeff will be made + !! If firstCall is False, then coeff will be used + !! Default value of firstCall is True + REAL(DFP) :: ans(order + 1) + !! Value of n+1 Lagrange polynomials at point x + END FUNCTION LagrangeEvalAll_Line1 +END INTERFACE + +INTERFACE LagrangeEvalAll_Line + MODULE PROCEDURE LagrangeEvalAll_Line1 +END INTERFACE LagrangeEvalAll_Line + +!---------------------------------------------------------------------------- +! LagrangeEvalAll_Line +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-23 +! summary: Evaluate Lagrange polynomials from 0 to n at several points + +INTERFACE + MODULE FUNCTION LagrangeEvalAll_Line2(order, x, xij, coeff, firstCall) & + & RESULT(ans) + INTEGER(I4B), INTENT(IN) :: order + !! order of Lagrange polynomials + REAL(DFP), INTENT(IN) :: x(:) + !! point of evaluation + REAL(DFP), OPTIONAL, INTENT(INOUT) :: xij(1, order + 1) + !! interpolation points + REAL(DFP), OPTIONAL, INTENT(INOUT) :: coeff(order + 1, order + 1) + !! coefficient of Lagrange polynomials + LOGICAL(LGT), OPTIONAL :: firstCall + !! If firstCall is true, then coeff will be made + !! If firstCall is False, then coeff will be used + !! Default value of firstCall is True + REAL(DFP) :: ans(SIZE(x), order + 1) + !! Value of n+1 Lagrange polynomials at point x + !! ans(:, j) is the value of jth polynomial at x points + !! ans(i, :) is the value of all polynomials at x(i) point + END FUNCTION LagrangeEvalAll_Line2 +END INTERFACE + +INTERFACE LagrangeEvalAll_Line + MODULE PROCEDURE LagrangeEvalAll_Line2 +END INTERFACE LagrangeEvalAll_Line + END MODULE LineInterpolationUtility From 05134545017fcb60917071f65f3e7bf3d06a415d Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:36:13 +0900 Subject: [PATCH 06/16] Minor formating in LagrangePolynomialUtility --- .../src/LagrangePolynomialUtility@Methods.F90 | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/submodules/Polynomial/src/LagrangePolynomialUtility@Methods.F90 b/src/submodules/Polynomial/src/LagrangePolynomialUtility@Methods.F90 index e45a5886a..643ec2f1b 100644 --- a/src/submodules/Polynomial/src/LagrangePolynomialUtility@Methods.F90 +++ b/src/submodules/Polynomial/src/LagrangePolynomialUtility@Methods.F90 @@ -103,14 +103,13 @@ INTEGER(I4B), ALLOCATABLE :: degree(:, :) REAL(DFP), ALLOCATABLE :: x0(:), y0(:), z0(:) INTEGER(I4B) :: m, n, jj, nsd - !! +! degree = TRANSPOSE(LagrangeDegree(order=order, elemType=elemType)) - !! m = SIZE(xij, 2) nsd = SIZE(degree, 1) n = SIZE(degree, 2) ALLOCATE (ans(m, n)) - !! + SELECT CASE (nsd) CASE (1) x0 = xij(1, :) @@ -131,12 +130,11 @@ ans(:, jj) = x0**degree(1, jj) * y0**degree(2, jj) * z0**degree(3, jj) END DO END SELECT - !! + IF (ALLOCATED(degree)) DEALLOCATE (degree) IF (ALLOCATED(x0)) DEALLOCATE (x0) IF (ALLOCATED(y0)) DEALLOCATE (y0) IF (ALLOCATED(z0)) DEALLOCATE (z0) - !! END PROCEDURE LagrangeVandermonde !---------------------------------------------------------------------------- @@ -181,10 +179,16 @@ ALLOCATE (ans(0, 0)) END IF CASE (Line) - ans = InterpolationPoint_Line(order=order, ipType=ipType, xij=xij, & + ans = InterpolationPoint_Line(& + & order=order, & + & ipType=ipType, & + & xij=xij, & & layout=layout) CASE (Triangle) - ans = InterpolationPoint_Triangle(order=order, ipType=ipType, xij=xij, & + ans = InterpolationPoint_Triangle( & + & order=order, & + & ipType=ipType, & + & xij=xij, & & layout=layout) CASE (Quadrangle) ans = InterpolationPoint_Quadrangle(order=order, ipType=ipType, xij=xij, & From 39be36e00180f8ff33e24daa736919463bd5ee48 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:36:41 +0900 Subject: [PATCH 07/16] Updates in LineInterpolationUtility Adding LagrangeEvalAll_Line method --- .../src/LineInterpolationUtility@Methods.F90 | 103 ++++++++++++++++-- 1 file changed, 93 insertions(+), 10 deletions(-) diff --git a/src/submodules/Polynomial/src/LineInterpolationUtility@Methods.F90 b/src/submodules/Polynomial/src/LineInterpolationUtility@Methods.F90 index 944c117e3..e40aafb94 100644 --- a/src/submodules/Polynomial/src/LineInterpolationUtility@Methods.F90 +++ b/src/submodules/Polynomial/src/LineInterpolationUtility@Methods.F90 @@ -182,7 +182,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE InterpolationPoint_Line1 -CHARACTER(LEN=20) :: astr +CHARACTER(20) :: astr INTEGER(I4B) :: nsd, ii REAL(DFP) :: temp(order + 1), t1 !! @@ -273,7 +273,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE InterpolationPoint_Line2 -CHARACTER(LEN=20) :: astr +CHARACTER(20) :: astr REAL(DFP) :: t1 !! IF (order .EQ. 0_I4B) THEN @@ -349,15 +349,10 @@ REAL(DFP) :: v(SIZE(xij, 2), SIZE(xij, 2)) INTEGER(I4B), DIMENSION(SIZE(xij, 2)) :: ipiv INTEGER(I4B) :: info -!! v = LagrangeVandermonde(order=order, xij=xij, elemType=Line2) CALL getLU(A=v, IPIV=ipiv, info=info) -!! -!! deploy to subroutine -!! ans = 0.0_DFP; ans(i) = 1.0_DFP CALL LUSolve(A=v, B=ans, IPIV=ipiv, info=info) -!! END PROCEDURE LagrangeCoeff_Line1 !---------------------------------------------------------------------------- @@ -368,13 +363,10 @@ REAL(DFP) :: vtemp(SIZE(v, 1), SIZE(v, 2)) INTEGER(I4B), DIMENSION(SIZE(v, 1)) :: ipiv INTEGER(I4B) :: info -!! vtemp = v; ipiv = 0 CALL getLU(A=vtemp, IPIV=ipiv, info=info) -!! ans = 0.0_DFP; ans(i) = 1.0_DFP CALL LUSolve(A=vtemp, B=ans, IPIV=ipiv, info=info) -!! END PROCEDURE LagrangeCoeff_Line2 !---------------------------------------------------------------------------- @@ -396,6 +388,97 @@ CALL GetInvMat(ans) END PROCEDURE LagrangeCoeff_Line4 +!---------------------------------------------------------------------------- +! LagrangeEvalAll_Line +!---------------------------------------------------------------------------- + +MODULE PROCEDURE LagrangeEvalAll_Line1 +LOGICAL(LGT) :: firstCall0 +REAL(DFP) :: coeff0(order + 1, order + 1), xx(order + 1) +INTEGER(I4B) :: ii + +firstCall0 = input(default=.FALSE., option=firstCall) + +IF (PRESENT(coeff)) THEN + IF (firstCall0) THEN + IF (.NOT. PRESENT(xij)) THEN + CALL Errormsg(& + & msg="xij should be present!", & + & file=__FILE__, & + & routine="LagrangeEvalAll_Line1", & + & line=__LINE__, & + & unitno=stderr) + END IF + coeff = LagrangeCoeff_Line(order=order, xij=xij) + coeff0 = TRANSPOSE(coeff) + ELSE + coeff0 = TRANSPOSE(coeff) + END IF +ELSE + IF (.NOT. PRESENT(xij)) THEN + CALL Errormsg(& + & msg="xij should be present!", & + & file=__FILE__, & + & routine="LagrangeEvalAll_Line1", & + & line=__LINE__, & + & unitno=stderr) + END IF + coeff0 = TRANSPOSE(LagrangeCoeff_Line(order=order, xij=xij)) +END IF + +xx(1) = 1.0_DFP +DO ii = 1, order + xx(ii + 1) = xx(ii) * x +END DO +ans = MATMUL(coeff0, xx) + +END PROCEDURE LagrangeEvalAll_Line1 + +!---------------------------------------------------------------------------- +! LagrangeEvalAll_Line +!---------------------------------------------------------------------------- + +MODULE PROCEDURE LagrangeEvalAll_Line2 +LOGICAL(LGT) :: firstCall0 +REAL(DFP) :: coeff0(order + 1, order + 1), xx(SIZE(x), order + 1) +INTEGER(I4B) :: ii + +firstCall0 = input(default=.FALSE., option=firstCall) + +IF (PRESENT(coeff)) THEN + IF (firstCall0) THEN + IF (.NOT. PRESENT(xij)) THEN + CALL Errormsg(& + & msg="xij should be present!", & + & file=__FILE__, & + & routine="LagrangeEvalAll_Line1", & + & line=__LINE__, & + & unitno=stderr) + END IF + coeff = LagrangeCoeff_Line(order=order, xij=xij) + coeff0 = TRANSPOSE(coeff) + ELSE + coeff0 = TRANSPOSE(coeff) + END IF +ELSE + IF (.NOT. PRESENT(xij)) THEN + CALL Errormsg(& + & msg="xij should be present!", & + & file=__FILE__, & + & routine="LagrangeEvalAll_Line1", & + & line=__LINE__, & + & unitno=stderr) + END IF + coeff0 = TRANSPOSE(LagrangeCoeff_Line(order=order, xij=xij)) +END IF + +xx(:, 1) = 1.0_DFP +DO ii = 1, order + xx(:, ii + 1) = xx(:, ii) * x +END DO +ans = MATMUL(xx, coeff0) +END PROCEDURE LagrangeEvalAll_Line2 + !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- From 2458910edf0eb99f4d0a89ca4e3fca385d17f3b9 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 10:37:12 +0900 Subject: [PATCH 08/16] Minor formating in Utility --- src/modules/Utility/src/Utility.F90 | 32 ++++++++++++----------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/src/modules/Utility/src/Utility.F90 b/src/modules/Utility/src/Utility.F90 index db886c1b7..c3aa9cb0e 100755 --- a/src/modules/Utility/src/Utility.F90 +++ b/src/modules/Utility/src/Utility.F90 @@ -15,40 +15,34 @@ ! along with this program. If not, see MODULE Utility -USE MappingUtility -USE BinomUtility USE AppendUtility USE ApproxUtility +USE ArangeUtility USE AssertUtility +USE BinomUtility +USE ContractionUtility +USE ConvertUtility +USE DiagUtility +USE EigenUtility +USE EyeUtility USE FunctionalFortranUtility USE GridPointUtility -USE OnesUtility -USE ZerosUtility -USE EyeUtility -USE DiagUtility USE HashingUtility USE InputUtility +USE IntegerUtility USE InvUtility +USE LinearAlgebraUtility +USE MappingUtility USE MatmulUtility -USE ContractionUtility USE MiscUtility +USE OnesUtility USE ProductUtility +USE PushPopUtility USE ReallocateUtility USE SortUtility USE StringUtility USE SwapUtility -USE ConvertUtility -USE IntegerUtility -USE PushPopUtility -USE PolynomialUtility -USE EigenUtility -USE ArangeUtility USE SymUtility USE TriagUtility -USE LinearAlgebraUtility - -!---------------------------------------------------------------------------- -! -!---------------------------------------------------------------------------- - +USE ZerosUtility END MODULE Utility From b184e8674e77bb5835c1490837d7afa5fdc7fae0 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 13:24:59 +0900 Subject: [PATCH 09/16] Update in MdEncode Now we can call MdEncode for 3D and 4D arrays. --- src/modules/MdEncode/src/MdEncode_Method.F90 | 55 +++++++++++++++----- 1 file changed, 42 insertions(+), 13 deletions(-) diff --git a/src/modules/MdEncode/src/MdEncode_Method.F90 b/src/modules/MdEncode/src/MdEncode_Method.F90 index 1895977ee..841c92a75 100644 --- a/src/modules/MdEncode/src/MdEncode_Method.F90 +++ b/src/modules/MdEncode/src/MdEncode_Method.F90 @@ -26,10 +26,10 @@ MODULE MdEncode_Method !---------------------------------------------------------------------------- INTERFACE -MODULE FUNCTION MdEncode_1( val ) RESULT( ans ) - CLASS( * ), INTENT( IN ) :: val - TYPE(String) :: ans -END FUNCTION MdEncode_1 + MODULE FUNCTION MdEncode_1(val) RESULT(ans) + CLASS(*), INTENT(IN) :: val + TYPE(String) :: ans + END FUNCTION MdEncode_1 END INTERFACE INTERFACE MdEncode @@ -43,10 +43,10 @@ END FUNCTION MdEncode_1 !---------------------------------------------------------------------------- INTERFACE -MODULE FUNCTION MdEncode_2( val ) RESULT( ans ) - CLASS( * ), INTENT( IN ) :: val( : ) - TYPE(String) :: ans -END FUNCTION MdEncode_2 + MODULE FUNCTION MdEncode_2(val) RESULT(ans) + CLASS(*), INTENT(IN) :: val(:) + TYPE(String) :: ans + END FUNCTION MdEncode_2 END INTERFACE INTERFACE MdEncode @@ -58,15 +58,44 @@ END FUNCTION MdEncode_2 !---------------------------------------------------------------------------- INTERFACE -MODULE FUNCTION MdEncode_3( val ) RESULT( ans ) - CLASS( * ), INTENT( IN ) :: val(:, :) - TYPE(String) :: ans -END FUNCTION MdEncode_3 + MODULE FUNCTION MdEncode_3(val) RESULT(ans) + CLASS(*), INTENT(IN) :: val(:, :) + TYPE(String) :: ans + END FUNCTION MdEncode_3 END INTERFACE INTERFACE MdEncode MODULE PROCEDURE MdEncode_3 END INTERFACE MdEncode +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +INTERFACE + MODULE FUNCTION MdEncode_4(val) RESULT(ans) + CLASS(*), INTENT(IN) :: val(:, :, :) + TYPE(String) :: ans + END FUNCTION MdEncode_4 +END INTERFACE + +INTERFACE MdEncode + MODULE PROCEDURE MdEncode_4 +END INTERFACE MdEncode + +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +INTERFACE + MODULE FUNCTION MdEncode_5(val) RESULT(ans) + CLASS(*), INTENT(IN) :: val(:, :, :, :) + TYPE(String) :: ans + END FUNCTION MdEncode_5 +END INTERFACE + +INTERFACE MdEncode + MODULE PROCEDURE MdEncode_5 +END INTERFACE MdEncode -END MODULE MdEncode_Method \ No newline at end of file +END MODULE MdEncode_Method From ad0b7c0f7bbfbb89de1adcdd69862336ecb6b5bf Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 13:25:32 +0900 Subject: [PATCH 10/16] Update in MdEncode Now we can call MdEncode for 3D and 4D arrays. --- .../MdEncode/src/MdEncode_Method@Methods.F90 | 174 ++++++++++-------- 1 file changed, 100 insertions(+), 74 deletions(-) diff --git a/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 b/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 index 6f511ea48..2eb2a76ec 100644 --- a/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 +++ b/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 @@ -26,24 +26,24 @@ MODULE PROCEDURE MdEncode_1 !! - SELECT TYPE( val ) - TYPE IS( REAL(Real32) ) - ans = TOSTRING( val ) - TYPE IS( REAL(Real64) ) - ans = TOSTRING( val ) - TYPE IS( INTEGER( Int8 ) ) - ans = TOSTRING( val ) - TYPE IS( INTEGER( Int16 ) ) - ans = TOSTRING( val ) - TYPE IS( INTEGER( Int32 ) ) - ans = TOSTRING( val ) - TYPE IS( INTEGER( Int64 ) ) - ans = TOSTRING( val ) - TYPE IS( CHARACTER( LEN = * ) ) - ans = TRIM( val ) - TYPE IS( String ) - ans = TRIM( val ) - END SELECT +SELECT TYPE (val) +TYPE IS (REAL(REAL32)) + ans = TOSTRING(val) +TYPE IS (REAL(REAL64)) + ans = TOSTRING(val) +TYPE IS (INTEGER(INT8)) + ans = TOSTRING(val) +TYPE IS (INTEGER(INT16)) + ans = TOSTRING(val) +TYPE IS (INTEGER(INT32)) + ans = TOSTRING(val) +TYPE IS (INTEGER(INT64)) + ans = TOSTRING(val) +TYPE IS (CHARACTER(LEN=*)) + ans = TRIM(val) +TYPE IS (String) + ans = TRIM(val) +END SELECT !! END PROCEDURE MdEncode_1 !---------------------------------------------------------------------------- @@ -51,47 +51,47 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE MdEncode_2 - INTEGER( I4B ) :: ii, n +INTEGER(I4B) :: ii, n !! - n = SIZE( val ) - ans = " | " - DO ii = 1, n - ans = ans // " | " - END DO - ans = ans // CHAR_LF +n = SIZE(val) +ans = " | " +DO ii = 1, n + ans = ans//" | " +END DO +ans = ans//CHAR_LF !! - ans = ans // " | " - DO ii = 1, n - ans = ans // " --- | " - END DO - ans = ans // CHAR_LF +ans = ans//" | " +DO ii = 1, n + ans = ans//" --- | " +END DO +ans = ans//CHAR_LF !! - SELECT TYPE( val ) - TYPE IS( REAL(Real32) ) +SELECT TYPE (val) +TYPE IS (REAL(REAL32)) #include "./inc/MdEncode_2.inc" - TYPE IS( REAL(Real64) ) +TYPE IS (REAL(REAL64)) #include "./inc/MdEncode_2.inc" - TYPE IS( INTEGER( Int8 ) ) +TYPE IS (INTEGER(INT8)) #include "./inc/MdEncode_2.inc" - TYPE IS( INTEGER( Int16 ) ) +TYPE IS (INTEGER(INT16)) #include "./inc/MdEncode_2.inc" - TYPE IS( INTEGER( Int32 ) ) +TYPE IS (INTEGER(INT32)) #include "./inc/MdEncode_2.inc" - TYPE IS( INTEGER( Int64 ) ) +TYPE IS (INTEGER(INT64)) #include "./inc/MdEncode_2.inc" - TYPE IS( CHARACTER( LEN = * ) ) - ans = ans // " | " - DO ii = 1, n - ans = ans // TRIM( val( ii ) ) // " | " - END DO - ans = ans // CHAR_LF - TYPE IS( String ) - ans = ans // " | " - DO ii = 1, n - ans = ans // TRIM( val( ii ) ) // " | " - END DO - ans = ans // CHAR_LF - END SELECT +TYPE IS (CHARACTER(LEN=*)) + ans = ans//" | " + DO ii = 1, n + ans = ans//TRIM(val(ii))//" | " + END DO + ans = ans//CHAR_LF +TYPE IS (String) + ans = ans//" | " + DO ii = 1, n + ans = ans//TRIM(val(ii))//" | " + END DO + ans = ans//CHAR_LF +END SELECT !! END PROCEDURE MdEncode_2 @@ -100,42 +100,68 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE MdEncode_3 - INTEGER( I4B ) :: ii, jj, m, n +INTEGER(I4B) :: ii, jj, m, n !! - m = SIZE( val, 1 ) - n = SIZE( val, 2 ) - ans = " | " - DO ii = 1, n - ans = ans // " | " - END DO - ans = ans // CHAR_LF +m = SIZE(val, 1) +n = SIZE(val, 2) +ans = " | " +DO ii = 1, n + ans = ans//" | " +END DO +ans = ans//CHAR_LF !! - ans = ans // " | " - DO ii = 1, n - ans = ans // " --- | " - END DO - ans = ans // CHAR_LF +ans = ans//" | " +DO ii = 1, n + ans = ans//" --- | " +END DO +ans = ans//CHAR_LF !! - SELECT TYPE( val ) - TYPE IS( REAL(Real32) ) +SELECT TYPE (val) +TYPE IS (REAL(REAL32)) #include "./inc/MdEncode_3.inc" - TYPE IS( REAL(Real64) ) +TYPE IS (REAL(REAL64)) #include "./inc/MdEncode_3.inc" - TYPE IS( INTEGER( Int8 ) ) +TYPE IS (INTEGER(INT8)) #include "./inc/MdEncode_3.inc" - TYPE IS( INTEGER( Int16 ) ) +TYPE IS (INTEGER(INT16)) #include "./inc/MdEncode_3.inc" - TYPE IS( INTEGER( Int32 ) ) +TYPE IS (INTEGER(INT32)) #include "./inc/MdEncode_3.inc" - TYPE IS( INTEGER( Int64 ) ) +TYPE IS (INTEGER(INT64)) #include "./inc/MdEncode_3.inc" - TYPE IS( CHARACTER( LEN = * ) ) +TYPE IS (CHARACTER(LEN=*)) #include "./inc/MdEncode_3b.inc" - TYPE IS( String ) +TYPE IS (String) #include "./inc/MdEncode_3b.inc" - END SELECT +END SELECT !! END PROCEDURE MdEncode_3 +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MdEncode_4 +INTEGER(I4B) :: ii +DO ii = 1, SIZE(val, 3) + ans = "( :, :, "//tostring(ii)//" ) = "//CHAR_LF//CHAR_LF + ans = ans//MdEncode(val(:, :, ii)) +END DO +END PROCEDURE MdEncode_4 + +!---------------------------------------------------------------------------- +! MdEncode +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MdEncode_5 +INTEGER(I4B) :: ii, jj +DO jj = 1, SIZE(val, 4) + DO ii = 1, SIZE(val, 3) + ans = "( :, :, "//tostring(ii)//", "//tostring(jj)//" ) = " & + & //CHAR_LF//CHAR_LF + ans = ans//MdEncode(val(:, :, ii, jj)) + END DO +END DO +END PROCEDURE MdEncode_5 -END SUBMODULE Methods \ No newline at end of file +END SUBMODULE Methods From 498678553db7ee7d58b250357d32982b2118c265 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 26 Jun 2023 14:59:59 +0900 Subject: [PATCH 11/16] Updates in EyeUtility Added eye methods for Int8 to Int128. --- src/modules/Utility/src/EyeUtility.F90 | 87 ++++++++++++----- .../Utility/src/EyeUtility@Methods.F90 | 96 ++++++++++++++----- 2 files changed, 136 insertions(+), 47 deletions(-) diff --git a/src/modules/Utility/src/EyeUtility.F90 b/src/modules/Utility/src/EyeUtility.F90 index f3c8a389f..d9e77b7bd 100644 --- a/src/modules/Utility/src/EyeUtility.F90 +++ b/src/modules/Utility/src/EyeUtility.F90 @@ -27,32 +27,67 @@ MODULE EyeUtility !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 6 March 2021 +! date: 2023-06-26 ! summary: Return an identity matrix of an integers INTERFACE -MODULE PURE FUNCTION int_eye_1( m, DataType ) RESULT( Ans ) - INTEGER( I4B ), INTENT( IN ) :: m, DataType - INTEGER( I4B ) :: Ans( m, m ) -END FUNCTION int_eye_1 + MODULE PURE FUNCTION int_eye_1(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + INTEGER(INT8), INTENT(IN) :: DataType + INTEGER(INT8) :: ans(m, m) + END FUNCTION int_eye_1 + + MODULE PURE FUNCTION int_eye_2(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + INTEGER(INT16), INTENT(IN) :: DataType + INTEGER(INT16) :: ans(m, m) + END FUNCTION int_eye_2 + + MODULE PURE FUNCTION int_eye_3(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + INTEGER(INT32), INTENT(IN) :: DataType + INTEGER(INT32) :: ans(m, m) + END FUNCTION int_eye_3 + + MODULE PURE FUNCTION int_eye_4(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + INTEGER(INT64), INTENT(IN) :: DataType + INTEGER(INT64) :: ans(m, m) + END FUNCTION int_eye_4 END INTERFACE INTERFACE Eye - MODULE PROCEDURE int_eye_1 + MODULE PROCEDURE int_eye_1, int_eye_2, int_eye_3, int_eye_4 END INTERFACE Eye +#ifdef USE_Int128 +INTERFACE + MODULE PURE FUNCTION int_eye_5(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + INTEGER(Int128), INTENT(IN) :: DataType + INTEGER(Int128) :: ans(m, m) + END FUNCTION int_eye_5 +END INTERFACE + +INTERFACE Eye + MODULE PROCEDURE int_eye_5 +END INTERFACE Eye +#endif + !---------------------------------------------------------------------------- ! Eye@Constructor !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Return identity matrix of real numbers INTERFACE -!! Return identity matrix of real numbers -MODULE PURE FUNCTION real_eye_1( m, DataType ) RESULT( Ans ) - INTEGER( I4B ), INTENT( IN ) :: m - REAL( Real64 ) :: Ans( m, m ) - REAL( Real64 ), INTENT( IN ) :: DataType -END FUNCTION real_eye_1 + MODULE PURE FUNCTION real_eye_1(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + REAL(REAL64) :: ans(m, m) + REAL(REAL64), INTENT(IN) :: DataType + END FUNCTION real_eye_1 END INTERFACE INTERFACE Eye @@ -63,13 +98,15 @@ END FUNCTION real_eye_1 ! Eye@Constructor !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Return identity matrix of real number INTERFACE -!! Return identity matrix of real number -MODULE PURE FUNCTION real_eye_2( m ) RESULT( Ans ) - INTEGER( I4B ), INTENT( IN ) :: m - REAL( DFP ) :: Ans( m, m ) -END FUNCTION real_eye_2 + MODULE PURE FUNCTION real_eye_2(m) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + REAL(DFP) :: ans(m, m) + END FUNCTION real_eye_2 END INTERFACE INTERFACE Eye @@ -80,14 +117,16 @@ END FUNCTION real_eye_2 ! Eye@Constructor !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Return identity matrix of real numbers INTERFACE -!! Return identity matrix of real numbers -MODULE PURE FUNCTION real_eye_3( m, DataType ) RESULT( Ans ) - INTEGER( I4B ), INTENT( IN ) :: m - REAL( Real32 ) :: Ans( m, m ) - REAL( Real32 ), INTENT( IN ) :: DataType -END FUNCTION real_eye_3 + MODULE PURE FUNCTION real_eye_3(m, DataType) RESULT(ans) + INTEGER(I4B), INTENT(IN) :: m + REAL(REAL32) :: ans(m, m) + REAL(REAL32), INTENT(IN) :: DataType + END FUNCTION real_eye_3 END INTERFACE INTERFACE Eye @@ -98,4 +137,4 @@ END FUNCTION real_eye_3 ! !---------------------------------------------------------------------------- -END MODULE EyeUtility \ No newline at end of file +END MODULE EyeUtility diff --git a/src/submodules/Utility/src/EyeUtility@Methods.F90 b/src/submodules/Utility/src/EyeUtility@Methods.F90 index dc86c7009..9337cd5e8 100644 --- a/src/submodules/Utility/src/EyeUtility@Methods.F90 +++ b/src/submodules/Utility/src/EyeUtility@Methods.F90 @@ -16,31 +16,81 @@ ! SUBMODULE(EyeUtility) Methods -implicit none -contains +IMPLICIT NONE +CONTAINS !---------------------------------------------------------------------------- ! Eye !---------------------------------------------------------------------------- MODULE PROCEDURE int_eye_1 - INTEGER( I4B ) :: i - Ans = 0_I4B - DO i = 1, m - Ans( i, i ) = 1 - END DO +INTEGER(I4B) :: i +Ans = 0_INT8 +DO i = 1, m + Ans(i, i) = 1 +END DO END PROCEDURE int_eye_1 !---------------------------------------------------------------------------- ! Eye !---------------------------------------------------------------------------- +MODULE PROCEDURE int_eye_2 +INTEGER(I4B) :: i +Ans = 0_INT16 +DO i = 1, m + Ans(i, i) = 1 +END DO +END PROCEDURE int_eye_2 + +!---------------------------------------------------------------------------- +! Eye +!---------------------------------------------------------------------------- + +MODULE PROCEDURE int_eye_3 +INTEGER(I4B) :: i +Ans = 0_INT32 +DO i = 1, m + Ans(i, i) = 1 +END DO +END PROCEDURE int_eye_3 + +!---------------------------------------------------------------------------- +! Eye +!---------------------------------------------------------------------------- + +MODULE PROCEDURE int_eye_4 +INTEGER(I4B) :: i +Ans = 0_INT64 +DO i = 1, m + Ans(i, i) = 1 +END DO +END PROCEDURE int_eye_4 + +!---------------------------------------------------------------------------- +! Eye +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE int_eye_5 +INTEGER(I4B) :: i +Ans = 0_INT128 +DO i = 1, m + Ans(i, i) = 1 +END DO +END PROCEDURE int_eye_5 +#endif + +!---------------------------------------------------------------------------- +! Eye +!---------------------------------------------------------------------------- + MODULE PROCEDURE real_eye_1 - INTEGER( I4B ) :: i - Ans = 0.0 - DO i = 1, m - Ans( i, i ) = 1.0 - END DO +INTEGER(I4B) :: i +Ans = 0.0 +DO i = 1, m + Ans(i, i) = 1.0 +END DO END PROCEDURE real_eye_1 !---------------------------------------------------------------------------- @@ -48,11 +98,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE real_eye_2 - INTEGER( I4B ) :: i - Ans = 0.0 - DO i = 1, m - Ans( i, i ) = 1.0 - END DO +INTEGER(I4B) :: i +Ans = 0.0 +DO i = 1, m + Ans(i, i) = 1.0 +END DO END PROCEDURE real_eye_2 !---------------------------------------------------------------------------- @@ -60,11 +110,11 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE real_eye_3 - INTEGER( I4B ) :: i - Ans = 0.0 - DO i = 1, m - Ans( i, i ) = 1.0 - END DO +INTEGER(I4B) :: i +Ans = 0.0 +DO i = 1, m + Ans(i, i) = 1.0 +END DO END PROCEDURE real_eye_3 -END SUBMODULE Methods \ No newline at end of file +END SUBMODULE Methods From c5348970ae461c8d4ce1d70333d5dbc878116f1c Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 27 Jun 2023 08:29:59 +0900 Subject: [PATCH 12/16] Updates in SwapUtility Now Swap works for 2D matrix of integers. --- src/modules/Utility/src/SwapUtility.F90 | 103 ++++++++------ .../Utility/src/SwapUtility@Methods.F90 | 129 +++++++++++++----- 2 files changed, 163 insertions(+), 69 deletions(-) diff --git a/src/modules/Utility/src/SwapUtility.F90 b/src/modules/Utility/src/SwapUtility.F90 index f16408f65..53c767dcc 100644 --- a/src/modules/Utility/src/SwapUtility.F90 +++ b/src/modules/Utility/src/SwapUtility.F90 @@ -32,16 +32,16 @@ MODULE SwapUtility INTERFACE MODULE PURE SUBROUTINE Swap_Int8(a, b) - INTEGER(Int8), INTENT(INOUT) :: a, b + INTEGER(INT8), INTENT(INOUT) :: a, b END SUBROUTINE Swap_Int8 MODULE PURE SUBROUTINE Swap_Int16(a, b) - INTEGER(Int16), INTENT(INOUT) :: a, b + INTEGER(INT16), INTENT(INOUT) :: a, b END SUBROUTINE Swap_Int16 MODULE PURE SUBROUTINE Swap_Int32(a, b) - INTEGER(Int32), INTENT(INOUT) :: a, b + INTEGER(INT32), INTENT(INOUT) :: a, b END SUBROUTINE Swap_Int32 MODULE PURE SUBROUTINE Swap_Int64(a, b) - INTEGER(Int64), INTENT(INOUT) :: a, b + INTEGER(INT64), INTENT(INOUT) :: a, b END SUBROUTINE Swap_Int64 END INTERFACE @@ -59,7 +59,7 @@ END SUBROUTINE Swap_Int64 INTERFACE MODULE PURE SUBROUTINE Swap_r32(a, b) - REAL(Real32), INTENT(INOUT) :: a, b + REAL(REAL32), INTENT(INOUT) :: a, b END SUBROUTINE Swap_r32 END INTERFACE @@ -77,7 +77,7 @@ END SUBROUTINE Swap_r32 INTERFACE MODULE PURE SUBROUTINE Swap_r64(a, b) - REAL(Real64), INTENT(INOUT) :: a, b + REAL(REAL64), INTENT(INOUT) :: a, b END SUBROUTINE Swap_r64 END INTERFACE @@ -96,32 +96,59 @@ END SUBROUTINE Swap_r64 #ifndef USE_BLAS95 INTERFACE MODULE PURE SUBROUTINE Swap_r32v(a, b) - REAL(Real32), INTENT(INOUT) :: a(:), b(:) + REAL(REAL32), INTENT(INOUT) :: a(:), b(:) END SUBROUTINE Swap_r32v + + MODULE PURE SUBROUTINE Swap_r64v(a, b) + REAL(REAL64), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_r64v END INTERFACE INTERFACE Swap - MODULE PROCEDURE Swap_r32v + MODULE PROCEDURE Swap_r32v, Swap_r64v END INTERFACE Swap #endif !---------------------------------------------------------------------------- -! Swap@SwapMethods +! Swap@SwapMethods !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 22 March 2021 -! summary: Swap two vectors of real +! date: 2023-06-27 +! summary: Swap two integer vectors -#ifndef USE_BLAS95 INTERFACE - MODULE PURE SUBROUTINE Swap_r64v(a, b) - REAL(Real64), INTENT(INOUT) :: a(:), b(:) - END SUBROUTINE Swap_r64v + MODULE PURE SUBROUTINE Swap_Int8v(a, b) + INTEGER(INT8), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_Int8v + MODULE PURE SUBROUTINE Swap_Int16v(a, b) + INTEGER(INT16), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_Int16v + MODULE PURE SUBROUTINE Swap_Int32v(a, b) + INTEGER(INT32), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_Int32v + MODULE PURE SUBROUTINE Swap_Int64v(a, b) + INTEGER(INT64), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_Int64v +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE Swap_Int8v, Swap_Int16v, Swap_Int32v, Swap_Int64v +END INTERFACE Swap + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +INTERFACE + MODULE PURE SUBROUTINE Swap_Int128v(a, b) + INTEGER(INT128), INTENT(INOUT) :: a(:), b(:) + END SUBROUTINE Swap_Int128v END INTERFACE INTERFACE Swap - MODULE PROCEDURE Swap_r64v + MODULE PROCEDURE Swap_Int128v END INTERFACE Swap #endif @@ -130,8 +157,8 @@ END SUBROUTINE Swap_r64v !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 22 March 2021 -! summary: Subroutine for interchanging two complex numbers +! date: 22 March 2021 +! summary: Subroutine for interchanging two complex numbers INTERFACE MODULE PURE SUBROUTINE Swap_c(a, b) @@ -179,7 +206,7 @@ END SUBROUTINE Swap_cm INTERFACE MODULE PURE SUBROUTINE Swap_r32m(a, b) - REAL(Real32), INTENT(INOUT) :: a(:, :), b(:, :) + REAL(REAL32), INTENT(INOUT) :: a(:, :), b(:, :) END SUBROUTINE Swap_r32m END INTERFACE @@ -193,7 +220,7 @@ END SUBROUTINE Swap_r32m INTERFACE MODULE PURE SUBROUTINE Swap_r64m(a, b) - REAL(Real64), INTENT(INOUT) :: a(:, :), b(:, :) + REAL(REAL64), INTENT(INOUT) :: a(:, :), b(:, :) END SUBROUTINE Swap_r64m END INTERFACE @@ -207,7 +234,7 @@ END SUBROUTINE Swap_r64m INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32s(a, b, mask) - REAL(Real32), INTENT(INOUT) :: a, b + REAL(REAL32), INTENT(INOUT) :: a, b LOGICAL(LGT), INTENT(IN) :: mask END SUBROUTINE masked_Swap_r32s END INTERFACE @@ -222,7 +249,7 @@ END SUBROUTINE masked_Swap_r32s INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64s(a, b, mask) - REAL(Real64), INTENT(INOUT) :: a, b + REAL(REAL64), INTENT(INOUT) :: a, b LOGICAL(LGT), INTENT(IN) :: mask END SUBROUTINE masked_Swap_r64s END INTERFACE @@ -237,7 +264,7 @@ END SUBROUTINE masked_Swap_r64s INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32v(a, b, mask) - REAL(Real32), INTENT(INOUT) :: a(:), b(:) + REAL(REAL32), INTENT(INOUT) :: a(:), b(:) LOGICAL(LGT), INTENT(IN) :: mask(:) END SUBROUTINE masked_Swap_r32v END INTERFACE @@ -252,7 +279,7 @@ END SUBROUTINE masked_Swap_r32v INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64v(a, b, mask) - REAL(Real64), INTENT(INOUT) :: a(:), b(:) + REAL(REAL64), INTENT(INOUT) :: a(:), b(:) LOGICAL(LGT), INTENT(IN) :: mask(:) END SUBROUTINE masked_Swap_r64v END INTERFACE @@ -267,7 +294,7 @@ END SUBROUTINE masked_Swap_r64v INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32m(a, b, mask) - REAL(Real32), INTENT(INOUT) :: a(:, :), b(:, :) + REAL(REAL32), INTENT(INOUT) :: a(:, :), b(:, :) LOGICAL(LGT), INTENT(IN) :: mask(:, :) END SUBROUTINE masked_Swap_r32m END INTERFACE @@ -282,7 +309,7 @@ END SUBROUTINE masked_Swap_r32m INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64m(a, b, mask) - REAL(Real64), INTENT(INOUT) :: a(:, :), b(:, :) + REAL(REAL64), INTENT(INOUT) :: a(:, :), b(:, :) LOGICAL(LGT), INTENT(IN) :: mask(:, :) END SUBROUTINE masked_Swap_r64m END INTERFACE @@ -310,9 +337,9 @@ END SUBROUTINE masked_Swap_r64m INTERFACE MODULE PURE SUBROUTINE Swap_index1(a, b, i1, i2) - REAL(Real32), ALLOCATABLE, INTENT(INOUT) :: a(:, :) + REAL(REAL32), ALLOCATABLE, INTENT(INOUT) :: a(:, :) !! the returned array - REAL(Real32), INTENT(IN) :: b(:, :) + REAL(REAL32), INTENT(IN) :: b(:, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` @@ -346,9 +373,9 @@ END SUBROUTINE Swap_index1 INTERFACE MODULE PURE SUBROUTINE Swap_index2(a, b, i1, i2) - REAL(Real64), ALLOCATABLE, INTENT(INOUT) :: a(:, :) + REAL(REAL64), ALLOCATABLE, INTENT(INOUT) :: a(:, :) !! the returned array - REAL(Real64), INTENT(IN) :: b(:, :) + REAL(REAL64), INTENT(IN) :: b(:, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` @@ -382,9 +409,9 @@ END SUBROUTINE Swap_index2 INTERFACE MODULE PURE SUBROUTINE Swap_index3(a, b, i1, i2, i3) - REAL(Real32), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :) + REAL(REAL32), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :) !! the returned array - REAL(Real32), INTENT(IN) :: b(:, :, :) + REAL(REAL32), INTENT(IN) :: b(:, :, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` @@ -421,9 +448,9 @@ END SUBROUTINE Swap_index3 INTERFACE MODULE PURE SUBROUTINE Swap_index4(a, b, i1, i2, i3) - REAL(Real64), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :) + REAL(REAL64), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :) !! the returned array - REAL(Real64), INTENT(IN) :: b(:, :, :) + REAL(REAL64), INTENT(IN) :: b(:, :, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` @@ -459,9 +486,9 @@ END SUBROUTINE Swap_index4 INTERFACE MODULE PURE SUBROUTINE Swap_index5(a, b, i1, i2, i3, i4) - REAL(Real64), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :, :) + REAL(REAL64), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :, :) !! the returned array - REAL(Real64), INTENT(IN) :: b(:, :, :, :) + REAL(REAL64), INTENT(IN) :: b(:, :, :, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` @@ -500,9 +527,9 @@ END SUBROUTINE Swap_index5 INTERFACE MODULE PURE SUBROUTINE Swap_index6(a, b, i1, i2, i3, i4) - REAL(Real32), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :, :) + REAL(REAL32), ALLOCATABLE, INTENT(INOUT) :: a(:, :, :, :) !! the returned array - REAL(Real32), INTENT(IN) :: b(:, :, :, :) + REAL(REAL32), INTENT(IN) :: b(:, :, :, :) !! input array, it will be untouched INTEGER(I4B), INTENT(IN) :: i1 !! index 1 is Swapped with index `i1` diff --git a/src/submodules/Utility/src/SwapUtility@Methods.F90 b/src/submodules/Utility/src/SwapUtility@Methods.F90 index 97df914d3..2f03868a0 100644 --- a/src/submodules/Utility/src/SwapUtility@Methods.F90 +++ b/src/submodules/Utility/src/SwapUtility@Methods.F90 @@ -29,31 +29,43 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE swap_Int8 - INTEGER(Int8) :: dum - dum = a - a = b - b = dum +INTEGER(INT8) :: dum +dum = a +a = b +b = dum END PROCEDURE swap_Int8 +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + MODULE PROCEDURE swap_Int16 - INTEGER(Int16) :: dum - dum = a - a = b - b = dum +INTEGER(INT16) :: dum +dum = a +a = b +b = dum END PROCEDURE swap_Int16 +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + MODULE PROCEDURE swap_Int32 - INTEGER(Int32) :: dum - dum = a - a = b - b = dum +INTEGER(INT32) :: dum +dum = a +a = b +b = dum END PROCEDURE swap_Int32 +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + MODULE PROCEDURE swap_Int64 - INTEGER(Int64) :: dum - dum = a - a = b - b = dum +INTEGER(INT64) :: dum +dum = a +a = b +b = dum END PROCEDURE swap_Int64 !---------------------------------------------------------------------------- @@ -61,7 +73,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE swap_r32 -REAL(Real32) :: dum +REAL(REAL32) :: dum dum = a a = b b = dum @@ -72,7 +84,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE swap_r64 -REAL(Real64) :: dum +REAL(REAL64) :: dum dum = a a = b b = dum @@ -84,26 +96,81 @@ #ifndef USE_BLAS95 MODULE PROCEDURE swap_r32v -REAL(Real32), DIMENSION(SIZE(a)) :: dum +REAL(REAL32), DIMENSION(SIZE(a)) :: dum dum = a a = b b = dum END PROCEDURE swap_r32v -#endif !---------------------------------------------------------------------------- -! SWAP +! SWAP !---------------------------------------------------------------------------- -#ifndef USE_BLAS95 MODULE PROCEDURE swap_r64v -REAL(Real64), DIMENSION(SIZE(a)) :: dum +REAL(REAL64), DIMENSION(SIZE(a)) :: dum dum = a a = b b = dum END PROCEDURE swap_r64v #endif +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int8v +INTEGER(INT8), DIMENSION(SIZE(a)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int8v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int16v +INTEGER(INT16), DIMENSION(SIZE(a)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int16v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int32v +INTEGER(INT32), DIMENSION(SIZE(a)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int32v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int64v +INTEGER(INT64), DIMENSION(SIZE(a)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int64v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE swap_Int128v +INTEGER(Int128), DIMENSION(SIZE(a)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int128v +#endif + !---------------------------------------------------------------------------- ! SWAP !---------------------------------------------------------------------------- @@ -144,7 +211,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE swap_r32m -REAL( Real32 ), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +REAL(REAL32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum dum = a a = b b = dum @@ -155,7 +222,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE swap_r64m -REAL( Real32 ), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +REAL(REAL32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum dum = a a = b b = dum @@ -166,7 +233,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r32s -REAL(Real32) :: swp +REAL(REAL32) :: swp IF (mask) THEN swp = a a = b @@ -179,7 +246,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r64s -REAL(Real64) :: swp +REAL(REAL64) :: swp IF (mask) THEN swp = a a = b @@ -192,7 +259,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r32v -REAL(Real32), DIMENSION(SIZE(a)) :: swp +REAL(REAL32), DIMENSION(SIZE(a)) :: swp WHERE (mask) swp = a a = b @@ -205,7 +272,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r64v -REAL(Real64), DIMENSION(SIZE(a)) :: swp +REAL(REAL64), DIMENSION(SIZE(a)) :: swp WHERE (mask) swp = a a = b @@ -218,7 +285,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r32m -REAL(Real32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +REAL(REAL32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp WHERE (mask) swp = a a = b @@ -231,7 +298,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE masked_swap_r64m -REAL(Real64), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +REAL(REAL64), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp WHERE (mask) swp = a a = b From 4a0eafecc4c1dbf228fa730dce1a75c27fa19d35 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 27 Jun 2023 09:23:36 +0900 Subject: [PATCH 13/16] Updates in SwapUtility Implemented Swap(a,b) and Swap(a,b,mask) methods for integer arrays. --- src/modules/Utility/src/SwapUtility.F90 | 244 +++++++++++++++++ .../Utility/src/SwapUtility@Methods.F90 | 258 ++++++++++++++++++ 2 files changed, 502 insertions(+) diff --git a/src/modules/Utility/src/SwapUtility.F90 b/src/modules/Utility/src/SwapUtility.F90 index 53c767dcc..e3c6c43bd 100644 --- a/src/modules/Utility/src/SwapUtility.F90 +++ b/src/modules/Utility/src/SwapUtility.F90 @@ -204,6 +204,10 @@ END SUBROUTINE Swap_cm ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two matrix of real numbers + INTERFACE MODULE PURE SUBROUTINE Swap_r32m(a, b) REAL(REAL32), INTENT(INOUT) :: a(:, :), b(:, :) @@ -218,6 +222,10 @@ END SUBROUTINE Swap_r32m ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two real matrix + INTERFACE MODULE PURE SUBROUTINE Swap_r64m(a, b) REAL(REAL64), INTENT(INOUT) :: a(:, :), b(:, :) @@ -232,6 +240,56 @@ END SUBROUTINE Swap_r64m ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two integer matrix + +INTERFACE + MODULE PURE SUBROUTINE Swap_Int8m(a, b) + INTEGER(INT8), INTENT(INOUT) :: a(:, :), b(:, :) + END SUBROUTINE Swap_Int8m + + MODULE PURE SUBROUTINE Swap_Int16m(a, b) + INTEGER(INT16), INTENT(INOUT) :: a(:, :), b(:, :) + END SUBROUTINE Swap_Int16m + + MODULE PURE SUBROUTINE Swap_Int32m(a, b) + INTEGER(INT32), INTENT(INOUT) :: a(:, :), b(:, :) + END SUBROUTINE Swap_Int32m + + MODULE PURE SUBROUTINE Swap_Int64m(a, b) + INTEGER(INT64), INTENT(INOUT) :: a(:, :), b(:, :) + END SUBROUTINE Swap_Int64m +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE Swap_Int8m, Swap_Int16m, Swap_Int32m, Swap_Int64m +END INTERFACE + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +INTERFACE + MODULE PURE SUBROUTINE Swap_Int128m(a, b) + INTEGER(Int128), INTENT(INOUT) :: a(:, :), b(:, :) + END SUBROUTINE Swap_Int128m +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE Swap_Int128m +END INTERFACE +#endif + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two scalars with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32s(a, b, mask) REAL(REAL32), INTENT(INOUT) :: a, b @@ -247,6 +305,10 @@ END SUBROUTINE masked_Swap_r32s ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two scalars with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64s(a, b, mask) REAL(REAL64), INTENT(INOUT) :: a, b @@ -262,6 +324,66 @@ END SUBROUTINE masked_Swap_r64s ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two scalars with masking + +INTERFACE + MODULE PURE SUBROUTINE masked_Swap_Int8s(a, b, mask) + INTEGER(INT8), INTENT(INOUT) :: a, b + LOGICAL(LGT), INTENT(IN) :: mask + END SUBROUTINE masked_Swap_Int8s + + MODULE PURE SUBROUTINE masked_Swap_Int16s(a, b, mask) + INTEGER(INT16), INTENT(INOUT) :: a, b + LOGICAL(LGT), INTENT(IN) :: mask + END SUBROUTINE masked_Swap_Int16s + + MODULE PURE SUBROUTINE masked_Swap_Int32s(a, b, mask) + INTEGER(INT32), INTENT(INOUT) :: a, b + LOGICAL(LGT), INTENT(IN) :: mask + END SUBROUTINE masked_Swap_Int32s + + MODULE PURE SUBROUTINE masked_Swap_Int64s(a, b, mask) + INTEGER(INT64), INTENT(INOUT) :: a, b + LOGICAL(LGT), INTENT(IN) :: mask + END SUBROUTINE masked_Swap_Int64s +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int8s, masked_Swap_Int16s, & + & masked_Swap_Int32s, masked_Swap_Int64s +END INTERFACE + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two scalars with masking + +#ifdef USE_Int128 +INTERFACE + MODULE PURE SUBROUTINE masked_Swap_Int128s(a, b, mask) + INTEGER(Int128), INTENT(INOUT) :: a, b + LOGICAL(LGT), INTENT(IN) :: mask + END SUBROUTINE masked_Swap_Int128s +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int128s +END INTERFACE +#endif + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two vectors with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32v(a, b, mask) REAL(REAL32), INTENT(INOUT) :: a(:), b(:) @@ -277,6 +399,10 @@ END SUBROUTINE masked_Swap_r32v ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two vectors with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64v(a, b, mask) REAL(REAL64), INTENT(INOUT) :: a(:), b(:) @@ -292,6 +418,64 @@ END SUBROUTINE masked_Swap_r64v ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two vectors with masking + +INTERFACE + MODULE PURE SUBROUTINE masked_Swap_Int8v(a, b, mask) + INTEGER(INT8), INTENT(INOUT) :: a(:), b(:) + LOGICAL(LGT), INTENT(IN) :: mask(:) + END SUBROUTINE masked_Swap_Int8v + + MODULE PURE SUBROUTINE masked_Swap_Int16v(a, b, mask) + INTEGER(INT16), INTENT(INOUT) :: a(:), b(:) + LOGICAL(LGT), INTENT(IN) :: mask(:) + END SUBROUTINE masked_Swap_Int16v + + MODULE PURE SUBROUTINE masked_Swap_Int32v(a, b, mask) + INTEGER(INT32), INTENT(INOUT) :: a(:), b(:) + LOGICAL(LGT), INTENT(IN) :: mask(:) + END SUBROUTINE masked_Swap_Int32v + + MODULE PURE SUBROUTINE masked_Swap_Int64v(a, b, mask) + INTEGER(INT64), INTENT(INOUT) :: a(:), b(:) + LOGICAL(LGT), INTENT(IN) :: mask(:) + END SUBROUTINE masked_Swap_Int64v +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int8v, masked_Swap_Int16v, & + & masked_Swap_Int32v, masked_Swap_Int64v +END INTERFACE + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two vectors with masking + +#ifdef USE_Int128 +MODULE PURE SUBROUTINE masked_Swap_Int128v(a, b, mask) + INTEGER(Int128), INTENT(INOUT) :: a(:), b(:) + LOGICAL(LGT), INTENT(IN) :: mask(:) +END SUBROUTINE masked_Swap_Int128v + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int128v +END INTERFACE +#endif + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two matrices with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r32m(a, b, mask) REAL(REAL32), INTENT(INOUT) :: a(:, :), b(:, :) @@ -307,6 +491,10 @@ END SUBROUTINE masked_Swap_r32m ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two matrices with masking + INTERFACE MODULE PURE SUBROUTINE masked_Swap_r64m(a, b, mask) REAL(REAL64), INTENT(INOUT) :: a(:, :), b(:, :) @@ -322,6 +510,62 @@ END SUBROUTINE masked_Swap_r64m ! Swap@SwapMethods !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two matrices with masking + +INTERFACE + MODULE PURE SUBROUTINE masked_Swap_Int8m(a, b, mask) + INTEGER(INT8), INTENT(INOUT) :: a(:, :), b(:, :) + LOGICAL(LGT), INTENT(IN) :: mask(:, :) + END SUBROUTINE masked_Swap_Int8m + + MODULE PURE SUBROUTINE masked_Swap_Int16m(a, b, mask) + INTEGER(INT16), INTENT(INOUT) :: a(:, :), b(:, :) + LOGICAL(LGT), INTENT(IN) :: mask(:, :) + END SUBROUTINE masked_Swap_Int16m + + MODULE PURE SUBROUTINE masked_Swap_Int32m(a, b, mask) + INTEGER(INT32), INTENT(INOUT) :: a(:, :), b(:, :) + LOGICAL(LGT), INTENT(IN) :: mask(:, :) + END SUBROUTINE masked_Swap_Int32m + + MODULE PURE SUBROUTINE masked_Swap_Int64m(a, b, mask) + INTEGER(INT64), INTENT(INOUT) :: a(:, :), b(:, :) + LOGICAL(LGT), INTENT(IN) :: mask(:, :) + END SUBROUTINE masked_Swap_Int64m +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int8m, masked_Swap_Int16m, & + & masked_Swap_Int32m, masked_Swap_Int64m +END INTERFACE + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Swap two matrices with masking + +#ifdef USE_Int128 +INTERFACE + MODULE PURE SUBROUTINE masked_Swap_Int128m(a, b, mask) + INTEGER(Int128), INTENT(INOUT) :: a(:, :), b(:, :) + LOGICAL(LGT), INTENT(IN) :: mask(:, :) + END SUBROUTINE masked_Swap_Int128m +END INTERFACE + +INTERFACE Swap + MODULE PROCEDURE masked_Swap_Int128m +END INTERFACE +#endif + +!---------------------------------------------------------------------------- +! Swap@SwapMethods +!---------------------------------------------------------------------------- + !> author: Vikas Sharma, Ph. D. ! date: 2021-11-20 ! update: 2021-11-20 diff --git a/src/submodules/Utility/src/SwapUtility@Methods.F90 b/src/submodules/Utility/src/SwapUtility@Methods.F90 index 2f03868a0..a078cd38d 100644 --- a/src/submodules/Utility/src/SwapUtility@Methods.F90 +++ b/src/submodules/Utility/src/SwapUtility@Methods.F90 @@ -228,6 +228,63 @@ b = dum END PROCEDURE swap_r64m +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int8m +INTEGER(INT8), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int8m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int16m +INTEGER(INT16), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int16m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int32m +INTEGER(INT32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int32m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE swap_Int64m +INTEGER(INT64), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int64m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE swap_Int128m +INTEGER(Int128), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: dum +dum = a +a = b +b = dum +END PROCEDURE swap_Int128m +#endif + !---------------------------------------------------------------------------- ! SWAP !---------------------------------------------------------------------------- @@ -258,6 +315,73 @@ ! SWAP !---------------------------------------------------------------------------- +MODULE PROCEDURE masked_swap_Int8s +INTEGER(INT8) :: swp +IF (mask) THEN + swp = a + a = b + b = swp +END IF +END PROCEDURE masked_swap_Int8s + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int16s +INTEGER(INT16) :: swp +IF (mask) THEN + swp = a + a = b + b = swp +END IF +END PROCEDURE masked_swap_Int16s + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int32s +INTEGER(INT32) :: swp +IF (mask) THEN + swp = a + a = b + b = swp +END IF +END PROCEDURE masked_swap_Int32s + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int64s +INTEGER(INT64) :: swp +IF (mask) THEN + swp = a + a = b + b = swp +END IF +END PROCEDURE masked_swap_Int64s + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE masked_swap_Int128s +INTEGER(Int128) :: swp +IF (mask) THEN + swp = a + a = b + b = swp +END IF +END PROCEDURE masked_swap_Int128s +#endif + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + MODULE PROCEDURE masked_swap_r32v REAL(REAL32), DIMENSION(SIZE(a)) :: swp WHERE (mask) @@ -280,6 +404,73 @@ END WHERE END PROCEDURE masked_swap_r64v +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int8v +INTEGER(INT8), DIMENSION(SIZE(a)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int8v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int16v +INTEGER(INT16), DIMENSION(SIZE(a)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int16v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int32v +INTEGER(INT32), DIMENSION(SIZE(a)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int32v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int64v +INTEGER(INT64), DIMENSION(SIZE(a)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int64v + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE masked_swap_Int128v +INTEGER(Int128), DIMENSION(SIZE(a)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int128v +#endif + !---------------------------------------------------------------------------- ! SWAP !---------------------------------------------------------------------------- @@ -306,6 +497,73 @@ END WHERE END PROCEDURE masked_swap_r64m +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int8m +INTEGER(INT8), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int8m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int16m +INTEGER(INT16), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int16m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int32m +INTEGER(INT32), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int32m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +MODULE PROCEDURE masked_swap_Int64m +INTEGER(INT64), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int64m + +!---------------------------------------------------------------------------- +! SWAP +!---------------------------------------------------------------------------- + +#ifdef USE_Int128 +MODULE PROCEDURE masked_swap_Int128m +INTEGER(Int128), DIMENSION(SIZE(a, 1), SIZE(a, 2)) :: swp +WHERE (mask) + swp = a + a = b + b = swp +END WHERE +END PROCEDURE masked_swap_Int128m +#endif + !---------------------------------------------------------------------------- ! SWAP !---------------------------------------------------------------------------- From 1ae29ce6a2cbba1bf455b2f412c5cc26b0954eb1 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 27 Jun 2023 12:20:58 +0900 Subject: [PATCH 14/16] Updates in SortUtility Added: - InsertionSort - ArgInsertionSort --- src/modules/Utility/src/SortUtility.F90 | 247 +++++++++++++----- .../src/InsertionSort/ArgInsertionSort.inc | 28 ++ .../src/InsertionSort/InsertionSort.inc | 28 ++ .../Utility/src/SortUtility@Methods.F90 | 68 ++++- 4 files changed, 297 insertions(+), 74 deletions(-) create mode 100644 src/submodules/Utility/src/InsertionSort/ArgInsertionSort.inc create mode 100644 src/submodules/Utility/src/InsertionSort/InsertionSort.inc diff --git a/src/modules/Utility/src/SortUtility.F90 b/src/modules/Utility/src/SortUtility.F90 index 8fc847e79..2b5bf2ed0 100644 --- a/src/modules/Utility/src/SortUtility.F90 +++ b/src/modules/Utility/src/SortUtility.F90 @@ -20,14 +20,125 @@ MODULE SortUtility IMPLICIT NONE PRIVATE -PUBLIC :: HeapSort PUBLIC :: ArgHeapSort +PUBLIC :: HeapSort PUBLIC :: QuickSort PUBLIC :: Sort PUBLIC :: ArgSort +PUBLIC :: InsertionSort +PUBLIC :: ArgInsertionSort + +!---------------------------------------------------------------------------- +! IntroSort +!---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Sorting by insertion algorithm + +INTERFACE + MODULE PURE SUBROUTINE InsertionSort_Int8(array, low, high) + INTEGER(INT8), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Int8 + MODULE PURE SUBROUTINE InsertionSort_Int16(array, low, high) + INTEGER(INT16), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Int16 + MODULE PURE SUBROUTINE InsertionSort_Int32(array, low, high) + INTEGER(INT32), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Int32 + MODULE PURE SUBROUTINE InsertionSort_Int64(array, low, high) + INTEGER(INT64), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Int64 + MODULE PURE SUBROUTINE InsertionSort_Real32(array, low, high) + REAL(REAL32), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Real32 + MODULE PURE SUBROUTINE InsertionSort_Real64(array, low, high) + REAL(REAL64), INTENT(INOUT) :: array(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE InsertionSort_Real64 +END INTERFACE + +INTERFACE InsertionSort + MODULE PROCEDURE InsertionSort_Int8, InsertionSort_Int16, & + & InsertionSort_Int32, InsertionSort_Int64, InsertionSort_Real32, & + & InsertionSort_Real64 +END INTERFACE InsertionSort + +!---------------------------------------------------------------------------- +! ArgInsertionSort !---------------------------------------------------------------------------- -! HeapSort@Sort + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Indirect sorting by insertion sort + +INTERFACE + MODULE PURE SUBROUTINE ArgInsertionSort_Int8(array, arg, low, high) + INTEGER(INT8), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Int8 + + MODULE PURE SUBROUTINE ArgInsertionSort_Int16(array, arg, low, high) + INTEGER(INT16), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Int16 + + MODULE PURE SUBROUTINE ArgInsertionSort_Int32(array, arg, low, high) + INTEGER(INT32), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Int32 + + MODULE PURE SUBROUTINE ArgInsertionSort_Int64(array, arg, low, high) + INTEGER(INT64), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Int64 + + MODULE PURE SUBROUTINE ArgInsertionSort_Real32(array, arg, low, high) + REAL(REAL32), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Real32 + + MODULE PURE SUBROUTINE ArgInsertionSort_Real64(array, arg, low, high) + REAL(REAL64), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + INTEGER(I4B), INTENT(IN) :: low + INTEGER(I4B), INTENT(IN) :: high + END SUBROUTINE ArgInsertionSort_Real64 +END INTERFACE + +INTERFACE ArgInsertionSort + MODULE PROCEDURE & + & ArgInsertionSort_Int8, & + & ArgInsertionSort_Int16, & + & ArgInsertionSort_Int32, & + & ArgInsertionSort_Int64, & + & ArgInsertionSort_Real32, & + & ArgInsertionSort_Real64 +END INTERFACE ArgInsertionSort + +!---------------------------------------------------------------------------- +! HeapSort !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. @@ -36,22 +147,22 @@ MODULE SortUtility INTERFACE MODULE PURE SUBROUTINE HeapSort_Int8(array) - INTEGER(Int8), INTENT(INOUT) :: array(:) + INTEGER(INT8), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Int8 MODULE PURE SUBROUTINE HeapSort_Int16(array) - INTEGER(Int16), INTENT(INOUT) :: array(:) + INTEGER(INT16), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Int16 MODULE PURE SUBROUTINE HeapSort_Int32(array) - INTEGER(Int32), INTENT(INOUT) :: array(:) + INTEGER(INT32), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Int32 MODULE PURE SUBROUTINE HeapSort_Int64(array) - INTEGER(Int64), INTENT(INOUT) :: array(:) + INTEGER(INT64), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Int64 MODULE PURE SUBROUTINE HeapSort_Real32(array) - REAL(Real32), INTENT(INOUT) :: array(:) + REAL(REAL32), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Real32 MODULE PURE SUBROUTINE HeapSort_Real64(array) - REAL(Real64), INTENT(INOUT) :: array(:) + REAL(REAL64), INTENT(INOUT) :: array(:) END SUBROUTINE HeapSort_Real64 END INTERFACE @@ -61,7 +172,7 @@ END SUBROUTINE HeapSort_Real64 END INTERFACE HeapSort !---------------------------------------------------------------------------- -! ArgHeapSort@Sort +! ArgHeapSort !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. @@ -70,32 +181,32 @@ END SUBROUTINE HeapSort_Real64 INTERFACE MODULE PURE SUBROUTINE ArgHeapSort_Int8(array, arg) - INTEGER(Int8), INTENT(IN) :: array(:) + INTEGER(INT8), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Int8 MODULE PURE SUBROUTINE ArgHeapSort_Int16(array, arg) - INTEGER(Int16), INTENT(IN) :: array(:) + INTEGER(INT16), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Int16 MODULE PURE SUBROUTINE ArgHeapSort_Int32(array, arg) - INTEGER(Int32), INTENT(IN) :: array(:) + INTEGER(INT32), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Int32 MODULE PURE SUBROUTINE ArgHeapSort_Int64(array, arg) - INTEGER(Int64), INTENT(IN) :: array(:) + INTEGER(INT64), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Int64 MODULE PURE SUBROUTINE ArgHeapSort_Real32(array, arg) - REAL(Real32), INTENT(IN) :: array(:) + REAL(REAL32), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Real32 MODULE PURE SUBROUTINE ArgHeapSort_Real64(array, arg) - REAL(Real64), INTENT(IN) :: array(:) + REAL(REAL64), INTENT(IN) :: array(:) INTEGER(I4B), INTENT(OUT) :: arg(0:) END SUBROUTINE ArgHeapSort_Real64 END INTERFACE @@ -106,32 +217,32 @@ END SUBROUTINE ArgHeapSort_Real64 END INTERFACE ArgHeapSort !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectInt8(vect1, low, high) - INTEGER(Int8), INTENT(INOUT) :: vect1(:) + INTEGER(INT8), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectInt8 MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectInt16(vect1, low, high) - INTEGER(Int16), INTENT(INOUT) :: vect1(:) + INTEGER(INT16), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectInt16 MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectInt32(vect1, low, high) - INTEGER(Int32), INTENT(INOUT) :: vect1(:) + INTEGER(INT32), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectInt32 MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectInt64(vect1, low, high) - INTEGER(Int64), INTENT(INOUT) :: vect1(:) + INTEGER(INT64), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectInt64 MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectReal32(vect1, low, high) - REAL(Real32), INTENT(INOUT) :: vect1(:) + REAL(REAL32), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectReal32 MODULE RECURSIVE PURE SUBROUTINE QuickSort1vectReal64(vect1, low, high) - REAL(Real64), INTENT(INOUT) :: vect1(:) + REAL(REAL64), INTENT(INOUT) :: vect1(:) INTEGER(I4B), INTENT(IN) :: low, high END SUBROUTINE QuickSort1vectReal64 END INTERFACE @@ -143,7 +254,7 @@ END SUBROUTINE QuickSort1vectReal64 END INTERFACE QuickSort !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -155,7 +266,7 @@ MODULE RECURSIVE PURE SUBROUTINE QuickSort2vectIR(vect1, vect2, low, high) END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -167,7 +278,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort2vectII(vect1, vect2, low, high) END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -179,7 +290,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort2vectRI(vect1, vect2, low, high) END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -191,7 +302,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort2vectRR(vect1, vect2, low, high) END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -203,7 +314,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectIII(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -216,7 +327,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectIIR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -229,7 +340,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectIRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -242,7 +353,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectIRI(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -254,7 +365,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectRRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -267,7 +378,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectRRI(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -280,7 +391,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectRIR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -293,7 +404,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort3vectRII(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -305,7 +416,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIIII(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -318,7 +429,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIIIR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -331,7 +442,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIIRI(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -344,7 +455,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIIRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -357,7 +468,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIRRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -370,7 +481,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIRRI(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -383,7 +494,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIRIR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -396,7 +507,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectIRII(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -408,7 +519,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRRRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -421,7 +532,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRRRI(vect1, vect2, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -434,7 +545,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRRIR(vect1, vect2, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -447,7 +558,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRRII(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -460,7 +571,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRIRR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -473,7 +584,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRIRI(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -486,7 +597,7 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRIIR(vect1, vect2, vect3, & END INTERFACE !---------------------------------------------------------------------------- -! QuickSort@Sort +! QuickSort !---------------------------------------------------------------------------- INTERFACE @@ -517,34 +628,34 @@ MODULE PURE RECURSIVE SUBROUTINE QuickSort4vectRIII(vect1, vect2, vect3, & INTERFACE MODULE PURE FUNCTION Sort_Int8(x, name) RESULT(ans) - INTEGER(Int8), INTENT(IN) :: x(:) + INTEGER(INT8), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - INTEGER(Int8) :: ans(SIZE(x)) + INTEGER(INT8) :: ans(SIZE(x)) END FUNCTION Sort_Int8 MODULE PURE FUNCTION Sort_Int16(x, name) RESULT(ans) - INTEGER(Int16), INTENT(IN) :: x(:) + INTEGER(INT16), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - INTEGER(Int16) :: ans(SIZE(x)) + INTEGER(INT16) :: ans(SIZE(x)) END FUNCTION Sort_Int16 MODULE PURE FUNCTION Sort_Int32(x, name) RESULT(ans) - INTEGER(Int32), INTENT(IN) :: x(:) + INTEGER(INT32), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - INTEGER(Int32) :: ans(SIZE(x)) + INTEGER(INT32) :: ans(SIZE(x)) END FUNCTION Sort_Int32 MODULE PURE FUNCTION Sort_Int64(x, name) RESULT(ans) - INTEGER(Int64), INTENT(IN) :: x(:) + INTEGER(INT64), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - INTEGER(Int64) :: ans(SIZE(x)) + INTEGER(INT64) :: ans(SIZE(x)) END FUNCTION Sort_Int64 MODULE PURE FUNCTION Sort_Real32(x, name) RESULT(ans) - Real(Real32), INTENT(IN) :: x(:) + REAL(REAL32), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - Real(Real32) :: ans(SIZE(x)) + REAL(REAL32) :: ans(SIZE(x)) END FUNCTION Sort_Real32 MODULE PURE FUNCTION Sort_Real64(x, name) RESULT(ans) - Real(Real64), INTENT(IN) :: x(:) + REAL(REAL64), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name - Real(Real64) :: ans(SIZE(x)) + REAL(REAL64) :: ans(SIZE(x)) END FUNCTION Sort_Real64 END INTERFACE @@ -559,32 +670,32 @@ END FUNCTION Sort_Real64 INTERFACE MODULE PURE FUNCTION ArgSort_Int8(x, name) RESULT(ans) - INTEGER(Int8), INTENT(IN) :: x(:) + INTEGER(INT8), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Int8 MODULE PURE FUNCTION ArgSort_Int16(x, name) RESULT(ans) - INTEGER(Int16), INTENT(IN) :: x(:) + INTEGER(INT16), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Int16 MODULE PURE FUNCTION ArgSort_Int32(x, name) RESULT(ans) - INTEGER(Int32), INTENT(IN) :: x(:) + INTEGER(INT32), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Int32 MODULE PURE FUNCTION ArgSort_Int64(x, name) RESULT(ans) - INTEGER(Int64), INTENT(IN) :: x(:) + INTEGER(INT64), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Int64 MODULE PURE FUNCTION ArgSort_Real32(x, name) RESULT(ans) - Real(Real32), INTENT(IN) :: x(:) + REAL(REAL32), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Real32 MODULE PURE FUNCTION ArgSort_Real64(x, name) RESULT(ans) - Real(Real64), INTENT(IN) :: x(:) + REAL(REAL64), INTENT(IN) :: x(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: name INTEGER(I4B) :: ans(SIZE(x)) END FUNCTION ArgSort_Real64 diff --git a/src/submodules/Utility/src/InsertionSort/ArgInsertionSort.inc b/src/submodules/Utility/src/InsertionSort/ArgInsertionSort.inc new file mode 100644 index 000000000..78ed3fe96 --- /dev/null +++ b/src/submodules/Utility/src/InsertionSort/ArgInsertionSort.inc @@ -0,0 +1,28 @@ +! 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 +! + +INTEGER(I4B) :: ii, jj + +DO ii = low, high + DO jj = ii, low + 1, -1 + IF (array(arg(jj)) < array(arg(jj - 1))) THEN + CALL SWAP(arg(jj), arg(jj - 1)) + ELSE + EXIT + END IF + END DO +END DO diff --git a/src/submodules/Utility/src/InsertionSort/InsertionSort.inc b/src/submodules/Utility/src/InsertionSort/InsertionSort.inc new file mode 100644 index 000000000..76778c5c8 --- /dev/null +++ b/src/submodules/Utility/src/InsertionSort/InsertionSort.inc @@ -0,0 +1,28 @@ +! 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 +! + +INTEGER(I4B) :: ii, jj + +DO ii = low, high + DO jj = ii, low + 1, -1 + IF (array(jj) < array(jj - 1)) THEN + CALL SWAP(array(jj), array(jj - 1)) + ELSE + EXIT + END IF + END DO +END DO diff --git a/src/submodules/Utility/src/SortUtility@Methods.F90 b/src/submodules/Utility/src/SortUtility@Methods.F90 index e9c1665ad..c90947fb7 100644 --- a/src/submodules/Utility/src/SortUtility@Methods.F90 +++ b/src/submodules/Utility/src/SortUtility@Methods.F90 @@ -24,37 +24,93 @@ IMPLICIT NONE CONTAINS +!---------------------------------------------------------------------------- +! InsertionSort +!---------------------------------------------------------------------------- + +MODULE PROCEDURE InsertionSort_Int8 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Int8 + +MODULE PROCEDURE InsertionSort_Int16 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Int16 + +MODULE PROCEDURE InsertionSort_Int32 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Int32 + +MODULE PROCEDURE InsertionSort_Int64 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Int64 + +MODULE PROCEDURE InsertionSort_Real32 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Real32 + +MODULE PROCEDURE InsertionSort_Real64 +#include "./InsertionSort/InsertionSort.inc" +END PROCEDURE InsertionSort_Real64 + +!---------------------------------------------------------------------------- +! ArgInsertionSort +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgInsertionSort_Int8 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Int8 + +MODULE PROCEDURE ArgInsertionSort_Int16 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Int16 + +MODULE PROCEDURE ArgInsertionSort_Int32 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Int32 + +MODULE PROCEDURE ArgInsertionSort_Int64 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Int64 + +MODULE PROCEDURE ArgInsertionSort_Real32 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Real32 + +MODULE PROCEDURE ArgInsertionSort_Real64 +#include "./InsertionSort/ArgInsertionSort.inc" +END PROCEDURE ArgInsertionSort_Real64 + !---------------------------------------------------------------------------- ! HeapSort !---------------------------------------------------------------------------- MODULE PROCEDURE HeapSort_Int8 -INTEGER(Int8) :: t +INTEGER(INT8) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Int8 MODULE PROCEDURE HeapSort_Int16 -INTEGER(Int16) :: t +INTEGER(INT16) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Int16 MODULE PROCEDURE HeapSort_Int32 -INTEGER(Int32) :: t +INTEGER(INT32) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Int32 MODULE PROCEDURE HeapSort_Int64 -INTEGER(Int64) :: t +INTEGER(INT64) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Int64 MODULE PROCEDURE HeapSort_Real32 -REAL(Real32) :: t +REAL(REAL32) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Real32 MODULE PROCEDURE HeapSort_Real64 -REAL(Real64) :: t +REAL(REAL64) :: t #include "./HeapSort/HeapSort.inc" END PROCEDURE HeapSort_Real64 From 6a51c9c87a7ef8f48d3288015e5cc40076457482 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Tue, 27 Jun 2023 16:40:50 +0900 Subject: [PATCH 15/16] Update in SortUtility New sorting algorithms are added. - QuickSort - HeapSort - IntroSort - InsertionSort - ArgHeapSort - ArgIntroSort - ArgInsertionSort TODO - ArgQuickSort --- src/modules/Utility/CMakeLists.txt | 2 + .../Utility/src/ContractionUtility.F90 | 36 +- src/modules/Utility/src/DiagUtility.F90 | 126 ++--- src/modules/Utility/src/EigenUtility.F90 | 34 +- src/modules/Utility/src/HashingUtility.F90 | 2 +- src/modules/Utility/src/IntegerUtility.F90 | 15 +- .../Utility/src/LinearAlgebraUtility.F90 | 7 +- src/modules/Utility/src/MedianUtility.F90 | 131 +++++ src/modules/Utility/src/PartitionUtility.F90 | 174 +++++++ src/modules/Utility/src/ProductUtility.F90 | 478 +++++++++--------- src/modules/Utility/src/SortUtility.F90 | 99 +++- src/modules/Utility/src/StringUtility.F90 | 69 +-- src/modules/Utility/src/Utility.F90 | 2 + .../MdEncode/src/MdEncode_Method@Methods.F90 | 9 +- src/submodules/Utility/CMakeLists.txt | 2 + .../Utility/src/IntegerUtility@Methods.F90 | 20 +- .../Utility/src/IntroSort/ArgIntroSort.inc | 16 + .../Utility/src/IntroSort/IntroSort.inc | 16 + .../src/IntroSort/Recursive_ArgIntroSort.inc | 31 ++ .../src/IntroSort/Recursive_IntroSort.inc | 32 ++ .../Utility/src/Median/ArgMedian.inc | 20 + src/submodules/Utility/src/Median/Median.inc | 20 + .../Utility/src/MedianUtility@Methods.F90 | 119 +++++ .../Utility/src/Partition/ArgPartition.inc | 34 ++ .../Utility/src/Partition/Partition.inc | 35 ++ .../Utility/src/PartitionUtility@Methods.F90 | 143 ++++++ .../Utility/src/Repeat/Repeat_1.inc | 2 +- src/submodules/Utility/src/Sort/ArgSort.inc | 12 +- src/submodules/Utility/src/Sort/Sort.inc | 8 +- .../Utility/src/SortUtility@Methods.F90 | 270 +++++++++- .../Utility/src/StringUtility@Methods.F90 | 14 +- 31 files changed, 1556 insertions(+), 422 deletions(-) create mode 100644 src/modules/Utility/src/MedianUtility.F90 create mode 100644 src/modules/Utility/src/PartitionUtility.F90 create mode 100644 src/submodules/Utility/src/IntroSort/ArgIntroSort.inc create mode 100644 src/submodules/Utility/src/IntroSort/IntroSort.inc create mode 100644 src/submodules/Utility/src/IntroSort/Recursive_ArgIntroSort.inc create mode 100644 src/submodules/Utility/src/IntroSort/Recursive_IntroSort.inc create mode 100644 src/submodules/Utility/src/Median/ArgMedian.inc create mode 100644 src/submodules/Utility/src/Median/Median.inc create mode 100644 src/submodules/Utility/src/MedianUtility@Methods.F90 create mode 100644 src/submodules/Utility/src/Partition/ArgPartition.inc create mode 100644 src/submodules/Utility/src/Partition/Partition.inc create mode 100644 src/submodules/Utility/src/PartitionUtility@Methods.F90 diff --git a/src/modules/Utility/CMakeLists.txt b/src/modules/Utility/CMakeLists.txt index 34d2d2cf9..fbc5ef56c 100644 --- a/src/modules/Utility/CMakeLists.txt +++ b/src/modules/Utility/CMakeLists.txt @@ -38,6 +38,8 @@ TARGET_SOURCES( ${src_path}/MiscUtility.F90 ${src_path}/ProductUtility.F90 ${src_path}/ReallocateUtility.F90 + ${src_path}/PartitionUtility.F90 + ${src_path}/MedianUtility.F90 ${src_path}/SortUtility.F90 ${src_path}/StringUtility.F90 ${src_path}/SwapUtility.F90 diff --git a/src/modules/Utility/src/ContractionUtility.F90 b/src/modules/Utility/src/ContractionUtility.F90 index c7be7be2a..45f15dce3 100644 --- a/src/modules/Utility/src/ContractionUtility.F90 +++ b/src/modules/Utility/src/ContractionUtility.F90 @@ -38,7 +38,7 @@ MODULE ContractionUtility MODULE PURE FUNCTION Contraction_r4_r1(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :, :, :) REAL(DFP), INTENT(IN) :: a2(:) - REAL(DFP) :: ans(size(a1, 1), size(a1, 2), size(a1, 3)) + REAL(DFP) :: ans(SIZE(a1, 1), SIZE(a1, 2), SIZE(a1, 3)) END FUNCTION END INTERFACE @@ -61,8 +61,8 @@ MODULE PURE FUNCTION Contraction_r4_r1(a1, a2) RESULT(ans) INTERFACE MODULE PURE FUNCTION Contraction_r4_r2(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :, :, :) - REAL(DFP), INTENT(IN) :: a2(:,:) - REAL(DFP) :: ans(size(a1, 1), size(a1, 2)) + REAL(DFP), INTENT(IN) :: a2(:, :) + REAL(DFP) :: ans(SIZE(a1, 1), SIZE(a1, 2)) END FUNCTION END INTERFACE @@ -86,7 +86,7 @@ MODULE PURE FUNCTION Contraction_r4_r2(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r4_r3(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :, :, :) REAL(DFP), INTENT(IN) :: a2(:, :, :) - REAL(DFP) :: ans(size(a1, 1)) + REAL(DFP) :: ans(SIZE(a1, 1)) END FUNCTION END INTERFACE @@ -135,7 +135,7 @@ MODULE PURE FUNCTION Contraction_r4_r4(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r3_r1(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :, :) REAL(DFP), INTENT(IN) :: a2(:) - REAL(DFP) :: ans(size(a1, 1), size(a1, 2)) + REAL(DFP) :: ans(SIZE(a1, 1), SIZE(a1, 2)) END FUNCTION END INTERFACE @@ -159,7 +159,7 @@ MODULE PURE FUNCTION Contraction_r3_r1(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r3_r2(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :, :) REAL(DFP), INTENT(IN) :: a2(:, :) - REAL(DFP) :: ans(size(a1, 1)) + REAL(DFP) :: ans(SIZE(a1, 1)) END FUNCTION END INTERFACE @@ -181,7 +181,7 @@ MODULE PURE FUNCTION Contraction_r3_r2(a1, a2) RESULT(ans) INTERFACE MODULE PURE FUNCTION Contraction_r3_r3(a1, a2) RESULT(ans) - REAL(DFP), INTENT(IN) :: a1(:,:,:) + REAL(DFP), INTENT(IN) :: a1(:, :, :) REAL(DFP), INTENT(IN) :: a2(:, :, :) REAL(DFP) :: ans END FUNCTION @@ -205,9 +205,9 @@ MODULE PURE FUNCTION Contraction_r3_r3(a1, a2) RESULT(ans) INTERFACE MODULE PURE FUNCTION Contraction_r3_r4(a1, a2) RESULT(ans) - REAL(DFP), INTENT(IN) :: a1(:,:,:) + REAL(DFP), INTENT(IN) :: a1(:, :, :) REAL(DFP), INTENT(IN) :: a2(:, :, :, :) - REAL(DFP) :: ans(size(a2,4)) + REAL(DFP) :: ans(SIZE(a2, 4)) END FUNCTION END INTERFACE @@ -232,7 +232,7 @@ MODULE PURE FUNCTION Contraction_r3_r4(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r2_r1(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:, :) REAL(DFP), INTENT(IN) :: a2(:) - REAL(DFP) :: ans(size(a1, 1)) + REAL(DFP) :: ans(SIZE(a1, 1)) END FUNCTION END INTERFACE @@ -278,9 +278,9 @@ MODULE PURE FUNCTION Contraction_r2_r2(a1, a2) RESULT(ans) INTERFACE MODULE PURE FUNCTION Contraction_r2_r3(a1, a2) RESULT(ans) - REAL(DFP), INTENT(IN) :: a1(:,:) + REAL(DFP), INTENT(IN) :: a1(:, :) REAL(DFP), INTENT(IN) :: a2(:, :, :) - REAL(DFP) :: ans(size(a2,3)) + REAL(DFP) :: ans(SIZE(a2, 3)) END FUNCTION END INTERFACE @@ -302,9 +302,9 @@ MODULE PURE FUNCTION Contraction_r2_r3(a1, a2) RESULT(ans) INTERFACE MODULE PURE FUNCTION Contraction_r2_r4(a1, a2) RESULT(ans) - REAL(DFP), INTENT(IN) :: a1(:,:) + REAL(DFP), INTENT(IN) :: a1(:, :) REAL(DFP), INTENT(IN) :: a2(:, :, :, :) - REAL(DFP) :: ans(size(a2,3), size(a2,4)) + REAL(DFP) :: ans(SIZE(a2, 3), SIZE(a2, 4)) END FUNCTION END INTERFACE @@ -353,7 +353,7 @@ MODULE PURE FUNCTION Contraction_r1_r1(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r1_r2(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:) REAL(DFP), INTENT(IN) :: a2(:, :) - REAL(DFP) :: ans(size(a2,2)) + REAL(DFP) :: ans(SIZE(a2, 2)) END FUNCTION END INTERFACE @@ -377,7 +377,7 @@ MODULE PURE FUNCTION Contraction_r1_r2(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r1_r3(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:) REAL(DFP), INTENT(IN) :: a2(:, :, :) - REAL(DFP) :: ans(size(a2,2), size(a2,3)) + REAL(DFP) :: ans(SIZE(a2, 2), SIZE(a2, 3)) END FUNCTION END INTERFACE @@ -401,7 +401,7 @@ MODULE PURE FUNCTION Contraction_r1_r3(a1, a2) RESULT(ans) MODULE PURE FUNCTION Contraction_r1_r4(a1, a2) RESULT(ans) REAL(DFP), INTENT(IN) :: a1(:) REAL(DFP), INTENT(IN) :: a2(:, :, :, :) - REAL(DFP) :: ans(size(a2,2), size(a2,3), size(a2,4)) + REAL(DFP) :: ans(SIZE(a2, 2), SIZE(a2, 3), SIZE(a2, 4)) END FUNCTION END INTERFACE @@ -413,4 +413,4 @@ MODULE PURE FUNCTION Contraction_r1_r4(a1, a2) RESULT(ans) ! !---------------------------------------------------------------------------- -END MODULE ContractionUtility \ No newline at end of file +END MODULE ContractionUtility diff --git a/src/modules/Utility/src/DiagUtility.F90 b/src/modules/Utility/src/DiagUtility.F90 index f459f0f90..84dc81844 100644 --- a/src/modules/Utility/src/DiagUtility.F90 +++ b/src/modules/Utility/src/DiagUtility.F90 @@ -16,8 +16,8 @@ ! MODULE DiagUtility -USE GlobalData, ONLY: I4B, Int8, Int16, Int32, Int64, & -& Real32, Real64, DFP +USE GlobalData, ONLY: I4B, INT8, INT16, INT32, INT64, & +& REAL32, REAL64, DFP #ifdef USE_Int128 USE GlobaData, ONLY: Int128 #endif @@ -41,33 +41,33 @@ MODULE DiagUtility INTERFACE MODULE PURE FUNCTION Diag_1(a) RESULT(Ans) - INTEGER(Int8), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + INTEGER(INT8), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_1 MODULE PURE FUNCTION Diag_2(a) RESULT(Ans) - INTEGER(Int16), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + INTEGER(INT16), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_2 MODULE PURE FUNCTION Diag_3(a) RESULT(Ans) - INTEGER(Int32), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + INTEGER(INT32), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_3 MODULE PURE FUNCTION Diag_4(a) RESULT(Ans) - INTEGER(Int64), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + INTEGER(INT64), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_4 MODULE PURE FUNCTION Diag_5(a) RESULT(Ans) - REAL(Real32), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + REAL(REAL32), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_5 MODULE PURE FUNCTION Diag_6(a) RESULT(Ans) - REAL(Real64), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + REAL(REAL64), INTENT(IN) :: a(:) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_6 END INTERFACE @@ -89,7 +89,7 @@ END FUNCTION Diag_6 INTERFACE MODULE PURE FUNCTION Diag_7(a) RESULT(Ans) INTEGER(Int128), INTENT(IN) :: a(:) - REAL(DFP) :: ans(size(a), size(a)) + REAL(DFP) :: ans(SIZE(a), SIZE(a)) END FUNCTION Diag_7 END INTERFACE @@ -156,32 +156,32 @@ END FUNCTION Diag_8 INTERFACE MODULE PURE SUBROUTINE SetDiag1(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - INTEGER(Int8), INTENT(IN) :: d(:) + INTEGER(INT8), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag1 MODULE PURE SUBROUTINE SetDiag2(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - INTEGER(Int16), INTENT(IN) :: d(:) + INTEGER(INT16), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag2 MODULE PURE SUBROUTINE SetDiag3(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - INTEGER(Int32), INTENT(IN) :: d(:) + INTEGER(INT32), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag3 MODULE PURE SUBROUTINE SetDiag4(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - INTEGER(Int64), INTENT(IN) :: d(:) + INTEGER(INT64), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag4 MODULE PURE SUBROUTINE SetDiag5(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - REAL(Real32), INTENT(IN) :: d(:) + REAL(REAL32), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag5 MODULE PURE SUBROUTINE SetDiag6(mat, d, diagNo) REAL(DFP), INTENT(INOUT) :: mat(:, :) - REAL(Real64), INTENT(IN) :: d(:) + REAL(REAL64), INTENT(IN) :: d(:) INTEGER(I4B), INTENT(IN) :: diagNo END SUBROUTINE SetDiag6 END INTERFACE @@ -274,66 +274,66 @@ END FUNCTION DiagIndx MODULE PURE SUBROUTINE SetTriDiag1(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - INTEGER(Int8), INTENT(IN) :: d(:) + INTEGER(INT8), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int8), INTENT(IN) :: da(:) + INTEGER(INT8), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - INTEGER(Int8), INTENT(IN) :: db(:) + INTEGER(INT8), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag1 MODULE PURE SUBROUTINE SetTriDiag2(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - INTEGER(Int16), INTENT(IN) :: d(:) + INTEGER(INT16), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int16), INTENT(IN) :: da(:) + INTEGER(INT16), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - INTEGER(Int16), INTENT(IN) :: db(:) + INTEGER(INT16), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag2 MODULE PURE SUBROUTINE SetTriDiag3(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - INTEGER(Int32), INTENT(IN) :: d(:) + INTEGER(INT32), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int32), INTENT(IN) :: da(:) + INTEGER(INT32), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - INTEGER(Int32), INTENT(IN) :: db(:) + INTEGER(INT32), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag3 MODULE PURE SUBROUTINE SetTriDiag4(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - INTEGER(Int64), INTENT(IN) :: d(:) + INTEGER(INT64), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int64), INTENT(IN) :: da(:) + INTEGER(INT64), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - INTEGER(Int64), INTENT(IN) :: db(:) + INTEGER(INT64), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag4 MODULE PURE SUBROUTINE SetTriDiag5(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - REAL(Real32), INTENT(IN) :: d(:) + REAL(REAL32), INTENT(IN) :: d(:) !! main diagonal - REAL(Real32), INTENT(IN) :: da(:) + REAL(REAL32), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - REAL(Real32), INTENT(IN) :: db(:) + REAL(REAL32), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag5 MODULE PURE SUBROUTINE SetTriDiag6(mat, d, da, db) REAL(DFP), INTENT(INOUT) :: mat(:, :) !! tri diagonal matrix dense form - REAL(Real64), INTENT(IN) :: d(:) + REAL(REAL64), INTENT(IN) :: d(:) !! main diagonal - REAL(Real64), INTENT(IN) :: da(:) + REAL(REAL64), INTENT(IN) :: da(:) !! super-diagonal, (a, for above) - REAL(Real64), INTENT(IN) :: db(:) + REAL(REAL64), INTENT(IN) :: db(:) !! sub-diagonal (b for below) END SUBROUTINE SetTriDiag6 @@ -354,81 +354,81 @@ END SUBROUTINE SetTriDiag6 INTERFACE MODULE PURE FUNCTION Tridiag_1(d, da, db, diagNo) RESULT(Ans) - INTEGER(Int8), INTENT(IN) :: d(:) + INTEGER(INT8), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int8), INTENT(IN) :: da(:) + INTEGER(INT8), INTENT(IN) :: da(:) !! super diagonal - INTEGER(Int8), INTENT(IN) :: db(:) + INTEGER(INT8), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_1 MODULE PURE FUNCTION Tridiag_2(d, da, db, diagNo) RESULT(Ans) - INTEGER(Int16), INTENT(IN) :: d(:) + INTEGER(INT16), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int16), INTENT(IN) :: da(:) + INTEGER(INT16), INTENT(IN) :: da(:) !! super diagonal - INTEGER(Int16), INTENT(IN) :: db(:) + INTEGER(INT16), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_2 MODULE PURE FUNCTION Tridiag_3(d, da, db, diagNo) RESULT(Ans) - INTEGER(Int32), INTENT(IN) :: d(:) + INTEGER(INT32), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int32), INTENT(IN) :: da(:) + INTEGER(INT32), INTENT(IN) :: da(:) !! super diagonal - INTEGER(Int32), INTENT(IN) :: db(:) + INTEGER(INT32), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_3 MODULE PURE FUNCTION Tridiag_4(d, da, db, diagNo) RESULT(Ans) - INTEGER(Int64), INTENT(IN) :: d(:) + INTEGER(INT64), INTENT(IN) :: d(:) !! main diagonal - INTEGER(Int64), INTENT(IN) :: da(:) + INTEGER(INT64), INTENT(IN) :: da(:) !! super diagonal - INTEGER(Int64), INTENT(IN) :: db(:) + INTEGER(INT64), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_4 MODULE PURE FUNCTION Tridiag_5(d, da, db, diagNo) RESULT(Ans) - REAL(Real32), INTENT(IN) :: d(:) + REAL(REAL32), INTENT(IN) :: d(:) !! main diagonal - REAL(Real32), INTENT(IN) :: da(:) + REAL(REAL32), INTENT(IN) :: da(:) !! super diagonal - REAL(Real32), INTENT(IN) :: db(:) + REAL(REAL32), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_5 MODULE PURE FUNCTION Tridiag_6(d, da, db, diagNo) RESULT(Ans) - REAL(Real64), INTENT(IN) :: d(:) + REAL(REAL64), INTENT(IN) :: d(:) !! main diagonal - REAL(Real64), INTENT(IN) :: da(:) + REAL(REAL64), INTENT(IN) :: da(:) !! super diagonal - REAL(Real64), INTENT(IN) :: db(:) + REAL(REAL64), INTENT(IN) :: db(:) !! subdiagonal INTEGER(I4B), OPTIONAL, INTENT(IN) :: diagNo !! sub and super diagonal number, default is 1 !! diagNo should be positive - REAL(DFP) :: ans(size(d), size(d)) + REAL(DFP) :: ans(SIZE(d), SIZE(d)) END FUNCTION Tridiag_6 END INTERFACE diff --git a/src/modules/Utility/src/EigenUtility.F90 b/src/modules/Utility/src/EigenUtility.F90 index a435014b6..1995d8b4b 100644 --- a/src/modules/Utility/src/EigenUtility.F90 +++ b/src/modules/Utility/src/EigenUtility.F90 @@ -19,10 +19,22 @@ MODULE EigenUtility USE GlobalData IMPLICIT NONE +PUBLIC :: SymEigenValues2by2 +PUBLIC :: SymEigenValues3by3 +PUBLIC :: SymEigenValuesUpto3 +PUBLIC :: SymEigenValues +PUBLIC :: GetSymEigenValues +PUBLIC :: GetSymEigenValues_ +PUBLIC :: GetSymEigenJacobi + !---------------------------------------------------------------------------- ! SymEigen !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Eigenvalue of 2 by 2 symmetric matrix + INTERFACE MODULE PURE FUNCTION SymEigenValues2by2(mat) RESULT(ans) REAL(DFP), INTENT(IN) :: mat(2, 2) @@ -30,12 +42,14 @@ MODULE PURE FUNCTION SymEigenValues2by2(mat) RESULT(ans) END FUNCTION SymEigenValues2by2 END INTERFACE -PUBLIC :: SymEigenValues2by2 - !---------------------------------------------------------------------------- ! SymEigen !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Eigenvalue of 3 by 3 symmetric matrix + INTERFACE MODULE PURE FUNCTION SymEigenValues3by3(mat) RESULT(ans) REAL(DFP), INTENT(IN) :: mat(3, 3) @@ -43,12 +57,14 @@ MODULE PURE FUNCTION SymEigenValues3by3(mat) RESULT(ans) END FUNCTION SymEigenValues3by3 END INTERFACE -PUBLIC :: SymEigenValues3by3 - !---------------------------------------------------------------------------- ! SymEigen !---------------------------------------------------------------------------- +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-26 +! summary: Eigenvalue of 3 by 3 or 2 by 2 symmetric matrix + INTERFACE MODULE PURE FUNCTION SymEigenValuesUpto3(mat) RESULT(ans) REAL(DFP), INTENT(IN) :: mat(:, :) @@ -57,8 +73,6 @@ MODULE PURE FUNCTION SymEigenValuesUpto3(mat) RESULT(ans) END FUNCTION SymEigenValuesUpto3 END INTERFACE -PUBLIC :: SymEigenValuesUpto3 - !---------------------------------------------------------------------------- ! SymEigen !---------------------------------------------------------------------------- @@ -85,8 +99,6 @@ MODULE FUNCTION SymEigenValues(mat) RESULT(ans) END FUNCTION SymEigenValues END INTERFACE -PUBLIC :: SymEigenValues - !---------------------------------------------------------------------------- ! GetSymEigen !---------------------------------------------------------------------------- @@ -110,8 +122,6 @@ MODULE SUBROUTINE GetSymEigenValues(mat, eigenValues) END SUBROUTINE GetSymEigenValues END INTERFACE -PUBLIC :: GetSymEigenValues - !---------------------------------------------------------------------------- ! GetSymEigen !---------------------------------------------------------------------------- @@ -137,8 +147,6 @@ MODULE SUBROUTINE GetSymEigenValues_(mat, eigenValues) END SUBROUTINE GetSymEigenValues_ END INTERFACE -PUBLIC :: GetSymEigenValues_ - !---------------------------------------------------------------------------- ! GetSymEigenJacobi@LAPACK !---------------------------------------------------------------------------- @@ -172,8 +180,6 @@ MODULE PURE SUBROUTINE GetSymEigenJacobi(mat, eigenValues, eigenVectors, & END SUBROUTINE GetSymEigenJacobi END INTERFACE -PUBLIC :: GetSymEigenJacobi - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/Utility/src/HashingUtility.F90 b/src/modules/Utility/src/HashingUtility.F90 index 6a145e9bb..dd989eab2 100644 --- a/src/modules/Utility/src/HashingUtility.F90 +++ b/src/modules/Utility/src/HashingUtility.F90 @@ -36,7 +36,7 @@ MODULE HashingUtility INTERFACE MODULE PURE FUNCTION StringToUID_PolyRoll(charVar) RESULT(Ans) - CHARACTER(LEN=*), INTENT(IN) :: charVar + CHARACTER(*), INTENT(IN) :: charVar INTEGER(I4B) :: ans END FUNCTION StringToUID_PolyRoll END INTERFACE diff --git a/src/modules/Utility/src/IntegerUtility.F90 b/src/modules/Utility/src/IntegerUtility.F90 index 4ad66f52f..bde5d2ba4 100644 --- a/src/modules/Utility/src/IntegerUtility.F90 +++ b/src/modules/Utility/src/IntegerUtility.F90 @@ -161,7 +161,6 @@ END FUNCTION in_1d ! if a(i) is inside the b, then ans(i) is true, otherwise false. INTERFACE - MODULE PURE FUNCTION isin_1a(a, b) RESULT(Ans) INTEGER(INT8), INTENT(IN) :: a(:) INTEGER(INT8), INTENT(IN) :: b(:) @@ -185,7 +184,6 @@ MODULE PURE FUNCTION isin_1d(a, b) RESULT(Ans) INTEGER(INT64), INTENT(IN) :: b(:) LOGICAL(LGT) :: ans(SIZE(a)) END FUNCTION isin_1d - END INTERFACE INTERFACE OPERATOR(.isin.) @@ -286,10 +284,21 @@ MODULE PURE FUNCTION Repeat_1d(Val, rtimes) RESULT(Ans) INTEGER(I4B), INTENT(IN) :: rtimes INTEGER(INT64) :: Ans(SIZE(Val) * rtimes) END FUNCTION Repeat_1d + MODULE PURE FUNCTION Repeat_1e(Val, rtimes) RESULT(Ans) + REAL(REAL32), INTENT(IN) :: Val(:) + INTEGER(I4B), INTENT(IN) :: rtimes + REAL(REAL32) :: Ans(SIZE(Val) * rtimes) + END FUNCTION Repeat_1e + MODULE PURE FUNCTION Repeat_1f(Val, rtimes) RESULT(Ans) + REAL(REAL64), INTENT(IN) :: Val(:) + INTEGER(I4B), INTENT(IN) :: rtimes + REAL(REAL64) :: Ans(SIZE(Val) * rtimes) + END FUNCTION Repeat_1f END INTERFACE INTERFACE Repeat - MODULE PROCEDURE Repeat_1a, Repeat_1b, Repeat_1c, Repeat_1d + MODULE PROCEDURE Repeat_1a, Repeat_1b, Repeat_1c, Repeat_1d, & + & Repeat_1e, Repeat_1f END INTERFACE Repeat !---------------------------------------------------------------------------- diff --git a/src/modules/Utility/src/LinearAlgebraUtility.F90 b/src/modules/Utility/src/LinearAlgebraUtility.F90 index 6daa2ec60..0eb48c5df 100644 --- a/src/modules/Utility/src/LinearAlgebraUtility.F90 +++ b/src/modules/Utility/src/LinearAlgebraUtility.F90 @@ -20,6 +20,9 @@ MODULE LinearAlgebraUtility IMPLICIT NONE PRIVATE +PUBLIC :: InvHilbertMatrix +PUBLIC :: HilbertMatrix + !---------------------------------------------------------------------------- ! InvHilbertMatrix@Methods !---------------------------------------------------------------------------- @@ -31,8 +34,6 @@ MODULE PURE FUNCTION InvHilbertMatrix(n) RESULT(Ans) END FUNCTION InvHilbertMatrix END INTERFACE -PUBLIC :: InvHilbertMatrix - !---------------------------------------------------------------------------- ! HilbertMatrix@Methods !---------------------------------------------------------------------------- @@ -44,6 +45,4 @@ MODULE PURE FUNCTION HilbertMatrix(n) RESULT(Ans) END FUNCTION HilbertMatrix END INTERFACE -PUBLIC :: HilbertMatrix - END MODULE LinearAlgebraUtility diff --git a/src/modules/Utility/src/MedianUtility.F90 b/src/modules/Utility/src/MedianUtility.F90 new file mode 100644 index 000000000..e98bf452d --- /dev/null +++ b/src/modules/Utility/src/MedianUtility.F90 @@ -0,0 +1,131 @@ +! 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 MedianUtility +USE GlobalData +IMPLICIT NONE +PRIVATE +PUBLIC :: Median +PUBLIC :: ArgMedian + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Given three numbers, find their median and sort at the same time + +INTERFACE Median + MODULE PURE SUBROUTINE Median_Int8(this, left, mid, right) + INTEGER(INT8), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Int8 + + MODULE PURE SUBROUTINE Median_Int16(this, left, mid, right) + INTEGER(INT16), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Int16 + + MODULE PURE SUBROUTINE Median_Int32(this, left, mid, right) + INTEGER(INT32), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Int32 + + MODULE PURE SUBROUTINE Median_Int64(this, left, mid, right) + INTEGER(INT64), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Int64 + + MODULE PURE SUBROUTINE Median_Real32(this, left, mid, right) + REAL(REAL32), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Real32 + + MODULE PURE SUBROUTINE Median_Real64(this, left, mid, right) + REAL(REAL64), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE Median_Real64 +END INTERFACE Median + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +INTERFACE ArgMedian + MODULE PURE SUBROUTINE ArgMedian_Int8(this, indx, left, mid, right) + INTEGER(INT8), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Int8 + + MODULE PURE SUBROUTINE ArgMedian_Int16(this, indx, left, mid, right) + INTEGER(INT16), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Int16 + + MODULE PURE SUBROUTINE ArgMedian_Int32(this, indx, left, mid, right) + INTEGER(INT32), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Int32 + + MODULE PURE SUBROUTINE ArgMedian_Int64(this, indx, left, mid, right) + INTEGER(INT64), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Int64 + + MODULE PURE SUBROUTINE ArgMedian_Real32(this, indx, left, mid, right) + REAL(REAL32), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Real32 + + MODULE PURE SUBROUTINE ArgMedian_Real64(this, indx, left, mid, right) + REAL(REAL64), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: indx(:) + INTEGER(I4B), INTENT(IN) :: left + INTEGER(I4B), INTENT(IN) :: mid + INTEGER(I4B), INTENT(IN) :: right + END SUBROUTINE ArgMedian_Real64 +END INTERFACE ArgMedian + +END MODULE MedianUtility diff --git a/src/modules/Utility/src/PartitionUtility.F90 b/src/modules/Utility/src/PartitionUtility.F90 new file mode 100644 index 000000000..3fb18eced --- /dev/null +++ b/src/modules/Utility/src/PartitionUtility.F90 @@ -0,0 +1,174 @@ +! 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 +! + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Partition methods for quicksorting and quickselect +! +!# Introduction +! +! This module contains Hoare's style partitioning algorithm used +! for quicksorting and quickselect routines. +! +! Reference: +! +! https://github.com/leonfoks/coretran/blob/master/src/core/m_partition.f90 + +MODULE PartitionUtility +USE GlobalData +IMPLICIT NONE +PRIVATE +PUBLIC :: partition +PUBLIC :: argPartition + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Partitioning used for quickSort and quickSelect routines + +INTERFACE partition + MODULE PURE SUBROUTINE partition_Real32(this, left, right, iPivot) + REAL(REAL32), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + + MODULE PURE SUBROUTINE partition_Real64(this, left, right, iPivot) + REAL(REAL64), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + + MODULE PURE SUBROUTINE partition_Int8(this, left, right, iPivot) + INTEGER(INT8), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + + MODULE PURE SUBROUTINE partition_Int16(this, left, right, iPivot) + INTEGER(INT16), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + + MODULE PURE SUBROUTINE partition_Int32(this, left, right, iPivot) + INTEGER(INT32), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + + MODULE PURE SUBROUTINE partition_int64(this, left, right, iPivot) + INTEGER(INT64), INTENT(inout) :: this(:) + !! 1D array + INTEGER(I4B), INTENT(in) :: left + !! Left index + INTEGER(I4B), INTENT(in) :: right + !! Right index + INTEGER(I4B), INTENT(inout) :: iPivot + !! Pivoting index + END SUBROUTINE + +END INTERFACE + +!---------------------------------------------------------------------------- +! argPartition +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Partitioning used for argQuicksort routines + +INTERFACE argPartition + MODULE PURE SUBROUTINE argPartition_Real32(this, idx, left, right, i) + REAL(REAL32), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + + MODULE PURE SUBROUTINE argPartition_Real64(this, idx, left, right, i) + REAL(REAL64), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + + MODULE PURE SUBROUTINE argPartition_Int8(this, idx, left, right, i) + INTEGER(INT8), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + + MODULE PURE SUBROUTINE argPartition_Int16(this, idx, left, right, i) + INTEGER(INT16), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + + MODULE PURE SUBROUTINE argPartition_Int32(this, idx, left, right, i) + INTEGER(INT32), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + + MODULE PURE SUBROUTINE argPartition_Int64(this, idx, left, right, i) + INTEGER(INT64), INTENT(in) :: this(:) + INTEGER(I4B), INTENT(inout) :: idx(:) + INTEGER(I4B), INTENT(in) :: left + INTEGER(I4B), INTENT(in) :: right + INTEGER(I4B), INTENT(inout) :: i + END SUBROUTINE + +END INTERFACE argPartition + +END MODULE PartitionUtility diff --git a/src/modules/Utility/src/ProductUtility.F90 b/src/modules/Utility/src/ProductUtility.F90 index 3ec0de03e..8bbe18966 100644 --- a/src/modules/Utility/src/ProductUtility.F90 +++ b/src/modules/Utility/src/ProductUtility.F90 @@ -15,12 +15,10 @@ ! along with this program. If not, see ! - MODULE ProductUtility USE GlobalData IMPLICIT NONE PRIVATE - PUBLIC :: OUTERPROD PUBLIC :: Cross_Product PUBLIC :: Vector_Product @@ -31,8 +29,8 @@ MODULE ProductUtility !---------------------------------------------------------------------------- !> author: Vikas Sharma, Ph. D. -! date: 22 March 2021 -! summary: This FUNCTION evaluate vectors product +! date: 22 March 2021 +! summary: This FUNCTION evaluate vectors product ! !# Introduction ! This FUNCTION evaluate vectors products @@ -41,16 +39,16 @@ MODULE ProductUtility INTERFACE MODULE PURE FUNCTION vectorProduct_1(a, b) RESULT(c) ! Define INTENT of dummy argument - REAL(Real64), INTENT(IN) :: a(3), b(3) - REAL(Real64) :: c(3) + REAL(REAL64), INTENT(IN) :: a(3), b(3) + REAL(REAL64) :: c(3) END FUNCTION vectorProduct_1 END INTERFACE INTERFACE MODULE PURE FUNCTION vectorProduct_2(a, b) RESULT(c) ! Define INTENT of dummy argument - REAL(Real32), INTENT(IN) :: a(3), b(3) - REAL(Real32) :: c(3) + REAL(REAL32), INTENT(IN) :: a(3), b(3) + REAL(REAL32) :: c(3) END FUNCTION vectorProduct_2 END INTERFACE @@ -477,9 +475,9 @@ MODULE PURE FUNCTION outerprod_r1r1r1(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1) ) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1)) END FUNCTION outerprod_r1r1r1 END INTERFACE @@ -500,12 +498,12 @@ END FUNCTION outerprod_r1r1r1 MODULE PURE FUNCTION outerprod_r1r1r2(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r1r1r2 END INTERFACE @@ -526,13 +524,13 @@ END FUNCTION outerprod_r1r1r2 MODULE PURE FUNCTION outerprod_r1r1r3(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:,:) + REAL(DFP), INTENT(IN) :: c(:, :, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(c,3)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(c, 3)) END FUNCTION outerprod_r1r1r3 END INTERFACE @@ -553,14 +551,14 @@ END FUNCTION outerprod_r1r1r3 MODULE PURE FUNCTION outerprod_r1r1r4(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:,:,:) + REAL(DFP), INTENT(IN) :: c(:, :, :, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(c,3),& - & SIZE(c,4)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(c, 3),& + & SIZE(c, 4)) END FUNCTION outerprod_r1r1r4 END INTERFACE @@ -580,13 +578,13 @@ END FUNCTION outerprod_r1r1r4 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r1(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1)) END FUNCTION outerprod_r1r2r1 END INTERFACE @@ -606,14 +604,14 @@ END FUNCTION outerprod_r1r2r1 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r2(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: b(:, :) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r1r2r2 END INTERFACE @@ -633,15 +631,15 @@ END FUNCTION outerprod_r1r2r2 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r3(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) - REAL(DFP), INTENT(IN) :: c(:,:,:) + REAL(DFP), INTENT(IN) :: b(:, :) + REAL(DFP), INTENT(IN) :: c(:, :, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(c,3)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(c, 3)) END FUNCTION outerprod_r1r2r3 END INTERFACE @@ -661,14 +659,14 @@ END FUNCTION outerprod_r1r2r3 INTERFACE MODULE PURE FUNCTION outerprod_r1r3r1(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:,:) + REAL(DFP), INTENT(IN) :: b(:, :, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(b,3),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(b, 3),& + & SIZE(c, 1)) END FUNCTION outerprod_r1r3r1 END INTERFACE @@ -688,15 +686,15 @@ END FUNCTION outerprod_r1r3r1 INTERFACE MODULE PURE FUNCTION outerprod_r1r3r2(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:,:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: b(:, :, :) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(b,3),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(b, 3),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r1r3r2 END INTERFACE @@ -716,15 +714,15 @@ END FUNCTION outerprod_r1r3r2 INTERFACE MODULE PURE FUNCTION outerprod_r1r4r1(a, b, c) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:,:,:) + REAL(DFP), INTENT(IN) :: b(:, :, :, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(b,3),& - & SIZE(b,4),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(b, 3),& + & SIZE(b, 4),& + & SIZE(c, 1)) END FUNCTION outerprod_r1r4r1 END INTERFACE @@ -743,14 +741,14 @@ END FUNCTION outerprod_r1r4r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r1(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1)) END FUNCTION outerprod_r2r1r1 END INTERFACE @@ -769,15 +767,15 @@ END FUNCTION outerprod_r2r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r2(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r2r1r2 END INTERFACE @@ -796,16 +794,16 @@ END FUNCTION outerprod_r2r1r2 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r3(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:,:) + REAL(DFP), INTENT(IN) :: c(:, :, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(c,3)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(c, 3)) END FUNCTION outerprod_r2r1r3 END INTERFACE @@ -824,15 +822,15 @@ END FUNCTION outerprod_r2r1r3 INTERFACE MODULE PURE FUNCTION outerprod_r2r2r1(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1)) END FUNCTION outerprod_r2r2r1 END INTERFACE @@ -851,16 +849,16 @@ END FUNCTION outerprod_r2r2r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r2r2(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) - REAL(DFP), INTENT(IN) :: b(:,:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) + REAL(DFP), INTENT(IN) :: b(:, :) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r2r2r2 END INTERFACE @@ -879,15 +877,15 @@ END FUNCTION outerprod_r2r2r2 INTERFACE MODULE PURE FUNCTION outerprod_r3r1r1(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:,:) + REAL(DFP), INTENT(IN) :: a(:, :, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(a,3),& - & SIZE(b,1),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(a, 3),& + & SIZE(b, 1),& + & SIZE(c, 1)) END FUNCTION outerprod_r3r1r1 END INTERFACE @@ -906,16 +904,16 @@ END FUNCTION outerprod_r3r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r3r1r2(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:,:) + REAL(DFP), INTENT(IN) :: a(:, :, :) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(a,3),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(a, 3),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2)) END FUNCTION outerprod_r3r1r2 END INTERFACE @@ -934,16 +932,16 @@ END FUNCTION outerprod_r3r1r2 INTERFACE MODULE PURE FUNCTION outerprod_r3r2r1(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:,:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: a(:, :, :) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(a,3),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(a, 3),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1)) END FUNCTION outerprod_r3r2r1 END INTERFACE @@ -962,16 +960,16 @@ END FUNCTION outerprod_r3r2r1 INTERFACE MODULE PURE FUNCTION outerprod_r4r1r1(a, b, c) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:,:,:) + REAL(DFP), INTENT(IN) :: a(:, :, :, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(a,3),& - & SIZE(a,4),& - & SIZE(b,1),& - & SIZE(c,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(a, 3),& + & SIZE(a, 4),& + & SIZE(b, 1),& + & SIZE(c, 1)) END FUNCTION outerprod_r4r1r1 END INTERFACE @@ -995,10 +993,10 @@ MODULE PURE FUNCTION outerprod_r1r1r1r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r1r1r1 END INTERFACE @@ -1020,13 +1018,13 @@ MODULE PURE FUNCTION outerprod_r1r1r1r2(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) - REAL(DFP), INTENT(IN) :: d(:,:) + REAL(DFP), INTENT(IN) :: d(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1),& - & SIZE(d,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1),& + & SIZE(d, 2)) END FUNCTION outerprod_r1r1r1r2 END INTERFACE @@ -1048,14 +1046,14 @@ MODULE PURE FUNCTION outerprod_r1r1r1r3(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) - REAL(DFP), INTENT(IN) :: d(:,:,:) + REAL(DFP), INTENT(IN) :: d(:, :, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1),& - & SIZE(d,2),& - & SIZE(d,3)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1),& + & SIZE(d, 2),& + & SIZE(d, 3)) END FUNCTION outerprod_r1r1r1r3 END INTERFACE @@ -1076,14 +1074,14 @@ END FUNCTION outerprod_r1r1r1r3 MODULE PURE FUNCTION outerprod_r1r1r2r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r1r2r1 END INTERFACE @@ -1104,15 +1102,15 @@ END FUNCTION outerprod_r1r1r2r1 MODULE PURE FUNCTION outerprod_r1r1r2r2(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) - REAL(DFP), INTENT(IN) :: d(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) + REAL(DFP), INTENT(IN) :: d(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(d,1),& - & SIZE(d,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(d, 1),& + & SIZE(d, 2)) END FUNCTION outerprod_r1r1r2r2 END INTERFACE @@ -1133,15 +1131,15 @@ END FUNCTION outerprod_r1r1r2r2 MODULE PURE FUNCTION outerprod_r1r1r3r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:,:) + REAL(DFP), INTENT(IN) :: c(:, :, :) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(c,3),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(c, 3),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r1r3r1 END INTERFACE @@ -1161,15 +1159,15 @@ END FUNCTION outerprod_r1r1r3r1 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r1r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r2r1r1 END INTERFACE @@ -1189,16 +1187,16 @@ END FUNCTION outerprod_r1r2r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r1r2(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) - REAL(DFP), INTENT(IN) :: d(:,:) + REAL(DFP), INTENT(IN) :: d(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(d,1),& - & SIZE(d,2)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(d, 1),& + & SIZE(d, 2)) END FUNCTION outerprod_r1r2r1r2 END INTERFACE @@ -1218,16 +1216,16 @@ END FUNCTION outerprod_r1r2r1r2 INTERFACE MODULE PURE FUNCTION outerprod_r1r2r2r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: b(:, :) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r2r2r1 END INTERFACE @@ -1247,16 +1245,16 @@ END FUNCTION outerprod_r1r2r2r1 INTERFACE MODULE PURE FUNCTION outerprod_r1r3r1r1(a, b, c, d) RESULT(ans) REAL(DFP), INTENT(IN) :: a(:) - REAL(DFP), INTENT(IN) :: b(:,:,:) + REAL(DFP), INTENT(IN) :: b(:, :, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(b,3),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(b, 3),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r1r3r1r1 END INTERFACE @@ -1275,16 +1273,16 @@ END FUNCTION outerprod_r1r3r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r1r1(a, b, c, d) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r2r1r1r1 END INTERFACE @@ -1303,17 +1301,17 @@ END FUNCTION outerprod_r2r1r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r1r2(a, b, c, d) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) - REAL(DFP), INTENT(IN) :: d(:,:) + REAL(DFP), INTENT(IN) :: d(:, :) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1),& - & SIZE(d,2)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1),& + & SIZE(d, 2)) END FUNCTION outerprod_r2r1r1r2 END INTERFACE @@ -1332,17 +1330,17 @@ END FUNCTION outerprod_r2r1r1r2 INTERFACE MODULE PURE FUNCTION outerprod_r2r1r2r1(a, b, c, d) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) REAL(DFP), INTENT(IN) :: b(:) - REAL(DFP), INTENT(IN) :: c(:,:) + REAL(DFP), INTENT(IN) :: c(:, :) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(c,2),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(c, 2),& + & SIZE(d, 1)) END FUNCTION outerprod_r2r1r2r1 END INTERFACE @@ -1361,17 +1359,17 @@ END FUNCTION outerprod_r2r1r2r1 INTERFACE MODULE PURE FUNCTION outerprod_r2r2r1r1(a, b, c, d) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:) - REAL(DFP), INTENT(IN) :: b(:,:) + REAL(DFP), INTENT(IN) :: a(:, :) + REAL(DFP), INTENT(IN) :: b(:, :) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(b,1),& - & SIZE(b,2),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(b, 1),& + & SIZE(b, 2),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r2r2r1r1 END INTERFACE @@ -1390,17 +1388,17 @@ END FUNCTION outerprod_r2r2r1r1 INTERFACE MODULE PURE FUNCTION outerprod_r3r1r1r1(a, b, c, d) RESULT(ans) - REAL(DFP), INTENT(IN) :: a(:,:,:) + REAL(DFP), INTENT(IN) :: a(:, :, :) REAL(DFP), INTENT(IN) :: b(:) REAL(DFP), INTENT(IN) :: c(:) REAL(DFP), INTENT(IN) :: d(:) REAL(DFP) :: ans( & - & SIZE(a,1),& - & SIZE(a,2),& - & SIZE(a,3),& - & SIZE(b,1),& - & SIZE(c,1),& - & SIZE(d,1)) + & SIZE(a, 1),& + & SIZE(a, 2),& + & SIZE(a, 3),& + & SIZE(b, 1),& + & SIZE(c, 1),& + & SIZE(d, 1)) END FUNCTION outerprod_r3r1r1r1 END INTERFACE @@ -1412,4 +1410,4 @@ END FUNCTION outerprod_r3r1r1r1 ! !---------------------------------------------------------------------------- -END MODULE ProductUtility \ No newline at end of file +END MODULE ProductUtility diff --git a/src/modules/Utility/src/SortUtility.F90 b/src/modules/Utility/src/SortUtility.F90 index 2b5bf2ed0..392e60538 100644 --- a/src/modules/Utility/src/SortUtility.F90 +++ b/src/modules/Utility/src/SortUtility.F90 @@ -27,6 +27,97 @@ MODULE SortUtility PUBLIC :: ArgSort PUBLIC :: InsertionSort PUBLIC :: ArgInsertionSort +PUBLIC :: IntroSort +PUBLIC :: ArgIntroSort + +!---------------------------------------------------------------------------- +! IntroSort +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Sorting by insertion algorithm + +INTERFACE + MODULE PURE SUBROUTINE IntroSort_Int8(array) + INTEGER(INT8), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Int8 + MODULE PURE SUBROUTINE IntroSort_Int16(array) + INTEGER(INT16), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Int16 + MODULE PURE SUBROUTINE IntroSort_Int32(array) + INTEGER(INT32), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Int32 + MODULE PURE SUBROUTINE IntroSort_Int64(array) + INTEGER(INT64), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Int64 + MODULE PURE SUBROUTINE IntroSort_Real32(array) + REAL(REAL32), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Real32 + MODULE PURE SUBROUTINE IntroSort_Real64(array) + REAL(REAL64), INTENT(INOUT) :: array(:) + END SUBROUTINE IntroSort_Real64 +END INTERFACE + +INTERFACE IntroSort + MODULE PROCEDURE & + & IntroSort_Int8, & + & IntroSort_Int16, & + & IntroSort_Int32, & + & IntroSort_Int64, & + & IntroSort_Real32, & + & IntroSort_Real64 +END INTERFACE IntroSort + +!---------------------------------------------------------------------------- +! ArgIntroSort +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2023-06-27 +! summary: Indirect sorting by insertion sort + +INTERFACE + MODULE PURE SUBROUTINE ArgIntroSort_Int8(array, arg) + INTEGER(INT8), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Int8 + + MODULE PURE SUBROUTINE ArgIntroSort_Int16(array, arg) + INTEGER(INT16), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Int16 + + MODULE PURE SUBROUTINE ArgIntroSort_Int32(array, arg) + INTEGER(INT32), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Int32 + + MODULE PURE SUBROUTINE ArgIntroSort_Int64(array, arg) + INTEGER(INT64), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Int64 + + MODULE PURE SUBROUTINE ArgIntroSort_Real32(array, arg) + REAL(REAL32), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Real32 + + MODULE PURE SUBROUTINE ArgIntroSort_Real64(array, arg) + REAL(REAL64), INTENT(IN) :: array(:) + INTEGER(I4B), INTENT(INOUT) :: arg(:) + END SUBROUTINE ArgIntroSort_Real64 +END INTERFACE + +INTERFACE ArgIntroSort + MODULE PROCEDURE & + & ArgIntroSort_Int8, & + & ArgIntroSort_Int16, & + & ArgIntroSort_Int32, & + & ArgIntroSort_Int64, & + & ArgIntroSort_Real32, & + & ArgIntroSort_Real64 +END INTERFACE ArgIntroSort !---------------------------------------------------------------------------- ! IntroSort @@ -70,8 +161,12 @@ END SUBROUTINE InsertionSort_Real64 END INTERFACE INTERFACE InsertionSort - MODULE PROCEDURE InsertionSort_Int8, InsertionSort_Int16, & - & InsertionSort_Int32, InsertionSort_Int64, InsertionSort_Real32, & + MODULE PROCEDURE & + & InsertionSort_Int8, & + & InsertionSort_Int16, & + & InsertionSort_Int32, & + & InsertionSort_Int64, & + & InsertionSort_Real32, & & InsertionSort_Real64 END INTERFACE InsertionSort diff --git a/src/modules/Utility/src/StringUtility.F90 b/src/modules/Utility/src/StringUtility.F90 index 1025d7c68..3efe3371d 100644 --- a/src/modules/Utility/src/StringUtility.F90 +++ b/src/modules/Utility/src/StringUtility.F90 @@ -20,6 +20,25 @@ MODULE StringUtility IMPLICIT NONE PRIVATE +PUBLIC :: FindReplace +PUBLIC :: GetFileParts +PUBLIC :: GetPath +PUBLIC :: GetFileName +PUBLIC :: GetFileNameExt +PUBLIC :: GetExtension +PUBLIC :: GetField +PUBLIC :: LowerCase +PUBLIC :: ToLowerCase +PUBLIC :: IsWhiteChar +PUBLIC :: IsBlank +PUBLIC :: NumStrings +PUBLIC :: NumMatchStr +PUBLIC :: IsPresent +PUBLIC :: StrFind +PUBLIC :: SlashRep +PUBLIC :: ToUpperCase +PUBLIC :: UpperCase + !---------------------------------------------------------------------------- ! UpperCase@StringMethods !---------------------------------------------------------------------------- @@ -39,8 +58,6 @@ END FUNCTION UpperCase_char MODULE PROCEDURE UpperCase_char END INTERFACE UpperCase -PUBLIC :: UpperCase - !---------------------------------------------------------------------------- ! toUpperCase@StringMethods !---------------------------------------------------------------------------- @@ -59,8 +76,6 @@ END SUBROUTINE ToUpperCase_Char MODULE PROCEDURE ToUpperCase_Char END INTERFACE toUpperCase -PUBLIC :: toUpperCase - !---------------------------------------------------------------------------- ! LowerCase@StringMethods !---------------------------------------------------------------------------- @@ -80,8 +95,6 @@ END FUNCTION LowerCase_char MODULE PROCEDURE LowerCase_char END INTERFACE LowerCase -PUBLIC :: LowerCase - !---------------------------------------------------------------------------- ! toLowerCase@StringMethods !---------------------------------------------------------------------------- @@ -100,8 +113,6 @@ END SUBROUTINE ToLowerCase_Char MODULE PROCEDURE ToLowerCase_Char END INTERFACE toLowerCase -PUBLIC :: toLowerCase - !---------------------------------------------------------------------------- ! isWhiteChar@StringMethods !---------------------------------------------------------------------------- @@ -121,8 +132,6 @@ END FUNCTION isWhiteChar_char MODULE PROCEDURE isWhiteChar_char END INTERFACE isWhiteChar -PUBLIC :: isWhiteChar - !---------------------------------------------------------------------------- ! isBlank@StringMethods !---------------------------------------------------------------------------- @@ -142,8 +151,6 @@ END FUNCTION isBlank_chars MODULE PROCEDURE isBlank_chars END INTERFACE isBlank -PUBLIC :: isBlank - !---------------------------------------------------------------------------- ! numString@StringMethods !---------------------------------------------------------------------------- @@ -172,8 +179,6 @@ END FUNCTION numStrings_chars MODULE PROCEDURE numStrings_chars END INTERFACE numStrings -PUBLIC :: numStrings - !---------------------------------------------------------------------------- ! nmatchstr@StringMethods !---------------------------------------------------------------------------- @@ -195,8 +200,6 @@ END FUNCTION numMatchStr_chars MODULE PROCEDURE numMatchStr_chars END INTERFACE numMatchStr -PUBLIC :: numMatchStr - !---------------------------------------------------------------------------- ! isPresent@StringMethods !---------------------------------------------------------------------------- @@ -225,8 +228,6 @@ END FUNCTION isPresent_chars MODULE PROCEDURE isPresent_chars END INTERFACE isPresent -PUBLIC :: isPresent - !---------------------------------------------------------------------------- ! strFind@StringMethods !---------------------------------------------------------------------------- @@ -247,8 +248,6 @@ END SUBROUTINE strFind_chars MODULE PROCEDURE strFind_chars END INTERFACE strFind -PUBLIC :: strFind - !---------------------------------------------------------------------------- ! FindReplace@StringMethods !---------------------------------------------------------------------------- @@ -264,7 +263,7 @@ END SUBROUTINE strFind_chars ! - repp the new substring that will be replace parts of string ! !@note -! repp can be larger than @c findp and as long as the size of string can +! repp can be larger than findp and as long as the size of string can ! accomodate the increased length of all replacements. Trailing and preceding ! spaces are counted in all strings. !@endnote @@ -281,8 +280,6 @@ END SUBROUTINE FindReplace_chars MODULE PROCEDURE FindReplace_chars END INTERFACE FindReplace -PUBLIC :: FindReplace - !---------------------------------------------------------------------------- ! getField@StringMethods !---------------------------------------------------------------------------- @@ -290,18 +287,6 @@ END SUBROUTINE FindReplace_chars !> author: Vikas Sharma, Ph. D. ! date: 8 sept 2021 ! summary: Replaces a substring pattern with a different substring in a string -! -!# Introduction -! Replaces a substring pattern with a different substring in a string. -! - chars the string which will have substrings replaced. -! - findp the substring pattern to find and replace -! - repp the new substring that will be replace parts of string -! -!@note -! repp can be larger than @c findp and as long as the size of string can -! accomodate the increased length of all replacements. Trailing and preceding -! spaces are counted in all strings. -!@endnote INTERFACE MODULE PURE SUBROUTINE getField_chars(i, chars, field, ierr) @@ -316,8 +301,6 @@ END SUBROUTINE getField_chars MODULE PROCEDURE getField_chars END INTERFACE getField -PUBLIC :: getField - !---------------------------------------------------------------------------- ! SlashRep@StringMethods !---------------------------------------------------------------------------- @@ -340,8 +323,6 @@ END SUBROUTINE SlashRep_chars MODULE PROCEDURE SlashRep_chars END INTERFACE SlashRep -PUBLIC :: SlashRep - !---------------------------------------------------------------------------- ! getFileParts@StringMethods !---------------------------------------------------------------------------- @@ -366,8 +347,6 @@ END SUBROUTINE getFileParts_chars MODULE PROCEDURE getFileParts_chars END INTERFACE getFileParts -PUBLIC :: getFileParts - !---------------------------------------------------------------------------- ! getPath@StringMethods !---------------------------------------------------------------------------- @@ -383,8 +362,6 @@ END SUBROUTINE getPath_chars MODULE PROCEDURE getPath_chars END INTERFACE getPath -PUBLIC :: getPath - !---------------------------------------------------------------------------- ! getFileName@StringMethods !---------------------------------------------------------------------------- @@ -400,8 +377,6 @@ END SUBROUTINE getFileName_chars MODULE PROCEDURE getFileName_chars END INTERFACE getFileName -PUBLIC :: getFileName - !---------------------------------------------------------------------------- ! getFileNameExt@StringMethods !---------------------------------------------------------------------------- @@ -417,8 +392,6 @@ END SUBROUTINE getFileNameExt_chars MODULE PROCEDURE getFileNameExt_chars END INTERFACE getFileNameExt -PUBLIC :: getFileNameExt - !---------------------------------------------------------------------------- ! getExtension@StringMethods !---------------------------------------------------------------------------- @@ -444,8 +417,6 @@ MODULE FUNCTION getExtension_chars(char) RESULT(ext) MODULE PROCEDURE getExtension_chars END INTERFACE getExtension -PUBLIC :: getExtension - !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- diff --git a/src/modules/Utility/src/Utility.F90 b/src/modules/Utility/src/Utility.F90 index c3aa9cb0e..eae51c258 100755 --- a/src/modules/Utility/src/Utility.F90 +++ b/src/modules/Utility/src/Utility.F90 @@ -34,8 +34,10 @@ MODULE Utility USE LinearAlgebraUtility USE MappingUtility USE MatmulUtility +USE MedianUtility USE MiscUtility USE OnesUtility +USE PartitionUtility USE ProductUtility USE PushPopUtility USE ReallocateUtility diff --git a/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 b/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 index 2eb2a76ec..0cef333e5 100644 --- a/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 +++ b/src/submodules/MdEncode/src/MdEncode_Method@Methods.F90 @@ -144,8 +144,8 @@ MODULE PROCEDURE MdEncode_4 INTEGER(I4B) :: ii DO ii = 1, SIZE(val, 3) - ans = "( :, :, "//tostring(ii)//" ) = "//CHAR_LF//CHAR_LF - ans = ans//MdEncode(val(:, :, ii)) + ans = ans//"( :, :, "//tostring(ii)//" ) = "//CHAR_LF//CHAR_LF & + & //MdEncode(val(:, :, ii)) END DO END PROCEDURE MdEncode_4 @@ -157,9 +157,8 @@ INTEGER(I4B) :: ii, jj DO jj = 1, SIZE(val, 4) DO ii = 1, SIZE(val, 3) - ans = "( :, :, "//tostring(ii)//", "//tostring(jj)//" ) = " & - & //CHAR_LF//CHAR_LF - ans = ans//MdEncode(val(:, :, ii, jj)) + ans = ans//"( :, :, "//tostring(ii)//", "//tostring(jj)//" ) = " & + & //CHAR_LF//CHAR_LF//MdEncode(val(:, :, ii, jj)) END DO END DO END PROCEDURE MdEncode_5 diff --git a/src/submodules/Utility/CMakeLists.txt b/src/submodules/Utility/CMakeLists.txt index 3e56ffb96..c8bbe4016 100644 --- a/src/submodules/Utility/CMakeLists.txt +++ b/src/submodules/Utility/CMakeLists.txt @@ -20,6 +20,8 @@ TARGET_SOURCES( ${PROJECT_NAME} PRIVATE ${src_path}/MappingUtility@Methods.F90 ${src_path}/BinomUtility@Methods.F90 + ${src_path}/MedianUtility@Methods.F90 + ${src_path}/PartitionUtility@Methods.F90 ${src_path}/SortUtility@Methods.F90 ${src_path}/SwapUtility@Methods.F90 ${src_path}/ConvertUtility@Methods.F90 diff --git a/src/submodules/Utility/src/IntegerUtility@Methods.F90 b/src/submodules/Utility/src/IntegerUtility@Methods.F90 index a75e2d08b..997688284 100644 --- a/src/submodules/Utility/src/IntegerUtility@Methods.F90 +++ b/src/submodules/Utility/src/IntegerUtility@Methods.F90 @@ -36,7 +36,7 @@ INTEGER(I4B) :: ii ans = 0_I4B DO ii = 0, n - ans = ans + Size(n=ii, d=d) + ans = ans + SIZE(n=ii, d=d) END DO END PROCEDURE obj_Size2 @@ -86,7 +86,7 @@ MODULE PROCEDURE obj_GetMultiIndices2 INTEGER(I4B) :: ii, m, r1, r2 !! -m = SIZE(n, d, .true.) +m = SIZE(n, d, .TRUE.) ALLOCATE (ans(d + 1, m)) !! r1 = 0; r2 = 0 @@ -164,22 +164,22 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE RemoveDuplicates_1a -INTEGER(Int8), ALLOCATABLE :: temp(:) +INTEGER(INT8), ALLOCATABLE :: temp(:) #include "./RemoveDuplicates/RemoveDuplicates_1.inc" END PROCEDURE RemoveDuplicates_1a MODULE PROCEDURE RemoveDuplicates_1b -INTEGER(Int16), ALLOCATABLE :: temp(:) +INTEGER(INT16), ALLOCATABLE :: temp(:) #include "./RemoveDuplicates/RemoveDuplicates_1.inc" END PROCEDURE RemoveDuplicates_1b MODULE PROCEDURE RemoveDuplicates_1c -INTEGER(Int32), ALLOCATABLE :: temp(:) +INTEGER(INT32), ALLOCATABLE :: temp(:) #include "./RemoveDuplicates/RemoveDuplicates_1.inc" END PROCEDURE RemoveDuplicates_1c MODULE PROCEDURE RemoveDuplicates_1d -INTEGER(Int64), ALLOCATABLE :: temp(:) +INTEGER(INT64), ALLOCATABLE :: temp(:) #include "./RemoveDuplicates/RemoveDuplicates_1.inc" END PROCEDURE RemoveDuplicates_1d @@ -203,4 +203,12 @@ #include "./Repeat/Repeat_1.inc" END PROCEDURE Repeat_1d +MODULE PROCEDURE Repeat_1e +#include "./Repeat/Repeat_1.inc" +END PROCEDURE Repeat_1e + +MODULE PROCEDURE Repeat_1f +#include "./Repeat/Repeat_1.inc" +END PROCEDURE Repeat_1f + END SUBMODULE Methods diff --git a/src/submodules/Utility/src/IntroSort/ArgIntroSort.inc b/src/submodules/Utility/src/IntroSort/ArgIntroSort.inc new file mode 100644 index 000000000..63b7886bf --- /dev/null +++ b/src/submodules/Utility/src/IntroSort/ArgIntroSort.inc @@ -0,0 +1,16 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! diff --git a/src/submodules/Utility/src/IntroSort/IntroSort.inc b/src/submodules/Utility/src/IntroSort/IntroSort.inc new file mode 100644 index 000000000..63b7886bf --- /dev/null +++ b/src/submodules/Utility/src/IntroSort/IntroSort.inc @@ -0,0 +1,16 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! diff --git a/src/submodules/Utility/src/IntroSort/Recursive_ArgIntroSort.inc b/src/submodules/Utility/src/IntroSort/Recursive_ArgIntroSort.inc new file mode 100644 index 000000000..980800478 --- /dev/null +++ b/src/submodules/Utility/src/IntroSort/Recursive_ArgIntroSort.inc @@ -0,0 +1,31 @@ +! 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 +! + +N = right - left + 1 +IF (N < minimumLengthForInsertion) THEN + CALL argInsertionSort(this, idx, left, right) + RETURN +END IF +IF (maxDepth == 0) THEN + CALL argHeapsort(this, idx(left:right)) + RETURN +END IF +imid = left + N / 2 +CALL argMedian(this, idx, left, imid, right) +CALL argPartition(this, idx, left, right, iPivot) +CALL _Recursive_ArgIntroSort_(this, idx, left, iPivot - 1, maxDepth - 1) +CALL _Recursive_ArgIntroSort_(this, idx, iPivot + 1, right, maxDepth - 1) diff --git a/src/submodules/Utility/src/IntroSort/Recursive_IntroSort.inc b/src/submodules/Utility/src/IntroSort/Recursive_IntroSort.inc new file mode 100644 index 000000000..d2ab39821 --- /dev/null +++ b/src/submodules/Utility/src/IntroSort/Recursive_IntroSort.inc @@ -0,0 +1,32 @@ +! 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 +! + +N = right - left + 1 +IF (N < minimumLengthForInsertion) THEN + CALL InsertionSort(this, left, right) + RETURN +END IF +IF (maxDepth .EQ. 0) THEN + CALL Heapsort(this(left:right)) + RETURN +END IF +imid = left + N / 2 +CALL Median(this, left, imid, right) +CALL swap(this(left), this(imid)) +CALL partition(this, left, right, iPivot) +CALL _Recursive_IntroSort_(this, left, iPivot - 1, maxDepth - 1) +CALL _Recursive_IntroSort_(this, iPivot + 1, right, maxDepth - 1) diff --git a/src/submodules/Utility/src/Median/ArgMedian.inc b/src/submodules/Utility/src/Median/ArgMedian.inc new file mode 100644 index 000000000..ddc929849 --- /dev/null +++ b/src/submodules/Utility/src/Median/ArgMedian.inc @@ -0,0 +1,20 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +IF (this(indx(right)) < this(indx(left))) CALL swap(indx(left), indx(right)) +IF (this(indx(mid)) < this(indx(left))) CALL swap(indx(mid), indx(left)) +IF (this(indx(right)) < this(indx(mid))) CALL swap(indx(right), indx(mid)) diff --git a/src/submodules/Utility/src/Median/Median.inc b/src/submodules/Utility/src/Median/Median.inc new file mode 100644 index 000000000..0ff1cd794 --- /dev/null +++ b/src/submodules/Utility/src/Median/Median.inc @@ -0,0 +1,20 @@ +! This program is a part of EASIFEM library +! Copyright (C) 2020-2021 Vikas Sharma, Ph.D +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see +! + +if (this(right) < this(left)) call swap(this(left), this(right)) +if (this(mid) < this(left)) call swap(this(mid), this(left)) +if (this(right) < this(mid)) call swap(this(right), this(mid)) diff --git a/src/submodules/Utility/src/MedianUtility@Methods.F90 b/src/submodules/Utility/src/MedianUtility@Methods.F90 new file mode 100644 index 000000000..f4d4a922e --- /dev/null +++ b/src/submodules/Utility/src/MedianUtility@Methods.F90 @@ -0,0 +1,119 @@ +! 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(MedianUtility) Methods +USE BaseMethod, ONLY: SWAP +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Real32 +#include "./Median/Median.inc" +END PROCEDURE Median_Real32 + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Real64 +#include "./Median/Median.inc" +END PROCEDURE Median_Real64 + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Int8 +#include "./Median/Median.inc" +END PROCEDURE Median_Int8 + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Int16 +#include "./Median/Median.inc" +END PROCEDURE Median_Int16 + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Int32 +#include "./Median/Median.inc" +END PROCEDURE Median_Int32 + +!---------------------------------------------------------------------------- +! Median +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Median_Int64 +#include "./Median/Median.inc" +END PROCEDURE Median_Int64 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Real32 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Real32 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Real64 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Real64 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Int8 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Int8 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Int16 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Int16 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Int32 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Int32 + +!---------------------------------------------------------------------------- +! ArgMedian +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ArgMedian_Int64 +#include "./Median/ArgMedian.inc" +END PROCEDURE ArgMedian_Int64 + +END SUBMODULE diff --git a/src/submodules/Utility/src/Partition/ArgPartition.inc b/src/submodules/Utility/src/Partition/ArgPartition.inc new file mode 100644 index 000000000..09bde4203 --- /dev/null +++ b/src/submodules/Utility/src/Partition/ArgPartition.inc @@ -0,0 +1,34 @@ +! 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 +! + + +pivot = this(idx(left)) +lo = left + 1; hi = right +DO WHILE (lo <= hi) + DO WHILE (this(idx(hi)) > pivot) + hi = hi - 1 + END DO + DO WHILE (lo <= hi .AND. this(idx(lo)) <= pivot) + lo = lo + 1 + END DO + IF (lo <= hi) THEN + CALL swap(idx(lo), idx(hi)) + lo = lo + 1; hi = hi - 1 + END IF +END DO +CALL swap(idx(left), idx(hi)) +i = hi diff --git a/src/submodules/Utility/src/Partition/Partition.inc b/src/submodules/Utility/src/Partition/Partition.inc new file mode 100644 index 000000000..9a78557fb --- /dev/null +++ b/src/submodules/Utility/src/Partition/Partition.inc @@ -0,0 +1,35 @@ +! 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 +! + + +pivot = this(left) +lo = left; hi = right +DO WHILE (lo <= hi) + DO WHILE (this(hi) > pivot) + hi = hi - 1 + END DO + + DO WHILE (lo <= hi .AND. this(lo) <= pivot) + lo = lo + 1 + END DO + IF (lo <= hi) THEN + CALL swap(this(lo), this(hi)) + lo = lo + 1; hi = hi - 1 + END IF +END DO +CALL swap(this(left), this(hi)) +iPivot = hi diff --git a/src/submodules/Utility/src/PartitionUtility@Methods.F90 b/src/submodules/Utility/src/PartitionUtility@Methods.F90 new file mode 100644 index 000000000..c9597bbdd --- /dev/null +++ b/src/submodules/Utility/src/PartitionUtility@Methods.F90 @@ -0,0 +1,143 @@ +! 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(PartitionUtility) Methods +USE BaseMethod, ONLY: SWAP +IMPLICIT NONE +CONTAINS + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Real32 +INTEGER(I4B) :: lo, hi +REAL(REAL32) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Real32 + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Real64 +INTEGER(I4B) :: lo, hi +REAL(REAL64) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Real64 + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Int8 +INTEGER(I4B) :: lo, hi +INTEGER(INT8) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Int8 + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Int16 +INTEGER(I4B) :: lo, hi +INTEGER(INT16) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Int16 + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Int32 +INTEGER(I4B) :: lo, hi +INTEGER(INT32) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Int32 + +!---------------------------------------------------------------------------- +! Partition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE partition_Int64 +INTEGER(I4B) :: lo, hi +INTEGER(INT64) :: pivot +#include "./Partition/Partition.inc" +END PROCEDURE partition_Int64 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Int8 +INTEGER(I4B) :: lo, hi +INTEGER(INT8) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Int8 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Int16 +INTEGER(I4B) :: lo, hi +INTEGER(INT16) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Int16 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Int32 +INTEGER(I4B) :: lo, hi +INTEGER(INT32) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Int32 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Int64 +INTEGER(I4B) :: lo, hi +INTEGER(INT64) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Int64 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Real32 +INTEGER(I4B) :: lo, hi +REAL(REAL32) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Real32 + +!---------------------------------------------------------------------------- +! ArgPartition +!---------------------------------------------------------------------------- + +MODULE PROCEDURE argPartition_Real64 +INTEGER(I4B) :: lo, hi +REAL(REAL64) :: pivot +#include "./Partition/ArgPartition.inc" +END PROCEDURE argPartition_Real64 + +END SUBMODULE diff --git a/src/submodules/Utility/src/Repeat/Repeat_1.inc b/src/submodules/Utility/src/Repeat/Repeat_1.inc index a4f3451d6..968e97111 100644 --- a/src/submodules/Utility/src/Repeat/Repeat_1.inc +++ b/src/submodules/Utility/src/Repeat/Repeat_1.inc @@ -20,4 +20,4 @@ n = SIZE(Val) Ans(1:n) = Val DO i = 1, rtimes - 1 Ans(i * n + 1:(i + 1) * n) = Val -END DO \ No newline at end of file +END DO diff --git a/src/submodules/Utility/src/Sort/ArgSort.inc b/src/submodules/Utility/src/Sort/ArgSort.inc index bd093d850..a9763bcde 100644 --- a/src/submodules/Utility/src/Sort/ArgSort.inc +++ b/src/submodules/Utility/src/Sort/ArgSort.inc @@ -20,14 +20,16 @@ CHARACTER(LEN=120) :: name0 IF (PRESENT(name)) THEN name0 = UpperCase(name) ELSE - name0 = "HEAPSORT" + name0 = "INTROSORT" END IF +ans = arange(1_I4B, SIZE(x, kind=I4B), 1_I4B) + SELECT CASE (TRIM(name0)) -CASE ("QUICKSORT") - !! TODO CASE ("HEAPSORT") CALL ArgHeapSort(array=x, arg=ans) -CASE ("INTROSORT") - !! TODO +CASE ("INTROSORT", "QUICKSORT") + CALL ArgIntroSort(array=x, arg=ans) +CASE ("INSERTION") + CALL ArgInsertionSort(array=x, arg=ans, low=1_I4B, high=SIZE(x, kind=I4B)) END SELECT diff --git a/src/submodules/Utility/src/Sort/Sort.inc b/src/submodules/Utility/src/Sort/Sort.inc index 070aef0fd..ef78bbfbd 100644 --- a/src/submodules/Utility/src/Sort/Sort.inc +++ b/src/submodules/Utility/src/Sort/Sort.inc @@ -20,16 +20,18 @@ CHARACTER(LEN=120) :: name0 IF (PRESENT(name)) THEN name0 = UpperCase(name) ELSE - name0 = "QUICKSORT" + name0 = "INTROSORT" END IF ans = x SELECT CASE (TRIM(name0)) CASE ("QUICKSORT") - CALL QuickSort(vect1=ans, low=1_I4B, high=SIZE(ans)) + CALL QuickSort(vect1=ans, low=1_I4B, high=SIZE(ans, kind=I4B)) CASE ("HEAPSORT") CALL HeapSort(array=ans) CASE ("INTROSORT") - !! TODO + CALL IntroSort(array=ans) +CASE ("INSERTIONSORT") + CALL InsertionSort(array=ans, low=1_I4B, high=SIZE(ans, kind=I4B)) END SELECT diff --git a/src/submodules/Utility/src/SortUtility@Methods.F90 b/src/submodules/Utility/src/SortUtility@Methods.F90 index c90947fb7..e4e198cf1 100644 --- a/src/submodules/Utility/src/SortUtility@Methods.F90 +++ b/src/submodules/Utility/src/SortUtility@Methods.F90 @@ -20,10 +20,278 @@ ! summary: This submodule contains the sorting routine SUBMODULE(SortUtility) Methods -USE BaseMethod, ONLY: Swap, UpperCase, arange +USE BaseMethod, ONLY: Swap, UpperCase, arange, Median, Partition, & +& ArgPartition, ArgMedian IMPLICIT NONE + +INTEGER(I4B), PARAMETER :: minimumLengthForInsertion = 16 + CONTAINS +!---------------------------------------------------------------------------- +! IntroSort_Int8 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Int8 +MODULE PROCEDURE IntroSort_Int8 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Int8 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + INTEGER(INT8), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int16 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Int16 +MODULE PROCEDURE IntroSort_Int16 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Int16 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + INTEGER(INT16), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int32 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Int32 +MODULE PROCEDURE IntroSort_Int32 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Int32 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + INTEGER(INT32), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int8 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Int64 +MODULE PROCEDURE IntroSort_Int64 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Int64 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + INTEGER(INT64), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Real32 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Real32 +MODULE PROCEDURE IntroSort_Real32 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Real32 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + REAL(REAL32), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Real64 +!---------------------------------------------------------------------------- + +#define _Recursive_IntroSort_ Recursive_IntroSort_Real64 +MODULE PROCEDURE IntroSort_Real64 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_IntroSort_(array, low, high, maxDepth) +END PROCEDURE IntroSort_Real64 +RECURSIVE PURE SUBROUTINE _Recursive_IntroSort_(this, left, right, maxDepth) + REAL(REAL64), INTENT(INOUT) :: this(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_IntroSort.inc" +END SUBROUTINE _Recursive_IntroSort_ +#undef _Recursive_IntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int8 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Int8 +MODULE PROCEDURE ArgIntroSort_Int8 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Int8 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + INTEGER(INT8), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int16 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Int16 +MODULE PROCEDURE ArgIntroSort_Int16 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Int16 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + INTEGER(INT16), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int32 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Int32 +MODULE PROCEDURE ArgIntroSort_Int32 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Int32 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + INTEGER(INT32), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Int64 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Int64 +MODULE PROCEDURE ArgIntroSort_Int64 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Int64 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + INTEGER(INT64), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Real32 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Real32 +MODULE PROCEDURE ArgIntroSort_Real32 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Real32 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + REAL(REAL32), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + +!---------------------------------------------------------------------------- +! IntroSort_Real32 +!---------------------------------------------------------------------------- + +#define _Recursive_ArgIntroSort_ Recursive_ArgIntroSort_Real64 +MODULE PROCEDURE ArgIntroSort_Real64 +INTEGER(I4B) :: low, high +INTEGER(I4B) :: maxDepth +low = 1 +high = SIZE(array) +maxDepth = 2 * idnint(LOG(DBLE(high))) +CALL _Recursive_ArgIntroSort_(array, arg, low, high, maxDepth) +END PROCEDURE ArgIntroSort_Real64 +RECURSIVE PURE SUBROUTINE _Recursive_ArgIntroSort_(this, idx, & + & left, right, maxDepth) + REAL(REAL64), INTENT(IN) :: this(:) + INTEGER(I4B), INTENT(INOUT) :: idx(:) + INTEGER(I4B), INTENT(IN) :: left, right, maxDepth + INTEGER(I4B) :: imid, iPivot, N +#include "./IntroSort/Recursive_ArgIntroSort.inc" +END SUBROUTINE _Recursive_ArgIntroSort_ +#undef _Recursive_ArgIntroSort_ + !---------------------------------------------------------------------------- ! InsertionSort !---------------------------------------------------------------------------- diff --git a/src/submodules/Utility/src/StringUtility@Methods.F90 b/src/submodules/Utility/src/StringUtility@Methods.F90 index e9e003d12..fed3e0760 100644 --- a/src/submodules/Utility/src/StringUtility@Methods.F90 +++ b/src/submodules/Utility/src/StringUtility@Methods.F90 @@ -35,7 +35,7 @@ MODULE PROCEDURE ToUpperCase_Char INTEGER(I4B) :: i, diff -CHARACTER(LEN=1) :: c +CHARACTER(1) :: c diff = ICHAR('A') - ICHAR('a') DO i = 1, LEN(chars) @@ -61,7 +61,7 @@ MODULE PROCEDURE ToLowerCase_Char INTEGER(I4B) :: i, diff -CHARACTER(LEN=1) :: c +CHARACTER(1) :: c !> diff = ICHAR('A') - ICHAR('a') DO i = 1, LEN(chars) @@ -229,7 +229,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE FindReplace_chars -CHARACTER(LEN=LEN(chars)) :: string2 +CHARACTER(LEN(chars)) :: string2 INTEGER(I4B), ALLOCATABLE :: indices(:) INTEGER(I4B) :: i, n, stt, stp, dlen, slen, rlen, flen, tlen !> @@ -259,7 +259,7 @@ MODULE PROCEDURE getField_chars INTEGER(I4B) :: j, ioerr, nf -CHARACTER(LEN=LEN(chars)) :: temp, temp2 +CHARACTER(LEN(chars)) :: temp, temp2 temp = chars temp2 = '' @@ -323,7 +323,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE getPath_chars -CHARACTER(LEN=LEN(chars)) :: chars2 +CHARACTER(LEN(chars)) :: chars2 INTEGER(I4B) :: i !> chars2 = chars @@ -356,7 +356,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE getFileName_chars -CHARACTER(LEN=LEN(chars)) :: chars2 +CHARACTER(LEN(chars)) :: chars2 INTEGER(I4B) :: i chars2 = chars CALL SlashRep(chars2) @@ -374,7 +374,7 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE getFileNameExt_chars -CHARACTER(LEN=LEN(chars)) :: chars2 +CHARACTER(LEN(chars)) :: chars2 INTEGER(I4B) :: i, SLASHloc chars2 = chars From 27ecc588e3c0228cedc5300e114f1646cc44d7b5 Mon Sep 17 00:00:00 2001 From: Vikas Sharma Date: Mon, 5 Dec 2022 15:53:43 +0900 Subject: [PATCH 16/16] Some formatting in FPL module --- src/modules/FPL/src/FPL.F90 | 22 ++++++------- src/modules/FPL/src/FPL_utils.F90 | 53 +++++++++++++++++++++++-------- 2 files changed, 49 insertions(+), 26 deletions(-) diff --git a/src/modules/FPL/src/FPL.F90 b/src/modules/FPL/src/FPL.F90 index f34260fec..bb1bbe18d 100644 --- a/src/modules/FPL/src/FPL.F90 +++ b/src/modules/FPL/src/FPL.F90 @@ -22,7 +22,6 @@ #define ParameterListIterator_t ParameterListIterator_ module FPL - USE ParameterList USE WrapperFactoryListSingleton @@ -30,19 +29,16 @@ module FPL contains - subroutine FPL_Init() - !----------------------------------------------------------------- - !< Initialize FPL - !----------------------------------------------------------------- - call TheWrapperFactoryList_Init() - end subroutine FPL_Init +!> author: Vikas Sharma, Ph. D. +! date: 2022-12-02 +! summary: Initialize FPL +subroutine FPL_Init() + call TheWrapperFactoryList_Init() +end subroutine FPL_Init - subroutine FPL_Finalize() - !----------------------------------------------------------------- - !< Finalize FPL - !----------------------------------------------------------------- - call TheWrapperFactoryList%Free() - end subroutine FPL_Finalize +subroutine FPL_Finalize() + call TheWrapperFactoryList%Free() +end subroutine FPL_Finalize end module FPL diff --git a/src/modules/FPL/src/FPL_utils.F90 b/src/modules/FPL/src/FPL_utils.F90 index 4c4ca3f2c..978416506 100644 --- a/src/modules/FPL/src/FPL_utils.F90 +++ b/src/modules/FPL/src/FPL_utils.F90 @@ -1,18 +1,45 @@ -module FPL_Utils +! 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 FPL_Utils USE PENF, only: I1P, I4P - contains - elemental function byte_size_logical(l) result(bytes) - !----------------------------------------------------------------- - !< Procedure for computing the number of bytes of a logical variable. - !----------------------------------------------------------------- - logical, intent(IN):: l !< Character variable whose number of bits must be computed. - integer(I4P) :: bytes !< Number of bits of l. - integer(I1P) :: mold(1) !< "Molding" dummy variable for bits counting. - !----------------------------------------------------------------- - bytes = size(transfer(l,mold),dim=1,kind=I1P) - return - end function byte_size_logical +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Vikas Sharma, Ph. D. +! date: 2022-12-02 +! summary: Procedure for computing the number of bytes of a logical variable. + +elemental function byte_size_logical(l) result(bytes) + logical, intent(IN) :: l + !! Character variable whose number of bits must be computed. + integer(I4P) :: bytes + !! Number of bits of l. + integer(I1P) :: mold(1) + !! "Molding" dummy variable for bits counting. + bytes = size(transfer(l, mold), dim=1, kind=I1P) + return +end function byte_size_logical + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + end module FPL_Utils