fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas-2.2-maint:

Browse Source 
base/comm/psb_dhalo.f90
 base/comm/psb_ihalo.f90
 base/comm/psb_zhalo.f90
 base/modules/psb_spmat_type.f90
 base/modules/psb_string_mod.f90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_dspsm.f90
 base/psblas/psb_zspmm.f90
 base/psblas/psb_zspsm.f90
 base/serial/dp/dcoco.f
 base/serial/dp/dcocr.f
 base/serial/dp/dcrco.f
 base/serial/dp/dcrcr.f
 base/serial/dp/dcrjd.f
 base/serial/dp/dcsrp1.f
 base/serial/dp/dcsrrp.f
 base/serial/dp/djadrp.f
 base/serial/dp/djadrp1.f
 base/serial/dp/djdcox.f
 base/serial/dp/dvtfg.f
 base/serial/dp/zcoco.f
 base/serial/dp/zcocr.f
 base/serial/dp/zcrco.f
 base/serial/dp/zcrcr.f
 base/serial/dp/zcrjd.f
 base/serial/jad/djadsm.f
 base/serial/psb_cest.f90
 base/serial/psb_dcoins.f90
 base/serial/psb_dcsprt.f90
 base/serial/psb_dfixcoo.f90
 base/serial/psb_dipcoo2csc.f90
 base/serial/psb_dipcoo2csr.f90
 base/serial/psb_dipcsr2coo.f90
 base/serial/psb_dnumbmm.f90
 base/serial/psb_drwextd.f90
 base/serial/psb_dspcnv.f90
 base/serial/psb_dspgetrow.f90
 base/serial/psb_dspscal.f90
 base/serial/psb_dsymbmm.f90
 base/serial/psb_dtransp.f90
 base/serial/psb_lsame.f90
 base/serial/psb_update_mod.f90
 base/serial/psb_zcoins.f90
 base/serial/psb_zcsprt.f90
 base/serial/psb_zfixcoo.f90
 base/serial/psb_zipcoo2csc.f90
 base/serial/psb_zipcoo2csr.f90
 base/serial/psb_zipcsr2coo.f90
 base/serial/psb_znumbmm.f90
 base/serial/psb_zrwextd.f90
 base/serial/psb_zspcnv.f90
 base/serial/psb_zspgetrow.f90
 base/serial/psb_zspscal.f90
 base/serial/psb_zsymbmm.f90
 base/serial/psb_ztransc.f90
 base/serial/psb_ztransp.f90
 base/tools/psb_cdren.f90
 base/tools/psb_dsphalo.F90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_loc_to_glob.f90
 base/tools/psb_zsphalo.F90
 krylov/psb_krylov_mod.f90
 prec/psb_dbjac_aply.f90
 prec/psb_dgprec_aply.f90
 prec/psb_dprc_aply.f90
 prec/psb_dprecbld.f90
 prec/psb_dprecinit.f90
 prec/psb_zbjac_aply.f90
 prec/psb_zgprec_aply.f90
 prec/psb_zprc_aply.f90
 prec/psb_zprecbld.f90
 prec/psb_zprecinit.f90
 util/psb_hbio_mod.f90
 util/psb_mat_dist_mod.f90
 util/psb_metispart_mod.F90
 util/psb_mmio_mod.f90
 util/psb_read_mat_mod.f90


Fixed name of TOUPPER and friends with prefix PSB_.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent c2edbeffe8
commit f0c52178c6
78 changed files with 280 additions and 278 deletions
Show Stats Download Patch File Download Diff File

4
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -120,7 +120,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif
@ -331,7 +331,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif

4
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -121,7 +121,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif
@ -337,7 +337,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif

4
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -120,7 +120,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif
@ -331,7 +331,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then
tran_ = toupper(tran)
tran_ = psb_toupper(tran)
else
tran_ = 'N'
endif

44
base/modules/psb_spmat_type.f90
Unescape Escape View File

