← Back to branch summary

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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/hwscs1.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/hwscs1.f
 
1
*DECK HWSCS1
 
2
      SUBROUTINE HWSCS1 (INTL, TS, TF, M, MBDCND, BDTS, BDTF, RS, RF, N,
 
3
     +   NBDCND, BDRS, BDRF, ELMBDA, F, IDIMF, PERTRB, W, S, AN, BN, CN,
 
4
     +   R, AM, BM, CM, SINT, BMH)
 
5
C***BEGIN PROLOGUE  HWSCS1
 
6
C***SUBSIDIARY
 
7
C***PURPOSE  Subsidiary to HWSCSP
 
8
C***LIBRARY   SLATEC
 
9
C***TYPE      SINGLE PRECISION (HWSCS1-S)
 
10
C***AUTHOR  (UNKNOWN)
 
11
C***SEE ALSO  HWSCSP
 
12
C***ROUTINES CALLED  BLKTRI
 
13
C***REVISION HISTORY  (YYMMDD)
 
14
C   801001  DATE WRITTEN
 
15
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
16
C   891009  Removed unreferenced variables.  (WRB)
 
17
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
18
C   900402  Added TYPE section.  (WRB)
 
19
C***END PROLOGUE  HWSCS1
 
20
      DIMENSION       F(IDIMF,*) ,BDRS(*)    ,BDRF(*)    ,BDTS(*)    ,
 
21
     1                BDTF(*)    ,AM(*)      ,BM(*)      ,CM(*)      ,
 
22
     2                AN(*)      ,BN(*)      ,CN(*)      ,S(*)       ,
 
23
     3                R(*)       ,SINT(*)    ,BMH(*)     ,W(*)
 
24
C***FIRST EXECUTABLE STATEMENT  HWSCS1
 
25
      MP1 = M+1
 
26
      DTH = (TF-TS)/M
 
27
      TDT = DTH+DTH
 
28
      HDTH = DTH/2.
 
29
      SDTS = 1./(DTH*DTH)
 
30
      DO 102 I=1,MP1
 
31
         THETA = TS+(I-1)*DTH
 
32
         SINT(I) = SIN(THETA)
 
33
         IF (SINT(I)) 101,102,101
 
34
  101    T1 = SDTS/SINT(I)
 
35
         AM(I) = T1*SIN(THETA-HDTH)
 
36
         CM(I) = T1*SIN(THETA+HDTH)
 
37
         BM(I) = -(AM(I)+CM(I))
 
38
  102 CONTINUE
 
39
      NP1 = N+1
 
40
      DR = (RF-RS)/N
 
41
      HDR = DR/2.
 
42
      TDR = DR+DR
 
43
      DR2 = DR*DR
 
44
      CZR = 6.*DTH/(DR2*(COS(TS)-COS(TF)))
 
45
      DO 103 J=1,NP1
 
46
         R(J) = RS+(J-1)*DR
 
47
         AN(J) = (R(J)-HDR)**2/DR2
 
48
         CN(J) = (R(J)+HDR)**2/DR2
 
49
         BN(J) = -(AN(J)+CN(J))
 
50
  103 CONTINUE
 
51
      MP = 1
 
52
      NP = 1
 
53
C
 
54
C BOUNDARY CONDITION AT PHI=PS
 
55
C
 
56
      GO TO (104,104,105,105,106,106,104,105,106),MBDCND
 
57
  104 AT = AM(2)
 
58
      ITS = 2
 
59
      GO TO 107
 
60
  105 AT = AM(1)
 
61
      ITS = 1
 
62
      CM(1) = CM(1)+AM(1)
 
63
      GO TO 107
 
64
  106 ITS = 1
 
65
      BM(1) = -4.*SDTS
 
66
      CM(1) = -BM(1)
 
67
C
 
68
C BOUNDARY CONDITION AT PHI=PF
 
69
C
 
70
  107 GO TO (108,109,109,108,108,109,110,110,110),MBDCND
 
71
  108 CT = CM(M)
 
72
      ITF = M
 
73
      GO TO 111
 
74
  109 CT = CM(M+1)
 
75
      AM(M+1) = AM(M+1)+CM(M+1)
 
76
      ITF = M+1
 
77
      GO TO 111
 
78
  110 ITF = M+1
 
79
      AM(M+1) = 4.*SDTS
 
80
      BM(M+1) = -AM(M+1)
 
81
  111 WTS = SINT(ITS+1)*AM(ITS+1)/CM(ITS)
 
82
      WTF = SINT(ITF-1)*CM(ITF-1)/AM(ITF)
 
83
      ITSP = ITS+1
 
84
      ITFM = ITF-1
 
85
C
 
86
C BOUNDARY CONDITION AT R=RS
 
87
C
 
88
      ICTR = 0
 
89
      GO TO (112,112,113,113,114,114),NBDCND
 
