← Back to branch summary

~ubuntu-branches/ubuntu/saucy/python-scipy/saucy

« back to all changes in this revision

Viewing changes to scipy/sandbox/arpack/ARPACK/UTIL/dmout.f

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
scipy/sandbox/arpack/ARPACK/UTIL/dmout.f
 
1
*-----------------------------------------------------------------------
 
2
*  Routine:    DMOUT
 
3
*
 
4
*  Purpose:    Real matrix output routine.
 
5
*
 
6
*  Usage:      CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
 
7
*
 
8
*  Arguments
 
9
*     M      - Number of rows of A.  (Input)
 
10
*     N      - Number of columns of A.  (Input)
 
11
*     A      - Real M by N matrix to be printed.  (Input)
 
12
*     LDA    - Leading dimension of A exactly as specified in the
 
13
*              dimension statement of the calling program.  (Input)
 
14
*     IFMT   - Format to be used in printing matrix A.  (Input)
 
15
*     IDIGIT - Print up to IABS(IDIGIT) decimal digits per number.  (In)
 
16
*              If IDIGIT .LT. 0, printing is done with 72 columns.
 
17
*              If IDIGIT .GT. 0, printing is done with 132 columns.
 
18
*
 
19
*-----------------------------------------------------------------------
 
20
*
 
21
      SUBROUTINE DMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
 
22
*     ...
 
23
*     ... SPECIFICATIONS FOR ARGUMENTS
 
24
*     ...
 
25
*     ... SPECIFICATIONS FOR LOCAL VARIABLES
 
26
*     .. Scalar Arguments ..
 
27
      CHARACTER*( * )    IFMT
 
28
      INTEGER            IDIGIT, LDA, LOUT, M, N
 
29
*     ..
 
30
*     .. Array Arguments ..
 
31
      DOUBLE PRECISION   A( LDA, * )
 
32
*     ..
 
33
*     .. Local Scalars ..
 
34
      CHARACTER*80       LINE
 
35
      INTEGER            I, J, K1, K2, LLL, NDIGIT
 
36
*     ..
 
37
*     .. Local Arrays ..
 
38
      CHARACTER          ICOL( 3 )
 
39
*     ..
 
40
*     .. Intrinsic Functions ..
 
41
      INTRINSIC          LEN, MIN, MIN0
 
42
*     ..
 
43
*     .. Data statements ..
 
44
      DATA               ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
 
45
     $                   'l' /
 
46
*     ..
 
47
*     .. Executable Statements ..
 
48
*     ...
 
49
*     ... FIRST EXECUTABLE STATEMENT
 
50
*
 
51
      LLL = MIN( LEN( IFMT ), 80 )
 
52
      DO 10 I = 1, LLL
 
53
         LINE( I: I ) = '-'
 
54
   10 CONTINUE
 
55
*
 
56
      DO 20 I = LLL + 1, 80
 
57
         LINE( I: I ) = ' '
 
58
   20 CONTINUE
 
59
*
 
60
      WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
 
61
 9999 FORMAT( / 1X, A, / 1X, A )
 
62
*
 
63
      IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
 
64
     $   RETURN
 
65
      NDIGIT = IDIGIT
 
66
      IF( IDIGIT.EQ.0 )
 
67
     $   NDIGIT = 4
 
68
*
 
69
*=======================================================================
 
70
*             CODE FOR OUTPUT USING 72 COLUMNS FORMAT
 
71
*=======================================================================
 
72
*
 
73
      IF( IDIGIT.LT.0 ) THEN
 
74
         NDIGIT = -IDIGIT
 
75
         IF( NDIGIT.LE.4 ) THEN
 
76
            DO 40 K1 = 1, N, 5
 
77
               K2 = MIN0( N, K1+4 )
 
78
               WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
 
79
               DO 30 I = 1, M
 
80
                  WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
 
81
   30          CONTINUE
 
82
   40       CONTINUE
 
83
*
 
84
         ELSE IF( NDIGIT.LE.6 ) THEN
 
85
            DO 60 K1 = 1, N, 4
 
86
               K2 = MIN0( N, K1+3 )
 
87
               WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
 
88
               DO 50 I = 1, M
 
89
                  WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
 
90
   50          CONTINUE
 
91
   60       CONTINUE
 
92
*
 
93
         ELSE IF( NDIGIT.LE.10 ) THEN
 
94
            DO 80 K1 = 1, N, 3
 
95
               K2 = MIN0( N, K1+2 )
 
96
               WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
 
97
               DO 70 I = 1, M
 
98
                  WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
 
99
   70          CONTINUE
 
100
   80       CONTINUE
 
101
*
 
102
         ELSE
 
103
            DO 100 K1 = 1, N, 2
 
104
               K2 = MIN0( N, K1+1 )
 
105
               WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
 
106
               DO 90 I = 1, M
 
107
                  WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
 
108
   90          CONTINUE
 
109
  100       CONTINUE
 
110
         END IF
 
111
*
 
112
*=======================================================================
 
113
*             CODE FOR OUTPUT USING 132 COLUMNS FORMAT
 
114
*=======================================================================
 
115
*
 
116
      ELSE
 
117
         IF( NDIGIT.LE.4 ) THEN
 
118
            DO 120 K1 = 1, N, 10
 
119
               K2 = MIN0( N, K1+9 )
 
120
               WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
 
121
               DO 110 I = 1, M
 
122
                  WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
 
123
  110          CONTINUE
 
124
  120       CONTINUE
 
125
*
 
126
         ELSE IF( NDIGIT.LE.6 ) THEN
 
127
            DO 140 K1 = 1, N, 8
 
128
               K2 = MIN0( N, K1+7 )
 
129
               WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
 
130
               DO 130 I = 1, M
 
131
                  WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
 
132
  130          CONTINUE
 
133
  140       CONTINUE
 
134
*
 
135
         ELSE IF( NDIGIT.LE.10 ) THEN
 
136
            DO 160 K1 = 1, N, 6
 
137
               K2 = MIN0( N, K1+5 )
 
138
               WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
 
139
               DO 150 I = 1, M
 
140
                  WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
 
141
  150          CONTINUE
 
142
  160       CONTINUE
 
143
*
 
144
         ELSE
 
145
            DO 180 K1 = 1, N, 5
 
146
               K2 = MIN0( N, K1+4 )
 
147
               WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
 
148
               DO 170 I = 1, M
 
149
                  WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
 
150
  170          CONTINUE
 
151
  180       CONTINUE
 
152
         END IF
 
153
      END IF
 
154
      WRITE( LOUT, FMT = 9990 )
 
155
*
 
156
 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
 
157
 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
 
158
 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
 
159
 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
 
160
 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 )
 
161
 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 )
 
162
 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 )
 
163
 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 )
 
164
 9990 FORMAT( 1X, ' ' )
 
165
*
 
166
      RETURN
 
167
      END