@ -744,7 +744,7 @@ contains
ia = size(a%aspk)
return
endif
select case(tolower(a%fida))
select case(psb_tolower(a%fida))
case('csr')
nza = a%ia2(a%m+1)-1
ia = nza
@ -1231,7 +1231,7 @@ contains
ia = size(a%aspk)
return
endif
select case(tolower(a%fida))
select case(psb_tolower(a%fida))
case('csr')
nza = a%ia2(a%m+1)-1
ia = nza
@ -1373,14 +1373,14 @@ contains
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
else if (psb_toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
else if (psb_toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
@ -1404,9 +1404,9 @@ contains
ires = 0
return
endif
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
@ -1439,7 +1439,7 @@ contains
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
else if (psb_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
@ -1478,11 +1478,11 @@ contains
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
else if (psb_toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1
@ -1533,14 +1533,14 @@ contains
if (ireq == psb_nztotreq_) then
! The number of nonzeroes
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
nr = a%m
ires = a%ia2(nr+1)-1
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'JAD') then
else if (psb_toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else if (toupper(a%fida) == 'CSC') then
else if (psb_toupper(a%fida) == 'CSC') then
nc = a%k
ires = a%ia2(nc+1)-1
else
@ -1559,9 +1559,9 @@ contains
return
endif
irw = iaux
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
ires = a%ia2(irw+1)-a%ia2(irw)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
! In this case we can do a binary search.
@ -1594,7 +1594,7 @@ contains
!!$ do i=1, a%infoa(psb_nnz_)
!!$ if (a%ia1(i) == irw) ires = ires + 1
!!$ enddo
else if (toupper(a%fida) == 'JAD') then
else if (psb_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
@ -1633,11 +1633,11 @@ contains
end if
else if (ireq == psb_nzsizereq_) then
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
ires = size(a%aspk)
else if ((toupper(a%fida) == 'COO').or.(toupper(a%fida) == 'COI')) then
else if ((psb_toupper(a%fida) == 'COO').or.(psb_toupper(a%fida) == 'COI')) then
ires = size(a%aspk)
else if (toupper(a%fida) == 'JAD') then
else if (psb_toupper(a%fida) == 'JAD') then
ires = a%infoa(psb_nnz_)
else
ires=-1

38
base/modules/psb_string_mod.f90
Unescape Escape View File

@ -31,17 +31,17 @@
!!$
module psb_string_mod
public tolower, toupper, touppers
interface tolower
module procedure tolowerc
public psb_tolower, psb_toupper, psb_touppers
interface psb_tolower
module procedure psb_tolowerc
end interface
interface toupper
module procedure toupperc
interface psb_toupper
module procedure psb_toupperc
end interface
interface touppers
module procedure sub_toupperc
interface psb_touppers
module procedure psb_sub_toupperc
end interface
private
@ -50,37 +50,37 @@ module psb_string_mod
contains
function tolowerc(string)
function psb_tolowerc(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: tolowerc
character(len=len(string)) :: psb_tolowerc
integer :: i,k
do i=1,len(string)
k = index(ucase,string(i:i))
if (k /=0 ) then
tolowerc(i:i) = lcase(k:k)
psb_tolowerc(i:i) = lcase(k:k)
else
tolowerc(i:i) = string(i:i)
psb_tolowerc(i:i) = string(i:i)
end if
enddo
end function tolowerc
end function psb_tolowerc
function toupperc(string)
function psb_toupperc(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: toupperc
character(len=len(string)) :: psb_toupperc
integer :: i,k
do i=1,len(string)
k = index(lcase,string(i:i))
if (k /=0 ) then
toupperc(i:i) = ucase(k:k)
psb_toupperc(i:i) = ucase(k:k)
else
toupperc(i:i) = string(i:i)
psb_toupperc(i:i) = string(i:i)
end if
enddo
end function toupperc
end function psb_toupperc
subroutine sub_toupperc(string,strout)
subroutine psb_sub_toupperc(string,strout)
character(len=*), intent(in) :: string
character(len=*), intent(out) :: strout
integer :: i,k
@ -93,6 +93,6 @@ contains
strout(i:i) = string(i:i)
end if
enddo
end subroutine sub_toupperc
end subroutine psb_sub_toupperc
end module psb_string_mod

4
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -147,7 +147,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
else
trans_ = 'N'
endif
@ -475,7 +475,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
else
trans_ = 'N'
endif

8
base/psblas/psb_dspsm.f90
Unescape Escape View File

@ -159,13 +159,13 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = toupper(unitd)
lunitd = psb_toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
itrans = toupper(trans)
itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then
! OK
else
@ -430,13 +430,13 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = toupper(unitd)
lunitd = psb_toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
itrans = toupper(trans)
itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then
! Ok
else

4
base/psblas/psb_zspmm.f90
Unescape Escape View File

@ -147,7 +147,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
else
trans_ = 'N'
endif
@ -475,7 +475,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
else
trans_ = 'N'
endif

8
base/psblas/psb_zspsm.f90
Unescape Escape View File

@ -158,13 +158,13 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = toupper(unitd)
lunitd = psb_toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
itrans = toupper(trans)
itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then
! OK
else
@ -429,13 +429,13 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = toupper(unitd)
lunitd = psb_toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
itrans = toupper(trans)
itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then
! Ok
else

20
base/serial/dp/dcoco.f
Unescape Escape View File

@ -77,8 +77,8 @@ c
call psb_getifield(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
if (toupper(trans).eq.'N') then
scale = (toupper(unitd).eq.'L') ! meaningless
if (psb_toupper(trans).eq.'N') then
scale = (psb_toupper(unitd).eq.'L') ! meaningless
p1(1) = 0
p2(1) = 0
@ -117,7 +117,7 @@ c
goto 9999
end if
if (toupper(descra(1:1)).eq.'G') then
if (psb_toupper(descra(1:1)).eq.'G') then
c
c sort COO data structure
c
@ -254,29 +254,29 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),
+ ': done rebuild COO',infon(1)
else if (toupper(descra(1:1)).eq.'S' .and.
+ toupper(descra(2:2)).eq.'U') then
else if (psb_toupper(descra(1:1)).eq.'S' .and.
+ psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
else if (toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'U') then
else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
else if (toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'L') then
else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ psb_toupper(descra(2:2)).eq.'L') then
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
end if
c
else if (toupper(trans).ne.'N') then
else if (psb_toupper(trans).ne.'N') then
c
c to do
c

20
base/serial/dp/dcocr.f
Unescape Escape View File

@ -82,9 +82,9 @@ C
call psb_getifield(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
call psb_getifield(regen_flag,psb_upd_,infon,psb_ifasize_,ierror)
IF (toupper(TRANS).EQ.'N') THEN
IF (psb_toupper(TRANS).EQ.'N') THEN
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
P1(1) = 0
P2(1) = 0
nnz = info(1)
@ -137,7 +137,7 @@ C
infon(psb_upd_pnt_) = 0
IF (toupper(descra(1:1)).EQ.'G') THEN
IF (psb_toupper(descra(1:1)).EQ.'G') THEN
C
C Sort COO data structure
C
@ -332,15 +332,15 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),': Done Rebuild CSR',
+ ian2(m+1),ia(elem)
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
do 20 k = 1, m
p2(k) = k
20 continue
else if (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
else if (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call reordvn(nnz,arn,itmp,ian1,aux)
@ -412,8 +412,8 @@ c ... sum the duplicated element ...
ian2(row+1) = elem_csr
enddo
else if (toupper(descra(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN
else if (psb_toupper(descra(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'L') THEN
call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call reordvn(nnz,arn,itmp,ian1,aux)
@ -490,7 +490,7 @@ c ... sum the duplicated element ...
end if
c
else if (toupper(TRANS).NE.'N') then
else if (psb_toupper(TRANS).NE.'N') then
c
c to do
c

20
base/serial/dp/dcrco.f
Unescape Escape View File

@ -68,8 +68,8 @@ C
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
IF (toupper(TRANS).EQ.'N') THEN
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
IF (psb_toupper(TRANS).EQ.'N') THEN
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
IP1(1) = 0
IP2(1) = 0
NNZ = IA2(M+1)-1
@ -99,7 +99,7 @@ C
GOTO 9999
END IF
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
C ... Construct COO Representation...
ELEM = 0
@ -116,8 +116,8 @@ C ... Construct COO Representation...
if (debug_level >= psb_debug_serial_)
+ write(debug_unit,*) trim(name),': endloop',m,elem
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
DO 20 K = 1, M
IP2(K) = K
@ -132,8 +132,8 @@ c$$$ CALL DVSMR(M,AR,IA1,IA2,IAN2(PNG),AUX(IWLEN),IP1,IP2,
c$$$ * IAN2(PIA),IAN2(PJA),IAN1,ARN,AUX(IWORK1),
c$$$ * AUX(IWORK2),NJA,IER,SCALE)
C
ELSE IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
@ -145,8 +145,8 @@ c$$$ CALL DVTMR(M,AR,IA1,IA2,ISTROW,IAN2(PNG),AUX(IWLEN),IP1,IP2,
c$$$ * IAN2(PIA),IAN2(PJA),IAN1,ARN,NJA,IER,SCALE)
C
ELSE IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'L') THEN
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
@ -163,7 +163,7 @@ c$$$ * IAN2(PIA),IAN2(PJA),IAN1,ARN,NJA,IER,SCALE)
END IF
C
ELSE IF (toupper(TRANS).NE.'N') THEN
ELSE IF (psb_toupper(TRANS).NE.'N') THEN
C
C TO DO
C

18
base/serial/dp/dcrcr.f
Unescape Escape View File

@ -196,14 +196,14 @@ C
C
C Check for argument errors
C
idescra=toupper(descra)
idescra=psb_toupper(descra)
IF (((idescra(1:1) .EQ. 'S' .OR. idescra(1:1) .EQ. 'H' .OR.
& idescra(1:1) .EQ. 'A') .AND. (toupper(unitd) .NE. 'B'))
& idescra(1:1) .EQ. 'A') .AND. (psb_toupper(unitd) .NE. 'B'))
+ .OR.
& (.NOT.((idescra(3:3).EQ.'N').OR.(idescra(3:3).EQ.'L').OR.
+ (idescra(3:3).EQ.'U')))
+ .OR.
+ toupper(TRANS).NE.'N') THEN
+ psb_toupper(TRANS).NE.'N') THEN
IERROR = 20
ENDIF
IF(LAN.LT.(IA2(M+1)-1)) THEN
@ -231,7 +231,8 @@ C
ENDIF
ENDIF
IF ((idescra(1:1) .EQ. 'S' .OR. idescra(1:1) .EQ. 'H' .OR.
& idescra(1:1) .EQ. 'A') .AND. (toupper(UNITD) .EQ. 'B')) THEN
& idescra(1:1) .EQ. 'A') .AND. (psb_toupper(UNITD) .EQ. 'B'))
+ THEN
IF (LWORK.LT.M) THEN
IF (LWORK.LE.0) THEN
EXIT=.TRUE.
@ -268,7 +269,8 @@ C
IAN2(I) = IA2(I)
20 CONTINUE
IF ((idescra(1:1) .EQ. 'S' .OR. idescra(1:1) .EQ. 'H' .OR.
& idescra(1:1) .EQ. 'A') .AND. (toupper(UNITD) .EQ. 'B')) THEN
& idescra(1:1) .EQ. 'A') .AND. (psb_toupper(UNITD) .EQ. 'B'))
+ THEN
DO 30 I = 1, M
WORK(I) = DSQRT(D(I))
30 CONTINUE
@ -278,21 +280,21 @@ C
IAN1(J) = IA1(J)
50 CONTINUE
40 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'L') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'L') THEN
DO 60 I = 1, M
DO 70 J = IA2(I), IA2(I+1)-1
AN(J) = D(I) * A(J)
IAN1(J) = IA1(J)
70 CONTINUE
60 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'R') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'R') THEN
DO 80 I = 1, M
DO 90 J = IA2(I), IA2(I+1)-1
AN(J) = A(J) * D(IA1(J))
IAN1(J) = IA1(J)
90 CONTINUE
80 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'U') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'U') THEN
DO 100 J = 1, IA2(M+1)-1
AN(J) = A(J)
IAN1(J) = IA1(J)

