psblas3:

I/O fixes.

util/psb_hbio_mod.f90

@@ -56,7 +56,7 @@ contains
     character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
     integer        :: indcrd,  ptrcrd, totcrd,&
          & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
-    type(psb_s_csr_sparse_mat) :: acsr
+    type(psb_s_csc_sparse_mat) :: acsc
     type(psb_s_coo_sparse_mat) :: acoo
     integer                     :: ircode, i,nzr,infile, info
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
@@ -88,7 +88,7 @@ contains
          & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
     if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
     
-    call acsr%allocate(nrow,ncol,nnzero)
+    call acsc%allocate(nrow,ncol,nnzero)
     if (ircode /= 0 ) then 
       write(0,*) 'Memory allocation failed'
       goto 993
@@ -101,11 +101,11 @@ contains
       if (psb_tolower(type(2:2)) == 'u') then 
 
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
         
-        call a%mv_from(acsr)
+        call a%mv_from(acsc)
         
         if (present(b)) then
           if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then 
@@ -131,9 +131,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -156,7 +156,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -171,7 +171,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else
@@ -182,6 +181,8 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       iret=904
     end if
+
+    call a%cscnv(ircode,type='csr')
     if (infile/=5) close(infile)
 
     return 
@@ -201,7 +202,7 @@ contains
   subroutine shb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle)
     use psb_base_mod
     implicit none
-    type(psb_s_sparse_mat), intent(in)  :: a
+    type(psb_s_sparse_mat), intent(in), target :: a
     integer, intent(out)        :: iret
     character(len=*), optional, intent(in) :: mtitle
     integer, optional, intent(in)          :: iunit
@@ -218,6 +219,8 @@ contains
     character(len=*), parameter :: fmt11='(a3,11x,2i14)'
     character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
 
+    type(psb_s_csc_sparse_mat), target  ::  acsc
+    type(psb_s_csc_sparse_mat), pointer ::  acpnt
     character(len=72) :: mtitle_
     character(len=8)  :: key_
 
@@ -260,62 +263,69 @@ contains
 
 
     select type(aa=>a%a)
-    type is (psb_s_csr_sparse_mat)
+    type is (psb_s_csc_sparse_mat)
-      
-      nrow   = aa%get_nrows()
-      ncol   = aa%get_ncols()
-      nnzero = aa%get_nzeros()
-      
-      neltvl = 0 
-
-      ptrcrd = (nrow+1)/jptr
-      if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1
-      indcrd = nnzero/jind
-      if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
-      valcrd = nnzero/jval
-      if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
-      rhstype = ''
-      if (present(rhs)) then 
-        if (size(rhs)<nrow) then 
-          rhscrd = 0
-        else
-          rhscrd = nrow/jrhs
-          if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
-        endif
-        nrhs = 1
-        rhstype(1:1) = 'F'
-      else
-        rhscrd = 0
-        nrhs   = 0
-      end if
-      totcrd = ptrcrd + indcrd + valcrd + rhscrd
 
-      nrhsix  = nrhs*nrow
+      acpnt => aa
 
-      if (present(g)) then 
+    class default
-        rhstype(2:2) = 'G'
-      end if
-      if (present(x)) then 
-        rhstype(3:3) = 'X'
-      end if
-      type    = 'RUA'
 
