diff --git a/src/modules/ConvectiveMatrix/src/ConvectiveMatrix_Method.F90 b/src/modules/ConvectiveMatrix/src/ConvectiveMatrix_Method.F90 index b38be47e3..367b49e0a 100644 --- a/src/modules/ConvectiveMatrix/src/ConvectiveMatrix_Method.F90 +++ b/src/modules/ConvectiveMatrix/src/ConvectiveMatrix_Method.F90 @@ -26,6 +26,7 @@ MODULE ConvectiveMatrix_Method PRIVATE PUBLIC :: ConvectiveMatrix +PUBLIC :: ConvectiveMatrix_ !---------------------------------------------------------------------------- ! ConvectiveMatrix@ConvectiveMatrixMethods @@ -36,7 +37,7 @@ MODULE ConvectiveMatrix_Method ! update: 2021-11-21 ! summary: returns the convective matrix -INTERFACE +INTERFACE ConvectiveMatrix MODULE PURE FUNCTION ConvectiveMatrix_1(test, trial, term1, & & term2, opt) RESULT(Ans) CLASS(ElemshapeData_), INTENT(IN) :: test @@ -45,15 +46,32 @@ MODULE PURE FUNCTION ConvectiveMatrix_1(test, trial, term1, & !! del_x, del_y, del_z, del_x_all, del_none INTEGER(I4B), INTENT(IN) :: term2 !! del_x, del_y, del_z, del_x_all, del_none - INTEGER( I4B ), OPTIONAL, INTENT( IN ) :: opt + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt REAL(DFP), ALLOCATABLE :: ans(:, :) END FUNCTION ConvectiveMatrix_1 -END INTERFACE - -INTERFACE ConvectiveMatrix - MODULE PROCEDURE ConvectiveMatrix_1 END INTERFACE ConvectiveMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: Convective matrix without allcation + +INTERFACE ConvectiveMatrix_ + MODULE PURE SUBROUTINE ConvectiveMatrix1_(test, trial, term1, & + & term2, nrow, ncol, opt, ans) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(inout) :: ans(:, :) + END SUBROUTINE ConvectiveMatrix1_ +END INTERFACE ConvectiveMatrix_ + !---------------------------------------------------------------------------- ! ConvectiveMatrix@ConvectiveMatrixMethods !---------------------------------------------------------------------------- @@ -63,7 +81,7 @@ END FUNCTION ConvectiveMatrix_1 ! update: 2021-11-21 ! summary: returns the convective matrix -INTERFACE +INTERFACE ConvectiveMatrix MODULE PURE FUNCTION ConvectiveMatrix_2(test, trial, c, crank, term1, & & term2, opt) RESULT(Ans) CLASS(ElemshapeData_), INTENT(IN) :: test @@ -76,16 +94,35 @@ MODULE PURE FUNCTION ConvectiveMatrix_2(test, trial, c, crank, term1, & !! del_x, del_y, del_z, del_x_all, del_none INTEGER(I4B), INTENT(IN) :: term2 !! del_x, del_y, del_z, del_x_all, del_none - INTEGER( I4B ), OPTIONAL, INTENT( IN ) :: opt + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt !! number of copies REAL(DFP), ALLOCATABLE :: ans(:, :) END FUNCTION ConvectiveMatrix_2 -END INTERFACE - -INTERFACE ConvectiveMatrix - MODULE PROCEDURE ConvectiveMatrix_2 END INTERFACE ConvectiveMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: Convective matrix without allcation + +INTERFACE ConvectiveMatrix_ + MODULE PURE SUBROUTINE ConvectiveMatrix2_(test, trial, c, crank, term1, & + & term2, opt, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + TYPE(FEVariable_), INTENT(IN) :: c + TYPE(FEVariableScalar_), INTENT(IN) :: crank + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(inout) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE ConvectiveMatrix2_ +END INTERFACE ConvectiveMatrix_ + !---------------------------------------------------------------------------- ! ConvectiveMatrix@ConvectiveMatrixMethods !---------------------------------------------------------------------------- @@ -95,7 +132,7 @@ END FUNCTION ConvectiveMatrix_2 ! update: 2021-11-21 ! summary: returns the convective matrix -INTERFACE +INTERFACE ConvectiveMatrix MODULE PURE FUNCTION ConvectiveMatrix_3(test, trial, c, crank, term1, & & term2, opt) RESULT(Ans) CLASS(ElemshapeData_), INTENT(IN) :: test @@ -108,18 +145,37 @@ MODULE PURE FUNCTION ConvectiveMatrix_3(test, trial, c, crank, term1, & !! del_x, del_y, del_z, del_x_all, del_none INTEGER(I4B), INTENT(IN) :: term2 !! del_x, del_y, del_z, del_x_all, del_none - INTEGER( I4B ), OPTIONAL, INTENT( IN ) :: opt + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt !! number of copies REAL(DFP), ALLOCATABLE :: ans(:, :) END FUNCTION ConvectiveMatrix_3 -END INTERFACE - -INTERFACE ConvectiveMatrix - MODULE PROCEDURE ConvectiveMatrix_3 END INTERFACE ConvectiveMatrix !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: Convective matrix without allcation + +INTERFACE ConvectiveMatrix_ + MODULE PURE SUBROUTINE ConvectiveMatrix3_(test, trial, c, crank, term1, & + & term2, opt, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + TYPE(FEVariable_), INTENT(IN) :: c + TYPE(FEVariableVector_), INTENT(IN) :: crank + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(inout) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE ConvectiveMatrix3_ +END INTERFACE ConvectiveMatrix_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END MODULE ConvectiveMatrix_Method diff --git a/src/modules/DiffusionMatrix/src/DiffusionMatrix_Method.F90 b/src/modules/DiffusionMatrix/src/DiffusionMatrix_Method.F90 index 9347beac4..899f090fd 100644 --- a/src/modules/DiffusionMatrix/src/DiffusionMatrix_Method.F90 +++ b/src/modules/DiffusionMatrix/src/DiffusionMatrix_Method.F90 @@ -118,6 +118,23 @@ MODULE PURE FUNCTION DiffusionMatrix_2(test, trial, k, krank, opt) & END FUNCTION DiffusionMatrix_2 END INTERFACE DiffusionMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE DiffusionMatrix_ + MODULE PURE SUBROUTINE DiffusionMatrix2_(test, trial, k, krank, opt, & + ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: k + TYPE(FEVariableScalar_), INTENT(IN) :: krank + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE DiffusionMatrix2_ +END INTERFACE DiffusionMatrix_ + !---------------------------------------------------------------------------- ! DiffusionMatrix@DiffusionMatrixMethods !---------------------------------------------------------------------------- @@ -149,6 +166,23 @@ MODULE PURE FUNCTION DiffusionMatrix_3(test, trial, k, krank, opt) & END FUNCTION DiffusionMatrix_3 END INTERFACE DiffusionMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE DiffusionMatrix_ + MODULE PURE SUBROUTINE DiffusionMatrix3_(test, trial, k, krank, opt, & + ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: k + TYPE(FEVariableVector_), INTENT(IN) :: krank + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE DiffusionMatrix3_ +END INTERFACE DiffusionMatrix_ + !---------------------------------------------------------------------------- ! DiffusionMatrix@DiffusionMatrixMethods !---------------------------------------------------------------------------- @@ -181,6 +215,23 @@ MODULE PURE FUNCTION DiffusionMatrix_4(test, trial, k, krank, opt) & END FUNCTION DiffusionMatrix_4 END INTERFACE DiffusionMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE DiffusionMatrix_ + MODULE PURE SUBROUTINE DiffusionMatrix4_(test, trial, k, krank, opt, & + ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: k + TYPE(FEVariableMatrix_), INTENT(IN) :: krank + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE DiffusionMatrix4_ +END INTERFACE DiffusionMatrix_ + !---------------------------------------------------------------------------- ! DiffusionMatrix@DiffusionMatrixMethods !---------------------------------------------------------------------------- @@ -217,6 +268,25 @@ MODULE PURE FUNCTION DiffusionMatrix_5(test, trial, c1, c2, c1rank, & END FUNCTION DiffusionMatrix_5 END INTERFACE DiffusionMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE DiffusionMatrix_ + MODULE PURE SUBROUTINE DiffusionMatrix5_(test, trial, c1, c2, c1rank, & + c2rank, opt, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: c1 + CLASS(FEVariable_), INTENT(IN) :: c2 + TYPE(FEVariableScalar_), INTENT(IN) :: c1rank + TYPE(FEVariableScalar_), INTENT(IN) :: c2rank + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE DiffusionMatrix5_ +END INTERFACE DiffusionMatrix_ + !---------------------------------------------------------------------------- ! DiffusionMatrix@DiffusionMatrixMethods !---------------------------------------------------------------------------- @@ -253,6 +323,25 @@ MODULE PURE FUNCTION DiffusionMatrix_6(test, trial, c1, c2, c1rank, & END FUNCTION DiffusionMatrix_6 END INTERFACE DiffusionMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE DiffusionMatrix_ + MODULE PURE SUBROUTINE DiffusionMatrix6_(test, trial, c1, c2, c1rank, & + c2rank, opt, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: c1 + CLASS(FEVariable_), INTENT(IN) :: c2 + TYPE(FEVariableScalar_), INTENT(IN) :: c1rank + TYPE(FEVariableVector_), INTENT(IN) :: c2rank + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE DiffusionMatrix6_ +END INTERFACE DiffusionMatrix_ + !---------------------------------------------------------------------------- ! DiffusionMatrix@DiffusionMatrixMethods !---------------------------------------------------------------------------- diff --git a/src/modules/ElemshapeData/src/ElemshapeData_InterpolMethods.F90 b/src/modules/ElemshapeData/src/ElemshapeData_InterpolMethods.F90 index 1074afee6..f6ab5ef77 100644 --- a/src/modules/ElemshapeData/src/ElemshapeData_InterpolMethods.F90 +++ b/src/modules/ElemshapeData/src/ElemshapeData_InterpolMethods.F90 @@ -17,13 +17,14 @@ ! ! This file contains the interpolation methods interfaces\ -module ElemshapeData_InterpolMethods +MODULE ElemshapeData_InterpolMethods USE BaseType USE GlobalData IMPLICIT NONE PRIVATE -PUBLIC :: getInterpolation +PUBLIC :: GetInterpolation +PUBLIC :: GetInterpolation_ PUBLIC :: Interpolation PUBLIC :: STInterpolation @@ -44,7 +45,7 @@ module ElemshapeData_InterpolMethods ! ! - TODO Make it work when the size of val is not the same as NNS -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE scalar_getInterpolation_1(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:) @@ -52,11 +53,24 @@ MODULE PURE SUBROUTINE scalar_getInterpolation_1(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:) !! spatial nodal values of scalar END SUBROUTINE scalar_getInterpolation_1 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE scalar_getInterpolation_1 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of scalar without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE scalar_getInterpolation1_(obj, interpol, val, tsize) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:) + REAL(DFP), INTENT(IN) :: val(:) + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE scalar_getInterpolation1_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -76,7 +90,7 @@ END SUBROUTINE scalar_getInterpolation_1 ! The resultant represents the interpolation value of `val` at ! spatial-quadrature points -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE scalar_getInterpolation_2(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:) @@ -84,11 +98,20 @@ MODULE PURE SUBROUTINE scalar_getInterpolation_2(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :) !! space-time nodal values of scalar END SUBROUTINE scalar_getInterpolation_2 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE scalar_getInterpolation_2 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE scalar_getInterpolation2_(obj, interpol, val, tsize) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:) + REAL(DFP), INTENT(IN) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE scalar_getInterpolation2_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -108,7 +131,7 @@ END SUBROUTINE scalar_getInterpolation_2 ! The resultant represents the interpolation value of `val` at ! spatial-temporal quadrature points -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE scalar_getInterpolation_3(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:, :) @@ -116,11 +139,25 @@ MODULE PURE SUBROUTINE scalar_getInterpolation_3(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :) !! space-time nodal values of scalar END SUBROUTINE scalar_getInterpolation_3 -END INTERFACE +END INTERFACE GetInterpolation + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- -INTERFACE getInterpolation - MODULE PROCEDURE scalar_getInterpolation_3 -END INTERFACE getInterpolation +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of scalar without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE scalar_getInterpolation3_(obj, interpol, val, & + nrow, ncol) + CLASS(STElemshapeData_), INTENT(IN) :: obj(:) + REAL(DFP), INTENT(INOUT) :: interpol(:, :) + REAL(DFP), INTENT(IN) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE scalar_getInterpolation3_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -144,7 +181,7 @@ END SUBROUTINE scalar_getInterpolation_3 !This routine calls [[Interpolation]] function from the same module. !@endnote -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE scalar_getInterpolation_4(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:) @@ -152,11 +189,24 @@ MODULE PURE SUBROUTINE scalar_getInterpolation_4(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! Scalar FE variable END SUBROUTINE scalar_getInterpolation_4 -END INTERFACE +END INTERFACE GetInterpolation + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of scalar without allocation -INTERFACE getInterpolation - MODULE PROCEDURE scalar_getInterpolation_4 -END INTERFACE getInterpolation +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE scalar_getInterpolation4_(obj, interpol, val, tsize) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE scalar_getInterpolation4_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -181,7 +231,7 @@ END SUBROUTINE scalar_getInterpolation_4 ! The resultant represents the interpolation value of `val` at ! spatial-quadrature points -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE scalar_getInterpolation_5(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :) @@ -189,11 +239,25 @@ MODULE PURE SUBROUTINE scalar_getInterpolation_5(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! scalar FE variable END SUBROUTINE scalar_getInterpolation_5 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE scalar_getInterpolation_5 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of scalar without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE scalar_getInterpolation5_(obj, interpol, val, & + nrow, ncol) + CLASS(STElemshapeData_), INTENT(IN) :: obj(:) + REAL(DFP), INTENT(INOUT) :: interpol(:, :) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE scalar_getInterpolation5_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -210,7 +274,7 @@ END SUBROUTINE scalar_getInterpolation_5 ! ! $$u_{i}=u_{iI}N^{I}$$ -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE vector_getInterpolation_1(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :) @@ -218,11 +282,25 @@ MODULE PURE SUBROUTINE vector_getInterpolation_1(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :) !! nodal values of vector in `xiJ` format END SUBROUTINE vector_getInterpolation_1 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE vector_getInterpolation_1 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of vector without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE vector_getInterpolation1_(obj, interpol, val, & + nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :) + REAL(DFP), INTENT(IN) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE vector_getInterpolation1_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -239,7 +317,7 @@ END SUBROUTINE vector_getInterpolation_1 ! ! $$u_{i}=u^{a}_{iI}N^{I}T_{a}$$ -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE vector_getInterpolation_2(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:, :) @@ -247,11 +325,25 @@ MODULE PURE SUBROUTINE vector_getInterpolation_2(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :, :) !! space-time nodal values of vector in `xiJa` format END SUBROUTINE vector_getInterpolation_2 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE vector_getInterpolation_2 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of vector without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE vector_getInterpolation2_(obj, interpol, val, & + nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :) + REAL(DFP), INTENT(IN) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE vector_getInterpolation2_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -268,7 +360,7 @@ END SUBROUTINE vector_getInterpolation_2 ! ! $$u_{i}=u^{a}_{iI}N^{I}T_{a}$$ -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE vector_getInterpolation_3(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:, :, :) @@ -276,11 +368,25 @@ MODULE PURE SUBROUTINE vector_getInterpolation_3(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :, :) !! space-time nodal values of vector in `xiJa` format END SUBROUTINE vector_getInterpolation_3 -END INTERFACE +END INTERFACE GetInterpolation + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- -INTERFACE getInterpolation - MODULE PROCEDURE vector_getInterpolation_3 -END INTERFACE getInterpolation +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of vector without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE vector_getInterpolation3_(obj, interpol, val, & + dim1, dim2, dim3) + CLASS(STElemshapeData_), INTENT(IN) :: obj(:) + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :) + REAL(DFP), INTENT(IN) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE vector_getInterpolation3_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -302,7 +408,7 @@ END SUBROUTINE vector_getInterpolation_3 ! ! NOTE This routine calls [[Interpolation]] function from the same module. ! -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE vector_getInterpolation_4(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :) @@ -310,11 +416,25 @@ MODULE PURE SUBROUTINE vector_getInterpolation_4(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! vector FEvariable END SUBROUTINE vector_getInterpolation_4 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE vector_getInterpolation_4 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of vector without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE vector_getInterpolation4_(obj, interpol, val, & + nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE vector_getInterpolation4_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -336,7 +456,7 @@ END SUBROUTINE vector_getInterpolation_4 ! ! NOTE This routine calls [[Interpolation]] function from the same module. ! -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE vector_getInterpolation_5(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :, :) @@ -344,11 +464,25 @@ MODULE PURE SUBROUTINE vector_getInterpolation_5(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! vector FEvariable END SUBROUTINE vector_getInterpolation_5 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE vector_getInterpolation_5 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: get interpolation of vector without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE vector_getInterpolation5_(obj, interpol, val, & + dim1, dim2, dim3) + CLASS(STElemshapeData_), INTENT(IN) :: obj(:) + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE vector_getInterpolation5_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -358,7 +492,7 @@ END SUBROUTINE vector_getInterpolation_5 ! date: 4 March 2021 ! summary: This subroutine performs interpolation of matrix -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE matrix_getInterpolation_1(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :, :) @@ -366,11 +500,25 @@ MODULE PURE SUBROUTINE matrix_getInterpolation_1(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :, :) !! nodal value of matrix END SUBROUTINE matrix_getInterpolation_1 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE matrix_getInterpolation_1 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: get interpolation of matrix without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE matrix_getInterpolation1_(obj, interpol, val, & + dim1, dim2, dim3) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :) + REAL(DFP), INTENT(IN) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE matrix_getInterpolation1_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -385,18 +533,32 @@ END SUBROUTINE matrix_getInterpolation_1 ! This subroutine performs interpolation of matrix from its space-time ! nodal values -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE matrix_getInterpolation_2(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:, :, :) REAL(DFP), INTENT(IN) :: val(:, :, :, :) !! space-time nodal value of matrix END SUBROUTINE matrix_getInterpolation_2 -END INTERFACE +END INTERFACE GetInterpolation + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- -INTERFACE getInterpolation - MODULE PROCEDURE matrix_getInterpolation_2 -END INTERFACE getInterpolation +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: get interpolation of matrix without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE matrix_getInterpolation2_(obj, interpol, val, & + dim1, dim2, dim3) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :) + REAL(DFP), INTENT(IN) :: val(:, :, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE matrix_getInterpolation2_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -411,7 +573,7 @@ END SUBROUTINE matrix_getInterpolation_2 ! This subroutine performs interpolation of matrix from its space-time ! nodal values -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE matrix_getInterpolation_3(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), INTENT(INOUT), ALLOCATABLE :: interpol(:, :, :, :) @@ -419,11 +581,7 @@ MODULE PURE SUBROUTINE matrix_getInterpolation_3(obj, interpol, val) REAL(DFP), INTENT(IN) :: val(:, :, :, :) !! space-time nodal value of matrix END SUBROUTINE matrix_getInterpolation_3 -END INTERFACE - -INTERFACE getInterpolation - MODULE PROCEDURE matrix_getInterpolation_3 -END INTERFACE getInterpolation +END INTERFACE GetInterpolation !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -433,7 +591,7 @@ END SUBROUTINE matrix_getInterpolation_3 ! date: 4 March 2021 ! summary: This subroutine performs interpolation of matrix FEVariable ! -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE matrix_getInterpolation_4(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :, :) @@ -441,17 +599,31 @@ MODULE PURE SUBROUTINE matrix_getInterpolation_4(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! matrix fe variable END SUBROUTINE matrix_getInterpolation_4 -END INTERFACE +END INTERFACE GetInterpolation -INTERFACE getInterpolation - MODULE PROCEDURE matrix_getInterpolation_4 -END INTERFACE getInterpolation +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: get interpolation of matrix without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE matrix_getInterpolation4_(obj, interpol, val, & + dim1, dim2, dim3) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE matrix_getInterpolation4_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods !---------------------------------------------------------------------------- -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE matrix_getInterpolation_5(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: interpol(:, :, :, :) @@ -459,11 +631,25 @@ MODULE PURE SUBROUTINE matrix_getInterpolation_5(obj, interpol, val) TYPE(FEVariable_), INTENT(IN) :: val !! matrix fe variable END SUBROUTINE matrix_getInterpolation_5 -END INTERFACE +END INTERFACE GetInterpolation + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- -INTERFACE getInterpolation - MODULE PROCEDURE matrix_getInterpolation_5 -END INTERFACE getInterpolation +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: get interpolation of matrix without allocation + +INTERFACE GetInterpolation_ + MODULE PURE SUBROUTINE matrix_getInterpolation5_(obj, interpol, val, & + dim1, dim2, dim3, dim4) + CLASS(STElemshapeData_), INTENT(IN) :: obj(:) + REAL(DFP), INTENT(INOUT) :: interpol(:, :, :, :) + TYPE(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3, dim4 + END SUBROUTINE matrix_getInterpolation5_ +END INTERFACE GetInterpolation_ !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -485,17 +671,13 @@ END SUBROUTINE matrix_getInterpolation_5 ! - the val can be defined on quadrature (do nothing) or nodal (interpol) ! - The `vartype` of val can be constant, space, time, spacetime ! -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE master_getInterpolation_1(obj, interpol, val) CLASS(ElemshapeData_), INTENT(IN) :: obj TYPE(FEVariable_), INTENT(INOUT) :: interpol TYPE(FEVariable_), INTENT(IN) :: val END SUBROUTINE master_getInterpolation_1 -END INTERFACE - -INTERFACE getInterpolation - MODULE PROCEDURE master_getInterpolation_1 -END INTERFACE getInterpolation +END INTERFACE GetInterpolation !---------------------------------------------------------------------------- ! getInterpolation@InterpolMethods @@ -517,17 +699,13 @@ END SUBROUTINE master_getInterpolation_1 ! - the val can be defined on quadrature (do nothing) or nodal (interpol) ! - The `vartype` of val can be constant, space, time, spacetime ! -INTERFACE +INTERFACE GetInterpolation MODULE PURE SUBROUTINE master_getInterpolation_2(obj, interpol, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) TYPE(FEVariable_), INTENT(INOUT) :: interpol TYPE(FEVariable_), INTENT(IN) :: val END SUBROUTINE master_getInterpolation_2 -END INTERFACE - -INTERFACE getInterpolation - MODULE PROCEDURE master_getInterpolation_2 -END INTERFACE getInterpolation +END INTERFACE GetInterpolation !---------------------------------------------------------------------------- ! Interpolation@InterpolMethods @@ -537,16 +715,12 @@ END SUBROUTINE master_getInterpolation_2 ! date: 4 March 2021 ! summary: This function returns the interpolation of a scalar -INTERFACE +INTERFACE Interpolation MODULE PURE FUNCTION scalar_interpolation_1(obj, val) RESULT(interpol) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), INTENT(IN) :: val(:) REAL(DFP), ALLOCATABLE :: interpol(:) END FUNCTION scalar_interpolation_1 -END INTERFACE - -INTERFACE Interpolation - MODULE PROCEDURE scalar_interpolation_1 END INTERFACE Interpolation !---------------------------------------------------------------------------- @@ -692,4 +866,4 @@ END FUNCTION matrix_stinterpolation_1 MODULE PROCEDURE matrix_stinterpolation_1 END INTERFACE STInterpolation -end module ElemshapeData_InterpolMethods +END MODULE ElemshapeData_InterpolMethods diff --git a/src/modules/ElemshapeData/src/ElemshapeData_ProjectionMethods.F90 b/src/modules/ElemshapeData/src/ElemshapeData_ProjectionMethods.F90 index 4d78a673c..0f71ae33b 100644 --- a/src/modules/ElemshapeData/src/ElemshapeData_ProjectionMethods.F90 +++ b/src/modules/ElemshapeData/src/ElemshapeData_ProjectionMethods.F90 @@ -15,14 +15,17 @@ ! along with this program. If not, see ! -module ElemshapeData_ProjectionMethods +MODULE ElemshapeData_ProjectionMethods USE BaseType USE GlobalData IMPLICIT NONE PRIVATE PUBLIC :: getProjectionOfdNdXt +PUBLIC :: getProjectionOfdNdXt_ PUBLIC :: getProjectionOfdNTdXt +! TODO: implement +! PUBLIC :: getProjectionOfdNTdXt_ !---------------------------------------------------------------------------- ! getProjectionOfdNdXt@ProjectionMethods @@ -40,7 +43,7 @@ module ElemshapeData_ProjectionMethods ! ! $$P^{I}=c_{i}\frac{\partial N^{I}}{\partial x_{i}} $$ -INTERFACE +INTERFACE GetProjectionOfdNdXt MODULE PURE SUBROUTINE getProjectionOfdNdXt_1(obj, cdNdXt, val) CLASS(ElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: cdNdXt(:, :) @@ -48,11 +51,24 @@ MODULE PURE SUBROUTINE getProjectionOfdNdXt_1(obj, cdNdXt, val) REAL(DFP), INTENT(IN) :: val(:) !! constant value of vector END SUBROUTINE getProjectionOfdNdXt_1 -END INTERFACE +END INTERFACE GetProjectionOfdNdXt -INTERFACE getProjectionOfdNdXt - MODULE PROCEDURE getProjectionOfdNdXt_1 -END INTERFACE getProjectionOfdNdXt +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: get interpolation of vector without allocation + +INTERFACE GetProjectionOfdNdXt_ + MODULE PURE SUBROUTINE getProjectionOfdNdXt1_(obj, cdNdXt, val, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: cdNdXt(:, :) + REAL(DFP), INTENT(IN) :: val(:) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE getProjectionOfdNdXt1_ +END INTERFACE GetProjectionOfdNdXt_ !---------------------------------------------------------------------------- ! getProjectionOfdNdXt@getMethod @@ -70,7 +86,7 @@ END SUBROUTINE getProjectionOfdNdXt_1 ! ! $$P^{I}=c_{i}\frac{\partial N^{I}}{\partial x_{i}} $$ -INTERFACE +INTERFACE GetProjectionOfdNdXt MODULE PURE SUBROUTINE getProjectionOfdNdXt_2(obj, cdNdXt, val) CLASS(ElemshapeData_), INTENT(IN) :: obj !! ElemshapeData object @@ -79,11 +95,20 @@ MODULE PURE SUBROUTINE getProjectionOfdNdXt_2(obj, cdNdXt, val) CLASS(FEVariable_), INTENT(IN) :: val !! FEVariable vector END SUBROUTINE getProjectionOfdNdXt_2 -END INTERFACE +END INTERFACE GetProjectionOfdNdXt -INTERFACE getProjectionOfdNdXt - MODULE PROCEDURE getProjectionOfdNdXt_2 -END INTERFACE getProjectionOfdNdXt +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE GetProjectionOfdNdXt_ + MODULE PURE SUBROUTINE getProjectionOfdNdXt2_(obj, cdNdXt, val, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: cdNdXt(:, :) + CLASS(FEVariable_), INTENT(IN) :: val + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE getProjectionOfdNdXt2_ +END INTERFACE GetProjectionOfdNdXt_ !---------------------------------------------------------------------------- ! getProjectionOfdNdXt@getMethod @@ -101,7 +126,7 @@ END SUBROUTINE getProjectionOfdNdXt_2 ! ! $$P^{I}=c_{i}\frac{\partial N^{I}}{\partial x_{i}} $$ -INTERFACE +INTERFACE GetProjectionOfdNdXt MODULE PURE SUBROUTINE getProjectionOfdNdXt_3(obj, cdNdXt, val) CLASS(ElemshapeData_), INTENT(IN) :: obj !! ElemshapeData object @@ -110,11 +135,24 @@ MODULE PURE SUBROUTINE getProjectionOfdNdXt_3(obj, cdNdXt, val) REAL(DFP), INTENT(IN) :: val(:, :) !! a vector, defined over quadrature points END SUBROUTINE getProjectionOfdNdXt_3 -END INTERFACE +END INTERFACE GetProjectionOfdNdXt + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- -INTERFACE getProjectionOfdNdXt - MODULE PROCEDURE getProjectionOfdNdXt_3 -END INTERFACE getProjectionOfdNdXt +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: get interpolation of vector without allocation + +INTERFACE GetProjectionOfdNdXt_ + MODULE PURE SUBROUTINE getProjectionOfdNdXt3_(obj, cdNdXt, val, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: cdNdXt(:, :) + REAL(DFP), INTENT(IN) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE getProjectionOfdNdXt3_ +END INTERFACE GetProjectionOfdNdXt_ !---------------------------------------------------------------------------- ! getProjectionOfdNTdXt@getMethod @@ -130,7 +168,7 @@ END SUBROUTINE getProjectionOfdNdXt_3 ! ! $$P^{I,a}=c_{i}\frac{\partial N^{I} T_a}{\partial x_{i}}$$ -INTERFACE +INTERFACE GetProjectionOfdNTdXt MODULE PURE SUBROUTINE getProjectionOfdNTdXt_1(obj, cdNTdXt, val) CLASS(STElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: cdNTdXt(:, :, :) @@ -138,11 +176,7 @@ MODULE PURE SUBROUTINE getProjectionOfdNTdXt_1(obj, cdNTdXt, val) REAL(DFP), INTENT(IN) :: val(:) !! constant value of vector END SUBROUTINE getProjectionOfdNTdXt_1 -END INTERFACE - -INTERFACE getProjectionOfdNTdXt - MODULE PROCEDURE getProjectionOfdNTdXt_1 -END INTERFACE getProjectionOfdNTdXt +END INTERFACE GetProjectionOfdNTdXt !---------------------------------------------------------------------------- ! getProjectionOfdNTdXt@getMethod @@ -164,7 +198,7 @@ END SUBROUTINE getProjectionOfdNTdXt_1 ! ! $$P^{I,a}=c_{i}\frac{\partial N^{I} T_a}{\partial x_{i}}$$ ! -INTERFACE +INTERFACE GetProjectionOfdNTdXt MODULE PURE SUBROUTINE getProjectionOfdNTdXt_2(obj, cdNTdXt, val) CLASS(STElemshapeData_), INTENT(IN) :: obj REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: cdNTdXt(:, :, :) @@ -172,11 +206,7 @@ MODULE PURE SUBROUTINE getProjectionOfdNTdXt_2(obj, cdNTdXt, val) TYPE(FEVariable_), INTENT(IN) :: val !! constant value of vector END SUBROUTINE getProjectionOfdNTdXt_2 -END INTERFACE - -INTERFACE getProjectionOfdNTdXt - MODULE PROCEDURE getProjectionOfdNTdXt_2 -END INTERFACE getProjectionOfdNTdXt +END INTERFACE GetProjectionOfdNTdXt !---------------------------------------------------------------------------- ! getProjectionOfdNTdXt@getMethod @@ -199,16 +229,12 @@ END SUBROUTINE getProjectionOfdNTdXt_2 ! ! $$P^{I,a}=c_{i}\frac{\partial N^{I} T_a}{\partial x_{i}}$$ ! -INTERFACE +INTERFACE GetProjectionOfdNTdXt MODULE PURE SUBROUTINE getProjectionOfdNTdXt_3(obj, cdNTdXt, val) CLASS(STElemshapeData_), INTENT(IN) :: obj(:) REAL(DFP), ALLOCATABLE, INTENT(INOUT) :: cdNTdXt(:, :, :, :) TYPE(FEVariable_), INTENT(IN) :: val END SUBROUTINE getProjectionOfdNTdXt_3 -END INTERFACE - -INTERFACE getProjectionOfdNTdXt - MODULE PROCEDURE getProjectionOfdNTdXt_3 -END INTERFACE getProjectionOfdNTdXt +END INTERFACE GetProjectionOfdNTdXt -end module ElemshapeData_ProjectionMethods +END MODULE ElemshapeData_ProjectionMethods diff --git a/src/modules/FEVariable/src/FEVariable_Method.F90 b/src/modules/FEVariable/src/FEVariable_Method.F90 index 965542d7e..718aba242 100644 --- a/src/modules/FEVariable/src/FEVariable_Method.F90 +++ b/src/modules/FEVariable/src/FEVariable_Method.F90 @@ -42,6 +42,7 @@ MODULE FEVariable_Method PUBLIC :: isNodalVariable PUBLIC :: isQuadratureVariable PUBLIC :: Get +PUBLIC :: Get_ PUBLIC :: OPERATOR(+) PUBLIC :: OPERATOR(-) PUBLIC :: OPERATOR(*) @@ -1077,6 +1078,24 @@ MODULE PURE FUNCTION Scalar_Space(obj, rank, vartype) RESULT(val) END FUNCTION Scalar_Space END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is scalar, space without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Scalar_Space_(obj, rank, vartype, val, tsize) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:) + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE Scalar_Space_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1094,6 +1113,24 @@ MODULE PURE FUNCTION Scalar_Time(obj, rank, vartype) RESULT(val) END FUNCTION Scalar_Time END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is scalar, time without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Scalar_Time_(obj, rank, vartype, val, tsize) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:) + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE Scalar_Time_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1111,6 +1148,25 @@ MODULE PURE FUNCTION Scalar_SpaceTime(obj, rank, vartype) RESULT(val) END FUNCTION Scalar_SpaceTime END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is scalar, SpaceTime without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Scalar_SpaceTime_(obj, rank, vartype, val, & + nrow, ncol) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableScalar_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE Scalar_SpaceTime_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1128,6 +1184,24 @@ MODULE PURE FUNCTION Vector_Constant(obj, rank, vartype) RESULT(val) END FUNCTION Vector_Constant END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is vector, constant without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Vector_Constant_(obj, rank, vartype, val, tsize) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:) + INTEGER(I4B), INTENT(OUT) :: tsize + END SUBROUTINE Vector_Constant_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1145,6 +1219,25 @@ MODULE PURE FUNCTION Vector_Space(obj, rank, vartype) RESULT(val) END FUNCTION Vector_Space END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is vector, space without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Vector_Space_(obj, rank, vartype, val, & + nrow, ncol) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE Vector_Space_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1162,6 +1255,25 @@ MODULE PURE FUNCTION Vector_Time(obj, rank, vartype) RESULT(val) END FUNCTION Vector_Time END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is vector, time without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Vector_Time_(obj, rank, vartype, val, & + nrow, ncol) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE Vector_Time_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1179,6 +1291,25 @@ MODULE PURE FUNCTION Vector_SpaceTime(obj, rank, vartype) RESULT(val) END FUNCTION Vector_SpaceTime END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is vector, spaceTime without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Vector_SpaceTime_(obj, rank, vartype, val, & + dim1, dim2, dim3) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableVector_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE Vector_SpaceTime_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1196,6 +1327,25 @@ MODULE PURE FUNCTION Matrix_Constant(obj, rank, vartype) RESULT(val) END FUNCTION Matrix_Constant END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is Matrix, Constant without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Matrix_Constant_(obj, rank, vartype, val, & + nrow, ncol) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableConstant_), INTENT(IN) :: vartype + REAL(DFP), INTENT(inout) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE Matrix_Constant_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1213,6 +1363,25 @@ MODULE PURE FUNCTION Matrix_Space(obj, rank, vartype) RESULT(val) END FUNCTION Matrix_Space END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is Matrix, Space without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Matrix_Space_(obj, rank, vartype, val, & + dim1, dim2, dim3) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpace_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE Matrix_Space_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1230,6 +1399,25 @@ MODULE PURE FUNCTION Matrix_Time(obj, rank, vartype) RESULT(val) END FUNCTION Matrix_Time END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is Matrix, Time without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Matrix_Time_(obj, rank, vartype, val, & + dim1, dim2, dim3) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE Matrix_Time_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Get@GetMethods !---------------------------------------------------------------------------- @@ -1247,6 +1435,25 @@ MODULE PURE FUNCTION Matrix_SpaceTime(obj, rank, vartype) RESULT(val) END FUNCTION Matrix_SpaceTime END INTERFACE Get +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-04 +! summary: Returns value which is Matrix, SpaceTime without allocation + +INTERFACE Get_ + MODULE PURE SUBROUTINE Matrix_SpaceTime_(obj, rank, vartype, val, & + dim1, dim2, dim3, dim4) + CLASS(FEVariable_), INTENT(IN) :: obj + TYPE(FEVariableMatrix_), INTENT(IN) :: rank + TYPE(FEVariableSpaceTime_), INTENT(IN) :: vartype + REAL(DFP), INTENT(INOUT) :: val(:, :, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3, dim4 + END SUBROUTINE Matrix_SpaceTime_ +END INTERFACE Get_ + !---------------------------------------------------------------------------- ! Addition@AdditioMethods !---------------------------------------------------------------------------- diff --git a/src/modules/MassMatrix/src/MassMatrix_Method.F90 b/src/modules/MassMatrix/src/MassMatrix_Method.F90 index c2b6ab317..7b7eeafa6 100644 --- a/src/modules/MassMatrix/src/MassMatrix_Method.F90 +++ b/src/modules/MassMatrix/src/MassMatrix_Method.F90 @@ -26,6 +26,7 @@ MODULE MassMatrix_Method PRIVATE PUBLIC :: MassMatrix +PUBLIC :: MassMatrix_ PUBLIC :: ViscousBoundaryMassMatrix !---------------------------------------------------------------------------- @@ -56,6 +57,20 @@ MODULE PURE FUNCTION MassMatrix_1(test, trial, opt) RESULT(ans) END FUNCTION MassMatrix_1 END INTERFACE MassMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE MassMatrix_ + MODULE PURE SUBROUTINE MassMatrix1_(test, trial, ans, nrow, ncol, opt) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + END SUBROUTINE MassMatrix1_ +END INTERFACE MassMatrix_ + !---------------------------------------------------------------------------- ! MassMatrix@MassMatrixMethods !---------------------------------------------------------------------------- @@ -80,6 +95,23 @@ MODULE PURE FUNCTION MassMatrix_2(test, trial, rho, rhorank, opt) & END FUNCTION MassMatrix_2 END INTERFACE MassMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE MassMatrix_ + MODULE PURE SUBROUTINE MassMatrix2_(test, trial, rho, rhorank, & + ans, nrow, ncol, opt) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: rho + TYPE(FEVariableScalar_), INTENT(IN) :: rhorank + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + END SUBROUTINE MassMatrix2_ +END INTERFACE MassMatrix_ + !---------------------------------------------------------------------------- ! MassMatrix@MassMatrixMethods !---------------------------------------------------------------------------- @@ -104,6 +136,27 @@ MODULE PURE FUNCTION MassMatrix_3(test, trial, rho, rhorank, opt) & END FUNCTION MassMatrix_3 END INTERFACE MassMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-02 +! summary: mass matrix in space +! notice: not implemented yet + +INTERFACE MassMatrix_ + MODULE PURE SUBROUTINE MassMatrix3_(test, trial, rho, & + opt, nrow, ncol, ans) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: rho + INTEGER(I4B), INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + REAL(DFP), INTENT(INOUT) :: ans(:, :) + END SUBROUTINE MassMatrix3_ +END INTERFACE MassMatrix_ + !---------------------------------------------------------------------------- ! MassMatrix@MassMatrixMethods !---------------------------------------------------------------------------- @@ -126,6 +179,27 @@ MODULE PURE FUNCTION MassMatrix_4(test, trial, rho, rhorank) & END FUNCTION MassMatrix_4 END INTERFACE MassMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-02 +! summary: mass matrix in space +! notice: not implemented yet + +INTERFACE MassMatrix_ + MODULE PURE SUBROUTINE MassMatrix4_(test, trial, rho, rhorank, & + nrow, ncol, ans) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + CLASS(FEVariable_), INTENT(IN) :: rho + TYPE(FEVariableMatrix_), INTENT(IN) :: rhorank + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + REAL(DFP), INTENT(INOUT) :: ans(:, :) + END SUBROUTINE MassMatrix4_ +END INTERFACE MassMatrix_ + !---------------------------------------------------------------------------- ! MassMatrix@MassMatrixMethods !---------------------------------------------------------------------------- diff --git a/src/modules/StiffnessMatrix/src/StiffnessMatrix_Method.F90 b/src/modules/StiffnessMatrix/src/StiffnessMatrix_Method.F90 index 2f9b0479a..67bf4f160 100644 --- a/src/modules/StiffnessMatrix/src/StiffnessMatrix_Method.F90 +++ b/src/modules/StiffnessMatrix/src/StiffnessMatrix_Method.F90 @@ -26,6 +26,7 @@ MODULE StiffnessMatrix_Method PRIVATE PUBLIC :: StiffnessMatrix +PUBLIC :: StiffnessMatrix_ !---------------------------------------------------------------------------- ! StiffnessMatrix@StiffnessMatrixMethods @@ -40,6 +41,23 @@ MODULE PURE FUNCTION obj_StiffnessMatrix1(test, trial, Cijkl) & END FUNCTION obj_StiffnessMatrix1 END INTERFACE StiffnessMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-02-28 +! summary: subroutine to calculate stiffness matrix + +INTERFACE StiffnessMatrix_ + MODULE PURE SUBROUTINE obj_StiffnessMatrix1_(test, trial, Cijkl, nrow,ncol, ans) + CLASS(ElemshapeData_), INTENT(IN) :: test, trial + CLASS(FEVariable_), INTENT(IN) :: Cijkl + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + REAL(DFP), INTENT(INOUT) :: ans(:, :) + END SUBROUTINE obj_StiffnessMatrix1_ +END INTERFACE StiffnessMatrix_ + !---------------------------------------------------------------------------- ! StiffnessMatrix@StiffnessMatrixMethods !---------------------------------------------------------------------------- @@ -57,6 +75,21 @@ MODULE PURE FUNCTION obj_StiffnessMatrix2(test, trial, lambda, mu, & END FUNCTION obj_StiffnessMatrix2 END INTERFACE StiffnessMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE StiffnessMatrix_ + MODULE PURE SUBROUTINE obj_StiffnessMatrix2_(test, trial, lambda, mu, & + isLambdaYoungsModulus, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test, trial + CLASS(FEVariable_), INTENT(IN) :: lambda, mu + LOGICAL(LGT), OPTIONAL, INTENT(IN) :: isLambdaYoungsModulus + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE obj_StiffnessMatrix2_ +END INTERFACE StiffnessMatrix_ + !---------------------------------------------------------------------------- ! StiffnessMatrix@StiffnessMatrixMethods !---------------------------------------------------------------------------- @@ -70,6 +103,20 @@ MODULE PURE FUNCTION obj_StiffnessMatrix3(test, trial, lambda, & END FUNCTION obj_StiffnessMatrix3 END INTERFACE StiffnessMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE StiffnessMatrix_ + MODULE PURE SUBROUTINE obj_StiffnessMatrix3_(test, trial, lambda, & + mu, ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test, trial + REAL(DFP), INTENT(IN) :: lambda, mu + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE obj_StiffnessMatrix3_ +END INTERFACE StiffnessMatrix_ + !---------------------------------------------------------------------------- ! StiffnessMatrix@StiffnessMatrixMethods !---------------------------------------------------------------------------- @@ -83,6 +130,20 @@ MODULE PURE FUNCTION obj_StiffnessMatrix4(test, trial, Cijkl) & END FUNCTION obj_StiffnessMatrix4 END INTERFACE StiffnessMatrix +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +INTERFACE StiffnessMatrix_ + MODULE PURE SUBROUTINE obj_StiffnessMatrix4_(test, trial, Cijkl, ans, & + nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test, trial + REAL(DFP), INTENT(IN) :: Cijkl(:, :) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE obj_StiffnessMatrix4_ +END INTERFACE StiffnessMatrix_ + !---------------------------------------------------------------------------- ! StiffnessMatrix@StiffnessMatrixMethods !---------------------------------------------------------------------------- @@ -101,4 +162,19 @@ END FUNCTION obj_StiffnessMatrix5 ! !---------------------------------------------------------------------------- +INTERFACE StiffnessMatrix_ + MODULE PURE SUBROUTINE obj_StiffnessMatrix5_(test, trial, lambda, mu, & + ans, nrow, ncol) + CLASS(ElemshapeData_), INTENT(IN) :: test, trial + REAL(DFP), INTENT(IN) :: lambda(:) + REAL(DFP), INTENT(IN) :: mu(:) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE obj_StiffnessMatrix5_ +END INTERFACE StiffnessMatrix_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END MODULE StiffnessMatrix_Method diff --git a/src/modules/Utility/src/ConvertUtility.F90 b/src/modules/Utility/src/ConvertUtility.F90 index 9deec4303..2037e78d7 100644 --- a/src/modules/Utility/src/ConvertUtility.F90 +++ b/src/modules/Utility/src/ConvertUtility.F90 @@ -21,6 +21,7 @@ MODULE ConvertUtility PRIVATE PUBLIC :: Convert +PUBLIC :: Convert_ PUBLIC :: ConvertSafe !---------------------------------------------------------------------------- @@ -126,6 +127,22 @@ MODULE PURE SUBROUTINE convert_2(From, To) END SUBROUTINE convert_2 END INTERFACE Convert +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: convert without allocation + +INTERFACE Convert_ + MODULE PURE SUBROUTINE convert2_(From, To, nrow, ncol) + REAL(DFP), INTENT(IN) :: From(:, :, :, :) + REAL(DFP), INTENT(INOUT) :: To(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + END SUBROUTINE convert2_ +END INTERFACE Convert_ + !---------------------------------------------------------------------------- ! Convert@ConvertMethods !---------------------------------------------------------------------------- @@ -148,4 +165,20 @@ END SUBROUTINE convert_3 ! !---------------------------------------------------------------------------- +!> author: Shion Shimizu +! date: 2025-03-03 +! summary: convert without allocation + +INTERFACE Convert_ + MODULE PURE SUBROUTINE convert3_(From, To, dim1, dim2, dim3, dim4) + REAL(DFP), INTENT(IN) :: From(:, :, :, :, :, :) + REAL(DFP), INTENT(INOUT) :: To(:, :, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3, dim4 + END SUBROUTINE convert3_ +END INTERFACE Convert_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END MODULE ConvertUtility diff --git a/src/modules/Utility/src/ProductUtility.F90 b/src/modules/Utility/src/ProductUtility.F90 index 58f221cf6..b076bf7ea 100644 --- a/src/modules/Utility/src/ProductUtility.F90 +++ b/src/modules/Utility/src/ProductUtility.F90 @@ -193,6 +193,21 @@ MODULE PURE FUNCTION OuterProd_r1r2(a, b) RESULT(ans) END FUNCTION OuterProd_r1r2 END INTERFACE OuterProd +!> author: Shion Shimizu +! date: 2025-03-05 +! summary: a x b + +INTERFACE OuterProd_ + MODULE PURE SUBROUTINE OuterProd_r1r2_(a, b, anscoeff, scale, ans, & + dim1, dim2, dim3) + REAL(DFP), INTENT(IN) :: a(:) + REAL(DFP), INTENT(IN) :: b(:, :) + REAL(DFP), INTENT(IN) :: anscoeff, scale + REAL(DFP), INTENT(INOUT) :: ans(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + END SUBROUTINE OuterProd_r1r2_ +END INTERFACE OuterProd_ + !---------------------------------------------------------------------------- ! OuterProd@ProductMethods !---------------------------------------------------------------------------- diff --git a/src/submodules/ConvectiveMatrix/src/ConvectiveMatrix_Method@Methods.F90 b/src/submodules/ConvectiveMatrix/src/ConvectiveMatrix_Method@Methods.F90 index 838cc5b12..bad5cdb52 100644 --- a/src/submodules/ConvectiveMatrix/src/ConvectiveMatrix_Method@Methods.F90 +++ b/src/submodules/ConvectiveMatrix/src/ConvectiveMatrix_Method@Methods.F90 @@ -35,98 +35,127 @@ !---------------------------------------------------------------------------- MODULE PROCEDURE ConvectiveMatrix_1 -IF( term1 .EQ. DEL_NONE ) THEN -!! -!! -!! -!! - IF( term2 .EQ. DEL_X_ALL ) THEN - !! +IF (term1 .EQ. DEL_NONE) THEN + IF (term2 .EQ. DEL_X_ALL) THEN !! del_none !! del_x_all - !! CALL CM_9(ans=ans, test=test, trial=trial, & & term1=term2, term2=term2, opt=opt) - !! ELSE - !! !! del_none !! del_x, del_y, del_z - !! CALL CM_7(ans=ans, test=test, trial=trial, & & term1=term2, term2=term2, opt=opt) !! END IF -!! -!! -!! -!! ELSE - !! !! term2 .eq. del_none - !! - IF( term1 .EQ. del_x_all ) THEN - !! + IF (term1 .EQ. del_x_all) THEN !! del_x_all !! del_none - !! CALL CM_10(ans=ans, test=test, trial=trial, & & term1=term2, term2=term2, opt=opt) - !! ELSE - !! !! del_x, del_y, del_z !! del_none - !! CALL CM_8(ans=ans, test=test, trial=trial, & & term1=term2, term2=term2, opt=opt) - !! END IF END IF -!! + END PROCEDURE ConvectiveMatrix_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ConvectiveMatrix1_ + +IF (term1 .EQ. DEL_NONE) THEN + IF (term2 .EQ. DEL_X_ALL) THEN + CALL CM9_(ans=ans, test=test, trial=trial, & + & term1=term2, term2=term2, nrow=nrow, ncol=ncol, opt=opt) + ELSE + CALL CM7_(ans=ans, test=test, trial=trial, & + & term1=term2, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + END IF +ELSE + IF (term1 .EQ. del_x_all) THEN + CALL CM10_(ans=ans, test=test, trial=trial, & + & term1=term2, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + ELSE + CALL CM8_(ans=ans, test=test, trial=trial, & + & term1=term2, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + END IF +END IF + +END PROCEDURE ConvectiveMatrix1_ + !---------------------------------------------------------------------------- ! ConvectiveMatrix !---------------------------------------------------------------------------- MODULE PROCEDURE ConvectiveMatrix_2 - !! - !! scalar - !! - IF( term1 .EQ. del_none ) THEN - IF( term2 .EQ. del_x_all ) THEN - CALL CM_5(ans=ans, test=test, trial=trial, c=c, & - & term1=term1, term2=term2, opt=opt) - ELSE - CALL CM_3(ans=ans, test=test, trial=trial, c=c, & - & term1=term2, term2=term2, opt=opt) - END IF + +IF (term1 .EQ. del_none) THEN + IF (term2 .EQ. del_x_all) THEN + CALL CM_5(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt) ELSE - IF( term1 .EQ. del_x_all ) THEN - CALL CM_6(ans=ans, test=test, trial=trial, c=c, & - & term1=term1, term2=term2, opt=opt) - ELSE - CALL CM_4(ans=ans, test=test, trial=trial, c=c, & - & term1=term2, term2=term2, opt=opt) - END IF + CALL CM_3(ans=ans, test=test, trial=trial, c=c, & + & term1=term2, term2=term2, opt=opt) END IF +ELSE + IF (term1 .EQ. del_x_all) THEN + CALL CM_6(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt) + ELSE + CALL CM_4(ans=ans, test=test, trial=trial, c=c, & + & term1=term2, term2=term2, opt=opt) + END IF +END IF !! END PROCEDURE ConvectiveMatrix_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE ConvectiveMatrix2_ + +IF (term1 .EQ. del_none) THEN + IF (term2 .EQ. del_x_all) THEN + CALL CM5_(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + ELSE + CALL CM3_(ans=ans, test=test, trial=trial, c=c, & + & term1=term2, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + END IF +ELSE + IF (term1 .EQ. del_x_all) THEN + CALL CM6_(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + ELSE + CALL CM4_(ans=ans, test=test, trial=trial, c=c, & + & term1=term2, term2=term2, opt=opt, nrow=nrow, ncol=ncol) + END IF +END IF + +END PROCEDURE ConvectiveMatrix2_ + !---------------------------------------------------------------------------- ! ConvectiveMatrix !---------------------------------------------------------------------------- MODULE PROCEDURE ConvectiveMatrix_3 !! - IF( term1 .EQ. del_none ) THEN - CALL CM_1(ans=ans, test=test, trial=trial, c=c, & - & term1=term1, term2=term2, opt=opt) - ELSE - CALL CM_2(ans=ans, test=test, trial=trial, c=c, & - & term1=term1, term2=term2, opt=opt) - END IF +IF (term1 .EQ. del_none) THEN + CALL CM_1(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt) +ELSE + CALL CM_2(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt) +END IF !! END PROCEDURE ConvectiveMatrix_3 @@ -134,4 +163,442 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE ConvectiveMatrix3_ +IF (term1 .EQ. del_none) THEN + CALL CM1_(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt, nrow=nrow, ncol=ncol) +ELSE + CALL CM2_(ans=ans, test=test, trial=trial, c=c, & + & term1=term1, term2=term2, opt=opt, nrow=nrow, ncol=ncol) +END IF +END PROCEDURE ConvectiveMatrix3_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM1_(ans, test, trial, c, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: p(trial%nns, trial%nips) + REAL(DFP), PARAMETER :: one = 1.0_DFP + REAL(DFP) :: realVal + + nrow = test%nns + ncol = trial%nns + ans(1:nrow, 1:ncol) = 0.0_DFP + + CALL GetProjectionOfdNdXt_(obj=trial, cdNdXt=p, val=c, nrow=ii, ncol=jj) + !! + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=p(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval, anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF + +END SUBROUTINE CM1_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM2_(ans, test, trial, c, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: p(test%nns, test%nips) + REAL(DFP) :: realval + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = test%nns + ncol = trial%nns + ans(1:nrow, 1:ncol) = 0.0_DFP + + CALL GetProjectionOfdNdXt_(obj=test, cdNdXt=p, val=c, nrow=ii, ncol=jj) + + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + CALL OuterProd_(a=p(1:nrow, ips), & + b=trial%N(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval, anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF +END SUBROUTINE CM2_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM3_(ans, test, trial, term1, term2, c, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: realval(trial%nips) + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = test%nns + ncol = trial%nns + ans(1:nrow, 1:ncol) = 0.0_DFP + + CALL GetInterpolation_(obj=trial, val=c, interpol=realval, tsize=ii) + realval(1:ii) = trial%js * trial%ws * trial%thickness * realval(1:ii) + + DO ips = 1, trial%nips + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, term2, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval(ips), anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF +END SUBROUTINE CM3_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM4_(ans, test, trial, term1, term2, c, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: realval(trial%nips) + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = SIZE(test%N, 1) + ncol = SIZE(trial%N, 1) + ans(1:nrow, 1:ncol) = 0.0_DFP + + CALL GetInterpolation_(obj=trial, val=c, interpol=realval, tsize=ii) + realval(1:ii) = trial%js * trial%ws * trial%thickness * realval(1:ii) + + DO ips = 1, trial%nips + CALL OuterProd_(a=test%dNdXt(1:nrow, term1, ips), & + b=trial%N(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval(ips), anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF +END SUBROUTINE CM4_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM5_(ans, test, trial, term1, term2, c, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj, kk, nsd + REAL(DFP) :: realval(trial%nips) + REAL(DFP) :: m4_1(test%nns, trial%nns, trial%nsd, 1) + REAL(DFP) :: m4_2(test%nns, trial%nns, 1, trial%nsd) + REAL(DFP), PARAMETER :: one = 1.0_DFP + + CALL GetInterpolation_(obj=trial, val=c, interpol=realval, tsize=ii) + realval(1:trial%nips) = trial%js * trial%ws * trial%thickness * realval(1:trial%nips) + + nrow = test%nns + ncol = trial%nns + nsd = trial%nsd + + IF (opt .EQ. 1) THEN + m4_1 = 0.0_DFP + DO ips = 1, trial%nips + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, 1:nsd, ips), & + dim1=ii, dim2=jj, dim3=kk, & + ans=m4_1(1:nrow, 1:ncol, 1:nsd, 1), & + scale=realval(ips), anscoeff=one) + END DO + CALL Convert_(from=m4_1, to=ans, nrow=nrow, ncol=ncol) + ELSE + m4_2 = 0.0_DFP + DO ips = 1, trial%nips + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, 1:nsd, ips), & + dim1=ii, dim2=jj, dim3=kk, & + ans=m4_1(1:nrow, 1:ncol, 1, 1:nsd), & + scale=realval(ips), anscoeff=one) + END DO + CALL Convert_(from=m4_2, to=ans, nrow=nrow, ncol=ncol) + END IF + +END SUBROUTINE CM5_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM6_(ans, test, trial, term1, term2, c, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + TYPE(FEVariable_), INTENT(IN) :: c + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj, kk + REAL(DFP) :: realval(trial%nips) + REAL(DFP) :: m4_1(test%nns, trial%nns, trial%nsd, 1) + REAL(DFP) :: m4_2(test%nns, trial%nns, 1, trial%nsd) + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = test%nns + ncol = trial%nns + + CALL GetInterpolation_(obj=trial, val=c, interpol=realval, tsize=ii) + realval(1:ii) = trial%js * trial%ws * trial%thickness * realval(1:ii) + + IF (opt .EQ. 1) THEN + m4_1 = 0.0_DFP + DO ips = 1, trial%nips + DO ii = 1, trial%nsd + CALL OuterProd_(a=trial%dNdXt(1:nrow, ii, ips), & + b=test%N(1:ncol, ips), & + nrow=jj, ncol=kk, ans=m4_1(1:nrow, 1:ncol, ii, 1), & + scale=realval(ips), anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_1, to=ans, nrow=nrow, ncol=ncol) + ELSE + m4_2 = 0.0_DFP + DO ips = 1, trial%nips + DO ii = 1, trial%nsd + CALL OuterProd_(a=trial%dNdXt(1:nrow, ii, ips), & + b=test%N(1:ncol, ips), & + nrow=jj, ncol=kk, ans=m4_2(1:nrow, 1:ncol, 1, ii), & + scale=realval(ips), anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_2, to=ans, nrow=nrow, ncol=ncol) + END IF + +END SUBROUTINE CM6_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM7_(ans, test, trial, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: realval + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = test%nns + ncol = trial%nns + ans(1:nrow, 1:ncol) = 0.0_DFP + + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, term2, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval, anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF + +END SUBROUTINE CM7_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM8_(ans, test, trial, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), OPTIONAL, INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj + REAL(DFP) :: realval + REAL(DFP), PARAMETER :: one = 1.0_DFP + + nrow = test%nns + ncol = trial%nns + ans(1:nrow, 1:ncol) = 0.0_DFP + + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + CALL OuterProd_(a=test%dNdXt(1:nrow, term1, ips), & + b=trial%N(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, & + scale=realval, anscoeff=one) + END DO + + IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol + END IF + +END SUBROUTINE CM8_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM9_(ans, test, trial, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj, kk + REAL(DFP), PARAMETER :: one = 1.0_DFP + REAL(DFP) :: realval + REAL(DFP) :: m4_1(test%nns, trial%nns, trial%nsd, 1) + REAL(DFP) :: m4_2(test%nns, trial%nns, 1, trial%nsd) + + nrow = test%nns + ncol = trial%nns + IF (opt .EQ. 1) THEN + m4_1 = 0.0_DFP + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + DO ii = 1, trial%nsd + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, ii, ips), & + nrow=jj, ncol=kk, ans=m4_1(1:nrow, 1:ncol, ii, 1), & + scale=realval, anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_1, to=ans, nrow=nrow, ncol=ncol) + ELSE + m4_2 = 0.0_DFP + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + DO ii = 1, trial%nsd + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%dNdXt(1:ncol, ii, ips), & + nrow=jj, ncol=kk, ans=m4_2(1:nrow, 1:ncol, 1, ii), & + scale=realval, anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_2, to=ans, nrow=nrow, ncol=ncol) + END IF + +END SUBROUTINE CM9_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE CM10_(ans, test, trial, term1, term2, opt, nrow, ncol) + REAL(DFP), INTENT(INOUT) :: ans(:, :) + CLASS(ElemshapeData_), INTENT(IN) :: test + CLASS(ElemshapeData_), INTENT(IN) :: trial + INTEGER(I4B), INTENT(IN) :: term1 + INTEGER(I4B), INTENT(IN) :: term2 + INTEGER(I4B), INTENT(IN) :: opt + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + INTEGER(I4B) :: ips, ii, jj, kk + REAL(DFP), PARAMETER :: one = 1.0_DFP + REAL(DFP) :: realval + REAL(DFP) :: m4_1(test%nns, trial%nns, trial%nsd, 1) + REAL(DFP) :: m4_2(test%nns, trial%nns, 1, trial%nsd) + + nrow = test%nns + ncol = trial%nns + IF (opt .EQ. 1) THEN + m4_1 = 0.0_DFP + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + DO ii = 1, trial%nsd + CALL OuterProd_(a=test%dNdXt(1:nrow, ii, ips), & + b=trial%N(1:ncol, ips), & + nrow=jj, ncol=kk, ans=m4_1(1:nrow, 1:ncol, ii, 1), & + scale=realval, anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_1, to=ans, nrow=nrow, ncol=ncol) + ELSE + m4_2 = 0.0_DFP + DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + DO ii = 1, trial%nsd + CALL OuterProd_(a=test%dNdXt(1:nrow, ii, ips), & + b=trial%N(1:ncol, ips), & + nrow=jj, ncol=kk, ans=m4_2(1:nrow, 1:ncol, 1, ii), & + scale=realval, anscoeff=one) + END DO + END DO + CALL Convert_(from=m4_2, to=ans, nrow=nrow, ncol=ncol) + END IF + +END SUBROUTINE CM10_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END SUBMODULE Methods diff --git a/src/submodules/DiffusionMatrix/src/DiffusionMatrix_Method@Methods.F90 b/src/submodules/DiffusionMatrix/src/DiffusionMatrix_Method@Methods.F90 index 346b4b480..358c371d7 100644 --- a/src/submodules/DiffusionMatrix/src/DiffusionMatrix_Method@Methods.F90 +++ b/src/submodules/DiffusionMatrix/src/DiffusionMatrix_Method@Methods.F90 @@ -88,6 +88,34 @@ DEALLOCATE (kbar, realval) END PROCEDURE DiffusionMatrix_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE DiffusionMatrix2_ +REAL(DFP) :: realval, kbar(trial%nips) +INTEGER(I4B) :: ii + +CALL GetInterpolation_(obj=trial, Interpol=kbar, val=k, tsize=ii) +nrow = test%nns +ncol = trial%nns +ans(1:nrow, 1:ncol) = 0.0 + +DO ii = 1, trial%nips + realval = trial%js(ii) * trial%ws(ii) * trial%thickness(ii) * kbar(ii) + ans(1:nrow, 1:ncol) = ans(1:nrow, 1:ncol) + & + realval * MATMUL(test%dNdXt(:, :, ii), & + TRANSPOSE(trial%dNdXt(:, :, ii))) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE DiffusionMatrix2_ + !---------------------------------------------------------------------------- ! DiffusionMatrix !---------------------------------------------------------------------------- @@ -106,6 +134,35 @@ DEALLOCATE (c1bar, c2bar, realval) END PROCEDURE DiffusionMatrix_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE DiffusionMatrix3_ +REAL(DFP) :: c1bar(test%nns, test%nips), c2bar(trial%nns, trial%nips) +REAL(DFP) :: realval +INTEGER(I4B) :: ii, jj, kk +REAL(DFP), PARAMETER :: one = 1.0_DFP + +CALL getProjectionOfdNdXt_(obj=test, cdNdXt=c1bar, val=k, nrow=nrow, ncol=ii) +CALL getProjectionOfdNdXt_(obj=trial, cdNdXt=c2bar, val=k, nrow=ncol, ncol=ii) + +ans(1:nrow, 1:ncol) = 0.0 + +DO ii = 1, trial%nips + realval = trial%js(ii) * trial%ws(ii) * trial%thickness(ii) + CALL OuterProd_(a=c1bar(1:nrow, ii), b=c2bar(1:ncol, ii), & + nrow=jj, ncol=kk, ans=ans, & + scale=realval, anscoeff=one) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF +END PROCEDURE DiffusionMatrix3_ + !---------------------------------------------------------------------------- ! DiffusionMatrix !---------------------------------------------------------------------------- @@ -127,6 +184,37 @@ DEALLOCATE (kbar, realval) END PROCEDURE DiffusionMatrix_4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE DiffusionMatrix4_ +REAL(DFP) :: kbar(test%nsd, test%nsd, trial%nips) +REAL(DFP) :: realval +REAL(DFP), PARAMETER :: one = 1.0_DFP +INTEGER(I4B) :: ii, jj, kk + +CALL getInterpolation_(obj=trial, Interpol=kbar, val=k, & + dim1=ii, dim2=jj, dim3=kk) +nrow = test%nns +ncol = trial%nns +ans(1:nrow, 1:ncol) = 0.0 + +DO ii = 1, trial%nips + realval = trial%js(ii) * trial%ws(ii) * trial%thickness(ii) + ans(1:nrow, 1:ncol) = ans(1:nrow, 1:ncol) + & + realval * MATMUL(MATMUL(test%dNdXt(:, :, ii), kbar(:, :, ii)), & + TRANSPOSE(trial%dNdXt(:, :, ii))) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE DiffusionMatrix4_ + !---------------------------------------------------------------------------- ! DiffusionMatrix !---------------------------------------------------------------------------- @@ -146,6 +234,36 @@ DEALLOCATE (cbar, realval) END PROCEDURE DiffusionMatrix_5 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE DiffusionMatrix5_ +REAL(DFP) :: realval(trial%nips), cbar(trial%nips) +INTEGER(I4B) :: ii + +CALL getInterpolation_(obj=trial, Interpol=cbar, val=c1, tsize=ii) +CALL getInterpolation_(obj=trial, Interpol=realval, val=c2, tsize=ii) +realval = realval * trial%js * trial%ws * trial%thickness * cbar + +nrow = test%nns +ncol = trial%nns +ans(1:nrow, 1:ncol) = 0.0 + +DO ii = 1, trial%nips + ans(1:nrow, 1:ncol) = ans(1:nrow, 1:ncol) + & + realval(ii) * MATMUL(test%dNdXt(:, :, ii), & + TRANSPOSE(trial%dNdXt(:, :, ii))) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE DiffusionMatrix5_ + !---------------------------------------------------------------------------- ! DiffusionMatrix !---------------------------------------------------------------------------- @@ -165,6 +283,42 @@ DEALLOCATE (c1bar, c2bar, realval) END PROCEDURE DiffusionMatrix_6 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE DiffusionMatrix6_ +REAL(DFP) :: c1bar(test%nns, test%nips), c2bar(trial%nns, trial%nips), & + realval(trial%nips) +INTEGER(I4B) :: ii, jj, kk +REAL(DFP), PARAMETER :: one = 1.0_DFP + +CALL getProjectionOfdNdXt_(obj=test, cdNdXt=c1bar, val=c2, & + nrow=nrow, ncol=ii) +CALL getProjectionOfdNdXt_(obj=trial, cdNdXt=c2bar, val=c2, & + nrow=ncol, ncol=ii) + +CALL getInterpolation_(obj=trial, interpol=realval, val=c1, & + tsize=ii) + +realval = realval * trial%js * trial%ws * trial%thickness + +ans(1:nrow, 1:ncol) = 0.0 + +DO ii = 1, trial%nips + CALL OuterProd_(a=c1bar(1:nrow, ii), b=c2bar(1:ncol, ii), & + nrow=jj, ncol=kk, ans=ans, & + scale=realval(ii), anscoeff=one) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE DiffusionMatrix6_ + !---------------------------------------------------------------------------- ! DiffusionMatrix !---------------------------------------------------------------------------- diff --git a/src/submodules/ElemshapeData/src/ElemshapeData_InterpolMethods@Methods.F90 b/src/submodules/ElemshapeData/src/ElemshapeData_InterpolMethods@Methods.F90 index 3b6cc592c..321a86582 100644 --- a/src/submodules/ElemshapeData/src/ElemshapeData_InterpolMethods@Methods.F90 +++ b/src/submodules/ElemshapeData/src/ElemshapeData_InterpolMethods@Methods.F90 @@ -28,6 +28,15 @@ interpol = MATMUL(val, obj%N) END PROCEDURE scalar_getinterpolation_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE scalar_getinterpolation1_ +tsize = SIZE(obj%N, 2) +interpol(1:tsize) = MATMUL(val, obj%N) +END PROCEDURE scalar_getinterpolation1_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -39,6 +48,18 @@ END SELECT END PROCEDURE scalar_getinterpolation_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE scalar_getinterpolation2_ +SELECT TYPE (obj) +TYPE IS (STElemShapeData_) + tsize = SIZE(obj%N, 2) + interpol = MATMUL(MATMUL(val, obj%T), obj%N) +END SELECT +END PROCEDURE scalar_getinterpolation2_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -51,6 +72,19 @@ END DO END PROCEDURE scalar_getinterpolation_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE scalar_getinterpolation3_ +INTEGER(I4B) :: ipt +nrow = SIZE(obj(1)%N, 2) +ncol = SIZE(obj) +DO ipt = 1, ncol + interpol(1:nrow, ipt) = MATMUL(MATMUL(val, obj(ipt)%T), obj(ipt)%N) +END DO +END PROCEDURE scalar_getinterpolation3_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -78,6 +112,39 @@ END SELECT END PROCEDURE scalar_getinterpolation_4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE scalar_getinterpolation4_ +SELECT CASE (val%vartype) +CASE (Constant) + tsize = SIZE(obj%N, 2) + interpol(1:tsize) = Get(val, TypeFEVariableScalar, TypeFEVariableConstant) +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + CALL GetInterpolation_(obj=obj, interpol=interpol, & + val=Get(val, TypeFEVariableScalar, & + TypeFEVariableSpace), & + tsize=tsize) + ELSE + CALL Get_(obj=val, rank=TypeFEVariableScalar, & + vartype=TypeFEVariableSpace, & + val=interpol, tsize=tsize) + END IF +CASE (SpaceTime) + SELECT TYPE (obj) + TYPE IS (STElemShapeData_) + IF (val%DefineOn .EQ. Nodal) THEN + CALL GetInterpolation_(obj=obj, interpol=interpol, & + val=Get(val, TypeFEVariableScalar, & + TypeFEVariableSpaceTime), & + tsize=tsize) + END IF + END SELECT +END SELECT +END PROCEDURE scalar_getinterpolation4_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -148,6 +215,52 @@ !! END PROCEDURE scalar_getinterpolation_5 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE scalar_getinterpolation5_ +INTEGER(I4B) :: ii +nrow = SIZE(obj(1)%N, 2) +ncol = SIZE(obj) +SELECT CASE (val%vartype) +CASE (Constant) + interpol(1:nrow, 1:ncol) = Get(val, TypeFEVariableScalar, TypeFEVariableConstant) +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, ncol + CALL GetInterpolation_(obj=obj(ii), & + interpol=interpol(1:nrow, ii), & + val=Get(val, TypeFEVariableScalar, & + TypeFEVariableSpace), & + tsize=nrow) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableScalar, & + vartype=TypeFEVariableSpace, & + val=interpol(1:nrow, 1), tsize=nrow) + DO ii = 2, ncol + interpol(1:nrow, ii) = interpol(1:nrow, 1) + END DO + END IF +CASE (SpaceTime) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, ncol + CALL GetInterpolation_(obj=obj(ii), & + interpol=interpol(1:nrow, ii), & + val=Get(val, TypeFEVariableScalar, & + TypeFEVariableSpaceTime), & + tsize=nrow) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableScalar, & + vartype=typeFEVariableSpaceTime, & + val=interpol, nrow=nrow, ncol=ncol) + END IF +END SELECT + +END PROCEDURE scalar_getinterpolation5_ + !--------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -156,6 +269,16 @@ interpol = MATMUL(val, obj%N) END PROCEDURE vector_getinterpolation_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vector_getinterpolation1_ +nrow = SIZE(val, 1) +ncol = SIZE(obj%N, 2) +interpol(1:nrow, 1:ncol) = MATMUL(val, obj%N) +END PROCEDURE vector_getinterpolation1_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -167,6 +290,19 @@ END SELECT END PROCEDURE vector_getinterpolation_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vector_getinterpolation2_ +SELECT TYPE (obj) +TYPE IS (STElemShapeData_) + nrow = SIZE(val, 1) + ncol = SIZE(obj%N, 2) + interpol(1:nrow, 1:ncol) = MATMUL(MATMUL(val, obj%T), obj%N) +END SELECT +END PROCEDURE vector_getinterpolation2_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -180,6 +316,22 @@ END DO END PROCEDURE vector_getinterpolation_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vector_getinterpolation3_ +INTEGER(I4B) :: ipt + +dim1 = SIZE(val, 1) +dim2 = SIZE(obj(1)%N, 2) +dim3 = SIZE(obj) +DO ipt = 1, dim3 + interpol(1:dim1, 1:dim2, ipt) = MATMUL(MATMUL(val, obj(ipt)%T), & + obj(ipt)%N) +END DO +END PROCEDURE vector_getinterpolation3_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -227,6 +379,47 @@ !! END PROCEDURE vector_getinterpolation_4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vector_getinterpolation4_ +INTEGER(I4B) :: ii + +SELECT CASE (val%vartype) +CASE (Constant) + CALL Get_(obj=val, rank=TypeFEVariableVector, & + vartype=TypeFEVariableConstant, & + val=interpol(:, 1), tsize=nrow) + ncol = SIZE(obj%N, 2) + DO ii = 2, ncol + interpol(1:nrow, ii) = interpol(1:nrow, 1) + END DO +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + CALL GetInterpolation_(obj=obj, & + val=Get(val, TypeFEVariableVector, & + TypeFEVariableSpace), & + interpol=interpol, & + nrow=nrow, ncol=ncol) + ELSE + CALL Get_(obj=val, rank=TypeFEVariableVector, & + vartype=TypeFEVariableSpace, & + val=interpol, nrow=nrow, ncol=ncol) + END IF +CASE (SpaceTime) + SELECT TYPE (obj) + TYPE IS (STElemShapeData_) + CALL GetInterpolation_(obj=obj, & + val=Get(val, TypeFEVariableVector, & + TypeFEVariableSpaceTime), & + interpol=interpol, & + nrow=nrow, ncol=ncol) + END SELECT +END SELECT + +END PROCEDURE vector_getinterpolation4_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -311,6 +504,62 @@ !! END PROCEDURE vector_getinterpolation_5 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE vector_getinterpolation5_ +INTEGER(I4B) :: ii, jj + +dim1 = SIZE(val, 1) +dim2 = SIZE(obj(1)%N, 2) +dim3 = SIZE(obj) +SELECT CASE (val%vartype) +CASE (Constant) + CALL Get_(obj=val, rank=TypeFEVariableVector, & + vartype=TypeFEVariableConstant, & + val=interpol(:, 1, 1), tsize=dim1) + DO jj = 1, dim3 + DO ii = 1, dim2 + IF (jj .EQ. 1 .AND. ii .EQ. 1) CYCLE + interpol(1:dim1, ii, jj) = interpol(1:dim1, 1, 1) + END DO + END DO +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, dim3 + CALL GetInterpolation_(obj=obj(ii), & + val=Get(val, TypeFEVariableVector, & + TypeFEVariableSpace), & + interpol=interpol(1:dim1, 1:dim2, ii), & + nrow=dim1, ncol=dim2) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableVector, & + vartype=TypeFEVariableSpace, & + val=interpol(:, :, 1), nrow=dim1, ncol=dim2) + DO ii = 2, SIZE(obj) + interpol(1:dim1, 1:dim2, ii) = interpol(1:dim1, 1:dim2, 1) + END DO + END IF +CASE (SpaceTime) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, SIZE(obj) + CALL GetInterpolation_(obj=obj(ii), & + val=Get(val, TypeFEVariableVector, & + TypeFEVariableSpaceTime), & + interpol=interpol(1:dim1, 1:dim2, ii), & + nrow=dim1, ncol=dim2) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableVector, & + vartype=TypeFEVariableSpaceTime, & + val=interpol, dim1=dim1, dim2=dim2, dim3=dim3) + END IF +END SELECT + +END PROCEDURE vector_getinterpolation5_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -319,6 +568,17 @@ interpol = MATMUL(val, obj%N) END PROCEDURE matrix_getinterpolation_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE matrix_getinterpolation1_ +dim1 = SIZE(val, 1) +dim2 = SIZE(val, 2) +dim3 = SIZE(obj%N, 2) +interpol(1:dim1, 1:dim2, 1:dim3) = MATMUL(val, obj%N) +END PROCEDURE matrix_getinterpolation1_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -330,6 +590,20 @@ END SELECT END PROCEDURE matrix_getinterpolation_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE matrix_getinterpolation2_ +SELECT TYPE (obj) +TYPE IS (STElemShapeData_) + dim1 = SIZE(val, 1) + dim2 = SIZE(val, 2) + dim3 = SIZE(obj%N, 2) + interpol(1:dim1, 1:dim2, 1:dim3) = MATMUL(MATMUL(val, obj%T), obj%N) +END SELECT +END PROCEDURE matrix_getinterpolation2_ + !---------------------------------------------------------------------------- ! getSTinterpolation !---------------------------------------------------------------------------- @@ -373,6 +647,48 @@ END SELECT END PROCEDURE matrix_getinterpolation_4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE matrix_getinterpolation4_ +INTEGER(I4B) :: ii + +SELECT CASE (val%vartype) +CASE (Constant) + dim3 = SIZE(obj%N, 2) + CALL Get_(obj=val, rank=TypeFEVariableMatrix, & + vartype=TypeFEVariableConstant, & + val=interpol(:, :, 1), nrow=dim1, ncol=dim2) + DO ii = 2, dim3 + interpol(1:dim1, 1:dim2, ii) = interpol(1:dim1, 1:dim2, 1) + END DO +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + CALL GetInterpolation_(obj=obj, & + val=Get(val, TypeFEVariableMatrix, & + TypeFEVariableSpace), & + interpol=interpol, & + dim1=dim1, dim2=dim2, dim3=dim3) + ELSE + CALL Get_(obj=val, rank=TypeFEVariableMatrix, & + vartype=TypeFEVariableSpace, val=interpol, & + dim1=dim1, dim2=dim2, dim3=dim3) + END IF +CASE (SpaceTime) + SELECT TYPE (obj) + TYPE IS (STElemShapeData_) + IF (val%DefineOn .EQ. Nodal) THEN + CALL GetInterpolation_(obj=obj, & + val=Get(val, TypeFEVariableMatrix, & + TypeFEVariableSpaceTime), & + interpol=interpol, & + dim1=dim1, dim2=dim2, dim3=dim3) + END IF + END SELECT +END SELECT +END PROCEDURE matrix_getinterpolation4_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- @@ -461,6 +777,63 @@ !! END PROCEDURE matrix_getinterpolation_5 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE matrix_getinterpolation5_ +INTEGER(I4B) :: ii, jj +dim1 = SIZE(val, 1) +dim2 = SIZE(val, 2) +dim3 = SIZE(obj(1)%N, 2) +dim4 = SIZE(obj) + +SELECT CASE (val%vartype) +CASE (Constant) + CALL Get_(obj=val, rank=TypeFEVariableMatrix, & + vartype=TypeFEVariableConstant, val=interpol(:, :, 1, 1), & + nrow=dim1, ncol=dim2) + DO jj = 1, dim3 + DO ii = 1, dim4 + IF (jj .EQ. 1 .AND. ii .EQ. 1) CYCLE + interpol(1:dim1, 1:dim2, ii, jj) = interpol(1:dim1, 1:dim2, 1, 1) + END DO + END DO +CASE (Space) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, dim4 + CALL GetInterpolation_(obj=obj(ii), & + val=Get(val, TypeFEVariableMatrix, & + TypeFEVariableSpace), & + interpol=interpol(:, :, :, ii), & + dim1=dim1, dim2=dim2, dim3=dim3) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableMatrix, & + vartype=TypeFEVariableSpace, val=interpol(:, :, :, 1), & + dim1=dim1, dim2=dim2, dim3=dim3) + DO ii = 2, dim4 + interpol(1:dim1, 1:dim2, 1:dim3, ii) = & + interpol(1:dim1, 1:dim2, 1:dim3, 1) + END DO + END IF +CASE (SpaceTime) + IF (val%DefineOn .EQ. Nodal) THEN + DO ii = 1, dim4 + CALL GetInterpolation_(obj=obj(ii), & + val=Get(val, TypeFEVariableMatrix, & + TypeFEVariableSpaceTime), & + interpol=interpol(:, :, :, ii), & + dim1=dim1, dim2=dim2, dim3=dim3) + END DO + ELSE + CALL Get_(obj=val, rank=TypeFEVariableMatrix, & + vartype=TypeFEVariableSpaceTime, val=interpol, & + dim1=dim1, dim2=dim2, dim3=dim3, dim4=dim4) + END IF +END SELECT +END PROCEDURE matrix_getinterpolation5_ + !---------------------------------------------------------------------------- ! getinterpolation !---------------------------------------------------------------------------- diff --git a/src/submodules/ElemshapeData/src/ElemshapeData_ProjectionMethods@Methods.F90 b/src/submodules/ElemshapeData/src/ElemshapeData_ProjectionMethods@Methods.F90 index 2998cf756..c4819ecda 100644 --- a/src/submodules/ElemshapeData/src/ElemshapeData_ProjectionMethods@Methods.F90 +++ b/src/submodules/ElemshapeData/src/ElemshapeData_ProjectionMethods@Methods.F90 @@ -38,6 +38,23 @@ !! END PROCEDURE getProjectionOfdNdXt_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE getProjectionOfdNdXt1_ +INTEGER(I4B) :: ii, nsd + +nrow = SIZE(obj%dNdXt, 1) +ncol = SIZE(obj%dNdXt, 3) +nsd = SIZE(obj%dNdXt, 2) + +DO ii = 1, ncol + cdNdXt(1:nrow, ii) = MATMUL(obj%dNdXt(1:nrow, 1:nsd, ii), Val(1:nsd)) +END DO + +END PROCEDURE getProjectionOfdNdXt1_ + !---------------------------------------------------------------------------- ! getProjectionOfdNdXt !---------------------------------------------------------------------------- @@ -59,6 +76,24 @@ !! END PROCEDURE getProjectionOfdNdXt_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE getProjectionOfdNdXt2_ +INTEGER(I4B) :: ii, nsd +REAL(DFP) :: cbar(SIZE(obj%dNdXt, 2), SIZE(obj%dNdXt, 3)) + +CALL GetInterpolation_(obj=obj, val=val, interpol=cbar, nrow=nrow, ncol=ncol) +nsd = nrow +nrow = SIZE(obj%dNdXt, 1) + +DO ii = 1, ncol + cdNdXt(1:nrow, ii) = MATMUL(obj%dNdXt(1:nrow, 1:nsd, ii), cbar(1:nsd, ii)) +END DO + +END PROCEDURE getProjectionOfdNdXt2_ + !---------------------------------------------------------------------------- ! getProjectionOfdNdXt !---------------------------------------------------------------------------- @@ -77,6 +112,23 @@ !! END PROCEDURE getProjectionOfdNdXt_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE getProjectionOfdNdXt3_ +INTEGER(I4B) :: ii, nsd + +nrow = SIZE(obj%dNdXt, 1) +ncol = SIZE(obj%dNdXt, 3) +nsd = SIZE(obj%dNdXt, 2) + +DO ii = 1, ncol + cdNdXt(1:nrow, ii) = MATMUL(obj%dNdXt(1:nrow, 1:nsd, ii), val(1:nsd, ii)) +END DO + +END PROCEDURE getProjectionOfdNdXt3_ + !---------------------------------------------------------------------------- ! getProjectionOfdNTdXt !---------------------------------------------------------------------------- diff --git a/src/submodules/FEVariable/src/FEVariable_Method@GetMethods.F90 b/src/submodules/FEVariable/src/FEVariable_Method@GetMethods.F90 index 573b6700b..dc39463e2 100644 --- a/src/submodules/FEVariable/src/FEVariable_Method@GetMethods.F90 +++ b/src/submodules/FEVariable/src/FEVariable_Method@GetMethods.F90 @@ -137,6 +137,69 @@ val = obj%val(1) END PROCEDURE Scalar_Constant +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE Master_Get_vec_(obj, val, tsize) + CLASS(FEVariable_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: val(:) + INTEGER(I4B), INTENT(OUT) :: tsize + + tsize = obj%len + val(1:tsize) = obj%val(1:tsize) + +END SUBROUTINE Master_Get_vec_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE Master_Get_mat_(obj, val, nrow, ncol) + CLASS(FEVariable_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: val(:, :) + INTEGER(I4B), INTENT(OUT) :: nrow, ncol + + INTEGER(I4B) :: ii, jj, cnt + + nrow = obj%s(1) + ncol = obj%s(2) + + cnt = 0 + DO jj = 1, ncol + DO ii = 1, nrow + cnt = cnt + 1 + val(ii, jj) = obj%val(cnt) + END DO + END DO +END SUBROUTINE Master_Get_mat_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +PURE SUBROUTINE Master_get_mat3_(obj, val, dim1, dim2, dim3) + CLASS(FEVariable_), INTENT(IN) :: obj + REAL(DFP), INTENT(INOUT) :: val(:, :, :) + INTEGER(I4B), INTENT(OUT) :: dim1, dim2, dim3 + INTEGER(I4B) :: ii, jj, kk, cnt + + dim1 = obj%s(1) + dim2 = obj%s(2) + dim3 = obj%s(3) + + cnt = 0 + DO kk = 1, dim3 + DO jj = 1, dim2 + DO ii = 1, dim1 + cnt = cnt + 1 + val(ii, jj, kk) = obj%val(cnt) + END DO + END DO + END DO + +END SUBROUTINE Master_get_mat3_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -146,6 +209,14 @@ val = obj%val(1:obj%len) END PROCEDURE Scalar_Space +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Scalar_Space_ +CALL Master_Get_vec_(obj, val, tsize) +END PROCEDURE Scalar_Space_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -155,6 +226,14 @@ val = obj%val(1:obj%len) END PROCEDURE Scalar_Time +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Scalar_Time_ +CALL Master_Get_vec_(obj, val, tsize) +END PROCEDURE Scalar_Time_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -175,6 +254,14 @@ END PROCEDURE Scalar_SpaceTime +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Scalar_SpaceTime_ +CALL Master_Get_mat_(obj, val, nrow, ncol) +END PROCEDURE Scalar_SpaceTime_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -184,6 +271,14 @@ val = obj%val(1:obj%len) END PROCEDURE Vector_Constant +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Vector_Constant_ +CALL Master_Get_vec_(obj, val, tsize) +END PROCEDURE Vector_Constant_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -203,6 +298,14 @@ END PROCEDURE Vector_Space +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Vector_Space_ +CALL Master_Get_mat_(obj, val, nrow, ncol) +END PROCEDURE Vector_Space_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -221,6 +324,14 @@ END DO END PROCEDURE Vector_Time +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Vector_Time_ +CALL Master_Get_mat_(obj, val, nrow, ncol) +END PROCEDURE Vector_Time_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -241,6 +352,14 @@ END DO END PROCEDURE Vector_SpaceTime +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Vector_SpaceTime_ +CALL Master_Get_mat3_(obj, val, dim1, dim2, dim3) +END PROCEDURE Vector_SpaceTime_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -259,6 +378,14 @@ END DO END PROCEDURE Matrix_Constant +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Matrix_Constant_ +CALL Master_Get_mat_(obj, val, nrow, ncol) +END PROCEDURE Matrix_Constant_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -279,6 +406,14 @@ END DO END PROCEDURE Matrix_Space +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Matrix_Space_ +CALL Master_Get_mat3_(obj, val, dim1, dim2, dim3) +END PROCEDURE Matrix_Space_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -299,6 +434,14 @@ END DO END PROCEDURE Matrix_Time +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Matrix_Time_ +CALL Master_Get_mat3_(obj, val, dim1, dim2, dim3) +END PROCEDURE Matrix_Time_ + !---------------------------------------------------------------------------- ! getNodalvalues !---------------------------------------------------------------------------- @@ -325,4 +468,30 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE Matrix_SpaceTime_ +INTEGER(I4B) :: ii, jj, kk, ll, cnt + +dim1 = obj%s(1) +dim2 = obj%s(2) +dim3 = obj%s(3) +dim4 = obj%s(4) + +cnt = 0 +DO ll = 1, dim4 + DO kk = 1, dim3 + DO jj = 1, dim2 + DO ii = 1, dim1 + cnt = cnt + 1 + val(ii, jj, kk, ll) = obj%val(cnt) + END DO + END DO + END DO +END DO + +END PROCEDURE Matrix_SpaceTime_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END SUBMODULE GetMethods diff --git a/src/submodules/MassMatrix/src/MassMatrix_Method@Methods.F90 b/src/submodules/MassMatrix/src/MassMatrix_Method@Methods.F90 index 2a8aaef11..009ca1ada 100644 --- a/src/submodules/MassMatrix/src/MassMatrix_Method@Methods.F90 +++ b/src/submodules/MassMatrix/src/MassMatrix_Method@Methods.F90 @@ -196,6 +196,36 @@ END SUBROUTINE MM_2d DEALLOCATE (realval) END PROCEDURE MassMatrix_1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE Massmatrix1_ +REAL(DFP), PARAMETER :: one = 1.0_DFP +REAL(DFP) :: realval +INTEGER(I4B) :: ii, jj, ips + +nrow = test%nns +ncol = trial%nns +ans(1:nrow, 1:ncol) = 0.0 + +DO ips = 1, trial%nips + realval = trial%js(ips) * trial%ws(ips) * trial%thickness(ips) + + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%N(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, scale=realval, anscoeff=one) + +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE Massmatrix1_ + !---------------------------------------------------------------------------- ! MassMatrix !---------------------------------------------------------------------------- @@ -218,6 +248,37 @@ END SUBROUTINE MM_2d DEALLOCATE (realval) END PROCEDURE MassMatrix_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MassMatrix2_ +REAL(DFP) :: realval(trial%nips) +REAL(DFP), PARAMETER :: one = 1.0_DFP +INTEGER(I4B) :: ips, ii, jj + +nrow = test%nns +ncol = trial%nns +realval = 0.0_DFP +CALL GetInterpolation_(obj=trial, interpol=realval, & + val=rho, tsize=ii) +realval = trial%js * trial%ws * trial%thickness * realval + +DO ips = 1, SIZE(realval) + CALL OuterProd_(a=test%N(1:nrow, ips), & + b=trial%N(1:ncol, ips), & + nrow=ii, ncol=jj, ans=ans, scale=realval(ips), & + anscoeff=one) +END DO + +IF (PRESENT(opt)) THEN + CALL MakeDiagonalCopies_(mat=ans, ncopy=opt, nrow=nrow, ncol=ncol) + nrow = opt * nrow + ncol = opt * ncol +END IF + +END PROCEDURE MassMatrix2_ + !---------------------------------------------------------------------------- ! MassMatrix !---------------------------------------------------------------------------- @@ -235,6 +296,14 @@ END SUBROUTINE MM_2d END SELECT END PROCEDURE MassMatrix_3 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE massmatrix3_ +! TODO: implement +END PROCEDURE massmatrix3_ + !---------------------------------------------------------------------------- ! MassMatrix !---------------------------------------------------------------------------- @@ -267,6 +336,14 @@ END SUBROUTINE MM_2d DEALLOCATE (realval, m2, kbar, m4) END PROCEDURE MassMatrix_4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE MassMatrix4_ +! TODO: implement +END PROCEDURE MassMatrix4_ + !---------------------------------------------------------------------------- ! MassMatrix !---------------------------------------------------------------------------- diff --git a/src/submodules/Polynomial/src/QuadrangleInterpolationUtility@Methods.F90 b/src/submodules/Polynomial/src/QuadrangleInterpolationUtility@Methods.F90 index 4400aa610..32243f79b 100644 --- a/src/submodules/Polynomial/src/QuadrangleInterpolationUtility@Methods.F90 +++ b/src/submodules/Polynomial/src/QuadrangleInterpolationUtility@Methods.F90 @@ -89,7 +89,7 @@ nrow = LagrangeDOF_Quadrangle(p=p, q=q) ncol = 2 -p1 = p1 + 1 +p1 = p + 1 DO CONCURRENT(jj=0:q, ii=0:p) ans(p1 * jj + ii + 1, 1) = ii diff --git a/src/submodules/StiffnessMatrix/src/StiffnessMatrix_Method@Methods.F90 b/src/submodules/StiffnessMatrix/src/StiffnessMatrix_Method@Methods.F90 index 11e983a30..65c2c2283 100644 --- a/src/submodules/StiffnessMatrix/src/StiffnessMatrix_Method@Methods.F90 +++ b/src/submodules/StiffnessMatrix/src/StiffnessMatrix_Method@Methods.F90 @@ -83,6 +83,68 @@ END PROCEDURE obj_StiffnessMatrix1 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_StiffnessMatrix1_ +REAL(DFP) :: Cbar(test%nsd * (test%nsd + 1) / 2, & + trial%nsd * (trial%nsd + 1) / 2, & + trial%nips), & + Ce(test%nsd * test%nsd, trial%nsd * trial%nsd), & + BMat1(test%nsd * test%nns, trial%nsd * trial%nsd), & + BMat2(trial%nsd * trial%nns, trial%nsd * trial%nsd) +INTEGER(I4B) :: nips, nns1, nns2, ips, nsd, ii, jj, kk +INTEGER(I4B) :: indx(3, 3) +REAL(DFP) :: realval + +nns1 = test%nns +nns2 = trial%nns +nips = trial%nips +nsd = trial%nsd +nrow = nns1 * nsd +ncol = nns2 * nsd +ans(1:nrow, 1:ncol) = 0.0 + +CALL GetInterpolation_(obj=test, interpol=CBar, val=Cijkl, & + dim1=ii, dim2=jj, dim3=kk) + +SELECT CASE (nsd) +CASE (1) + indx(1, 1) = 1 +CASE (2) + indx(1:2, 1:2) = RESHAPE([1, 3, 3, 2], [2, 2]) +CASE (3) + indx(1:3, 1:3) = RESHAPE([1, 4, 6, 4, 2, 5, 6, 5, 3], [3, 3]) +END SELECT + +BMat1 = 0.0_DFP +BMat2 = 0.0_DFP + +DO ips = 1, nips + realval = trial%ws(ips) * trial%js(ips) * trial%thickness(ips) + + DO jj = 1, nsd + DO ii = 1, nsd + Ce((ii - 1) * nsd + 1:ii * nsd, (jj - 1) * nsd + 1:jj * nsd) & + & = CBar(indx(1:nsd, ii), indx(1:nsd, jj), ips) + END DO + END DO + + DO ii = 1, nsd + BMat1((ii - 1) * nns1 + 1:ii * nns1, (ii - 1) * nsd + 1:ii * nsd) = & + & test%dNdXt(1:nns1, 1:nsd, ips) + BMat2((ii - 1) * nns2 + 1:ii * nns2, (ii - 1) * nsd + 1:ii * nsd) = & + & trial%dNdXt(1:nns2, 1:nsd, ips) + END DO + + ans(1:nrow, 1:ncol) = ans(1:nrow, 1:ncol) + & + realval * MATMUL(MATMUL(BMat1, Ce), TRANSPOSE(BMat2)) + +END DO + +END PROCEDURE obj_StiffnessMatrix1_ + !---------------------------------------------------------------------------- ! StiffnessMatrix !---------------------------------------------------------------------------- @@ -163,6 +225,83 @@ END PROCEDURE obj_StiffnessMatrix2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_StiffnessMatrix2_ +REAL(DFP) :: lambdaBar(trial%nips), muBar(trial%nips), & + Ke11(test%nns, trial%nns) +REAL(DFP) :: realval +REAL(DFP) :: real1, real2, real3 +INTEGER(I4B) :: nns1, nns2, nips, nsd, c1, c2, ii, jj, & + r1, r2, ips, kk, ll +LOGICAL(LGT) :: abool +TYPE(FEVariable_) :: lambda0 +REAL(DFP), PARAMETER :: one = 1.0_DFP, zero = 0.0_DFP + +abool = Input(default=.FALSE., option=isLambdaYoungsModulus) +IF (abool) THEN + CALL GetLambdaFromYoungsModulus(lambda=lambda0, & + & youngsModulus=lambda, shearModulus=mu) +ELSE + lambda0 = lambda +END IF + +nns1 = test%nns +nns2 = trial%nns +nips = trial%nips +nsd = trial%nsd +nrow = nns1 * nsd +ncol = nns2 * nsd +ans(1:nrow, 1:ncol) = zero + +CALL GetInterpolation_(obj=test, interpol=lambdaBar, val=lambda0, tsize=ii) +CALL GetInterpolation_(obj=test, interpol=muBar, val=mu, tsize=ii) + +DO ips = 1, nips + + realval = trial%ws(ips) * trial%js(ips) * trial%thickness(ips) + real1 = muBar(ips) * realval + real2 = (lambdaBar(ips) + muBar(ips)) * realval + real3 = lambdaBar(ips) * realval + c1 = 0 + c2 = 0 + + DO jj = 1, nsd + c1 = c2 + 1 + c2 = jj * nns2 + r1 = 0 + r2 = 0 + DO ii = 1, nsd + r1 = r2 + 1 + r2 = ii * nns1 + IF (ii .EQ. jj) THEN + Ke11(1:nns1, 1:nns2) = real1 * MATMUL(test%dNdXt(:, :, ips), & + & TRANSPOSE(trial%dNdXt(:, :, ips))) + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real2, anscoeff=one) + ELSE + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, jj, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real3, anscoeff=zero) + CALL OuterProd_(a=test%dNdXt(1:nns1, jj, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real1, anscoeff=one) + END IF + ans(r1:r2, c1:c2) = ans(r1:r2, c1:c2) + Ke11 + END DO + END DO +END DO + +CALL DEALLOCATE (lambda0) + +END PROCEDURE obj_StiffnessMatrix2_ + !---------------------------------------------------------------------------- ! Stiffnessmatrix !---------------------------------------------------------------------------- @@ -213,6 +352,59 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE obj_StiffnessMatrix3_ +INTEGER(I4B) :: nns1, nns2, nips, ips, nsd, c1, c2, & + r1, r2, ii, jj, kk, ll +REAL(DFP) :: realval, Ke11(test%nns, trial%nns) +REAL(DFP) :: real1, real2, real3 +REAL(DFP), PARAMETER :: one = 1.0_DFP, zero = 0.0_DFP + +nns1 = test%nns +nns2 = trial%nns +nips = trial%nips +nsd = trial%nsd +nrow = nns1 * nsd +ncol = nns2 * nsd +ans(1:nrow, 1:ncol) = zero + +DO ips = 1, nips + realval = trial%ws(ips) * trial%thickness(ips) * trial%js(ips) + real1 = mu * realval + real2 = (lambda + mu) * realval + real3 = lambda * realval + c1 = 0; c2 = 0; + DO jj = 1, nsd + c1 = c2 + 1; c2 = jj * nns2; r1 = 0; r2 = 0 + DO ii = 1, nsd + r1 = r2 + 1; r2 = ii * nns1 + IF (ii .EQ. jj) THEN + Ke11 = real1 * MATMUL(test%dNdXt(:, :, ips), & + TRANSPOSE(trial%dNdXt(:, :, ips))) + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real2, anscoeff=one) + ELSE + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, jj, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real3, anscoeff=zero) + CALL OuterProd_(a=test%dNdXt(1:nns1, jj, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real1, anscoeff=one) + END IF + ans(r1:r2, c1:c2) = ans(r1:r2, c1:c2) + Ke11(1:nns1, 1:nns2) + END DO + END DO +END DO + +END PROCEDURE obj_StiffnessMatrix3_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + MODULE PROCEDURE obj_StiffnessMatrix4 REAL(DFP), ALLOCATABLE :: realval(:), Ce(:, :), BMat1(:, :), BMat2(:, :) INTEGER(I4B) :: nips, nns1, nns2, i, j, ips, nsd @@ -271,6 +463,62 @@ END PROCEDURE obj_StiffnessMatrix4 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE obj_StiffnessMatrix4_ +REAL(DFP) :: realval +REAL(DFP) :: Ce(test%nsd * test%nsd, trial%nsd * trial%nsd), & + BMat1(test%nsd * test%nns, test%nsd * test%nsd), & + BMat2(trial%nsd * trial%nns, trial%nsd * trial%nsd) +INTEGER(I4B) :: nips, nns1, nns2, ii, jj, ips, nsd +INTEGER(I4B), ALLOCATABLE :: indx(:, :) + +nns1 = SIZE(test%N, 1) +nns2 = SIZE(trial%N, 1) +nips = SIZE(trial%N, 2) +nsd = SIZE(trial%dNdXt, 2) + +nrow = nns1 * nsd +ncol = nns2 * nsd + +SELECT CASE (nsd) +CASE (1) + indx(1, 1) = 1 +CASE (2) + indx(1:2, 1:2) = RESHAPE([1, 3, 3, 2], [2, 2]) +CASE (3) + indx(1:3, 1:3) = RESHAPE([1, 4, 6, 4, 2, 5, 6, 5, 3], [3, 3]) +END SELECT + +BMat1 = 0.0_DFP +BMat2 = 0.0_DFP + +DO ips = 1, nips + + realval = trial%ws(ips) * trial%js(ips) * trial%thickness(ips) + DO jj = 1, nsd + DO ii = 1, nsd + Ce((ii - 1) * nsd + 1:ii * nsd, (jj - 1) * nsd + 1:jj * nsd) & + & = Cijkl(indx(1:nsd, ii), indx(1:nsd, jj)) + END DO + END DO + + DO ii = 1, nsd + BMat1((ii - 1) * nns1 + 1:ii * nns1, (ii - 1) * nsd + 1:ii * nsd) = & + & test%dNdXt(:, :, ips) + BMat2((ii - 1) * nns2 + 1:ii * nns2, (ii - 1) * nsd + 1:ii * nsd) = & + & trial%dNdXt(:, :, ips) + END DO + + ans(1:nrow, 1:ncol) = ans(1:nrow, 1:ncol) + & + realval * MATMUL(MATMUL(BMat1, Ce), TRANSPOSE(BMat2)) + +END DO + +END PROCEDURE obj_StiffnessMatrix4_ + !---------------------------------------------------------------------------- ! StiffnessMatrix !---------------------------------------------------------------------------- @@ -335,4 +583,63 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE obj_StiffnessMatrix5_ +REAL(DFP) :: realval, Ke11(test%nns, trial%nns) +REAL(DFP) :: real1, real2, real3 +INTEGER(I4B) :: nns1, nns2, nips, nsd, c1, c2, ii, jj, & + r1, r2, ips, kk, ll +REAL(DFP), PARAMETER :: one = 1.0_DFP, zero = 0.0_DFP + +nns1 = SIZE(test%N, 1) +nns2 = SIZE(trial%N, 1) +nips = SIZE(trial%N, 2) +nsd = SIZE(trial%dNdXt, 2) +nrow = nns1 * nsd +ncol = nns2 * nsd +ans(1:nrow, 1:ncol) = zero + +DO ips = 1, nips + realval = trial%ws(ips) * trial%js(ips) * trial%thickness(ips) + real1 = mu(ips) * realval + real2 = (lambda(ips) + mu(ips)) * realval + real3 = lambda(ips) * realval + c1 = 0 + c2 = 0 + DO jj = 1, nsd + c1 = c2 + 1 + c2 = jj * nns2 + r1 = 0 + r2 = 0 + DO ii = 1, nsd + r1 = r2 + 1 + r2 = ii * nns1 + IF (ii .EQ. jj) THEN + Ke11 = real1 * MATMUL( & + test%dNdXt(:, :, ips), & + TRANSPOSE(trial%dNdXt(:, :, ips))) + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real2, anscoeff=one) + ELSE + CALL OuterProd_(a=test%dNdXt(1:nns1, ii, ips), & + b=trial%dNdXt(1:nns2, jj, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real3, anscoeff=zero) + CALL OuterProd_(a=test%dNdXt(1:nns1, jj, ips), & + b=trial%dNdXt(1:nns2, ii, ips), & + nrow=kk, ncol=ll, ans=Ke11, & + scale=real1, anscoeff=one) + END IF + ans(r1:r2, c1:c2) = ans(r1:r2, c1:c2) + Ke11(1:nns1, 1:nns2) + END DO + END DO +END DO + +END PROCEDURE obj_StiffnessMatrix5_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END SUBMODULE Methods diff --git a/src/submodules/Utility/src/ConvertUtility@Methods.F90 b/src/submodules/Utility/src/ConvertUtility@Methods.F90 index 658b358e7..20e817b35 100644 --- a/src/submodules/Utility/src/ConvertUtility@Methods.F90 +++ b/src/submodules/Utility/src/ConvertUtility@Methods.F90 @@ -96,6 +96,35 @@ END DO END PROCEDURE convert_2 +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + +MODULE PROCEDURE convert2_ +INTEGER(I4B) :: a, b, r1, r2, c1, c2 +INTEGER(I4B) :: dim1, dim2, dim3, dim4 + +dim1 = SIZE(From, 1) +dim2 = SIZE(From, 2) +dim3 = SIZE(From, 3) +dim4 = SIZE(From, 4) +nrow = dim1 * dim3 +ncol = dim2 * dim4 +c1 = 0; c2 = 0 + +DO b = 1, dim4 + c1 = c2 + 1 + c2 = b * dim2 + r1 = 0; r2 = 0 + DO a = 1, dim3 + r1 = r2 + 1; + r2 = a * dim1 + To(r1:r2, c1:c2) = From(1:dim1, 1:dim2, a, b) + END DO +END DO + +END PROCEDURE convert2_ + !---------------------------------------------------------------------------- ! Convert !---------------------------------------------------------------------------- @@ -120,4 +149,32 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE convert3_ +INTEGER(I4B) :: a, b +INTEGER(I4B) :: n1, n2, n3, n4, n5, n6 + +n1 = SIZE(from, 1) +n2 = SIZE(from, 2) +n3 = SIZE(from, 3) +n4 = SIZE(from, 4) +n5 = SIZE(from, 5) +n6 = SIZE(from, 6) + +dim3 = n5 +dim4 = n6 + +DO b = 1, n6 + DO a = 1, n5 + CALL Convert_(from=from(1:n1, 1:n2, 1:n3, 1:n4, a, b), & + to=to(1:n1 * n3, 1:n2 * n4, a, b), & + nrow=dim1, ncol=dim2) + END DO +END DO + +END PROCEDURE convert3_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + END SUBMODULE Methods diff --git a/src/submodules/Utility/src/ProductUtility@Methods.F90 b/src/submodules/Utility/src/ProductUtility@Methods.F90 index 3d2684690..2ec17697f 100644 --- a/src/submodules/Utility/src/ProductUtility@Methods.F90 +++ b/src/submodules/Utility/src/ProductUtility@Methods.F90 @@ -167,6 +167,22 @@ ! !---------------------------------------------------------------------------- +MODULE PROCEDURE OuterProd_r1r2_ +INTEGER(I4B) :: ii +dim1 = SIZE(a) +dim2 = SIZE(b, 1) +dim3 = SIZE(b, 2) +DO ii = 1, dim3 + CALL OuterProd_(a=a, b=b(1:dim2, ii), ans=ans(1:dim1, 1:dim2, ii), & + anscoeff=anscoeff, scale=scale, & + nrow=dim1, ncol=dim2) +END DO +END PROCEDURE OuterProd_r1r2_ + +!---------------------------------------------------------------------------- +! +!---------------------------------------------------------------------------- + MODULE PROCEDURE OuterProd_r1r3 INTEGER(I4B) :: ii DO ii = 1, SIZE(b, 3)