!!matvec with matmul !#define __MATVEC_N(y,Mat,Vec) y=MATMUL(Mat,Vec) !#define __MATVEC_T(y,Mat,Vec) y=MATMUL(Vec,Mat) !#define __PMATVEC_N(fy,y,Mat,Vec) y=fyy+MATMUL(Mat,Vec) !#define __PMATVEC_T(fy,y,Mat,Vec) y=fyy+MATMUL(Vec,Mat) !#define __AMATVEC_N(y,fMat,Mat,Vec) y=fMatMATMUL(Mat,Vec) !#define __AMATVEC_T(y,fMat,Mat,Vec) y=fMatMATMUL(Vec,Mat) !#define __PAMATVEC_N(fy,y,fMat,Mat,Vec) y=fyy+fMatMATMUL(Mat,Vec) !#define __PAMATVEC_T(fy,y,fMat,Mat,Vec) y=fyy+fMatMATMUL(Vec,Mat)
!!#define __GENERICMATVEC(NT,fy,y,fMat,Mat,Vec) CALL DGEMV(NT,SIZE(Mat,1),SIZE(Mat,2),fMat,Mat,SIZE(Mat,1),Vec,1,fy,y,1)
!!matmat with matmul !#define __MATMAT_NN(Y,A,B) Y=MATMUL(A,B) !#define __MATMAT_TN(Y,A,B) Y=MATMUL(TRANSPOSE(A),B) !#define __MATMAT_NT(Y,A,B) Y=MATMUL(A,TRANSPOSE(B)) !#define __MATMAT_TT(Y,A,B) Y=TRANSPOSE(MATMUL(B,A))
!#define __PMATMAT_NN(fy,Y,A,B) Y=fyY+MATMUL(A,B) !#define __PMATMAT_TN(fy,Y,A,B) Y=fyY+MATMUL(TRANSPOSE(A),B) !#define __PMATMAT_NT(fy,Y,A,B) Y=fyY+MATMUL(A,TRANSPOSE(B)) !#define __PMATMAT_TT(fy,Y,A,B) Y=fyY+TRANSPOSE(MATMUL(B,A))
!#define __AMATMAT_NN(Y,fa,A,B) Y=faMATMUL(A,B) !#define __AMATMAT_TN(Y,fa,A,B) Y=faMATMUL(TRANSPOSE(A),B) !#define __AMATMAT_NT(Y,fa,A,B) Y=faMATMUL(A,TRANSPOSE(B)) !#define __AMATMAT_TT(Y,fa,A,B) Y=faTRANSPOSE(MATMUL(B,A))
!#define __PAMATMAT_NN(fy,Y,fa,A,B) Y=fyY+faMATMUL(A,B) !#define __PAMATMAT_TN(fy,Y,fa,A,B) Y=fyY+faMATMUL(TRANSPOSE(A),B) !#define __PAMATMAT_NT(fy,Y,fa,A,B) Y=fyY+faMATMUL(A,TRANSPOSE(B)) !#define __PAMATMAT_TT(fy,Y,fa,A,B) Y=fyY+faTRANSPOSE(MATMUL(B,A))
! GEMM does in general Y = fa A^?B^? + fy Y ! with structure: (m x n) = (m x k) (k x n) ! Y=A B : DGEMM('N','N',m,n,k,fa,Amat ,m, Bmat,k, fy,Y,m) ! Y=A^TB : DGEMM('T','N',m,n,k,fa,Amat ,k, Bmat,k, fy,Y,m) ! Y=A B^T : DGEMM('N','T',m,n,k,fa,Amat ,m, Bmat,n, fy,Y,m) ! Y=A^T*B^T : DGEMM('T','T',m,n,k,fa,Amat ,k, Bmat,n, fy,Y,m)
!#define __GENERICMATMAT_NN(fy,Y,fa,A,B) CALL DGEMM('N','N',SIZE(A,1),SIZE(B,2),SIZE(B,1),fa,A,SIZE(A,1),B,SIZE(B,1),fy,Y,SIZE(A,1)) !#define __GENERICMATMAT_TN(fy,Y,fa,A,B) CALL DGEMM('T','N',SIZE(A,2),SIZE(B,2),SIZE(B,1),fa,A,SIZE(B,1),B,SIZE(B,1),fy,Y,SIZE(A,2)) !#define __GENERICMATMAT_NT(fy,Y,fa,A,B) CALL DGEMM('N','T',SIZE(A,1),SIZE(B,1),SIZE(B,2),fa,A,SIZE(A,1),B,SIZE(B,1),fy,Y,SIZE(A,1)) !#define __GENERICMATMAT_TT(fy,Y,fa,A,B) CALL DGEMM('T','T',SIZE(A,2),SIZE(B,1),SIZE(B,2),fa,A,SIZE(B,2),B,SIZE(B,1),fy,Y,SIZE(A,2))
! SIMPLE INTERFACE FOR DGEMM, specifying nrows/ncols of mat A and nrows/ncols of mat B (for any transpose!) ! GEMM does in general Y = fa A^?B^? + fy Y ! with structure: (m x n) = (m x k) (k x n) ! Y=A B : DGEMM('N','N',m,n,k,fa,Amat ,m, Bmat,k, fy,Y,m) ! Y=A^TB : DGEMM('T','N',m,n,k,fa,Amat ,k, Bmat,k, fy,Y,m) ! Y=A B^T : DGEMM('N','T',m,n,k,fa,Amat ,m, Bmat,n, fy,Y,m) ! Y=A^T*B^T : DGEMM('T','T',m,n,k,fa,Amat ,k, Bmat,n, fy,Y,m)
!=================================================================================================================================== ! Copyright (c) 2025 GVEC Contributors, Max Planck Institute for Plasma Physics ! License: MIT !=================================================================================================================================== #include "defines.FPP" !=================================================================================================================================== !> !!# Module ** C_Sol_Var ** !! !! contains only abstract type c_sol_var !! !=================================================================================================================================== MODULE MODgvec_c_sol_var ! MODULES USE MODgvec_Globals,ONLY:wp IMPLICIT NONE PUBLIC !----------------------------------------------------------------------------------------------------------------------------------- TYPE,ABSTRACT :: c_sol_var INTEGER :: nVars CONTAINS PROCEDURE(i_sub_sol_var_init ),DEFERRED :: init PROCEDURE(i_sub_sol_var ),DEFERRED :: free PROCEDURE(i_sub_sol_var_set_to_solvar),DEFERRED :: set_to_solvar PROCEDURE(i_sub_sol_var_set_to_scalar),DEFERRED :: set_to_scalar PROCEDURE(i_sub_sol_var_copy ),DEFERRED :: copy PROCEDURE(i_fun_sol_var_norm_2),DEFERRED :: norm_2 PROCEDURE(i_sub_sol_var_AXBY ),DEFERRED :: AXBY END TYPE c_sol_var ABSTRACT INTERFACE SUBROUTINE i_sub_sol_var_init( sf ,varsize) IMPORT c_sol_var INTEGER , INTENT(IN ) :: varsize(:) CLASS(c_sol_var), INTENT(INOUT) :: sf END SUBROUTINE i_sub_sol_var_init SUBROUTINE i_sub_sol_var( sf ) IMPORT c_sol_var CLASS(c_sol_var), INTENT(INOUT) :: sf END SUBROUTINE i_sub_sol_var FUNCTION i_fun_sol_var_norm_2( sf ) RESULT(norm_2) IMPORT wp,c_sol_var CLASS(c_sol_var), INTENT(IN ) :: sf REAL(wp) :: norm_2(sf%nvars) END FUNCTION i_fun_sol_var_norm_2 SUBROUTINE i_sub_sol_var_copy( sf, tocopy ) IMPORT c_sol_var CLASS(c_sol_var), INTENT(IN ) :: tocopy CLASS(c_sol_var), INTENT(INOUT) :: sf END SUBROUTINE i_sub_sol_var_copy SUBROUTINE i_sub_sol_var_set_to_solvar( sf, toset ,scal_in) IMPORT wp,c_sol_var CLASS(c_sol_var), INTENT(IN ) :: toset CLASS(c_sol_var), INTENT(INOUT) :: sf REAL(wp),INTENT(IN),OPTIONAL :: scal_in END SUBROUTINE i_sub_sol_var_set_to_solvar SUBROUTINE i_sub_sol_var_set_to_scalar( sf, scalar ) IMPORT wp,c_sol_var REAL(wp) , INTENT(IN ) :: scalar CLASS(c_sol_var), INTENT(INOUT) :: sf END SUBROUTINE i_sub_sol_var_set_to_scalar SUBROUTINE i_sub_sol_var_AXBY( sf, aa, X, bb, Y ) IMPORT wp,c_sol_var REAL(wp) , INTENT(IN ) :: aa CLASS(c_sol_var), INTENT(IN ) :: X REAL(wp) , INTENT(IN ) :: bb CLASS(c_sol_var), INTENT(IN ) :: Y CLASS(c_sol_var), INTENT(INOUT) :: sf END SUBROUTINE i_sub_sol_var_AXBY END INTERFACE !----------------------------------------------------------------------------------------------------------------------------------- END MODULE MODgvec_c_sol_var