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 end if
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif 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) nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif 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 end if
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif endif
@ -337,7 +337,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif 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 end if
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif 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) nrow = psb_cd_get_local_rows(desc_a)
if (present(tran)) then if (present(tran)) then
tran_ = toupper(tran) tran_ = psb_toupper(tran)
else else
tran_ = 'N' tran_ = 'N'
endif endif

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

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

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

@ -31,17 +31,17 @@
!!$ !!$
module psb_string_mod module psb_string_mod
public tolower, toupper, touppers public psb_tolower, psb_toupper, psb_touppers
interface tolower interface psb_tolower
module procedure tolowerc module procedure psb_tolowerc
end interface end interface
interface toupper interface psb_toupper
module procedure toupperc module procedure psb_toupperc
end interface end interface
interface touppers interface psb_touppers
module procedure sub_toupperc module procedure psb_sub_toupperc
end interface end interface
private private
@ -50,37 +50,37 @@ module psb_string_mod
contains contains
function tolowerc(string) function psb_tolowerc(string)
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
character(len=len(string)) :: tolowerc character(len=len(string)) :: psb_tolowerc
integer :: i,k integer :: i,k
do i=1,len(string) do i=1,len(string)
k = index(ucase,string(i:i)) k = index(ucase,string(i:i))
if (k /=0 ) then if (k /=0 ) then
tolowerc(i:i) = lcase(k:k) psb_tolowerc(i:i) = lcase(k:k)
else else
tolowerc(i:i) = string(i:i) psb_tolowerc(i:i) = string(i:i)
end if end if
enddo enddo
end function tolowerc end function psb_tolowerc
function toupperc(string) function psb_toupperc(string)
character(len=*), intent(in) :: string character(len=*), intent(in) :: string
character(len=len(string)) :: toupperc character(len=len(string)) :: psb_toupperc
integer :: i,k integer :: i,k
do i=1,len(string) do i=1,len(string)
k = index(lcase,string(i:i)) k = index(lcase,string(i:i))
if (k /=0 ) then if (k /=0 ) then
toupperc(i:i) = ucase(k:k) psb_toupperc(i:i) = ucase(k:k)
else else
toupperc(i:i) = string(i:i) psb_toupperc(i:i) = string(i:i)
end if end if
enddo 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(in) :: string
character(len=*), intent(out) :: strout character(len=*), intent(out) :: strout
integer :: i,k integer :: i,k
@ -93,6 +93,6 @@ contains
strout(i:i) = string(i:i) strout(i:i) = string(i:i)
end if end if
enddo enddo
end subroutine sub_toupperc end subroutine psb_sub_toupperc
end module psb_string_mod 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 endif
if (present(trans)) then if (present(trans)) then
trans_ = toupper(trans) trans_ = psb_toupper(trans)
else else
trans_ = 'N' trans_ = 'N'
endif endif
@ -475,7 +475,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(trans)) then if (present(trans)) then
trans_ = toupper(trans) trans_ = psb_toupper(trans)
else else
trans_ = 'N' trans_ = 'N'
endif 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 endif
if (present(unitd)) then if (present(unitd)) then
lunitd = toupper(unitd) lunitd = psb_toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
itrans = toupper(trans) itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then
! OK ! OK
else else
@ -430,13 +430,13 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(unitd)) then if (present(unitd)) then
lunitd = toupper(unitd) lunitd = psb_toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
itrans = toupper(trans) itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then
! Ok ! Ok
else 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 endif
if (present(trans)) then if (present(trans)) then
trans_ = toupper(trans) trans_ = psb_toupper(trans)
else else
trans_ = 'N' trans_ = 'N'
endif endif
@ -475,7 +475,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(trans)) then if (present(trans)) then
trans_ = toupper(trans) trans_ = psb_toupper(trans)
else else
trans_ = 'N' trans_ = 'N'
endif 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 endif
if (present(unitd)) then if (present(unitd)) then
lunitd = toupper(unitd) lunitd = psb_toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
itrans = toupper(trans) itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then if((itrans == 'N').or.(itrans == 'T').or. (itrans == 'C')) then
! OK ! OK
else else
@ -429,13 +429,13 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(unitd)) then if (present(unitd)) then
lunitd = toupper(unitd) lunitd = psb_toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
itrans = toupper(trans) itrans = psb_toupper(trans)
if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then
! Ok ! Ok
else 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) call psb_getifield(check_flag,psb_dupl_,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 p1(1) = 0
p2(1) = 0 p2(1) = 0
@ -117,7 +117,7 @@ c
goto 9999 goto 9999
end if end if
if (toupper(descra(1:1)).eq.'G') then if (psb_toupper(descra(1:1)).eq.'G') then
c c
c sort COO data structure c sort COO data structure
c c
@ -254,29 +254,29 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name), + write(debug_unit,*) trim(name),
+ ': done rebuild COO',infon(1) + ': done rebuild COO',infon(1)
else if (toupper(descra(1:1)).eq.'S' .and. else if (psb_toupper(descra(1:1)).eq.'S' .and.
+ toupper(descra(2:2)).eq.'U') then + psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021 ierror = 3021
call fcpsb_errpush(ierror,name,int_val) call fcpsb_errpush(ierror,name,int_val)
goto 9999 goto 9999
else if (toupper(descra(1:1)).eq.'T' .and. else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'U') then + psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021 ierror = 3021
call fcpsb_errpush(ierror,name,int_val) call fcpsb_errpush(ierror,name,int_val)
goto 9999 goto 9999
else if (toupper(descra(1:1)).eq.'T' .and. else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'L') then + psb_toupper(descra(2:2)).eq.'L') then
ierror = 3021 ierror = 3021
call fcpsb_errpush(ierror,name,int_val) call fcpsb_errpush(ierror,name,int_val)
goto 9999 goto 9999
end if end if
c c
else if (toupper(trans).ne.'N') then else if (psb_toupper(trans).ne.'N') then
c c
c to do c to do
c 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(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
call psb_getifield(regen_flag,psb_upd_,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 P1(1) = 0
P2(1) = 0 P2(1) = 0
nnz = info(1) nnz = info(1)
@ -137,7 +137,7 @@ C
infon(psb_upd_pnt_) = 0 infon(psb_upd_pnt_) = 0
IF (toupper(descra(1:1)).EQ.'G') THEN IF (psb_toupper(descra(1:1)).EQ.'G') THEN
C C
C Sort COO data structure C Sort COO data structure
C C
@ -332,15 +332,15 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),': Done Rebuild CSR', + write(debug_unit,*) trim(name),': Done Rebuild CSR',
+ ian2(m+1),ia(elem) + ian2(m+1),ia(elem)
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND. ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN + psb_toupper(DESCRA(2:2)).EQ.'U') THEN
do 20 k = 1, m do 20 k = 1, m
p2(k) = k p2(k) = k
20 continue 20 continue
else if (toupper(DESCRA(1:1)).EQ.'T' .AND. else if (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN + psb_toupper(DESCRA(2:2)).EQ.'U') THEN
call msort_up(nnz,itmp,aux,iret) call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call reordvn(nnz,arn,itmp,ian1,aux) 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 ian2(row+1) = elem_csr
enddo enddo
else if (toupper(descra(1:1)).EQ.'T' .AND. else if (psb_toupper(descra(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN + psb_toupper(DESCRA(2:2)).EQ.'L') THEN
call msort_up(nnz,itmp,aux,iret) call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call reordvn(nnz,arn,itmp,ian1,aux) if (iret.eq.0) call reordvn(nnz,arn,itmp,ian1,aux)
@ -490,7 +490,7 @@ c ... sum the duplicated element ...
end if end if
c c
else if (toupper(TRANS).NE.'N') then else if (psb_toupper(TRANS).NE.'N') then
c c
c to do c to do
c c

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

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

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

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

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

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

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

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

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

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

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

@ -149,7 +149,7 @@ C
PIA = PNG + 1 PIA = PNG + 1
PJA = PIA + 3*(IA(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), CALL DJADRP1(TRANS,M,N,DESCRA,IA(PNG),
+ JA,IA(PIA),IA(PJA),P,WORK,LWORK*2) + JA,IA(PIA),IA(PJA),P,WORK,LWORK*2)
ELSE ELSE

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

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

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

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

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

@ -79,7 +79,7 @@ C
IWORK1(I) = 0 IWORK1(I) = 0
IWORK3(I) = 0 IWORK3(I) = 0
40 CONTINUE 40 CONTINUE
IF (toupper(UPLO).EQ.'L') THEN IF (psb_toupper(UPLO).EQ.'L') THEN
C C
C LOWER TRIANGULAR SPARSE MATRIX C LOWER TRIANGULAR SPARSE MATRIX
C C
@ -89,7 +89,7 @@ C
IWORK1(I) = MAX(IWORK1(I),IWORK1(JA(J))+1) IWORK1(I) = MAX(IWORK1(I),IWORK1(JA(J))+1)
60 CONTINUE 60 CONTINUE
80 CONTINUE 80 CONTINUE
ELSE IF (toupper(UPLO).EQ.'U') THEN ELSE IF (psb_toupper(UPLO).EQ.'U') THEN
C C
C UPPER TRIANGULAR SPARSE MATRIX C UPPER TRIANGULAR SPARSE MATRIX
C 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) call psb_getifield(check_flag,psb_dupl_,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 p1(1) = 0
p2(1) = 0 p2(1) = 0
@ -117,7 +117,7 @@ c
goto 9999 goto 9999
end if end if
if (toupper(descra(1:1)).eq.'G') then if (psb_toupper(descra(1:1)).eq.'G') then
c c
c sort COO data structure c sort COO data structure
c c
@ -255,29 +255,29 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name), + write(debug_unit,*) trim(name),
+ ': done rebuild COO',infon(1) + ': done rebuild COO',infon(1)
else if (toupper(descra(1:1)).eq.'S' .and. else if (psb_toupper(descra(1:1)).eq.'S' .and.
+ toupper(descra(2:2)).eq.'U') then + psb_toupper(descra(2:2)).eq.'U') then
do 20 k = 1, m do 20 k = 1, m
p2(k) = k p2(k) = k
20 continue 20 continue
else if (toupper(descra(1:1)).eq.'T' .and. else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'U') then + psb_toupper(descra(2:2)).eq.'U') then
ierror = 3021 ierror = 3021
call fcpsb_errpush(ierror,name,int_val) call fcpsb_errpush(ierror,name,int_val)
goto 9999 goto 9999
else if (toupper(descra(1:1)).eq.'T' .and. else if (psb_toupper(descra(1:1)).eq.'T' .and.
+ toupper(descra(2:2)).eq.'L') then + psb_toupper(descra(2:2)).eq.'L') then
ierror = 3021 ierror = 3021
call fcpsb_errpush(ierror,name,int_val) call fcpsb_errpush(ierror,name,int_val)
goto 9999 goto 9999
end if end if
c c
else if (toupper(trans).ne.'N') then else if (psb_toupper(trans).ne.'N') then
c c
c to do c to do
c 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(check_flag,psb_dupl_,infon,psb_ifasize_,ierror)
call psb_getifield(regen_flag,psb_upd_,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 P1(1) = 0
P2(1) = 0 P2(1) = 0
nnz = info(1) nnz = info(1)
@ -136,7 +136,7 @@ C
infon(psb_upd_pnt_) = 0 infon(psb_upd_pnt_) = 0
IF (toupper(descra(1:1)).EQ.'G') THEN IF (psb_toupper(descra(1:1)).EQ.'G') THEN
C C
C Sort COO data structure C Sort COO data structure
C C
@ -332,15 +332,15 @@ c ... sum the duplicated element ...
+ write(debug_unit,*) trim(name),': Done Rebuild CSR', + write(debug_unit,*) trim(name),': Done Rebuild CSR',
+ ian2(m+1),ia(elem) + ian2(m+1),ia(elem)
ELSE IF (toupper(DESCRA(1:1)).EQ.'S' .AND. ELSE IF (psb_toupper(DESCRA(1:1)).EQ.'S' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN + psb_toupper(DESCRA(2:2)).EQ.'U') THEN
do 20 k = 1, m do 20 k = 1, m
p2(k) = k p2(k) = k
20 continue 20 continue
else if (toupper(DESCRA(1:1)).EQ.'T' .AND. else if (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') THEN + psb_toupper(DESCRA(2:2)).EQ.'U') THEN
call msort_up(nnz,itmp,aux,iret) call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call zreordvn(nnz,arn,itmp,ian1,aux) 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 ian2(row+1) = elem_csr
enddo enddo
else if (toupper(descra(1:1)).EQ.'T' .AND. else if (psb_toupper(descra(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') THEN + psb_toupper(DESCRA(2:2)).EQ.'L') THEN
call msort_up(nnz,itmp,aux,iret) call msort_up(nnz,itmp,aux,iret)
if (iret.eq.0) call zreordvn(nnz,arn,itmp,ian1,aux) if (iret.eq.0) call zreordvn(nnz,arn,itmp,ian1,aux)
@ -490,7 +490,7 @@ c ... sum the duplicated element ...
end if end if
c c
else if (toupper(TRANS).NE.'N') then else if (psb_toupper(TRANS).NE.'N') then
c c
c to do c to do
c c

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

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

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

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

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

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

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

@ -66,10 +66,10 @@ C
GOTO 9999 GOTO 9999
ENDIF ENDIF
UPLO = '?' UPLO = '?'
IF (toupper(DESCRA(1:1)).EQ.'T' .AND. IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'U') UPLO = 'U' + psb_toupper(DESCRA(2:2)).EQ.'U') UPLO = 'U'
IF (toupper(DESCRA(1:1)).EQ.'T' .AND. IF (psb_toupper(DESCRA(1:1)).EQ.'T' .AND.
+ toupper(DESCRA(2:2)).EQ.'L') UPLO = 'L' + psb_toupper(DESCRA(2:2)).EQ.'L') UPLO = 'L'
C C
IF (UPLO.EQ.'?') THEN IF (UPLO.EQ.'?') THEN
IERROR=5 IERROR=5
@ -77,7 +77,7 @@ C
GOTO 9999 GOTO 9999
END IF END IF
IF (toupper(DESCRA(3:3)).NE.'U') THEN IF (psb_toupper(DESCRA(3:3)).NE.'U') THEN
IERROR=5 IERROR=5
CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL) CALL FCPSB_ERRPUSH(IERROR,NAME,INT_VAL)
GOTO 9999 GOTO 9999
@ -89,7 +89,7 @@ C
if (debug_level >= psb_debug_serial_comp_) if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': entry',m,n + 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_) if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': Right Scale' + write(debug_unit,*) trim(name),': Right Scale'
DO I = 1, N DO I = 1, N
@ -114,7 +114,7 @@ C
END IF END IF
IF (toupper(TDIAG).EQ.'L') THEN IF (psb_toupper(TDIAG).EQ.'L') THEN
if (debug_level >= psb_debug_serial_comp_) if (debug_level >= psb_debug_serial_comp_)
+ write(debug_unit,*) trim(name),': Left Scale' + write(debug_unit,*) trim(name),': Left Scale'
DO I = 1, N 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_ afmt = psb_fidef_
endif endif
afmt = toupper(afmt) afmt = psb_toupper(afmt)
select case(iup) select case(iup)
case (psb_upd_perm_) case (psb_upd_perm_)
@ -71,7 +71,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
lar = nnz lar = nnz
else else
info = 136 info = 136
call psb_errpush(info,name,a_err=toupper(afmt)) call psb_errpush(info,name,a_err=psb_toupper(afmt))
goto 9999 goto 9999
endif endif
@ -91,7 +91,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
lar = nnz lar = nnz
else else
info = 136 info = 136
call psb_errpush(info,name,a_err=toupper(afmt)) call psb_errpush(info,name,a_err=psb_toupper(afmt))
goto 9999 goto 9999
endif 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. rebuild_ = .false.
end if end if
call touppers(a%fida,ufida) call psb_touppers(a%fida,ufida)
spstate = psb_sp_getifld(psb_state_,a,info) 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)') '%%MatrixMarket matrix coordinate real general'
write(iout,'(a,a)') '% ',head write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% ',toupper(a%fida) write(iout,'(a,a)') '% ',psb_toupper(a%fida)
endif endif
select case(toupper(a%fida)) select case(psb_toupper(a%fida))
case ('CSR') 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_) & if(debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),': start ',& & write(debug_unit,*) trim(name),': start ',&
& size(a%ia1),size(a%ia2) & 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 write(debug_unit,*) 'Fixcoo Invalid input ',a%fida
info = -1 info = -1
return 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,*) & if(debug_level >= psb_debug_serial_) write(debug_unit,*) &
& trim(name),': start',a%fida,a%m & 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 write(debug_unit,*) trim(name),' Invalid input ',a%fida
info = -1 info = -1
call psb_errpush(info,name) 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_)& if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': start',a%fida,a%m & 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 write(debug_unit,*) trim(name),': Invalid input ',a%fida
info = -1 info = -1
call psb_errpush(info,name) 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 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (toupper(a%fida) /= 'CSR') then if (psb_toupper(a%fida) /= 'CSR') then
info = 5 info = 5
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 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. ! Note: we still have to test about possible performance hits.
! !
! !
csra = (toupper(a%fida(1:3))=='CSR') csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR') csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (csra.and.csrb) then if (csra.and.csrb) then
call numbmm(a%m,a%k,b%k,a%ia2,a%ia1,0,a%aspk,& 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 end if
if (nr > a%m) then 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) call psb_ensure_size(nr+1,a%ia2,info)
if (present(b)) then if (present(b)) then
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_ensure_size(size(a%ia1)+nzb,a%ia1,info) call psb_ensure_size(size(a%ia1)+nzb,a%ia1,info)
call psb_ensure_size(size(a%aspk)+nzb,a%aspk,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) 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) 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%m = nr
a%k = max(a%k,b%k) 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 if (present(b)) then
nza = psb_sp_get_nnzeros(a) nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info) call psb_sp_reall(a,nza+nzb,info)
if (toupper(b%fida)=='COO') then if (psb_toupper(b%fida)=='COO') then
if (rowscale_) then if (rowscale_) then
do j=1,nzb do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then if ((a%m + b%ia1(j)) <= nr) then
@ -128,7 +128,7 @@ subroutine psb_drwextd(nr,a,info,b,rowscale)
enddo enddo
endif endif
a%infoa(psb_nnz_) = nza 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 i=1, min(nr-a%m,b%m)
do do
jb = b%ia2(i) 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:',& & write(debug_unit,*) trim(name),': size_req 1:',&
& size_req, trans_,upd_,dupl_,b%fida,b%descra & size_req, trans_,upd_,dupl_,b%fida,b%descra
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case ('csr') case ('csr')
select case (tolower(b%fida)) select case (psb_tolower(b%fida))
case ('csr') case ('csr')
@ -255,7 +255,7 @@ subroutine psb_dspcnv2(a, b,info,afmt,upd,dupl)
case ('coo','coi') case ('coo','coi')
select case (tolower(b%fida)) select case (psb_tolower(b%fida))
case ('csr') case ('csr')
@ -457,9 +457,9 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
& ': Update:',upd_,psb_upd_srch_,psb_upd_perm_ & ': Update:',upd_,psb_upd_srch_,psb_upd_perm_
if (upd_ == psb_upd_srch_) then if (upd_ == psb_upd_srch_) then
if (present(afmt)) then if (present(afmt)) then
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case('coo') case('coo')
select case(tolower(afmt)) select case(psb_tolower(afmt))
case('coo') case('coo')
call psb_fixcoo(a,info) call psb_fixcoo(a,info)
goto 9998 goto 9998
@ -471,7 +471,7 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
goto 9998 goto 9998
end select end select
case('csr') case('csr')
select case(tolower(afmt)) select case(psb_tolower(afmt))
case('coo') case('coo')
call psb_ipcsr2coo(a,info) call psb_ipcsr2coo(a,info)
goto 9998 goto 9998
@ -510,7 +510,7 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
! !
! Second case: we come from an update loop. ! Second case: we come from an update loop.
! !
select case(tolower(a%fida)) select case(psb_tolower(a%fida))
case('csr') case('csr')
call csr_regen(a,info) call csr_regen(a,info)
case ('coo','coi') 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 nzin_ = 0
endif endif
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case ('csr') case ('csr')
call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren) call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren)
case ('coo') case ('coo')

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

