Mercurial > octave-nkf
diff libcruft/arpack/util/zvout.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/zvout.f Fri Jan 28 14:04:33 2011 -0500 @@ -0,0 +1,240 @@ +c----------------------------------------------------------------------- +c +c\SCCS Information: @(#) +c FILE: zvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 +c +*----------------------------------------------------------------------- +* Routine: ZVOUT +* +* Purpose: Complex*16 vector output routine. +* +* Usage: CALL ZVOUT (LOUT, N, CX, IDIGIT, IFMT) +* +* Arguments +* N - Length of array CX. (Input) +* CX - Complex*16 array to be printed. (Input) +* IFMT - Format to be used in printing array CX. (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 ZVOUT( LOUT, N, CX, IDIGIT, IFMT ) +* ... +* ... SPECIFICATIONS FOR ARGUMENTS + INTEGER N, IDIGIT, LOUT + Complex*16 + & CX( * ) + 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, 2 + K2 = MIN0( N, K1+1 ) + IF (K1.NE.N) THEN + WRITE( LOUT, 9998 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE + WRITE( LOUT, 9997 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 30 CONTINUE + ELSE IF( NDIGIT.LE.6 ) THEN + DO 40 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + IF (K1.NE.N) THEN + WRITE( LOUT, 9988 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE + WRITE( LOUT, 9987 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 40 CONTINUE + ELSE IF( NDIGIT.LE.8 ) THEN + DO 50 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + IF (K1.NE.N) THEN + WRITE( LOUT, 9978 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE + WRITE( LOUT, 9977 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 50 CONTINUE + ELSE + DO 60 K1 = 1, N + WRITE( LOUT, 9968 )K1, K1, CX( I ) + 60 CONTINUE + END IF +* +*======================================================================= +* CODE FOR OUTPUT USING 132 COLUMNS FORMAT +*======================================================================= +* + ELSE + IF( NDIGIT.LE.4 ) THEN + DO 70 K1 = 1, N, 4 + K2 = MIN0( N, K1+3 ) + IF ((K1+3).LE.N) THEN + WRITE( LOUT, 9958 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+3-N) .EQ. 1) THEN + WRITE( LOUT, 9957 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+3-N) .EQ. 2) THEN + WRITE( LOUT, 9956 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+3-N) .EQ. 1) THEN + WRITE( LOUT, 9955 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 70 CONTINUE + ELSE IF( NDIGIT.LE.6 ) THEN + DO 80 K1 = 1, N, 3 + K2 = MIN0( N, K1+2 ) + IF ((K1+2).LE.N) THEN + WRITE( LOUT, 9948 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+2-N) .EQ. 1) THEN + WRITE( LOUT, 9947 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+2-N) .EQ. 2) THEN + WRITE( LOUT, 9946 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 80 CONTINUE + ELSE IF( NDIGIT.LE.8 ) THEN + DO 90 K1 = 1, N, 3 + K2 = MIN0( N, K1+2 ) + IF ((K1+2).LE.N) THEN + WRITE( LOUT, 9938 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+2-N) .EQ. 1) THEN + WRITE( LOUT, 9937 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+2-N) .EQ. 2) THEN + WRITE( LOUT, 9936 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 90 CONTINUE + ELSE + DO 100 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + IF ((K1+2).LE.N) THEN + WRITE( LOUT, 9928 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + ELSE IF ((K1+2-N) .EQ. 1) THEN + WRITE( LOUT, 9927 )K1, K2, ( CX( I ), + $ I = K1, K2 ) + END IF + 100 CONTINUE + END IF + END IF + WRITE( LOUT, 9994 ) + RETURN +* +*======================================================================= +* FORMAT FOR 72 COLUMNS +*======================================================================= +* +* DISPLAY 4 SIGNIFICANT DIGITS +* + 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D10.3,',',D10.3,') ') ) + 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D10.3,',',D10.3,') ') ) +* +* DISPLAY 6 SIGNIFICANT DIGITS +* + 9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D12.5,',',D12.5,') ') ) + 9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D12.5,',',D12.5,') ') ) +* +* DISPLAY 8 SIGNIFICANT DIGITS +* + 9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D14.7,',',D14.7,') ') ) + 9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D14.7,',',D14.7,') ') ) +* +* DISPLAY 13 SIGNIFICANT DIGITS +* + 9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D20.13,',',D20.13,') ') ) +* +*========================================================================= +* FORMAT FOR 132 COLUMNS +*========================================================================= +* +* DISPLAY 4 SIGNIFICANT DIGITS +* + 9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,4('(',D10.3,',',D10.3,') ') ) + 9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,3('(',D10.3,',',D10.3,') ') ) + 9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D10.3,',',D10.3,') ') ) + 9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D10.3,',',D10.3,') ') ) +* +* DISPLAY 6 SIGNIFICANT DIGITS +* + 9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,3('(',D12.5,',',D12.5,') ') ) + 9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D12.5,',',D12.5,') ') ) + 9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D12.5,',',D12.5,') ') ) +* +* DISPLAY 8 SIGNIFICANT DIGITS +* + 9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,3('(',D14.7,',',D14.7,') ') ) + 9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D14.7,',',D14.7,') ') ) + 9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D14.7,',',D14.7,') ') ) +* +* DISPLAY 13 SIGNIFICANT DIGITS +* + 9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,2('(',D20.13,',',D20.13,') ') ) + 9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X, + $ 1P,1('(',D20.13,',',D20.13,') ') ) +* +* +* + 9994 FORMAT( 1X, ' ' ) + END