Télécharger la plaquette Cast3M


fr en

Télécharger elimin2.eso

Retour à la liste

Numérotation des lignes : 

elimin2

  1. C ELIMIN2   SOURCE    SP204843  23/07/17    21:15:03     11710          
  2.  
  3. ************************************************************************
  4. * NOM         : ELIMIN2
  5. * DESCRIPTION : Supprime les doublons dans un LISTENTI
  6. ************************************************************************
  7. * HISTORIQUE : 22/05/2012 : JCARDO : Creation de la subroutine
  8. * HISTORIQUE : 21/12/2012 : OF : adaptation a UNIQue
  9. ************************************************************************
  10. * Priere de PRENDRE LE TEMPS DE COMPLETER LES COMMENTAIRES
  11. * en cas de modification de ce sous-programme afin de faciliter
  12. * la maintenance !
  13. ************************************************************************
  14. * SYNTAXE (GIBIANE)
  15. *        LENTIS = UNIQ LENTIE ;
  16. ************************************************************************
  17.  
  18.       SUBROUTINE ELIMIN2(IPLENT)
  19.  
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC SMLENTI
  24.  
  25.       MLENT1 = IPLENT
  26.       SEGINI,MLENTI=MLENT1
  27.  
  28.       NN = LECT(/1)
  29.  
  30. c Recherche des doublons
  31.       IF (NN.GT.1) THEN
  32.         JG = 1
  33.         DO 10 I = 2, NN
  34.           I_Z  = LECT(I)
  35.           DO J = 1, JG
  36.             IF (I_Z.EQ.LECT(J)) GOTO 10
  37.           ENDDO
  38.           JG = JG + 1
  39.           LECT(JG) = I_Z
  40.  10     CONTINUE
  41.         IF (JG.NE.NN) SEGADJ,MLENTI
  42.       ENDIF
  43.       IF (JG.EQ.NN) THEN
  44.         SEGSUP,MLENTI
  45.       ELSE
  46.         SEGDES,MLENTI
  47.         IPLENT = MLENTI
  48.       ENDIF
  49.  
  50.       RETURN
  51.       END
  52.  
  53.  
  54.  
  55.  

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