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
! !

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

@ -728,7 +728,7 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc)
character(len=80) :: frmt character(len=80) :: frmt
integer(psb_ipk_) :: i,j, ni, nr, nc, nz integer(psb_ipk_) :: i,j, ni, nr, nc, nz
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
if (present(head)) write(iout,'(a,a)') '% ',head if (present(head)) write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% COO' write(iout,'(a,a)') '% COO'
@ -3172,9 +3172,9 @@ subroutine psb_c_cp_coo_from_coo(a,b,info)
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1, nz do i=1, nz
a%ia(i) = b%ia(i) a%ia(i) = b%ia(i)
a%ja(i) = b%ja(i) a%ja(i) = b%ja(i)
a%val(i) = b%val(i) a%val(i) = b%val(i)
end do end do
end block end block
#else #else
@ -5284,13 +5284,13 @@ function psb_lc_coo_maxval(a) result(res)
if (allocated(a%val)) then if (allocated(a%val)) then
nnz = min(nnz,size(a%val)) nnz = min(nnz,size(a%val))
#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
end block end block
#else #else
res = maxval(abs(a%val(1:nnz))) res = maxval(abs(a%val(1:nnz)))
#endif #endif
@ -5351,13 +5351,13 @@ function psb_lc_coo_csnmi(a) result(res)
vt(i) = vt(i) + abs(a%val(j)) vt(i) = vt(i) + abs(a%val(j))
end do end do
#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
end block end block
#else #else
res = maxval(vt(1:m)) res = maxval(vt(1:m))
#endif #endif
@ -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
@ -6856,7 +6856,7 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
if (nz < 0) then if (nz < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/)) 3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/))
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then

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

@ -1328,8 +1328,8 @@ 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
acc = acc + abs(a%val(j)) acc = acc + abs(a%val(j))
@ -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

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

@ -728,7 +728,7 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc)
character(len=80) :: frmt character(len=80) :: frmt
integer(psb_ipk_) :: i,j, ni, nr, nc, nz integer(psb_ipk_) :: i,j, ni, nr, nc, nz
write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' write(iout,'(a)') '%%MatrixMarket matrix coordinate real general'
if (present(head)) write(iout,'(a,a)') '% ',head if (present(head)) write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% COO' write(iout,'(a,a)') '% COO'
@ -3172,9 +3172,9 @@ subroutine psb_d_cp_coo_from_coo(a,b,info)
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1, nz do i=1, nz
a%ia(i) = b%ia(i) a%ia(i) = b%ia(i)
a%ja(i) = b%ja(i) a%ja(i) = b%ja(i)
a%val(i) = b%val(i) a%val(i) = b%val(i)
end do end do
end block end block
#else #else
@ -5284,13 +5284,13 @@ function psb_ld_coo_maxval(a) result(res)
if (allocated(a%val)) then if (allocated(a%val)) then
nnz = min(nnz,size(a%val)) nnz = min(nnz,size(a%val))
#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
end block end block
#else #else
res = maxval(abs(a%val(1:nnz))) res = maxval(abs(a%val(1:nnz)))
#endif #endif
@ -5351,13 +5351,13 @@ function psb_ld_coo_csnmi(a) result(res)
vt(i) = vt(i) + abs(a%val(j)) vt(i) = vt(i) + abs(a%val(j))
end do end do
#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
end block end block
#else #else
res = maxval(vt(1:m)) res = maxval(vt(1:m))
#endif #endif
@ -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
@ -6856,7 +6856,7 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
if (nz < 0) then if (nz < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/)) 3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/))
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then

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

@ -1328,8 +1328,8 @@ 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
acc = acc + abs(a%val(j)) acc = acc + abs(a%val(j))
@ -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

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

@ -728,7 +728,7 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc)
character(len=80) :: frmt character(len=80) :: frmt
integer(psb_ipk_) :: i,j, ni, nr, nc, nz integer(psb_ipk_) :: i,j, ni, nr, nc, nz
write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' write(iout,'(a)') '%%MatrixMarket matrix coordinate real general'
if (present(head)) write(iout,'(a,a)') '% ',head if (present(head)) write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% COO' write(iout,'(a,a)') '% COO'
@ -3172,9 +3172,9 @@ subroutine psb_s_cp_coo_from_coo(a,b,info)
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1, nz do i=1, nz
a%ia(i) = b%ia(i) a%ia(i) = b%ia(i)
a%ja(i) = b%ja(i) a%ja(i) = b%ja(i)
a%val(i) = b%val(i) a%val(i) = b%val(i)
end do end do
end block end block
#else #else
@ -5284,13 +5284,13 @@ function psb_ls_coo_maxval(a) result(res)
if (allocated(a%val)) then if (allocated(a%val)) then
nnz = min(nnz,size(a%val)) nnz = min(nnz,size(a%val))
#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
end block end block
#else #else
res = maxval(abs(a%val(1:nnz))) res = maxval(abs(a%val(1:nnz)))
#endif #endif
@ -5351,13 +5351,13 @@ function psb_ls_coo_csnmi(a) result(res)
vt(i) = vt(i) + abs(a%val(j)) vt(i) = vt(i) + abs(a%val(j))
end do end do
#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
end block end block
#else #else
res = maxval(vt(1:m)) res = maxval(vt(1:m))
#endif #endif
@ -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
@ -6856,7 +6856,7 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
if (nz < 0) then if (nz < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/)) 3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/))
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then

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

