Télécharger genrd2.eso

Retour à la liste

Numérotation des lignes :

  1. C GENRD2 SOURCE CHAT 05/01/13 00:17:40 5004
  2. SUBROUTINE GENRD2(FAC1,BAR1,NUM1,BAR2,NUM2,NPTO,TOL)
  3. C--------------------------------------------------------------------
  4. C
  5. C ON NUMEROTE CORRECTEMENT LES NOEUDS POUR ORIENTER LE JOINT
  6. C SUIVANT BAR1-BAR2
  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),NUM1(NPTO),NUM2(NPTO)
  17. DIMENSION BAR1(3),BAR2(3)
  18. DIMENSION XNORM(3),YNORM(3)
  19. C
  20. XXORM=0.D0
  21. DO IE1=1,3
  22. XNORM(IE1)=BAR1(IE1)-BAR2(IE1)
  23. ENDDO
  24. C
  25. YNORM(1)=(FAC1(2,2)-FAC1(2,1))*(FAC1(3,NPTO)-FAC1(3,1))
  26. > -(FAC1(3,2)-FAC1(3,1))*(FAC1(2,NPTO)-FAC1(2,1))
  27. YNORM(2)=(FAC1(3,2)-FAC1(3,1))*(FAC1(1,NPTO)-FAC1(1,1))
  28. > -(FAC1(1,2)-FAC1(1,1))*(FAC1(3,NPTO)-FAC1(3,1))
  29. YNORM(3)=(FAC1(1,2)-FAC1(1,1))*(FAC1(2,NPTO)-FAC1(2,1))
  30. > -(FAC1(2,2)-FAC1(2,1))*(FAC1(1,NPTO)-FAC1(1,1))
  31. C
  32. PSCAL=XNORM(1)*YNORM(1)+XNORM(2)*YNORM(2)+XNORM(3)*YNORM(3)
  33. C
  34. IF(PSCAL.LT.0.D0)THEN
  35. DO IE1=1,NPTO/2
  36. JE1=NPTO+1-IE1
  37. IDUM=NUM1(IE1)
  38. NUM1(IE1)=NUM1(JE1)
  39. NUM1(JE1)=IDUM
  40. IDUM=NUM2(IE1)
  41. NUM2(IE1)=NUM2(JE1)
  42. NUM2(JE1)=IDUM
  43. ENDDO
  44. ENDIF
  45. C
  46. C ON VERIFIE S'IL N'Y-A-PAS DE DOUBLON
  47. C
  48. IDOUB=0
  49. DO IE1=1,NPTO
  50. IF(NUM1(IE1).EQ.NUM2(IE1))THEN
  51. IDOUB=IDOUB+1
  52. WRITE(IOIMP,*)
  53. >'GENRD2: il y a ',IDOUB,' doublon(s) dans un joint-->',NUM1(IE1)
  54. ENDIF
  55. ENDDO
  56. C
  57. RETURN
  58. END
  59.  
  60.  
  61.  

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