@ -56,7 +56,7 @@ subroutine psb_dspscal(a,d,info)
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(toupper(a%fida(1:3))) select case(psb_toupper(a%fida(1:3)))
case ('CSR') case ('CSR')
do i=1, a%m 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' name='psb_symbmm'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
csra = (toupper(a%fida(1:3))=='CSR') csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR') csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (b%m /= a%k) then if (b%m /= a%k) then
write(0,*) 'Mismatch in SYMBMM: ',a%m,a%k,b%m,b%k 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 c_=1
endif endif
if (present(fmt)) then if (present(fmt)) then
fmt_ = toupper(fmt) fmt_ = psb_toupper(fmt)
else else
fmt_='CSR' fmt_='CSR'
endif endif

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

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

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

@ -76,7 +76,7 @@ contains
return return
endif endif
end if end if
select case(tolower(a%fida)) select case(psb_tolower(a%fida))
case ('csr') case ('csr')
call csr_srch_upd(nz,ia,ja,val,nza,a,& call csr_srch_upd(nz,ia,ja,val,nza,a,&
& imin,imax,jmin,jmax,nzl,info,gtl,ng) & imin,imax,jmin,jmax,nzl,info,gtl,ng)
@ -121,7 +121,7 @@ contains
return return
endif endif
select case(toupper(a%fida)) select case(psb_toupper(a%fida))
case ('CSR') case ('CSR')
!!$ write(0,*) 'Calling csr_srch_upd' !!$ write(0,*) 'Calling csr_srch_upd'
call csr_srch_upd(nz,ia,ja,val,nza,a,& call csr_srch_upd(nz,ia,ja,val,nza,a,&
@ -137,7 +137,7 @@ contains
end select end select
else else
select case(toupper(a%fida)) select case(psb_toupper(a%fida))
case ('CSR') case ('CSR')
!!$ write(0,*) 'Calling csr_srch_upd' !!$ write(0,*) 'Calling csr_srch_upd'
call csr_srch_upd(nz,ia,ja,val,nza,a,& 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. rebuild_ = .false.
end if end if
call touppers(a%fida,ufida) call psb_touppers(a%fida,ufida)
spstate = psb_sp_getifld(psb_state_,a,info) 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)') '%%MatrixMarket matrix coordinate complex general'
write(iout,'(a,a)') '% ',head write(iout,'(a,a)') '% ',head
write(iout,'(a)') '%' write(iout,'(a)') '%'
write(iout,'(a,a)') '% ',toupper(a%fida) write(iout,'(a,a)') '% ',psb_toupper(a%fida)
endif endif
select case(toupper(a%fida)) select case(psb_toupper(a%fida))
case ('CSR') 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_) & if(debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),': start ',& & write(debug_unit,*) trim(name),': start ',&
& size(a%ia1),size(a%ia2) & 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 write(debug_unit,*) 'Fixcoo Invalid input ',a%fida
info = -1 info = -1
return 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,*) & if(debug_level >= psb_debug_serial_) write(debug_unit,*) &
& trim(name),': start',a%fida,a%m & 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 write(debug_unit,*) trim(name),' Invalid input ',a%fida
info = -1 info = -1
call psb_errpush(info,name) 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_)& if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': start',a%fida,a%m & 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 write(debug_unit,*) trim(name),': Invalid input ',a%fida
info = -1 info = -1
call psb_errpush(info,name) 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 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (toupper(a%fida) /= 'CSR') then if (psb_toupper(a%fida) /= 'CSR') then
info = 5 info = 5
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 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. ! Note: we still have to test about possible performance hits.
! !
! !
csra = (toupper(a%fida(1:3))=='CSR') csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR') csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (csra.and.csrb) then if (csra.and.csrb) then
call znumbmm(a%m,a%k,b%k,a%ia2,a%ia1,0,a%aspk,& 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 end if
if (nr > a%m) then 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) call psb_realloc(nr+1,a%ia2,info)
if (present(b)) then if (present(b)) then
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_realloc(size(a%ia1)+nzb,a%ia1,info) call psb_realloc(size(a%ia1)+nzb,a%ia1,info)
call psb_realloc(size(a%aspk)+nzb,a%aspk,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) 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) 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%m = nr
a%k = max(a%k,b%k) 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 if (present(b)) then
nza = psb_sp_get_nnzeros(a) nza = psb_sp_get_nnzeros(a)
nzb = psb_sp_get_nnzeros(b) nzb = psb_sp_get_nnzeros(b)
call psb_sp_reall(a,nza+nzb,info) call psb_sp_reall(a,nza+nzb,info)
if (toupper(b%fida)=='COO') then if (psb_toupper(b%fida)=='COO') then
if (rowscale_) then if (rowscale_) then
do j=1,nzb do j=1,nzb
if ((a%m + b%ia1(j)) <= nr) then if ((a%m + b%ia1(j)) <= nr) then
@ -127,7 +127,7 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale)
enddo enddo
endif endif
a%infoa(psb_nnz_) = nza 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 i=1, min(nr-a%m,b%m)
do do
jb = b%ia2(i) 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:',& & write(debug_unit,*) trim(name),': size_req 1:',&
& size_req, trans_,upd_,dupl_,b%fida,b%descra & size_req, trans_,upd_,dupl_,b%fida,b%descra
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case ('csr') case ('csr')
select case (tolower(b%fida)) select case (psb_tolower(b%fida))
case ('csr') case ('csr')
@ -255,7 +255,7 @@ subroutine psb_zspcnv2(a, b,info,afmt,upd,dupl)
case ('coo','coi') case ('coo','coi')
select case (tolower(b%fida)) select case (psb_tolower(b%fida))
case ('csr') case ('csr')
@ -457,9 +457,9 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
& ': Update:',upd_,psb_upd_srch_,psb_upd_perm_ & ': Update:',upd_,psb_upd_srch_,psb_upd_perm_
if (upd_ == psb_upd_srch_) then if (upd_ == psb_upd_srch_) then
if (present(afmt)) then if (present(afmt)) then
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case('coo') case('coo')
select case(tolower(afmt)) select case(psb_tolower(afmt))
case('coo') case('coo')
call psb_fixcoo(a,info) call psb_fixcoo(a,info)
goto 9998 goto 9998
@ -471,7 +471,7 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
goto 9998 goto 9998
end select end select
case('csr') case('csr')
select case(tolower(afmt)) select case(psb_tolower(afmt))
case('coo') case('coo')
call psb_ipcsr2coo(a,info) call psb_ipcsr2coo(a,info)
goto 9998 goto 9998
@ -510,7 +510,7 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
! !
! Second case: we come from an update loop. ! Second case: we come from an update loop.
! !
select case(tolower(a%fida)) select case(psb_tolower(a%fida))
case('csr') case('csr')
call csr_regen(a,info) call csr_regen(a,info)
case ('coo','coi') 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 nzin_ = 0
endif endif
select case (tolower(a%fida)) select case (psb_tolower(a%fida))
case ('csr') case ('csr')
call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren) call csr_getrow(irw_,a,nz,ia,ja,val,nzin_,append_,lrw_,info,iren)
case ('coo') case ('coo')

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

