← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/scpplt.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/scpplt.f
 
1
*DECK SCPPLT
 
2
      SUBROUTINE SCPPLT (N, NELT, IA, JA, A, ISYM, IUNIT)
 
3
C***BEGIN PROLOGUE  SCPPLT
 
4
C***PURPOSE  Printer Plot of SLAP Column Format Matrix.
 
5
C            Routine to print out a SLAP Column format matrix in a
 
6
C            "printer plot" graphical representation.
 
7
C***LIBRARY   SLATEC (SLAP)
 
8
C***CATEGORY  N1
 
9
C***TYPE      SINGLE PRECISION (SCPPLT-S, DCPPLT-D)
 
10
C***KEYWORDS  DIAGNOSTICS, LINEAR SYSTEM, SLAP SPARSE
 
11
C***AUTHOR  Seager, Mark K., (LLNL)
 
12
C             Lawrence Livermore National Laboratory
 
13
C             PO BOX 808, L-60
 
14
C             Livermore, CA 94550 (510) 423-3141
 
15
C             seager@llnl.gov
 
16
C***DESCRIPTION
 
17
C
 
18
C *Usage:
 
19
C     INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IUNIT
 
20
C     REAL    A(NELT)
 
21
C
 
22
C     CALL SCPPLT( N, NELT, IA, JA, A, ISYM, IUNIT )
 
23
C
 
24
C *Arguments:
 
25
C N      :IN       Integer
 
26
C         Order of the Matrix.
 
27
C         If N.gt.MAXORD, only the leading MAXORD x MAXORD
 
28
C         submatrix will be printed.  (Currently MAXORD = 225.)
 
29
C NELT   :IN       Integer.
 
30
C         Number of non-zeros stored in A.
 
31
C IA     :IN       Integer IA(NELT).
 
32
C JA     :IN       Integer JA(NELT).
 
33
C A      :IN       Real A(NELT).
 
34
C         These arrays should hold the matrix A in the SLAP
 
35
C         Column format.  See "Description", below.
 
36
C ISYM   :IN       Integer.
 
37
C         Flag to indicate symmetric storage format.
 
38
C         If ISYM=0, all non-zero entries of the matrix are stored.
 
39
C         If ISYM=1, the matrix is symmetric, and only the lower
 
40
C         triangle of the matrix is stored.
 
41
C IUNIT  :IN       Integer.
 
42
C         Fortran logical I/O device unit number to write the matrix
 
43
C         to.  This unit must be connected in a system dependent fashion
 
44
C         to a file or the console or you will get a nasty message
 
45
C         from the Fortran I/O libraries.
 
46
C
 
47
C *Description:
 
48
C       This routine prints out a SLAP  Column format matrix  to the
 
49
C       Fortran logical I/O unit   number  IUNIT.  The  numbers them
 
50
C       selves  are not printed  out, but   rather  a one  character
 
51
C       representation of the numbers.   Elements of the matrix that
 
52
C       are not represented in the (IA,JA,A)  arrays are  denoted by
 
53
C       ' ' character (a blank).  Elements of A that are *ZERO* (and
 
54
C       hence  should  really not be  stored) are  denoted  by a '0'
 
55
C       character.  Elements of A that are *POSITIVE* are denoted by
 
56
C       'D' if they are Diagonal elements  and '#' if  they are off
 
57
C       Diagonal  elements.  Elements of  A that are *NEGATIVE* are
 
58
C       denoted by 'N'  if they  are Diagonal  elements and  '*' if
 
59
C       they are off Diagonal elements.
 
60
C
 
61
C       =================== S L A P Column format ==================
 
62
C
 
63
C       This routine  requires that  the matrix A  be stored in  the
 
64
C       SLAP Column format.  In this format the non-zeros are stored
 
65
C       counting down columns (except for  the diagonal entry, which
 
66
C       must appear first in each  "column")  and are stored  in the
 
67
C       real array A.  In other words, for each column in the matrix
 
68
C       put the diagonal entry in A.  Then put in the other non-zero
 
69
C       elements going down   the  column (except  the diagonal)  in
 
70
C       order.  The IA array holds the row  index for each non-zero.
 
71
C       The JA array holds the offsets into the IA, A arrays for the
 
72
C       beginning of   each    column.    That  is,    IA(JA(ICOL)),
 
73
C       A(JA(ICOL)) points to the beginning of the ICOL-th column in
 
74
C       IA and  A.  IA(JA(ICOL+1)-1),  A(JA(ICOL+1)-1) points to the
 
75
C       end  of   the ICOL-th  column.  Note   that  we  always have
 
76
C       JA(N+1) = NELT+1, where  N  is the number of columns in  the
 
77
C       matrix and  NELT   is the number of non-zeros in the matrix.
 
78
C
 
79
C       Here is an example of the  SLAP Column  storage format for a
 
80
C       5x5 Matrix (in the A and IA arrays '|'  denotes the end of a
 
81
C       column):
 
82
C
 
83
C           5x5 Matrix      SLAP Column format for 5x5 matrix on left.
 
84
C                              1  2  3    4  5    6  7    8    9 10 11
 
85
C       |11 12  0  0 15|   A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35
 
86
C       |21 22  0  0  0|  IA:  1  2  5 |  2  1 |  3  5 |  4 |  5  1  3
 
87
C       | 0  0 33  0 35|  JA:  1  4  6    8  9   12
 
88
C       | 0  0  0 44  0|
 
89
C       |51  0 53  0 55|
 
90
C
 
91
C *Cautions:
 
92
C     This routine will attempt to write to the Fortran logical output
 
93
C     unit IUNIT, if IUNIT .ne. 0.  Thus, the user must make sure that
 
