Actual source code: fmdot.F90
1: !
2: !
3: ! Fortran kernel for the MDot() vector routine
4: !
5: #include <petsc/finclude/petscsys.h>
6: !
7: subroutine FortranMDot4(x,y1,y2,y3,y4,n,sum1,sum2,sum3,sum4)
8: implicit none
9: PetscScalar sum1,sum2,sum3,sum4
10: PetscScalar x(*),y1(*),y2(*),y3(*),y4(*)
11: PetscInt n
12: PetscInt i
14: PETSC_AssertAlignx(16,x(1))
15: PETSC_AssertAlignx(16,y1(1))
16: PETSC_AssertAlignx(16,y2(1))
17: PETSC_AssertAlignx(16,y3(1))
18: PETSC_AssertAlignx(16,y4(1))
20: do 10,i=1,n
21: sum1 = sum1 + x(i)*PetscConj(y1(i))
22: sum2 = sum2 + x(i)*PetscConj(y2(i))
23: sum3 = sum3 + x(i)*PetscConj(y3(i))
24: sum4 = sum4 + x(i)*PetscConj(y4(i))
25: 10 continue
27: return
28: end
30: subroutine FortranMDot3(x,y1,y2,y3,n,sum1,sum2,sum3)
31: implicit none
32: PetscScalar sum1,sum2,sum3
33: PetscScalar x(*),y1(*),y2(*),y3(*)
34: PetscInt n
35: PetscInt i
37: PETSC_AssertAlignx(16,x(1))
38: PETSC_AssertAlignx(16,y1(1))
39: PETSC_AssertAlignx(16,y2(1))
40: PETSC_AssertAlignx(16,y3(1))
41: do 10,i=1,n
42: sum1 = sum1 + x(i)*PetscConj(y1(i))
43: sum2 = sum2 + x(i)*PetscConj(y2(i))
44: sum3 = sum3 + x(i)*PetscConj(y3(i))
45: 10 continue
47: return
48: end
50: subroutine FortranMDot2(x,y1,y2,n,sum1,sum2)
51: implicit none
52: PetscScalar sum1,sum2,x(*),y1(*),y2(*)
53: PetscInt n
54: PetscInt i
56: PETSC_AssertAlignx(16,x(1))
57: PETSC_AssertAlignx(16,y1(1))
58: PETSC_AssertAlignx(16,y2(1))
59: do 10,i=1,n
60: sum1 = sum1 + x(i)*PetscConj(y1(i))
61: sum2 = sum2 + x(i)*PetscConj(y2(i))
62: 10 continue
64: return
65: end
67: subroutine FortranMDot1(x,y1,n,sum1)
68: implicit none
69: PetscScalar sum1,x(*),y1(*)
70: PetscInt n
71: PetscInt i
73: PETSC_AssertAlignx(16,x(1))
74: PETSC_AssertAlignx(16,y1(1))
75: do 10,i=1,n
76: sum1 = sum1 + x(i)*PetscConj(y1(i))
77: 10 continue
79: return
80: end