-      write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+      call acsc%cp_from_fmt(aa, iret)
-           &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+      if (iret/=0) return
-      if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+      acpnt => acsc
-      write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1)
-      write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero)
-      if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero)
-      if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
-      if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
-      if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
+    end select
+
+
+    nrow   = acpnt%get_nrows()
+    ncol   = acpnt%get_ncols()
+    nnzero = acpnt%get_nzeros()
+
+    neltvl = 0 
+
+    ptrcrd = (ncol+1)/jptr
+    if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1
+    indcrd = nnzero/jind
+    if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
+    valcrd = nnzero/jval
+    if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
+    rhstype = ''
+    if (present(rhs)) then 
+      if (size(rhs)<nrow) then 
+        rhscrd = 0
+      else
+        rhscrd = nrow/jrhs
+        if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
+      endif
+      nrhs = 1
+      rhstype(1:1) = 'F'
+    else
+      rhscrd = 0
+      nrhs   = 0
+    end if
+    totcrd = ptrcrd + indcrd + valcrd + rhscrd
+
+    nrhsix  = nrhs*nrow
+
+    if (present(g)) then 
+      rhstype(2:2) = 'G'
+    end if
+    if (present(x)) then 
+      rhstype(3:3) = 'X'
+    end if
+    type    = 'RUA'
+
+    write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+         &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+    if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+    write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1)
+    write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero)
+    if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero)
+    if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
+    if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
+    if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
-    class default
 
-      write(0,*) 'format: ',a%get_fmt(),' not yet implemented'
 
-    end select
 
     if (iout /= 6) close(iout)
 
@@ -329,10 +339,11 @@ contains
   end subroutine shb_write
 
 
+
   subroutine dhb_read(a, iret, iunit, filename,b,g,x,mtitle)   
     use psb_base_mod
     implicit none
-    type(psb_d_sparse_mat), intent(out)     :: a
+    type(psb_d_sparse_mat), intent(out)    :: a
     integer, intent(out)                   :: iret
     integer, optional, intent(in)          :: iunit
     character(len=*), optional, intent(in) :: filename
@@ -344,7 +355,7 @@ contains
     character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
     integer        :: indcrd,  ptrcrd, totcrd,&
          & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
-    type(psb_d_csr_sparse_mat) :: acsr
+    type(psb_d_csc_sparse_mat) :: acsc
     type(psb_d_coo_sparse_mat) :: acoo
     integer                     :: ircode, i,nzr,infile, info
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
@@ -376,7 +387,7 @@ contains
          & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
     if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
     
-    call acsr%allocate(nrow,ncol,nnzero)
+    call acsc%allocate(nrow,ncol,nnzero)
     if (ircode /= 0 ) then 
       write(0,*) 'Memory allocation failed'
       goto 993
@@ -389,11 +400,11 @@ contains
       if (psb_tolower(type(2:2)) == 'u') then 
 
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
         
-        call a%mv_from(acsr)
+        call a%mv_from(acsc)
         
         if (present(b)) then
           if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then 
@@ -419,9 +430,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -444,7 +455,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -459,7 +470,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else
@@ -470,6 +480,8 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       iret=904
     end if
+
+    call a%cscnv(ircode,type='csr')
     if (infile/=5) close(infile)
 
     return 
@@ -489,7 +501,7 @@ contains
   subroutine dhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle)
     use psb_base_mod
     implicit none
-    type(psb_d_sparse_mat), intent(in)  :: a
+    type(psb_d_sparse_mat), intent(in), target :: a
     integer, intent(out)        :: iret
     character(len=*), optional, intent(in) :: mtitle
     integer, optional, intent(in)          :: iunit
@@ -506,6 +518,8 @@ contains
     character(len=*), parameter :: fmt11='(a3,11x,2i14)'
     character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
 
+    type(psb_d_csc_sparse_mat), target  ::  acsc
+    type(psb_d_csc_sparse_mat), pointer ::  acpnt
     character(len=72) :: mtitle_
     character(len=8)  :: key_
 
@@ -548,62 +562,69 @@ contains
 
 
     select type(aa=>a%a)
