Télécharger j3iden.eso

Retour à la liste

Numérotation des lignes :

  1. C J3IDEN SOURCE CHAT 05/01/13 00:46:47 5004
  2. SUBROUTINE J3IDEN(WORK1,WORK2,TOL)
  3. C----------------------------------------------------
  4. C ON REGARDE SI DEUX FACES SONT IDENTIQUES MAIS PAS
  5. C DANS LE MEME ORDRE
  6. C SI OUI ON FAIT WORK1=WORK2
  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. -INC PPARAM
  14. -INC CCOPTIO
  15. DIMENSION BAR1(2),BAR2(2)
  16. C
  17. SEGMENT WORK
  18. REAL*8 XYC(2,NPTO)
  19. INTEGER IST(3,NPTO)
  20. REAL*8 DENS(NPTO)
  21. INTEGER JUN
  22. ENDSEGMENT
  23. POINTEUR WORK1.WORK,WORK2.WORK
  24. C
  25. NPTO1=WORK1.DENS(/1)
  26. NPTO2=WORK2.DENS(/1)
  27. IF(NPTO1.NE.NPTO2)RETURN
  28. C
  29. DO IE1=1,2
  30. BAR1(IE1)=0.D0
  31. BAR2(IE1)=0.D0
  32. ENDDO
  33. DO IE1=1,NPTO1
  34. DO IE2=1,2
  35. BAR1(IE2)=BAR1(IE2)+WORK1.XYC(IE2,IE1)
  36. BAR2(IE2)=BAR2(IE2)+WORK2.XYC(IE2,IE1)
  37. ENDDO
  38. ENDDO
  39. DIS12=SQRT((BAR2(1)-BAR1(1))**2+(BAR2(1)-BAR1(1))**2)
  40. IF(DIS12.GT.TOL)RETURN
  41. C
  42. DO IE1=1,NPTO1
  43. DIS12=SQRT((WORK1.XYC(1,1)-WORK2.XYC(1,IE1))**2
  44. > +(WORK1.XYC(2,1)-WORK2.XYC(2,IE1))**2)
  45. IF(DIS12.LT.TOL)GOTO 1
  46. ENDDO
  47. RETURN
  48. C
  49. 1 CONTINUE
  50. JE1=IE1-1
  51. DO IE1=1,NPTO1
  52. JE1=JE1+1
  53. IF(JE1.GT.NPTO1)JE1=1
  54. DIS12=SQRT((WORK1.XYC(1,IE1)-WORK2.XYC(1,JE1))**2
  55. > +(WORK1.XYC(2,IE1)-WORK2.XYC(2,JE1))**2)
  56. IF(DIS12.GT.TOL)RETURN
  57. ENDDO
  58. C
  59. SEGSUP,WORK1
  60. SEGINI,WORK1=WORK2
  61. WORK1.JUN=0
  62. RETURN
  63. END
  64.  
  65.  
  66.  

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