Télécharger doubl4.eso

Retour à la liste

Numérotation des lignes :

  1. C DOUBL4 SOURCE MAUGIS 05/09/01 21:15:02 5152
  2. SUBROUTINE DOUBL4(NUM,NBNN,NBELEM,LECT,LECT1,LECT2)
  3. C----------------------------------------------------
  4. C
  5. C Esclave de DOUBL3 : detection des occurences multiples d'elements
  6. C
  7. C Variables :
  8. C LECT : liste des sommes des numéros de noeuds pour chaque élément
  9. C classée par ordre croissant
  10. C LECT1 : liste (non croissante) des indices classant LECT par ordre croissant
  11. C LECT2 : liste des indices dans l'ordre original (croissant de 1 à N)
  12. C
  13. C Fortran pur
  14. C
  15. C----------------------------------------------------
  16. C
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19. C
  20. DIMENSION NUM(NBNN,NBELEM)
  21. DIMENSION LECT(NBELEM),LECT1(NBELEM),LECT2(NBELEM)
  22. LOGICAL GENTST
  23. C
  24. C On parcourt LECT et on compare chaque valeur à celle de l'indice précédent
  25. IFI=LECT(1)
  26. DO IE1=2,NBELEM
  27. IFF=LECT(IE1)
  28. IF(IFI.EQ.IFF)THEN
  29. C deux sommes identiques
  30. JE1=LECT1(IE1-1)
  31. IF(LECT2(JE1).EQ.JE1)THEN
  32. C dans le cas contraire, cet indice a déjà été traité
  33. C et fait l'objet d'une interversion dans LECT2
  34.  
  35. DO IE2=IE1,NBELEM
  36. C on parcourt toutes les valeurs semblables
  37. IFFF=LECT(IE2)
  38. IF(IFI.NE.IFFF)GOTO 1
  39. JE2=LECT1(IE2)
  40. IF(LECT2(JE2).EQ.JE2)THEN
  41. C dans le cas contraire, cet indice a déjà été traité
  42. C et fait l'objet d'une interversion dans LECT2
  43. IF(GENTST(NUM(1,JE1),NUM(1,JE2),NBNN))THEN
  44. C les deux éléments sont semblables.
  45. C On intervertit leurs indices dans LECT2
  46. C PM LECT2(JE1)=JE2
  47. C PM LECT2(JE2)=JE1
  48. JSAV=LECT2(JE1)
  49. LECT2(JE1)=LECT2(JE2)
  50. LECT2(JE2)=JSAV
  51. ENDIF
  52. ENDIF
  53. ENDDO
  54.  
  55. ENDIF
  56. ENDIF
  57. 1 IFI=IFF
  58. ENDDO
  59. C
  60. RETURN
  61. END
  62.  
  63.  

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