Télécharger genrd1.eso

Retour à la liste

Numérotation des lignes :

  1. C GENRD1 SOURCE CHAT 05/01/13 00:17:37 5004
  2. SUBROUTINE GENRD1(FAC1,FAC2,NUM2,NPTO,TOL2,IRET)
  3. C--------------------------------------------------------------------
  4. C
  5. C ON ORDONNE FAC2 SUIVANT FAC1 EN FAISANT SUIVRE LES PERMUTATIONS
  6. C SUR NUM2
  7. C
  8. C PP 9/97
  9. C Pierre Pegon/JRC Ispra
  10. C--------------------------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13. C
  14. -INC CCOPTIO
  15. C
  16. DIMENSION FAC1(3,NPTO),FAC2(3,NPTO),NUM2(NPTO)
  17. C
  18. DO IE1=1,NPTO-1
  19. DO IE2=IE1,NPTO
  20. DIST=0.D0
  21. DO IE3=1,3
  22. DIST=DIST+(FAC1(IE3,IE1)-FAC2(IE3,IE2))**2
  23. ENDDO
  24. IF(DIST.LT.TOL2)GOTO 1
  25. ENDDO
  26. IRET=IRET+1
  27. WRITE(IOIMP,*)'GENRD1: Impossible de ce retrouver la!'
  28. GOTO 2
  29. 1 CONTINUE
  30. IF(IE2.NE.IE1)THEN
  31. DO IE3=1,3
  32. PDUM=FAC2(IE3,IE2)
  33. FAC2(IE3,IE2)=FAC2(IE3,IE1)
  34. FAC2(IE3,IE1)=PDUM
  35. ENDDO
  36. NDUM=NUM2(IE2)
  37. NUM2(IE2)=NUM2(IE1)
  38. NUM2(IE1)=NDUM
  39. ENDIF
  40. ENDDO
  41. C
  42. 2 CONTINUE
  43. RETURN
  44. END
  45.  
  46.  
  47.  

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