Télécharger la plaquette Cast3M


fr en

Télécharger karset.eso

Retour à la liste

Numérotation des lignes : 

karset

  1. C KARSET    SOURCE    CB215821  17/11/30    21:16:37     9639           
  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)=MIN(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)=MIN(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)=MIN(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.  
  170.  

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