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.
17 years ago · 486a011f4b
parent 76b01051f3
commit 486a011f4b
5 changed files with 145 additions and 17 deletions
--- 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
--- 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
--- 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
--- 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     
--- 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