Télécharger la plaquette Cast3M


fr en

Télécharger intlre.eso

Retour à la liste

Numérotation des lignes : 

intlre

  1. C INTLRE    SOURCE    PASCAL    21/07/15    21:15:05     11076          
  2.       SUBROUTINE INTLRE(IPROG1,IPROG2)
  3. C----------------------------------------------------------------------C
  4. C    INTERSECTION DEUX LISTREEL
  5. C
  6. C    SYNTAXE : voir notice
  7. C
  8. C    ENTREES :
  9. C      - IPROG1 : LISTREEL 1
  10. C      - IPROG2 : LISTREEL 2
  11.  
  12. C    SORTIE : le resultat est renvoye dans la pile.
  13. C
  14. C----------------------------------------------------------------------C
  15.  
  16.       IMPLICIT INTEGER(I-N)
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC CCREEL 
  21. -INC SMLREEL
  22.  
  23.       SEGMENT ILU1(LL1)
  24.  
  25. C Activation de l'objet :
  26.       MLREE1 = IPROG1
  27.       MLREE2 = IPROG2
  28.       CALL ACTOBJ('LISTREEL',MLREE1,1)
  29.       CALL ACTOBJ('LISTREEL',MLREE2,1)
  30.  
  31. C---- CAS LISTREEL VIDE EN ARGUMENT ----C
  32.  
  33.       JG1 = MLREE1.PROG(/1)
  34.       IF (JG1.EQ.0) THEN
  35.         CALL ECROBJ('LISTREEL',MLREE1)
  36.         RETURN
  37.       ENDIF
  38.  
  39.       JG2 = MLREE2.PROG(/1)
  40.       IF (JG2.EQ.0) THEN
  41.         CALL ECROBJ('LISTREEL',MLREE2)
  42.         RETURN
  43.       ENDIF
  44.  
  45. C---- CAS GENERAL ----C
  46.  
  47. C     On met la liste la + longue en 2e
  48.       IF (JG1.GT.JG2) THEN
  49.         JG  = JG2
  50.         JG2 = JG1
  51.         JG1 = JG
  52.         MLREEL = MLREE2
  53.         MLREE2 = MLREE1
  54.         MLREE1 = MLREEL
  55.       ENDIF
  56.  
  57. C     Initialisation du segment resultat 
  58.       JG = MIN(JG1,JG2)
  59.       SEGINI, MLREEL
  60.  
  61. C     Inidicateur elts 2e liste lus
  62.       LL1 = JG2
  63.       SEGINI, ILU1
  64.  
  65.       JG = 0
  66.       DO 100 I1=1,JG1
  67.         INUL1 = 0 
  68.         XVAL1 = MLREE1.PROG(I1)
  69.         IF (ABS(XVAL1).LT.XPETIT) INUL1 = 1
  70.         DO 110 J2=1,JG2
  71.           IF (ILU1(J2).EQ.1) GOTO 110
  72.           INUL2 = 0
  73.           XVAL2 = MLREE2.PROG(J2)
  74.           IF (ABS(XVAL2).LT.XPETIT) INUL2 = 1
  75.           IF (INUL1.EQ.INUL2) THEN
  76.             IF (INUL1.EQ.1) THEN
  77.               JG = JG + 1
  78.               MLREEL.PROG(JG) = 0.D0
  79.               ILU1(J2) = 1
  80.               GOTO 100
  81.             ELSE
  82.               IF (A_EGALE_B(XVAL1,XVAL2)) THEN
  83.                 JG = JG + 1
  84.                 MLREEL.PROG(JG) = XVAL1
  85.                 ILU1(J2) = 1
  86.                 GOTO 100
  87.               ENDIF
  88.             ENDIF
  89.           ENDIF
  90.  110    CONTINUE
  91.  100  CONTINUE
  92.       SEGADJ,MLREEL
  93.  
  94. C Ecriture resultat dans la pile :
  95.       CALL ECROBJ('LISTREEL',MLREEL)
  96.  
  97.       RETURN
  98.       END
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  

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