Return to matz CVS log

Up to [Research Unix] / researchv10dc / cmd / matlab

researchv10 Dan Cross

      SUBROUTINE MATZ(A,LDA,M,N,IDA,JOB,IERR)
      INTEGER LDA,M,N,IDA(1),JOB,IERR
      DOUBLE PRECISION A(LDA,N)
C
C     ACCESS MATLAB VARIABLE STACK
C     A IS AN M BY N MATRIX, STORED IN AN ARRAY WITH
C         LEADING DIMENSION LDA.
C     IDA IS THE NAME OF A.
C         IF IDA IS AN INTEGER K LESS THAN 10, THEN THE NAME IS 'A'K
C         OTHERWISE, IDA(1:4) IS FOUR CHARACTERS, FORMAT 4A1.
C     JOB =  0  GET REAL A FROM MATLAB,
C         =  1  PUT REAL A INTO MATLAB,
C         = 10  GET IMAG PART OF A FROM MATLAB,
C         = 11  PUT IMAG PART OF A INTO MATLAB.
C     RETURN WITH NONZERO IERR AFTER MATLAB ERROR MESSAGE.
C
C     USES MATLAB ROUTINES STACKG, STACKP AND ERROR
      DOUBLE PRECISION STKR(5005),STKI(5005)
      INTEGER IDSTK(4,48),LSTK(48),MSTK(48),NSTK(48),VSIZE,LSIZE,BOT,TOP
      INTEGER ALFA(52),ALFB(52),ALFL,CASE
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE
      INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
      COMMON /VSTK/ STKR,STKI,IDSTK,LSTK,MSTK,NSTK,VSIZE,LSIZE,BOT,TOP
      COMMON /ALFS/ ALFA,ALFB,ALFL,CASE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE
      COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
C
      INTEGER ID(4),SEMI,BLANK,ACHAR
      LOGICAL IMG
      DATA SEMI/39/,BLANK/36/,ACHAR/10/
C
      IF (IDA(1).LT.0 .OR. IDA(1).GE.10) GO TO 10
         ID(1) = ACHAR
         ID(2) = IDA(1)
         ID(3) = BLANK
         ID(4) = BLANK
         GO TO 15
   10 DO 12 I = 1, 4
         ID(I) = BLANK
         DO 11 J = 1, BLANK
            IF (IDA(I).EQ.ALFA(J) .OR. IDA(I).EQ.ALFB(J)) ID(I) = J-1
   11    CONTINUE
   12 CONTINUE
C
   15 RHS = 0
      LPT(2) = LPT(1)
      ERR = 0
      IERR = 0
      IMG = JOB/10 .NE. 0
      IF (MOD(JOB,10) .NE. 0) GO TO 30
C
C     GET FROM MATLAB
   20 CALL STACKG(ID)
      IF (FIN .EQ. 0) CALL ERROR(4)
      IF (ERR .GT. 0) GO TO 50
      L = LSTK(TOP)
      M = MSTK(TOP)
      N = NSTK(TOP)
      DO 22 J = 1, N
         DO 21 I = 1, M
            IJ = L + I-1 + (J-1)*M
            A(I,J) = STKR(IJ)
            IF (IMG) A(I,J) = STKI(IJ)
   21    CONTINUE
   22 CONTINUE
      TOP = TOP - 1
      RETURN
C
C     PUT INTO MATLAB
   30 ERR = M*N - LSTK(BOT)
      IF (ERR .GT. 0) CALL ERROR(17)
      IF (ERR .GT. 0) GO TO 50
      TOP = TOP + 1
      LSTK(TOP) = 1
      MSTK(TOP) = M
      NSTK(TOP) = N
      DO 32 J = 1, N
         DO 31 I = 1, M
            IJ = I + (J-1)*M
            STKR(IJ) = A(I,J)
            STKI(IJ) = 0.0D0
            IF (IMG) STKR(IJ) = 0.0D0
            IF (IMG) STKI(IJ) = A(I,J)
   31    CONTINUE
   32 CONTINUE
      SYM = SEMI
      CALL STACKP(ID)
      IF (ERR .GT. 0) GO TO 50
      RETURN
C
   50 IERR = ERR
      RETURN
      END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.