Mercurial > octave-nkf
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