dot_R0R1R1_rel_coarray Function

private impure function dot_R0R1R1_rel_coarray(u, v, option, coarray) result(a)

Arguments

Type IntentOptional Attributes Name
real(kind=rk), intent(in), contiguous :: u(:)
real(kind=rk), intent(in), contiguous :: v(:)
character(len=*), intent(in), optional :: option
logical, intent(in) :: coarray

Return Value real(kind=rk)


Calls

proc~~dot_r0r1r1_rel_coarray~~CallsGraph proc~dot_r0r1r1_rel_coarray fordot::dot_R0R1R1_rel_coarray proc~compute_block_ranges fordot::compute_block_ranges proc~dot_r0r1r1_rel_coarray->proc~compute_block_ranges

Called by

proc~~dot_r0r1r1_rel_coarray~~CalledByGraph proc~dot_r0r1r1_rel_coarray fordot::dot_R0R1R1_rel_coarray interface~dot_product fordot::dot_product interface~dot_product->proc~dot_r0r1r1_rel_coarray

Source Code

   impure function dot_R0R1R1_rel_coarray(u,v,option,coarray) result(a)
      real(rk),     intent(in), contiguous :: u(:)
      real(rk),     intent(in), contiguous :: v(:)
      character(*), intent(in), optional   :: option
      real(rk)                             :: a
      logical,      intent(in)             :: coarray
#if defined(USE_COARRAY)
      integer               :: i, im, nimg, m, se, ee
      integer               :: block_size(num_images()), start_elem(num_images()), end_elem(num_images())
      real(rk), allocatable :: a_block[:], u_block(:)[:], v_block(:)[:]

      im   = this_image()
      nimg = num_images()
      m    = size(u)
      call compute_block_ranges(size(u), nimg, block_size, start_elem, end_elem)
      allocate(u_block(block_size(im))[*], v_block(block_size(im))[*], a_block[*])
      se = start_elem(im)
      ee = end_elem(im)
      u_block(:)[im] = u(se:ee)
      v_block(:)[im] = v(se:ee)
      a_block[im] = dot_product(u_block(:)[im],v_block(:)[im],option)
      call co_sum(a_block, result_image=1)
      a = a_block[1]
      ! sync all
      ! if (im == 1) then
      !    a = 0.0_rk
      !    do i = 1, nimg
      !       a = a + a_block[i]
      !    end do
      ! end if
#else
      a = dot_product(u, v, option)
#endif

   end function dot_R0R1R1_rel_coarray