1: !
  2: !    Fortran kernel for gemv() BLAS operation. This version supports
  3: !  matrix array stored in single precision but vectors in double
  4: !
  5: #include <petsc/finclude/petscsys.h>

  7: pure subroutine MSGemv(bs,ncols,A,x,y)
  8:   use, intrinsic :: ISO_C_binding
  9:   implicit none (type, external)
 10:   PetscInt, intent(in) :: bs,ncols
 11:   MatScalar, intent(in) :: A(bs,ncols)
 12:   PetscScalar, intent(in) :: x(ncols)
 13:   PetscScalar, intent(out) :: y(bs)

 15:   PetscInt :: i

 17:   y(1:bs) = 0.0
 18:   do i=1,ncols
 19:     y(1:bs) = y(1:bs) + A(1:bs,i)*x(i)
 20:   end do
 21: end subroutine MSGemv

 23: pure subroutine MSGemvp(bs,ncols,A,x,y)
 24:   use, intrinsic :: ISO_C_binding
 25:   implicit none (type, external)
 26:   PetscInt, intent(in) :: bs,ncols
 27:   MatScalar, intent(in) :: A(bs,ncols)
 28:   PetscScalar, intent(in) :: x(ncols)
 29:   PetscScalar, intent(inout) :: y(bs)

 31:   PetscInt :: i

 33:   do i=1,ncols
 34:     y(1:bs) = y(1:bs) + A(1:bs,i)*x(i)
 35:   end do
 36: end subroutine MSGemvp

 38: pure subroutine MSGemvm(bs,ncols,A,x,y)
 39:   use, intrinsic :: ISO_C_binding
 40:   implicit none (type, external)
 41:   PetscInt, intent(in) :: bs,ncols
 42:   MatScalar, intent(in) :: A(bs,ncols)
 43:   PetscScalar, intent(in) :: x(ncols)
 44:   PetscScalar, intent(inout) :: y(bs)

 46:   PetscInt :: i

 48:   do i=1,ncols
 49:     y(1:bs) = y(1:bs) - A(1:bs,i)*x(i)
 50:   end do
 51: end subroutine MSGemvm

 53: pure subroutine MSGemvt(bs,ncols,A,x,y)
 54:   use, intrinsic :: ISO_C_binding
 55:   implicit none (type, external)
 56:   PetscInt, intent(in) :: bs,ncols
 57:   MatScalar, intent(in) :: A(bs,ncols)
 58:   PetscScalar, intent(in) :: x(bs)
 59:   PetscScalar, intent(inout) :: y(ncols)

 61:   PetscInt :: i

 63:   do  i=1,ncols
 64:     y(i) = y(i) + sum(A(1:bs,i)*x(1:bs))
 65:   end do
 66: end subroutine MSGemvt

 68: pure subroutine MSGemm(bs,A,B,C)
 69:   use, intrinsic :: ISO_C_binding
 70:   implicit none (type, external)
 71:   PetscInt, intent(in) :: bs
 72:   MatScalar, intent(in) :: B(bs,bs),C(bs,bs)
 73:   MatScalar, intent(inout) :: A(bs,bs)

 75:   PetscInt :: i,j

 77:   do i=1,bs
 78:     do j=1,bs
 79:       A(i,j) = A(i,j) - sum(B(i,1:bs)*C(1:bs,j))
 80:     end do
 81:   end do
 82: end subroutine MSGemm

 84: pure subroutine MSGemmi(bs,A,C,B)
 85:   use, intrinsic :: ISO_C_binding
 86:   implicit none (type, external)
 87:   PetscInt, intent(in) :: bs
 88:   MatScalar, intent(in) :: B(bs,bs),C(bs,bs)
 89:   MatScalar, intent(out) :: A(bs,bs)

 91:   PetscInt :: i,j

 93:   do i=1,bs
 94:     do j=1,bs
 95:       A(i,j) = sum(B(i,1:bs)*C(1:bs,j))
 96:     end do
 97:   end do
 98: end subroutine MSGemmi