psblas3:

modules/Makefile
 modules/psb_c_base_mat_mod.f03
 modules/psb_c_csr_mat_mod.f03
 modules/psb_c_mat_mod.f03
 modules/psb_mat_mod.f03
 modules/psb_z_base_mat_mod.f03
 modules/psb_z_csr_mat_mod.f03
 modules/psb_z_mat_mod.f03
 serial/f03/Makefile
 serial/f03/psb_c_coo_impl.f03
 serial/f03/psb_c_csr_impl.f03
 serial/f03/psb_d_coo_impl.f03
 serial/f03/psb_d_csr_impl.f03
 serial/f03/psb_s_coo_impl.f03
 serial/f03/psb_s_csr_impl.f03
 serial/f03/psb_z_coo_impl.f03
 serial/f03/psb_z_csr_impl.f03

Complex version, step 1.

base/modules/Makefile

@@ -8,8 +8,11 @@ UTIL_MODS = psb_string_mod.o psb_spmat_type.o \
 	psi_serial_mod.o psi_mod.o  psb_ip_reord_mod.o\
 	psb_check_mod.o psb_gps_mod.o psb_linmap_mod.o psb_hash_mod.o\
 	psb_base_mat_mod.o  psb_mat_mod.o\
+	psb_s_base_mat_mod.o psb_s_csr_mat_mod.o  psb_s_mat_mod.o \
 	psb_d_base_mat_mod.o psb_d_csr_mat_mod.o  psb_d_mat_mod.o \
-	psb_s_base_mat_mod.o psb_s_csr_mat_mod.o  psb_s_mat_mod.o 
+	psb_c_base_mat_mod.o psb_c_csr_mat_mod.o  psb_c_mat_mod.o \
+	psb_z_base_mat_mod.o psb_z_csr_mat_mod.o  psb_z_mat_mod.o 
+
 
 MODULES=$(BASIC_MODS) $(UTIL_MODS)
 
@@ -27,11 +30,18 @@ lib:  $(BASIC_MODS) blacsmod  $(UTIL_MODS)  $(OBJS)  $(LIBMOD)
 	/bin/cp -p *$(.mod) $(LIBDIR)
 
 
-psb_base_mat_mod.o: psb_string_mod.o psb_sort_mod.o psb_ip_reord_mod.o psb_error_mod.o psi_serial_mod.o
-psb_s_base_mat_mod.o psb_d_base_mat_mod.o: psb_base_mat_mod.o
+psb_base_mat_mod.o: psb_string_mod.o psb_sort_mod.o psb_ip_reord_mod.o\
+	psb_error_mod.o psi_serial_mod.o
+psb_s_base_mat_mod.o psb_d_base_mat_mod.o psb_c_base_mat_mod.o psb_z_base_mat_mod.o: psb_base_mat_mod.o
 psb_s_mat_mod.o: psb_s_base_mat_mod.o  psb_s_csr_mat_mod.o
 psb_d_mat_mod.o: psb_d_base_mat_mod.o  psb_d_csr_mat_mod.o
-psb_mat_mod.o: psb_d_mat_mod.o psb_s_mat_mod.o
+psb_c_mat_mod.o: psb_c_base_mat_mod.o  psb_c_csr_mat_mod.o
+psb_z_mat_mod.o: psb_z_base_mat_mod.o  psb_z_csr_mat_mod.o
+psb_s_csr_mat_mod.o: psb_s_base_mat_mod.o 
+psb_d_csr_mat_mod.o: psb_d_base_mat_mod.o 
+psb_c_csr_mat_mod.o: psb_c_base_mat_mod.o 
+psb_z_csr_mat_mod.o: psb_z_base_mat_mod.o 
+psb_mat_mod.o: psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o psb_z_mat_mod.o
 psb_realloc_mod.o : psb_error_mod.o 
 psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o psb_sort_mod.o
 psb_error_mod.o: psb_const_mod.o

base/modules/psb_mat_mod.f03

@@ -1,4 +1,6 @@
 module  psb_mat_mod
   use psb_s_mat_mod
   use psb_d_mat_mod
+  use psb_c_mat_mod
+  use psb_z_mat_mod
 end module psb_mat_mod

base/serial/f03/Makefile

@@ -3,7 +3,8 @@ include ../../../Make.inc
 #
 # The object files
 #
-FOBJS =  psb_s_csr_impl.o  psb_s_coo_impl.o  psb_d_csr_impl.o  psb_d_coo_impl.o
+FOBJS =  psb_s_csr_impl.o  psb_s_coo_impl.o  psb_d_csr_impl.o  psb_d_coo_impl.o\
+  psb_c_csr_impl.o  psb_c_coo_impl.o  psb_z_csr_impl.o  psb_z_coo_impl.o
 
 OBJS=$(FOBJS)
 

base/serial/f03/psb_d_coo_impl.f03