-    type is (psb_d_csr_sparse_mat)
+    type is (psb_s_csc_sparse_mat)
-      
-      nrow   = aa%get_nrows()
-      ncol   = aa%get_ncols()
-      nnzero = aa%get_nzeros()
-      
-      neltvl = 0 
-
-      ptrcrd = (nrow+1)/jptr
-      if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1
-      indcrd = nnzero/jind
-      if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
-      valcrd = nnzero/jval
-      if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
-      rhstype = ''
-      if (present(rhs)) then 
-        if (size(rhs)<nrow) then 
-          rhscrd = 0
-        else
-          rhscrd = nrow/jrhs
-          if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
-        endif
-        nrhs = 1
-        rhstype(1:1) = 'F'
-      else
-        rhscrd = 0
-        nrhs   = 0
-      end if
-      totcrd = ptrcrd + indcrd + valcrd + rhscrd
 
-      nrhsix  = nrhs*nrow
+      acpnt => aa
 
-      if (present(g)) then 
+    class default
-        rhstype(2:2) = 'G'
-      end if
-      if (present(x)) then 
-        rhstype(3:3) = 'X'
-      end if
-      type    = 'RUA'
 
-      write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+      call acsc%cp_from_fmt(aa, iret)
-           &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+      if (iret/=0) return
-      if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+      acpnt => acsc
-      write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1)
-      write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero)
-      if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero)
-      if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
-      if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
-      if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
+    end select
+
+
+    nrow   = acpnt%get_nrows()
+    ncol   = acpnt%get_ncols()
+    nnzero = acpnt%get_nzeros()
+
+    neltvl = 0 
+
+    ptrcrd = (ncol+1)/jptr
+    if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1
+    indcrd = nnzero/jind
+    if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
+    valcrd = nnzero/jval
+    if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
+    rhstype = ''
+    if (present(rhs)) then 
+      if (size(rhs)<nrow) then 
+        rhscrd = 0
+      else
+        rhscrd = nrow/jrhs
+        if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
+      endif
+      nrhs = 1
+      rhstype(1:1) = 'F'
+    else
+      rhscrd = 0
+      nrhs   = 0
+    end if
+    totcrd = ptrcrd + indcrd + valcrd + rhscrd
+
+    nrhsix  = nrhs*nrow
+
+    if (present(g)) then 
+      rhstype(2:2) = 'G'
+    end if
+    if (present(x)) then 
+      rhstype(3:3) = 'X'
+    end if
+    type    = 'RUA'
+
+    write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+         &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+    if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+    write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1)
+    write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero)
+    if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero)
+    if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
+    if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
+    if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
-    class default
 
-      write(0,*) 'format: ',a%get_fmt(),' not yet implemented'
 
-    end select
 
     if (iout /= 6) close(iout)
 
@@ -616,6 +637,9 @@ contains
     return
   end subroutine dhb_write
 
+
+
+
   subroutine chb_read(a, iret, iunit, filename,b,g,x,mtitle)   
     use psb_base_mod
     implicit none
@@ -631,7 +655,7 @@ contains
     character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
     integer        :: indcrd,  ptrcrd, totcrd,&
          & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
-    type(psb_c_csr_sparse_mat) :: acsr
+    type(psb_c_csc_sparse_mat) :: acsc
     type(psb_c_coo_sparse_mat) :: acoo
     integer                     :: ircode, i,nzr,infile, info
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
@@ -663,7 +687,7 @@ contains
          & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
     if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
     
-    call acsr%allocate(nrow,ncol,nnzero)
+    call acsc%allocate(nrow,ncol,nnzero)
     if (ircode /= 0 ) then 
       write(0,*) 'Memory allocation failed'
       goto 993
@@ -672,15 +696,15 @@ contains
     if (present(mtitle)) mtitle=mtitle_
     
 
-    if (psb_tolower(type(1:1)) == 'r') then 
+    if (psb_tolower(type(1:1)) == 'c') then 
       if (psb_tolower(type(2:2)) == 'u') then 
 
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
         
-        call a%mv_from(acsr)
+        call a%mv_from(acsc)
         
         if (present(b)) then
           if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then 
@@ -706,9 +730,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -731,7 +755,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -746,7 +770,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else if (psb_tolower(type(2:2)) == 'h') then 
@@ -754,9 +777,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -779,7 +802,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -794,7 +817,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else
@@ -805,6 +827,8 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       iret=904
     end if