18
base/serial/dp/dcrjd.f
Unescape Escape View File

@ -103,10 +103,10 @@ C
GOTO 9999
ENDIF
IF (toupper(TRANS).EQ.'N') THEN
IF (psb_toupper(TRANS).EQ.'N') THEN
C
NJA = 3*M
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
IOFF = 5
C
C SET THE VALUES OF POINTERS TO VECTOR IAN2 AND AUX
@ -115,7 +115,7 @@ C
PIA = PNG + 1
PJA = PIA + 3*(M+2)
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
C
C CHECK ON DIMENSION OF IAN2 AND AUX
@ -183,8 +183,8 @@ C
DESCRN(2:2) = 'U'
DESCRN(3:3) = 'N'
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
C
ISTROW = 1
NZ = 2*(IA2(M+1)-1) - M
@ -220,13 +220,13 @@ c$$$ CALL DVSMR(M,AR,IA1,IA2,IAN2(PNG),AUX(IWLEN),IP1,IP2,
c$$$ * IAN2(PIA),IAN2(PJA),IAN1,ARN,AUX(IWORK1),
c$$$ * AUX(IWORK2),NJA,IER,SCALE)
C
ELSE IF (toupper(DESCRA(1:1)).EQ.'T') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T') THEN
C
C Only unit diagonal so far for triangular matrices.
C
IF (toupper(DESCRA(3:3)).NE.'U') THEN
IF (psb_toupper(DESCRA(3:3)).NE.'U') THEN
IERROR=3022
CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL)
GOTO 9999
@ -275,7 +275,7 @@ c$$$ write(0,*) "error 2",ierrv(1)
ENDIF
DESCRN(1:1) = 'T'
DESCRN(2:3) = toupper(DESCRA(2:3))
DESCRN(2:3) = psb_toupper(DESCRA(2:3))
END IF
C
@ -289,7 +289,7 @@ C
LIAN2 = 3*M + 10
LAUX2 = 4*M + 2
C
ELSE IF (toupper(TRANS).NE.'N') THEN
ELSE IF (psb_toupper(TRANS).NE.'N') THEN
C
C TO BE DONE
C

4
base/serial/dp/dcsrp1.f
Unescape Escape View File

@ -142,14 +142,14 @@ C
IERROR = 0
CALL FCPSB_ERRACTIONSAVE(ERR_ACT)
IF(toupper(TRANS).EQ.'N') THEN
IF(psb_toupper(TRANS).EQ.'N') THEN
DO 30 I=1,M
DO 10 J=IA(I),IA(I+1)-1
JA(J) = P(JA(J))
10 CONTINUE
30 CONTINUE
WORK(1) = 0.D0
ELSE IF(toupper(TRANS).EQ.'T') THEN
ELSE IF(psb_toupper(TRANS).EQ.'T') THEN
C
C LWORK refers here to INTEGER IWORK (alias for WORK)
C

4
base/serial/dp/dcsrrp.f
Unescape Escape View File

@ -146,8 +146,8 @@ C
IERROR = 0
CALL FCPSB_ERRACTIONSAVE(ERR_ACT)
IF (toupper(DESCRA(1:1)).EQ.'S' .OR.
+ toupper(DESCRA(1:1)).EQ.'T') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'S' .OR.
+ psb_toupper(DESCRA(1:1)).EQ.'T') THEN
IERROR=3023
CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL)
GOTO 9999

2
base/serial/dp/djadrp.f
Unescape Escape View File

@ -149,7 +149,7 @@ C
PIA = PNG + 1
PJA = PIA + 3*(IA(PNG)+1)
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
CALL DJADRP1(TRANS,M,N,DESCRA,IA(PNG),
+ JA,IA(PIA),IA(PJA),P,WORK,LWORK*2)
ELSE

4
base/serial/dp/djadrp1.f
Unescape Escape View File

@ -126,7 +126,7 @@ C
IERROR = 0
CALL FCPSB_ERRACTIONSAVE(ERR_ACT)
IF(toupper(TRANS).EQ.'N') THEN
IF(psb_toupper(TRANS).EQ.'N') THEN
DO IPG = 1, NG
DO K = IA(2,IPG), IA(3,IPG)-1
DO I = JA(K), JA(K+1) - 1
@ -143,7 +143,7 @@ C Permute CSR
ENDDO
IWORK(1) = 0
ELSE IF(toupper(TRANS).EQ.'T') THEN
ELSE IF(psb_toupper(TRANS).EQ.'T') THEN
C
C LWORK refers here to INTEGER IWORK (alias for WORK)
C

10
base/serial/dp/djdcox.f
Unescape Escape View File

