|
|
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.