* Routine: PDVOUT - Parallel Version of ARPACK utility routine DVOUT * * Purpose: Double precision vector output routine. * * Usage: CALL PDVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT) * * Arguments * COMM - BLACS Communicator for the processor grid * N - Length of array SX. (Input) * SX - Double precision 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. * *\SCCS Information: * FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1 * *----------------------------------------------------------------------- * SUBROUTINE PDVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT ) * ... * .. BLACS VARIABLES AND FUNCTIONS .. * .. Variable Declaration .. integer COMM, NPROW, NPCOL, MYPROW, MYPCOL * * .. External Functions .. external BLACS_GRIDINFO * * ... SPECIFICATIONS FOR ARGUMENTS * ... * ... SPECIFICATIONS FOR LOCAL VARIABLES * .. Scalar Arguments .. CHARACTER*( * ) IFMT INTEGER IDIGIT, LOUT, N * .. * .. Array Arguments .. Double precision & SX( * ) * .. * .. Local Scalars .. CHARACTER*80 LINE INTEGER I, K1, K2, LLL, NDIGIT * .. * .. Intrinsic Functions .. INTRINSIC LEN, MIN, MIN0 * .. * .. Executable Statements .. * ... * ... FIRST EXECUTABLE STATEMENT * * Determine processor configuration * CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL ) * * .. Only Processor (0,0) will write to file LOUT .. * IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN * 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, FMT = 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, FMT = 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, FMT = 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, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 50 CONTINUE ELSE DO 60 K1 = 1, N, 2 K2 = MIN0( N, K1+1 ) WRITE( LOUT, FMT = 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, FMT = 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, FMT = 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, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 ) 90 CONTINUE ELSE DO 100 K1 = 1, N, 5 K2 = MIN0( N, K1+4 ) WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 ) 100 CONTINUE END IF END IF WRITE( LOUT, FMT = 9994 ) ENDIF RETURN 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 ) 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 ) 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 ) 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 ) 9994 FORMAT( 1X, ' ' ) END