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

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