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
|
SUBROUTINE MATVEC (Y,X,FILEA,BUF)
C
C MATVEC WILL FORM THE PRODUCT X = X + A*Y WHERE A IS A MATRIX
C AND Y IS A VECTOR
C
C THIS ROUTINE IS SUITABLE FOR SINGLE PRECISION OPERATION
C
INTEGER FILEA(7) ,SUB(2) ,DIAG ,RSP ,EOL
DIMENSION Y(1) ,X(1) ,BUF(1)
COMMON /ZNTPKX/ A(4) ,II ,EOL
C COMMON /DESCRP/ LENGTH ,MAJOR(1)
COMMON /NAMES / RD ,RDREW ,WRT ,WRTREW ,
1 REW ,NOREW ,EOFNRW ,RSP ,
2 RDP ,CSP ,CDP ,SQR ,
3 RECT ,DIAG ,IWTRI ,UPRTRI ,
4 SYM ,ROW ,IDENTY
COMMON /TRDXX / IDUM(27) ,IOPEN
EQUIVALENCE (A(1),DA)
DATA SUB / 4HMATV, 4HEC /
C
IF (FILEA(1) .EQ. 0) RETURN
NCOL = FILEA(2)
IF (FILEA(4) .EQ. IDENTY) GO TO 60
IF (IOPEN .EQ. 1) GO TO 5
CALL OPEN (*90,FILEA(1),BUF,RDREW)
5 CALL FWDREC (*100,FILEA(1))
IF (FILEA(4) .EQ. DIAG) GO TO 40
C
C MATRIX IS FULL
C
DO 30 I = 1,NCOL
IF (Y(I) .EQ. 0.0) GO TO 20
CALL INTPK (*30,FILEA(1),0,RSP,0)
10 CALL ZNTPKI
X(II) = DA*Y(I) + X(II)
IF (EOL) 30,10,30
20 CALL FWDREC (*100,FILEA(1))
30 CONTINUE
GO TO 80
C
C MATRIX IS DIAGONAL
C
40 CALL INTPK (*80,FILEA(1),0,RSP,0)
50 CALL ZNTPKI
X(II) = Y(II)*DA +X(II)
IF (EOL) 80,50,80
C
C MATRIX IS THE IDENTITY
C
60 DO 70 I = 1,NCOL
70 X(I) = Y(I) + X(I)
RETURN
C
80 CALL REWIND (FILEA(1))
IF (IOPEN .EQ. 0) CALL CLOSE (FILEA(1),REW)
RETURN
C
90 NO = -1
GO TO 110
100 NO = -2
110 CALL MESAGE (NO,FILEA(1),SUB(1))
RETURN
END
|
