diff libcruft/arpack/util/svout.f @ 12274:9f5d2ef078e8 release-3-4-x

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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/arpack/util/svout.f	Fri Jan 28 14:04:33 2011 -0500
@@ -0,0 +1,112 @@
+*-----------------------------------------------------------------------
+*  Routine:    SVOUT
+*
+*  Purpose:    Real vector output routine.
+*
+*  Usage:      CALL SVOUT (LOUT, N, SX, IDIGIT, IFMT)
+*
+*  Arguments
+*     N      - Length of array SX.  (Input)
+*     SX     - Real array to be printed.  (Input)
+*     IFMT   - Format to be used in printing array SX.  (Input)
+*     IDIGIT - Print up to IABS(IDIGIT) decimal digits per number.  (In)
+*              If IDIGIT .LT. 0, printing is done with 72 columns.
+*              If IDIGIT .GT. 0, printing is done with 132 columns.
+*
+*-----------------------------------------------------------------------
+*
+      SUBROUTINE SVOUT( LOUT, N, SX, IDIGIT, IFMT )
+*     ...
+*     ... SPECIFICATIONS FOR ARGUMENTS
+      INTEGER            N, IDIGIT, LOUT
+      REAL               SX( * )
+      CHARACTER          IFMT*( * )
+*     ...
+*     ... SPECIFICATIONS FOR LOCAL VARIABLES
+      INTEGER            I, NDIGIT, K1, K2, LLL
+      CHARACTER*80       LINE
+*     ...
+*     ... FIRST EXECUTABLE STATEMENT
+*
+*
+      LLL = MIN( LEN( IFMT ), 80 )
+      DO 10 I = 1, LLL
+         LINE( I: I ) = '-'
+   10 CONTINUE
+*
+      DO 20 I = LLL + 1, 80
+         LINE( I: I ) = ' '
+   20 CONTINUE
+*
+      WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
+ 9999 FORMAT( / 1X, A / 1X, A )
+*
+      IF( N.LE.0 )
+     $   RETURN
+      NDIGIT = IDIGIT
+      IF( IDIGIT.EQ.0 )
+     $   NDIGIT = 4
+*
+*=======================================================================
+*             CODE FOR OUTPUT USING 72 COLUMNS FORMAT
+*=======================================================================
+*
+      IF( IDIGIT.LT.0 ) THEN
+         NDIGIT = -IDIGIT
+         IF( NDIGIT.LE.4 ) THEN
+            DO 30 K1 = 1, N, 5
+               K2 = MIN0( N, K1+4 )
+               WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
+   30       CONTINUE
+         ELSE IF( NDIGIT.LE.6 ) THEN
+            DO 40 K1 = 1, N, 4
+               K2 = MIN0( N, K1+3 )
+               WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
+   40       CONTINUE
+         ELSE IF( NDIGIT.LE.10 ) THEN
+            DO 50 K1 = 1, N, 3
+               K2 = MIN0( N, K1+2 )
+               WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
+   50       CONTINUE
+         ELSE
+            DO 60 K1 = 1, N, 2
+               K2 = MIN0( N, K1+1 )
+               WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
+   60       CONTINUE
+         END IF
+*
+*=======================================================================
+*             CODE FOR OUTPUT USING 132 COLUMNS FORMAT
+*=======================================================================
+*
+      ELSE
+         IF( NDIGIT.LE.4 ) THEN
+            DO 70 K1 = 1, N, 10
+               K2 = MIN0( N, K1+9 )
+               WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
+   70       CONTINUE
+         ELSE IF( NDIGIT.LE.6 ) THEN
+            DO 80 K1 = 1, N, 8
+               K2 = MIN0( N, K1+7 )
+               WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
+   80       CONTINUE
+         ELSE IF( NDIGIT.LE.10 ) THEN
+            DO 90 K1 = 1, N, 6
+               K2 = MIN0( N, K1+5 )
+               WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
+   90       CONTINUE
+         ELSE
+            DO 100 K1 = 1, N, 5
+               K2 = MIN0( N, K1+4 )
+               WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
+  100       CONTINUE
+         END IF
+      END IF
+      WRITE( LOUT, 9994 )
+      RETURN
+ 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P10E12.3 )
+ 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P8E14.5 )
+ 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P6E18.9 )
+ 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P5E24.13 )
+ 9994 FORMAT( 1X, ' ' )
+      END