@@ -543,6 +543,7 @@ end subroutine d_coo_cssv_impl
 subroutine d_coo_csmv_impl(alpha,a,x,beta,y,info,trans) 
   use psb_const_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_d_base_mat_mod, psb_protect_name => d_coo_csMv_impl
   implicit none 
 
@@ -576,8 +577,7 @@ subroutine d_coo_csmv_impl(alpha,a,x,beta,y,info,trans)
     trans_ = 'N'
   end if
 
-  tra = ((trans_=='T').or.(trans_=='t'))
-
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
 
 
   if (tra) then 
@@ -701,6 +701,7 @@ end subroutine d_coo_csmv_impl
 subroutine d_coo_csmm_impl(alpha,a,x,beta,y,info,trans) 
   use psb_const_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_d_base_mat_mod, psb_protect_name => d_coo_csmm_impl
   implicit none 
   class(psb_d_coo_sparse_mat), intent(in) :: a
@@ -735,7 +736,7 @@ subroutine d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
   end if
 
 
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
 
   if (tra) then 
     m = a%get_ncols()

base/serial/f03/psb_d_csr_impl.f03

@@ -589,6 +589,7 @@ end subroutine d_csr_csmm_impl
 
 subroutine d_csr_cssv_impl(alpha,a,x,beta,y,info,trans) 
   use psb_error_mod
+  use psb_string_mod
   use psb_d_csr_mat_mod, psb_protect_name => d_csr_cssv_impl
   implicit none 
   class(psb_d_csr_sparse_mat), intent(in) :: a
@@ -619,7 +620,7 @@ subroutine d_csr_cssv_impl(alpha,a,x,beta,y,info,trans)
     goto 9999
   endif
 
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
   m = a%get_nrows()
 
   if (.not. (a%is_triangle())) then 
@@ -793,6 +794,7 @@ end subroutine d_csr_cssv_impl
 
 subroutine d_csr_cssm_impl(alpha,a,x,beta,y,info,trans) 
   use psb_error_mod
+  use psb_string_mod
   use psb_d_csr_mat_mod, psb_protect_name => d_csr_cssm_impl
   implicit none 
   class(psb_d_csr_sparse_mat), intent(in) :: a
@@ -825,7 +827,8 @@ subroutine d_csr_cssm_impl(alpha,a,x,beta,y,info,trans)
   endif
 
 
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
+
   m   = a%get_nrows()
   nc  = min(size(x,2) , size(y,2)) 
 
@@ -917,18 +920,18 @@ contains
         if (unit) then 
           do i=1, nr
             acc = dzero 
-            do j=a%irp(i), a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
             y(i,1:nc) = x(i,1:nc) - acc
           end do
         else if (.not.unit) then 
           do i=1, nr
             acc = dzero 
-            do j=a%irp(i), a%irp(i+1)-2
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-2
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
-            y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%irp(i+1)-1)
+            y(i,1:nc) = (x(i,1:nc) - acc)/val(irp(i+1)-1)
           end do
         end if
       else if (.not.lower) then 
@@ -936,18 +939,18 @@ contains
         if (unit) then 
           do i=nr, 1, -1 
             acc = dzero 
-            do j=a%irp(i), a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
             y(i,1:nc) = x(i,1:nc) - acc
           end do
         else if (.not.unit) then 
           do i=nr, 1, -1 
             acc = dzero 
-            do j=a%irp(i)+1, a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i)+1, irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
-            y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%irp(i))
+            y(i,1:nc) = (x(i,1:nc) - acc)/val(irp(i))
           end do
         end if
 
@@ -963,18 +966,18 @@ contains
         if (unit) then 
           do i=nr, 1, -1
             acc = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-1
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-1
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         else if (.not.unit) then 
           do i=nr, 1, -1
-            y(i,1:nc) = y(i,1:nc)/a%val(a%irp(i+1)-1)
+            y(i,1:nc) = y(i,1:nc)/val(irp(i+1)-1)
             acc  = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-2
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-2
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         end if
@@ -983,18 +986,18 @@ contains
         if (unit) then 
           do i=1, nr
             acc  = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-1
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-1
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         else if (.not.unit) then 
           do i=1, nr
-            y(i,1:nc) = y(i,1:nc)/a%val(a%irp(i))
+            y(i,1:nc) = y(i,1:nc)/val(irp(i))
             acc    = y(i,1:nc) 
-            do j=a%irp(i)+1, a%irp(i+1)-1
-              jc      = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i)+1, irp(i+1)-1
+              jc      = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         end if

base/serial/f03/psb_s_coo_impl.f03

@@ -543,6 +543,7 @@ end subroutine s_coo_cssv_impl
 subroutine s_coo_csmv_impl(alpha,a,x,beta,y,info,trans) 
   use psb_const_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_s_base_mat_mod, psb_protect_name => s_coo_csMv_impl
   implicit none 
 
