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