@ -56,7 +56,7 @@ subroutine psb_zspscal(a,d,info)
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(toupper(a%fida(1:3))) select case(psb_toupper(a%fida(1:3)))
case ('CSR') case ('CSR')
do i=1, a%m 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' name='psb_symbmm'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
csra = (toupper(a%fida(1:3))=='CSR') csra = (psb_toupper(a%fida(1:3))=='CSR')
csrb = (toupper(b%fida(1:3))=='CSR') csrb = (psb_toupper(b%fida(1:3))=='CSR')
if (b%m /= a%k) then if (b%m /= a%k) then
write(0,*) 'Mismatch in SYMBMM: ',a%m,a%k,b%m,b%k 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 c_=1
endif endif
if (present(fmt)) then if (present(fmt)) then
fmt_ = toupper(fmt) fmt_ = psb_toupper(fmt)
else else
fmt_='CSR' fmt_='CSR'
endif endif

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

@ -55,7 +55,7 @@ subroutine psb_ztransp(a,b,c,fmt)
c_=1 c_=1
endif endif
if (present(fmt)) then if (present(fmt)) then
fmt_ = toupper(fmt) fmt_ = psb_toupper(fmt)
else else
fmt_='CSR' fmt_='CSR'
endif 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_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': here we go with ',iperm(1) & write(debug_unit,*) me,' ',trim(name),': here we go with ',iperm(1)
call psb_ensure_size(n_col,desc_a%lprm,info) 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 do i=1, n_row
desc_a%lprm(iperm(i)) = i desc_a%lprm(iperm(i)) = i
enddo enddo
do i=n_row+1,n_col do i=n_row+1,n_col
desc_a%lprm(i) = i desc_a%lprm(i) = i
enddo enddo
else if (toupper(trans) == 'T') then else if (psb_toupper(trans) == 'T') then
do i=1, n_row do i=1, n_row
desc_a%lprm(i) = iperm(i) desc_a%lprm(i) = iperm(i)
enddo 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 endif
if (present(outfmt)) then if (present(outfmt)) then
outfmt_ = toupper(outfmt) outfmt_ = psb_toupper(outfmt)
else else
outfmt_ = 'CSR' outfmt_ = 'CSR'
endif 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 else
act='I' act='I'
endif endif
act = toupper(act) act = psb_toupper(act)
if (present(owned)) then if (present(owned)) then
owned_=owned owned_=owned
else else
@ -215,7 +215,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
owned_=.false. owned_=.false.
end if end if
act = toupper(act) act = psb_toupper(act)
n = size(x) n = size(x)
call psi_idx_cnv(n,x,desc_a,info,owned=owned_) 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 else
act='I' act='I'
endif endif
act=toupper(act) act=psb_toupper(act)
n=size(x) n=size(x)
do i=1,n do i=1,n
@ -202,7 +202,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
else else
act='I' act='I'
endif endif
act = toupper(act) act = psb_toupper(act)
n=size(x) n=size(x)
do i=1,n 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 endif
if (present(outfmt)) then if (present(outfmt)) then
outfmt_ = toupper(outfmt) outfmt_ = psb_toupper(outfmt)
else else
outfmt_ = 'CSR' outfmt_ = 'CSR'
endif endif

