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