![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sys.dec10 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.dec10 CVS log | Up to [Research Unix] / researchv10dc / cmd / matlab |
1.1 root 1: C PROGRAM MAIN
2: CALL MATLAB(0)
3: STOP
4: END
5: SUBROUTINE FILES(LUNIT,NAME,IOSTAT)
6: INTEGER LUNIT,NAME(32)
7: C
8: C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES
9: C LUNIT = LOGICAL UNIT NUMBER
10: C NAME = FILE NAME, 1 CHARACTER PER WORD
11: C
12: DOUBLE PRECISION NAM8
13: C
14: L = -LUNIT
15: IF (LUNIT .LT. 0) REWIND L
16: IF (LUNIT .LT. 0) RETURN
17: C
18: ENCODE(8,10,NAM8) (NAME(I),I=1,8)
19: 10 FORMAT(8A1)
20: OPEN (UNIT=LUNIT, DEVICE='DSK:', FILE=NAM8)
21: RETURN
22: END
23: SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG)
24: INTEGER LUNIT,ID(4),M,N,IMG,JOB
25: DOUBLE PRECISION XREAL(1),XIMAG(1)
26: C
27: C IMPLEMENT SAVE AND LOAD
28: C LUNIT = LOGICAL UNIT NUMBER
29: C ID = NAME, FORMAT 4A1
30: C M, N = DIMENSIONS
31: C IMG = NONZERO IF XIMAG IS NONZERO
32: C JOB = 0 FOR SAVE
33: C = SPACE AVAILABLE FOR LOAD
34: C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS
35: C
36: C SYSTEM DEPENDENT FORMATS
37: 101 FORMAT(4A1,3I4)
38: 102 FORMAT(4O25)
39: C
40: IF (JOB .GT. 0) GO TO 20
41: C
42: C SAVE
43: 10 WRITE(LUNIT,101) ID,M,N,IMG
44: DO 15 J = 1, N
45: K = (J-1)*M+1
46: L = J*M
47: WRITE(LUNIT,102) (XREAL(I),I=K,L)
48: IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L)
49: 15 CONTINUE
50: RETURN
51: C
52: C LOAD
53: 20 READ(LUNIT,101,END=30) ID,M,N,IMG
54: IF (M*N .GT. JOB) GO TO 30
55: DO 25 J = 1, N
56: K = (J-1)*M+1
57: L = J*M
58: READ(LUNIT,102,END=30) (XREAL(I),I=K,L)
59: IF (IMG .NE. 0) READ(LUNIT,102,END=30) (XIMAG(I),I=K,L)
60: 25 CONTINUE
61: RETURN
62: C
63: C END OF FILE
64: 30 M = 0
65: N = 0
66: RETURN
67: END
68: SUBROUTINE FORMZ(LUNIT,X,Y)
69: DOUBLE PRECISION X,Y
70: C
71: C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT
72: C
73: IF (Y .NE. 0.0D0) WRITE(LUNIT,10) X,Y
74: IF (Y .EQ. 0.0D0) WRITE(LUNIT,10) X
75: 10 FORMAT(2O25)
76: RETURN
77: END
78: DOUBLE PRECISION FUNCTION FLOP(X)
79: DOUBLE PRECISION X
80: C SYSTEM DEPENDENT FUNCTION
81: C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION
82: C FLP(1) IS FLOP COUNTER
83: C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED
84: C
85: INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
86: COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
87: C
88: DOUBLE PRECISION MASK(21),XX,MM
89: LOGICAL LX(2),LM(2)
90: EQUIVALENCE (LX(1),XX),(LM(1),MM)
91: DATA MASK /"777777777777777777777770,
92: $ "777777777777777777777700,
93: $ "777777777777777777777000,
94: $ "777777777777777777770000,
95: $ "777777777777777777700000,
96: $ "777777777777777777000000,
97: $ "777777777777777770000000,
98: $ "777777777777777700000000,
99: $ "777777777777777000000000,
100: $ "777777777777770000000000,
101: $ "777777777777700000000000,
102: $ "777777777777000000000000,
103: $ "777777777770000000000000,
104: $ "777777777700000000000000,
105: $ "777777777000000000000000,
106: $ "777777770000000000000000,
107: $ "777777700000000000000000,
108: $ "777777000000000000000000,
109: $ "777770000000000000000000,
110: $ "777700000000000000000000,
111: $ "777000000000000000000000/
112: C
113: FLP(1) = FLP(1) + 1
114: K = FLP(2)
115: FLOP = X
116: IF (K .LE. 0) RETURN
117: FLOP = 0.0D0
118: IF (K .GE. 22) RETURN
119: XX = X
120: MM = MASK(K)
121: LX(1) = LX(1) .AND. LM(1)
122: LX(2) = LX(2) .AND. LM(2)
123: FLOP = XX
124: RETURN
125: END
126: SUBROUTINE XCHAR(BUF,K)
127: INTEGER BUF(1),K
128: C
129: C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS
130: C
131: WRITE(6,10) BUF(1)
132: 10 FORMAT(1X,A1,' is not a MATLAB character.')
133: RETURN
134: END
135: SUBROUTINE USER(A,M,N,S,T)
136: DOUBLE PRECISION A(M,N),S,T
137: C
138: INTEGER A3(9)
139: DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/
140: IF (A(1,1) .NE. 3.0D0) RETURN
141: DO 10 I = 1, 9
142: A(I,1) = A3(I)
143: 10 CONTINUE
144: M = 3
145: N = 3
146: RETURN
147: END
148: SUBROUTINE PROMPT(PAUSE)
149: INTEGER PAUSE
150: C
151: C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE
152: C
153: INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO
154: COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO
155: WRITE(WTE,10)
156: IF (WIO .NE. 0) WRITE(WIO,10)
157: 10 FORMAT(/1X,'<>')
158: IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY
159: 20 FORMAT(A1)
160: RETURN
161: END
162: SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF)
163: DOUBLE PRECISION X(N),Y(N),P(1)
164: INTEGER BUF(79)
165: C
166: C PLOT X VS. Y ON LUNIT
167: C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS
168: C BUF IS WORK SPACE
169: C
170: DOUBLE PRECISION XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0
171: INTEGER AST,BLANK,H,W
172: DATA AST/1H*/,BLANK/1H /,H/20/,W/79/
173: C
174: C H = HEIGHT, W = WIDTH
175: C
176: XMIN = X(1)
177: XMAX = X(1)
178: YMIN = Y(1)
179: YMAX = Y(1)
180: DO 10 I = 1, N
181: XMIN = DMIN1(XMIN,X(I))
182: XMAX = DMAX1(XMAX,X(I))
183: YMIN = DMIN1(YMIN,Y(I))
184: YMAX = DMAX1(YMAX,Y(I))
185: 10 CONTINUE
186: DX = XMAX - XMIN
187: IF (DX .EQ. 0.0D0) DX = 1.0D0
188: DY = YMAX - YMIN
189: WRITE(LUNIT,35)
190: DO 40 L = 1, H
191: DO 20 J = 1, W
192: BUF(J) = BLANK
193: 20 CONTINUE
194: Y1 = YMIN + (H-L+1)*DY/H
195: Y0 = YMIN + (H-L)*DY/H
196: JMAX = 1
197: DO 30 I = 1, N
198: IF (Y(I) .GT. Y1) GO TO 30
199: IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30
200: J = 1 + (W-1)*(X(I) - XMIN)/DX
201: BUF(J) = AST
202: JMAX = MAX0(JMAX,J)
203: 30 CONTINUE
204: WRITE(LUNIT,35) (BUF(J),J=1,JMAX)
205: 35 FORMAT(1X,79A1)
206: 40 CONTINUE
207: RETURN
208: END
209: SUBROUTINE EDIT(BUF,N)
210: INTEGER BUF(N)
211: C
212: C CALLED AFTER INPUT OF A SINGLE BACKSLASH
213: C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD
214: C ENTER LOCAL EDITOR IF AVAILABLE
215: C OTHERWISE JUST
216: RETURN
217: END
218: DOUBLE PRECISION FUNCTION DSINH(X)
219: IMPLICIT DOUBLE PRECISION (A-Z)
220: DATA A0/-.139005324307231D6/,
221: $ A1/-.180697428204813D5/,
222: $ A2/-.404150536907816D3/,
223: $ B0/-.139005324307231D6/,
224: $ B1/+.509781123072247D4/,
225: $ B2/-.954080394016126D2/
226: IF (DABS(X) .LT. 0.5D0) GO TO 10
227: E = DEXP(X)
228: DSINH = 0.5D0*(E-1.0D0/E)
229: RETURN
230: 10 Y = X*X
231: P = ((A2*Y)+A1)*Y+A0
232: Q = ((Y+B2)*Y+B1)*Y+B0
233: DSINH = X*P/Q
234: RETURN
235: END
236: DOUBLE PRECISION FUNCTION DCOSH(X)
237: IMPLICIT DOUBLE PRECISION (A-Z)
238: E = DEXP(X)
239: DCOSH = 0.5D0*(E+1.0D0/E)
240: RETURN
241: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.