Actual source code: fmdot.F90
1: !
2: !
3: ! Fortran kernel for the MDot() vector routine
4: !
5: #include <petsc/finclude/petscsys.h>
6: !
7: pure subroutine FortranMDot4(x, y1, y2, y3, y4, n, sum1, sum2, sum3, sum4)
8: use, intrinsic :: ISO_C_binding
9: implicit none(type, external)
10: PetscScalar, intent(inout) :: sum1, sum2, sum3, sum4
11: PetscScalar, intent(in) :: x(*), y1(*), y2(*), y3(*), y4(*)
12: PetscInt, intent(in) :: n
14: PetscInt :: i
16: PETSC_AssertAlignx(16, x(1))
17: PETSC_AssertAlignx(16, y1(1))
18: PETSC_AssertAlignx(16, y2(1))
19: PETSC_AssertAlignx(16, y3(1))
20: PETSC_AssertAlignx(16, y4(1))
22: do i = 1, n
23: sum1 = sum1 + x(i)*PetscConj(y1(i))
24: sum2 = sum2 + x(i)*PetscConj(y2(i))
25: sum3 = sum3 + x(i)*PetscConj(y3(i))
26: sum4 = sum4 + x(i)*PetscConj(y4(i))
27: end do
28: end subroutine FortranMDot4
30: pure subroutine FortranMDot3(x, y1, y2, y3, n, sum1, sum2, sum3)
31: use, intrinsic :: ISO_C_binding
32: implicit none(type, external)
33: PetscScalar, intent(inout) :: sum1, sum2, sum3
34: PetscScalar, intent(in) :: x(*), y1(*), y2(*), y3(*)
35: PetscInt, intent(in) :: n
37: PetscInt :: i
39: PETSC_AssertAlignx(16, x(1))
40: PETSC_AssertAlignx(16, y1(1))
41: PETSC_AssertAlignx(16, y2(1))
42: PETSC_AssertAlignx(16, y3(1))
44: do i = 1, n
45: sum1 = sum1 + x(i)*PetscConj(y1(i))
46: sum2 = sum2 + x(i)*PetscConj(y2(i))
47: sum3 = sum3 + x(i)*PetscConj(y3(i))
48: end do
49: end subroutine FortranMDot3
51: pure subroutine FortranMDot2(x, y1, y2, n, sum1, sum2)
52: use, intrinsic :: ISO_C_binding
53: implicit none(type, external)
54: PetscScalar, intent(inout) :: sum1, sum2
55: PetscScalar, intent(in) :: x(*), y1(*), y2(*)
56: PetscInt, intent(in) :: n
58: PetscInt :: i
60: PETSC_AssertAlignx(16, x(1))
61: PETSC_AssertAlignx(16, y1(1))
62: PETSC_AssertAlignx(16, y2(1))
64: do i = 1, n
65: sum1 = sum1 + x(i)*PetscConj(y1(i))
66: sum2 = sum2 + x(i)*PetscConj(y2(i))
67: end do
68: end subroutine FortranMDot2
70: pure subroutine FortranMDot1(x, y1, n, sum1)
71: use, intrinsic :: ISO_C_binding
72: implicit none(type, external)
73: PetscScalar, intent(inout) :: sum1
74: PetscScalar, intent(in) :: x(*), y1(*)
75: PetscInt, intent(in) :: n
77: PetscInt :: i
79: PETSC_AssertAlignx(16, x(1))
80: PETSC_AssertAlignx(16, y1(1))
82: do i = 1, n
83: sum1 = sum1 + x(i)*PetscConj(y1(i))
84: end do
86: end subroutine FortranMDot1