Renaming: moved DSCINS and DSCASB into CDINS and CDASB

psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 1a6aa93f75
commit 75921dde75

@ -722,15 +722,15 @@ contains
end if
call psb_dscins(nzl,bg%ia1,bg%ia2,p%desc_data,info)
call psb_cdins(nzl,bg%ia1,bg%ia2,p%desc_data,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_dscins')
call psb_errpush(4010,name,a_err='psb_cdins')
goto 9999
end if
call psb_dscasb(p%desc_data,info)
call psb_cdasb(p%desc_data,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_dscasb')
call psb_errpush(4010,name,a_err='psb_cdasb')
goto 9999
end if

@ -113,10 +113,10 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
blk%infoa(psb_nnz_) = 0
If (upd == 'F') Then
call psb_dsccpy(desc_p,desc_data,info)
call psb_cdcpy(desc_p,desc_data,info)
if(info /= 0) then
info=4010
ch_err='psb_dsccpy'
ch_err='psb_cdcpy'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@ -154,10 +154,10 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
blk%infoa(psb_nnz_)=0
if (debug) write(0,*) 'Calling desccpy'
if (upd == 'F') then
call psb_dsccpy(desc_p,desc_data,info)
call psb_cdcpy(desc_p,desc_data,info)
if(info /= 0) then
info=4010
ch_err='psb_dsccpy'
ch_err='psb_cdcpy'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if

@ -2,9 +2,9 @@ include ../../Make.inc
FOBJS = psb_dallc.o psb_dasb.o psb_dcsrp.o psb_cdprt.o \
psb_dfree.o psb_dgelp.o psb_dins.o \
psb_cdall.o psb_cdalv.o psb_dscasb.o psb_dsccpy.o \
psb_cddec.o psb_cdfree.o psb_dscins.o psb_cdovr.o \
psb_dscren.o psb_cdrep.o psb_dspalloc.o psb_dspasb.o \
psb_cdall.o psb_cdalv.o psb_cdasb.o psb_cdcpy.o \
psb_cddec.o psb_cdfree.o psb_cdins.o psb_cdovr.o \
psb_cdren.o psb_cdrep.o psb_dspalloc.o psb_dspasb.o \
psb_dspcnv.o psb_dspfree.o psb_dspins.o psb_dsprn.o \
psb_glob_to_loc.o psb_ialloc.o psb_iasb.o \
psb_ifree.o psb_iins.o psb_loc_to_glob.o

@ -28,15 +28,15 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dscasb.f90
! File: psb_cdasb.f90
!
! Subroutine: psb_dscasb
! Subroutine: psb_cdasb
! Assembly the psblas communications descriptor.
!
! Parameters:
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code.
subroutine psb_dscasb(desc_a,info)
subroutine psb_cdasb(desc_a,info)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
@ -61,7 +61,7 @@ subroutine psb_dscasb(desc_a,info)
info = 0
int_err(1) = 0
name = 'psb_dscasb'
name = 'psb_cdasb'
call psb_erractionsave(err_act)
@ -93,7 +93,7 @@ subroutine psb_dscasb(desc_a,info)
if (debug) write (0, *) ' Begin matrix assembly...'
if (psb_is_bld_dec(dectype)) then
if (debug) write(0,*) 'psb_dscasb: Checking rows insertion'
if (debug) write(0,*) 'psb_cdasb: Checking rows insertion'
! check if all local row are inserted
do i=1,desc_a%matrix_data(psb_n_col_)
if (desc_a%loc_to_glob(i) < 0) then
@ -166,7 +166,7 @@ subroutine psb_dscasb(desc_a,info)
if (debug) write(0,*) 'psb_dscasb: converting indexes',&
if (debug) write(0,*) 'psb_cdasb: converting indexes',&
& nhalo,lhalo,halo_index(lhalo)
!.... convert comunication stuctures....
! first the halo index
@ -228,4 +228,4 @@ subroutine psb_dscasb(desc_a,info)
end if
return
end subroutine psb_dscasb
end subroutine psb_cdasb

@ -28,16 +28,16 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dsccpy.f90
! File: psb_cdcpy.f90
!
! Subroutine: psb_dsccpy
! Subroutine: psb_cdcpy
! Produces a clone of a descriptor.
!
! Parameters:
! desc_out - type(<psb_desc_type>). The output communication descriptor.
! desc_a - type(<psb_desc_type>). The communication descriptor to be cloned.
! info - integer. Eventually returns an error code.
subroutine psb_dsccpy(desc_out, desc_a, info)
subroutine psb_cdcpy(desc_out, desc_a, info)
use psb_descriptor_type
use psb_serial_mod
@ -63,7 +63,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
name = 'psb_dsccpy'
name = 'psb_cdcpy'
icontxt=desc_a%matrix_data(psb_ctxt_)
@ -86,7 +86,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%matrix_data)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%matrix_data,info)
if(debug) write(0,*) 'dsccpy: m_data',isz,':',desc_a%matrix_data(:)
if(debug) write(0,*) 'cdcpy: m_data',isz,':',desc_a%matrix_data(:)
if (info.ne.0) then
info=4010
char_err='psb_realloc'
@ -101,7 +101,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%halo_index)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%halo_index,info)
if(debug) write(0,*) 'dsccpy: h_idx',isz,':',desc_a%halo_index(:)
if(debug) write(0,*) 'cdcpy: h_idx',isz,':',desc_a%halo_index(:)
if (info.ne.0) then
info=4010
char_err='psb_realloc'
@ -117,7 +117,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%bnd_elem)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%bnd_elem,info)
if(debug) write(0,*) 'dsccpy: bnd_elem',isz,':',desc_a%bnd_elem(:)
if(debug) write(0,*) 'cdcpy: bnd_elem',isz,':',desc_a%bnd_elem(:)
if (info.ne.0) then
info=4010
char_err='psb_realloc'
@ -133,7 +133,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%ovrlap_elem)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%ovrlap_elem,info)
if(debug) write(0,*) 'dsccpy: ovrlap_elem',isz,':',desc_a%ovrlap_elem(:)
if(debug) write(0,*) 'cdcpy: ovrlap_elem',isz,':',desc_a%ovrlap_elem(:)
if (info.ne.0) then
info=4010
char_err='psrealloc'
@ -148,7 +148,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%ovrlap_index)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%ovrlap_index,info)
if(debug) write(0,*) 'dsccpy: ovrlap_index',isz,':',desc_a%ovrlap_index(:)
if(debug) write(0,*) 'cdcpy: ovrlap_index',isz,':',desc_a%ovrlap_index(:)
if (info.ne.0) then
info=4010
char_err='psrealloc'
@ -164,7 +164,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%loc_to_glob)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%loc_to_glob,info)
if(debug) write(0,*) 'dsccpy: loc_to_glob',isz,':',desc_a%loc_to_glob(:)
if(debug) write(0,*) 'cdcpy: loc_to_glob',isz,':',desc_a%loc_to_glob(:)
if (info.ne.0) then
info=4010
char_err='psrealloc'
@ -179,7 +179,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%glob_to_loc)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%glob_to_loc,info)
if(debug) write(0,*) 'dsccpy: glob_to_loc',isz,':',desc_a%glob_to_loc(:)
if(debug) write(0,*) 'cdcpy: glob_to_loc',isz,':',desc_a%glob_to_loc(:)
if (info.ne.0) then
info=4010
char_err='psrealloc'
@ -194,7 +194,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%lprm)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%lprm,info)
if(debug) write(0,*) 'dsccpy: lprm',isz,':',desc_a%lprm(:)
if(debug) write(0,*) 'cdcpy: lprm',isz,':',desc_a%lprm(:)
if (info.ne.0) then
info=4010
char_err='psb_realloc'
@ -209,7 +209,7 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
isz = size(desc_a%idx_space)
! allocate(desc_out%matrix_data(isz),stat=info)
call psb_realloc(isz,desc_out%idx_space,info)
if(debug) write(0,*) 'dsccpy: idx_space',isz,':',desc_a%idx_space(:)
if(debug) write(0,*) 'cdcpy: idx_space',isz,':',desc_a%idx_space(:)
if (info.ne.0) then
info=4010
char_err='psb_realloc'
@ -233,4 +233,4 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
end if
return
end subroutine psb_dsccpy
end subroutine psb_cdcpy