90
  112 AR = AN(2)
 
91
      JRS = 2
 
92
      GO TO 118
 
93
  113 AR = AN(1)
 
94
      JRS = 1
 
95
      CN(1) = CN(1)+AN(1)
 
96
      GO TO 118
 
97
  114 JRS = 2
 
98
      ICTR = 1
 
99
      S(N) = AN(N)/BN(N)
 
100
      DO 115 J=3,N
 
101
         L = N-J+2
 
102
         S(L) = AN(L)/(BN(L)-CN(L)*S(L+1))
 
103
  115 CONTINUE
 
104
      S(2) = -S(2)
 
105
      DO 116 J=3,N
 
106
         S(J) = -S(J)*S(J-1)
 
107
  116 CONTINUE
 
108
      WTNM = WTS+WTF
 
109
      DO 117 I=ITSP,ITFM
 
110
         WTNM = WTNM+SINT(I)
 
111
  117 CONTINUE
 
112
      YPS = CZR*WTNM*(S(2)-1.)
 
113
C
 
114
C BOUNDARY CONDITION AT R=RF
 
115
C
 
116
  118 GO TO (119,120,120,119,119,120),NBDCND
 
117
  119 CR = CN(N)
 
118
      JRF = N
 
119
      GO TO 121
 
120
  120 CR = CN(N+1)
 
121
      AN(N+1) = AN(N+1)+CN(N+1)
 
122
      JRF = N+1
 
123
  121 WRS = AN(JRS+1)*R(JRS)**2/CN(JRS)
 
124
      WRF = CN(JRF-1)*R(JRF)**2/AN(JRF)
 
125
      WRZ = AN(JRS)/CZR
 
126
      JRSP = JRS+1
 
127
      JRFM = JRF-1
 
128
      MUNK = ITF-ITS+1
 
129
      NUNK = JRF-JRS+1
 
130
      DO 122 I=ITS,ITF
 
131
         BMH(I) = BM(I)
 
132
  122 CONTINUE
 
133
      ISING = 0
 
134
      GO TO (132,132,123,132,132,123),NBDCND
 
135
  123 GO TO (132,132,124,132,132,124,132,124,124),MBDCND
 
136
  124 IF (ELMBDA) 132,125,125
 
137
  125 ISING = 1
 
138
      SUM = WTS*WRS+WTS*WRF+WTF*WRS+WTF*WRF
 
139
      IF (ICTR) 126,127,126
 
140
  126 SUM = SUM+WRZ
 
141
  127 DO 129 J=JRSP,JRFM
 
142
         R2 = R(J)**2
 
143
         DO 128 I=ITSP,ITFM
 
144
            SUM = SUM+R2*SINT(I)
 
145
  128    CONTINUE
 
146
  129 CONTINUE
 
147
      DO 130 J=JRSP,JRFM
 
148
         SUM = SUM+(WTS+WTF)*R(J)**2
 
149
  130 CONTINUE
 
150
      DO 131 I=ITSP,ITFM
 
151
         SUM = SUM+(WRS+WRF)*SINT(I)
 
152
  131 CONTINUE
 
153
      HNE = SUM
 
154
  132 GO TO (133,133,133,133,134,134,133,133,134),MBDCND
 
155
  133 BM(ITS) = BMH(ITS)+ELMBDA/SINT(ITS)**2
 
156
  134 GO TO (135,135,135,135,135,135,136,136,136),MBDCND
 
157
  135 BM(ITF) = BMH(ITF)+ELMBDA/SINT(ITF)**2
 
158
  136 DO 137 I=ITSP,ITFM
 
159
         BM(I) = BMH(I)+ELMBDA/SINT(I)**2
 
160
  137 CONTINUE
 
161
      GO TO (138,138,140,140,142,142,138,140,142),MBDCND
 
162
  138 DO 139 J=JRS,JRF
 
163
         F(2,J) = F(2,J)-AT*F(1,J)/R(J)**2
 
164
  139 CONTINUE
 
165
      GO TO 142
 
166
  140 DO 141 J=JRS,JRF
 
167
         F(1,J) = F(1,J)+TDT*BDTS(J)*AT/R(J)**2
 
168
  141 CONTINUE
 
169
  142 GO TO (143,145,145,143,143,145,147,147,147),MBDCND
 
170
  143 DO 144 J=JRS,JRF
 
171
         F(M,J) = F(M,J)-CT*F(M+1,J)/R(J)**2
 
172
  144 CONTINUE
 
173
      GO TO 147
 
174
  145 DO 146 J=JRS,JRF
 
175
         F(M+1,J) = F(M+1,J)-TDT*BDTF(J)*CT/R(J)**2
 
176
  146 CONTINUE
 
177
  147 GO TO (151,151,153,153,148,148),NBDCND
 
178
  148 IF (MBDCND-3) 155,149,155
 