@ -70,7 +70,7 @@ C
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
IF (toupper(TRANS).EQ.'N') THEN
IF (psb_toupper(TRANS).EQ.'N') THEN
C SCALE = (UNITD.EQ.'L') ! meaningless
IP1(1) = 0
IP2(1) = 0
@ -109,7 +109,7 @@ C SCALE = (UNITD.EQ.'L') ! meaningless
INT_VAL(3) = LAUX
ENDIF
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
DO 200 IPG = 1, NG
DO 50 K = IA(2,IPG), IA(3,IPG)-1
@ -155,8 +155,8 @@ C .... Order with key IA2N ...
ENDDO
INFON(1)=nnz
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
DO 20 K = 1, M
IP2(K) = K
@ -172,7 +172,7 @@ c$$$ ELSE IF (DESCRA(1:1).EQ.'T' .AND. DESCRA(2:2).EQ.'L') THEN
END IF
C
ELSE IF (toupper(TRANS).NE.'N') THEN
ELSE IF (psb_toupper(TRANS).NE.'N') THEN
C
C TO DO
C

4
base/serial/dp/dvtfg.f
Unescape Escape View File

@ -79,7 +79,7 @@ C
IWORK1(I) = 0
IWORK3(I) = 0
40 CONTINUE
IF (toupper(UPLO).EQ.'L') THEN
IF (psb_toupper(UPLO).EQ.'L') THEN
C
C LOWER TRIANGULAR SPARSE MATRIX
C
@ -89,7 +89,7 @@ C
IWORK1(I) = MAX(IWORK1(I),IWORK1(JA(J))+1)
60 CONTINUE
80 CONTINUE
ELSE IF (toupper(UPLO).EQ.'U') THEN
ELSE IF (psb_toupper(UPLO).EQ.'U') THEN
C
C UPPER TRIANGULAR SPARSE MATRIX
C

20
base/serial/dp/zcoco.f
Unescape Escape View File

@ -77,8 +77,8 @@ c
call psb_getifield(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
if (toupper(trans).eq.'N') then
scale = (toupper(unitd).eq.'L') ! meaningless
if (psb_toupper(trans).eq.'N') then
scale = (psb_toupper(unitd).eq.'L') ! meaningless
p1(1) = 0
p2(1) = 0
@ -117,7 +117,7 @@ c
goto 9999
end if
if (toupper(descra(1:1)).eq.'G') then
if (psb_toupper(descra(1:1)).eq.'G') then
c
c sort COO data structure
c
@ -255,29 +255,29 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),
+ ': done rebuild COO',infon(1)
else if (toupper(descra(1:1)).eq.'S' .and.
+ toupper(descra(2:2)).eq.'U') then
else if (psb_toupper(descra(1:1)).eq.'S' .and.
+ psb_toupper(descra(2:2)).eq.'U') then
do 20 k = 1, m
p2(k) = k
20 continue
else if (toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'U') then
else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
else if (toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'L') then
else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ psb_toupper(descra(2:2)).eq.'L') then
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
end if
c
else if (toupper(trans).ne.'N') then
else if (psb_toupper(trans).ne.'N') then
c
c to do
c

20
base/serial/dp/zcocr.f
Unescape Escape View File

@ -81,9 +81,9 @@ C
call psb_getifield(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
call psb_getifield(regen_flag,psb_upd_,infon,psb_ifasize_,ierror)
IF (toupper(TRANS).EQ.'N') THEN
IF (psb_toupper(TRANS).EQ.'N') THEN
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
P1(1) = 0
P2(1) = 0
nnz = info(1)
@ -136,7 +136,7 @@ C
infon(psb_upd_pnt_) = 0
IF (toupper(descra(1:1)).EQ.'G') THEN
IF (psb_toupper(descra(1:1)).EQ.'G') THEN
C
C Sort COO data structure
C
@ -332,15 +332,15 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),': Done Rebuild CSR',
+ ian2(m+1),ia(elem)
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
do 20 k = 1, m
p2(k) = k
20 continue
else if (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
else if (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call zreordvn(nnz,arn,itmp,ian1,aux)
@ -412,8 +412,8 @@ c ... sum the duplicated element ...
ian2(row+1) = elem_csr
enddo
else if (toupper(descra(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN
else if (psb_toupper(descra(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'L') THEN
call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call zreordvn(nnz,arn,itmp,ian1,aux)
@ -490,7 +490,7 @@ c ... sum the duplicated element ...
end if
c
else if (toupper(TRANS).NE.'N') then
else if (psb_toupper(TRANS).NE.'N') then
c
c to do
c

20
base/serial/dp/zcrco.f
Unescape Escape View File

@ -68,8 +68,8 @@ C
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
IF (toupper(TRANS).EQ.'N') THEN
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
IF (psb_toupper(TRANS).EQ.'N') THEN
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
IP1(1) = 0
IP2(1) = 0
NNZ = IA2(M+1)-1
@ -99,7 +99,7 @@ C
GOTO 9999
END IF
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
C ... Construct COO Representation...
ELEM = 0
@ -115,8 +115,8 @@ C ... Construct COO Representation...
if (debug_level >= psb_debug_serial_)
+ write(debug_unit,*) trim(name),': endloop',m,elem
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
DO 20 K = 1, M
IP2(K) = K
@ -126,16 +126,16 @@ C ... Construct COO Representation...
call fcpsb_errpush(ierror,name,int_val)
goto 9999
C
ELSE IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
C
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
goto 9999
ELSE IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'L') THEN
ierror = 3021
call fcpsb_errpush(ierror,name,int_val)
@ -143,7 +143,7 @@ C
END IF
C
ELSE IF (toupper(TRANS).NE.'N') THEN
ELSE IF (psb_toupper(TRANS).NE.'N') THEN
C
C TO DO
C

16
base/serial/dp/zcrcr.f
Unescape Escape View File

@ -196,12 +196,12 @@ C
C
C Check for argument errors
C
idescra=toupper(descra)
idescra=psb_toupper(descra)
IF(((IDESCRA(1:1) .EQ. 'S' .OR. IDESCRA(1:1) .EQ. 'H' .OR.
& IDESCRA(1:1) .EQ. 'A') .AND. (toupper(UNITD) .NE. 'B')) .OR.
& IDESCRA(1:1) .EQ. 'A') .AND. (psb_toupper(UNITD) .NE. 'B')).OR.
& (.NOT.((IDESCRA(3:3).EQ.'N').OR.(IDESCRA(3:3).EQ.'L').OR.
+ (IDESCRA(3:3).EQ.'U'))) .OR.
+ toupper(TRANS).NE.'N') THEN
+ psb_toupper(TRANS).NE.'N') THEN
IERROR = 20
ENDIF
IF(LAN.LT.(IA2(M+1)-1)) THEN
@ -229,7 +229,7 @@ C
ENDIF
ENDIF
IF ((IDESCRA(1:1) .EQ. 'S' .OR. IDESCRA(1:1) .EQ. 'H' .OR.
& IDESCRA(1:1) .EQ. 'A') .AND. (toupper(UNITD) .EQ. 'B')) THEN
& IDESCRA(1:1) .EQ. 'A') .AND. (psb_toupper(UNITD) .EQ. 'B')) THEN
IF (LWORK.LT.M) THEN
IF (LWORK.LE.0) THEN
EXIT=.TRUE.
@ -266,7 +266,7 @@ C
IAN2(I) = IA2(I)
20 CONTINUE
IF ((IDESCRA(1:1) .EQ. 'S' .OR. IDESCRA(1:1) .EQ. 'H' .OR.
& IDESCRA(1:1) .EQ. 'A') .AND. (toupper(UNITD) .EQ. 'B')) THEN
& IDESCRA(1:1) .EQ. 'A') .AND. (psb_toupper(UNITD) .EQ. 'B')) THEN
DO 30 I = 1, M
WORK(I) = DBLE(DSQRT(ABS(D(I))))
30 CONTINUE
@ -276,21 +276,21 @@ C
IAN1(J) = IA1(J)
50 CONTINUE
40 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'L') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'L') THEN
DO 60 I = 1, M
DO 70 J = IA2(I), IA2(I+1)-1
AN(J) = D(I) * A(J)
IAN1(J) = IA1(J)
70 CONTINUE
60 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'R') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'R') THEN
DO 80 I = 1, M
DO 90 J = IA2(I), IA2(I+1)-1
AN(J) = A(J) * D(IA1(J))
IAN1(J) = IA1(J)
90 CONTINUE
80 CONTINUE
ELSE IF (toupper(UNITD) .EQ. 'U') THEN
ELSE IF (psb_toupper(UNITD) .EQ. 'U') THEN
DO 100 J = 1, IA2(M+1)-1
AN(J) = A(J)
IAN1(J) = IA1(J)

