V10/cmd/matlab/sys.cdc
PROGRAM MATMAIN(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT)
CALL MATLAB(0)
STOP
END
SUBROUTINE FILES(LUNIT,NAME,IOSTAT)
INTEGER LUNIT,NAME(64),IOSTAT
C
C SYSTEM DEPENDENT ROUTINE TO ALLOCATE FILES
C LUNIT = LOGICAL UNIT NUMBER
C = 1, SAVE
C = 2, LOAD
C = 7, PRINT
C = 8, DIARY
C > 10, EXEC
C < 0, CLOSE -LUNIT
C = -5, SPECIAL CASE, END OF FILE DETECTED ON TERMINAL
C NAME = FILE NAME, 1 CHARACTER PER WORD
C NONZERO IOSTAT RETURNED FOR ERROR CONDITION
C
C (UNLESS CHANGED IN SUBROUTINE MATLAB, UNITS 5, 6 AND 9 ARE
C USED FOR TERMINAL INPUT, TERMINAL OUTPUT AND THE HELP FILE.
C THE HELP FILE IS OPENED BY SUBROUTINE HELPER.)
C
CHARACTER*64 NAM
C
IF (LUNIT .LT. 0) GO TO 30
C
C FORTRAN 77 INTERNAL FILE CONVERSION FROM 64A1 TO CHARACTER*64
C
WRITE(NAM,'(64A1)') NAME
C
C UNFORMATTED I/O FOR SAVE AND LOAD
C FORMATTED I/O FOR EXEC, DIARY AND PRINT
C
IOSTAT = 0
IF (LUNIT .EQ. 1) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
> STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
IF (LUNIT .EQ. 2) OPEN(UNIT=LUNIT,FILE=NAM,FORM='UNFORMATTED',
> STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
IF (LUNIT .EQ. 7) OPEN(UNIT=LUNIT,FILE=NAM,
> STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
IF (LUNIT .EQ. 8) OPEN(UNIT=LUNIT,FILE=NAM,
> STATUS='NEW',ERR=20,IOSTAT=IOSTAT)
IF (LUNIT .GT. 10) OPEN(UNIT=LUNIT,FILE=NAM,
> STATUS='OLD',ERR=20,IOSTAT=IOSTAT)
IF (IOSTAT .NE. 0) GO TO 20
C
C REWIND ALL EXCEPT DIARY
C
IF (LUNIT .NE. 8) REWIND LUNIT
RETURN
C
C ERROR ON OPEN
C
20 IF (IOSTAT .EQ. 0) IOSTAT = -1
RETURN
C
C CLOSE FILES
C
30 CLOSE(UNIT=-LUNIT)
RETURN
END
SUBROUTINE SAVLOD(LUNIT,ID,M,N,IMG,JOB,XREAL,XIMAG)
INTEGER LUNIT,ID(4),M,N,IMG,JOB
REAL XREAL(1),XIMAG(1)
C
C IMPLEMENT SAVE AND LOAD
C LUNIT = LOGICAL UNIT NUMBER
C ID = NAME, FORMAT 4A1
C M, N = DIMENSIONS
C IMG = NONZERO IF XIMAG IS NONZERO
C JOB = 0 FOR SAVE
C = SPACE AVAILABLE FOR LOAD
C XREAL, XIMAG = REAL AND OPTIONAL IMAGINARY PARTS
C
C SYSTEM DEPENDENT FORMATS
101 FORMAT(4A1,3I4)
102 FORMAT(4O20)
C
IF (JOB .GT. 0) GO TO 20
C
C SAVE
10 WRITE(LUNIT,101) ID,M,N,IMG
DO 15 J = 1, N
K = (J-1)*M+1
L = J*M
WRITE(LUNIT,102) (XREAL(I),I=K,L)
IF (IMG .NE. 0) WRITE(LUNIT,102) (XIMAG(I),I=K,L)
15 CONTINUE
RETURN
C
C LOAD
20 READ(LUNIT,101) ID,M,N,IMG
IF (EOF(LUNIT).NE.0) GO TO 30
IF (M*N .GT. JOB) GO TO 30
DO 25 J = 1, N
K = (J-1)*M+1
L = J*M
READ(LUNIT,102) (XREAL(I),I=K,L)
IF (EOF(LUNIT).NE.0) GO TO 30
IF (IMG .NE. 0) READ(LUNIT,102) (XIMAG(I),I=K,L)
IF (EOF(LUNIT).NE.0) GO TO 30
25 CONTINUE
RETURN
C
C END OF FILE
30 M = 0
N = 0
RETURN
END
SUBROUTINE FORMZ(LUNIT,X,Y)
REAL X,Y
C
C SYSTEM DEPENDENT ROUTINE TO PRINT WITH Z FORMAT
C
IF (Y .NE. 0.0E0) WRITE(LUNIT,10) X,Y
IF (Y .EQ. 0.0E0) WRITE(LUNIT,10) X
10 FORMAT(2O22)
RETURN
END
REAL FUNCTION FLOP(X)
REAL X
C SYSTEM DEPENDENT FUNCTION
C COUNT AND POSSIBLY CHOP EACH FLOATING POINT OPERATION
C FLP(1) IS FLOP COUNTER
C FLP(2) IS NUMBER OF PLACES TO BE CHOPPED
C
INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
C
REAL MASK(15)
DATA MASK / 77777777777777777770B,
$ 77777777777777777700B,77777777777777777000B,
$ 77777777777777770000B,77777777777777700000B,
$ 77777777777777000000B,77777777777770000000B,
$ 77777777777700000000B,77777777777000000000B,
$ 77777777770000000000B,77777777700000000000B,
$ 77777777000000000000B,77777770000000000000B,
$ 77777700000000000000B,77777000000000000000B/
C
FLP(1) = FLP(1) + 1
K = FLP(2)
FLOP = X
IF (K .LE. 0) RETURN
FLOP = 0.0E0
IF (K .GE. 16) RETURN
C LOGICAL AND FUNCTION
C FLOP = X .AND. MASK(K) IS AN ALTERNATE
FLOP = AND(X,MASK(K))
RETURN
END
SUBROUTINE XCHAR(BUF,K)
INTEGER BUF(2),K
C
C SYSTEM DEPENDENT ROUTINE TO HANDLE SPECIAL CHARACTERS
C
INTEGER AT,UP,D,COLON
DATA AT/O"74"/,UP/O"76"/,D/O"04"/,COLON/O"7404"/
C TO HANDLE ASCII ON CDC NOS, AT SHOULD BE 74 OCTAL,
C UP SHOULD BE 76 OCTAL, D SHOULD BE 04 OCTAL,
C AND COLON SHOULD BE 7404 OCTAL.
C IN SUBROUTINE MATLAB, THE DATA STATEMENTS FOR ALPHA AND ALPHB
C SHOULD BE ALTERED SO THAT ALPHA(41) IS 63 OCTAL (ASCII PERCENT)
C AND ALPHB(41) IS THE SAME AS THE COLON HERE.
C
C THE 12-BIT CODE FOR COLON IS AT FOLLOWED BY D
IF (BUF(1).EQ.AT .AND. BUF(2).EQ.D) BUF(2) = COLON
C OTHERWISE IGNORE THE TWO 12-BIT ESCAPE CHARACTERS
IF (BUF(1).EQ.AT .OR. BUF(1).EQ.UP) K = 0
C
IF (K .NE. 0) WRITE(6,10) BUF(1)
10 FORMAT(1X,A1,' is not a MATLAB character.')
RETURN
END
SUBROUTINE USER(A,M,N,S,T)
REAL A(M,N),S,T
C
INTEGER A3(9)
DATA A3 /-149,537,-27,-50,180,-9,-154,546,-25/
IF (A(1,1) .NE. 3.0E0) RETURN
DO 10 I = 1, 9
A(I,1) = A3(I)
10 CONTINUE
M = 3
N = 3
RETURN
END
SUBROUTINE PROMPT(PAUSE)
INTEGER PAUSE
C
C ISSUE MATLAB PROMPT WITH OPTIONAL PAUSE
C
INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),RIO,WIO,RTE,WTE,HIO
COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,RIO,WIO,RTE,WTE,HIO
WRITE(WTE,10)
IF (WIO .NE. 0) WRITE(WIO,10)
10 FORMAT(1X,/'<>')
IF (PAUSE .EQ. 1) READ(RTE,20) DUMMY
20 FORMAT(A1)
RETURN
END
SUBROUTINE PLOT(LUNIT,X,Y,N,P,K,BUF)
REAL X(N),Y(N),P(1)
INTEGER BUF(79)
C
C PLOT X VS. Y ON LUNIT
C IF K IS NONZERO, THEN P(1),...,P(K) ARE EXTRA PARAMETERS
C BUF IS WORK SPACE
C
REAL XMIN,YMIN,XMAX,YMAX,DY,DX,Y1,Y0
INTEGER AST,BLANK,H,W
DATA AST/1H*/,BLANK/1H /,H/20/,W/79/
C
C H = HEIGHT, W = WIDTH
C
XMIN = X(1)
XMAX = X(1)
YMIN = Y(1)
YMAX = Y(1)
DO 10 I = 1, N
XMIN = AMIN1(XMIN,X(I))
XMAX = AMAX1(XMAX,X(I))
YMIN = AMIN1(YMIN,Y(I))
YMAX = AMAX1(YMAX,Y(I))
10 CONTINUE
DX = XMAX - XMIN
IF (DX .EQ. 0.0) DX = 1.0
DY = YMAX - YMIN
WRITE(LUNIT,35)
DO 40 L = 1, H
DO 20 J = 1, W
BUF(J) = BLANK
20 CONTINUE
Y1 = YMIN + (H-L+1)*DY/H
Y0 = YMIN + (H-L)*DY/H
JMAX = 1
DO 30 I = 1, N
IF (Y(I) .GT. Y1) GO TO 30
IF (L.NE.H .AND. Y(I).LE.Y0) GO TO 30
J = 1 + (W-1)*(X(I) - XMIN)/DX
BUF(J) = AST
JMAX = MAX0(JMAX,J)
30 CONTINUE
WRITE(LUNIT,35) (BUF(J),J=1,JMAX)
35 FORMAT(1X,79A1)
40 CONTINUE
RETURN
END
SUBROUTINE EDIT(BUF,N)
INTEGER BUF(N)
C
C CALLED AFTER INPUT OF A SINGLE BACKSLASH
C BUF CONTAINS PREVIOUS INPUT LINE, ONE CHAR PER WORD
C ENTER LOCAL EDITOR IF AVAILABLE
C OTHERWISE JUST
RETURN
END