![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sys.cdc 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.cdc CVS log | Up to [Research Unix] / researchv10dc / cmd / matlab |
1.1 root 1: PROGRAM MATMAIN(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT)
2: CALL MATLAB(0)
3: STOP
4: END
5: SUBROUTINE FILES(LUNIT,NAME,IOSTAT)
6: INTEGER LUNIT,NAME(64),IOSTAT
7: C
8: C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES
9: C LUNIT = LOGICAL UNIT NUMBER
10: C = 1, SAVE
11: C = 2, LOAD
12: C = 7, PRINT
13: C = 8, DIARY
14: C > 10, EXEC
15: C < 0, CLOSE -LUNIT
16: C = -5, SPECIAL CASE, END OF FILE DETECTED ON TERMINAL
17: C NAME = FILE NAME, 1 CHARACTER PER WORD
18: C NONZERO IOSTAT RETURNED FOR ERROR CONDITION
19: C
20: C (UNLESS CHANGED IN SUBROUTINE MATLAB, UNITS 5, 6 AND 9 ARE
21: C USED FOR TERMINAL INPUT, TERMINAL OUTPUT AND THE HELP FILE.
22: C THE HELP FILE IS OPENED BY SUBROUTINE HELPER.)
23: C
24: CHARACTER*64 NAM
25: C
26: IF (LUNIT .LT. 0) GO TO 30
27: C
28: C FORTRAN 77 INTERNAL FILE CONVERSION FROM 64A1 TO CHARACTER*64
29: C
30: WRITE(NAM,'(64A1)') NAME
31: C
32: C UNFORMATTED I/O FOR SAVE AND LOAD
33: C FORMATTED I/O FOR EXEC, DIARY AND PRINT
34: C
35: IOSTAT = 0
36: IF (LUNIT .EQ. 1) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
37: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
38: IF (LUNIT .EQ. 2) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
39: > STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
40: IF (LUNIT .EQ. 7) OPEN(UNIT=LUNIT,FILE=NAM,
41: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
42: IF (LUNIT .EQ. 8) OPEN(UNIT=LUNIT,FILE=NAM,
43: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
44: IF (LUNIT .GT. 10) OPEN(UNIT=LUNIT,FILE=NAM,
45: > STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
46: IF (IOSTAT .NE. 0) GO TO 20
47: C
48: C REWIND ALL EXCEPT DIARY
49: C
50: IF (LUNIT .NE. 8) REWIND LUNIT
51: RETURN
52: C
53: C ERROR ON OPEN
54: C
55: 20 IF (IOSTAT .EQ. 0) IOSTAT = -1
56: RETURN
57: C
58: C CLOSE FILES
59: C
60: 30 CLOSE(UNIT=-LUNIT)
61: RETURN
62: END
63: SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG)
64: INTEGER LUNIT,ID(4),M,N,IMG,JOB
65: REAL XREAL(1),XIMAG(1)
66: C
67: C IMPLEMENT SAVE AND LOAD
68: C LUNIT = LOGICAL UNIT NUMBER
69: C ID = NAME, FORMAT 4A1
70: C M, N = DIMENSIONS
71: C IMG = NONZERO IF XIMAG IS NONZERO
72: C JOB = 0 FOR SAVE
73: C = SPACE AVAILABLE FOR LOAD
74: C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS
75: C
76: C SYSTEM DEPENDENT FORMATS
77: 101 FORMAT(4A1,3I4)
78: 102 FORMAT(4O20)
79: C
80: IF (JOB .GT. 0) GO TO 20
81: C
82: C SAVE
83: 10 WRITE(LUNIT,101) ID,M,N,IMG
84: DO 15 J = 1, N
85: K = (J-1)*M+1
86: L = J*M
87: WRITE(LUNIT,102) (XREAL(I),I=K,L)
88: IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L)
89: 15 CONTINUE
90: RETURN
91: C
92: C LOAD
93: 20 READ(LUNIT,101) ID,M,N,IMG
94: IF (EOF(LUNIT).NE.0) GO TO 30
95: IF (M*N .GT. JOB) GO TO 30
96: DO 25 J = 1, N
97: K = (J-1)*M+1
98: L = J*M
99: READ(LUNIT,102) (XREAL(I),I=K,L)
100: IF (EOF(LUNIT).NE.0) GO TO 30
101: IF (IMG .NE. 0) READ(LUNIT,102) (XIMAG(I),I=K,L)
102: IF (EOF(LUNIT).NE.0) GO TO 30
103: 25 CONTINUE
104: RETURN
105: C
106: C END OF FILE
107: 30 M = 0
108: N = 0
109: RETURN
110: END
111: SUBROUTINE FORMZ(LUNIT,X,Y)
112: REAL X,Y
113: C
114: C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT
115: C
116: IF (Y .NE. 0.0E0) WRITE(LUNIT,10) X,Y
117: IF (Y .EQ. 0.0E0) WRITE(LUNIT,10) X
118: 10 FORMAT(2O22)
119: RETURN
120: END
121: REAL FUNCTION FLOP(X)
122: REAL X
123: C SYSTEM DEPENDENT FUNCTION
124: C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION
125: C FLP(1) IS FLOP COUNTER
126: C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED
127: C
128: INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
129: COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
130: C
131: REAL MASK(15)
132: DATA MASK / 77777777777777777770B,
133: $ 77777777777777777700B,77777777777777777000B,
134: $ 77777777777777770000B,77777777777777700000B,
135: $ 77777777777777000000B,77777777777770000000B,
136: $ 77777777777700000000B,77777777777000000000B,
137: $ 77777777770000000000B,77777777700000000000B,
138: $ 77777777000000000000B,77777770000000000000B,
139: $ 77777700000000000000B,77777000000000000000B/
140: C
141: FLP(1) = FLP(1) + 1
142: K = FLP(2)
143: FLOP = X
144: IF (K .LE. 0) RETURN
145: FLOP = 0.0E0
146: IF (K .GE. 16) RETURN
147: C LOGICAL AND FUNCTION
148: C FLOP = X .AND. MASK(K) IS AN ALTERNATE
149: FLOP = AND(X,MASK(K))
150: RETURN
151: END
152: SUBROUTINE XCHAR(BUF,K)
153: INTEGER BUF(2),K
154: C
155: C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS
156: C
157: INTEGER AT,UP,D,COLON
158: DATA AT/O"74"/,UP/O"76"/,D/O"04"/,COLON/O"7404"/
159: C TO HANDLE ASCII ON CDC NOS, AT SHOULD BE 74 OCTAL,
160: C UP SHOULD BE 76 OCTAL, D SHOULD BE 04 OCTAL,
161: C AND COLON SHOULD BE 7404 OCTAL.
162: C IN SUBROUTINE MATLAB, THE DATA STATEMENTS FOR ALPHA AND ALPHB
163: C SHOULD BE ALTERED SO THAT ALPHA(41) IS 63 OCTAL (ASCII PERCENT)
164: C AND ALPHB(41) IS THE SAME AS THE COLON HERE.
165: C
166: C THE 12-BIT CODE FOR COLON IS AT FOLLOWED BY D
167: IF (BUF(1).EQ.AT .AND. BUF(2).EQ.D) BUF(2) = COLON
168: C OTHERWISE IGNORE THE TWO 12-BIT ESCAPE CHARACTERS
169: IF (BUF(1).EQ.AT .OR. BUF(1).EQ.UP) K = 0
170: C
171: IF (K .NE. 0) WRITE(6,10) BUF(1)
172: 10 FORMAT(1X,A1,' is not a MATLAB character.')
173: RETURN
174: END
175: SUBROUTINE USER(A,M,N,S,T)
176: REAL A(M,N),S,T
177: C
178: INTEGER A3(9)
179: DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/
180: IF (A(1,1) .NE. 3.0E0) RETURN
181: DO 10 I = 1, 9
182: A(I,1) = A3(I)
183: 10 CONTINUE
184: M = 3
185: N = 3
186: RETURN
187: END
188: SUBROUTINE PROMPT(PAUSE)
189: INTEGER PAUSE
190: C
191: C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE
192: C
193: INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO
194: COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO
195: WRITE(WTE,10)
196: IF (WIO .NE. 0) WRITE(WIO,10)
197: 10 FORMAT(1X,/'<>')
198: IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY
199: 20 FORMAT(A1)
200: RETURN
201: END
202: SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF)
203: REAL X(N),Y(N),P(1)
204: INTEGER BUF(79)
205: C
206: C PLOT X VS. Y ON LUNIT
207: C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS
208: C BUF IS WORK SPACE
209: C
210: REAL XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0
211: INTEGER AST,BLANK,H,W
212: DATA AST/1H*/,BLANK/1H /,H/20/,W/79/
213: C
214: C H = HEIGHT, W = WIDTH
215: C
216: XMIN = X(1)
217: XMAX = X(1)
218: YMIN = Y(1)
219: YMAX = Y(1)
220: DO 10 I = 1, N
221: XMIN = AMIN1(XMIN,X(I))
222: XMAX = AMAX1(XMAX,X(I))
223: YMIN = AMIN1(YMIN,Y(I))
224: YMAX = AMAX1(YMAX,Y(I))
225: 10 CONTINUE
226: DX = XMAX - XMIN
227: IF (DX .EQ. 0.0) DX = 1.0
228: DY = YMAX - YMIN
229: WRITE(LUNIT,35)
230: DO 40 L = 1, H
231: DO 20 J = 1, W
232: BUF(J) = BLANK
233: 20 CONTINUE
234: Y1 = YMIN + (H-L+1)*DY/H
235: Y0 = YMIN + (H-L)*DY/H
236: JMAX = 1
237: DO 30 I = 1, N
238: IF (Y(I) .GT. Y1) GO TO 30
239: IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30
240: J = 1 + (W-1)*(X(I) - XMIN)/DX
241: BUF(J) = AST
242: JMAX = MAX0(JMAX,J)
243: 30 CONTINUE
244: WRITE(LUNIT,35) (BUF(J),J=1,JMAX)
245: 35 FORMAT(1X,79A1)
246: 40 CONTINUE
247: RETURN
248: END
249: SUBROUTINE EDIT(BUF,N)
250: INTEGER BUF(N)
251: C
252: C CALLED AFTER INPUT OF A SINGLE BACKSLASH
253: C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD
254: C ENTER LOCAL EDITOR IF AVAILABLE
255: C OTHERWISE JUST
256: RETURN
257: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.