18
base/serial/dp/zcrjd.f
Unescape Escape View File

@ -103,10 +103,10 @@ C
GOTO 9999
ENDIF
IF (toupper(TRANS).EQ.'N') THEN
IF (psb_toupper(TRANS).EQ.'N') THEN
C
NJA = 3*M
SCALE = (toupper(UNITD).EQ.'L') ! meaningless
SCALE = (psb_toupper(UNITD).EQ.'L') ! meaningless
IOFF = 5
C
C SET THE VALUES OF POINTERS TO VECTOR IAN2 AND AUX
@ -115,7 +115,7 @@ C
PIA = PNG + 1
PJA = PIA + 3*(M+2)
IF (toupper(DESCRA(1:1)).EQ.'G') THEN
IF (psb_toupper(DESCRA(1:1)).EQ.'G') THEN
C
C CHECK ON DIMENSION OF IAN2 AND AUX
@ -183,8 +183,8 @@ C
DESCRN(2:2) = 'U'
DESCRN(3:3) = 'N'
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') THEN
C
ISTROW = 1
NZ = 2*(IA2(M+1)-1) - M
@ -220,13 +220,13 @@ c$$$ CALL DVSMR(M,AR,IA1,IA2,IAN2(PNG),AUX(IWLEN),IP1,IP2,
c$$$ * IAN2(PIA),IAN2(PJA),IAN1,ARN,AUX(IWORK1),
c$$$ * AUX(IWORK2),NJA,IER,SCALE)
C
ELSE IF (toupper(DESCRA(1:1)).EQ.'T') THEN
ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'T') THEN
C
C Only unit diagonal so far for triangular matrices.
C
IF (toupper(DESCRA(3:3)).NE.'U') THEN
IF (psb_toupper(DESCRA(3:3)).NE.'U') THEN
IERROR=3022
CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL)
GOTO 9999
@ -275,7 +275,7 @@ c$$$ write(0,*) "error 2",ierrv(1)
ENDIF
DESCRN(1:1) = 'T'
DESCRN(2:3) = toupper(DESCRA(2:3))
DESCRN(2:3) = psb_toupper(DESCRA(2:3))
END IF
C
@ -289,7 +289,7 @@ C
LIAN2 = 3*M + 10
LAUX2 = 4*M + 2
C
ELSE IF (toupper(TRANS).NE.'N') THEN
ELSE IF (psb_toupper(TRANS).NE.'N') THEN
C
C TO BE DONE
C

14
base/serial/jad/djadsm.f
Unescape Escape View File

@ -66,10 +66,10 @@ C
GOTO 9999
ENDIF
UPLO = '?'
IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') UPLO = 'U'
IF (toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') UPLO = 'L'
IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'U') UPLO = 'U'
IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ psb_toupper(DESCRA(2:2)).EQ.'L') UPLO = 'L'
C
IF (UPLO.EQ.'?') THEN
IERROR=5
@ -77,7 +77,7 @@ C
GOTO 9999
END IF
IF (toupper(DESCRA(3:3)).NE.'U') THEN
IF (psb_toupper(DESCRA(3:3)).NE.'U') THEN
IERROR=5
CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL)
GOTO 9999
@ -89,7 +89,7 @@ C
if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': entry',m,n
IF (toupper(TDIAG).EQ.'R') THEN
IF (psb_toupper(TDIAG).EQ.'R') THEN
if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': Right Scale'
DO I = 1, N
@ -114,7 +114,7 @@ C
END IF
IF (toupper(TDIAG).EQ.'L') THEN
IF (psb_toupper(TDIAG).EQ.'L') THEN
if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': Left Scale'
DO I = 1, N

6
base/serial/psb_cest.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
afmt = psb_fidef_
endif
afmt = toupper(afmt)
afmt = psb_toupper(afmt)
select case(iup)
case (psb_upd_perm_)
@ -71,7 +71,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=toupper(afmt))
call psb_errpush(info,name,a_err=psb_toupper(afmt))
goto 9999
endif
@ -91,7 +91,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=toupper(afmt))
call psb_errpush(info,name,a_err=psb_toupper(afmt))
goto 9999
endif

2
base/serial/psb_dcoins.f90
Unescape Escape View File

@ -119,7 +119,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
rebuild_ = .false.
end if
call touppers(a%fida,ufida)
call psb_touppers(a%fida,ufida)
spstate = psb_sp_getifld(psb_state_,a,info)

4
base/serial/psb_dcsprt.f90
Unescape Escape View File

@ -76,10 +76,10 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%%MatrixMarket matrix coordinate real general'
write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%'
write(iout,'(a,a)') '% ',toupper(a%fida)
write(iout,'(a,a)') '% ',psb_toupper(a%fida)
endif
select case(toupper(a%fida))
select case(psb_toupper(a%fida))
case ('CSR')

2
base/serial/psb_dfixcoo.f90
Unescape Escape View File

@ -61,7 +61,7 @@ subroutine psb_dfixcoo(a,info,idir)
if(debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),': start ',&
& size(a%ia1),size(a%ia2)
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) 'Fixcoo Invalid input ',a%fida
info = -1
return

2
base/serial/psb_dipcoo2csc.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_dipcoo2csc(a,info,clshr)
if(debug_level >= psb_debug_serial_) write(debug_unit,*) &
& trim(name),': start',a%fida,a%m
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) trim(name),' Invalid input ',a%fida
info = -1
call psb_errpush(info,name)

2
base/serial/psb_dipcoo2csr.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': start',a%fida,a%m
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) trim(name),': Invalid input ',a%fida
info = -1
call psb_errpush(info,name)

2
base/serial/psb_dipcsr2coo.f90
Unescape Escape View File