+
+    call a%cscnv(ircode,type='csr')
     if (infile/=5) close(infile)
 
     return 
@@ -824,7 +848,7 @@ contains
   subroutine chb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle)
     use psb_base_mod
     implicit none
-    type(psb_c_sparse_mat), intent(in)  :: a
+    type(psb_c_sparse_mat), intent(in), target :: a
     integer, intent(out)        :: iret
     character(len=*), optional, intent(in) :: mtitle
     integer, optional, intent(in)          :: iunit
@@ -836,11 +860,13 @@ contains
     character(len=*), parameter::  ptrfmt='(10I8)',indfmt='(10I8)'
     integer, parameter :: jptr=10,jind=10
     character(len=*), parameter::  valfmt='(4E20.12)',rhsfmt='(4E20.12)'
-    integer, parameter :: jval=4,jrhs=4
+    integer, parameter :: jval=2,jrhs=2
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
     character(len=*), parameter :: fmt11='(a3,11x,2i14)'
     character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
 
+    type(psb_c_csc_sparse_mat), target  ::  acsc
+    type(psb_c_csc_sparse_mat), pointer ::  acpnt
     character(len=72) :: mtitle_
     character(len=8)  :: key_
 
@@ -883,62 +909,69 @@ contains
 
 
     select type(aa=>a%a)
-    type is (psb_c_csr_sparse_mat)
+    type is (psb_s_csc_sparse_mat)
-      
-      nrow   = aa%get_nrows()
-      ncol   = aa%get_ncols()
-      nnzero = aa%get_nzeros()
-      
-      neltvl = 0 
-
-      ptrcrd = (nrow+1)/jptr
-      if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1
-      indcrd = nnzero/jind
-      if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
-      valcrd = nnzero/jval
-      if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
-      rhstype = ''
-      if (present(rhs)) then 
-        if (size(rhs)<nrow) then 
-          rhscrd = 0
-        else
-          rhscrd = nrow/jrhs
-          if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
-        endif
-        nrhs = 1
-        rhstype(1:1) = 'F'
-      else
-        rhscrd = 0
-        nrhs   = 0
-      end if
-      totcrd = ptrcrd + indcrd + valcrd + rhscrd
 
-      nrhsix  = nrhs*nrow
+      acpnt => aa
 
-      if (present(g)) then 
+    class default
-        rhstype(2:2) = 'G'
-      end if
-      if (present(x)) then 
-        rhstype(3:3) = 'X'
-      end if
-      type    = 'RUA'
 
-      write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+      call acsc%cp_from_fmt(aa, iret)
-           &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+      if (iret/=0) return
-      if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+      acpnt => acsc
-      write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1)
-      write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero)
-      if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero)
-      if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
-      if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
-      if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
+    end select
+
+
+    nrow   = acpnt%get_nrows()
+    ncol   = acpnt%get_ncols()
+    nnzero = acpnt%get_nzeros()
+
+    neltvl = 0 
+
+    ptrcrd = (ncol+1)/jptr
+    if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1
+    indcrd = nnzero/jind
+    if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
+    valcrd = nnzero/jval
+    if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
+    rhstype = ''
+    if (present(rhs)) then 
+      if (size(rhs)<nrow) then 
+        rhscrd = 0
+      else
+        rhscrd = nrow/jrhs
+        if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
+      endif
+      nrhs = 1
+      rhstype(1:1) = 'F'
+    else
+      rhscrd = 0
+      nrhs   = 0
+    end if
+    totcrd = ptrcrd + indcrd + valcrd + rhscrd
+
+    nrhsix  = nrhs*nrow
+
+    if (present(g)) then 
+      rhstype(2:2) = 'G'
+    end if
+    if (present(x)) then 
+      rhstype(3:3) = 'X'
+    end if
+    type    = 'CUA'
+
+    write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+         &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+    if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+    write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1)
+    write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero)
+    if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero)
+    if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
+    if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
+    if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
-    class default
 
