1! 2! 3! Fortran kernel for the MDot() vector routine 4! 5#include <petsc/finclude/petscsys.h> 6! 7pure 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 13 14 PetscInt :: i 15 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)) 21 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 28end subroutine FortranMDot4 29 30pure 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 36 37 PetscInt :: i 38 39 PETSC_AssertAlignx(16, x(1)) 40 PETSC_AssertAlignx(16, y1(1)) 41 PETSC_AssertAlignx(16, y2(1)) 42 PETSC_AssertAlignx(16, y3(1)) 43 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 49end subroutine FortranMDot3 50 51pure 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 57 58 PetscInt :: i 59 60 PETSC_AssertAlignx(16, x(1)) 61 PETSC_AssertAlignx(16, y1(1)) 62 PETSC_AssertAlignx(16, y2(1)) 63 64 do i = 1, n 65 sum1 = sum1 + x(i)*PetscConj(y1(i)) 66 sum2 = sum2 + x(i)*PetscConj(y2(i)) 67 end do 68end subroutine FortranMDot2 69 70pure 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 76 77 PetscInt :: i 78 79 PETSC_AssertAlignx(16, x(1)) 80 PETSC_AssertAlignx(16, y1(1)) 81 82 do i = 1, n 83 sum1 = sum1 + x(i)*PetscConj(y1(i)) 84 end do 85 86end subroutine FortranMDot1 87