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 / print.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  4.2 KB  |  134 lines
  1.       SUBROUTINE PRINT (ID, K)
  2.       IMPLICIT NONE
  3. C
  4. C PRIMARY OUTPUT ROUTINE
  5. C
  6.       INTEGER ID(4), K
  7. C
  8.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  9.       INCLUDE MATLAB$KOM:VSTK.KOM
  10.       INCLUDE MATLAB$KOM:ALFS.KOM
  11.       INCLUDE MATLAB$KOM:IOP.KOM
  12.       INCLUDE MATLAB$KOM:COM.KOM
  13. C
  14.       DOUBLE PRECISION S, TR, TI, PR(12), PI(12)
  15.       INTEGER FNO(11), FNL(11), SIG(12), PLUS, MINUS, BLANK, TYP, F
  16.       INTEGER I, J, J1, J2, JM, JINC, KS, L, LS, M, MN, N, LUNIT
  17. C
  18.       DOUBLE PRECISION ROUND
  19. C
  20.       DATA PLUS/41/, MINUS/42/, BLANK/36/
  21. C
  22. C     FORMAT NUMBERS AND LENGTHS
  23.       DATA FNO /11, 12, 21, 22, 23, 24, 31, 32, 33, 34, -1/
  24.       DATA FNL /12, 6, 8, 4, 6, 3, 4, 2, 3, 1, 1/
  25. C
  26. C FMT   1       2       3       4       5
  27. C     SHORT   LONG   SHORT E  LONG E    Z
  28. C TYP   1       2       3
  29. C     INTEGER  REAL   COMPLEX
  30. C
  31. C
  32.       IF (LCT(1).LT.0) GO TO 99
  33.       L = LSTK(K)
  34.       M = MSTK(K)
  35.       N = NSTK(K)
  36.       MN = M*N
  37.       TYP = 1
  38.       S = 0.0D0
  39.       DO 10 I = 1, MN
  40.         LS = L+I-1
  41.         TR = STKR(LS)
  42.         TI = STKI(LS)
  43.         S = DMAX1 (S, DABS (TR), DABS (TI))
  44.         IF (ROUND (TR).NE.TR) TYP = MAX0 (2, TYP)
  45.         IF (TI.NE.0.0D0) TYP = 3
  46. 10    CONTINUE
  47.       IF (S.NE.0.0D0) S = DLOG10 (S)
  48.       KS = IDINT (S)
  49.       IF (-2.LE.KS .AND. KS.LE.1) KS = 0
  50.       IF (KS.EQ.2 .AND. FMT.EQ.1 .AND. TYP.EQ.2) KS = 0
  51.       IF (TYP.EQ.1 .AND. KS.LE.2) F = 1
  52.       IF (TYP.EQ.1 .AND. KS.GT.2) F = 2
  53.       IF (TYP.EQ.1 .AND. KS.GT.9) TYP = 2
  54.       IF (TYP.EQ.2) F = FMT+2
  55.       IF (TYP.EQ.3) F = FMT+6
  56.       IF (MN.EQ.1 .AND. KS.NE.0 .AND. FMT.LT.3 .AND. TYP.NE.1) F = F+2
  57.       IF (FMT.EQ.5) F = 11
  58.       JINC = FNL(F)
  59.       F = FNO(F)
  60.       S = 1.0D0
  61.       IF (F.EQ.21 .OR. F.EQ.22 .OR. F.EQ.31 .OR. F.EQ.32) S = 10.0D0**KS
  62.       LS = ((N-1)/JINC+1)*M+2
  63.       IF (LCT(1)+LS.LE.LCT(2)) GO TO 20
  64.       LCT(1) = 0
  65.       WRITE (WTE, 43) LS
  66. 43    FORMAT (/, ' AT LEAST ', I5, ' MORE LINES.',
  67.      .          '  ENTER BLANK LINE TO CONTINUE OUTPUT.')
  68.       READ (RTE, 44, END = 19) LS
  69. 44    FORMAT (A1)
  70.       IF (LS.EQ.ALFA(BLANK+1)) GO TO 20
  71.       LCT(1) = -1
  72.       GO TO 99
  73. C
  74. 19    CONTINUE
  75.       CALL FILES (-1*RTE, BUF)
  76. 20    CONTINUE
  77.       WRITE (WTE, 44)
  78.       IF (WIO.NE.0) WRITE (WIO, 44)
  79.       CALL PRNTID (ID, -1)
  80.       LCT(1) = LCT(1)+2
  81.       LUNIT = WTE
  82. 50    CONTINUE
  83.       IF (S.NE.1.0D0) WRITE (LUNIT, 41) S
  84. 41    FORMAT (/, 2X, 1PD9.1, ' *')
  85.       DO 80 J1 = 1, N, JINC
  86.         J2 = MIN0 (N, J1+JINC-1)
  87.         WRITE (LUNIT, 44)
  88.         IF (N.GT.JINC) WRITE (LUNIT, 42) J1, J2
  89. 42      FORMAT ('     COLUMNS', I3, ' THRU', I3)
  90.         DO 70 I = 1, M
  91.           JM = J2-J1+1
  92.           DO 60 J = 1, JM
  93.             LS = L+I-1+(J+J1-2)*M
  94.             PR(J) = STKR(LS)/S
  95.             PI(J) = DABS (STKI(LS)/S)
  96.             SIG(J) = ALFA(PLUS+1)
  97.             IF (STKI(LS).LT.0.0D0) SIG(J) = ALFA(MINUS+1)
  98. 60        CONTINUE
  99.           IF (F.EQ.11) WRITE (LUNIT, 11) (PR(J), J = 1, JM)
  100. 11        FORMAT (1X, 12F6.0)
  101.           IF (F.EQ.12) WRITE (LUNIT, 12) (PR(J), J = 1, JM)
  102. 12        FORMAT (1X, 6F12.0)
  103.           IF (F.EQ.21) WRITE (LUNIT, 21) (PR(J), J = 1, JM)
  104. 21        FORMAT (1X, F9.4, 7F10.4)
  105.           IF (F.EQ.22) WRITE (LUNIT, 22) (PR(J), J = 1, JM)
  106. 22        FORMAT (1X, F19.15, 3F20.15)
  107.           IF (F.EQ.23) WRITE (LUNIT, 23) (PR(J), J = 1, JM)
  108. 23        FORMAT (1X, 1P6D13.4)
  109.           IF (F.EQ.24) WRITE (LUNIT, 24) (PR(J), J = 1, JM)
  110. 24        FORMAT (1X, 1P3D24.15)
  111.           IF (F.EQ.31) WRITE (LUNIT, 31)
  112.      .                       (PR(J), SIG(J), PI(J), J = 1, JM)
  113. 31        FORMAT (1X, 4(F9.4, ' ', A1, F7.4, 'i'))
  114.           IF (F.EQ.32) WRITE (LUNIT, 32)
  115.      .                       (PR(J), SIG(J), PI(J), J = 1, JM)
  116. 32        FORMAT (1X, F19.15, A1, F18.15, 'i', F20.15, A1, F18.15, 'i')
  117.           IF (F.EQ.33) WRITE (LUNIT, 33)
  118.      .                       (PR(J), SIG(J), PI(J), J = 1, JM)
  119. 33        FORMAT (1X, 3(1PD13.4, ' ', A1, 1PD10.4, 'i'))
  120.           IF (F.EQ.34) WRITE (LUNIT, 34)
  121.      .                       (PR(J), SIG(J), PI(J), J = 1, JM)
  122. 34        FORMAT (1X, 1PD24.15, ' ', A1, 1PD21.15, 'i')
  123.           IF (F.EQ.-1) CALL FORMZ (LUNIT, STKR(LS), STKI(LS))
  124.           LCT(1) = LCT(1)+1
  125. 70      CONTINUE
  126. 80    CONTINUE
  127.       IF (LUNIT.EQ.WIO .OR. WIO.EQ.0) GO TO 99
  128.       LUNIT = WIO
  129.       GO TO 50
  130. C
  131. 99    CONTINUE
  132.       RETURN
  133.       END
  134.