diff --git a/base/modules/auxil/psb_c_realloc_mod.F90 b/base/modules/auxil/psb_c_realloc_mod.F90 index 938ef36f..504f19f7 100644 --- a/base/modules/auxil/psb_c_realloc_mod.F90 +++ b/base/modules/auxil/psb_c_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains complex(psb_spk_),allocatable :: tmp(:,:) 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 name='psb_r_m_c_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_d_realloc_mod.F90 b/base/modules/auxil/psb_d_realloc_mod.F90 index 868a6657..588a4e4d 100644 --- a/base/modules/auxil/psb_d_realloc_mod.F90 +++ b/base/modules/auxil/psb_d_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains real(psb_dpk_),allocatable :: tmp(:,:) 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 name='psb_r_m_d_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_e_realloc_mod.F90 b/base/modules/auxil/psb_e_realloc_mod.F90 index c5645bf0..87561777 100644 --- a/base/modules/auxil/psb_e_realloc_mod.F90 +++ b/base/modules/auxil/psb_e_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains integer(psb_epk_),allocatable :: tmp(:,:) 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 name='psb_r_m_e_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_i2_realloc_mod.F90 b/base/modules/auxil/psb_i2_realloc_mod.F90 index cbe0d130..b348d9c4 100644 --- a/base/modules/auxil/psb_i2_realloc_mod.F90 +++ b/base/modules/auxil/psb_i2_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains integer(psb_i2pk_),allocatable :: tmp(:,:) 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 name='psb_r_m_i2_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_m_realloc_mod.F90 b/base/modules/auxil/psb_m_realloc_mod.F90 index 973648d5..536ff219 100644 --- a/base/modules/auxil/psb_m_realloc_mod.F90 +++ b/base/modules/auxil/psb_m_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains integer(psb_mpk_),allocatable :: tmp(:,:) 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 name='psb_r_m_m_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_s_realloc_mod.F90 b/base/modules/auxil/psb_s_realloc_mod.F90 index 07a6bbbd..252a2b9c 100644 --- a/base/modules/auxil/psb_s_realloc_mod.F90 +++ b/base/modules/auxil/psb_s_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains real(psb_spk_),allocatable :: tmp(:,:) 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 name='psb_r_m_s_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/auxil/psb_z_realloc_mod.F90 b/base/modules/auxil/psb_z_realloc_mod.F90 index f6ae24b0..220637ff 100644 --- a/base/modules/auxil/psb_z_realloc_mod.F90 +++ b/base/modules/auxil/psb_z_realloc_mod.F90 @@ -131,7 +131,7 @@ Contains ! ...Local Variables 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 character(len=30) :: name logical, parameter :: debug=.false. @@ -179,7 +179,10 @@ Contains end if endif 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 call psb_erractionrestore(err_act) return @@ -204,7 +207,7 @@ Contains complex(psb_dpk_),allocatable :: tmp(:,:) 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 name='psb_r_m_z_rk2' @@ -267,8 +270,14 @@ Contains end if endif if (present(pad)) then - rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad - rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad + !$omp parallel do private(i) shared(lb1_,dim,len1) + 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 call psb_erractionrestore(err_act) return @@ -982,48 +991,7 @@ Contains goto 9999 end if -!!$ If (len > psb_size(v)) Then -!!$ if (present(newsz)) then -!!$ isz = (max(len+1,newsz)) -!!$ else -!!$ if (present(addsz)) then -!!$ isz = len+max(1,addsz) -!!$ else -!!$ isz = max(len+10, int(1.25*len)) -!!$ endif -!!$ endif -!!$ -!!$ call psb_realloc(isz,v,info,pad=pad) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_from_subroutine_ -!!$ call psb_errpush(info,name,a_err='psb_realloc') -!!$ goto 9999 -!!$ End If -!!$ end If 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 isz = (max(len+1,newsz)) else @@ -1040,7 +1008,6 @@ Contains call psb_errpush(info,name,a_err='psb_realloc') goto 9999 End If -#endif end If call psb_erractionrestore(err_act) diff --git a/base/modules/serial/psb_c_base_mat_mod.F90 b/base/modules/serial/psb_c_base_mat_mod.F90 index ab43f386..7a7bbb1f 100644 --- a/base/modules/serial/psb_c_base_mat_mod.F90 +++ b/base/modules/serial/psb_c_base_mat_mod.F90 @@ -1865,26 +1865,29 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(in), optional :: idir end subroutine psb_c_fix_coo_inner end interface - interface - subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_c_fix_coo_inner_colmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) complex(psb_spk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_fix_coo_inner_rowmajor + end subroutine psb_c_fix_coo_inner_colmajor end interface - interface - subroutine psb_c_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) complex(psb_spk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_fix_coo_inner_colmajor - + end subroutine psb_c_fix_coo_inner_rowmajor end interface ! diff --git a/base/modules/serial/psb_d_base_mat_mod.F90 b/base/modules/serial/psb_d_base_mat_mod.F90 index 48e9ec1e..eb49905d 100644 --- a/base/modules/serial/psb_d_base_mat_mod.F90 +++ b/base/modules/serial/psb_d_base_mat_mod.F90 @@ -1865,26 +1865,29 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(in), optional :: idir end subroutine psb_d_fix_coo_inner end interface - interface - subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_d_fix_coo_inner_colmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) real(psb_dpk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_fix_coo_inner_rowmajor + end subroutine psb_d_fix_coo_inner_colmajor end interface - interface - subroutine psb_d_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) real(psb_dpk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_fix_coo_inner_colmajor - + end subroutine psb_d_fix_coo_inner_rowmajor end interface ! diff --git a/base/modules/serial/psb_s_base_mat_mod.F90 b/base/modules/serial/psb_s_base_mat_mod.F90 index 62706c1c..79c8222b 100644 --- a/base/modules/serial/psb_s_base_mat_mod.F90 +++ b/base/modules/serial/psb_s_base_mat_mod.F90 @@ -1865,26 +1865,29 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(in), optional :: idir end subroutine psb_s_fix_coo_inner end interface - interface - subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_s_fix_coo_inner_colmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) real(psb_spk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_fix_coo_inner_rowmajor + end subroutine psb_s_fix_coo_inner_colmajor end interface - interface - subroutine psb_s_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) real(psb_spk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_fix_coo_inner_colmajor - + end subroutine psb_s_fix_coo_inner_rowmajor end interface ! diff --git a/base/modules/serial/psb_z_base_mat_mod.F90 b/base/modules/serial/psb_z_base_mat_mod.F90 index ea7e0de5..5b6ca07b 100644 --- a/base/modules/serial/psb_z_base_mat_mod.F90 +++ b/base/modules/serial/psb_z_base_mat_mod.F90 @@ -1865,26 +1865,29 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(in), optional :: idir end subroutine psb_z_fix_coo_inner end interface - interface - subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_z_fix_coo_inner_colmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) complex(psb_dpk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_fix_coo_inner_rowmajor + end subroutine psb_z_fix_coo_inner_colmajor end interface - interface - subroutine psb_z_fix_coo_inner_colmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,info) + + interface + subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,& + & ia,ja,val,iaux,nzout,info) import integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_ipk_), intent(inout) :: ia(:), ja(:), iaux(:) complex(psb_dpk_), intent(inout) :: val(:) integer(psb_ipk_), intent(out) :: nzout integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_fix_coo_inner_colmajor - + end subroutine psb_z_fix_coo_inner_rowmajor end interface ! diff --git a/base/serial/impl/psb_c_coo_impl.F90 b/base/serial/impl/psb_c_coo_impl.F90 index d159b6b2..1b0e3633 100644 --- a/base/serial/impl/psb_c_coo_impl.F90 +++ b/base/serial/impl/psb_c_coo_impl.F90 @@ -728,7 +728,7 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc) character(len=80) :: frmt 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 write(iout,'(a)') '%' write(iout,'(a,a)') '% COO' @@ -3172,9 +3172,9 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) integer(psb_ipk_) :: i !$omp parallel do private(i) do i=1, nz - a%ia(i) = b%ia(i) - a%ja(i) = b%ja(i) - a%val(i) = b%val(i) + a%ia(i) = b%ia(i) + a%ja(i) = b%ja(i) + a%val(i) = b%val(i) end do end block #else @@ -5268,13 +5268,13 @@ function psb_lc_coo_maxval(a) result(res) implicit none class(psb_lc_coo_sparse_mat), intent(in) :: a real(psb_spk_) :: res - + integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info character(len=20) :: name='c_coo_maxval' logical, parameter :: debug=.false. - + if (a%is_dev()) call a%sync() - + if (a%is_unit()) then res = sone else @@ -5284,18 +5284,18 @@ function psb_lc_coo_maxval(a) result(res) if (allocated(a%val)) then nnz = min(nnz,size(a%val)) #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, nnz - res = max(res,abs(a%val(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, nnz + res = max(res,abs(a%val(i))) + end do + end block #else res = maxval(abs(a%val(1:nnz))) #endif end if - + end function psb_lc_coo_maxval function psb_lc_coo_csnmi(a) result(res) @@ -5351,13 +5351,13 @@ function psb_lc_coo_csnmi(a) result(res) vt(i) = vt(i) + abs(a%val(j)) end do #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, m - res = max(res,abs(vt(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, m + res = max(res,abs(vt(i))) + end do + end block #else res = maxval(vt(1:m)) #endif @@ -5403,11 +5403,11 @@ function psb_lc_coo_csnm1(a) result(res) #if defined(OPENMP) block integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) + !$omp parallel do private(i) do i=1, n res = max(res,abs(vt(i))) end do - end block + end block #else res = maxval(vt(1:n)) #endif @@ -6856,7 +6856,7 @@ subroutine psb_lc_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) if (nz < 0) then 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 end if if (size(ia) < nz) then diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 88510e53..c8819ba3 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1328,8 +1328,8 @@ function psb_c_csr_csnmi(a) result(res) res = szero if (a%is_dev()) call a%sync() - !$omp parallel do private(i,acc) reduction(max: res) - do i = 1, a%get_nrows() + !$omp parallel do private(i,j,acc) reduction(max: res) + do i = 1, a%get_nrows() acc = szero do j=a%irp(i),a%irp(i+1)-1 acc = acc + abs(a%val(j)) @@ -1562,8 +1562,12 @@ subroutine psb_c_csr_get_diag(a,d,info) if (a%is_unit()) then - d(1:mnm) = cone + !$omp parallel do private(i) + do i=1, mnm + d(i) = cone + end do else + !$omp parallel do private(i,j,k) do i=1, mnm d(i) = czero do k=a%irp(i),a%irp(i+1)-1 @@ -1574,6 +1578,7 @@ subroutine psb_c_csr_get_diag(a,d,info) enddo end do end if + !$omp parallel do private(i) do i=mnm+1,size(d) d(i) = czero end do @@ -1629,6 +1634,7 @@ subroutine psb_c_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1, m do j = a%irp(i), a%irp(i+1) -1 a%val(j) = a%val(j) * d(i) @@ -1643,6 +1649,7 @@ subroutine psb_c_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1,a%get_nzeros() j = a%ja(i) a%val(i) = a%val(i) * d(j) @@ -1681,6 +1688,7 @@ subroutine psb_c_csr_scals(d,a,info) call a%make_nonunit() end if + !$omp parallel do private(i) do i=1,a%get_nzeros() a%val(i) = a%val(i) * d enddo diff --git a/base/serial/impl/psb_d_coo_impl.F90 b/base/serial/impl/psb_d_coo_impl.F90 index 9a4399cd..696e5220 100644 --- a/base/serial/impl/psb_d_coo_impl.F90 +++ b/base/serial/impl/psb_d_coo_impl.F90 @@ -728,7 +728,7 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc) character(len=80) :: frmt 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 write(iout,'(a)') '%' write(iout,'(a,a)') '% COO' @@ -3172,9 +3172,9 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) integer(psb_ipk_) :: i !$omp parallel do private(i) do i=1, nz - a%ia(i) = b%ia(i) - a%ja(i) = b%ja(i) - a%val(i) = b%val(i) + a%ia(i) = b%ia(i) + a%ja(i) = b%ja(i) + a%val(i) = b%val(i) end do end block #else @@ -5268,13 +5268,13 @@ function psb_ld_coo_maxval(a) result(res) implicit none class(psb_ld_coo_sparse_mat), intent(in) :: a real(psb_dpk_) :: res - + integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info character(len=20) :: name='d_coo_maxval' logical, parameter :: debug=.false. - + if (a%is_dev()) call a%sync() - + if (a%is_unit()) then res = done else @@ -5284,18 +5284,18 @@ function psb_ld_coo_maxval(a) result(res) if (allocated(a%val)) then nnz = min(nnz,size(a%val)) #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, nnz - res = max(res,abs(a%val(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, nnz + res = max(res,abs(a%val(i))) + end do + end block #else res = maxval(abs(a%val(1:nnz))) #endif end if - + end function psb_ld_coo_maxval function psb_ld_coo_csnmi(a) result(res) @@ -5351,13 +5351,13 @@ function psb_ld_coo_csnmi(a) result(res) vt(i) = vt(i) + abs(a%val(j)) end do #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, m - res = max(res,abs(vt(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, m + res = max(res,abs(vt(i))) + end do + end block #else res = maxval(vt(1:m)) #endif @@ -5403,11 +5403,11 @@ function psb_ld_coo_csnm1(a) result(res) #if defined(OPENMP) block integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) + !$omp parallel do private(i) do i=1, n res = max(res,abs(vt(i))) end do - end block + end block #else res = maxval(vt(1:n)) #endif @@ -6856,7 +6856,7 @@ subroutine psb_ld_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) if (nz < 0) then 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 end if if (size(ia) < nz) then diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index a927b1a9..70821a9e 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1328,8 +1328,8 @@ function psb_d_csr_csnmi(a) result(res) res = dzero if (a%is_dev()) call a%sync() - !$omp parallel do private(i,acc) reduction(max: res) - do i = 1, a%get_nrows() + !$omp parallel do private(i,j,acc) reduction(max: res) + do i = 1, a%get_nrows() acc = dzero do j=a%irp(i),a%irp(i+1)-1 acc = acc + abs(a%val(j)) @@ -1562,8 +1562,12 @@ subroutine psb_d_csr_get_diag(a,d,info) if (a%is_unit()) then - d(1:mnm) = done + !$omp parallel do private(i) + do i=1, mnm + d(i) = done + end do else + !$omp parallel do private(i,j,k) do i=1, mnm d(i) = dzero do k=a%irp(i),a%irp(i+1)-1 @@ -1574,6 +1578,7 @@ subroutine psb_d_csr_get_diag(a,d,info) enddo end do end if + !$omp parallel do private(i) do i=mnm+1,size(d) d(i) = dzero end do @@ -1629,6 +1634,7 @@ subroutine psb_d_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1, m do j = a%irp(i), a%irp(i+1) -1 a%val(j) = a%val(j) * d(i) @@ -1643,6 +1649,7 @@ subroutine psb_d_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1,a%get_nzeros() j = a%ja(i) a%val(i) = a%val(i) * d(j) @@ -1681,6 +1688,7 @@ subroutine psb_d_csr_scals(d,a,info) call a%make_nonunit() end if + !$omp parallel do private(i) do i=1,a%get_nzeros() a%val(i) = a%val(i) * d enddo diff --git a/base/serial/impl/psb_s_coo_impl.F90 b/base/serial/impl/psb_s_coo_impl.F90 index 464b0d97..20f8abfd 100644 --- a/base/serial/impl/psb_s_coo_impl.F90 +++ b/base/serial/impl/psb_s_coo_impl.F90 @@ -728,7 +728,7 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc) character(len=80) :: frmt 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 write(iout,'(a)') '%' write(iout,'(a,a)') '% COO' @@ -3172,9 +3172,9 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) integer(psb_ipk_) :: i !$omp parallel do private(i) do i=1, nz - a%ia(i) = b%ia(i) - a%ja(i) = b%ja(i) - a%val(i) = b%val(i) + a%ia(i) = b%ia(i) + a%ja(i) = b%ja(i) + a%val(i) = b%val(i) end do end block #else @@ -5268,13 +5268,13 @@ function psb_ls_coo_maxval(a) result(res) implicit none class(psb_ls_coo_sparse_mat), intent(in) :: a real(psb_spk_) :: res - + integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info character(len=20) :: name='s_coo_maxval' logical, parameter :: debug=.false. - + if (a%is_dev()) call a%sync() - + if (a%is_unit()) then res = sone else @@ -5284,18 +5284,18 @@ function psb_ls_coo_maxval(a) result(res) if (allocated(a%val)) then nnz = min(nnz,size(a%val)) #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, nnz - res = max(res,abs(a%val(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, nnz + res = max(res,abs(a%val(i))) + end do + end block #else res = maxval(abs(a%val(1:nnz))) #endif end if - + end function psb_ls_coo_maxval function psb_ls_coo_csnmi(a) result(res) @@ -5351,13 +5351,13 @@ function psb_ls_coo_csnmi(a) result(res) vt(i) = vt(i) + abs(a%val(j)) end do #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, m - res = max(res,abs(vt(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, m + res = max(res,abs(vt(i))) + end do + end block #else res = maxval(vt(1:m)) #endif @@ -5403,11 +5403,11 @@ function psb_ls_coo_csnm1(a) result(res) #if defined(OPENMP) block integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) + !$omp parallel do private(i) do i=1, n res = max(res,abs(vt(i))) end do - end block + end block #else res = maxval(vt(1:n)) #endif @@ -6856,7 +6856,7 @@ subroutine psb_ls_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) if (nz < 0) then 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 end if if (size(ia) < nz) then diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index b2d9dd48..65713f7b 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1328,8 +1328,8 @@ function psb_s_csr_csnmi(a) result(res) res = szero if (a%is_dev()) call a%sync() - !$omp parallel do private(i,acc) reduction(max: res) - do i = 1, a%get_nrows() + !$omp parallel do private(i,j,acc) reduction(max: res) + do i = 1, a%get_nrows() acc = szero do j=a%irp(i),a%irp(i+1)-1 acc = acc + abs(a%val(j)) @@ -1562,8 +1562,12 @@ subroutine psb_s_csr_get_diag(a,d,info) if (a%is_unit()) then - d(1:mnm) = sone + !$omp parallel do private(i) + do i=1, mnm + d(i) = sone + end do else + !$omp parallel do private(i,j,k) do i=1, mnm d(i) = szero do k=a%irp(i),a%irp(i+1)-1 @@ -1574,6 +1578,7 @@ subroutine psb_s_csr_get_diag(a,d,info) enddo end do end if + !$omp parallel do private(i) do i=mnm+1,size(d) d(i) = szero end do @@ -1629,6 +1634,7 @@ subroutine psb_s_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1, m do j = a%irp(i), a%irp(i+1) -1 a%val(j) = a%val(j) * d(i) @@ -1643,6 +1649,7 @@ subroutine psb_s_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1,a%get_nzeros() j = a%ja(i) a%val(i) = a%val(i) * d(j) @@ -1681,6 +1688,7 @@ subroutine psb_s_csr_scals(d,a,info) call a%make_nonunit() end if + !$omp parallel do private(i) do i=1,a%get_nzeros() a%val(i) = a%val(i) * d enddo diff --git a/base/serial/impl/psb_z_coo_impl.F90 b/base/serial/impl/psb_z_coo_impl.F90 index f86ff27a..b93c1ca9 100644 --- a/base/serial/impl/psb_z_coo_impl.F90 +++ b/base/serial/impl/psb_z_coo_impl.F90 @@ -728,7 +728,7 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc) character(len=80) :: frmt 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 write(iout,'(a)') '%' write(iout,'(a,a)') '% COO' @@ -3172,9 +3172,9 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) integer(psb_ipk_) :: i !$omp parallel do private(i) do i=1, nz - a%ia(i) = b%ia(i) - a%ja(i) = b%ja(i) - a%val(i) = b%val(i) + a%ia(i) = b%ia(i) + a%ja(i) = b%ja(i) + a%val(i) = b%val(i) end do end block #else @@ -5268,13 +5268,13 @@ function psb_lz_coo_maxval(a) result(res) implicit none class(psb_lz_coo_sparse_mat), intent(in) :: a real(psb_dpk_) :: res - + integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info character(len=20) :: name='z_coo_maxval' logical, parameter :: debug=.false. - + if (a%is_dev()) call a%sync() - + if (a%is_unit()) then res = done else @@ -5284,18 +5284,18 @@ function psb_lz_coo_maxval(a) result(res) if (allocated(a%val)) then nnz = min(nnz,size(a%val)) #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, nnz - res = max(res,abs(a%val(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, nnz + res = max(res,abs(a%val(i))) + end do + end block #else res = maxval(abs(a%val(1:nnz))) #endif end if - + end function psb_lz_coo_maxval function psb_lz_coo_csnmi(a) result(res) @@ -5351,13 +5351,13 @@ function psb_lz_coo_csnmi(a) result(res) vt(i) = vt(i) + abs(a%val(j)) end do #if defined(OPENMP) - block - integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) - do i=1, m - res = max(res,abs(vt(i))) - end do - end block + block + integer(psb_ipk_) :: i + !$omp parallel do private(i) + do i=1, m + res = max(res,abs(vt(i))) + end do + end block #else res = maxval(vt(1:m)) #endif @@ -5403,11 +5403,11 @@ function psb_lz_coo_csnm1(a) result(res) #if defined(OPENMP) block integer(psb_ipk_) :: i - !$omp parallel do private(i) reduction(max: res) + !$omp parallel do private(i) do i=1, n res = max(res,abs(vt(i))) end do - end block + end block #else res = maxval(vt(1:n)) #endif @@ -6856,7 +6856,7 @@ subroutine psb_lz_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) if (nz < 0) then 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 end if if (size(ia) < nz) then diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index ba2d322f..a7f41138 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1328,8 +1328,8 @@ function psb_z_csr_csnmi(a) result(res) res = dzero if (a%is_dev()) call a%sync() - !$omp parallel do private(i,acc) reduction(max: res) - do i = 1, a%get_nrows() + !$omp parallel do private(i,j,acc) reduction(max: res) + do i = 1, a%get_nrows() acc = dzero do j=a%irp(i),a%irp(i+1)-1 acc = acc + abs(a%val(j)) @@ -1562,8 +1562,12 @@ subroutine psb_z_csr_get_diag(a,d,info) if (a%is_unit()) then - d(1:mnm) = zone + !$omp parallel do private(i) + do i=1, mnm + d(i) = zone + end do else + !$omp parallel do private(i,j,k) do i=1, mnm d(i) = zzero do k=a%irp(i),a%irp(i+1)-1 @@ -1574,6 +1578,7 @@ subroutine psb_z_csr_get_diag(a,d,info) enddo end do end if + !$omp parallel do private(i) do i=mnm+1,size(d) d(i) = zzero end do @@ -1629,6 +1634,7 @@ subroutine psb_z_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1, m do j = a%irp(i), a%irp(i+1) -1 a%val(j) = a%val(j) * d(i) @@ -1643,6 +1649,7 @@ subroutine psb_z_csr_scal(d,a,info,side) goto 9999 end if + !$omp parallel do private(i,j) do i=1,a%get_nzeros() j = a%ja(i) a%val(i) = a%val(i) * d(j) @@ -1681,6 +1688,7 @@ subroutine psb_z_csr_scals(d,a,info) call a%make_nonunit() end if + !$omp parallel do private(i) do i=1,a%get_nzeros() a%val(i) = a%val(i) * d enddo diff --git a/test/pargen/psb_d_pde3d.F90 b/test/pargen/psb_d_pde3d.F90 index 7f68dbc6..887c08d9 100644 --- a/test/pargen/psb_d_pde3d.F90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -569,112 +569,112 @@ contains call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - if (.false.) then - ! - ! Add extra rows to test remote build. - ! - block - integer(psb_ipk_) :: ks, i - ks = desc_a%get_local_cols()-desc_a%get_local_rows() - if (ks > 0) ks = max(1,ks / 10) - mysz = nlr+ks - call psb_realloc(mysz,myidx,info) - do i=nlr+1, mysz - myidx(i) = i - end do - call desc_a%l2gv1(myidx(nlr+1:mysz),info) - !write(0,*) iam,' Check on extra nodes ',nlr,mysz,':',myidx(nlr+1:mysz) - do ii= nlr+1, mysz, nb - ib = min(nb,mysz-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) - ! x, y, z coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - z = (iz-1)*deltah - zt(k) = f_(x,y,z) - ! internal point: build discretization - ! - ! term depending on (x-1,y,z) - ! - val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 - if (ix == 1) then - zt(k) = g(dzero,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 - ! 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) + ! + ! Add extra rows + ! + block + integer(psb_ipk_) :: ks, i + ks = desc_a%get_local_cols()-desc_a%get_local_rows() + if (ks > 0) ks = max(1,ks / 10) + mysz = nlr+ks + call psb_realloc(mysz,myidx,info) + do i=nlr+1, mysz + myidx(i) = i + end do + call desc_a%l2gv1(myidx(nlr+1:mysz),info) + !write(0,*) iam,' Check on extra nodes ',nlr,mysz,':',myidx(nlr+1:mysz) + do ii= nlr+1, mysz, nb + ib = min(nb,mysz-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + z = (iz-1)*deltah + zt(k) = f_(x,y,z) + ! internal point: build discretization + ! + ! term depending on (x-1,y,z) + ! + val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 + if (ix == 1) then + zt(k) = g(dzero,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 - ! 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 + 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 + icoeff = icoeff+1 + ! 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 + 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) t1 = psb_wtime()