1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
SUBROUTINE SDCOM1 (P,AC,WA,WB)
C
INTEGER AC(1),ROW,C,START
REAL P(1),WA(1),WB(1)
COMMON /SDCOMX/ ROW,C,SPFLG,START,FRSTPC,LASTPL,LASTI
C
J = 1
L = 1
K1 = LASTPL + 1
IEND = MIN0(LASTPL,LASTI)
ISTART = MAX0(K1,START)
IF (C .EQ. LASTPL) GO TO 200
IF (START .GT. LASTPL) GO TO 100
DO 48 I = START,IEND
PI =-P(I)/P(1)
IJMK = J - I
ILMK = L - I
DO 10 K = I,LASTPL
WB(K+IJMK) = PI*P(K) + WA(K+ILMK)
10 CONTINUE
L = ILMK + K1
DO 18 K = K1,C
IF (AC(K) .GT. 0) GO TO 12
WB(K+IJMK) = PI*P(K)
GO TO 18
12 WB(K+IJMK) = PI*P(K) + WA(L)
L = L + 1
18 CONTINUE
J = IJMK + C + 1
P(I) = PI
48 CONTINUE
IF (LASTPL .GE. LASTI) RETURN
100 DO 148 I = ISTART,LASTI
PI = -P(I)/P(1)
IJMK = J - I
IF (AC(I) .LT. 0) GO TO 120
DO 118 K = I,C
IF (AC(K) .GT. 0) GO TO 112
WB(K+IJMK) = PI*P(K)
GO TO 118
112 WB(K+IJMK) = PI*P(K) + WA(L)
L = L + 1
118 CONTINUE
GO TO 140
120 DO 128 K = I,C
WB(K+IJMK) = PI*P(K)
128 CONTINUE
140 J = IJMK + C + 1
P(I) = PI
148 CONTINUE
RETURN
C
200 IF (START .GT. LASTPL) GO TO 300
DO 248 I = START,IEND
PI = -P(I)/P(1)
IJMK = J - I
ILMK = L - I
DO 238 K = I,LASTPL
WB(K+IJMK) = PI*P(K) + WA(K+ILMK)
238 CONTINUE
J = IJMK + K1
L = ILMK + K1
P(I) = PI
248 CONTINUE
IF (LASTPL .GE. LASTI) RETURN
300 DO 348 I = ISTART,LASTI
PI = -P(I)/P(1)
IJMK = J - I
IF (AC(I) .LT. 0) GO TO 320
DO 318 K = I,C
IF (AC(K) .GT. 0) GO TO 312
WB(K+IJMK) = PI*P(K)
GO TO 318
312 WB(K+IJMK) = PI*P(K) + WA(L)
L = L + 1
318 CONTINUE
GO TO 340
320 DO 328 K = I,C
WB(K+IJMK) = PI*P(K)
328 CONTINUE
340 J = IJMK + C + 1
P(I) = PI
348 CONTINUE
RETURN
END
|
