diff libcruft/arpack/util/ivout.f @ 12194:470857149e61

import ARPACK sources to libcruft from Debian package libarpack2 2.1+parpack96.dfsg-3+b1
author John W. Eaton <jwe@octave.org>
date Fri, 28 Jan 2011 14:04:33 -0500
parents
children
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/libcruft/arpack/util/ivout.f
@@ -0,0 +1,120 @@
+C-----------------------------------------------------------------------
+C  Routine:    IVOUT
+C
+C  Purpose:    Integer vector output routine.
+C
+C  Usage:      CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
+C
+C  Arguments
+C     N      - Length of array IX. (Input)
+C     IX     - Integer array to be printed. (Input)
+C     IFMT   - Format to be used in printing array IX. (Input)
+C     IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
+C              If IDIGIT .LT. 0, printing is done with 72 columns.
+C              If IDIGIT .GT. 0, printing is done with 132 columns.
+C
+C-----------------------------------------------------------------------
+C
+      SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
+C     ...
+C     ... SPECIFICATIONS FOR ARGUMENTS
+      INTEGER    IX(*), N, IDIGIT, LOUT
+      CHARACTER  IFMT*(*)
+C     ...
+C     ... SPECIFICATIONS FOR LOCAL VARIABLES
+      INTEGER    I, NDIGIT, K1, K2, LLL
+      CHARACTER*80 LINE
+*     ...
+*     ... SPECIFICATIONS INTRINSICS
+      INTRINSIC          MIN
+*
+C
+      LLL = MIN ( LEN ( IFMT ), 80 )
+      DO 1 I = 1, LLL
+          LINE(I:I) = '-'
+    1 CONTINUE
+C
+      DO 2 I = LLL+1, 80
+          LINE(I:I) = ' '
+    2 CONTINUE
+C
+      WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
+ 2000 FORMAT ( /1X, A  /1X, A )
+C
+      IF (N .LE. 0) RETURN
+      NDIGIT = IDIGIT
+      IF (IDIGIT .EQ. 0) NDIGIT = 4
+C
+C=======================================================================
+C             CODE FOR OUTPUT USING 72 COLUMNS FORMAT
+C=======================================================================
+C
+      IF (IDIGIT .LT. 0) THEN
+C
+      NDIGIT = -IDIGIT
+      IF (NDIGIT .LE. 4) THEN
+         DO 10 K1 = 1, N, 10
+            K2 = MIN0(N,K1+9)
+            WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
+   10    CONTINUE
+C
+      ELSE IF (NDIGIT .LE. 6) THEN
+         DO 30 K1 = 1, N, 7
+            K2 = MIN0(N,K1+6)
+            WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
+   30    CONTINUE
+C
+      ELSE IF (NDIGIT .LE. 10) THEN
+         DO 50 K1 = 1, N, 5
+            K2 = MIN0(N,K1+4)
+            WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
+   50    CONTINUE
+C
+      ELSE
+         DO 70 K1 = 1, N, 3
+            K2 = MIN0(N,K1+2)
+            WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
+   70    CONTINUE
+      END IF
+C
+C=======================================================================
+C             CODE FOR OUTPUT USING 132 COLUMNS FORMAT
+C=======================================================================
+C
+      ELSE
+C
+      IF (NDIGIT .LE. 4) THEN
+         DO 90 K1 = 1, N, 20
+            K2 = MIN0(N,K1+19)
+            WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
+   90    CONTINUE
+C
+      ELSE IF (NDIGIT .LE. 6) THEN
+         DO 110 K1 = 1, N, 15
+            K2 = MIN0(N,K1+14)
+            WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
+  110    CONTINUE
+C
+      ELSE IF (NDIGIT .LE. 10) THEN
+         DO 130 K1 = 1, N, 10
+            K2 = MIN0(N,K1+9)
+            WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
+  130    CONTINUE
+C
+      ELSE
+         DO 150 K1 = 1, N, 7
+            K2 = MIN0(N,K1+6)
+            WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
+  150    CONTINUE
+      END IF
+      END IF
+      WRITE (LOUT,1004)
+C
+ 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
+ 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
+ 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
+ 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
+ 1004 FORMAT(1X,' ')
+C
+      RETURN
+      END