fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Improvemnts to MAT ASB in OpenMP

Browse Source
omp-threadsafe
Salvatore Filippone 2 years ago
parent 776c755112
commit 4d988ea3db
20 changed files with 383 additions and 570 deletions
Show Stats Download Patch File Download Diff File

61
base/modules/auxil/psb_c_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
complex(psb_spk_),allocatable :: tmp(:) complex(psb_spk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
complex(psb_spk_),allocatable :: tmp(:,:) complex(psb_spk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_c_rk2' name='psb_r_m_c_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_d_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
real(psb_dpk_),allocatable :: tmp(:) real(psb_dpk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
real(psb_dpk_),allocatable :: tmp(:,:) real(psb_dpk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_d_rk2' name='psb_r_m_d_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_e_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
integer(psb_epk_),allocatable :: tmp(:) integer(psb_epk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
integer(psb_epk_),allocatable :: tmp(:,:) integer(psb_epk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_e_rk2' name='psb_r_m_e_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_i2_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
integer(psb_i2pk_),allocatable :: tmp(:) integer(psb_i2pk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
integer(psb_i2pk_),allocatable :: tmp(:,:) integer(psb_i2pk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_i2_rk2' name='psb_r_m_i2_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_m_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
integer(psb_mpk_),allocatable :: tmp(:) integer(psb_mpk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
integer(psb_mpk_),allocatable :: tmp(:,:) integer(psb_mpk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_m_rk2' name='psb_r_m_m_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_s_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
real(psb_spk_),allocatable :: tmp(:) real(psb_spk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
real(psb_spk_),allocatable :: tmp(:,:) real(psb_spk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_s_rk2' name='psb_r_m_s_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

61
base/modules/auxil/psb_z_realloc_mod.F90
Unescape Escape View File

@ -131,7 +131,7 @@ Contains
! ...Local Variables ! ...Local Variables
complex(psb_dpk_),allocatable :: tmp(:) complex(psb_dpk_),allocatable :: tmp(:)
integer(psb_mpk_) :: dim, lb_, lbi,ub_ integer(psb_mpk_) :: dim, lb_, lbi,ub_, i
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
character(len=30) :: name character(len=30) :: name
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -179,7 +179,10 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad !$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
rrax(i) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -204,7 +207,7 @@ Contains
complex(psb_dpk_),allocatable :: tmp(:,:) complex(psb_dpk_),allocatable :: tmp(:,:)
integer(psb_ipk_) :: err_act,err integer(psb_ipk_) :: err_act,err
integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2 integer(psb_mpk_) :: dim,dim2,lb1_, lb2_, ub1_, ub2_,lbi1, lbi2, i
character(len=30) :: name character(len=30) :: name
name='psb_r_m_z_rk2' name='psb_r_m_z_rk2'
@ -267,8 +270,14 @@ Contains
end if end if
endif endif
if (present(pad)) then if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad !$omp parallel do private(i) shared(lb1_,dim,len1)
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad do i=lb1_-1+dim+1,lb1_-1+len1
rrax(i,:) = pad
end do
!$omp parallel do private(i) shared(lb1_,dim,len1,lb2_,dim2,len2)
do i=lb1_,lb1_-1+len1
rrax(i,lb2_-1+dim2+1:lb2_-1+len2) = pad
end do
endif endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -982,48 +991,7 @@ Contains
goto 9999 goto 9999
end if 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
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
#if defined(OPENMP)
!$OMP CRITICAL
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)
end if
!$OMP END CRITICAL
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
#else
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = (max(len+1,newsz))
else else
@ -1040,7 +1008,6 @@ Contains
call psb_errpush(info,name,a_err='psb_realloc') call psb_errpush(info,name,a_err='psb_realloc')
goto 9999 goto 9999
End If End If
#endif
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

13
base/modules/serial/psb_c_base_mat_mod.F90
Unescape Escape View File

@ -1865,26 +1865,29 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(in), optional :: idir integer(psb_ipk_), intent(in), optional :: idir
end subroutine psb_c_fix_coo_inner end subroutine psb_c_fix_coo_inner
end interface end interface
interface interface
subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_c_fix_coo_inner_colmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
complex(psb_spk_), intent(inout) :: val(:) complex(psb_spk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_fix_coo_inner_rowmajor end subroutine psb_c_fix_coo_inner_colmajor
end interface end interface
interface interface
subroutine psb_c_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
complex(psb_spk_), intent(inout) :: val(:) complex(psb_spk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_fix_coo_inner_colmajor end subroutine psb_c_fix_coo_inner_rowmajor
end interface end interface
! !

13
base/modules/serial/psb_d_base_mat_mod.F90
Unescape Escape View File

@ -1865,26 +1865,29 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(in), optional :: idir integer(psb_ipk_), intent(in), optional :: idir
end subroutine psb_d_fix_coo_inner end subroutine psb_d_fix_coo_inner
end interface end interface
interface interface
subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_d_fix_coo_inner_colmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
real(psb_dpk_), intent(inout) :: val(:) real(psb_dpk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_fix_coo_inner_rowmajor end subroutine psb_d_fix_coo_inner_colmajor
end interface end interface
interface interface
subroutine psb_d_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
real(psb_dpk_), intent(inout) :: val(:) real(psb_dpk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_fix_coo_inner_colmajor end subroutine psb_d_fix_coo_inner_rowmajor
end interface end interface
! !

13
base/modules/serial/psb_s_base_mat_mod.F90
Unescape Escape View File

@ -1865,26 +1865,29 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(in), optional :: idir integer(psb_ipk_), intent(in), optional :: idir
end subroutine psb_s_fix_coo_inner end subroutine psb_s_fix_coo_inner
end interface end interface
interface interface
subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_s_fix_coo_inner_colmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
real(psb_spk_), intent(inout) :: val(:) real(psb_spk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_fix_coo_inner_rowmajor end subroutine psb_s_fix_coo_inner_colmajor
end interface end interface
interface interface
subroutine psb_s_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
real(psb_spk_), intent(inout) :: val(:) real(psb_spk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_fix_coo_inner_colmajor end subroutine psb_s_fix_coo_inner_rowmajor
end interface end interface
! !

13
base/modules/serial/psb_z_base_mat_mod.F90
Unescape Escape View File

@ -1865,26 +1865,29 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(in), optional :: idir integer(psb_ipk_), intent(in), optional :: idir
end subroutine psb_z_fix_coo_inner end subroutine psb_z_fix_coo_inner
end interface end interface
interface interface
subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_z_fix_coo_inner_colmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
complex(psb_dpk_), intent(inout) :: val(:) complex(psb_dpk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_fix_coo_inner_rowmajor end subroutine psb_z_fix_coo_inner_colmajor
end interface end interface
interface interface
subroutine psb_z_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,&
& ia,ja,val,iaux,nzout,info)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:)
complex(psb_dpk_), intent(inout) :: val(:) complex(psb_dpk_), intent(inout) :: val(:)
integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: nzout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_fix_coo_inner_colmajor end subroutine psb_z_fix_coo_inner_rowmajor
end interface end interface
! !

6
base/serial/impl/psb_c_coo_impl.F90
Unescape Escape View File

@ -5286,7 +5286,7 @@ function psb_lc_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -5353,7 +5353,7 @@ function psb_lc_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -5403,7 +5403,7 @@ function psb_lc_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

12
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -1328,7 +1328,7 @@ function psb_c_csr_csnmi(a) result(res)
res = szero res = szero
if (a%is_dev()) call a%sync() if (a%is_dev()) call a%sync()
!$omp parallel do private(i,acc) reduction(max: res) !$omp parallel do private(i,j,acc) reduction(max: res)
do i = 1, a%get_nrows() do i = 1, a%get_nrows()
acc = szero acc = szero
do j=a%irp(i),a%irp(i+1)-1 do j=a%irp(i),a%irp(i+1)-1
@ -1562,8 +1562,12 @@ subroutine psb_c_csr_get_diag(a,d,info)
if (a%is_unit()) then if (a%is_unit()) then
d(1:mnm) = cone !$omp parallel do private(i)
do i=1, mnm
d(i) = cone
end do
else else
!$omp parallel do private(i,j,k)
do i=1, mnm do i=1, mnm
d(i) = czero d(i) = czero
do k=a%irp(i),a%irp(i+1)-1 do k=a%irp(i),a%irp(i+1)-1
@ -1574,6 +1578,7 @@ subroutine psb_c_csr_get_diag(a,d,info)
enddo enddo
end do end do
end if end if
!$omp parallel do private(i)
do i=mnm+1,size(d) do i=mnm+1,size(d)
d(i) = czero d(i) = czero
end do end do
@ -1629,6 +1634,7 @@ subroutine psb_c_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1, m do i=1, m
do j = a%irp(i), a%irp(i+1) -1 do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) a%val(j) = a%val(j) * d(i)
@ -1643,6 +1649,7 @@ subroutine psb_c_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
j = a%ja(i) j = a%ja(i)
a%val(i) = a%val(i) * d(j) a%val(i) = a%val(i) * d(j)
@ -1681,6 +1688,7 @@ subroutine psb_c_csr_scals(d,a,info)
call a%make_nonunit() call a%make_nonunit()
end if end if
!$omp parallel do private(i)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d a%val(i) = a%val(i) * d
enddo enddo

6
base/serial/impl/psb_d_coo_impl.F90
Unescape Escape View File

@ -5286,7 +5286,7 @@ function psb_ld_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -5353,7 +5353,7 @@ function psb_ld_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -5403,7 +5403,7 @@ function psb_ld_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

12
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -1328,7 +1328,7 @@ function psb_d_csr_csnmi(a) result(res)
res = dzero res = dzero
if (a%is_dev()) call a%sync() if (a%is_dev()) call a%sync()
!$omp parallel do private(i,acc) reduction(max: res) !$omp parallel do private(i,j,acc) reduction(max: res)
do i = 1, a%get_nrows() do i = 1, a%get_nrows()
acc = dzero acc = dzero
do j=a%irp(i),a%irp(i+1)-1 do j=a%irp(i),a%irp(i+1)-1
@ -1562,8 +1562,12 @@ subroutine psb_d_csr_get_diag(a,d,info)
if (a%is_unit()) then if (a%is_unit()) then
d(1:mnm) = done !$omp parallel do private(i)
do i=1, mnm
d(i) = done
end do
else else
!$omp parallel do private(i,j,k)
do i=1, mnm do i=1, mnm
d(i) = dzero d(i) = dzero
do k=a%irp(i),a%irp(i+1)-1 do k=a%irp(i),a%irp(i+1)-1
@ -1574,6 +1578,7 @@ subroutine psb_d_csr_get_diag(a,d,info)
enddo enddo
end do end do
end if end if
!$omp parallel do private(i)
do i=mnm+1,size(d) do i=mnm+1,size(d)
d(i) = dzero d(i) = dzero
end do end do
@ -1629,6 +1634,7 @@ subroutine psb_d_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1, m do i=1, m
do j = a%irp(i), a%irp(i+1) -1 do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) a%val(j) = a%val(j) * d(i)
@ -1643,6 +1649,7 @@ subroutine psb_d_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
j = a%ja(i) j = a%ja(i)
a%val(i) = a%val(i) * d(j) a%val(i) = a%val(i) * d(j)
@ -1681,6 +1688,7 @@ subroutine psb_d_csr_scals(d,a,info)
call a%make_nonunit() call a%make_nonunit()
end if end if
!$omp parallel do private(i)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d a%val(i) = a%val(i) * d
enddo enddo

6
base/serial/impl/psb_s_coo_impl.F90
Unescape Escape View File

@ -5286,7 +5286,7 @@ function psb_ls_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -5353,7 +5353,7 @@ function psb_ls_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -5403,7 +5403,7 @@ function psb_ls_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

12
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1328,7 +1328,7 @@ function psb_s_csr_csnmi(a) result(res)
res = szero res = szero
if (a%is_dev()) call a%sync() if (a%is_dev()) call a%sync()
!$omp parallel do private(i,acc) reduction(max: res) !$omp parallel do private(i,j,acc) reduction(max: res)
do i = 1, a%get_nrows() do i = 1, a%get_nrows()
acc = szero acc = szero
do j=a%irp(i),a%irp(i+1)-1 do j=a%irp(i),a%irp(i+1)-1
@ -1562,8 +1562,12 @@ subroutine psb_s_csr_get_diag(a,d,info)
if (a%is_unit()) then if (a%is_unit()) then
d(1:mnm) = sone !$omp parallel do private(i)
do i=1, mnm
d(i) = sone
end do
else else
!$omp parallel do private(i,j,k)
do i=1, mnm do i=1, mnm
d(i) = szero d(i) = szero
do k=a%irp(i),a%irp(i+1)-1 do k=a%irp(i),a%irp(i+1)-1
@ -1574,6 +1578,7 @@ subroutine psb_s_csr_get_diag(a,d,info)
enddo enddo
end do end do
end if end if
!$omp parallel do private(i)
do i=mnm+1,size(d) do i=mnm+1,size(d)
d(i) = szero d(i) = szero
end do end do
@ -1629,6 +1634,7 @@ subroutine psb_s_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1, m do i=1, m
do j = a%irp(i), a%irp(i+1) -1 do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) a%val(j) = a%val(j) * d(i)
@ -1643,6 +1649,7 @@ subroutine psb_s_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
j = a%ja(i) j = a%ja(i)
a%val(i) = a%val(i) * d(j) a%val(i) = a%val(i) * d(j)
@ -1681,6 +1688,7 @@ subroutine psb_s_csr_scals(d,a,info)
call a%make_nonunit() call a%make_nonunit()
end if end if
!$omp parallel do private(i)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d a%val(i) = a%val(i) * d
enddo enddo

6
base/serial/impl/psb_z_coo_impl.F90
Unescape Escape View File

@ -5286,7 +5286,7 @@ function psb_lz_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -5353,7 +5353,7 @@ function psb_lz_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -5403,7 +5403,7 @@ function psb_lz_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) reduction(max: res) !$omp parallel do private(i)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

12
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -1328,7 +1328,7 @@ function psb_z_csr_csnmi(a) result(res)
res = dzero res = dzero
if (a%is_dev()) call a%sync() if (a%is_dev()) call a%sync()
!$omp parallel do private(i,acc) reduction(max: res) !$omp parallel do private(i,j,acc) reduction(max: res)
do i = 1, a%get_nrows() do i = 1, a%get_nrows()
acc = dzero acc = dzero
do j=a%irp(i),a%irp(i+1)-1 do j=a%irp(i),a%irp(i+1)-1
@ -1562,8 +1562,12 @@ subroutine psb_z_csr_get_diag(a,d,info)
if (a%is_unit()) then if (a%is_unit()) then
d(1:mnm) = zone !$omp parallel do private(i)
do i=1, mnm
d(i) = zone
end do
else else
!$omp parallel do private(i,j,k)
do i=1, mnm do i=1, mnm
d(i) = zzero d(i) = zzero
do k=a%irp(i),a%irp(i+1)-1 do k=a%irp(i),a%irp(i+1)-1
@ -1574,6 +1578,7 @@ subroutine psb_z_csr_get_diag(a,d,info)
enddo enddo
end do end do
end if end if
!$omp parallel do private(i)
do i=mnm+1,size(d) do i=mnm+1,size(d)
d(i) = zzero d(i) = zzero
end do end do
@ -1629,6 +1634,7 @@ subroutine psb_z_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1, m do i=1, m
do j = a%irp(i), a%irp(i+1) -1 do j = a%irp(i), a%irp(i+1) -1
a%val(j) = a%val(j) * d(i) a%val(j) = a%val(j) * d(i)
@ -1643,6 +1649,7 @@ subroutine psb_z_csr_scal(d,a,info,side)
goto 9999 goto 9999
end if end if
!$omp parallel do private(i,j)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
j = a%ja(i) j = a%ja(i)
a%val(i) = a%val(i) * d(j) a%val(i) = a%val(i) * d(j)
@ -1681,6 +1688,7 @@ subroutine psb_z_csr_scals(d,a,info)
call a%make_nonunit() call a%make_nonunit()
end if end if
!$omp parallel do private(i)
do i=1,a%get_nzeros() do i=1,a%get_nzeros()
a%val(i) = a%val(i) * d a%val(i) = a%val(i) * d
enddo enddo

6
test/pargen/psb_d_pde3d.F90
Unescape Escape View File

@ -569,9 +569,8 @@ contains
call psb_cdasb(desc_a,info,mold=imold) call psb_cdasb(desc_a,info,mold=imold)
tcdasb = psb_wtime()-t1 tcdasb = psb_wtime()-t1
if (.false.) then
! !
! Add extra rows to test remote build. ! Add extra rows
! !
block block
integer(psb_ipk_) :: ks, i integer(psb_ipk_) :: ks, i
@ -674,7 +673,8 @@ contains
end do end do
end block end block
end if
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()

Write Preview
Loading…
Cancel
Save