Some improvements for openmp vector updates

1 year ago · 5e691d5bff
parent bb9f213551
commit 5e691d5bff
13 changed files with 30 additions and 132 deletions
--- a/base/modules/auxil/psb_c_realloc_mod.F90
+++ b/base/modules/auxil/psb_c_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_d_realloc_mod.F90
+++ b/base/modules/auxil/psb_d_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_e_realloc_mod.F90
+++ b/base/modules/auxil/psb_e_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_i2_realloc_mod.F90
+++ b/base/modules/auxil/psb_i2_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_m_realloc_mod.F90
+++ b/base/modules/auxil/psb_m_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_s_realloc_mod.F90
+++ b/base/modules/auxil/psb_s_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/auxil/psb_z_realloc_mod.F90
+++ b/base/modules/auxil/psb_z_realloc_mod.F90
@ -997,24 +997,6 @@ Contains
      goto 9999
    end if

-!!$    If (len > psb_size(v)) Then
-!!$      if (present(newsz)) then 
-!!$        isz = (max(len+1,newsz))
-!!$      else
-!!$        if (present(addsz)) then 
-!!$          isz = len+max(1,addsz)
-!!$        else
-!!$          isz = max(len+10, int(1.25*len))
-!!$        endif
-!!$      endif
-!!$
-!!$      call psb_realloc(isz,v,info,pad=pad)
-!!$      if (info /= psb_success_) then
-!!$        info=psb_err_from_subroutine_
-!!$        call psb_errpush(info,name,a_err='psb_realloc')
-!!$        goto 9999
-!!$      End If
-!!$    end If
    isz = psb_size(v)
    If (len > isz) Then
 #if defined(OPENMP)
--- a/base/modules/serial/psb_c_base_vect_mod.F90
+++ b/base/modules/serial/psb_c_base_vect_mod.F90
@ -481,7 +481,11 @@ contains
    implicit none
    class(psb_c_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=czero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=czero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine c_base_zero

--- a/base/modules/serial/psb_d_base_vect_mod.F90
+++ b/base/modules/serial/psb_d_base_vect_mod.F90
@ -488,7 +488,11 @@ contains
    implicit none
    class(psb_d_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=dzero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=dzero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine d_base_zero

--- a/base/modules/serial/psb_i_base_vect_mod.F90
+++ b/base/modules/serial/psb_i_base_vect_mod.F90
@ -417,7 +417,11 @@ contains
    implicit none
    class(psb_i_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=izero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=izero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine i_base_zero

--- a/base/modules/serial/psb_l_base_vect_mod.F90
+++ b/base/modules/serial/psb_l_base_vect_mod.F90
@ -418,7 +418,11 @@ contains
    implicit none
    class(psb_l_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=lzero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=lzero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine l_base_zero

--- a/base/modules/serial/psb_s_base_vect_mod.F90
+++ b/base/modules/serial/psb_s_base_vect_mod.F90
@ -488,7 +488,11 @@ contains
    implicit none
    class(psb_s_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=szero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=szero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine s_base_zero

--- a/base/modules/serial/psb_z_base_vect_mod.F90
+++ b/base/modules/serial/psb_z_base_vect_mod.F90
@ -481,7 +481,11 @@ contains
    implicit none
    class(psb_z_base_vect_type), intent(inout)    :: x

-    if (allocated(x%v)) x%v=zzero
+    if (allocated(x%v)) then
+      !$omp workshare
+      x%v(:)=zzero
+      !$omp end workshare
+    end if
    call x%set_host()
  end subroutine z_base_zero