← Back to branch summary

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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dfspvd.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/dfspvd.f
 
1
*DECK DFSPVD
 
2
      SUBROUTINE DFSPVD (T, K, X, ILEFT, VNIKX, NDERIV)
 
3
C***BEGIN PROLOGUE  DFSPVD
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  Subsidiary to DFC
 
6
C***LIBRARY   SLATEC
 
7
C***TYPE      DOUBLE PRECISION (BSPLVD-S, DFSPVD-D)
 
8
C***AUTHOR  (UNKNOWN)
 
9
C***DESCRIPTION
 
10
C
 
11
C   **** Double Precision Version of BSPLVD ****
 
12
C Calculates value and deriv.s of all B-splines which do not vanish at X
 
13
C
 
14
C  Fill VNIKX(J,IDERIV), J=IDERIV, ... ,K  with nonzero values of
 
15
C  B-splines of order K+1-IDERIV , IDERIV=NDERIV, ... ,1, by repeated
 
16
C  calls to DFSPVN
 
17
C
 
18
C***SEE ALSO  DFC
 
19
C***ROUTINES CALLED  DFSPVN
 
20
C***REVISION HISTORY  (YYMMDD)
 
21
C   780801  DATE WRITTEN
 
22
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
23
C   890831  Modified array declarations.  (WRB)
 
24
C   890911  Removed unnecessary intrinsics.  (WRB)
 
25
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
26
C   900328  Added TYPE section.  (WRB)
 
27
C***END PROLOGUE  DFSPVD
 
28
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
29
      DIMENSION T(*),VNIKX(K,*)
 
30
      DIMENSION A(20,20)
 
31
C***FIRST EXECUTABLE STATEMENT  DFSPVD
 
32
      CALL DFSPVN(T,K+1-NDERIV,1,X,ILEFT,VNIKX(NDERIV,NDERIV))
 
33
      IF (NDERIV .LE. 1)               GO TO 99
 
34
      IDERIV = NDERIV
 
35
      DO 15 I=2,NDERIV
 
36
         IDERVM = IDERIV-1
 
37
         DO 11 J=IDERIV,K
 
38
   11       VNIKX(J-1,IDERVM) = VNIKX(J,IDERIV)
 
39
         IDERIV = IDERVM
 
40
         CALL DFSPVN(T,0,2,X,ILEFT,VNIKX(IDERIV,IDERIV))
 
41
   15    CONTINUE
 
42
C
 
43
      DO 20 I=1,K
 
44
         DO 19 J=1,K
 
45
   19       A(I,J) = 0.D0
 
46
   20    A(I,I) = 1.D0
 
47
      KMD = K
 
48
      DO 40 M=2,NDERIV
 
49
         KMD = KMD-1
 
50
         FKMD = KMD
 
51
         I = ILEFT
 
52
         J = K
 
53
   21       JM1 = J-1
 
54
            IPKMD = I + KMD
 
55
            DIFF = T(IPKMD) - T(I)
 
56
            IF (JM1 .EQ. 0)            GO TO 26
 
57
            IF (DIFF .EQ. 0.D0)          GO TO 25
 
58
            DO 24 L=1,J
 
59
   24          A(L,J) = (A(L,J) - A(L,J-1))/DIFF*FKMD
 
60
   25       J = JM1
 
61
            I = I - 1
 
62
                                       GO TO 21
 
63
   26    IF (DIFF .EQ. 0.)             GO TO 30
 
64
         A(1,1) = A(1,1)/DIFF*FKMD
 
65
C
 
66
   30    DO 40 I=1,K
 
67
            V = 0.D0
 
68
            JLOW = MAX(I,M)
 
69
            DO 35 J=JLOW,K
 
70
   35          V = A(I,J)*VNIKX(J,M) + V
 
71
   40       VNIKX(I,M) = V
 
72
   99                                  RETURN
 
73
      END