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