@ -28,9 +28,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dscins.f90
! File: psb_cdins.f90
!
! Subroutine: psb_dscins
! Subroutine: psb_cdins
! Takes as input a cloud of points and updates the descriptor accordingly.
!
! Parameters:
@ -41,7 +41,7 @@
! info - integer. Eventually returns an error code.
! is - integer(optional). The row offset.
! js - integer(optional). The column offset.
subroutine psb_dscins(nz,ia,ja,desc_a,info,is,js)
subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
use psb_descriptor_type
use psb_serial_mod
@ -68,7 +68,7 @@ subroutine psb_dscins(nz,ia,ja,desc_a,info,is,js)
character(len=20) :: name,ch_err
info = 0
name = 'psb_dscins'
name = 'psb_cdins'
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
@ -187,5 +187,5 @@ subroutine psb_dscins(nz,ia,ja,desc_a,info,is,js)
end if
return
end subroutine psb_dscins
end subroutine psb_cdins

@ -64,13 +64,13 @@ Subroutine psb_cdovr(a,desc_a,novr,desc_ov,info)
integer idscb,idsce,iovrb,iovre, ierr, irank, icomm, err_act
!!$ integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
interface psb_psdsccpy
subroutine psb_dsccpy(desc_out,desc_a,info)
interface psb_cdcpy
subroutine psb_cdcpy(desc_out,desc_a,info)
use psb_descriptor_type
type(psb_desc_type), intent(out) :: desc_out
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
end subroutine psb_dsccpy
end subroutine psb_cdcpy
end interface
interface psb_cdovrbld
@ -125,10 +125,10 @@ Subroutine psb_cdovr(a,desc_a,novr,desc_ov,info)
! Just copy the input.
!
if (debug) write(0,*) 'Calling desccpy'
call psb_dsccpy(desc_ov,desc_a,info)
call psb_cdcpy(desc_ov,desc_a,info)
if (info.ne.0) then
info=4010
ch_err='psb_dsccpy'
ch_err='psb_cdcpy'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@ -143,7 +143,7 @@ Subroutine psb_cdovr(a,desc_a,novr,desc_ov,info)
!!$ iovrb = mpe_log_get_event_number()
!!$ iovre = mpe_log_get_event_number()
!!$ if (irank==0) then
!!$ info = mpe_describe_state(idscb,idsce,"DSCASB ","NavyBlue")
!!$ info = mpe_describe_state(idscb,idsce,"CDASB ","NavyBlue")
!!$ info = mpe_describe_state(iovrb,iovre,"CDOVRR ","DeepPink")
!!$ endif
If(debug)Write(0,*)'BEGIN cdovr',me,nhalo
@ -152,7 +152,7 @@ Subroutine psb_cdovr(a,desc_a,novr,desc_ov,info)
!!$ ierr = MPE_Log_event( idscb, 0, "st DSCASB" )
!!$ ierr = MPE_Log_event( idscb, 0, "st CDASB" )
!
! Ok, since we are only estimating, do it as follows:
! LOVR= (NNZ/NROW)*N_HALO*N_OVR This assumes that the local average
@ -219,7 +219,7 @@ Subroutine psb_cdovr(a,desc_a,novr,desc_ov,info)
desc_ov%matrix_data(psb_dec_type_) = psb_desc_asb_
If(debug)Write(0,*)'Done cdovrbld',me,lworks,lworkr
call blacs_barrier(icontxt,'All')
!!$ ierr = MPE_Log_event( idsce, 0, "st DSCASB" )
!!$ ierr = MPE_Log_event( idsce, 0, "st CDASB" )
call psb_erractionrestore(err_act)
return

