mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 11:52:11 +00:00
psblas2-dev:
base/modules/psb_avl_mod.f90 base/modules/psb_string_mod.f90 base/serial/coo/dcoomm.f base/serial/csr/dcsrmm.f base/serial/jad/djadmm.f Fixes: 1. recursive functions in avl_mod 2. new string implementation with case table 3. fix to serial MM initialization of TRANS.
This commit is contained in:
Salvatore Filippone
@@ -179,7 +179,7 @@ contains
|
||||
|
||||
end subroutine CloneSearchTree_int2
|
||||
|
||||
subroutine CloneAVLTree_int2(root, tree)
|
||||
recursive subroutine CloneAVLTree_int2(root, tree)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info, key,val,next
|
||||
|
||||
+141
-13
@@ -44,7 +44,7 @@ module psb_string_mod
|
||||
module procedure psb_sub_toupperc
|
||||
end interface
|
||||
|
||||
private
|
||||
private lcase, ucase, upper1c, lower1c
|
||||
character(len=*), parameter :: lcase='abcdefghijklmnopqrstuvwxyz'
|
||||
character(len=*), parameter :: ucase='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
|
||||
@@ -56,12 +56,13 @@ contains
|
||||
integer :: i,k
|
||||
|
||||
do i=1,len(string)
|
||||
k = index(ucase,string(i:i))
|
||||
if (k /=0 ) then
|
||||
psb_tolowerc(i:i) = lcase(k:k)
|
||||
else
|
||||
psb_tolowerc(i:i) = string(i:i)
|
||||
end if
|
||||
psb_tolowerc(i:i) = lower1c(string(i:i))
|
||||
!!$ k = index(ucase,string(i:i))
|
||||
!!$ if (k /=0 ) then
|
||||
!!$ psb_tolowerc(i:i) = lcase(k:k)
|
||||
!!$ else
|
||||
!!$ psb_tolowerc(i:i) = string(i:i)
|
||||
!!$ end if
|
||||
enddo
|
||||
end function psb_tolowerc
|
||||
|
||||
@@ -71,12 +72,13 @@ contains
|
||||
integer :: i,k
|
||||
|
||||
do i=1,len(string)
|
||||
k = index(lcase,string(i:i))
|
||||
if (k /=0 ) then
|
||||
psb_toupperc(i:i) = ucase(k:k)
|
||||
else
|
||||
psb_toupperc(i:i) = string(i:i)
|
||||
end if
|
||||
psb_toupperc(i:i) = upper1c(string(i:i))
|
||||
!!$ k = index(lcase,string(i:i))
|
||||
!!$ if (k /=0 ) then
|
||||
!!$ psb_toupperc(i:i) = ucase(k:k)
|
||||
!!$ else
|
||||
!!$ psb_toupperc(i:i) = string(i:i)
|
||||
!!$ end if
|
||||
enddo
|
||||
end function psb_toupperc
|
||||
|
||||
@@ -95,4 +97,130 @@ contains
|
||||
enddo
|
||||
end subroutine psb_sub_toupperc
|
||||
|
||||
|
||||
function lower1c(ch)
|
||||
character(len=1), intent(in) :: ch
|
||||
character(len=1) :: lower1c
|
||||
|
||||
select case(ch)
|
||||
case ('A')
|
||||
lower1c = 'a'
|
||||
case ('B')
|
||||
lower1c = 'b'
|
||||
case ('C')
|
||||
lower1c = 'c'
|
||||
case ('D')
|
||||
lower1c = 'd'
|
||||
case ('E')
|
||||
lower1c = 'e'
|
||||
case ('F')
|
||||
lower1c = 'f'
|
||||
case ('G')
|
||||
lower1c = 'g'
|
||||
case ('H')
|
||||
lower1c = 'h'
|
||||
case ('I')
|
||||
lower1c = 'i'
|
||||
case ('J')
|
||||
lower1c = 'j'
|
||||
case ('K')
|
||||
lower1c = 'k'
|
||||
case ('L')
|
||||
lower1c = 'l'
|
||||
case ('M')
|
||||
lower1c = 'm'
|
||||
case ('N')
|
||||
lower1c = 'n'
|
||||
case ('O')
|
||||
lower1c = 'o'
|
||||
case ('P')
|
||||
lower1c = 'p'
|
||||
case ('Q')
|
||||
lower1c = 'q'
|
||||
case ('R')
|
||||
lower1c = 'r'
|
||||
case ('S')
|
||||
lower1c = 's'
|
||||
case ('T')
|
||||
lower1c = 't'
|
||||
case ('U')
|
||||
lower1c = 'u'
|
||||
case ('V')
|
||||
lower1c = 'v'
|
||||
case ('W')
|
||||
lower1c = 'w'
|
||||
case ('X')
|
||||
lower1c = 'x'
|
||||
case ('Y')
|
||||
lower1c = 'y'
|
||||
case ('Z')
|
||||
lower1c = 'z'
|
||||
case default
|
||||
lower1c = ch
|
||||
end select
|
||||
end function lower1c
|
||||
|
||||
function upper1c(ch)
|
||||
character(len=1), intent(in) :: ch
|
||||
character(len=1) :: upper1c
|
||||
|
||||
select case(ch)
|
||||
case ('a')
|
||||
upper1c = 'A'
|
||||
case ('b')
|
||||
upper1c = 'B'
|
||||
case ('c')
|
||||
upper1c = 'C'
|
||||
case ('d')
|
||||
upper1c = 'D'
|
||||
case ('e')
|
||||
upper1c = 'E'
|
||||
case ('f')
|
||||
upper1c = 'F'
|
||||
case ('g')
|
||||
upper1c = 'G'
|
||||
case ('h')
|
||||
upper1c = 'H'
|
||||
case ('i')
|
||||
upper1c = 'I'
|
||||
case ('j')
|
||||
upper1c = 'J'
|
||||
case ('k')
|
||||
upper1c = 'K'
|
||||
case ('l')
|
||||
upper1c = 'L'
|
||||
case ('m')
|
||||
upper1c = 'M'
|
||||
case ('n')
|
||||
upper1c = 'N'
|
||||
case ('o')
|
||||
upper1c = 'O'
|
||||
case ('p')
|
||||
upper1c = 'P'
|
||||
case ('q')
|
||||
upper1c = 'Q'
|
||||
case ('r')
|
||||
upper1c = 'R'
|
||||
case ('s')
|
||||
upper1c = 'S'
|
||||
case ('t')
|
||||
upper1c = 'T'
|
||||
case ('u')
|
||||
upper1c = 'U'
|
||||
case ('v')
|
||||
upper1c = 'V'
|
||||
case ('w')
|
||||
upper1c = 'W'
|
||||
case ('x')
|
||||
upper1c = 'X'
|
||||
case ('y')
|
||||
upper1c = 'Y'
|
||||
case ('z')
|
||||
upper1c = 'Z'
|
||||
case default
|
||||
upper1c = ch
|
||||
end select
|
||||
end function upper1c
|
||||
|
||||
|
||||
end module psb_string_mod
|
||||
|
||||
@@ -60,7 +60,7 @@ C
|
||||
C
|
||||
C
|
||||
IERROR=0
|
||||
IF (DESCRA(1:1).EQ.'G') TRANS = TRANSA
|
||||
TRANS = TRANSA
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') TRANS = 'U'
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'L') TRANS = 'L'
|
||||
c
|
||||
|
||||
@@ -62,7 +62,7 @@ C
|
||||
IERROR = 0
|
||||
CALL FCPSB_ERRACTIONSAVE(ERR_ACT)
|
||||
C
|
||||
IF (DESCRA(1:1).EQ.'G') TRANS = TRANSA
|
||||
TRANS = TRANSA
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') TRANS = 'U'
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'L') TRANS = 'L'
|
||||
c
|
||||
|
||||
@@ -57,7 +57,7 @@ C
|
||||
IERROR = 0
|
||||
CALL FCPSB_ERRACTIONSAVE(ERR_ACT)
|
||||
|
||||
IF (DESCRA(1:1).EQ.'G') TRANS = TRANSA
|
||||
TRANS = TRANSA
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') TRANS = 'U'
|
||||
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'L') TRANS = 'L'
|
||||
IF (DESCRA(1:1).EQ.'D') THEN
|
||||
|
||||
Reference in New Issue
Block a user