← Back to branch summary

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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dxpmup.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/dxpmup.f
 
1
*DECK DXPMUP
 
2
      SUBROUTINE DXPMUP (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
 
3
C***BEGIN PROLOGUE  DXPMUP
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
 
6
C            This subroutine transforms an array of Legendre functions
 
7
C            of the first kind of negative order stored in array PQA
 
8
C            into Legendre functions of the first kind of positive
 
9
C            order stored in array PQA. The original array is destroyed.
 
10
C***LIBRARY   SLATEC
 
11
C***CATEGORY  C3A2, C9
 
12
C***TYPE      DOUBLE PRECISION (XPMUP-S, DXPMUP-D)
 
13
C***KEYWORDS  LEGENDRE FUNCTIONS
 
14
C***AUTHOR  Smith, John M., (NBS and George Mason University)
 
15
C***ROUTINES CALLED  DXADJ
 
16
C***REVISION HISTORY  (YYMMDD)
 
17
C   820728  DATE WRITTEN
 
18
C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
 
19
C   901019  Revisions to prologue.  (DWL and WRB)
 
20
C   901106  Changed all specific intrinsics to generic.  (WRB)
 
21
C           Corrected order of sections in prologue and added TYPE
 
22
C           section.  (WRB)
 
23
C   920127  Revised PURPOSE section of prologue.  (DWL)
 
24
C***END PROLOGUE  DXPMUP
 
25
      DOUBLE PRECISION DMU,NU,NU1,NU2,PQA,PROD
 
26
      DIMENSION PQA(*),IPQA(*)
 
27
C***FIRST EXECUTABLE STATEMENT  DXPMUP
 
28
      IERROR=0
 
29
      NU=NU1
 
30
      MU=MU1
 
31
      DMU=MU
 
32
      N=INT(NU2-NU1+.1D0)+(MU2-MU1)+1
 
33
      J=1
 
34
      IF(MOD(REAL(NU),1.).NE.0.) GO TO 210
 
35
  200 IF(DMU.LT.NU+1.D0) GO TO 210
 
36
      PQA(J)=0.D0
 
37
      IPQA(J)=0
 
38
      J=J+1
 
39
      IF(J.GT.N) RETURN
 
40
C        INCREMENT EITHER MU OR NU AS APPROPRIATE.
 
41
      IF(NU2-NU1.GT..5D0) NU=NU+1.D0
 
42
      IF(MU2.GT.MU1) MU=MU+1
 
43
      GO TO 200
 
44
C
 
45
C        TRANSFORM P(-MU,NU,X) TO P(MU,NU,X) USING
 
46
C        P(MU,NU,X)=(NU-MU+1)*(NU-MU+2)*...*(NU+MU)*P(-MU,NU,X)*(-1)**MU
 
47
C
 
48
  210 PROD=1.D0
 
49
      IPROD=0
 
50
      K=2*MU
 
51
      IF(K.EQ.0) GO TO 222
 
52
      DO 220 L=1,K
 
53
      PROD=PROD*(DMU-NU-L)
 
54
  220 CALL DXADJ(PROD,IPROD,IERROR)
 
55
      IF (IERROR.NE.0) RETURN
 
56
  222 CONTINUE
 
57
      DO 240 I=J,N
 
58
      IF(MU.EQ.0) GO TO 225
 
59
      PQA(I)=PQA(I)*PROD*(-1)**MU
 
60
      IPQA(I)=IPQA(I)+IPROD
 
61
      CALL DXADJ(PQA(I),IPQA(I),IERROR)
 
62
      IF (IERROR.NE.0) RETURN
 
63
  225 IF(NU2-NU1.GT..5D0) GO TO 230
 
64
      PROD=(DMU-NU)*PROD*(-DMU-NU-1.D0)
 
65
      CALL DXADJ(PROD,IPROD,IERROR)
 
66
      IF (IERROR.NE.0) RETURN
 
67
      MU=MU+1
 
68
      DMU=DMU+1.D0
 
69
      GO TO 240
 
70
  230 PROD=PROD*(-DMU-NU-1.D0)/(DMU-NU-1.D0)
 
71
      CALL DXADJ(PROD,IPROD,IERROR)
 
72
      IF (IERROR.NE.0) RETURN
 
73
      NU=NU+1.D0
 
74
  240 CONTINUE
 
75
      RETURN
 
76
      END