xref: /petsc/src/mat/ftn-kernels/sgemv.F90 (revision 0ccf82ac36648ce52b79cfc8b55f689a1594b19a) 
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>
6
7pure subroutine MSGemv(bs,ncols,A,x,y)
8  implicit none (type, external)
9  PetscInt, intent(in) :: bs,ncols
10  MatScalar, intent(in) :: A(bs,ncols)
11  PetscScalar, intent(in) :: x(ncols)
12  PetscScalar, intent(out) :: y(bs)
13
14  PetscInt         i,j
15
16  do j=1,bs
17    y(j) = 0.0d0
18  end do
19
20  do i=1,ncols
21    do j=1,bs
22      y(j) = y(j) + A(j,i)*x(i)
23    end do
24  end do
25end subroutine MSGemv
26
27pure subroutine MSGemvp(bs,ncols,A,x,y)
28  implicit none (type, external)
29  PetscInt, intent(in) :: bs,ncols
30  MatScalar, intent(in) :: A(bs,ncols)
31  PetscScalar, intent(in) :: x(ncols)
32  PetscScalar, intent(inout) :: y(bs)
33
34  PetscInt         i, j
35
36  do i=1,ncols
37    do j=1,bs
38      y(j) = y(j) + A(j,i)*x(i)
39    end do
40  end do
41end subroutine MSGemvp
42
43pure subroutine MSGemvm(bs,ncols,A,x,y)
44  implicit none (type, external)
45  PetscInt, intent(in) :: bs,ncols
46  MatScalar, intent(in) :: A(bs,ncols)
47  PetscScalar, intent(in) :: x(ncols)
48  PetscScalar, intent(inout) :: y(bs)
49
50  PetscInt         i, j
51
52  do i=1,ncols
53    do j=1,bs
54      y(j) = y(j) - A(j,i)*x(i)
55    end do
56  end do
57end subroutine MSGemvm
58
59pure subroutine MSGemvt(bs,ncols,A,x,y)
60  implicit none (type, external)
61  PetscInt, intent(in) :: bs,ncols
62  MatScalar, intent(in) :: A(bs,ncols)
63  PetscScalar, intent(in) :: x(bs)
64  PetscScalar, intent(inout) :: y(ncols)
65
66  PetscInt          i,j
67  PetscScalar      sum
68
69  do  i=1,ncols
70    sum = y(i)
71    do  j=1,bs
72      sum = sum + A(j,i)*x(j)
73    end do
74    y(i) = sum
75  end do
76end subroutine MSGemvt
77
78pure subroutine MSGemm(bs,A,B,C)
79  implicit none (type, external)
80  PetscInt, intent(in) :: bs
81  MatScalar, intent(in) :: B(bs,bs),C(bs,bs)
82  MatScalar, intent(inout) :: A(bs,bs)
83
84  PetscScalar sum
85  PetscInt    i,j,k
86
87  do i=1,bs
88    do j=1,bs
89      sum = A(i,j)
90      do k=1,bs
91        sum = sum - B(i,k)*C(k,j)
92      end do
93      A(i,j) = sum
94    end do
95  end do
96end subroutine MSGemm
97
98pure subroutine MSGemmi(bs,A,C,B)
99  implicit none (type, external)
100  PetscInt, intent(in) :: bs
101  MatScalar, intent(in) :: B(bs,bs),C(bs,bs)
102  MatScalar, intent(out) :: A(bs,bs)
103
104  PetscScalar sum
105  PetscInt    i,j,k
106
107  do i=1,bs
108    do j=1,bs
109      sum = 0.0d0
110      do  k=1,bs
111        sum = sum + B(i,k)*C(k,j)
112      end do
113      A(i,j) = sum
114    end do
115  end do
116end subroutine MSGemmi
117