@ -55,7 +55,7 @@ Subroutine psb_dipcsr2coo(a,info)
info = 0
call psb_erractionsave(err_act)
if (toupper(a%fida) /= 'CSR') then
if (psb_toupper(a%fida) /= 'CSR') then
info = 5
call psb_errpush(info,name)
goto 9999

4
base/serial/psb_dnumbmm.f90
Unescape Escape View File

@ -59,8 +59,8 @@ subroutine psb_dnumbmm(a,b,c)
! Note: we still have to test about possible performance hits.
!
!
csra = (toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR')
csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (csra.and.csrb) then
call numbmm(a%m,a%k,b%k,a%ia2,a%ia1,0,a%aspk,&

10
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -67,13 +67,13 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
end if
if (nr > a%m) then
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
call psb_ensure_size(nr+1,a%ia2,info)
if (present(b)) then
nzb = psb_sp_get_nnzeros(b)
call psb_ensure_size(size(a%ia1)+nzb,a%ia1,info)
call psb_ensure_size(size(a%aspk)+nzb,a%aspk,info)
if (toupper(b%fida)=='CSR') then
if (psb_toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m)
a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i)
@ -101,13 +101,13 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
a%m = nr
a%k = max(a%k,b%k)
else if (toupper(a%fida) == 'COO') then
else if (psb_toupper(a%fida) == 'COO') then
if (present(b)) then
nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info)
if (toupper(b%fida)=='COO') then
if (psb_toupper(b%fida)=='COO') then
if (rowscale_) then
do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then
@ -128,7 +128,7 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
enddo
endif
a%infoa(psb_nnz_) = nza
else if(toupper(b%fida)=='CSR') then
else if(psb_toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m)
do
jb = b%ia2(i)

14
base/serial/psb_dspcnv.f90
Unescape Escape View File

@ -170,11 +170,11 @@ subroutine psb_dspcnv2(a, b,info,afmt,upd,dupl)
& write(debug_unit,*) trim(name),': size_req 1:',&
& size_req, trans_,upd_,dupl_,b%fida,b%descra
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case ('csr')
select case (tolower(b%fida))
select case (psb_tolower(b%fida))
case ('csr')
@ -255,7 +255,7 @@ subroutine psb_dspcnv2(a, b,info,afmt,upd,dupl)
case ('coo','coi')
select case (tolower(b%fida))
select case (psb_tolower(b%fida))
case ('csr')
@ -457,9 +457,9 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
& ': Update:',upd_,psb_upd_srch_,psb_upd_perm_
if (upd_ == psb_upd_srch_) then
if (present(afmt)) then
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case('coo')
select case(tolower(afmt))
select case(psb_tolower(afmt))
case('coo')
call psb_fixcoo(a,info)
goto 9998
@ -471,7 +471,7 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
goto 9998
end select
case('csr')
select case(tolower(afmt))
select case(psb_tolower(afmt))
case('coo')
call psb_ipcsr2coo(a,info)
goto 9998
@ -510,7 +510,7 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
!
! Second case: we come from an update loop.
!
select case(tolower(a%fida))
select case(psb_tolower(a%fida))
case('csr')
call csr_regen(a,info)
case ('coo','coi')

2
base/serial/psb_dspgetrow.f90
Unescape Escape View File

@ -98,7 +98,7 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
nzin_ = 0
endif
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case ('csr')
call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren)
case ('coo')

2
base/serial/psb_dspscal.f90
Unescape Escape View File

@ -56,7 +56,7 @@ subroutine psb_dspscal(a,d,info)
info = 0
call psb_erractionsave(err_act)
select case(toupper(a%fida(1:3)))
select case(psb_toupper(a%fida(1:3)))
case ('CSR')
do i=1, a%m