-      write(0,*) 'format: ',a%get_fmt(),' not yet implemented'
 
-    end select
 
     if (iout /= 6) close(iout)
 
@@ -968,7 +1001,7 @@ contains
     character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
     integer        :: indcrd,  ptrcrd, totcrd,&
          & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
-    type(psb_z_csr_sparse_mat) :: acsr
+    type(psb_z_csc_sparse_mat) :: acsc
     type(psb_z_coo_sparse_mat) :: acoo
     integer                     :: ircode, i,nzr,infile, info
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
@@ -1000,7 +1033,7 @@ contains
          & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
     if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
     
-    call acsr%allocate(nrow,ncol,nnzero)
+    call acsc%allocate(nrow,ncol,nnzero)
     if (ircode /= 0 ) then 
       write(0,*) 'Memory allocation failed'
       goto 993
@@ -1009,15 +1042,15 @@ contains
     if (present(mtitle)) mtitle=mtitle_
     
 
-    if (psb_tolower(type(1:1)) == 'r') then 
+    if (psb_tolower(type(1:1)) == 'c') then 
       if (psb_tolower(type(2:2)) == 'u') then 
 
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
         
-        call a%mv_from(acsr)
+        call a%mv_from(acsc)
         
         if (present(b)) then
           if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then 
@@ -1043,9 +1076,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -1068,7 +1101,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -1083,7 +1116,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else if (psb_tolower(type(2:2)) == 'h') then 
@@ -1091,9 +1123,9 @@ contains
         ! we are generally working with non-symmetric matrices, so
         ! we de-symmetrize what we are about to read
 
-        read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
+        read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1)
-        read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
+        read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero)
-        if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
+        if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero)
 
 
         if (present(b)) then
@@ -1116,7 +1148,7 @@ contains
         endif
 
         
-        call acoo%mv_from_fmt(acsr,info)
+        call acoo%mv_from_fmt(acsc,info)
         call acoo%reallocate(2*nnzero)
         ! A is now in COO format
         nzr = nnzero
@@ -1131,7 +1163,6 @@ contains
         call acoo%set_nzeros(nzr)
         call acoo%fix(ircode)
         if (ircode==0) call a%mv_from(acoo)
-        if (ircode==0) call a%cscnv(ircode,type='csr')
         if (ircode/=0) goto 993
 
       else
@@ -1142,6 +1173,8 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       iret=904
     end if
+
+    call a%cscnv(ircode,type='csr')
     if (infile/=5) close(infile)
 
     return 
@@ -1161,7 +1194,7 @@ contains
   subroutine zhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle)
     use psb_base_mod
     implicit none
-    type(psb_z_sparse_mat), intent(in)  :: a
+    type(psb_z_sparse_mat), intent(in), target :: a
     integer, intent(out)        :: iret
     character(len=*), optional, intent(in) :: mtitle
     integer, optional, intent(in)          :: iunit
@@ -1173,11 +1206,13 @@ contains
     character(len=*), parameter::  ptrfmt='(10I8)',indfmt='(10I8)'
     integer, parameter :: jptr=10,jind=10
     character(len=*), parameter::  valfmt='(4E20.12)',rhsfmt='(4E20.12)'
-    integer, parameter :: jval=4,jrhs=4
+    integer, parameter :: jval=2,jrhs=2
     character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
     character(len=*), parameter :: fmt11='(a3,11x,2i14)'
     character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
 
+    type(psb_z_csc_sparse_mat), target  ::  acsc
+    type(psb_z_csc_sparse_mat), pointer ::  acpnt
     character(len=72) :: mtitle_
     character(len=8)  :: key_
 
@@ -1220,62 +1255,69 @@ contains
 
 
     select type(aa=>a%a)
