Télécharger ivout.eso

Retour à la liste

Numérotation des lignes :

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

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