← Back to branch summary

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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/slvs.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/slvs.f
 
1
*DECK SLVS
 
2
      SUBROUTINE SLVS (WM, IWM, X, TEM)
 
3
C***BEGIN PROLOGUE  SLVS
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  Subsidiary to DEBDF
 
6
C***LIBRARY   SLATEC
 
7
C***TYPE      SINGLE PRECISION (SLVS-S, DSLVS-D)
 
8
C***AUTHOR  Watts, H. A., (SNLA)
 
9
C***DESCRIPTION
 
10
C
 
11
C   SLVS solves the linear system in the iteration scheme for the
 
12
C   integrator package DEBDF.
 
13
C
 
14
C***SEE ALSO  DEBDF
 
15
C***ROUTINES CALLED  SGBSL, SGESL
 
16
C***COMMON BLOCKS    DEBDF1
 
17
C***REVISION HISTORY  (YYMMDD)
 
18
C   800901  DATE WRITTEN
 
19
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
20
C   900328  Added TYPE section.  (WRB)
 
21
C   910722  Updated AUTHOR section.  (ALS)
 
22
C   920422  Changed DIMENSION statement.  (WRB)
 
23
C***END PROLOGUE  SLVS
 
24
C
 
25
CLLL. OPTIMIZE
 
26
      INTEGER IWM, I, IER, IOWND, IOWNS, JSTART, KFLAG, L, MAXORD,
 
27
     1   MEBAND, METH, MITER, ML, MU, N, NFE, NJE, NQ, NQU, NST
 
28
      REAL WM, X, TEM,
 
29
     1   ROWND, ROWNS, EL0, H, HMIN, HMXI, HU, TN, UROUND,
 
30
     2   DI, HL0, PHL0, R
 
31
      DIMENSION WM(*), IWM(*), X(*), TEM(*)
 
32
      COMMON /DEBDF1/ ROWND, ROWNS(210),
 
33
     1   EL0, H, HMIN, HMXI, HU, TN, UROUND, IOWND(14), IOWNS(6),
 
34
     2   IER, JSTART, KFLAG, L, METH, MITER, MAXORD, N, NQ, NST, NFE,
 
35
     3   NJE, NQU
 
36
C-----------------------------------------------------------------------
 
37
C THIS ROUTINE MANAGES THE SOLUTION OF THE LINEAR SYSTEM ARISING FROM
 
38
C A CHORD ITERATION.  IT IS CALLED BY STOD  IF MITER .NE. 0.
 
39
C IF MITER IS 1 OR 2, IT CALLS SGESL TO ACCOMPLISH THIS.
 
40
C IF MITER = 3 IT UPDATES THE COEFFICIENT H*EL0 IN THE DIAGONAL
 
41
C MATRIX, AND THEN COMPUTES THE SOLUTION.
 
42
C IF MITER IS 4 OR 5, IT CALLS SGBSL.
 
43
C COMMUNICATION WITH SLVS USES THE FOLLOWING VARIABLES..
 
44
C WM  = REAL WORK SPACE CONTAINING THE INVERSE DIAGONAL MATRIX IF MITER
 
45
C       IS 3 AND THE LU DECOMPOSITION OF THE MATRIX OTHERWISE.
 
46
C       STORAGE OF MATRIX ELEMENTS STARTS AT WM(3).
 
47
C       WM ALSO CONTAINS THE FOLLOWING MATRIX-RELATED DATA..
 
48
C       WM(1) = SQRT(UROUND) (NOT USED HERE),
 
49
C       WM(2) = HL0, THE PREVIOUS VALUE OF H*EL0, USED IF MITER = 3.
 
50
C IWM = INTEGER WORK SPACE CONTAINING PIVOT INFORMATION, STARTING AT
 
51
C       IWM(21), IF MITER IS 1, 2, 4, OR 5.  IWM ALSO CONTAINS THE
 
52
C       BAND PARAMETERS ML = IWM(1) AND MU = IWM(2) IF MITER IS 4 OR 5.
 
53
C X   = THE RIGHT-HAND SIDE VECTOR ON INPUT, AND THE SOLUTION VECTOR
 
54
C       ON OUTPUT, OF LENGTH N.
 
55
C TEM = VECTOR OF WORK SPACE OF LENGTH N, NOT USED IN THIS VERSION.
 
56
C IER = OUTPUT FLAG (IN COMMON).  IER = 0 IF NO TROUBLE OCCURRED.
 
57
C       IER = -1 IF A SINGULAR MATRIX AROSE WITH MITER = 3.
 
58
C THIS ROUTINE ALSO USES THE COMMON VARIABLES EL0, H, MITER, AND N.
 
59
C-----------------------------------------------------------------------
 
60
C***FIRST EXECUTABLE STATEMENT  SLVS
 
61
      IER = 0
 
62
      GO TO (100, 100, 300, 400, 400), MITER
 
63
 100  CALL SGESL (WM(3), N, N, IWM(21), X, 0)
 
64
      RETURN
 
65
C
 
66
 300  PHL0 = WM(2)
 
67
      HL0 = H*EL0
 
68
      WM(2) = HL0
 
69
      IF (HL0 .EQ. PHL0) GO TO 330
 
70
      R = HL0/PHL0
 
71
      DO 320 I = 1,N
 
72
        DI = 1.0E0 - R*(1.0E0 - 1.0E0/WM(I+2))
 
73
        IF (ABS(DI) .EQ. 0.0E0) GO TO 390
 
74
 320    WM(I+2) = 1.0E0/DI
 
75
 330  DO 340 I = 1,N
 
76
 340    X(I) = WM(I+2)*X(I)
 
77
      RETURN
 
78
 390  IER = -1
 
79
      RETURN
 
80
C
 
81
 400  ML = IWM(1)
 
82
      MU = IWM(2)
 
83
      MEBAND = 2*ML + MU + 1
 
84
      CALL SGBSL (WM(3), MEBAND, N, ML, MU, IWM(21), X, 0)
 
85
      RETURN
 
86
C----------------------- END OF SUBROUTINE SLVS -----------------------
 
87
      END