Télécharger karset.eso

Retour à la liste

Numérotation des lignes :

  1. C KARSET SOURCE CHAT 05/01/13 00:51:39 5004
  2. SUBROUTINE KARSET(A,B,N,NM,X,Y,KVU)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*********************************************************************
  6. C SP appele par KAINTE
  7. C
  8. C - MISE A JOUR DES INTERVALLES D INTEGRATION
  9. C A : A(1,I),A(2,I) I=1,N INTERVALLES D INTEGRATION
  10. C B : TABLEAU DE SAUVEGARDE DE A
  11. C X Y : SEGMENT A ENLEVER X<Y
  12. C KVU : 0 SI L INTERVALLE EST VIDE
  13. C*********************************************************************
  14. DIMENSION A(2,NM),B(2,NM)
  15.  
  16. AM=A(1,N+1)
  17. KVU=1
  18. DO 1 I=1,N
  19. B(1,I)=A(1,I)
  20. B(2,I)=A(2,I)
  21. 1 CONTINUE
  22.  
  23.  
  24. C1>
  25. IF(X.LT.B(2,N).AND.Y.GT.B(1,1)) THEN
  26.  
  27. C11>
  28. IF(X.LE.B(1,1)) THEN
  29. IF(Y.GE.B(2,N)) THEN
  30. KVU=0
  31. ELSE
  32. C**
  33. C recherche de j
  34. IF (Y.GT.B(1,N)) THEN
  35. J=N
  36. ELSEIF(N.NE.1) THEN
  37. DO 200 J=1,N-1
  38. IF(Y.GT.B(1,J).AND.Y.LE.B(1,J+1)) GOTO 201
  39. 200 CONTINUE
  40. 201 CONTINUE
  41. ENDIF
  42.  
  43.  
  44. C13>
  45. IF(Y.GT.B(2,J)) THEN
  46. NI=J
  47. IF(J+1.LE.N) THEN
  48. DO 22 K=J+1,N
  49. A(1,K-NI)=B(1,K)
  50. A(2,K-NI)=B(2,K)
  51. 22 CONTINUE
  52. ENDIF
  53. N=N-NI
  54. C13-
  55. ELSE
  56. A(1,1)= Y
  57. A(2,1)= B(2,J)
  58. NI=J-1
  59. IF(J+1.LE.N) THEN
  60. DO 23 K=J+1,N
  61. A(1,K-NI)=B(1,K)
  62. A(2,K-NI)=B(2,K)
  63. 23 CONTINUE
  64. ENDIF
  65. N=N-NI
  66.  
  67. ENDIF
  68. C13<
  69. ENDIF
  70. C11-
  71. ELSE
  72. C2>
  73. IF(N.EQ.1) THEN
  74. C** N=1
  75.  
  76. IF(Y.LT.B(2,N)) THEN
  77. N=2
  78. A(2,1)=X
  79. A(1,2)=Y
  80. A(2,2)=B(2,1)
  81. ELSE
  82. A(2,1)=X
  83. ENDIF
  84.  
  85.  
  86. C2- N::1
  87.  
  88. ELSE
  89. C recherche de i
  90. IF (X.GT.B(1,N)) THEN
  91. I=N
  92. ELSEIF(N.NE.1) THEN
  93. DO 300 I=1,N-1
  94. IF(X.GT.B(1,I).AND.X.LE.B(1,I+1)) GOTO 301
  95. 300 CONTINUE
  96. 301 CONTINUE
  97. ENDIF
  98. C3>
  99. IF(Y.LT.B(2,I)) THEN
  100. C** I=J
  101. A(2,I)=X
  102. A(1,I+1)=Y
  103. A(2,I+1)=B(2,I)
  104. IF(I+1.LE.N) THEN
  105. DO 11 K=I+1,N
  106. A(1,K+1)=B(1,K)
  107. A(2,K+1)=B(2,K)
  108. 11 CONTINUE
  109. ENDIF
  110. N=N+1
  111. C3-
  112. ELSEIF(Y.LT.B(1,I+1)) THEN
  113. A(2,I)=DMIN1(X,B(2,I))
  114. C3-
  115. ELSE
  116. C** J::I
  117. C recherche de j
  118. IF (Y.GT.B(1,N)) THEN
  119. J=N
  120. ELSEIF(N.NE.1) THEN
  121. DO 400 J=I+1,N-1
  122. IF(Y.GT.B(1,J).AND.Y.LE.B(1,J+1)) GOTO 401
  123. 400 CONTINUE
  124. 401 CONTINUE
  125. ENDIF
  126.  
  127. C4>
  128. IF(Y.LT.B(2,J)) THEN
  129.  
  130. A(2,I)=DMIN1(X,B(2,I))
  131. A(1,I+1)=Y
  132. A(2,I+1)=B(2,J)
  133. NI=J-I-1
  134. IF(J+1.LE.N) THEN
  135. DO 13 K=J+1,N
  136. A(1,K-NI)=B(1,K)
  137. A(2,K-NI)=B(2,K)
  138. 13 CONTINUE
  139. ENDIF
  140. N=N-NI
  141. C4-
  142. ELSE
  143. A(2,I)=DMIN1(X,B(2,I))
  144. NI=J-I
  145. IF(J+1.LE.N) THEN
  146. DO 12 K=J+1,N
  147. A(1,K-NI)=B(1,K)
  148. A(2,K-NI)=B(2,K)
  149. 12 CONTINUE
  150. ENDIF
  151. N=N-NI
  152.  
  153. ENDIF
  154. C4<
  155. ENDIF
  156. C3<
  157. ENDIF
  158. C2<
  159. ENDIF
  160. C11<
  161. ENDIF
  162. C1<
  163. A(1,N+1)=AM
  164.  
  165.  
  166. RETURN
  167. END
  168.  
  169.  

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