From 6d66d1297cc1c5176c30c030e1caed427f527f77 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 18 Sep 2007 08:47:50 +0000 Subject: [PATCH] Merged new serial code. --- mld_daggrmat_raw_asb.F90 | 54 +++------- mld_daggrmat_smth_asb.F90 | 58 +++++----- mld_dbjac_bld.f90 | 15 ++- mld_dsp_renum.f90 | 15 +-- mld_prec_type.f90 | 2 +- mld_zaggrmat_raw_asb.F90 | 54 +++------- mld_zaggrmat_smth_asb.F90 | 58 +++++----- mld_zbjac_bld.f90 | 15 ++- mld_zsp_renum.f90 | 220 +++++--------------------------------- 9 files changed, 139 insertions(+), 352 deletions(-) diff --git a/mld_daggrmat_raw_asb.F90 b/mld_daggrmat_raw_asb.F90 index de919f89..992358d8 100644 --- a/mld_daggrmat_raw_asb.F90 +++ b/mld_daggrmat_raw_asb.F90 @@ -99,50 +99,26 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - nzt = psb_sp_get_nnzeros(a) - - call psb_sp_all(b,nzt,info) + call psb_sp_clip(a,b,info,jmax=nrow) if(info /= 0) then - call psb_errpush(4010,name,a_err='spall') + call psb_errpush(4010,name,a_err='spclip') goto 9999 end if - - call psb_sp_setifld(psb_dupl_ovwrt_,psb_dupl_,b,info) - call psb_sp_setifld(psb_upd_dflt_,psb_upd_,b,info) - b%fida = 'COO' - b%m=a%m - b%k=a%k - call psb_csdp(a,b,info) - if(info /= 0) then - info=4010 - ch_err='psb_csdp' - call psb_errpush(info,name,a_err=ch_err) + ! Out from sp_clip is always in COO, but just in case.. + if (tolower(b%fida) /= 'coo') then + call psb_errpush(4010,name,a_err='spclip NOT COO') goto 9999 end if - + nzt = psb_sp_get_nnzeros(b) - - j = 0 do i=1, nzt - if ((1<=b%ia2(i)).and.(b%ia2(i)<=nrow)) then - j = j + 1 - b%aspk(j) = b%aspk(i) - b%ia1(j) = p%mlia(b%ia1(i)) - b%ia2(j) = p%mlia(b%ia2(i)) - end if + b%ia1(i) = p%mlia(b%ia1(i)) + b%ia2(i) = p%mlia(b%ia2(i)) enddo - b%infoa(psb_nnz_)=j - call psb_fixcoo(b,info) - - nzt = psb_sp_get_nnzeros(b) - - call psb_sp_reall(b,nzt,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='spreall') - goto 9999 - end if b%m = naggr b%k = naggr + ! This is to minimize data exchange + call psb_spcnv(b,info,afmt='coo',dupl=psb_dupl_add_) if (p%iprcparm(coarse_mat_) == repl_mat_) then @@ -156,9 +132,10 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) nzbr(me+1) = nzt call psb_sum(ictxt,nzbr(1:np)) nzac = sum(nzbr) + call psb_sp_all(ntaggr,ntaggr,ac,nzac,info) if(info /= 0) then - call psb_errpush(4010,name,a_err='spall') + call psb_errpush(4010,name,a_err='sp_all') goto 9999 end if @@ -184,7 +161,7 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then call psb_errpush(4010,name,a_err='sp_free') goto 9999 @@ -219,13 +196,14 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_) end if - call psb_ipcoo2csr(ac,info) + deallocate(nzbr,idisp) + + call psb_spcnv(ac,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then call psb_errpush(4010,name,a_err='ipcoo2csr') goto 9999 end if - deallocate(nzbr,idisp) call psb_erractionrestore(err_act) return diff --git a/mld_daggrmat_smth_asb.F90 b/mld_daggrmat_smth_asb.F90 index caedd91b..fa3ae993 100644 --- a/mld_daggrmat_smth_asb.F90 +++ b/mld_daggrmat_smth_asb.F90 @@ -86,6 +86,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) + call psb_nullify_sp(am1) + call psb_nullify_sp(am2) nglob = psb_cd_get_global_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a) @@ -116,7 +118,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) call psb_halo(p%mlia,desc_a,info) if(info /= 0) then - call psb_errpush(4010,name,a_err='f90_pshalo') + call psb_errpush(4010,name,a_err='psb_halo') goto 9999 end if end if @@ -195,11 +197,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) endif - - - call psb_ipcoo2csr(am4,info) + call psb_spcnv(am4,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if @@ -256,7 +256,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end if - if (am3%fida=='CSR') then + if (toupper(am3%fida)=='CSR') then do i=1,am3%m do j=am3%ia2(i),am3%ia2(i+1)-1 if (am3%ia1(j) == i) then @@ -266,7 +266,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end if end do end do - else if (am3%fida=='COO') then + else if (toupper(am3%fida)=='COO') then do j=1,am3%infoa(psb_nnz_) if (am3%ia1(j) /= am3%ia2(j)) then am3%aspk(j) = - omega*am3%aspk(j) @@ -274,7 +274,13 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am3%aspk(j) = done - omega*am3%aspk(j) endif end do - call psb_ipcoo2csr(am3,info) + + call psb_spcnv(am3,info,afmt='csr',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv am3') + goto 9999 + end if + else write(0,*) 'Missing implementation of I sum' call psb_errpush(4010,name) @@ -381,7 +387,11 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end do am2%infoa(psb_nnz_) = i - call psb_ipcoo2csr(am2,info) + call psb_spcnv(am2,info,afmt='csr',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv am2') + goto 9999 + end if else call psb_transp(am1,am2) endif @@ -433,15 +443,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - call psb_ipcsr2coo(b,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='ipcsr2coo') - goto 9999 - end if - - call psb_fixcoo(b,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='fixcoo') + call psb_spcnv(b,info,afmt='coo',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv b') goto 9999 end if @@ -522,9 +526,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am1%k=desc_ac%matrix_data(psb_n_col_) if (np>1) then - call psb_ipcsr2coo(am2,info) + call psb_spcnv(am2,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcsr2coo') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if @@ -535,9 +539,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - call psb_ipcoo2csr(am2,info) + call psb_spcnv(am2,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if end if @@ -581,7 +585,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) goto 9999 call psb_sp_free(b,info) if(info /= 0) goto 9999 @@ -669,9 +673,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_fixcoo') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if call psb_sp_free(b,info) @@ -685,9 +689,9 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end select - call psb_ipcoo2csr(ac,info) + call psb_spcnv(ac,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if diff --git a/mld_dbjac_bld.f90 b/mld_dbjac_bld.f90 index 8c70fdfb..fda235a4 100644 --- a/mld_dbjac_bld.f90 +++ b/mld_dbjac_bld.f90 @@ -333,10 +333,9 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case(slu_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if @@ -384,10 +383,9 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case(sludist_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if @@ -438,10 +436,9 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case(umf_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if diff --git a/mld_dsp_renum.f90 b/mld_dsp_renum.f90 index ee1d9eba..96e4c857 100644 --- a/mld_dsp_renum.f90 +++ b/mld_dsp_renum.f90 @@ -62,7 +62,6 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) - call psb_info(ictxt, me, np) ! @@ -74,13 +73,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) ! (2. GPS band reduction disabled for the time being) nztota=psb_sp_get_nnzeros(a) nztotb=psb_sp_get_nnzeros(blck) - call psb_sp_reall(atmp,nztota+nztotb,info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_sp_reall') - goto 9999 - end if - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo',dupl=psb_dupl_add_) call psb_rwextd(a%m+blck%m,atmp,info,blck,rowscale=.false.) if (p%iprcparm(sub_ren_)==renum_glb_) then @@ -115,7 +108,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) else if (p%iprcparm(sub_ren_)==renum_gps_) then - call psb_ipcoo2csr(atmp,info) + call psb_spcnv(atmp,info,afmt='csr',dupl=psb_dupl_add_) nztmp = psb_sp_get_nnzeros(atmp) ! This is a renumbering with Gibbs-Poole-Stockmeyer ! band reduction. Switched off for now. To be fixed, @@ -171,7 +164,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) enddo t3 = psb_wtime() - call psb_ipcsr2coo(atmp,info) + call psb_spcnv(atmp,info,afmt='coo',dupl=psb_dupl_add_) end if @@ -182,7 +175,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) atmp%ia1(i) = p%perm(a%ia1(i)) atmp%ia2(i) = p%invperm(a%ia2(i)) end do - call psb_fixcoo(atmp,info) + call psb_spcnv(atmp,info,afmt='coo',dupl=psb_dupl_add_) if (info /= 0) then call psb_errpush(4010,name,a_err='psb_fixcoo') goto 9999 diff --git a/mld_prec_type.f90 b/mld_prec_type.f90 index 5643eb1a..8474d682 100644 --- a/mld_prec_type.f90 +++ b/mld_prec_type.f90 @@ -209,7 +209,7 @@ module mld_prec_type & aggr_names(0:3)=(/'Local aggregation ','Global aggregation',& & 'New local aggr. ','New global aggr. '/) character(len=6), parameter, private :: & - & restrict_names(0:4)=(/'None ',' ',' ',' ','Halo '/) + & restrict_names(0:4)=(/'None ','Halo ',' ',' ',' '/) character(len=12), parameter, private :: & & prolong_names(0:3)=(/'None ','Sum ','Average ','Square root'/) character(len=15), parameter, private :: & diff --git a/mld_zaggrmat_raw_asb.F90 b/mld_zaggrmat_raw_asb.F90 index 1e1c7e8a..6ce7870b 100644 --- a/mld_zaggrmat_raw_asb.F90 +++ b/mld_zaggrmat_raw_asb.F90 @@ -100,50 +100,26 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - nzt = psb_sp_get_nnzeros(a) - - call psb_sp_all(b,nzt,info) + call psb_sp_clip(a,b,info,jmax=nrow) if(info /= 0) then - call psb_errpush(4010,name,a_err='spall') + call psb_errpush(4010,name,a_err='spclip') goto 9999 end if - - call psb_sp_setifld(psb_dupl_ovwrt_,psb_dupl_,b,info) - call psb_sp_setifld(psb_upd_dflt_,psb_upd_,b,info) - b%fida = 'COO' - b%m=a%m - b%k=a%k - call psb_csdp(a,b,info) - if(info /= 0) then - info=4010 - ch_err='psb_csdp' - call psb_errpush(info,name,a_err=ch_err) + ! Out from sp_clip is always in COO, but just in case.. + if (tolower(b%fida) /= 'coo') then + call psb_errpush(4010,name,a_err='spclip NOT COO') goto 9999 end if - + nzt = psb_sp_get_nnzeros(b) - - j = 0 do i=1, nzt - if ((1<=b%ia2(i)).and.(b%ia2(i)<=nrow)) then - j = j + 1 - b%aspk(j) = b%aspk(i) - b%ia1(j) = p%mlia(b%ia1(i)) - b%ia2(j) = p%mlia(b%ia2(i)) - end if + b%ia1(i) = p%mlia(b%ia1(i)) + b%ia2(i) = p%mlia(b%ia2(i)) enddo - b%infoa(psb_nnz_)=j - call psb_fixcoo(b,info) - - nzt = psb_sp_get_nnzeros(b) - - call psb_sp_reall(b,nzt,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='spreall') - goto 9999 - end if b%m = naggr b%k = naggr + ! This is to minimize data exchange + call psb_spcnv(b,info,afmt='coo',dupl=psb_dupl_add_) if (p%iprcparm(coarse_mat_) == repl_mat_) then @@ -157,9 +133,10 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) nzbr(me+1) = nzt call psb_sum(ictxt,nzbr(1:np)) nzac = sum(nzbr) + call psb_sp_all(ntaggr,ntaggr,ac,nzac,info) if(info /= 0) then - call psb_errpush(4010,name,a_err='spall') + call psb_errpush(4010,name,a_err='sp_all') goto 9999 end if @@ -185,7 +162,7 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then call psb_errpush(4010,name,a_err='sp_free') goto 9999 @@ -220,13 +197,14 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_) end if - call psb_ipcoo2csr(ac,info) + deallocate(nzbr,idisp) + + call psb_spcnv(ac,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then call psb_errpush(4010,name,a_err='ipcoo2csr') goto 9999 end if - deallocate(nzbr,idisp) call psb_erractionrestore(err_act) return diff --git a/mld_zaggrmat_smth_asb.F90 b/mld_zaggrmat_smth_asb.F90 index 69c5bbc2..1d6ff6f6 100644 --- a/mld_zaggrmat_smth_asb.F90 +++ b/mld_zaggrmat_smth_asb.F90 @@ -86,6 +86,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am2 => p%av(sm_pr_t_) am1 => p%av(sm_pr_) + call psb_nullify_sp(am1) + call psb_nullify_sp(am2) nglob = psb_cd_get_global_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a) @@ -116,7 +118,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) call psb_halo(p%mlia,desc_a,info) if(info /= 0) then - call psb_errpush(4010,name,a_err='f90_pshalo') + call psb_errpush(4010,name,a_err='psb_halo') goto 9999 end if end if @@ -195,11 +197,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) endif - - - call psb_ipcoo2csr(am4,info) + call psb_spcnv(am4,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if @@ -256,7 +256,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end if - if (am3%fida=='CSR') then + if (toupper(am3%fida)=='CSR') then do i=1,am3%m do j=am3%ia2(i),am3%ia2(i+1)-1 if (am3%ia1(j) == i) then @@ -266,7 +266,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end if end do end do - else if (am3%fida=='COO') then + else if (toupper(am3%fida)=='COO') then do j=1,am3%infoa(psb_nnz_) if (am3%ia1(j) /= am3%ia2(j)) then am3%aspk(j) = - omega*am3%aspk(j) @@ -274,7 +274,13 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am3%aspk(j) = zone - omega*am3%aspk(j) endif end do - call psb_ipcoo2csr(am3,info) + + call psb_spcnv(am3,info,afmt='csr',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv am3') + goto 9999 + end if + else write(0,*) 'Missing implementation of I sum' call psb_errpush(4010,name) @@ -381,7 +387,11 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end do am2%infoa(psb_nnz_) = i - call psb_ipcoo2csr(am2,info) + call psb_spcnv(am2,info,afmt='csr',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv am2') + goto 9999 + end if else call psb_transp(am1,am2) endif @@ -433,15 +443,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - call psb_ipcsr2coo(b,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='ipcsr2coo') - goto 9999 - end if - - call psb_fixcoo(b,info) - if(info /= 0) then - call psb_errpush(4010,name,a_err='fixcoo') + call psb_spcnv(b,info,afmt='coo',dupl=psb_dupl_add_) + if (info /=0) then + call psb_errpush(4010,name,a_err='spcnv b') goto 9999 end if @@ -522,9 +526,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) am1%k=desc_ac%matrix_data(psb_n_col_) if (np>1) then - call psb_ipcsr2coo(am2,info) + call psb_spcnv(am2,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcsr2coo') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if @@ -535,9 +539,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) goto 9999 end if - call psb_ipcoo2csr(am2,info) + call psb_spcnv(am2,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if end if @@ -581,7 +585,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) goto 9999 call psb_sp_free(b,info) if(info /= 0) goto 9999 @@ -669,9 +673,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) ac%infoa(psb_nnz_) = nzac ac%fida='COO' ac%descra='G' - call psb_fixcoo(ac,info) + call psb_spcnv(ac,info,afmt='coo',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_fixcoo') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if call psb_sp_free(b,info) @@ -685,9 +689,9 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info) end select - call psb_ipcoo2csr(ac,info) + call psb_spcnv(ac,info,afmt='csr',dupl=psb_dupl_add_) if(info /= 0) then - call psb_errpush(4010,name,a_err='psb_ipcoo2csr') + call psb_errpush(4010,name,a_err='spcnv') goto 9999 end if diff --git a/mld_zbjac_bld.f90 b/mld_zbjac_bld.f90 index bf12b59e..bdb813e0 100644 --- a/mld_zbjac_bld.f90 +++ b/mld_zbjac_bld.f90 @@ -334,10 +334,9 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case(slu_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if @@ -385,10 +384,9 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case(sludist_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if @@ -439,10 +437,9 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case(umf_) - atmp%fida='COO' - call psb_csdp(a,atmp,info) + call psb_spcnv(a,atmp,info,afmt='coo') if (info /= 0) then - call psb_errpush(4010,name,a_err='psb_csdp') + call psb_errpush(4010,name,a_err='psb_spcnv') goto 9999 end if diff --git a/mld_zsp_renum.f90 b/mld_zsp_renum.f90 index e6540a33..7e9c0db8 100644 --- a/mld_zsp_renum.f90 +++ b/mld_zsp_renum.f90 @@ -64,20 +64,23 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) -!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A + ! + ! CHANGE: Start with a COO atmp. Then change if/when necessary. + ! Exit with a COO atmp. ! ! Renumbering type: ! 1. Global column indices ! (2. GPS band reduction disabled for the time being) + nztota=psb_sp_get_nnzeros(a) + nztotb=psb_sp_get_nnzeros(blck) + call psb_spcnv(a,atmp,info,afmt='coo',dupl=psb_dupl_add_) + call psb_rwextd(a%m+blck%m,atmp,info,blck,rowscale=.false.) if (p%iprcparm(sub_ren_)==renum_glb_) then - atmp%m = a%m + blck%m - atmp%k = a%k - atmp%fida='CSR' - atmp%descra = 'GUN' ! This is the renumbering coherent with global indices.. mglob = psb_cd_get_global_rows(desc_a) + ! ! Remember: we have switched IA1=COLS and IA2=ROWS ! Now identify the set of distinct local column indices @@ -103,112 +106,10 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) enddo t3 = psb_wtime() - ! Build ATMP with new numbering. - nztmp=size(atmp%aspk) - allocate(itmp(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - - j = 1 - atmp%ia2(1) = 1 - do i=1, atmp%m - ir = p%perm(i) - - if (ir <= a%m ) then - - nzl = a%ia2(ir+1) - a%ia2(ir) - if (nzl > size(ztmp)) then - call psb_realloc(nzl,ztmp,info) - if(info/=0) then - info=4010 - ch_err='psb_realloc' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - jj = a%ia2(ir) - k=0 - do kk=1, nzl - if (a%ia1(jj+kk-1)<=atmp%m) then - k = k + 1 - ztmp(k) = a%aspk(jj+kk-1) - atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) - endif - enddo - call psb_msort(atmp%ia1(j:j+k-1),ix=itmp2) - do kk=1,k - atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) - enddo - - else if (ir <= atmp%m ) then - - ir = ir - a%m - nzl = blck%ia2(ir+1) - blck%ia2(ir) - if (nzl > size(ztmp)) then - call psb_realloc(nzl,ztmp,info) - if(info/=0) then - info=4010 - ch_err='psb_realloc' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - jj = blck%ia2(ir) - k=0 - do kk=1, nzl - if (blck%ia1(jj+kk-1)<=atmp%m) then - k = k + 1 - ztmp(k) = blck%aspk(jj+kk-1) - atmp%ia1(j+k-1) = p%invperm(blck%ia1(jj+kk-1)) - endif - enddo - call psb_msort(atmp%ia1(j:j+k-1),ix=itmp2) - do kk=1,k - atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) - enddo - - else - write(0,*) 'Row index error 1 :',i,ir - endif - - j = j + k - atmp%ia2(i+1) = j - - enddo - - t4 = psb_wtime() - - - deallocate(itmp,itmp2,ztmp) - else if (p%iprcparm(sub_ren_)==renum_gps_) then - - atmp%m = a%m + blck%m - atmp%k = a%k - atmp%fida='CSR' - atmp%descra = 'GUN' - do i=1, a%m - atmp%ia2(i) = a%ia2(i) - do j= a%ia2(i), a%ia2(i+1)-1 - atmp%ia1(j) = a%ia1(j) - enddo - enddo - atmp%ia2(a%m+1) = a%ia2(a%m+1) - nztota = atmp%ia2(a%m+1) -1 - if (blck%m>0) then - do i=1, blck%m - atmp%ia2(a%m+i) = nztota+blck%ia2(i) - do j= blck%ia2(i), blck%ia2(i+1)-1 - atmp%ia1(nztota+j) = blck%ia1(j) - enddo - enddo - atmp%ia2(atmp%m+1) = nztota+blck%ia2(blck%m+1) - endif - nztmp = atmp%ia2(atmp%m+1) - 1 - - + + call psb_spcnv(atmp,info,afmt='csr',dupl=psb_dupl_add_) + nztmp = psb_sp_get_nnzeros(atmp) ! This is a renumbering with Gibbs-Poole-Stockmeyer ! band reduction. Switched off for now. To be fixed, ! gps_reduction should get p%perm. @@ -258,95 +159,30 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) enddo - do k=1, nnr p%invperm(p%perm(k)) = k enddo t3 = psb_wtime() - - ! Build ATMP with new numbering. - - allocate(itmp2(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - - j = 1 - atmp%ia2(1) = 1 - do i=1, atmp%m - ir = p%perm(i) - - if (ir <= a%m ) then - - nzl = a%ia2(ir+1) - a%ia2(ir) - if (nzl > size(ztmp)) then - call psb_realloc(nzl,ztmp,info) - if(info/=0) then - info=4010 - ch_err='psb_realloc' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - jj = a%ia2(ir) - k=0 - do kk=1, nzl - if (a%ia1(jj+kk-1)<=atmp%m) then - k = k + 1 - ztmp(k) = a%aspk(jj+kk-1) - atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) - endif - enddo - call psb_msort(atmp%ia1(j:j+k-1),ix=itmp2) - do kk=1,k - atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) - enddo - - else if (ir <= atmp%m ) then - - ir = ir - a%m - nzl = blck%ia2(ir+1) - blck%ia2(ir) - if (nzl > size(ztmp)) then - call psb_realloc(nzl,ztmp,info) - if(info/=0) then - info=4010 - ch_err='psb_realloc' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - jj = blck%ia2(ir) - k=0 - do kk=1, nzl - if (blck%ia1(jj+kk-1)<=atmp%m) then - k = k + 1 - ztmp(k) = blck%aspk(jj+kk-1) - atmp%ia1(j+k-1) = p%invperm(blck%ia1(jj+kk-1)) - endif - enddo - call psb_msort(atmp%ia1(j:j+k-1),ix=itmp2) - do kk=1,k - atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) - enddo - - else - write(0,*) 'Row index error 1 :',i,ir - endif - - j = j + k - atmp%ia2(i+1) = j - - enddo - - t4 = psb_wtime() - - - - deallocate(itmp,itmp2,ztmp) + + call psb_spcnv(atmp,info,afmt='coo',dupl=psb_dupl_add_) end if + ! Rebuild ATMP with new numbering. + + nztmp=psb_sp_get_nnzeros(atmp) + do i=1,nztmp + atmp%ia1(i) = p%perm(a%ia1(i)) + atmp%ia2(i) = p%invperm(a%ia2(i)) + end do + call psb_spcnv(atmp,info,afmt='coo',dupl=psb_dupl_add_) + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_fixcoo') + goto 9999 + end if + + t4 = psb_wtime() + call psb_erractionrestore(err_act) return