![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sys.vms 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.vms CVS log | Up to [Research Unix] / researchv10dc / cmd / matlab |
1.1 root 1: C PROGRAM MAIN FOR VAX/VMS
2: C For overflow handling, RTFM on Common Run-Time Library.
3: C Also compile subroutine URAND with FORTRAN/NOCHECK.
4: EXTERNAL UNTRAP
5: CALL LIB$ESTABLISH(UNTRAP)
6: CALL MATLAB(0)
7: STOP
8: END
9: INTEGER FUNCTION UNTRAP(SIGARGS,MECHARGS)
10: INTEGER SIGARGS(3),MECHARGS(5)
11: INCLUDE 'SYS$LIBRARY:SIGDEF'
12: INTEGER HUGE(2)
13: DATA HUGE/'FFFF7FFF'X,'FFFFFFFF'X/
14: I = LIB$SIM_TRAP(SIGARGS,MECHARGS)
15: IF (LIB$MATCH_COND (SIGARGS(2), SS$_FLTOVF)) THEN
16: WRITE(6,10)
17: 10 FORMAT(' ---OVERFLOW---')
18: CALL LIB$INSV(1,0,3,SIGARGS(2))
19: UNTRAP = SS$_CONTINUE
20: ELSEIF (LIB$MATCH_COND (SIGARGS(2), SS$_INTOVF)) THEN
21: WRITE(6,12)
22: 12 FORMAT(' ---INTEGER OVERFLOW---')
23: CALL LIB$INSV(2,0,3,SIGARGS(2))
24: UNTRAP = SS$_CONTINUE
25: ELSEIF (LIB$MATCH_COND (SIGARGS(2), SS$_ROPRAND)) THEN
26: UNTRAP = LIB$FIXUP_FLT(SIGARGS,MECHARGS,HUGE)
27: ELSE
28: UNTRAP = SS$_RESIGNAL
29: ENDIF
30: RETURN
31: END
32: SUBROUTINE FILES(LUNIT,NAME,IOSTAT)
33: INTEGER LUNIT,NAME(64),IOSTAT
34: C
35: C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES
36: C LUNIT = LOGICAL UNIT NUMBER
37: C = 1, SAVE
38: C = 2, LOAD
39: C = 7, PRINT
40: C = 8, DIARY
41: C > 10, EXEC
42: C < 0, CLOSE -LUNIT
43: C = -5, SPECIAL CASE, END OF FILE DETECTED ON TERMINAL
44: C NAME = FILE NAME, 1 CHARACTER PER WORD
45: C NONZERO IOSTAT RETURNED FOR ERROR CONDITION
46: C
47: C (UNLESS CHANGED IN SUBROUTINE MATLAB, UNITS 5, 6 AND 9 ARE
48: C USED FOR TERMINAL INPUT, TERMINAL OUTPUT AND THE HELP FILE.
49: C THE HELP FILE IS OPENED BY SUBROUTINE HELPER.)
50: C
51: CHARACTER*64 NAM
52: C
53: IF (LUNIT .LT. 0) GO TO 30
54: C
55: C FORTRAN 77 INTERNAL FILE CONVERSION FROM 64A1 TO CHARACTER*64
56: C
57: WRITE(NAM,'(64A1)') NAME
58: C
59: C UNFORMATTED I/O FOR SAVE AND LOAD
60: C FORMATTED I/O FOR EXEC, DIARY AND PRINT
61: C
62: IOSTAT = 0
63: IF (LUNIT .EQ. 1) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
64: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
65: IF (LUNIT .EQ. 2) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
66: > STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
67: IF (LUNIT .EQ. 7) OPEN(UNIT=LUNIT,FILE=NAM,
68: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
69: IF (LUNIT .EQ. 8) OPEN(UNIT=LUNIT,FILE=NAM,
70: > STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
71: IF (LUNIT .GT. 10) OPEN(UNIT=LUNIT,FILE=NAM,
72: > STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
73: IF (IOSTAT .NE. 0) GO TO 20
74: C
75: C REWIND ALL EXCEPT DIARY
76: C
77: IF (LUNIT .NE. 8) REWIND LUNIT
78: RETURN
79: C
80: C ERROR ON OPEN
81: C
82: 20 IF (IOSTAT .EQ. 0) IOSTAT = -1
83: RETURN
84: C
85: C CLOSE FILES
86: C
87: 30 CLOSE(UNIT=-LUNIT)
88: RETURN
89: END
90: SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG)
91: INTEGER LUNIT,ID(4),M,N,IMG,JOB
92: DOUBLE PRECISION XREAL(1),XIMAG(1)
93: C
94: C IMPLEMENT SAVE AND LOAD
95: C LUNIT = LOGICAL UNIT NUMBER
96: C ID = NAME, FORMAT 4A1
97: C M, N = DIMENSIONS
98: C IMG = NONZERO IF XIMAG IS NONZERO
99: C JOB = 0 FOR SAVE
100: C = SPACE AVAILABLE FOR LOAD
101: C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS
102: C
103: C SYSTEM DEPENDENT FORMATS
104: 101 FORMAT(4A1,3I4)
105: 102 FORMAT(4Z18)
106: C
107: IF (JOB .GT. 0) GO TO 20
108: C
109: C SAVE
110: 10 WRITE(LUNIT,101) ID,M,N,IMG
111: DO 15 J = 1, N
112: K = (J-1)*M+1
113: L = J*M
114: WRITE(LUNIT,102) (XREAL(I),I=K,L)
115: IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L)
116: 15 CONTINUE
117: RETURN
118: C
119: C LOAD
120: 20 READ(LUNIT,101,END=30) ID,M,N,IMG
121: IF (M*N .GT. JOB) GO TO 30
122: DO 25 J = 1, N
123: K = (J-1)*M+1
124: L = J*M
125: READ(LUNIT,102,END=30) (XREAL(I),I=K,L)
126: IF (IMG .NE. 0) READ(LUNIT,102,END=30) (XIMAG(I),I=K,L)
127: 25 CONTINUE
128: RETURN
129: C
130: C END OF FILE
131: 30 M = 0
132: N = 0
133: RETURN
134: END
135: SUBROUTINE FORMZ(LUNIT,X,Y)
136: DOUBLE PRECISION X,Y
137: C
138: C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT
139: C
140: IF (Y .NE. 0.0D0) WRITE(LUNIT,10) X,Y
141: IF (Y .EQ. 0.0D0) WRITE(LUNIT,10) X
142: 10 FORMAT(2Z18)
143: RETURN
144: END
145: DOUBLE PRECISION FUNCTION FLOP(X)
146: DOUBLE PRECISION X
147: C SYSTEM DEPENDENT FUNCTION
148: C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION
149: C FLP(1) IS FLOP COUNTER
150: C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED
151: C
152: INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
153: COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
154: C
155: DOUBLE PRECISION MASK(14),XX,MM
156: real mas(2,14)
157: LOGICAL LX(2),LM(2)
158: EQUIVALENCE (LX(1),XX),(LM(1),MM)
159: equivalence (mask(1),mas(1))
160: data mas/
161: $ 'ffffffff'x,'fff0ffff'x,
162: $ 'ffffffff'x,'ff00ffff'x,
163: $ 'ffffffff'x,'f000ffff'x,
164: $ 'ffffffff'x,'0000ffff'x,
165: $ 'ffffffff'x,'0000fff0'x,
166: $ 'ffffffff'x,'0000ff00'x,
167: $ 'ffffffff'x,'0000f000'x,
168: $ 'ffffffff'x,'00000000'x,
169: $ 'fff0ffff'x,'00000000'x,
170: $ 'ff00ffff'x,'00000000'x,
171: $ 'f000ffff'x,'00000000'x,
172: $ '0000ffff'x,'00000000'x,
173: $ '0000fff0'x,'00000000'x,
174: $ '0000ff80'x,'00000000'x/
175: C
176: FLP(1) = FLP(1) + 1
177: K = FLP(2)
178: FLOP = X
179: IF (K .LE. 0) RETURN
180: FLOP = 0.0D0
181: IF (K .GE. 15) RETURN
182: XX = X
183: MM = MASK(K)
184: LX(1) = LX(1) .AND. LM(1)
185: LX(2) = LX(2) .AND. LM(2)
186: FLOP = XX
187: RETURN
188: END
189: SUBROUTINE XCHAR(BUF,K)
190: INTEGER BUF(1),K
191: C
192: C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS
193: C
194: C
195: INTEGER BACK,MASK
196: DATA BACK/'20202008'X/,MASK/'000000FF'X/
197: C
198: IF (BUF(1) .EQ. BACK) K = -1
199: L = BUF(1) .AND. MASK
200: IF (K .NE. -1) WRITE(6,10) BUF(1),L
201: 10 FORMAT(1X,1H',A1,4H' = ,Z2,' hex is not a MATLAB character.')
202: RETURN
203: END
204: SUBROUTINE USER(A,M,N,S,T)
205: DOUBLE PRECISION A(M,N),S,T
206: C
207: INTEGER A3(9)
208: DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/
209: IF (A(1,1) .NE. 3.0D0) RETURN
210: DO 10 I = 1, 9
211: A(I,1) = A3(I)
212: 10 CONTINUE
213: M = 3
214: N = 3
215: RETURN
216: END
217: SUBROUTINE PROMPT(PAUSE)
218: INTEGER PAUSE
219: C
220: C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE
221: C
222: INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO
223: COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO
224: WRITE(WTE,10)
225: IF (WIO .NE. 0) WRITE(WIO,10)
226: 10 FORMAT(/1X,'<>')
227: IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY
228: 20 FORMAT(A1)
229: RETURN
230: END
231: SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF)
232: DOUBLE PRECISION X(N),Y(N),P(1)
233: INTEGER BUF(79)
234: C
235: C PLOT X VS. Y ON LUNIT
236: C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS
237: C BUF IS WORK SPACE
238: C
239: DOUBLE PRECISION XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0
240: INTEGER AST,BLANK,H,W
241: DATA AST/1H*/,BLANK/1H /,H/20/,W/79/
242: C
243: C H = HEIGHT, W = WIDTH
244: C
245: XMIN = X(1)
246: XMAX = X(1)
247: YMIN = Y(1)
248: YMAX = Y(1)
249: DO 10 I = 1, N
250: XMIN = DMIN1(XMIN,X(I))
251: XMAX = DMAX1(XMAX,X(I))
252: YMIN = DMIN1(YMIN,Y(I))
253: YMAX = DMAX1(YMAX,Y(I))
254: 10 CONTINUE
255: DX = XMAX - XMIN
256: IF (DX .EQ. 0.0D0) DX = 1.0D0
257: DY = YMAX - YMIN
258: WRITE(LUNIT,35)
259: DO 40 L = 1, H
260: DO 20 J = 1, W
261: BUF(J) = BLANK
262: 20 CONTINUE
263: Y1 = YMIN + (H-L+1)*DY/H
264: Y0 = YMIN + (H-L)*DY/H
265: JMAX = 1
266: DO 30 I = 1, N
267: IF (Y(I) .GT. Y1) GO TO 30
268: IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30
269: J = 1 + (W-1)*(X(I) - XMIN)/DX
270: BUF(J) = AST
271: JMAX = MAX0(JMAX,J)
272: 30 CONTINUE
273: WRITE(LUNIT,35) (BUF(J),J=1,JMAX)
274: 35 FORMAT(1X,79A1)
275: 40 CONTINUE
276: RETURN
277: END
278: SUBROUTINE EDIT(BUF,N)
279: INTEGER BUF(N)
280: C
281: C CALLED AFTER INPUT OF A SINGLE BACKSLASH
282: C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD
283: C ENTER LOCAL EDITOR IF AVAILABLE
284: C OTHERWISE JUST
285: RETURN
286: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.