1* Routine: PIVOUT - Parallel version of ARPACK UTILITY ROUTINE IVOUT 2* 3* Purpose: Integer vector output routine. 4* 5* Usage: CALL PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT) 6* 7* Arguments 8* COMM - BLACS Communicator for the processor grid 9* N - Length of array IX. (Input) 10* IX - Integer array to be printed. (Input) 11* IFMT - Format to be used in printing array IX. (Input) 12* IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input) 13* If IDIGIT .LT. 0, printing is done with 72 columns. 14* If IDIGIT .GT. 0, printing is done with 132 columns. 15* 16*\SCCS Information: 17* FILE: ivout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1 18* 19*----------------------------------------------------------------------- 20* 21 SUBROUTINE PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT) 22* 23* .. BLACS VARIABLES AND FUNCTIONS .. 24* .. Variable Declaration .. 25 integer COMM, NPROW, NPCOL, MYPROW, MYPCOL 26* 27* .. External Functions .. 28 external BLACS_GRIDINFO 29* 30* ... 31* ... SPECIFICATIONS FOR ARGUMENTS 32 INTEGER IX(*), N, IDIGIT, LOUT 33 CHARACTER IFMT*(*) 34* ... 35* ... SPECIFICATIONS FOR LOCAL VARIABLES 36 INTEGER I, NDIGIT, K1, K2, LLL 37 CHARACTER*80 LINE 38* ... 39* ... SPECIFICATIONS INTRINSICS 40 INTRINSIC MIN 41* 42* .. 43* .. Executable Statements .. 44* ... 45* ... FIRST EXECUTABLE STATEMENT 46* 47* Determine processor configuration 48* 49 CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL ) 50* 51* .. Only Processor (0,0) will write to file LOUT .. 52 IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN 53* 54 LLL = MIN ( LEN ( IFMT ), 80 ) 55 DO 1 I = 1, LLL 56 LINE(I:I) = '-' 57 1 CONTINUE 58* 59 DO 2 I = LLL+1, 80 60 LINE(I:I) = ' ' 61 2 CONTINUE 62* 63 WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL) 64 2000 FORMAT ( /1X, A /1X, A ) 65* 66 IF (N .LE. 0) RETURN 67 NDIGIT = IDIGIT 68 IF (IDIGIT .EQ. 0) NDIGIT = 4 69* 70*======================================================================= 71* CODE FOR OUTPUT USING 72 COLUMNS FORMAT 72*======================================================================= 73* 74 IF (IDIGIT .LT. 0) THEN 75* 76 NDIGIT = -IDIGIT 77 IF (NDIGIT .LE. 4) THEN 78 DO 10 K1 = 1, N, 10 79 K2 = MIN0(N,K1+9) 80 WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) 81 10 CONTINUE 82* 83 ELSE IF (NDIGIT .LE. 6) THEN 84 DO 30 K1 = 1, N, 7 85 K2 = MIN0(N,K1+6) 86 WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) 87 30 CONTINUE 88* 89 ELSE IF (NDIGIT .LE. 10) THEN 90 DO 50 K1 = 1, N, 5 91 K2 = MIN0(N,K1+4) 92 WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) 93 50 CONTINUE 94* 95 ELSE 96 DO 70 K1 = 1, N, 3 97 K2 = MIN0(N,K1+2) 98 WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) 99 70 CONTINUE 100 END IF 101* 102*======================================================================= 103* CODE FOR OUTPUT USING 132 COLUMNS FORMAT 104*======================================================================= 105* 106 ELSE 107* 108 IF (NDIGIT .LE. 4) THEN 109 DO 90 K1 = 1, N, 20 110 K2 = MIN0(N,K1+19) 111 WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2) 112 90 CONTINUE 113* 114 ELSE IF (NDIGIT .LE. 6) THEN 115 DO 110 K1 = 1, N, 15 116 K2 = MIN0(N,K1+14) 117 WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2) 118 110 CONTINUE 119* 120 ELSE IF (NDIGIT .LE. 10) THEN 121 DO 130 K1 = 1, N, 10 122 K2 = MIN0(N,K1+9) 123 WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2) 124 130 CONTINUE 125* 126 ELSE 127 DO 150 K1 = 1, N, 7 128 K2 = MIN0(N,K1+6) 129 WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2) 130 150 CONTINUE 131 END IF 132 END IF 133 WRITE (LOUT,1004) 134 135 ENDIF 136* 137 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5)) 138 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7)) 139 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11)) 140 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15)) 141 1004 FORMAT(1X,' ') 142* 143 RETURN 144 END 145