Reworked oacc_vect_mod. oacc_mlt_v_X generates ICE, to be fixed

openacc/impl/Makefile

@@ -9,7 +9,7 @@ MODDIR=../../modules
 FINCLUDES=$(FMFLAG).. $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(FIFLAG).. 
 LIBNAME=libpsb_openacc.a
 
-OBJS= psb_d_oacc_csr_vect_mv.o
+OBJS= psb_d_oacc_csr_vect_mv.o psb_d_oacc_mlt_v_2.o psb_d_oacc_mlt_v.o
 
 objs: $(OBJS)
 

openacc/impl/psb_d_oacc_mlt_v.f90

@@ -0,0 +1,31 @@
+
+subroutine d_oacc_mlt_v(x, y, info)
+  use psb_d_oacc_vect_mod, psb_protect_name => d_oacc_mlt_v
+
+  implicit none 
+  class(psb_d_base_vect_type), intent(inout) :: x
+  class(psb_d_vect_oacc), intent(inout)       :: y
+  integer(psb_ipk_), intent(out)             :: info
+
+  integer(psb_ipk_) :: i, n
+
+  info = 0    
+!!$  n = min(x%get_nrows(), y%get_nrows())
+!!$  select type(xx => x)
+!!$  type is (psb_d_base_vect_type)
+!!$    if (y%is_dev()) call y%sync()
+!!$    !$acc parallel loop
+!!$    do i = 1, n
+!!$      y%v(i) = y%v(i) * xx%v(i)
+!!$    end do
+!!$    call y%set_host()
+!!$  class default
+!!$    if (xx%is_dev()) call xx%sync()
+!!$    if (y%is_dev()) call y%sync()
+!!$    !$acc parallel loop
+!!$    do i = 1, n
+!!$      y%v(i) = y%v(i) * xx%v(i)
+!!$    end do
+!!$    call y%set_host()
+!!$  end select
+end subroutine d_oacc_mlt_v

openacc/impl/psb_d_oacc_mlt_v_2.f90

@@ -0,0 +1,55 @@
+subroutine d_oacc_mlt_v_2(alpha, x, y, beta, z, info, conjgx, conjgy)
+  use psb_d_oacc_vect_mod, psb_protect_name => d_oacc_mlt_v_2
+  use psb_string_mod
+  implicit none 
+  real(psb_dpk_), intent(in)                 :: alpha, beta
+  class(psb_d_base_vect_type), intent(inout) :: x
+  class(psb_d_base_vect_type), intent(inout) :: y
+  class(psb_d_vect_oacc), intent(inout)      :: z
+  integer(psb_ipk_), intent(out)             :: info
+  character(len=1), intent(in), optional     :: conjgx, conjgy
+  integer(psb_ipk_) :: i, n
+  logical :: conjgx_, conjgy_
+
+  conjgx_ = .false.
+  conjgy_ = .false.
+  if (present(conjgx)) conjgx_ = (psb_toupper(conjgx) == 'C')
+  if (present(conjgy)) conjgy_ = (psb_toupper(conjgy) == 'C')
+
+  n = min(x%get_nrows(), y%get_nrows(), z%get_nrows())
+
+  info = 0    
+!!$  select type(xx => x)
+!!$  class is (psb_d_vect_oacc)
+!!$    select type (yy => y)
+!!$    class is (psb_d_vect_oacc)
+!!$      if (xx%is_host()) call xx%sync_space()
+!!$      if (yy%is_host()) call yy%sync_space()
+!!$      if ((beta /= dzero) .and. (z%is_host())) call z%sync_space()
+!!$      !$acc parallel loop
+!!$      do i = 1, n
+!!$        z%v(i) = alpha * xx%v(i) * yy%v(i) + beta * z%v(i)
+!!$      end do
+!!$      call z%set_dev()
+!!$    class default
+!!$      if (xx%is_dev()) call xx%sync_space()
+!!$      if (yy%is_dev()) call yy%sync()
+!!$      if ((beta /= dzero) .and. (z%is_dev())) call z%sync_space()
+!!$      !$acc parallel loop
+!!$      do i = 1, n
+!!$        z%v(i) = alpha * xx%v(i) * yy%v(i) + beta * z%v(i)
+!!$      end do
+!!$      call z%set_host()
+!!$    end select
+!!$  class default
+!!$    if (x%is_dev()) call x%sync()
+!!$    if (y%is_dev()) call y%sync()
+!!$    if ((beta /= dzero) .and. (z%is_dev())) call z%sync_space()
+!!$    !$acc parallel loop
+!!$    do i = 1, n
+!!$      z%v(i) = alpha * x%v(i) * y%v(i) + beta * z%v(i)
+!!$    end do
+!!$    call z%set_host()
+!!$  end select
+end subroutine d_oacc_mlt_v_2
+