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