@ -603,7 +603,7 @@ Subroutine psb_cdovrbld(n_ovr,desc_p,desc_a,a,&
End Do
t1 = mpi_wtime()
call FreePairSearchTree()
!!$ ierr = MPE_Log_event( idsce, 0, "st DSCASB" )
!!$ ierr = MPE_Log_event( idsce, 0, "st CDASB" )
desc_p%matrix_data(psb_m_)=desc_a%matrix_data(psb_m_)
desc_p%matrix_data(psb_n_)=desc_a%matrix_data(psb_n_)
@ -618,7 +618,7 @@ Subroutine psb_cdovrbld(n_ovr,desc_p,desc_a,a,&
!
if (debug) then
write(0,*) 'psb_dscasb: converting indexes'
write(0,*) 'psb_cdasb: converting indexes'
call blacs_barrier(icontxt,'All')
end if
!.... convert comunication stuctures....

@ -28,9 +28,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dscren.f90
! File: psb_cdren.f90
!
! Subroutine: psb_dscren
! Subroutine: psb_cdren
! Updates a communication descriptor according to a renumbering scheme.
!
! Parameters:
@ -39,7 +39,7 @@
! desc_a - type(<psb_desc_type>). The communication descriptor to be updated.
! info - integer. Eventually returns an error code.
!
subroutine psb_dscren(trans,iperm,desc_a,info)
subroutine psb_cdren(trans,iperm,desc_a,info)
use psb_descriptor_type
use psb_const_mod
use psb_error_mod
@ -232,4 +232,4 @@ subroutine psb_dscren(trans,iperm,desc_a,info)
end if
return
end subroutine psb_dscren
end subroutine psb_cdren

@ -71,15 +71,15 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
interface psb_dscins
subroutine psb_dscins(nz,ia,ja,desc_a,info,is,js)
interface psb_cdins
subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
use psb_descriptor_type
implicit none
type(psb_desc_type), intent(inout) :: desc_a
integer, intent(in) :: nz,ia(:),ja(:)
integer, intent(out) :: info
integer, intent(in), optional :: is,js
end subroutine psb_dscins
end subroutine psb_cdins
end interface
character(len=20) :: name, ch_err
@ -130,10 +130,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
spstate = a%infoa(psb_state_)
if (psb_is_bld_dec(dectype)) then
call psb_dscins(nz,ia,ja,desc_a,info)
call psb_cdins(nz,ia,ja,desc_a,info)
if (info /= 0) then
info=4010
ch_err='psb_dscins'
ch_err='psb_cdins'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if

@ -425,11 +425,11 @@ contains
call blacs_barrier(icontxt,'all')
t0 = mpi_wtime()
call psb_dscasb(desc_a,info)
call psb_cdasb(desc_a,info)
t1 = mpi_wtime()
if(info/=0)then
info=4010
ch_err='psb_dscasb'
ch_err='psb_cdasb'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@ -790,11 +790,11 @@ contains
endif
call blacs_barrier(icontxt,'all')
t0 = mpi_wtime()
call psb_dscasb(desc_a,info)
call psb_cdasb(desc_a,info)
t1 = mpi_wtime()
if(info/=0)then
info=4010
ch_err='psb_dscasb'
ch_err='psb_cdasb'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if

@ -683,7 +683,7 @@ contains
deallocate(row_mat%aspk,row_mat%ia1,row_mat%ia2)
t1 = mpi_wtime()
call psb_dscasb(desc_a,info)
call psb_cdasb(desc_a,info)
call psb_spasb(a,desc_a,info,dup=1,afmt=afmt)
call blacs_barrier(icontxt,'ALL')
tasb = mpi_wtime()-t1

Loading…
Cancel
Save