Télécharger la plaquette Cast3M


fr en

Télécharger ivout.eso

Retour à la liste

Numérotation des lignes : 

ivout

  1. C IVOUT     SOURCE    PV        22/04/21    21:15:05     11344          
  2. C-----------------------------------------------------------------------
  3. C  Routine:    IVOUT
  4. C
  5. C  Purpose:    Integer vector output routine.
  6. C
  7. C  Usage:      CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
  8. *  BP,2020     CALL IVOUT (      N, SX, IDIGIT, IFMT)
  9. *              LOUT --> IOIMP
  10. C
  11. C  Arguments
  12. C     N      - Length of array IX. (Input)
  13. C     IX     - Integer array to be printed. (Input)
  14. C     IFMT   - Format to be used in printing array IX. (Input)
  15. C     IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
  16. C              If IDIGIT .LT. 0, printing is done with 72 columns.
  17. C              If IDIGIT .GT. 0, printing is done with 132 columns.
  18. C
  19. C-----------------------------------------------------------------------
  20. C
  21. c       SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
  22.       SUBROUTINE IVOUT ( N, IX, IDIGIT, IFMT)
  23.  
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. C     ...
  28. C     ... SPECIFICATIONS FOR ARGUMENTS
  29.       INTEGER    IX   , N, IDIGIT
  30.       CHARACTER  IFMT*(*)
  31. C     ...
  32. C     ... SPECIFICATIONS FOR LOCAL VARIABLES
  33.       INTEGER    I, NDIGIT, K1, K2, LLL
  34.       CHARACTER*80 LINE
  35. *     ...
  36. *     ... SPECIFICATIONS INTRINSICS
  37. *      INTRINSIC          MIN
  38. *
  39. C
  40.       LLL = MIN ( LEN ( IFMT ), 80 )
  41.       DO 1 I = 1, LLL
  42.           LINE(I:I) = '-'
  43.     1 CONTINUE
  44. C
  45.       DO 2 I = LLL+1, 80
  46.           LINE(I:I) = ' '
  47.     2 CONTINUE
  48. C
  49.       WRITE ( IOIMP, 2000 ) IFMT, LINE(1:LLL)
  50.  2000 FORMAT ( /1X, A  /1X, A )
  51. C
  52.       IF (N .LE. 0) RETURN
  53.       NDIGIT = IDIGIT
  54.       IF (IDIGIT .EQ. 0) NDIGIT = 4
  55. C
  56. C=======================================================================
  57. C             CODE FOR OUTPUT USING 72 COLUMNS FORMAT
  58. C=======================================================================
  59. C
  60.       IF (IDIGIT .LT. 0) THEN
  61. C
  62.       NDIGIT = -IDIGIT
  63.       IF (NDIGIT .LE. 4) THEN
  64.          DO 10 K1 = 1, N, 10
  65.             K2 = MIN0(N,K1+9)
  66.             WRITE(IOIMP,1000) K1,K2,(IX   ,I=K1,K2)
  67.    10    CONTINUE
  68. C
  69.       ELSE IF (NDIGIT .LE. 6) THEN
  70.          DO 30 K1 = 1, N, 7
  71.             K2 = MIN0(N,K1+6)
  72.             WRITE(IOIMP,1001) K1,K2,(IX   ,I=K1,K2)
  73.    30    CONTINUE
  74. C
  75.       ELSE IF (NDIGIT .LE. 10) THEN
  76.          DO 50 K1 = 1, N, 5
  77.             K2 = MIN0(N,K1+4)
  78.             WRITE(IOIMP,1002) K1,K2,(IX   ,I=K1,K2)
  79.    50    CONTINUE
  80. C
  81.       ELSE
  82.          DO 70 K1 = 1, N, 3
  83.             K2 = MIN0(N,K1+2)
  84.             WRITE(IOIMP,1003) K1,K2,(IX   ,I=K1,K2)
  85.    70    CONTINUE
  86.       END IF
  87. C
  88. C=======================================================================
  89. C             CODE FOR OUTPUT USING 132 COLUMNS FORMAT
  90. C=======================================================================
  91. C
  92.       ELSE
  93. C
  94.       IF (NDIGIT .LE. 4) THEN
  95.          DO 90 K1 = 1, N, 20
  96.             K2 = MIN0(N,K1+19)
  97.             WRITE(IOIMP,1000) K1,K2,(IX   ,I=K1,K2)
  98.    90    CONTINUE
  99. C
  100.       ELSE IF (NDIGIT .LE. 6) THEN
  101.          DO 110 K1 = 1, N, 15
  102.             K2 = MIN0(N,K1+14)
  103.             WRITE(IOIMP,1001) K1,K2,(IX   ,I=K1,K2)
  104.   110    CONTINUE
  105. C
  106.       ELSE IF (NDIGIT .LE. 10) THEN
  107.          DO 130 K1 = 1, N, 10
  108.             K2 = MIN0(N,K1+9)
  109.             WRITE(IOIMP,1002) K1,K2,(IX   ,I=K1,K2)
  110.   130    CONTINUE
  111. C
  112.       ELSE
  113.          DO 150 K1 = 1, N, 7
  114.             K2 = MIN0(N,K1+6)
  115.             WRITE(IOIMP,1003) K1,K2,(IX   ,I=K1,K2)
  116.   150    CONTINUE
  117.       END IF
  118.       END IF
  119.       WRITE (IOIMP,1004)
  120. C
  121.  1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
  122.  1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
  123.  1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
  124.  1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
  125.  1004 FORMAT(1X,' ')
  126. C
  127.       RETURN
  128.       END
  129.  
  130.  
  131.  
  132.  
  133.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales