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