4
krylov/psb_krylov_mod.f90
Unescape Escape View File

@ -338,7 +338,7 @@ contains
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case(toupper(method)) select case(psb_toupper(method))
case('CG') case('CG')
call psb_cg(a,prec,b,x,eps,desc_a,info,& call psb_cg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
@ -455,7 +455,7 @@ contains
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case(toupper(method)) select case(psb_toupper(method))
case('CG') case('CG')
call psb_cg(a,prec,b,x,eps,desc_a,info,& call psb_cg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &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) call psb_info(ictxt, me, np)
trans_ = toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N','T','C') case('N','T','C')
! Ok ! 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_) ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
trans_ = toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') 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_) ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
end if 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) call psb_info(ictxt, me, np)
if (present(upd)) then if (present(upd)) then
upd_ = toupper(upd) upd_ = psb_toupper(upd)
else else
upd_='F' upd_='F'
endif endif

2
prec/psb_dprecinit.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psb_dprecinit(p,ptype,info)
if (info /= 0) return if (info /= 0) return
p%iprcparm(:) = 0 p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC') case ('NONE','NOPREC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(psb_p_type_) = psb_noprec_ 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) call psb_info(ictxt, me, np)
trans_ = toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N','T','C') case('N','T','C')
! Ok ! 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_) ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
trans_ = toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') 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_) ictxt=desc_data%matrix_data(psb_ctxt_)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
end if 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) call psb_info(ictxt, me, np)
if (present(upd)) then if (present(upd)) then
upd_ = toupper(upd) upd_ = psb_toupper(upd)
else else
upd_='F' upd_='F'
endif endif

