Télécharger ivout.eso

Retour à la liste

Numérotation des lignes :

  1. C IVOUT SOURCE BP208322 20/02/06 21:15:38 10512
  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. -INC CCOPTIO
  25. C ...
  26. C ... SPECIFICATIONS FOR ARGUMENTS
  27. INTEGER IX(*), N, IDIGIT
  28. CHARACTER IFMT*(*)
  29. C ...
  30. C ... SPECIFICATIONS FOR LOCAL VARIABLES
  31. INTEGER I, NDIGIT, K1, K2, LLL
  32. CHARACTER*80 LINE
  33. * ...
  34. * ... SPECIFICATIONS INTRINSICS
  35. * INTRINSIC MIN
  36. *
  37. C
  38. LLL = MIN ( LEN ( IFMT ), 80 )
  39. DO 1 I = 1, LLL
  40. LINE(I:I) = '-'
  41. 1 CONTINUE
  42. C
  43. DO 2 I = LLL+1, 80
  44. LINE(I:I) = ' '
  45. 2 CONTINUE
  46. C
  47. WRITE ( IOIMP, 2000 ) IFMT, LINE(1:LLL)
  48. 2000 FORMAT ( /1X, A /1X, A )
  49. C
  50. IF (N .LE. 0) RETURN
  51. NDIGIT = IDIGIT
  52. IF (IDIGIT .EQ. 0) NDIGIT = 4
  53. C
  54. C=======================================================================
  55. C CODE FOR OUTPUT USING 72 COLUMNS FORMAT
  56. C=======================================================================
  57. C
  58. IF (IDIGIT .LT. 0) THEN
  59. C
  60. NDIGIT = -IDIGIT
  61. IF (NDIGIT .LE. 4) THEN
  62. DO 10 K1 = 1, N, 10
  63. K2 = MIN0(N,K1+9)
  64. WRITE(IOIMP,1000) K1,K2,(IX(I),I=K1,K2)
  65. 10 CONTINUE
  66. C
  67. ELSE IF (NDIGIT .LE. 6) THEN
  68. DO 30 K1 = 1, N, 7
  69. K2 = MIN0(N,K1+6)
  70. WRITE(IOIMP,1001) K1,K2,(IX(I),I=K1,K2)
  71. 30 CONTINUE
  72. C
  73. ELSE IF (NDIGIT .LE. 10) THEN
  74. DO 50 K1 = 1, N, 5
  75. K2 = MIN0(N,K1+4)
  76. WRITE(IOIMP,1002) K1,K2,(IX(I),I=K1,K2)
  77. 50 CONTINUE
  78. C
  79. ELSE
  80. DO 70 K1 = 1, N, 3
  81. K2 = MIN0(N,K1+2)
  82. WRITE(IOIMP,1003) K1,K2,(IX(I),I=K1,K2)
  83. 70 CONTINUE
  84. END IF
  85. C
  86. C=======================================================================
  87. C CODE FOR OUTPUT USING 132 COLUMNS FORMAT
  88. C=======================================================================
  89. C
  90. ELSE
  91. C
  92. IF (NDIGIT .LE. 4) THEN
  93. DO 90 K1 = 1, N, 20
  94. K2 = MIN0(N,K1+19)
  95. WRITE(IOIMP,1000) K1,K2,(IX(I),I=K1,K2)
  96. 90 CONTINUE
  97. C
  98. ELSE IF (NDIGIT .LE. 6) THEN
  99. DO 110 K1 = 1, N, 15
  100. K2 = MIN0(N,K1+14)
  101. WRITE(IOIMP,1001) K1,K2,(IX(I),I=K1,K2)
  102. 110 CONTINUE
  103. C
  104. ELSE IF (NDIGIT .LE. 10) THEN
  105. DO 130 K1 = 1, N, 10
  106. K2 = MIN0(N,K1+9)
  107. WRITE(IOIMP,1002) K1,K2,(IX(I),I=K1,K2)
  108. 130 CONTINUE
  109. C
  110. ELSE
  111. DO 150 K1 = 1, N, 7
  112. K2 = MIN0(N,K1+6)
  113. WRITE(IOIMP,1003) K1,K2,(IX(I),I=K1,K2)
  114. 150 CONTINUE
  115. END IF
  116. END IF
  117. WRITE (IOIMP,1004)
  118. C
  119. 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
  120. 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
  121. 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
  122. 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
  123. 1004 FORMAT(1X,' ')
  124. C
  125. RETURN
  126. END
  127.  
  128.  
  129.  

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