Télécharger j3orie.eso

Retour à la liste

Numérotation des lignes :

  1. C J3ORIE SOURCE CHAT 05/01/13 00:47:14 5004
  2. SUBROUTINE J3ORIE(IMOD,XYC,DENS,NPTO,IORI,TOL,IRET)
  3. C----------------------------------------------------
  4. C ORINTATION DANS IORI SI IMOD=0
  5. C ORIENTATION SUIVANT IORI SI IMOD=1
  6. C
  7. C PP 6/97,11/98
  8. C Pierre Pegon/JRC Ispra
  9. C----------------------------------------------------
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. DIMENSION XYC(2,NPTO),DENS(NPTO),XY(2)
  15. C
  16. C ON CHERCHE UN POINT A L'INTERIEUR DU CONTOURS
  17. C
  18. IF (NPTO.EQ.3)THEN
  19. XY(1)=(XYC(1,1)+XYC(1,2)+XYC(1,3))/3
  20. XY(2)=(XYC(2,1)+XYC(2,2)+XYC(2,3))/3
  21. CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  22. GOTO 1
  23. ENDIF
  24. C
  25. DO IE1=1,NPTO
  26. I1=IE1-1+(1/IE1)*NPTO
  27. I2=IE1+1-(IE1/NPTO)*IE1
  28. XL1=SQRT((XYC(1,I1)-XYC(1,IE1))**2+(XYC(2,I1)-XYC(2,IE1))**2)
  29. XL2=SQRT((XYC(1,I2)-XYC(1,IE1))**2+(XYC(2,I2)-XYC(2,IE1))**2)
  30. DDD=((XYC(1,I1)-XYC(1,IE1))*(XYC(2,I2)-XYC(2,IE1))
  31. > -(XYC(1,I2)-XYC(1,IE1))*(XYC(2,I1)-XYC(2,IE1)))/XL1/XL2
  32. IF(ABS(DDD).GT.10*TOL)THEN
  33. DO IE2=1,2
  34. XY(IE2)=(XYC(IE2,I1)+XYC(IE2,I2))/2
  35. ENDDO
  36. CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  37. IF(ICOD.EQ.-1)GOTO 1
  38. ENDIF
  39. ENDDO
  40. IRET=IRET+1
  41. WRITE(IOIMP,*)'J3ORIE: PAS DE POINT A L"INTERIEUR DU CONTOURS'
  42. RETURN
  43. C
  44. 1 CONTINUE
  45. C
  46. IF(IMOD.EQ.0)THEN
  47. IORI=ISIGM
  48. RETURN
  49. ENDIF
  50. C
  51. C SI L'ORIENTATION EST NEGATIVE, ON LA CHANGE
  52. C
  53. IF(ISIGM.NE.IORI)THEN
  54. DO IE1=1,NPTO/2
  55. I1=NPTO+1-IE1
  56. DO IE2=1,2
  57. XY(IE2)=XYC(IE2,IE1)
  58. ENDDO
  59. DENS1=DENS(IE1)
  60. DO IE2=1,2
  61. XYC(IE2,IE1)=XYC(IE2,I1)
  62. ENDDO
  63. DENS(IE1)=DENS(I1)
  64. DO IE2=1,2
  65. XYC(IE2,I1)=XY(IE2)
  66. ENDDO
  67. DENS(I1)=DENS1
  68. ENDDO
  69. ENDIF
  70. C
  71. RETURN
  72. END
  73.  
  74.  
  75.  

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