![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sys.tso CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / matlab|
Return to sys.tso CVS log | Up to [Research Unix] / researchv10dc / cmd / matlab |
1.1 root 1: C PROGRAM MAIN
2: CALL ERRSET(208,1000000,-1,1)
3: CALL ERRSET(207,1000000,0,1)
4: CALL MATLAB(0)
5: STOP
6: END
7: SUBROUTINE FILES(LUNIT,NAME,IOSTAT)
8: INTEGER LUNIT,NAME(32)
9: C
10: C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES
11: C LUNIT = LOGICAL UNIT NUMBER
12: C NAME = FILE NAME, 1 CHARACTER PER WORD
13: C
14: C THIS VERSION FOR SYSTEMS LIKE TSO WITHOUT OPEN AND CLOSE
15: C
16: L = -LUNIT
17: IF (LUNIT .LT. 0) REWIND L
18: IF (LUNIT .GT. 0) WRITE(6,13)
19: 13 FORMAT(1X,'SORRY, OPEN IS NOT AVAILABLE')
20: RETURN
21: END
22: SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG)
23: INTEGER LUNIT,ID(4),M,N,IMG,JOB
24: DOUBLE PRECISION XREAL(1),XIMAG(1)
25: C
26: C IMPLEMENT SAVE AND LOAD
27: C LUNIT = LOGICAL UNIT NUMBER
28: C ID = NAME, FORMAT 4A1
29: C M, N = DIMENSIONS
30: C IMG = NONZERO IF XIMAG IS NONZERO
31: C JOB = 0 FOR SAVE
32: C = SPACE AVAILABLE FOR LOAD
33: C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS
34: C
35: C SYSTEM DEPENDENT FORMATS
36: 101 FORMAT(4A1,3I4)
37: 102 FORMAT(4Z18)
38: C
39: IF (JOB .GT. 0) GO TO 20
40: C
41: C SAVE
42: 10 WRITE(LUNIT,101) ID,M,N,IMG
43: DO 15 J = 1, N
44: K = (J-1)*M+1
45: L = J*M
46: WRITE(LUNIT,102) (XREAL(I),I=K,L)
47: IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L)
48: 15 CONTINUE
49: RETURN
50: C
51: C LOAD
52: 20 READ(LUNIT,101,END=30) ID,M,N,IMG
53: IF (M*N .GT. JOB) GO TO 30
54: DO 25 J = 1, N
55: K = (J-1)*M+1
56: L = J*M
57: READ(LUNIT,102,END=30) (XREAL(I),I=K,L)
58: IF (IMG .NE. 0) READ(LUNIT,102,END=30) (XIMAG(I),I=K,L)
59: 25 CONTINUE
60: RETURN
61: C
62: C END OF FILE
63: 30 M = 0
64: N = 0
65: RETURN
66: END
67: SUBROUTINE FORMZ(LUNIT,X,Y)
68: DOUBLE PRECISION X,Y
69: C
70: C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT
71: C
72: IF (Y .NE. 0.0D0) WRITE(LUNIT,10) X,Y
73: IF (Y .EQ. 0.0D0) WRITE(LUNIT,10) X
74: 10 FORMAT(2Z18)
75: RETURN
76: END
77: DOUBLE PRECISION FUNCTION FLOP(X)
78: DOUBLE PRECISION X
79: C SYSTEM DEPENDENT FUNCTION
80: C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION
81: C FLP(1) IS FLOP COUNTER
82: C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED
83: C
84: INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
85: COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
86: C
87: DOUBLE PRECISION MASK(13),XX,MM
88: LOGICAL LX(2),LM(2)
89: EQUIVALENCE (LX(1),XX),(LM(1),MM)
90: DATA MASK / ZFFFFFFFFFFFFFFF0,ZFFFFFFFFFFFFFF00,
91: $ ZFFFFFFFFFFFFF000,ZFFFFFFFFFFFF0000,ZFFFFFFFFFFF00000,
92: $ ZFFFFFFFFFF000000,ZFFFFFFFFF0000000,ZFFFFFFFF00000000,
93: $ ZFFFFFFF000000000,ZFFFFFF0000000000,ZFFFFF00000000000,
94: $ ZFFFF000000000000,ZFFF0000000000000/
95: C
96: FLP(1) = FLP(1) + 1
97: K = FLP(2)
98: FLOP = X
99: IF (K .LE. 0) RETURN
100: FLOP = 0.0D0
101: IF (K .GE. 14) RETURN
102: XX = X
103: MM = MASK(K)
104: LX(1) = LX(1) .AND. LM(1)
105: LX(2) = LX(2) .AND. LM(2)
106: FLOP = XX
107: RETURN
108: END
109: SUBROUTINE XCHAR(BUF,K)
110: INTEGER BUF(1),K
111: C
112: C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS
113: C
114: WRITE(6,10) BUF(1)
115: 10 FORMAT(1X,A1,' is not a MATLAB character.')
116: RETURN
117: END
118: SUBROUTINE USER(A,M,N,S,T)
119: DOUBLE PRECISION A(M,N),S,T
120: C
121: INTEGER A3(9)
122: DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/
123: IF (A(1,1) .NE. 3.0D0) RETURN
124: DO 10 I = 1, 9
125: A(I,1) = A3(I)
126: 10 CONTINUE
127: M = 3
128: N = 3
129: RETURN
130: END
131: SUBROUTINE PROMPT(PAUSE)
132: INTEGER PAUSE
133: C
134: C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE
135: C
136: INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO
137: COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO
138: WRITE(WTE,10)
139: IF (WIO .NE. 0) WRITE(WIO,10)
140: 10 FORMAT(/1X,'<>')
141: IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY
142: 20 FORMAT(A1)
143: RETURN
144: END
145: SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF)
146: DOUBLE PRECISION X(N),Y(N),P(1)
147: INTEGER BUF(79)
148: C
149: C PLOT X VS. Y ON LUNIT
150: C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS
151: C BUF IS WORK SPACE
152: C
153: DOUBLE PRECISION XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0
154: INTEGER AST,BLANK,H,W
155: DATA AST/1H*/,BLANK/1H /,H/20/,W/79/
156: C
157: C H = HEIGHT, W = WIDTH
158: C
159: XMIN = X(1)
160: XMAX = X(1)
161: YMIN = Y(1)
162: YMAX = Y(1)
163: DO 10 I = 1, N
164: XMIN = DMIN1(XMIN,X(I))
165: XMAX = DMAX1(XMAX,X(I))
166: YMIN = DMIN1(YMIN,Y(I))
167: YMAX = DMAX1(YMAX,Y(I))
168: 10 CONTINUE
169: DX = XMAX - XMIN
170: IF (DX .EQ. 0.0D0) DX = 1.0D0
171: DY = YMAX - YMIN
172: WRITE(LUNIT,35)
173: DO 40 L = 1, H
174: DO 20 J = 1, W
175: BUF(J) = BLANK
176: 20 CONTINUE
177: Y1 = YMIN + (H-L+1)*DY/H
178: Y0 = YMIN + (H-L)*DY/H
179: JMAX = 1
180: DO 30 I = 1, N
181: IF (Y(I) .GT. Y1) GO TO 30
182: IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30
183: J = 1 + (W-1)*(X(I) - XMIN)/DX
184: BUF(J) = AST
185: JMAX = MAX0(JMAX,J)
186: 30 CONTINUE
187: WRITE(LUNIT,35) (BUF(J),J=1,JMAX)
188: 35 FORMAT(1X,79A1)
189: 40 CONTINUE
190: RETURN
191: END
192: SUBROUTINE EDIT(BUF,N)
193: INTEGER BUF(N)
194: C
195: C CALLED AFTER INPUT OF A SINGLE BACKSLASH
196: C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD
197: C ENTER LOCAL EDITOR IF AVAILABLE
198: C OTHERWISE JUST
199: RETURN
200: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.