Annotation of researchv10dc/cmd/matlab/matz, revision 1.1.1.1

1.1       root        1:       SUBROUTINE MATZ(A,LDA,M,N,IDA,JOB,IERR)
                      2:       INTEGER LDA,M,N,IDA(1),JOB,IERR
                      3:       DOUBLE PRECISION A(LDA,N)
                      4: C
                      5: C     ACCESS MATLAB VARIABLE STACK
                      6: C     A IS AN M BY N MATRIX, STORED IN AN ARRAY WITH
                      7: C         LEADING DIMENSION LDA.
                      8: C     IDA IS THE NAME OF A.
                      9: C         IF IDA IS AN INTEGER K LESS THAN 10, THEN THE NAME IS 'A'K
                     10: C         OTHERWISE, IDA(1:4) IS FOUR CHARACTERS, FORMAT 4A1.
                     11: C     JOB =  0  GET REAL A FROM MATLAB,
                     12: C         =  1  PUT REAL A INTO MATLAB,
                     13: C         = 10  GET IMAG PART OF A FROM MATLAB,
                     14: C         = 11  PUT IMAG PART OF A INTO MATLAB.
                     15: C     RETURN WITH NONZERO IERR AFTER MATLAB ERROR MESSAGE.
                     16: C
                     17: C     USES MATLAB ROUTINES STACKG, STACKP AND ERROR
                     18:       DOUBLE PRECISION STKR(5005),STKI(5005)
                     19:       INTEGER IDSTK(4,48),LSTK(48),MSTK(48),NSTK(48),VSIZE,LSIZE,BOT,TOP
                     20:       INTEGER ALFA(52),ALFB(52),ALFL,CASE
                     21:       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE
                     22:       INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
                     23:       COMMON /VSTK/ STKR,STKI,IDSTK,LSTK,MSTK,NSTK,VSIZE,LSIZE,BOT,TOP
                     24:       COMMON /ALFS/ ALFA,ALFB,ALFL,CASE
                     25:       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE
                     26:       COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
                     27: C
                     28:       INTEGER ID(4),SEMI,BLANK,ACHAR
                     29:       LOGICAL IMG
                     30:       DATA SEMI/39/,BLANK/36/,ACHAR/10/
                     31: C
                     32:       IF (IDA(1).LT.0 .OR. IDA(1).GE.10) GO TO 10
                     33:          ID(1) = ACHAR
                     34:          ID(2) = IDA(1)
                     35:          ID(3) = BLANK
                     36:          ID(4) = BLANK
                     37:          GO TO 15
                     38:    10 DO 12 I = 1, 4
                     39:          ID(I) = BLANK
                     40:          DO 11 J = 1, BLANK
                     41:             IF (IDA(I).EQ.ALFA(J) .OR. IDA(I).EQ.ALFB(J)) ID(I) = J-1
                     42:    11    CONTINUE
                     43:    12 CONTINUE
                     44: C
                     45:    15 RHS = 0
                     46:       LPT(2) = LPT(1)
                     47:       ERR = 0
                     48:       IERR = 0
                     49:       IMG = JOB/10 .NE. 0
                     50:       IF (MOD(JOB,10) .NE. 0) GO TO 30
                     51: C
                     52: C     GET FROM MATLAB
                     53:    20 CALL STACKG(ID)
                     54:       IF (FIN .EQ. 0) CALL ERROR(4)
                     55:       IF (ERR .GT. 0) GO TO 50
                     56:       L = LSTK(TOP)
                     57:       M = MSTK(TOP)
                     58:       N = NSTK(TOP)
                     59:       DO 22 J = 1, N
                     60:          DO 21 I = 1, M
                     61:             IJ = L + I-1 + (J-1)*M
                     62:             A(I,J) = STKR(IJ)
                     63:             IF (IMG) A(I,J) = STKI(IJ)
                     64:    21    CONTINUE
                     65:    22 CONTINUE
                     66:       TOP = TOP - 1
                     67:       RETURN
                     68: C
                     69: C     PUT INTO MATLAB
                     70:    30 ERR = M*N - LSTK(BOT)
                     71:       IF (ERR .GT. 0) CALL ERROR(17)
                     72:       IF (ERR .GT. 0) GO TO 50
                     73:       TOP = TOP + 1
                     74:       LSTK(TOP) = 1
                     75:       MSTK(TOP) = M
                     76:       NSTK(TOP) = N
                     77:       DO 32 J = 1, N
                     78:          DO 31 I = 1, M
                     79:             IJ = I + (J-1)*M
                     80:             STKR(IJ) = A(I,J)
                     81:             STKI(IJ) = 0.0D0
                     82:             IF (IMG) STKR(IJ) = 0.0D0
                     83:             IF (IMG) STKI(IJ) = A(I,J)
                     84:    31    CONTINUE
                     85:    32 CONTINUE
                     86:       SYM = SEMI
                     87:       CALL STACKP(ID)
                     88:       IF (ERR .GT. 0) GO TO 50
                     89:       RETURN
                     90: C
                     91:    50 IERR = ERR
                     92:       RETURN
                     93:       END

unix.superglobalmegacorp.com

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