2
prec/psb_zprecinit.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psb_zprecinit(p,ptype,info)
if (info /= 0) return if (info /= 0) return
p%iprcparm(:) = 0 p%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC') case ('NONE','NOPREC')
p%iprcparm(:) = 0 p%iprcparm(:) = 0
p%iprcparm(psb_p_type_) = psb_noprec_ 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 11 Number of inputs
a.mtx thm1000x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or 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 NONE rhs.mtx NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD 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 2 ISTOPC
01000 ITMAX 01000 ITMAX
-1 ITRACE -1 ITRACE

18
util/psb_hbio_mod.f90
Unescape Escape View File

@ -97,8 +97,8 @@ contains
a%descra='G' a%descra='G'
if (tolower(type(1:1)) == 'r') then if (psb_tolower(type(1:1)) == 'r') then
if (tolower(type(2:2)) == 'u') then if (psb_tolower(type(2:2)) == 'u') then
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) 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) if (info == 0) read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
@ -229,7 +229,7 @@ contains
key_ = 'PSBMAT00' key_ = 'PSBMAT00'
endif endif
if (toupper(a%fida) == 'CSR') then if (psb_toupper(a%fida) == 'CSR') then
nrow = a%m nrow = a%m
ncol = a%k ncol = a%k
@ -334,8 +334,8 @@ contains
if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
if (tolower(type(1:1)) == 'c') then if (psb_tolower(type(1:1)) == 'c') then
if (tolower(type(2:2)) == 'u') then if (psb_tolower(type(2:2)) == 'u') then
call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode) 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) if (info == 0) read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
@ -413,7 +413,7 @@ contains
goto 993 goto 993
end if 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
@ -553,7 +553,7 @@ contains
else else
key_ = 'PSBMAT00' key_ = 'PSBMAT00'
endif endif
if (toupper(a%fida) == 'CSR') then if (psb_toupper(a%fida) == 'CSR') then
nrow = a%m nrow = a%m
ncol = a%k 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) call psb_info(ictxt, iam, np)
if (iam == root) then if (iam == root) then
! extract information from a_glob ! extract information from a_glob
if (toupper(a_glob%fida) /= 'CSR') then if (psb_toupper(a_glob%fida) /= 'CSR') then
info=135 info=135
ch_err='CSR' ch_err='CSR'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
@ -1301,7 +1301,7 @@ contains
call psb_info(ictxt, iam, np) call psb_info(ictxt, iam, np)
if (iam == root) then if (iam == root) then
! extract information from a_glob ! extract information from a_glob
if (toupper(a_glob%fida) /= 'CSR') then if (psb_toupper(a_glob%fida) /= 'CSR') then
info=135 info=135
ch_err='CSR' ch_err='CSR'
call psb_errpush(info,name,a_err=ch_err) 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 return
endif endif
if (nparts > 1) then if (nparts > 1) then
if (toupper(fida) == 'CSR') then if (psb_toupper(fida) == 'CSR') then
iopt(1) = 0 iopt(1) = 0
numflag = 1 numflag = 1
wgflag = 0 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 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' write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909 iret=909
return return
@ -88,7 +88,7 @@ contains
end do end do
read(line,fmt=*) nrow,ncol,nnzero 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) call psb_sp_all(nrow,ncol,a,nnzero,ircode)
a%fida = 'COO' a%fida = 'COO'
a%descra = 'G' a%descra = 'G'
@ -99,7 +99,7 @@ contains
a%infoa(psb_nnz_) = nnzero a%infoa(psb_nnz_) = nnzero
call psb_spcnv(a,ircode,afmt='csr') 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) 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 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' write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909 iret=909
return return
@ -240,7 +240,7 @@ contains
end do end do
read(line,fmt=*) nrow,ncol,nnzero 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) call psb_sp_all(nrow,ncol,a,nnzero,ircode)
if (ircode /= 0) goto 993 if (ircode /= 0) goto 993
a%fida = 'COO' a%fida = 'COO'
@ -253,7 +253,7 @@ contains
call psb_spcnv(a,ircode,afmt='csr') 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
@ -277,7 +277,7 @@ contains
a%infoa(psb_nnz_) = nzr a%infoa(psb_nnz_) = nzr
call psb_spcnv(a,ircode,afmt='csr') 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 are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) 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 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) allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993 if (ircode /= 0) goto 993
read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol) read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol)
@ -222,7 +222,7 @@ contains
read(line,fmt=*)nrow,ncol 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) allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993 if (ircode /= 0) goto 993
do j=1, ncol do j=1, ncol

Write Preview
Loading…
Cancel
Save