@ -1328,8 +1328,8 @@ 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
acc = acc + abs(a%val(j)) acc = acc + abs(a%val(j))
@ -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

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

@ -728,7 +728,7 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc)
character(len=80) :: frmt character(len=80) :: frmt
integer(psb_ipk_) :: i,j, ni, nr, nc, nz integer(psb_ipk_) :: i,j, ni, nr, nc, nz
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
if (present(head)) write(iout,'(a,a)') '% ',head if (present(head)) write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% COO' write(iout,'(a,a)') '% COO'
@ -3172,9 +3172,9 @@ subroutine psb_z_cp_coo_from_coo(a,b,info)
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i)
do i=1, nz do i=1, nz
a%ia(i) = b%ia(i) a%ia(i) = b%ia(i)
a%ja(i) = b%ja(i) a%ja(i) = b%ja(i)
a%val(i) = b%val(i) a%val(i) = b%val(i)
end do end do
end block end block
#else #else
@ -5284,13 +5284,13 @@ function psb_lz_coo_maxval(a) result(res)
if (allocated(a%val)) then if (allocated(a%val)) then
nnz = min(nnz,size(a%val)) nnz = min(nnz,size(a%val))
#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
end block end block
#else #else
res = maxval(abs(a%val(1:nnz))) res = maxval(abs(a%val(1:nnz)))
#endif #endif
@ -5351,13 +5351,13 @@ function psb_lz_coo_csnmi(a) result(res)
vt(i) = vt(i) + abs(a%val(j)) vt(i) = vt(i) + abs(a%val(j))
end do end do
#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
end block end block
#else #else
res = maxval(vt(1:m)) res = maxval(vt(1:m))
#endif #endif
@ -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
@ -6856,7 +6856,7 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
if (nz < 0) then if (nz < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/)) 3 call psb_errpush(info,name,i_err=(/1_psb_ipk_/))
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then

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

@ -1328,8 +1328,8 @@ 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
acc = acc + abs(a%val(j)) acc = acc + abs(a%val(j))
@ -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

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

@ -569,112 +569,112 @@ 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
! Add extra rows to test remote build. !
! block
block integer(psb_ipk_) :: ks, i
integer(psb_ipk_) :: ks, i ks = desc_a%get_local_cols()-desc_a%get_local_rows()
ks = desc_a%get_local_cols()-desc_a%get_local_rows() if (ks > 0) ks = max(1,ks / 10)
if (ks > 0) ks = max(1,ks / 10) mysz = nlr+ks
mysz = nlr+ks call psb_realloc(mysz,myidx,info)
call psb_realloc(mysz,myidx,info) do i=nlr+1, mysz
do i=nlr+1, mysz myidx(i) = i
myidx(i) = i end do
end do call desc_a%l2gv1(myidx(nlr+1:mysz),info)
call desc_a%l2gv1(myidx(nlr+1:mysz),info) !write(0,*) iam,' Check on extra nodes ',nlr,mysz,':',myidx(nlr+1:mysz)
!write(0,*) iam,' Check on extra nodes ',nlr,mysz,':',myidx(nlr+1:mysz) do ii= nlr+1, mysz, nb
do ii= nlr+1, mysz, nb ib = min(nb,mysz-ii+1)
ib = min(nb,mysz-ii+1) icoeff = 1
icoeff = 1 do k=1,ib
do k=1,ib i=ii+k-1
i=ii+k-1 ! local matrix pointer
! local matrix pointer glob_row=myidx(i)
glob_row=myidx(i) ! compute gridpoint coordinates
! compute gridpoint coordinates call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) ! x, y, z coordinates
! x, y, z coordinates x = (ix-1)*deltah
x = (ix-1)*deltah y = (iy-1)*deltah
y = (iy-1)*deltah z = (iz-1)*deltah
z = (iz-1)*deltah zt(k) = f_(x,y,z)
zt(k) = f_(x,y,z) ! internal point: build discretization
! internal point: build discretization !
! ! term depending on (x-1,y,z)
! term depending on (x-1,y,z) !
! val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 if (ix == 1) then
if (ix == 1) then zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k)
zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) else
else call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1,z)
val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
if (iy == 1) then
zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z-1)
val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
if (iz == 1) then
zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z)
val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
& + c(x,y,z)
call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row irow(icoeff) = glob_row
icoeff = icoeff+1 icoeff = icoeff+1
! term depending on (x,y,z+1) endif
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 ! term depending on (x,y-1,z)
if (iz == idim) then val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) if (iy == 1) then
else zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k)
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) else
irow(icoeff) = glob_row call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
icoeff = icoeff+1 irow(icoeff) = glob_row
endif icoeff = icoeff+1
! term depending on (x,y+1,z) endif
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 ! term depending on (x,y,z-1)
if (iy == idim) then val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) if (iz == 1) then
else zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k)
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) else
irow(icoeff) = glob_row call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
icoeff = icoeff+1 irow(icoeff) = glob_row
endif icoeff = icoeff+1
! term depending on (x+1,y,z) endif
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then ! term depending on (x,y,z)
zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
else & + c(x,y,z)
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row irow(icoeff) = glob_row
icoeff = icoeff+1 icoeff = icoeff+1
endif ! term depending on (x,y,z+1)
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
if (iz == idim) then
zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y+1,z)
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
if (iy == idim) then
zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y,z)
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then
zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
end do end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
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