Annotation of researchv10dc/cmd/matlab/matz, revision 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.