-    type is (psb_z_csr_sparse_mat)
+    type is (psb_s_csc_sparse_mat)
-      
-      nrow   = aa%get_nrows()
-      ncol   = aa%get_ncols()
-      nnzero = aa%get_nzeros()
-      
-      neltvl = 0 
-
-      ptrcrd = (nrow+1)/jptr
-      if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1
-      indcrd = nnzero/jind
-      if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
-      valcrd = nnzero/jval
-      if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
-      rhstype = ''
-      if (present(rhs)) then 
-        if (size(rhs)<nrow) then 
-          rhscrd = 0
-        else
-          rhscrd = nrow/jrhs
-          if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
-        endif
-        nrhs = 1
-        rhstype(1:1) = 'F'
-      else
-        rhscrd = 0
-        nrhs   = 0
-      end if
-      totcrd = ptrcrd + indcrd + valcrd + rhscrd
 
-      nrhsix  = nrhs*nrow
+      acpnt => aa
 
-      if (present(g)) then 
+    class default
-        rhstype(2:2) = 'G'
-      end if
-      if (present(x)) then 
-        rhstype(3:3) = 'X'
-      end if
-      type    = 'RUA'
 
-      write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+      call acsc%cp_from_fmt(aa, iret)
-           &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+      if (iret/=0) return
-      if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+      acpnt => acsc
-      write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1)
-      write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero)
-      if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero)
-      if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
-      if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
-      if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
+    end select
+
+
+    nrow   = acpnt%get_nrows()
+    ncol   = acpnt%get_ncols()
+    nnzero = acpnt%get_nzeros()
+
+    neltvl = 0 
+
+    ptrcrd = (ncol+1)/jptr
+    if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1
+    indcrd = nnzero/jind
+    if (mod(nnzero,jind) > 0) indcrd = indcrd + 1
+    valcrd = nnzero/jval
+    if (mod(nnzero,jval) > 0) valcrd = valcrd + 1
+    rhstype = ''
+    if (present(rhs)) then 
+      if (size(rhs)<nrow) then 
+        rhscrd = 0
+      else
+        rhscrd = nrow/jrhs
+        if (mod(nrow,jrhs) > 0) rhscrd = rhscrd + 1
+      endif
+      nrhs = 1
+      rhstype(1:1) = 'F'
+    else
+      rhscrd = 0
+      nrhs   = 0
+    end if
+    totcrd = ptrcrd + indcrd + valcrd + rhscrd
+
+    nrhsix  = nrhs*nrow
+
+    if (present(g)) then 
+      rhstype(2:2) = 'G'
+    end if
+    if (present(x)) then 
+      rhstype(3:3) = 'X'
+    end if
+    type    = 'CUA'
+
+    write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
+         &  type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
+    if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
+    write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1)
+    write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero)
+    if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero)
+    if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
+    if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
+    if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
 
-    class default
 
-      write(0,*) 'format: ',a%get_fmt(),' not yet implemented'
 
-    end select
 
     if (iout /= 6) close(iout)
 

util/psb_mmio_mod.f90

@@ -31,17 +31,25 @@
 !!$  
 module psb_mmio_mod
 
-  public mm_mat_read, mm_mat_write, mm_vet_read
+  public mm_mat_read, mm_mat_write, mm_vet_read, mm_vet_write
+
   interface mm_mat_read
     module procedure smm_mat_read,  dmm_mat_read, cmm_mat_read, zmm_mat_read
   end interface
+
   interface mm_mat_write
     module procedure smm_mat_write, dmm_mat_write, cmm_mat_write,  zmm_mat_write
   end interface
+
   interface mm_vet_read
     module procedure mm_svet_read, mm_dvet_read, mm_cvet_read, mm_zvet_read
   end interface
 
+  interface mm_vet_write
+    module procedure mm_svet2_write, mm_svet1_write, mm_dvet2_write, mm_dvet1_write,&
+         &  mm_cvet2_write, mm_cvet1_write, mm_zvet2_write, mm_zvet1_write
+  end interface
+
 contains
 
   subroutine mm_svet_read(b, info, iunit, filename)   
