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 CCOPTIO
  14. DIMENSION BAR1(2),BAR2(2)
  15. C
  16. SEGMENT WORK
  17. REAL*8 XYC(2,NPTO)
  18. INTEGER IST(3,NPTO)
  19. REAL*8 DENS(NPTO)
  20. INTEGER JUN
  21. ENDSEGMENT
  22. POINTEUR WORK1.WORK,WORK2.WORK
  23. C
  24. NPTO1=WORK1.DENS(/1)
  25. NPTO2=WORK2.DENS(/1)
  26. IF(NPTO1.NE.NPTO2)RETURN
  27. C
  28. DO IE1=1,2
  29. BAR1(IE1)=0.D0
  30. BAR2(IE1)=0.D0
  31. ENDDO
  32. DO IE1=1,NPTO1
  33. DO IE2=1,2
  34. BAR1(IE2)=BAR1(IE2)+WORK1.XYC(IE2,IE1)
  35. BAR2(IE2)=BAR2(IE2)+WORK2.XYC(IE2,IE1)
  36. ENDDO
  37. ENDDO
  38. DIS12=SQRT((BAR2(1)-BAR1(1))**2+(BAR2(1)-BAR1(1))**2)
  39. IF(DIS12.GT.TOL)RETURN
  40. C
  41. DO IE1=1,NPTO1
  42. DIS12=SQRT((WORK1.XYC(1,1)-WORK2.XYC(1,IE1))**2
  43. > +(WORK1.XYC(2,1)-WORK2.XYC(2,IE1))**2)
  44. IF(DIS12.LT.TOL)GOTO 1
  45. ENDDO
  46. RETURN
  47. C
  48. 1 CONTINUE
  49. JE1=IE1-1
  50. DO IE1=1,NPTO1
  51. JE1=JE1+1
  52. IF(JE1.GT.NPTO1)JE1=1
  53. DIS12=SQRT((WORK1.XYC(1,IE1)-WORK2.XYC(1,JE1))**2
  54. > +(WORK1.XYC(2,IE1)-WORK2.XYC(2,JE1))**2)
  55. IF(DIS12.GT.TOL)RETURN
  56. ENDDO
  57. C
  58. SEGSUP,WORK1
  59. SEGINI,WORK1=WORK2
  60. WORK1.JUN=0
  61. RETURN
  62. END
  63.  
  64.  
  65.  

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