Télécharger la plaquette Cast3M


fr en

Télécharger elimin5.eso

Retour à la liste

Numérotation des lignes : 

elimin5

  1. C ELIMIN5   SOURCE    SP204843  26/07/30    21:15:06     12612          
  2. ************************************************************************
  3. * NOM         : ELIMIN5
  4. * DESCRIPTION : Supprime les doublons dans un LISTOBJE
  5. ************************************************************************
  6. * SYNTAXE (GIBIANE) : voir notice !
  7. ************************************************************************
  8.  
  9.       SUBROUTINE ELIMIN5(IPLOBJ,ICRIT,RCRIT)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC SMLOBJE
  15. -INC SMLENTI
  16. -INC SMLREEL
  17.  
  18.       MLOBJ1 = IPLOBJ
  19.       SEGINI, MLOBJE = MLOBJ1
  20.  
  21.  
  22.  
  23. *---- Cas d'un LISTOBJE de flottants :
  24.  
  25.       IF (MLOBJ1.TYPOBJ.EQ.'FLOTTANT') THEN
  26.  
  27. *       Conversion en LISTREEL
  28.  
  29.         JG = MLOBJ1.RLIREE(/1)
  30.         SEGINI, MLREEL
  31.         DO 10 I=1,JG
  32.           PROG(I) = MLOBJ1.RLIREE(I)
  33.  10     CONTINUE
  34.  
  35. *       Appel a ELIMI3
  36.  
  37.         IPLREE = MLREEL
  38.         CALL ELIMIN3(IPLREE,ICRIT,RCRIT)
  39.  
  40. *       Copie du resultat en LISTOBJE
  41.  
  42.         MLREEL = IPLREE
  43.         SEGACT, MLREEL
  44.         NOBJ = 0
  45.         NREE = PROG(/1)
  46.         IF (NREE.NE.JG) THEN
  47.           SEGADJ, MLOBJE
  48.           DO 11 I=1,NREE
  49.             RLIREE(I) = PROG(I)
  50.  11       CONTINUE
  51.         ELSE
  52.           SEGSUP, MLOBJE
  53.           MLOBJE = IPLOBJ
  54.         ENDIF
  55.         SEGSUP, MLREEL
  56.  
  57.  
  58.  
  59. *---- Cas general (ENTIERS ou poineturs) :
  60.  
  61.       ELSE
  62.  
  63. *     Conversion en LISTENTI
  64.  
  65.         JG = MLOBJ1.LISOBJ(/1)
  66.         SEGINI, MLENTI
  67.         DO 20 I=1,JG
  68.           LECT(I) = MLOBJ1.LISOBJ(I)
  69.  20     CONTINUE
  70.  
  71. *       Appel a ELIMI3
  72.  
  73.         IPLENT = MLENTI
  74.         CALL ELIMIN2(IPLENT)
  75.  
  76. *       Copie du resultat en LISTOBJE
  77.  
  78.         MLENTI = IPLENT
  79.         SEGACT, MLENTI
  80.         NOBJ = LECT(/1)
  81.         NREE = 0
  82.         IF (NOBJ.NE.JG) THEN
  83.           SEGADJ, MLOBJE
  84.           DO 21 I=1,NREE
  85.             LISOBJ(I) = LECT(I)
  86.  21       CONTINUE
  87.         ELSE
  88.           SEGSUP, MLOBJE
  89.           MLOBJE = IPLOBJ
  90.         ENDIF
  91.         SEGSUP, MLENTI
  92.  
  93.       ENDIF
  94.  
  95. *---- Sortie du resultat :
  96.  
  97.       IPLOBJ = MLOBJE
  98.       RETURN
  99.       END
  100.  
  101.  
  102.  
  103.  
  104.  

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