Télécharger elimin3.eso

Retour à la liste

Numérotation des lignes :

  1. C ELIMIN3 SOURCE FANDEUR 13/01/02 21:15:04 7653
  2.  
  3. ************************************************************************
  4. * NOM : ELIMIN3
  5. * DESCRIPTION : Supprime les doublons dans un LISTREEL
  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. * LREELS = UNIQ LREELE (FLOT1) ;
  16. ************************************************************************
  17.  
  18. SUBROUTINE ELIMIN3(IPLREE,ICRIT,RCRIT)
  19.  
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC SMLREEL
  24.  
  25. MLREE1 = IPLREE
  26. SEGINI,MLREEL=MLREE1
  27.  
  28. NN = PROG(/1)
  29.  
  30. c Recherche des doublons (a la precision pres)
  31. IF (NN.GT.1) THEN
  32. JG = 1
  33. IF (ICRIT.EQ.0) THEN
  34. DO 10 I = 2, NN
  35. R_ZI = PROG(I)
  36. R_ZA = ABS(R_ZI)
  37. DO J = 1, JG
  38. R_ZJ = PROG(J)
  39. XCRIT = RCRIT * MAX(R_ZA, ABS(R_ZJ))
  40. IF (ABS(R_ZI-R_ZJ).LT.XCRIT) GOTO 10
  41. ENDDO
  42. JG = JG + 1
  43. PROG(JG) = R_ZI
  44. 10 CONTINUE
  45. ELSE
  46. DO 11 I = 2, NN
  47. R_ZI = PROG(I)
  48. DO J = 1, JG
  49. IF (ABS(R_ZI-PROG(J)).LT.RCRIT) GOTO 11
  50. ENDDO
  51. JG = JG + 1
  52. PROG(JG) = R_ZI
  53. 11 CONTINUE
  54. ENDIF
  55. IF (JG.NE.NN) SEGADJ,MLREEL
  56. ENDIF
  57.  
  58. SEGDES,MLREEL
  59. IPLREE = MLREEL
  60.  
  61. RETURN
  62. END
  63.  
  64.  
  65.  

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