|
|
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.