94
C     this logical unit is attached to a file or terminal before calling
 
95
C     this routine with a non-zero value for IUNIT.  This routine does
 
96
C     not check for the validity of a non-zero IUNIT unit number.
 
97
C
 
98
C *Portability:
 
99
C     This routine, as distributed, can generate lines up to 229
 
100
C     characters long.  Some Fortran systems have more restricted
 
101
C     line lengths.  Change parameter MAXORD and the large number
 
102
C     in FORMAT 1010 to reduce this line length.
 
103
C
 
104
C***REFERENCES  (NONE)
 
105
C***ROUTINES CALLED  (NONE)
 
106
C***REVISION HISTORY  (YYMMDD)
 
107
C   871119  DATE WRITTEN
 
108
C   881213  Previous REVISION DATE
 
109
C   890915  Made changes requested at July 1989 CML Meeting.  (MKS)
 
110
C   890922  Numerous changes to prologue to make closer to SLATEC
 
111
C           standard.  (FNF)
 
112
C   890929  Numerous changes to reduce SP/DP differences.  (FNF)
 
113
C   910411  Prologue converted to Version 4.0 format.  (BAB)
 
114
C   920511  Added complete declaration section.  (WRB)
 
115
C   921007  Replaced hard-wired 225 with parameter MAXORD.  (FNF)
 
116
C   921021  Corrected syntax of CHARACTER declaration.  (FNF)
 
117
C   930701  Updated CATEGORY section.  (FNF, WRB)
 
118
C***END PROLOGUE  SCPPLT
 
119
C     .. Scalar Arguments ..
 
120
      INTEGER ISYM, IUNIT, N, NELT
 
121
C     .. Array Arguments ..
 
122
      REAL A(NELT)
 
123
      INTEGER IA(NELT), JA(NELT)
 
124
C     .. Parameters ..
 
125
      INTEGER  MAXORD
 
126
      PARAMETER (MAXORD=225)
 
127
C     .. Local Scalars ..
 
128
      INTEGER I, ICOL, IROW, J, JBGN, JEND, NMAX
 
129
C     .. Local Arrays ..
 
130
      CHARACTER CHMAT(MAXORD)*(MAXORD)
 
131
C     .. Intrinsic Functions ..
 
132
      INTRINSIC MIN, MOD, REAL
 
133
C***FIRST EXECUTABLE STATEMENT  SCPPLT
 
134
C
 
135
C         Set up the character matrix...
 
136
C
 
137
      NMAX = MIN( MAXORD, N )
 
138
      DO 10 I = 1, NMAX
 
139
         CHMAT(I)(1:NMAX) = ' '
 
140
 10   CONTINUE
 
141
      DO 30 ICOL = 1, NMAX
 
142
         JBGN = JA(ICOL)
 
143
         JEND = JA(ICOL+1)-1
 
144
         DO 20 J = JBGN, JEND
 
145
            IROW = IA(J)
 
146
            IF( IROW.LE.NMAX ) THEN
 
147
               IF( ISYM.NE.0 ) THEN
 
148
C         Put in non-sym part as well...
 
149
                  IF( A(J).EQ.0.0E0 ) THEN
 
150
                     CHMAT(IROW)(ICOL:ICOL) = '0'
 
151
                  ELSEIF( A(J).GT.0.0E0 ) THEN
 
152
                     CHMAT(IROW)(ICOL:ICOL) = '#'
 
153
                  ELSE
 
154
                     CHMAT(IROW)(ICOL:ICOL) = '*'
 
155
                  ENDIF
 
156
               ENDIF
 
157
               IF( IROW.EQ.ICOL ) THEN
 
158
C         Diagonal entry.
 
159
                  IF( A(J).EQ.0.0E0 ) THEN
 
160
                     CHMAT(IROW)(ICOL:ICOL) = '0'
 
161
                  ELSEIF( A(J).GT.0.0E0 ) THEN
 
162
                     CHMAT(IROW)(ICOL:ICOL) = 'D'
 
163
                  ELSE
 
164
                     CHMAT(IROW)(ICOL:ICOL) = 'N'
 
165
                  ENDIF
 
166
               ELSE
 
167
C         Off-Diagonal entry
 
168
                  IF( A(J).EQ.0.0E0 ) THEN
 
169
                     CHMAT(IROW)(ICOL:ICOL) = '0'
 
170
                  ELSEIF( A(J).GT.0.0E0 ) THEN
 
171
                     CHMAT(IROW)(ICOL:ICOL) = '#'
 
172
                  ELSE
 
173
                     CHMAT(IROW)(ICOL:ICOL) = '*'
 
174
                  ENDIF
 
175
               ENDIF
 
176
            ENDIF
 
177
 20      CONTINUE
 
178
 30   CONTINUE
 
179
C
 
180
C         Write out the heading.
 
181
      WRITE(IUNIT,1000) N, NELT, REAL(NELT)/(N*N)
 
182
      WRITE(IUNIT,1010) (MOD(I,10),I=1,NMAX)
 
183
C
 
184
C         Write out the character representations matrix elements.
 
185
      DO 40 IROW = 1, NMAX
 
186
         WRITE(IUNIT,1020) IROW, CHMAT(IROW)(1:NMAX)
 
187
 40   CONTINUE
 
188
      RETURN
 
189
C
 
190
 1000 FORMAT(/'**** Picture of Column SLAP matrix follows ****'/
 
191
     $     ' N, NELT and Density = ',2I10,E16.7)
 
192
C      The following assumes MAXORD.le.225.
 
193
 1010 FORMAT(4X,225(I1))
 
194
 1020 FORMAT(1X,I3,A)
 
195
C------------- LAST LINE OF SCPPLT FOLLOWS ----------------------------
 
196
      END