4
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -63,8 +63,8 @@ subroutine psb_dsymbmm(a,b,c,info)
name='psb_symbmm'
call psb_erractionsave(err_act)
csra = (toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR')
csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (b%m /= a%k) then
write(0,*) 'Mismatch in SYMBMM: ',a%m,a%k,b%m,b%k

2
base/serial/psb_dtransp.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_dtransp(a,b,c,fmt)
c_=1
endif
if (present(fmt)) then
fmt_ = toupper(fmt)
fmt_ = psb_toupper(fmt)
else
fmt_='CSR'
endif

2
base/serial/psb_lsame.f90
Unescape Escape View File

@ -34,5 +34,5 @@ function psb_lsame(a,b)
logical :: psb_lsame
character(len=1) :: a, b
psb_lsame = (tolower(a) == tolower(b))
psb_lsame = (psb_tolower(a) == psb_tolower(b))
end function psb_lsame

6
base/serial/psb_update_mod.f90
Unescape Escape View File

@ -76,7 +76,7 @@ contains
return
endif
end if
select case(tolower(a%fida))
select case(psb_tolower(a%fida))
case ('csr')
call csr_srch_upd(nz,ia,ja,val,nza,a,&
& imin,imax,jmin,jmax,nzl,info,gtl,ng)
@ -121,7 +121,7 @@ contains
return
endif
select case(toupper(a%fida))
select case(psb_toupper(a%fida))
case ('CSR')
!!$ write(0,*) 'Calling csr_srch_upd'
call csr_srch_upd(nz,ia,ja,val,nza,a,&
@ -137,7 +137,7 @@ contains
end select
else
select case(toupper(a%fida))
select case(psb_toupper(a%fida))
case ('CSR')
!!$ write(0,*) 'Calling csr_srch_upd'
call csr_srch_upd(nz,ia,ja,val,nza,a,&

2
base/serial/psb_zcoins.f90
Unescape Escape View File

@ -96,7 +96,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
rebuild_ = .false.
end if
call touppers(a%fida,ufida)
call psb_touppers(a%fida,ufida)
spstate = psb_sp_getifld(psb_state_,a,info)

4
base/serial/psb_zcsprt.f90
Unescape Escape View File

@ -76,10 +76,10 @@ subroutine psb_zcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%'
write(iout,'(a,a)') '% ',toupper(a%fida)
write(iout,'(a,a)') '% ',psb_toupper(a%fida)
endif
select case(toupper(a%fida))
select case(psb_toupper(a%fida))
case ('CSR')

2
base/serial/psb_zfixcoo.f90
Unescape Escape View File

@ -61,7 +61,7 @@ Subroutine psb_zfixcoo(a,info,idir)
if(debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),': start ',&
& size(a%ia1),size(a%ia2)
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) 'Fixcoo Invalid input ',a%fida
info = -1
return

2
base/serial/psb_zipcoo2csc.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_zipcoo2csc(a,info,clshr)
if(debug_level >= psb_debug_serial_) write(debug_unit,*) &
& trim(name),': start',a%fida,a%m
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) trim(name),' Invalid input ',a%fida
info = -1
call psb_errpush(info,name)

2
base/serial/psb_zipcoo2csr.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': start',a%fida,a%m
if (toupper(a%fida) /= 'COO') then
if (psb_toupper(a%fida) /= 'COO') then
write(debug_unit,*) trim(name),': Invalid input ',a%fida
info = -1
call psb_errpush(info,name)

2
base/serial/psb_zipcsr2coo.f90
Unescape Escape View File

@ -55,7 +55,7 @@ Subroutine psb_zipcsr2coo(a,info)
info = 0
call psb_erractionsave(err_act)
if (toupper(a%fida) /= 'CSR') then
if (psb_toupper(a%fida) /= 'CSR') then
info = 5
call psb_errpush(info,name)
goto 9999

4
base/serial/psb_znumbmm.f90
Unescape Escape View File

@ -59,8 +59,8 @@ subroutine psb_znumbmm(a,b,c)
! Note: we still have to test about possible performance hits.
!
!
csra = (toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR')
csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (csra.and.csrb) then
call znumbmm(a%m,a%k,b%k,a%ia2,a%ia1,0,a%aspk,&

10
base/serial/psb_zrwextd.f90
Unescape Escape View File

@ -66,13 +66,13 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
end if
if (nr > a%m) then
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
call psb_realloc(nr+1,a%ia2,info)
if (present(b)) then
nzb = psb_sp_get_nnzeros(b)
call psb_realloc(size(a%ia1)+nzb,a%ia1,info)
call psb_realloc(size(a%aspk)+nzb,a%aspk,info)
if (toupper(b%fida)=='CSR') then
if (psb_toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m)
a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i)
@ -100,13 +100,13 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
a%m = nr
a%k = max(a%k,b%k)
else if (toupper(a%fida) == 'COO') then
else if (psb_toupper(a%fida) == 'COO') then
if (present(b)) then
nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info)
if (toupper(b%fida)=='COO') then
if (psb_toupper(b%fida)=='COO') then
if (rowscale_) then
do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then
@ -127,7 +127,7 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
enddo
endif
a%infoa(psb_nnz_) = nza
else if(toupper(b%fida)=='CSR') then
else if(psb_toupper(b%fida)=='CSR') then
do i=1, min(nr-a%m,b%m)
do
jb = b%ia2(i)

14
base/serial/psb_zspcnv.f90
Unescape Escape View File

@ -170,11 +170,11 @@ subroutine psb_zspcnv2(a, b,info,afmt,upd,dupl)
& write(debug_unit,*) trim(name),': size_req 1:',&
& size_req, trans_,upd_,dupl_,b%fida,b%descra
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case ('csr')
select case (tolower(b%fida))
select case (psb_tolower(b%fida))
case ('csr')
@ -255,7 +255,7 @@ subroutine psb_zspcnv2(a, b,info,afmt,upd,dupl)
case ('coo','coi')
select case (tolower(b%fida))
select case (psb_tolower(b%fida))
case ('csr')
@ -457,9 +457,9 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
& ': Update:',upd_,psb_upd_srch_,psb_upd_perm_
if (upd_ == psb_upd_srch_) then
if (present(afmt)) then
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case('coo')
select case(tolower(afmt))
select case(psb_tolower(afmt))
case('coo')
call psb_fixcoo(a,info)
goto 9998
@ -471,7 +471,7 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
goto 9998
end select
case('csr')
select case(tolower(afmt))
select case(psb_tolower(afmt))
case('coo')
call psb_ipcsr2coo(a,info)
goto 9998
@ -510,7 +510,7 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
!
! Second case: we come from an update loop.
!
select case(tolower(a%fida))
select case(psb_tolower(a%fida))
case('csr')
call csr_regen(a,info)
case ('coo','coi')

2
base/serial/psb_zspgetrow.f90
Unescape Escape View File

@ -98,7 +98,7 @@ subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
nzin_ = 0
endif
select case (tolower(a%fida))
select case (psb_tolower(a%fida))
case ('csr')
call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren)
case ('coo')

2
base/serial/psb_zspscal.f90
Unescape Escape View File

@ -56,7 +56,7 @@ subroutine psb_zspscal(a,d,info)
info = 0
call psb_erractionsave(err_act)
select case(toupper(a%fida(1:3)))
select case(psb_toupper(a%fida(1:3)))
case ('CSR')
do i=1, a%m

4
base/serial/psb_zsymbmm.f90
Unescape Escape View File

@ -64,8 +64,8 @@ subroutine psb_zsymbmm(a,b,c,info)
name='psb_symbmm'
call psb_erractionsave(err_act)
csra = (toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR')
csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (b%m /= a%k) then
write(0,*) 'Mismatch in SYMBMM: ',a%m,a%k,b%m,b%k

2
base/serial/psb_ztransc.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_ztransc(a,b,c,fmt)
c_=1
endif
if (present(fmt)) then
fmt_ = toupper(fmt)
fmt_ = psb_toupper(fmt)
else
fmt_='CSR'
endif

2
base/serial/psb_ztransp.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_ztransp(a,b,c,fmt)
c_=1
endif
if (present(fmt)) then
fmt_ = toupper(fmt)
fmt_ = psb_toupper(fmt)
else
fmt_='CSR'
endif

4
base/tools/psb_cdren.f90
Unescape Escape View File

@ -115,14 +115,14 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': here we go with ',iperm(1)
call psb_ensure_size(n_col,desc_a%lprm,info)
if (toupper(trans) == 'N') then
if (psb_toupper(trans) == 'N') then
do i=1, n_row
desc_a%lprm(iperm(i)) = i
enddo
do i=n_row+1,n_col
desc_a%lprm(i) = i
enddo
else if (toupper(trans) == 'T') then
else if (psb_toupper(trans) == 'T') then
do i=1, n_row
desc_a%lprm(i) = iperm(i)
enddo

2
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -133,7 +133,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
endif
if (present(outfmt)) then
outfmt_ = toupper(outfmt)
outfmt_ = psb_toupper(outfmt)
else
outfmt_ = 'CSR'
endif

4
base/tools/psb_glob_to_loc.f90
Unescape Escape View File

@ -81,7 +81,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned)
else
act='I'
endif
act = toupper(act)
act = psb_toupper(act)
if (present(owned)) then
owned_=owned
else
@ -215,7 +215,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
owned_=.false.
end if
act = toupper(act)
act = psb_toupper(act)
n = size(x)
call psi_idx_cnv(n,x,desc_a,info,owned=owned_)

4
base/tools/psb_loc_to_glob.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
else
act='I'
endif
act=toupper(act)
act=psb_toupper(act)
n=size(x)
do i=1,n
@ -202,7 +202,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
else
act='I'
endif
act = toupper(act)
act = psb_toupper(act)
n=size(x)
do i=1,n

2
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -132,7 +132,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
endif
if (present(outfmt)) then
outfmt_ = toupper(outfmt)
outfmt_ = psb_toupper(outfmt)
else
outfmt_ = 'CSR'
endif

4
krylov/psb_krylov_mod.f90
Unescape Escape View File

@ -338,7 +338,7 @@ contains
call psb_info(ictxt, me, np)
select case(toupper(method))
select case(psb_toupper(method))
case('CG')
call psb_cg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)
@ -455,7 +455,7 @@ contains
call psb_info(ictxt, me, np)
select case(toupper(method))
select case(psb_toupper(method))
case('CG')
call psb_cg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)

