![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sys.tso 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.tso CVS log | Up to [Research Unix] / researchv10dc / cmd / matlab |
1.1 ! root 1: C PROGRAM MAIN ! 2: CALL ERRSET(208,1000000,-1,1) ! 3: CALL ERRSET(207,1000000,0,1) ! 4: CALL MATLAB(0) ! 5: STOP ! 6: END ! 7: SUBROUTINE FILES(LUNIT,NAME,IOSTAT) ! 8: INTEGER LUNIT,NAME(32) ! 9: C ! 10: C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES ! 11: C LUNIT = LOGICAL UNIT NUMBER ! 12: C NAME = FILE NAME, 1 CHARACTER PER WORD ! 13: C ! 14: C THIS VERSION FOR SYSTEMS LIKE TSO WITHOUT OPEN AND CLOSE ! 15: C ! 16: L = -LUNIT ! 17: IF (LUNIT .LT. 0) REWIND L ! 18: IF (LUNIT .GT. 0) WRITE(6,13) ! 19: 13 FORMAT(1X,'SORRY, OPEN IS NOT AVAILABLE') ! 20: RETURN ! 21: END ! 22: SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG) ! 23: INTEGER LUNIT,ID(4),M,N,IMG,JOB ! 24: DOUBLE PRECISION XREAL(1),XIMAG(1) ! 25: C ! 26: C IMPLEMENT SAVE AND LOAD ! 27: C LUNIT = LOGICAL UNIT NUMBER ! 28: C ID = NAME, FORMAT 4A1 ! 29: C M, N = DIMENSIONS ! 30: C IMG = NONZERO IF XIMAG IS NONZERO ! 31: C JOB = 0 FOR SAVE ! 32: C = SPACE AVAILABLE FOR LOAD ! 33: C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS ! 34: C ! 35: C SYSTEM DEPENDENT FORMATS ! 36: 101 FORMAT(4A1,3I4) ! 37: 102 FORMAT(4Z18) ! 38: C ! 39: IF (JOB .GT. 0) GO TO 20 ! 40: C ! 41: C SAVE ! 42: 10 WRITE(LUNIT,101) ID,M,N,IMG ! 43: DO 15 J = 1, N ! 44: K = (J-1)*M+1 ! 45: L = J*M ! 46: WRITE(LUNIT,102) (XREAL(I),I=K,L) ! 47: IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L) ! 48: 15 CONTINUE ! 49: RETURN ! 50: C ! 51: C LOAD ! 52: 20 READ(LUNIT,101,END=30) ID,M,N,IMG ! 53: IF (M*N .GT. JOB) GO TO 30 ! 54: DO 25 J = 1, N ! 55: K = (J-1)*M+1 ! 56: L = J*M ! 57: READ(LUNIT,102,END=30) (XREAL(I),I=K,L) ! 58: IF (IMG .NE. 0) READ(LUNIT,102,END=30) (XIMAG(I),I=K,L) ! 59: 25 CONTINUE ! 60: RETURN ! 61: C ! 62: C END OF FILE ! 63: 30 M = 0 ! 64: N = 0 ! 65: RETURN ! 66: END ! 67: SUBROUTINE FORMZ(LUNIT,X,Y) ! 68: DOUBLE PRECISION X,Y ! 69: C ! 70: C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT ! 71: C ! 72: IF (Y .NE. 0.0D0) WRITE(LUNIT,10) X,Y ! 73: IF (Y .EQ. 0.0D0) WRITE(LUNIT,10) X ! 74: 10 FORMAT(2Z18) ! 75: RETURN ! 76: END ! 77: DOUBLE PRECISION FUNCTION FLOP(X) ! 78: DOUBLE PRECISION X ! 79: C SYSTEM DEPENDENT FUNCTION ! 80: C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION ! 81: C FLP(1) IS FLOP COUNTER ! 82: C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED ! 83: C ! 84: INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2) ! 85: COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN ! 86: C ! 87: DOUBLE PRECISION MASK(13),XX,MM ! 88: LOGICAL LX(2),LM(2) ! 89: EQUIVALENCE (LX(1),XX),(LM(1),MM) ! 90: DATA MASK / ZFFFFFFFFFFFFFFF0,ZFFFFFFFFFFFFFF00, ! 91: $ ZFFFFFFFFFFFFF000,ZFFFFFFFFFFFF0000,ZFFFFFFFFFFF00000, ! 92: $ ZFFFFFFFFFF000000,ZFFFFFFFFF0000000,ZFFFFFFFF00000000, ! 93: $ ZFFFFFFF000000000,ZFFFFFF0000000000,ZFFFFF00000000000, ! 94: $ ZFFFF000000000000,ZFFF0000000000000/ ! 95: C ! 96: FLP(1) = FLP(1) + 1 ! 97: K = FLP(2) ! 98: FLOP = X ! 99: IF (K .LE. 0) RETURN ! 100: FLOP = 0.0D0 ! 101: IF (K .GE. 14) RETURN ! 102: XX = X ! 103: MM = MASK(K) ! 104: LX(1) = LX(1) .AND. LM(1) ! 105: LX(2) = LX(2) .AND. LM(2) ! 106: FLOP = XX ! 107: RETURN ! 108: END ! 109: SUBROUTINE XCHAR(BUF,K) ! 110: INTEGER BUF(1),K ! 111: C ! 112: C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS ! 113: C ! 114: WRITE(6,10) BUF(1) ! 115: 10 FORMAT(1X,A1,' is not a MATLAB character.') ! 116: RETURN ! 117: END ! 118: SUBROUTINE USER(A,M,N,S,T) ! 119: DOUBLE PRECISION A(M,N),S,T ! 120: C ! 121: INTEGER A3(9) ! 122: DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/ ! 123: IF (A(1,1) .NE. 3.0D0) RETURN ! 124: DO 10 I = 1, 9 ! 125: A(I,1) = A3(I) ! 126: 10 CONTINUE ! 127: M = 3 ! 128: N = 3 ! 129: RETURN ! 130: END ! 131: SUBROUTINE PROMPT(PAUSE) ! 132: INTEGER PAUSE ! 133: C ! 134: C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE ! 135: C ! 136: INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO ! 137: COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO ! 138: WRITE(WTE,10) ! 139: IF (WIO .NE. 0) WRITE(WIO,10) ! 140: 10 FORMAT(/1X,'<>') ! 141: IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY ! 142: 20 FORMAT(A1) ! 143: RETURN ! 144: END ! 145: SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF) ! 146: DOUBLE PRECISION X(N),Y(N),P(1) ! 147: INTEGER BUF(79) ! 148: C ! 149: C PLOT X VS. Y ON LUNIT ! 150: C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS ! 151: C BUF IS WORK SPACE ! 152: C ! 153: DOUBLE PRECISION XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0 ! 154: INTEGER AST,BLANK,H,W ! 155: DATA AST/1H*/,BLANK/1H /,H/20/,W/79/ ! 156: C ! 157: C H = HEIGHT, W = WIDTH ! 158: C ! 159: XMIN = X(1) ! 160: XMAX = X(1) ! 161: YMIN = Y(1) ! 162: YMAX = Y(1) ! 163: DO 10 I = 1, N ! 164: XMIN = DMIN1(XMIN,X(I)) ! 165: XMAX = DMAX1(XMAX,X(I)) ! 166: YMIN = DMIN1(YMIN,Y(I)) ! 167: YMAX = DMAX1(YMAX,Y(I)) ! 168: 10 CONTINUE ! 169: DX = XMAX - XMIN ! 170: IF (DX .EQ. 0.0D0) DX = 1.0D0 ! 171: DY = YMAX - YMIN ! 172: WRITE(LUNIT,35) ! 173: DO 40 L = 1, H ! 174: DO 20 J = 1, W ! 175: BUF(J) = BLANK ! 176: 20 CONTINUE ! 177: Y1 = YMIN + (H-L+1)*DY/H ! 178: Y0 = YMIN + (H-L)*DY/H ! 179: JMAX = 1 ! 180: DO 30 I = 1, N ! 181: IF (Y(I) .GT. Y1) GO TO 30 ! 182: IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30 ! 183: J = 1 + (W-1)*(X(I) - XMIN)/DX ! 184: BUF(J) = AST ! 185: JMAX = MAX0(JMAX,J) ! 186: 30 CONTINUE ! 187: WRITE(LUNIT,35) (BUF(J),J=1,JMAX) ! 188: 35 FORMAT(1X,79A1) ! 189: 40 CONTINUE ! 190: RETURN ! 191: END ! 192: SUBROUTINE EDIT(BUF,N) ! 193: INTEGER BUF(N) ! 194: C ! 195: C CALLED AFTER INPUT OF A SINGLE BACKSLASH ! 196: C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD ! 197: C ENTER LOCAL EDITOR IF AVAILABLE ! 198: C OTHERWISE JUST ! 199: RETURN ! 200: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.