fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 20:02:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed to case-independent character comparison. Descriptions for constants.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-04-12 19:59:10 +00:00
parent 2becae4636
commit 77106751a4
11 changed files with 88 additions and 125 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/methd/psb_dcgstab.f90
+2 -2
View File
@@ -158,8 +158,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
naux=6*n_col
allocate(aux(naux),stat=info)
call psb_geall(mglob,8,wwrk,desc_a,info)
call psb_geasb(wwrk,desc_a,info)
if (info == 0) call psb_geall(mglob,8,wwrk,desc_a,info)
if (info == 0) call psb_geasb(wwrk,desc_a,info)
if (info /= 0) then
info=4011
call psb_errpush(info,name)
src/modules/psb_const.fh
+42 -6
View File
@@ -28,11 +28,19 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! Communication, prolongation & restriction
!
integer, parameter :: psb_nohalo_=0, psb_halo_=4
integer, parameter :: psb_none_=0, psb_sum_=1
integer, parameter :: psb_avg_=2, psb_square_root_=3
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
!
! Data checks
!
integer, parameter :: psb_deadlock_check_=0
integer, parameter :: psb_local_mtrx_check_=1
integer, parameter :: psb_local_comm_check_=2
@@ -43,6 +51,9 @@
integer, parameter :: psb_loc_to_glob_check_=7
integer, parameter :: psb_convert_halo_=1, psb_convert_ovrlap_=2
integer, parameter :: psb_act_ret_=0, psb_act_abort_=1, no_err_=0
!
! Entries and values in desc%matrix_data
!
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
integer, parameter :: psb_loc_to_glob_=7
@@ -52,18 +63,31 @@
integer, parameter :: psb_desc_repl_=3199
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
integer, parameter :: psb_desc_upd_asb_=psb_desc_upd_+1
integer, parameter :: psb_upd_glb_=998, psb_upd_loc_=997
!
! Constants for desc_a handling
!
integer, parameter :: psb_upd_glbnum_=998
integer, parameter :: psb_upd_locnum_=997
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0
integer, parameter :: psb_n_dom_ovr_=1
integer, parameter :: psb_no_comm_=-1
integer, parameter :: ione=1, izero=0
integer, parameter :: itwo=2, ithree=3,mone=-1, psb_root_=0
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1
!
! Queries into spmat%info
!
integer, parameter :: psb_root_=0
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
integer, parameter :: psb_nnz_=1
!
! Entries and values for spmat%info
!
integer, parameter :: psb_nnz_=1, psb_dupl_=5
integer, parameter :: psb_del_bnd_=6, psb_srtd_=7
integer, parameter :: psb_state_=8, psb_upd_=9
integer, parameter :: psb_upd_pnt_=10, psb_ifasize_=10
@@ -72,12 +96,24 @@
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
integer, parameter :: psb_iflag_=2, psb_ichk_=3
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
integer, parameter :: psb_perm_update_=98765,psb_isrtdcoo_=98764
integer, parameter :: psb_dupl_err_ =1
integer, parameter :: psb_dupl_ovwrt_=2
integer, parameter :: psb_dupl_add_ =3
integer, parameter :: psb_perm_update_=98765
integer, parameter :: psb_srch_update_=98764
integer, parameter :: psb_isrtdcoo_ =98761
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
integer, parameter :: psb_dbleint_=2
!
! Error handling
!
integer, parameter :: act_ret=0, act_abort=1, no_err=0
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1
!
! Handy & miscellaneous constants
!
integer, parameter :: ione=1, izero=0
integer, parameter :: itwo=2, ithree=3,mone=-1, psb_root_=0
real(kind(1.d0)), parameter :: psb_colrow_=0.33, psb_percent_=0.7
real(kind(1.d0)), parameter :: dzero=0.d0, done=1.d0
complex(kind(1.d0)), parameter :: zzero=(0.d0,0.0d0)
src/psblas/psb_dspmm.f90
+9 -8
View File
@@ -87,6 +87,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
use psi_mod
use psb_check_mod
use psb_error_mod
use psb_string_mod
implicit none
real(kind(1.D0)), intent(in) :: alpha, beta
@@ -160,10 +161,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
if ((trans.eq.'N').or.(trans.eq.'T')&
& .or.(trans.eq.'n').or.(trans.eq.'t')) then
itrans = trans
else if ((trans.eq.'C').or.(trans.eq.'c')) then
if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T')) then
itrans = toupper(trans)
else if (toupper(trans).eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
@@ -317,7 +317,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
y(iiy+nrow+1-1:iiy+ncol,1:ik)=dzero
! local Matrix-vector product
call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),&
& beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans)
@@ -424,6 +424,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
use psi_mod
use psb_check_mod
use psb_error_mod
use psb_string_mod
implicit none
real(kind(1.D0)), intent(in) :: alpha, beta
@@ -482,9 +483,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
if((trans.eq.'N').or.(trans.eq.'T')) then
itrans = trans
else if (trans.eq.'C') then
if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T')) then
itrans = toupper(trans)
else if (toupper(trans).eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
src/serial/jad/Makefile
+1 -1
View File
@@ -3,7 +3,7 @@ include ../../../Make.inc
# The object files
#
FOBJS = dcojdupd.o djadmm.o djadmv.o djadsm.o djadsv.o djdnrmi.o djadnr.o djadprt.o\
FOBJS = djadmm.o djadmv.o djadsm.o djadsv.o djdnrmi.o djadnr.o djadprt.o\
djadmv2.o djadmv3.o djadmv4.o djadrws.o djdrws.o
OBJS=$(FOBJS)
src/serial/jad/dcojdupd.f
-78
View File
@@ -1,78 +0,0 @@
C
C Parallel Sparse BLAS v2.0
C (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
SUBROUTINE DCOJDUPD(M, N, DESCRA, A, IA1,
+ IA2, INFOA, IA, JA, DESCRH, H, IH1, IH2,
+ INFOH, IH, JH, FLAG, GLOB_TO_LOC,
+ IWORK, LIWORK, IERROR)
C
C .. Matrix A to be updated is required to be stored with
C .. column indices belonging to the same row ordered.
C .. Block H to be inserted don't need to be stored in such a way.
C
C Flag = 0: put elements to 0.0D0;
C Flag = 1: replace elements with new value;
C Flag = 2: sum block value to elements;
C
IMPLICIT NONE
include 'psb_const.fh'
C .. Scalar Arguments ..
INTEGER IA, JA, IH, JH, M, N,
+ IERROR, FLAG, LIWORK
C .. Array Arguments ..
INTEGER IA1(*),IA2(*),IH1(*),IH2(*),
+ INFOA(*),INFOH(*),IWORK(*),
+ GLOB_TO_LOC(*)
CHARACTER DESCRA*11,DESCRH*11
DOUBLE PRECISION A(*),H(*)
C .. Local scalars ..
INTEGER J, NNZ, IP1, NNZI
C .. Local arrays ..
IERROR = 0
IF (IBITS(INFOA(PSB_UPD_),2,1).EQ.1) THEN
C
C Smart update capability
C
IP1 = INFOA(PSB_UPD_PNT_)
NNZ = IA1(IP1+PSB_NNZ_)
NNZI = INFOH(1)
DO J = 1, NNZI
NNZ = NNZ + 1
A(NNZ) = H(J)
ENDDO
IA1(IP1+PSB_NNZ_) = NNZ
ELSE
IERROR = 2
ENDIF
9999 CONTINUE
RETURN
END
src/serial/psb_dcsprt.f90
+3 -2
View File
@@ -47,6 +47,7 @@
!*****************************************************************************
subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_spmat_type
use psb_string_mod
implicit none
integer, intent(in) :: iout
@@ -76,7 +77,7 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%'
endif
if (a%fida=='CSR') then
if (toupper(a%fida)=='CSR') then
write(iout,*) a%m,a%k,a%ia2(a%m+1)-1
@@ -114,7 +115,7 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
endif
endif
else if (a%fida=='COO') then
else if (toupper(a%fida)=='COO') then
if (present(ivr).and..not.present(ivc)) then
write(iout,*) a%m,a%k,a%infoa(psb_nnz_)
src/serial/psb_dspinfo.f90
+11 -10
View File
@@ -43,6 +43,7 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_dspmat_type), intent(in) :: a
@@ -61,14 +62,14 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (a%fida == 'CSC') then
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
@@ -87,9 +88,9 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
return
endif
irw = iaux
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
!!$ write(0,*) 'Gtrow_: srtd coo',irw
@@ -123,7 +124,7 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
@@ -162,11 +163,11 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
end if
else if (ireq == psb_nzsizereq_) then
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
src/serial/psb_zcsprt.f90
+3 -2
View File
@@ -47,6 +47,7 @@
!*****************************************************************************
subroutine psb_zcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_spmat_type
use psb_string_mod
implicit none
integer, intent(in) :: iout
@@ -76,7 +77,7 @@ subroutine psb_zcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%'
endif
if (a%fida=='CSR') then
if (toupper(a%fida)=='CSR') then
write(iout,*) a%m,a%k,a%ia2(a%m+1)-1
@@ -114,7 +115,7 @@ subroutine psb_zcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
endif
endif
else if (a%fida=='COO') then
else if (toupper(a%fida)=='COO') then
if (present(ivr).and..not.present(ivc)) then
write(iout,*) a%m,a%k,a%infoa(psb_nnz_)
src/serial/psb_zspinfo.f90
+11 -10
View File
@@ -43,6 +43,7 @@ subroutine psb_zspinfo(ireq,a,ires,info,iaux)
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_string_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
@@ -61,14 +62,14 @@ subroutine psb_zspinfo(ireq,a,ires,info,iaux)
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (a%fida == 'CSC') then
else if (toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
@@ -87,9 +88,9 @@ subroutine psb_zspinfo(ireq,a,ires,info,iaux)
return
endif
irw = iaux
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
!!$ write(0,*) 'Gtrow_: srtd coo',irw
@@ -123,7 +124,7 @@ subroutine psb_zspinfo(ireq,a,ires,info,iaux)
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
pia = a%ia2(2) ! points to the beginning of ia(3,png)
pja = a%ia2(3) ! points to the beginning of ja(:)
ja => a%ia2(pja:) ! the array containing the pointers to ka and aspk
@@ -162,11 +163,11 @@ subroutine psb_zspinfo(ireq,a,ires,info,iaux)
end if
else if (ireq == psb_nzsizereq_) then
if (a%fida == 'CSR') then
if (toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((a%fida == 'COO').or.(a%fida == 'COI')) then
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (a%fida == 'JAD') then
else if (toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
src/tools/psb_dins.f90
+3 -3
View File
@@ -526,10 +526,10 @@ subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,&
if (present(insflag)) then
liflag = insflag
else
liflag = psb_upd_glb_
liflag = psb_upd_glbnum_
end if
if (liflag == psb_upd_glb_) then
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
@@ -544,7 +544,7 @@ subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,&
x(loc_row) = x(loc_row) + blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_loc_) then
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = x(i) + blck(i-ix+1)
src/tools/psb_zins.f90
+3 -3
View File
@@ -526,10 +526,10 @@ subroutine psb_zinsvv(m, x, ix, blck, desc_a, info,&
if (present(insflag)) then
liflag = insflag
else
liflag = psb_upd_glb_
liflag = psb_upd_glbnum_
end if
if (liflag == psb_upd_glb_) then
if (liflag == psb_upd_glbnum_) then
do i = 1, m
!loop over all blck's rows
@@ -544,7 +544,7 @@ subroutine psb_zinsvv(m, x, ix, blck, desc_a, info,&
x(loc_row) = x(loc_row) + blck(iblock+i-1)
end if
enddo
else if (liflag == psb_upd_loc_) then
else if (liflag == psb_upd_locnum_) then
k = min(ix+m-1,loc_rows)
do i=ix,k
x(i) = x(i) + blck(i-ix+1)