@@ -340,6 +348,456 @@ contains
     return
   end subroutine mm_zvet_read
 
+  subroutine mm_svet2_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    real(psb_spk_), intent(in)  :: b(:,:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = size(b,2) 
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i,1:ncol)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_svet2_write
+
+  subroutine mm_svet1_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    real(psb_spk_), intent(in)  :: b(:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = 1
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_svet1_write
+
+
+  subroutine mm_dvet2_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    real(psb_dpk_), intent(in)  :: b(:,:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = size(b,2) 
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i,1:ncol)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_dvet2_write
+
+  subroutine mm_dvet1_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    real(psb_dpk_), intent(in)  :: b(:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = 1
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_dvet1_write
+
+
+  subroutine mm_cvet2_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    complex(psb_spk_), intent(in)  :: b(:,:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = size(b,2) 
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i,1:ncol)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_cvet2_write
+
+  subroutine mm_cvet1_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    complex(psb_spk_), intent(in)  :: b(:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = 1
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_cvet1_write
+
+  subroutine mm_zvet2_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    complex(psb_dpk_), intent(in)  :: b(:,:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = size(b,2) 
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i,1:ncol)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_zvet2_write
+
+  subroutine mm_zvet1_write(b, header, info, iunit, filename)   
+    use psb_base_mod
+    implicit none
+    complex(psb_dpk_), intent(in)  :: b(:)
+    character(len=*), intent(in) :: header
+    integer, intent(out)        :: info
+    integer, optional, intent(in)          :: iunit
+    character(len=*), optional, intent(in) :: filename
+    integer              :: nrow, ncol, i,root, np,  me,  ircode, j, outfile
+    
+    character(len=80)                 :: frmtv 
+
+    info = 0
+    if (present(filename)) then
+      if (filename=='-') then 
+        outfile=6
+      else
+        if (present(iunit)) then 
+          outfile=iunit
+        else
+          outfile=99
+        endif
+        open(outfile,file=filename, err=901, action='WRITE')
+      endif
+    else 
+      if (present(iunit)) then 
+        outfile=iunit
+      else
+        outfile=6
+      endif
+    endif
+
+    write(outfile,'(a)') '%%MatrixMarket matrix array real general'
+    write(outfile,'(a)') '% '//trim(header)
+    write(outfile,'(a)') '% '
+    nrow = size(b,1) 
+    ncol = 1
+    write(outfile,*) nrow,ncol
+    
+    write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))'
+
+    do i=1,size(b,1) 
+      write(outfile,frmtv) b(i)
+    end do
+    
+    if (outfile /= 6) close(outfile)
+
+    return 
+    ! open failed
+901 write(0,*) 'mm_vet_write: could not open file ',&
+         & outfile,' for output'
+    info = -1
+    return
+
+  end subroutine mm_zvet1_write
+
 
   subroutine smm_mat_read(a, info, iunit, filename)   
     use psb_base_mod
@@ -431,8 +889,6 @@ contains
     
 
     if (infile/=5) close(infile)
-
-
     return 
 
     ! open failed
@@ -493,8 +949,6 @@ contains
     return
   end subroutine smm_mat_write
 
-
-
   subroutine dmm_mat_read(a, info, iunit, filename)   
     use psb_base_mod
     implicit none
@@ -582,11 +1036,7 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       info=904
     end if
-    
-
     if (infile/=5) close(infile)
-
-
     return 
 
     ! open failed
@@ -759,11 +1209,7 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       info=904
     end if
-    
-
     if (infile/=5) close(infile)
-
-
     return 
 
     ! open failed
@@ -936,11 +1382,7 @@ contains
       write(0,*) 'read_matrix: matrix type not yet supported'
       info=904
     end if
-    
-
     if (infile/=5) close(infile)
-
-
     return 
 
     ! open failed