diff --git a/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 index 81047953..4041ebe5 100644 --- a/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_c_soc1_map_bld.F90 @@ -500,6 +500,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in endif end if end do + !$omp end parallel do + if (info /= 0) goto 9999 if (do_timings) call psb_toc(idx_soc1_p3) if (naggr > ncol) then info=psb_err_internal_error_ diff --git a/amgprec/impl/aggregator/amg_c_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_c_soc2_map_bld.F90 index 3bda8e90..b250e434 100644 --- a/amgprec/impl/aggregator/amg_c_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_c_soc2_map_bld.F90 @@ -406,11 +406,16 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in write(debug_unit,*) me,' ',trim(name),& & ' Check 1:',count(ilaggr == -(nr+1)) end if - + if (do_timings) call psb_toc(idx_soc2_p1) + if (do_timings) call psb_tic(idx_soc2_p2) ! ! Phase two: join the neighbours ! + !$omp workshare tmpaggr = ilaggr + !$omp end workshare + !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& + !$omp private(ii,i,j,k,nz,icol,val,ip,cpling) step2: do ii=1,nr i = idxs(ii) @@ -436,8 +441,9 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end if end if end do step2 - - + !$omp end parallel do + if (do_timings) call psb_toc(idx_soc2_p2) + if (do_timings) call psb_tic(idx_soc2_p3) ! ! Phase three: sweep over leftovers, if any ! @@ -471,6 +477,8 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end do step3 ! Any leftovers? + !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& + !$omp private(ii,i,j,k) do i=1, nr if (ilaggr(i) <= 0) then nz = (s_neigh%irp(i+1)-s_neigh%irp(i)) @@ -482,13 +490,17 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in ! other processes. ilaggr(i) = -(nrglob+nr) else + !$omp atomic write info=psb_err_internal_error_ + !$omp end atomic call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers') - goto 9999 + cycle endif end if end do - + !$omp end parallel do + if (info /= 0) goto 9999 + if (do_timings) call psb_toc(idx_soc2_p3) if (naggr > ncol) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Fatal error: naggr>ncol') diff --git a/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 index c83dfe3b..de95abce 100644 --- a/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_d_soc1_map_bld.F90 @@ -500,6 +500,8 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in endif end if end do + !$omp end parallel do + if (info /= 0) goto 9999 if (do_timings) call psb_toc(idx_soc1_p3) if (naggr > ncol) then info=psb_err_internal_error_ diff --git a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 index b4602378..345cd1ad 100644 --- a/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_d_soc2_map_bld.F90 @@ -406,11 +406,16 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in write(debug_unit,*) me,' ',trim(name),& & ' Check 1:',count(ilaggr == -(nr+1)) end if - + if (do_timings) call psb_toc(idx_soc2_p1) + if (do_timings) call psb_tic(idx_soc2_p2) ! ! Phase two: join the neighbours ! + !$omp workshare tmpaggr = ilaggr + !$omp end workshare + !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& + !$omp private(ii,i,j,k,nz,icol,val,ip,cpling) step2: do ii=1,nr i = idxs(ii) @@ -436,8 +441,9 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end if end if end do step2 - - + !$omp end parallel do + if (do_timings) call psb_toc(idx_soc2_p2) + if (do_timings) call psb_tic(idx_soc2_p3) ! ! Phase three: sweep over leftovers, if any ! @@ -471,6 +477,8 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end do step3 ! Any leftovers? + !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& + !$omp private(ii,i,j,k) do i=1, nr if (ilaggr(i) <= 0) then nz = (s_neigh%irp(i+1)-s_neigh%irp(i)) @@ -482,13 +490,17 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in ! other processes. ilaggr(i) = -(nrglob+nr) else + !$omp atomic write info=psb_err_internal_error_ + !$omp end atomic call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers') - goto 9999 + cycle endif end if end do - + !$omp end parallel do + if (info /= 0) goto 9999 + if (do_timings) call psb_toc(idx_soc2_p3) if (naggr > ncol) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Fatal error: naggr>ncol') diff --git a/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 index 59a7c03b..0a809624 100644 --- a/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_s_soc1_map_bld.F90 @@ -500,6 +500,8 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in endif end if end do + !$omp end parallel do + if (info /= 0) goto 9999 if (do_timings) call psb_toc(idx_soc1_p3) if (naggr > ncol) then info=psb_err_internal_error_ diff --git a/amgprec/impl/aggregator/amg_s_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_s_soc2_map_bld.F90 index 8dac2dd5..ef7f5707 100644 --- a/amgprec/impl/aggregator/amg_s_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_s_soc2_map_bld.F90 @@ -406,11 +406,16 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in write(debug_unit,*) me,' ',trim(name),& & ' Check 1:',count(ilaggr == -(nr+1)) end if - + if (do_timings) call psb_toc(idx_soc2_p1) + if (do_timings) call psb_tic(idx_soc2_p2) ! ! Phase two: join the neighbours ! + !$omp workshare tmpaggr = ilaggr + !$omp end workshare + !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& + !$omp private(ii,i,j,k,nz,icol,val,ip,cpling) step2: do ii=1,nr i = idxs(ii) @@ -436,8 +441,9 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end if end if end do step2 - - + !$omp end parallel do + if (do_timings) call psb_toc(idx_soc2_p2) + if (do_timings) call psb_tic(idx_soc2_p3) ! ! Phase three: sweep over leftovers, if any ! @@ -471,6 +477,8 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end do step3 ! Any leftovers? + !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& + !$omp private(ii,i,j,k) do i=1, nr if (ilaggr(i) <= 0) then nz = (s_neigh%irp(i+1)-s_neigh%irp(i)) @@ -482,13 +490,17 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in ! other processes. ilaggr(i) = -(nrglob+nr) else + !$omp atomic write info=psb_err_internal_error_ + !$omp end atomic call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers') - goto 9999 + cycle endif end if end do - + !$omp end parallel do + if (info /= 0) goto 9999 + if (do_timings) call psb_toc(idx_soc2_p3) if (naggr > ncol) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Fatal error: naggr>ncol') diff --git a/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 b/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 index 66c8e4e2..2c467426 100644 --- a/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_z_soc1_map_bld.F90 @@ -500,6 +500,8 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in endif end if end do + !$omp end parallel do + if (info /= 0) goto 9999 if (do_timings) call psb_toc(idx_soc1_p3) if (naggr > ncol) then info=psb_err_internal_error_ diff --git a/amgprec/impl/aggregator/amg_z_soc2_map_bld.F90 b/amgprec/impl/aggregator/amg_z_soc2_map_bld.F90 index 19956309..c6ac226e 100644 --- a/amgprec/impl/aggregator/amg_z_soc2_map_bld.F90 +++ b/amgprec/impl/aggregator/amg_z_soc2_map_bld.F90 @@ -406,11 +406,16 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in write(debug_unit,*) me,' ',trim(name),& & ' Check 1:',count(ilaggr == -(nr+1)) end if - + if (do_timings) call psb_toc(idx_soc2_p1) + if (do_timings) call psb_tic(idx_soc2_p2) ! ! Phase two: join the neighbours ! + !$omp workshare tmpaggr = ilaggr + !$omp end workshare + !$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,muij,s_neigh)& + !$omp private(ii,i,j,k,nz,icol,val,ip,cpling) step2: do ii=1,nr i = idxs(ii) @@ -436,8 +441,9 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end if end if end do step2 - - + !$omp end parallel do + if (do_timings) call psb_toc(idx_soc2_p2) + if (do_timings) call psb_tic(idx_soc2_p3) ! ! Phase three: sweep over leftovers, if any ! @@ -471,6 +477,8 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in end do step3 ! Any leftovers? + !$omp parallel do schedule(static) shared(ilaggr,s_neigh,info)& + !$omp private(ii,i,j,k) do i=1, nr if (ilaggr(i) <= 0) then nz = (s_neigh%irp(i+1)-s_neigh%irp(i)) @@ -482,13 +490,17 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in ! other processes. ilaggr(i) = -(nrglob+nr) else + !$omp atomic write info=psb_err_internal_error_ + !$omp end atomic call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers') - goto 9999 + cycle endif end if end do - + !$omp end parallel do + if (info /= 0) goto 9999 + if (do_timings) call psb_toc(idx_soc2_p3) if (naggr > ncol) then info=psb_err_internal_error_ call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')