module ConjugateGradient use SparseMatrix #ifdef USE_CATALYST use CoProcessor #endif implicit none private :: dotproduct public :: solve contains real(kind=8) function dotproduct(sm, a, b) type(SparseMatrixData), intent(inout) :: sm integer :: i real(kind=8), intent(in) :: a(:), b(:) real(kind=8) :: value value = 0.d0 do i=1, sm%globalsize value = value + a(i)*b(i) enddo dotproduct = value end function dotproduct subroutine solve(dimensions, sm, x, rhs) type(SparseMatrixData), intent(inout) :: sm integer, intent(in) :: dimensions(3) real(kind=8), intent(in) :: rhs(:) real(kind=8), intent(inout) :: x(:) integer :: k, i real(kind=8) :: alpha, beta, rdotproduct, rnewdotproduct, sqrtorigresid real(kind=8), DIMENSION(:), allocatable :: r(:), p(:), ap(:) allocate(r(sm%globalsize), p(sm%globalsize), ap(sm%globalsize)) #ifdef USE_CATALYST x(:) = 0.d0 call runcoprocessor(dimensions, 0, 0.d0, x) #endif r(:) = rhs(:) p(:) = rhs(:) k = 1 rdotproduct = dotproduct(sm, r, r) sqrtorigresid = sqrt(rdotproduct) do while(k .le. sm%globalsize .and. sqrt(rdotproduct) .gt. sqrtorigresid*0.000001d0) call matvec(sm, p, ap) alpha = rdotproduct/dotproduct(sm, ap, p) x(:) = x(:) + alpha*p(:) r(:) = r(:) - alpha*ap(:) rnewdotproduct = dotproduct(sm, r, r) beta = rnewdotproduct/rdotproduct p(:) = r(:) + beta*p(:) rdotproduct = rnewdotproduct !write(*,*) 'on iteration ', k, sqrtorigresid, sqrt(rdotproduct), alpha #ifdef USE_CATALYST call runcoprocessor(dimensions, k, k*1.d0, x) #endif k = k+1 end do deallocate(r, p, ap) end subroutine solve end module ConjugateGradient