diff liboctave/UMFPACK/UMFPACK/Demo/readhb_size.f @ 5164:57077d0ddc8e

[project @ 2005-02-25 19:55:24 by jwe]
author jwe
date Fri, 25 Feb 2005 19:55:28 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/liboctave/UMFPACK/UMFPACK/Demo/readhb_size.f	Fri Feb 25 19:55:28 2005 +0000
@@ -0,0 +1,47 @@
+c=======================================================================
+c== readhb_size ========================================================
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c UMFPACK Version 4.4, Copyright (c) 2005 by Timothy A. Davis.  CISE
+c Dept, Univ. of Florida.  All Rights Reserved.  See ../Doc/License for
+c License.  web: http://www.cise.ufl.edu/research/sparse/umfpack
+c-----------------------------------------------------------------------
+
+c readhb_size:
+c       read a sparse matrix in the Harwell/Boeing format and output the
+c       size of the matrix (# rows, # columns, and # of entries)
+c
+c usage (for example):
+c
+c       readhb_size < HB/arc130.rua > tmp/Asize
+
+        integer nz, totcrd, ptrcrd,
+     $          indcrd, valcrd, rhscrd, ncol, nrow, nrhs
+        character title*72, key*30, type*3, ptrfmt*16,
+     $          indfmt*16, valfmt*20, rhsfmt*20
+        character rhstyp*3
+        integer nzrhs, nel
+
+c-----------------------------------------------------------------------
+
+c       read header information from Harwell/Boeing matrix
+
+        read (5, 10, err = 998)
+     $          title, key,
+     $          totcrd, ptrcrd, indcrd, valcrd, rhscrd,
+     $          type, nrow, ncol, nz, nel,
+     $          ptrfmt, indfmt, valfmt, rhsfmt
+        if (rhscrd .gt. 0) then
+c          new Harwell/Boeing format:
+           read (5, 20, err = 998) rhstyp,nrhs,nzrhs
+           endif
+10      format (a72, a8 / 5i14 / a3, 11x, 4i14 / 2a16, 2a20)
+20      format (a3, 11x, 2i14)
+
+        write (6, *) nrow, ncol, nz
+        stop
+998     write (0, *) 'Read error'
+        stop
+        end
+