home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / libs / matlab.lzh / MATLAB / MATLAB.LZH / Source / MatLab / stack1.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  1.1 KB  |  54 lines
  1.       SUBROUTINE STACK1 (OP)
  2.       IMPLICIT NONE
  3. C
  4. C UNARY OPERATIONS
  5. C
  6.       INTEGER OP
  7. C
  8.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  9.       INCLUDE MATLAB$KOM:VSTK.KOM
  10.       INCLUDE MATLAB$KOM:IOP.KOM
  11. C
  12.       INTEGER QUOTE, I, J, L, LL, LS, M, MN, N
  13. C
  14.       DATA QUOTE / 49 /
  15. C
  16. C
  17.       IF (DDT.EQ.1) WRITE (WTE, 100) OP
  18. 100   FORMAT (' STACK1', I4)
  19.       L = LSTK(TOP)
  20.       M = MSTK(TOP)
  21.       N = NSTK(TOP)
  22.       MN = M*N
  23.       IF (MN.EQ.0) GO TO 99
  24.       IF (OP.EQ.QUOTE) GO TO 30
  25. C
  26. C ***      UNARY MINUS
  27.       CALL WRSCAL (MN, -1.0D0, STKR(L), STKI(L), 1)
  28.       GO TO 99
  29. C
  30. C ***      TRANSPOSE
  31. 30    CONTINUE
  32.       LL = L+MN
  33.       ERR = LL+MN-LSTK(BOT)
  34.       IF (ERR.GT.0) CALL ERROR (17)
  35.       IF (ERR.GT.0) RETURN
  36.       CALL WCOPY (MN, STKR(L), STKI(L), 1, STKR(LL), STKI(LL), 1)
  37.       M = NSTK(TOP)
  38.       N = MSTK(TOP)
  39.       MSTK(TOP) = M
  40.       NSTK(TOP) = N
  41.       DO 51 I = 1, M
  42.         DO 50 J = 1, N
  43.           LS = L+MN+(J-1)+(I-1)*N
  44.           LL = L+(I-1)+(J-1)*M
  45.           STKR(LL) = STKR(LS)
  46.           STKI(LL) = -STKI(LS)
  47. 50      CONTINUE
  48. 51    CONTINUE
  49. C      GO TO 99
  50. C
  51. 99    CONTINUE
  52.       RETURN
  53.       END
  54.