diff --git a/base/modules/psb_avl_mod.f90 b/base/modules/psb_avl_mod.f90 index 5b8047f7..f3c4eb95 100644 --- a/base/modules/psb_avl_mod.f90 +++ b/base/modules/psb_avl_mod.f90 @@ -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 diff --git a/base/modules/psb_string_mod.f90 b/base/modules/psb_string_mod.f90 index ac589f46..5b53e748 100644 --- a/base/modules/psb_string_mod.f90 +++ b/base/modules/psb_string_mod.f90 @@ -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 diff --git a/base/serial/coo/dcoomm.f b/base/serial/coo/dcoomm.f index f10e2c88..1fe600a9 100644 --- a/base/serial/coo/dcoomm.f +++ b/base/serial/coo/dcoomm.f @@ -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 diff --git a/base/serial/csr/dcsrmm.f b/base/serial/csr/dcsrmm.f index bc0798db..97b9205f 100644 --- a/base/serial/csr/dcsrmm.f +++ b/base/serial/csr/dcsrmm.f @@ -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 diff --git a/base/serial/jad/djadmm.f b/base/serial/jad/djadmm.f index bf346f36..542824a3 100644 --- a/base/serial/jad/djadmm.f +++ b/base/serial/jad/djadmm.f @@ -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