2
prec/psb_dbjac_aply.f90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_info(ictxt, me, np)
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
select case(trans_)
case('N','T','C')
! Ok

2
prec/psb_dgprec_aply.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np)
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')

2
prec/psb_dprc_aply.f90
Unescape Escape View File

@ -156,7 +156,7 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np)
if (present(trans)) then
trans_=toupper(trans)
trans_=psb_toupper(trans)
else
trans_='N'
end if

2
prec/psb_dprecbld.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
call psb_info(ictxt, me, np)
if (present(upd)) then
upd_ = toupper(upd)
upd_ = psb_toupper(upd)
else
upd_='F'
endif

2
prec/psb_dprecinit.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psb_dprecinit(p,ptype,info)
if (info /= 0) return
p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype))))
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
p%iprcparm(:) = 0
p%iprcparm(psb_p_type_) = psb_noprec_

2
prec/psb_zbjac_aply.f90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_info(ictxt, me, np)
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
select case(trans_)
case('N','T','C')
! Ok

2
prec/psb_zgprec_aply.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np)
trans_ = toupper(trans)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')

2
prec/psb_zprc_aply.f90
Unescape Escape View File

@ -159,7 +159,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np)
if (present(trans)) then
trans_=toupper(trans)
trans_=psb_toupper(trans)
else
trans_='N'
end if

2
prec/psb_zprecbld.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
call psb_info(ictxt, me, np)
if (present(upd)) then
upd_ = toupper(upd)
upd_ = psb_toupper(upd)
else
upd_='F'
endif

2
prec/psb_zprecinit.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psb_zprecinit(p,ptype,info)
if (info /= 0) return
p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype))))
select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
p%iprcparm(:) = 0
p%iprcparm(psb_p_type_) = psb_noprec_

6
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,10 +1,10 @@
11 Number of inputs
a.mtx thm1000x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
rhs.mtx NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
thm1000x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE rhs.mtx NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
2 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC
01000 ITMAX
-1 ITRACE

18
util/psb_hbio_mod.f90
Unescape Escape View File

@ -97,8 +97,8 @@ contains
a%descra='G'
if (tolower(type(1:1)) == 'r') then
if (tolower(type(2:2)) == 'u') then
if (psb_tolower(type(1:1)) == 'r') then
if (psb_tolower(type(2:2)) == 'u') then
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
@ -110,7 +110,7 @@ contains
if (info == 0) read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
else if (tolower(type(2:2)) == 's') then
else if (psb_tolower(type(2:2)) == 's') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
@ -229,7 +229,7 @@ contains
key_ = 'PSBMAT00'
endif
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
nrow = a%m
ncol = a%k
@ -334,8 +334,8 @@ contains
if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
if (tolower(type(1:1)) == 'c') then
if (tolower(type(2:2)) == 'u') then
if (psb_tolower(type(1:1)) == 'c') then
if (psb_tolower(type(2:2)) == 'u') then
call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode)
@ -358,7 +358,7 @@ contains
if (info == 0) read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
else if (tolower(type(2:2)) == 's') then
else if (psb_tolower(type(2:2)) == 's') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
@ -413,7 +413,7 @@ contains
goto 993
end if
else if (tolower(type(2:2)) == 'h') then
else if (psb_tolower(type(2:2)) == 'h') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
@ -553,7 +553,7 @@ contains
else
key_ = 'PSBMAT00'
endif
if (toupper(a%fida) == 'CSR') then
if (psb_toupper(a%fida) == 'CSR') then
nrow = a%m
ncol = a%k

4
util/psb_mat_dist_mod.f90
Unescape Escape View File

@ -557,7 +557,7 @@ contains
call psb_info(ictxt, iam, np)
if (iam == root) then
! extract information from a_glob
if (toupper(a_glob%fida) /= 'CSR') then
if (psb_toupper(a_glob%fida) /= 'CSR') then
info=135
ch_err='CSR'
call psb_errpush(info,name,a_err=ch_err)
@ -1301,7 +1301,7 @@ contains
call psb_info(ictxt, iam, np)
if (iam == root) then
! extract information from a_glob
if (toupper(a_glob%fida) /= 'CSR') then
if (psb_toupper(a_glob%fida) /= 'CSR') then
info=135
ch_err='CSR'
call psb_errpush(info,name,a_err=ch_err)

2
util/psb_metispart_mod.F90
Unescape Escape View File

@ -158,7 +158,7 @@ contains
return
endif
if (nparts > 1) then
if (toupper(fida) == 'CSR') then
if (psb_toupper(fida) == 'CSR') then
iopt(1) = 0
numflag = 1
wgflag = 0

14
util/psb_mmio_mod.f90
Unescape Escape View File

@ -76,7 +76,7 @@ contains
read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym
if ( (tolower(object) /= 'matrix').or.(tolower(fmt)/='coordinate')) then
if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt)/='coordinate')) then
write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909
return
@ -88,7 +88,7 @@ contains
end do
read(line,fmt=*) nrow,ncol,nnzero
if ((tolower(type) == 'real').and.(tolower(sym) == 'general')) then
if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then
call psb_sp_all(nrow,ncol,a,nnzero,ircode)
a%fida = 'COO'
a%descra = 'G'
@ -99,7 +99,7 @@ contains
a%infoa(psb_nnz_) = nnzero
call psb_spcnv(a,ircode,afmt='csr')
else if ((tolower(type) == 'real').and.(tolower(sym) == 'symmetric')) then
else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
@ -228,7 +228,7 @@ contains
read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym
if ( (tolower(object) /= 'matrix').or.(tolower(fmt)/='coordinate')) then
if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt)/='coordinate')) then
write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909
return
@ -240,7 +240,7 @@ contains
end do
read(line,fmt=*) nrow,ncol,nnzero
if ((tolower(type) == 'complex').and.(tolower(sym) == 'general')) then
if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then
call psb_sp_all(nrow,ncol,a,nnzero,ircode)
if (ircode /= 0) goto 993
a%fida = 'COO'
@ -253,7 +253,7 @@ contains
call psb_spcnv(a,ircode,afmt='csr')
else if ((tolower(type) == 'complex').and.(tolower(sym) == 'symmetric')) then
else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
@ -277,7 +277,7 @@ contains
a%infoa(psb_nnz_) = nzr
call psb_spcnv(a,ircode,afmt='csr')
else if ((tolower(type) == 'complex').and.(tolower(sym) == 'hermitian')) then
else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)

4
util/psb_read_mat_mod.f90
Unescape Escape View File

@ -133,7 +133,7 @@ contains
read(line,fmt=*)nrow,ncol
if ((tolower(type) == 'real').and.(tolower(sym) == 'general')) then
if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then
allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993
read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol)
@ -222,7 +222,7 @@ contains
read(line,fmt=*)nrow,ncol
if ((tolower(type) == 'complex').and.(tolower(sym) == 'general')) then
if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then
allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993
do j=1, ncol

Write Preview
Loading…
Cancel
Save