fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 19:32:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
Salvatore Filippone
2006-05-01 16:28:05 +00:00
parent f6ea0ade44
commit f678cbe25e
18 changed files with 108 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/serial/Makefile
+2 -2
View File
@@ -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)
src/serial/dp/dcrco.f
+7 -4
View File
@@ -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
src/serial/psb_dcsdp.f90
+3 -2
View File
@@ -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),&
src/serial/psb_dfixcoo.f90
+1 -1
View File
@@ -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
src/serial/psb_dipcoo2csc.f90
+1
View File
@@ -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)
src/serial/psb_dipcoo2csr.f90
+1
View File
@@ -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)
src/serial/psb_dipcsr2coo.f90
+2
View File
@@ -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)
src/serial/psb_dsymbmm.f90
+1
View File
@@ -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
src/serial/psb_dtransp.f90
+34 -11
View File
@@ -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
src/serial/psb_zcsdp.f90
+1 -3
View File
@@ -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,&
src/serial/psb_zfixcoo.f90
+1
View File
@@ -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
src/serial/psb_zipcoo2csc.f90
+1
View File
@@ -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)
src/serial/psb_zipcoo2csr.f90
+1
View File
@@ -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)
src/serial/psb_zipcsr2coo.f90
+2
View File
@@ -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)
src/serial/psb_zsymbmm.f90
+1
View File
@@ -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
src/serial/psb_ztransc.f90
+24 -11
View File
@@ -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
src/serial/psb_ztransp.f90
+24 -11
View File
@@ -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
src/tools/psb_dsphalo.f90
+1 -1
View File
@@ -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,&