From eb03797ad592ee3d799a0f8321f5580d92e89478 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 12 Jun 2020 19:55:59 +0200 Subject: [PATCH 1/5] Better error messages from MAP%APPLY --- base/tools/psb_c_map.f90 | 5 ++--- base/tools/psb_d_map.f90 | 5 ++--- base/tools/psb_s_map.f90 | 5 ++--- base/tools/psb_z_map.f90 | 5 ++--- 4 files changed, 8 insertions(+), 12 deletions(-) diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index 6324b944..83a54d32 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -159,7 +159,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 3046482e..51672121 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -159,7 +159,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 1d10b879..6fa9b7b7 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -159,7 +159,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 6b07401f..86858c60 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -159,7 +159,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then From 46736f9d39b6f54cf77b9a91bc917008e4a8370a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 12 Jun 2020 19:56:13 +0200 Subject: [PATCH 2/5] Fix type handling bug in simple_triad --- base/modules/penv/psi_c_collective_mod.F90 | 2 +- base/modules/penv/psi_e_collective_mod.F90 | 2 +- base/modules/penv/psi_i2_collective_mod.F90 | 2 +- base/modules/penv/psi_m_collective_mod.F90 | 2 +- base/modules/penv/psi_s_collective_mod.F90 | 2 +- base/modules/penv/psi_z_collective_mod.F90 | 2 +- base/tools/psb_csphalo.F90 | 2 +- base/tools/psb_dsphalo.F90 | 2 +- base/tools/psb_ssphalo.F90 | 2 +- base/tools/psb_zsphalo.F90 | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index de836d38..a1fa78a3 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_complex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 4c3a006e..443f5f99 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int8_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 911ed938..31a245b6 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int2_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 206b15fa..8badcf87 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int4_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index eda86961..e4fb9d06 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -1539,7 +1539,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_real_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index a517cb03..8a58ffb5 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index 668f7d52..79b2b5b7 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_lc_csr_sphalo' + name='psb_c_lc_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 8d800f6d..24949cff 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_ld_csr_sphalo' + name='psb_d_ld_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 038e72a5..f8958a45 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_ls_csr_sphalo' + name='psb_s_ls_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 0e32938b..a862ce99 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_lz_csr_sphalo' + name='psb_z_lz_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 From e3649e1cb6ebe7ae9ac0ab5ae2db22718c515a98 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 17 Jun 2020 11:54:43 +0200 Subject: [PATCH 3/5] Do not use sorting on dependency lists unless dlavg<16 --- base/internals/psi_crea_index.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 2b0a8321..69b58ac1 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -189,7 +189,9 @@ contains logical :: val val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) + val = (dlavg<16) !val = .true. + !val = .false. end function choose_sorting end subroutine psi_i_crea_index From 7df7b6ffcecd33eae17f14faba935b4b1ec3fa15 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 23 Jun 2020 11:28:37 +0200 Subject: [PATCH 4/5] Set adjacncy list during build of halo_index for all maps. --- base/internals/psi_bld_tmphalo.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index f7143f18..dc13b7c2 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -104,6 +104,7 @@ subroutine psi_bld_tmphalo(desc,info) call desc%indxmap%l2gip(helem(1:nh),info) if (info == psb_success_) call desc%indxmap%fnd_owner(helem(1:nh),hproc,info) if (info == psb_success_) call desc%indxmap%set_halo_owner(hproc,info) + if (info == psb_success_) call desc%indxmap%xtnd_p_adjcncy(hproc) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner') From 64e4c194fdd74cbfba577797295ee582b41b3f5a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 26 Jun 2020 14:33:35 +0200 Subject: [PATCH 5/5] Enable VECT objects in MMIO read/write. --- base/internals/psi_crea_index.f90 | 42 +- docs/html/userhtmlsu81.html | 17 +- docs/html/userhtmlsu82.html | 12 +- docs/html/userhtmlsu83.html | 33 +- docs/html/userhtmlsu90.html | 4 - docs/psblas-3.7.pdf | 1997 +++++++++++++++-------------- docs/src/util.tex | 16 +- util/psb_c_mmio_impl.f90 | 33 + util/psb_d_mmio_impl.f90 | 33 + util/psb_i_mmio_impl.F90 | 66 + util/psb_mmio_mod.F90 | 104 ++ util/psb_s_mmio_impl.f90 | 32 + util/psb_z_mmio_impl.f90 | 33 + 13 files changed, 1423 insertions(+), 999 deletions(-) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 69b58ac1..68bcbd20 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -71,9 +71,9 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1 integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.false., shuffle_dep_list=.false. integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 - integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 + integer(psb_ipk_), save :: idx_phase21=-1, idx_phase22=-1, idx_phase13=-1 info = psb_success_ name='psi_crea_index' @@ -95,10 +95,10 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) & idx_phase2 = psb_get_timer_idx("PSI_CREA_INDEX: phase2") if ((do_timings).and.(idx_phase3==-1)) & & idx_phase3 = psb_get_timer_idx("PSI_CREA_INDEX: phase3") -!!$ if ((do_timings).and.(idx_phase11==-1)) & -!!$ & idx_phase11 = psb_get_timer_idx("PSI_CREA_INDEX: phase11 ") -!!$ if ((do_timings).and.(idx_phase12==-1)) & -!!$ & idx_phase12 = psb_get_timer_idx("PSI_CREA_INDEX: phase12") + if ((do_timings).and.(idx_phase21==-1)) & + & idx_phase21 = psb_get_timer_idx("PSI_CREA_INDEX: phase21 ") + if ((do_timings).and.(idx_phase22==-1)) & + & idx_phase22 = psb_get_timer_idx("PSI_CREA_INDEX: phase22") !!$ if ((do_timings).and.(idx_phase13==-1)) & !!$ & idx_phase13 = psb_get_timer_idx("PSI_CREA_INDEX: phase13") @@ -123,6 +123,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (do_timings) call psb_tic(idx_phase2) if (choose_sorting(dlmax,dlavg,np)) then + if (do_timings) call psb_tic(idx_phase21) call psi_bld_glb_dep_list(ictxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) if (info /= 0) then @@ -131,13 +132,15 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) !!$ call psi_dl_check(dep_list,dl_lda,np,length_dl) !!$ !!$ ! ....now i can sort dependency lists. + if (do_timings) call psb_toc(idx_phase21) + if (do_timings) call psb_tic(idx_phase22) call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ictxt,info) if (info /= 0) then write(0,*) me,trim(name),' From sort_dl ',info end if ldl = length_dl(me) loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1) - + if (do_timings) call psb_toc(idx_phase22) !!$ if(info /= psb_success_) then !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_sort_dl') !!$ goto 9999 @@ -146,7 +149,26 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) else ! Do nothing ldl = length_dl(me) - loc_dl = loc_dl(1:ldl) + loc_dl = loc_dl(1:ldl) + if (shuffle_dep_list) then + ! + ! Apply a random shuffle to the dependency list + ! should improve the behaviour + ! + block + ! Algorithm 3.4.2P from TAOCP vol 2. + integer(psb_ipk_) :: tmp + integer :: j,k + real :: u + do j=ldl,2,-1 + call random_number(u) + k = min(j,floor(j*u)+1) + tmp = loc_dl(k) + loc_dl(k) = loc_dl(j) + loc_dl(j) = tmp + end do + end block + end if end if if (do_timings) call psb_toc(idx_phase2) @@ -189,9 +211,9 @@ contains logical :: val val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) - val = (dlavg<16) + val = (dlmax<16) !val = .true. - !val = .false. + val = .false. end function choose_sorting end subroutine psi_i_crea_index diff --git a/docs/html/userhtmlsu81.html b/docs/html/userhtmlsu81.html index 7bcaa337..b74cc797 100644 --- a/docs/html/userhtmlsu81.html +++ b/docs/html/userhtmlsu81.html @@ -66,9 +66,16 @@ class="description">Rigth hand side(s).
Type: required
An array of type real or complex, rank 1 or 2 and having the - ALLOCATABLE attribute; will be allocated and filled in if the input file - contains a right hand side, otherwise will be left in the UNALLOCATED - state. + ALLOCATABLE attribute, or an object of type psb_T_vect_type, of + type real or complex.
Will be allocated and filled in if the input file contains a right hand side, + otherwise will be left in the UNALLOCATED state.
iret
An integer value; 0 means no error has been detected.