diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 055ef7de..46d76c9a 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -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) diff --git a/src/modules/psb_const.fh b/src/modules/psb_const.fh index e7348c62..96502cc7 100644 --- a/src/modules/psb_const.fh +++ b/src/modules/psb_const.fh @@ -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) diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index f292ddfc..a517c55c 100644 --- a/src/psblas/psb_dspmm.f90 +++ b/src/psblas/psb_dspmm.f90 @@ -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 diff --git a/src/serial/jad/Makefile b/src/serial/jad/Makefile index 590719f0..70ef988a 100644 --- a/src/serial/jad/Makefile +++ b/src/serial/jad/Makefile @@ -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) diff --git a/src/serial/jad/dcojdupd.f b/src/serial/jad/dcojdupd.f deleted file mode 100644 index 54f7dcc7..00000000 --- a/src/serial/jad/dcojdupd.f +++ /dev/null @@ -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 - - diff --git a/src/serial/psb_dcsprt.f90 b/src/serial/psb_dcsprt.f90 index 9c243555..e2214a02 100644 --- a/src/serial/psb_dcsprt.f90 +++ b/src/serial/psb_dcsprt.f90 @@ -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_) diff --git a/src/serial/psb_dspinfo.f90 b/src/serial/psb_dspinfo.f90 index 5a1c1303..9fa81ca9 100644 --- a/src/serial/psb_dspinfo.f90 +++ b/src/serial/psb_dspinfo.f90 @@ -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 diff --git a/src/serial/psb_zcsprt.f90 b/src/serial/psb_zcsprt.f90 index d28e96fa..ee369eb0 100644 --- a/src/serial/psb_zcsprt.f90 +++ b/src/serial/psb_zcsprt.f90 @@ -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_) diff --git a/src/serial/psb_zspinfo.f90 b/src/serial/psb_zspinfo.f90 index b73bd0dc..e63969ba 100644 --- a/src/serial/psb_zspinfo.f90 +++ b/src/serial/psb_zspinfo.f90 @@ -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 diff --git a/src/tools/psb_dins.f90 b/src/tools/psb_dins.f90 index deba8a27..9b52f6c5 100644 --- a/src/tools/psb_dins.f90 +++ b/src/tools/psb_dins.f90 @@ -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) diff --git a/src/tools/psb_zins.f90 b/src/tools/psb_zins.f90 index 39acea24..144a4dca 100644 --- a/src/tools/psb_zins.f90 +++ b/src/tools/psb_zins.f90 @@ -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)