diff --git a/src/serial/Makefile b/src/serial/Makefile index da7377d2..74f912e3 100644 --- a/src/serial/Makefile +++ b/src/serial/Makefile @@ -46,7 +46,7 @@ f77d: (cd f77; make lib) clean: - /bin/rm -f $(FOBJS) + /bin/rm -f $(FOBJS) *$(.mod) (cd aux; make clean) (cd coo; make clean) (cd csr; make clean) @@ -55,7 +55,7 @@ clean: (cd f77; make clean) veryclean: - /bin/rm -f $(FOBJS) + /bin/rm -f $(FOBJS) *$(.mod) (cd aux; make veryclean) (cd coo; make veryclean) (cd csr; make veryclean) diff --git a/src/serial/dp/dcrco.f b/src/serial/dp/dcrco.f index 884c7ade..a6655762 100644 --- a/src/serial/dp/dcrco.f +++ b/src/serial/dp/dcrco.f @@ -52,7 +52,7 @@ C .. Local Scalars .. c .. Local Arrays .. CHARACTER*20 NAME INTEGER INT_VAL(5) - + logical, parameter :: debug=.false. C .. External Subroutines .. EXTERNAL MAX_NNZERO C .. Executable Statements .. @@ -67,6 +67,8 @@ C IP1(1) = 0 IP2(1) = 0 NNZ = IA2(M+1)-1 + if (debug) write(0,*) 'CRCO: ',m,n,nnz,' : ', + + descra,' : ',descrn IF (LARN.LT.NNZ) THEN IERROR = 60 INT_VAL(1) = 18 @@ -91,17 +93,18 @@ C IF (DESCRA(1:1).EQ.'G') THEN C ... Construct COO Representation... - ELEM = 1 + ELEM = 0 DO ROW = 1, M DO J = IA2(ROW), IA2(ROW+1)-1 + ELEM = ELEM + 1 IAN1(ELEM) = ROW IAN2(ELEM) = IA1(J) ARN(ELEM) = AR(J) - ELEM = ELEM + 1 ENDDO ENDDO - INFON(psb_nnz_) = IA2(M+1)-1 + INFON(psb_nnz_) = elem + if (debug) write(0,*) 'CRCO endloop',m,elem ELSE IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') THEN DO 20 K = 1, M diff --git a/src/serial/psb_dcsdp.f90 b/src/serial/psb_dcsdp.f90 index dc0dbcb9..18646838 100644 --- a/src/serial/psb_dcsdp.f90 +++ b/src/serial/psb_dcsdp.f90 @@ -127,7 +127,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) goto 9999 end if if (ifc_<1) then - write(0,*) 'dcsdp90 Error: invalid ifc ',ifc_ + write(0,*) 'csdp90 Error: invalid ifc ',ifc_ info = -4 call psb_errpush(info,name) goto 9999 @@ -219,6 +219,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) b%pl(:) = 0 b%pr(:) = 0 + b%descra = a%descra select case (toupper(a%fida(1:3))) @@ -283,7 +284,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) end if case ('COO') - + if (debug) write(0,*) 'Calling CRCO ',a%descra call dcrco(trans_, a%m, a%k, unitd_, d, a%descra, a%aspk,& & a%ia1, a%ia2, a%infoa, b%pl, b%descra, b%aspk, b%ia1,& & b%ia2, b%infoa, b%pr, size(b%aspk), size(b%ia1),& diff --git a/src/serial/psb_dfixcoo.f90 b/src/serial/psb_dfixcoo.f90 index 5f228c0a..877c45ce 100644 --- a/src/serial/psb_dfixcoo.f90 +++ b/src/serial/psb_dfixcoo.f90 @@ -154,7 +154,7 @@ Subroutine psb_dfixcoo(A,INFO,idir) case default write(0,*) 'Fixcoo: unknown direction ',idir_ end select - + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(iaux) return end Subroutine psb_dfixcoo diff --git a/src/serial/psb_dipcoo2csc.f90 b/src/serial/psb_dipcoo2csc.f90 index bfa847f6..5a7f2546 100644 --- a/src/serial/psb_dipcoo2csc.f90 +++ b/src/serial/psb_dipcoo2csc.f90 @@ -177,6 +177,7 @@ subroutine psb_dipcoo2csc(a,info,clshr) !!$ write(0,*) 'IPcoo2csc end loop ',i,nc,a%ia2(nc+1),nza a%fida='CSC' + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_dipcoo2csr.f90 b/src/serial/psb_dipcoo2csr.f90 index fbffdb02..4410c551 100644 --- a/src/serial/psb_dipcoo2csr.f90 +++ b/src/serial/psb_dipcoo2csr.f90 @@ -180,6 +180,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr) !!$ write(0,*) 'IPcoo2csr end loop ',i,nr,a%ia2(nr+1),nza a%fida='CSR' + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_dipcsr2coo.f90 b/src/serial/psb_dipcsr2coo.f90 index b48e2655..f1248cdd 100644 --- a/src/serial/psb_dipcsr2coo.f90 +++ b/src/serial/psb_dipcsr2coo.f90 @@ -81,6 +81,8 @@ Subroutine psb_dipcsr2coo(a,info) a%fida='COO' a%infoa(psb_nnz_) = nza a%infoa(psb_srtd_) = psb_isrtdcoo_ + a%infoa(psb_upd_) = psb_upd_srch_ + deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_dsymbmm.f90 b/src/serial/psb_dsymbmm.f90 index 58bb5bae..bace3e0a 100644 --- a/src/serial/psb_dsymbmm.f90 +++ b/src/serial/psb_dsymbmm.f90 @@ -64,6 +64,7 @@ subroutine psb_dsymbmm(a,b,c) c%m=a%m c%k=b%k c%fida='CSR' + c%descra='GUN' deallocate(itemp) return end subroutine psb_dsymbmm diff --git a/src/serial/psb_dtransp.f90 b/src/serial/psb_dtransp.f90 index f89d5050..7b645b1c 100644 --- a/src/serial/psb_dtransp.f90 +++ b/src/serial/psb_dtransp.f90 @@ -35,7 +35,8 @@ subroutine psb_dtransp(a,b,c,fmt) use psb_spmat_type use psb_tools_mod - use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo + use psb_string_mod + use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo, psb_csdp implicit none type(psb_dspmat_type) :: a,b @@ -45,25 +46,41 @@ subroutine psb_dtransp(a,b,c,fmt) character(len=5) :: fmt_ integer ::c_, info, nz integer, pointer :: itmp(:)=>null() + type(psb_dspmat_type) :: tmp + if (present(c)) then c_=c else c_=1 endif if (present(fmt)) then - fmt_ = fmt + fmt_ = toupper(fmt) else fmt_='CSR' endif - if (associated(b%aspk)) call psb_sp_free(b,info) - call psb_sp_clone(a,b,info) - - if (b%fida=='CSR') then - call psb_ipcsr2coo(b,info) - else if (b%fida=='COO') then - ! do nothing + + if (.true.) then + if (associated(b%aspk)) call psb_sp_free(b,info) + b%fida = 'COO' + b%descra = 'GUN' + call psb_csdp(a,b,info) +!!$ write(0,*) 'Check from CSDP',b%m,b%k,b%fida,b%descra,b%infoa(psb_nnz_) + if (info /= 0) then + write(0,*) 'transp: info from CSDP ',info + return + end if else - write(0,*) 'Unimplemented case in TRANSP ' + if (associated(b%aspk)) call psb_sp_free(b,info) + call psb_sp_clone(a,b,info) + + if (b%fida=='CSR') then + call psb_ipcsr2coo(b,info) + else if (b%fida=='COO') then + ! do nothing + else + write(0,*) 'Unimplemented case in TRANSP ' + endif +!!$ write(0,*) 'Check from CLONE',b%m,b%k,b%fida,b%descra,b%infoa(psb_nnz_) endif !!$ nz = b%infoa(nnz_) !!$ write(0,*) 'TRANSP CHECKS:',a%m,a%k,& @@ -83,7 +100,13 @@ subroutine psb_dtransp(a,b,c,fmt) call psb_fixcoo(b,info) b%fida='COO' else - write(0,*) 'Unknown FMT in TRANSP : "',fmt_,'"' + call psb_nullify_sp(tmp) + call psb_sp_clone(b,tmp,info) + b%fida=fmt_ + call psb_csdp(tmp,b,info) + !!!!!! ADD HERE ERRPUSH!!! + call psb_sp_free(tmp,info) + endif return diff --git a/src/serial/psb_zcsdp.f90 b/src/serial/psb_zcsdp.f90 index 4c93a5b0..aed26cab 100644 --- a/src/serial/psb_zcsdp.f90 +++ b/src/serial/psb_zcsdp.f90 @@ -188,8 +188,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) n_col=b%k call psb_cest(b%fida, n_row,n_col,size_req,& & ia1_size, ia2_size, aspk_size, upd_,info) -!!$ write(0,*) size(b%aspk),size(b%ia1),size(b%ia2),size(b%pl),size(b%pr),& -!!$ & ia1_size, ia2_size, aspk_size,b%fida,b%m,b%k if (info /= no_err) then info=4010 @@ -221,6 +219,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) b%pl(:) = 0 b%pr(:) = 0 + b%descra = a%descra select case (toupper(a%fida(1:3))) @@ -248,7 +247,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) !...converting to JAD !...output matrix may not be big enough - do call zcrjd(trans_, a%m, a%k, unitd_, d, a%descra, a%aspk,& diff --git a/src/serial/psb_zfixcoo.f90 b/src/serial/psb_zfixcoo.f90 index b6f7d0a6..5b669d43 100644 --- a/src/serial/psb_zfixcoo.f90 +++ b/src/serial/psb_zfixcoo.f90 @@ -154,6 +154,7 @@ Subroutine psb_zfixcoo(A,INFO,idir) case default write(0,*) 'Fixcoo: unknown direction ',idir_ end select + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(iaux) return diff --git a/src/serial/psb_zipcoo2csc.f90 b/src/serial/psb_zipcoo2csc.f90 index 1c68e08d..9c44d11b 100644 --- a/src/serial/psb_zipcoo2csc.f90 +++ b/src/serial/psb_zipcoo2csc.f90 @@ -178,6 +178,7 @@ subroutine psb_zipcoo2csc(a,info,clshr) !!$ write(0,*) 'IPcoo2csc end loop ',i,nc,a%ia2(nc+1),nza a%fida='CSC' + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_zipcoo2csr.f90 b/src/serial/psb_zipcoo2csr.f90 index 5856d912..9bcb84b5 100644 --- a/src/serial/psb_zipcoo2csr.f90 +++ b/src/serial/psb_zipcoo2csr.f90 @@ -180,6 +180,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr) !!$ write(0,*) 'IPcoo2csr end loop ',i,nr,a%ia2(nr+1),nza a%fida='CSR' + a%infoa(psb_upd_) = psb_upd_srch_ deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_zipcsr2coo.f90 b/src/serial/psb_zipcsr2coo.f90 index 775a002b..424cdb26 100644 --- a/src/serial/psb_zipcsr2coo.f90 +++ b/src/serial/psb_zipcsr2coo.f90 @@ -81,6 +81,8 @@ Subroutine psb_zipcsr2coo(a,info) a%fida='COO' a%infoa(psb_nnz_) = nza a%infoa(psb_srtd_) = psb_isrtdcoo_ + a%infoa(psb_upd_) = psb_upd_srch_ + deallocate(itemp) call psb_erractionrestore(err_act) diff --git a/src/serial/psb_zsymbmm.f90 b/src/serial/psb_zsymbmm.f90 index ab140656..2d967c25 100644 --- a/src/serial/psb_zsymbmm.f90 +++ b/src/serial/psb_zsymbmm.f90 @@ -64,6 +64,7 @@ subroutine psb_zsymbmm(a,b,c) c%m=a%m c%k=b%k c%fida='CSR' + c%descra='GUN' deallocate(itemp) return end subroutine psb_zsymbmm diff --git a/src/serial/psb_ztransc.f90 b/src/serial/psb_ztransc.f90 index b8fb3f63..16e2da03 100644 --- a/src/serial/psb_ztransc.f90 +++ b/src/serial/psb_ztransc.f90 @@ -36,7 +36,7 @@ subroutine psb_ztransc(a,b,c,fmt) use psb_spmat_type use psb_tools_mod use psb_string_mod - use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo + use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo, psb_csdp implicit none type(psb_zspmat_type) :: a,b @@ -45,7 +45,9 @@ subroutine psb_ztransc(a,b,c,fmt) character(len=5) :: fmt_ integer ::c_, info, nz, i - integer, pointer :: itmp(:) + integer, pointer :: itmp(:)=>null() + type(psb_zspmat_type) :: tmp + if (present(c)) then c_=c else @@ -56,15 +58,20 @@ subroutine psb_ztransc(a,b,c,fmt) else fmt_='CSR' endif - if (associated(b%aspk)) call psb_sp_free(b,info) - call psb_sp_clone(a,b,info) - - if (b%fida=='CSR') then - call psb_ipcsr2coo(b,info) - else if (b%fida=='COO') then - ! do nothing + if (.true.) then + b%fida = 'COO' + call psb_csdp(a,b,info) else - write(0,*) 'Unimplemented case in TRANSC ' + if (associated(b%aspk)) call psb_sp_free(b,info) + call psb_sp_clone(a,b,info) + + if (b%fida=='CSR') then + call psb_ipcsr2coo(b,info) + else if (b%fida=='COO') then + ! do nothing + else + write(0,*) 'Unimplemented case in TRANSC ' + endif endif itmp => b%ia1 b%ia1 => b%ia2 @@ -85,7 +92,13 @@ subroutine psb_ztransc(a,b,c,fmt) call psb_fixcoo(b,info) b%fida='COO' else - write(0,*) 'Unknown FMT in TRANSC : "',fmt_,'"' + call psb_nullify_sp(tmp) + call psb_sp_clone(b,tmp,info) + b%fida=fmt_ + call psb_csdp(tmp,b,info) + !!!!!! ADD HERE ERRPUSH!!! + call psb_sp_free(tmp,info) + endif return diff --git a/src/serial/psb_ztransp.f90 b/src/serial/psb_ztransp.f90 index f1aada5f..dfe0d716 100644 --- a/src/serial/psb_ztransp.f90 +++ b/src/serial/psb_ztransp.f90 @@ -36,7 +36,7 @@ subroutine psb_ztransp(a,b,c,fmt) use psb_spmat_type use psb_tools_mod use psb_string_mod - use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo + use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo, psb_csdp implicit none type(psb_zspmat_type) :: a,b @@ -45,7 +45,9 @@ subroutine psb_ztransp(a,b,c,fmt) character(len=5) :: fmt_ integer ::c_, info, nz - integer, pointer :: itmp(:) + integer, pointer :: itmp(:)=>null() + type(psb_zspmat_type) :: tmp + if (present(c)) then c_=c else @@ -56,15 +58,20 @@ subroutine psb_ztransp(a,b,c,fmt) else fmt_='CSR' endif - if (associated(b%aspk)) call psb_sp_free(b,info) - call psb_sp_clone(a,b,info) - - if (b%fida=='CSR') then - call psb_ipcsr2coo(b,info) - else if (b%fida=='COO') then - ! do nothing + if (.true.) then + b%fida = 'COO' + call psb_csdp(a,b,info) else - write(0,*) 'Unimplemented case in TRANSP ' + if (associated(b%aspk)) call psb_sp_free(b,info) + call psb_sp_clone(a,b,info) + + if (b%fida=='CSR') then + call psb_ipcsr2coo(b,info) + else if (b%fida=='COO') then + ! do nothing + else + write(0,*) 'Unimplemented case in TRANSP ' + endif endif !!$ nz = b%infoa(nnz_) !!$ write(0,*) 'TRANSP CHECKS:',a%m,a%k,& @@ -84,7 +91,13 @@ subroutine psb_ztransp(a,b,c,fmt) call psb_fixcoo(b,info) b%fida='COO' else - write(0,*) 'Unknown FMT in TRANSP : "',fmt_,'"' + call psb_nullify_sp(tmp) + call psb_sp_clone(b,tmp,info) + b%fida=fmt_ + call psb_csdp(tmp,b,info) + !!!!!! ADD HERE ERRPUSH!!! + call psb_sp_free(tmp,info) + endif return diff --git a/src/tools/psb_dsphalo.f90 b/src/tools/psb_dsphalo.f90 index 6c53d7b0..8be5c7c4 100644 --- a/src/tools/psb_dsphalo.f90 +++ b/src/tools/psb_dsphalo.f90 @@ -63,7 +63,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) integer, intent(out) :: info logical, optional, intent(in) :: rwcnv,clcnv character(len=5), optional :: outfmt - !c ...local scalars.... + ! ...local scalars.... Integer :: nprow,npcol,me,mycol,counter,proc,n,i,& & n_el_send,k,n_el_recv,icontxt, idx, r, tot_elem,& & n_elem, m, j, ipx,mat_recv, iszs, iszr,&