179
  149 YHLD = F(ITS,1)-CZR/TDT*(SIN(TF)*BDTF(2)-SIN(TS)*BDTS(2))
 
180
      DO 150 I=1,MP1
 
181
         F(I,1) = YHLD
 
182
  150 CONTINUE
 
183
      GO TO 155
 
184
  151 RS2 = (RS+DR)**2
 
185
      DO 152 I=ITS,ITF
 
186
         F(I,2) = F(I,2)-AR*F(I,1)/RS2
 
187
  152 CONTINUE
 
188
      GO TO 155
 
189
  153 DO 154 I=ITS,ITF
 
190
         F(I,1) = F(I,1)+TDR*BDRS(I)*AR/RS**2
 
191
  154 CONTINUE
 
192
  155 GO TO (156,158,158,156,156,158),NBDCND
 
193
  156 RF2 = (RF-DR)**2
 
194
      DO 157 I=ITS,ITF
 
195
         F(I,N) = F(I,N)-CR*F(I,N+1)/RF2
 
196
  157 CONTINUE
 
197
      GO TO 160
 
198
  158 DO 159 I=ITS,ITF
 
199
         F(I,N+1) = F(I,N+1)-TDR*BDRF(I)*CR/RF**2
 
200
  159 CONTINUE
 
201
  160 CONTINUE
 
202
      PERTRB = 0.
 
203
      IF (ISING) 161,170,161
 
204
  161 SUM = WTS*WRS*F(ITS,JRS)+WTS*WRF*F(ITS,JRF)+WTF*WRS*F(ITF,JRS)+
 
205
     1      WTF*WRF*F(ITF,JRF)
 
206
      IF (ICTR) 162,163,162
 
207
  162 SUM = SUM+WRZ*F(ITS,1)
 
208
  163 DO 165 J=JRSP,JRFM
 
209
         R2 = R(J)**2
 
210
         DO 164 I=ITSP,ITFM
 
211
            SUM = SUM+R2*SINT(I)*F(I,J)
 
212
  164    CONTINUE
 
213
  165 CONTINUE
 
214
      DO 166 J=JRSP,JRFM
 
215
         SUM = SUM+R(J)**2*(WTS*F(ITS,J)+WTF*F(ITF,J))
 
216
  166 CONTINUE
 
217
      DO 167 I=ITSP,ITFM
 
218
         SUM = SUM+SINT(I)*(WRS*F(I,JRS)+WRF*F(I,JRF))
 
219
  167 CONTINUE
 
220
      PERTRB = SUM/HNE
 
221
      DO 169 J=1,NP1
 
222
         DO 168 I=1,MP1
 
223
            F(I,J) = F(I,J)-PERTRB
 
224
  168    CONTINUE
 
225
  169 CONTINUE
 
226
  170 DO 172 J=JRS,JRF
 
227
         RSQ = R(J)**2
 
228
         DO 171 I=ITS,ITF
 
229
            F(I,J) = RSQ*F(I,J)
 
230
  171    CONTINUE
 
231
  172 CONTINUE
 
232
      IFLG = INTL
 
233
  173 CALL BLKTRI (IFLG,NP,NUNK,AN(JRS),BN(JRS),CN(JRS),MP,MUNK,
 
234
     1             AM(ITS),BM(ITS),CM(ITS),IDIMF,F(ITS,JRS),IERROR,W)
 
235
      IFLG = IFLG+1
 
236
      IF (IFLG-1) 174,173,174
 
237
  174 IF (NBDCND) 177,175,177
 
238
  175 DO 176 I=1,MP1
 
239
         F(I,JRF+1) = F(I,JRS)
 
240
  176 CONTINUE
 
241
  177 IF (MBDCND) 180,178,180
 
242
  178 DO 179 J=1,NP1
 
243
         F(ITF+1,J) = F(ITS,J)
 
244
  179 CONTINUE
 
245
  180 XP = 0.
 
246
      IF (ICTR) 181,188,181
 
247
  181 IF (ISING) 186,182,186
 
248
  182 SUM = WTS*F(ITS,2)+WTF*F(ITF,2)
 
249
      DO 183 I=ITSP,ITFM
 
250
         SUM = SUM+SINT(I)*F(I,2)
 
251
  183 CONTINUE
 
252
      YPH = CZR*SUM
 
253
      XP = (F(ITS,1)-YPH)/YPS
 
254
      DO 185 J=JRS,JRF
 
255
         XPS = XP*S(J)
 
256
         DO 184 I=ITS,ITF
 
257
            F(I,J) = F(I,J)+XPS
 
258
  184    CONTINUE
 
259
  185 CONTINUE
 
260
  186 DO 187 I=1,MP1
 
261
         F(I,1) = XP
 
262
  187 CONTINUE
 
263
  188 RETURN
 
264
      END