![[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.