@@ -576,9 +577,7 @@ subroutine s_coo_csmv_impl(alpha,a,x,beta,y,info,trans)
     trans_ = 'N'
   end if
 
-  tra = ((trans_=='T').or.(trans_=='t'))
-
-
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
 
   if (tra) then 
     m = a%get_ncols()
@@ -701,6 +700,7 @@ end subroutine s_coo_csmv_impl
 subroutine s_coo_csmm_impl(alpha,a,x,beta,y,info,trans) 
   use psb_const_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_s_base_mat_mod, psb_protect_name => s_coo_csmm_impl
   implicit none 
   class(psb_s_coo_sparse_mat), intent(in) :: a
@@ -734,8 +734,7 @@ subroutine s_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
     trans_ = 'N'
   end if
 
-
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
 
   if (tra) then 
     m = a%get_ncols()

base/serial/f03/psb_s_csr_impl.f03

@@ -589,6 +589,7 @@ end subroutine s_csr_csmm_impl
 
 subroutine s_csr_cssv_impl(alpha,a,x,beta,y,info,trans) 
   use psb_error_mod
+  use psb_string_mod
   use psb_s_csr_mat_mod, psb_protect_name => s_csr_cssv_impl
   implicit none 
   class(psb_s_csr_sparse_mat), intent(in) :: a
@@ -619,7 +620,8 @@ subroutine s_csr_cssv_impl(alpha,a,x,beta,y,info,trans)
     goto 9999
   endif
 
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
+
   m = a%get_nrows()
 
   
@@ -804,6 +806,7 @@ end subroutine s_csr_cssv_impl
 
 subroutine s_csr_cssm_impl(alpha,a,x,beta,y,info,trans) 
   use psb_error_mod
+  use psb_string_mod
   use psb_s_csr_mat_mod, psb_protect_name => s_csr_cssm_impl
   implicit none 
   class(psb_s_csr_sparse_mat), intent(in) :: a
@@ -836,7 +839,7 @@ subroutine s_csr_cssm_impl(alpha,a,x,beta,y,info,trans)
   endif
 
 
-  tra = ((trans_=='T').or.(trans_=='t'))
+  tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
   m   = a%get_nrows()
   nc  = min(size(x,2) , size(y,2)) 
 
@@ -928,18 +931,18 @@ contains
         if (unit) then 
           do i=1, nr
             acc = szero 
-            do j=a%irp(i), a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
             y(i,1:nc) = x(i,1:nc) - acc
           end do
         else if (.not.unit) then 
           do i=1, nr
             acc = szero 
-            do j=a%irp(i), a%irp(i+1)-2
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-2
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
-            y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%irp(i+1)-1)
+            y(i,1:nc) = (x(i,1:nc) - acc)/val(irp(i+1)-1)
           end do
         end if
       else if (.not.lower) then 
@@ -947,18 +950,18 @@ contains
         if (unit) then 
           do i=nr, 1, -1 
             acc = szero 
-            do j=a%irp(i), a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i), irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
             y(i,1:nc) = x(i,1:nc) - acc
           end do
         else if (.not.unit) then 
           do i=nr, 1, -1 
             acc = szero 
-            do j=a%irp(i)+1, a%irp(i+1)-1
-              acc = acc + a%val(j)*y(a%ja(j),1:nc)
+            do j=irp(i)+1, irp(i+1)-1
+              acc = acc + val(j)*y(ja(j),1:nc)
             end do
-            y(i,1:nc) = (x(i,1:nc) - acc)/a%val(a%irp(i))
+            y(i,1:nc) = (x(i,1:nc) - acc)/val(irp(i))
           end do
         end if
 
@@ -974,18 +977,18 @@ contains
         if (unit) then 
           do i=nr, 1, -1
             acc = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-1
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-1
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         else if (.not.unit) then 
           do i=nr, 1, -1
-            y(i,1:nc) = y(i,1:nc)/a%val(a%irp(i+1)-1)
+            y(i,1:nc) = y(i,1:nc)/val(irp(i+1)-1)
             acc  = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-2
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-2
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         end if
@@ -994,18 +997,18 @@ contains
         if (unit) then 
           do i=1, nr
             acc  = y(i,1:nc) 
-            do j=a%irp(i), a%irp(i+1)-1
-              jc    = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i), irp(i+1)-1
+              jc    = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         else if (.not.unit) then 
           do i=1, nr
-            y(i,1:nc) = y(i,1:nc)/a%val(a%irp(i))
+            y(i,1:nc) = y(i,1:nc)/val(irp(i))
             acc    = y(i,1:nc) 
-            do j=a%irp(i)+1, a%irp(i+1)-1
-              jc      = a%ja(j)
-              y(jc,1:nc) = y(jc,1:nc) - a%val(j)*acc 
+            do j=irp(i)+1, irp(i+1)-1
+              jc      = ja(j)
+              y(jc,1:nc) = y(jc,1:nc) - val(j)*acc 
             end do
           end do
         end if