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 CCOPTIO
  13. DIMENSION XYC(2,NPTO),DENS(NPTO),XY(2)
  14. C
  15. C ON CHERCHE UN POINT A L'INTERIEUR DU CONTOURS
  16. C
  17. IF (NPTO.EQ.3)THEN
  18. XY(1)=(XYC(1,1)+XYC(1,2)+XYC(1,3))/3
  19. XY(2)=(XYC(2,1)+XYC(2,2)+XYC(2,3))/3
  20. CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  21. GOTO 1
  22. ENDIF
  23. C
  24. DO IE1=1,NPTO
  25. I1=IE1-1+(1/IE1)*NPTO
  26. I2=IE1+1-(IE1/NPTO)*IE1
  27. XL1=SQRT((XYC(1,I1)-XYC(1,IE1))**2+(XYC(2,I1)-XYC(2,IE1))**2)
  28. XL2=SQRT((XYC(1,I2)-XYC(1,IE1))**2+(XYC(2,I2)-XYC(2,IE1))**2)
  29. DDD=((XYC(1,I1)-XYC(1,IE1))*(XYC(2,I2)-XYC(2,IE1))
  30. > -(XYC(1,I2)-XYC(1,IE1))*(XYC(2,I1)-XYC(2,IE1)))/XL1/XL2
  31. IF(ABS(DDD).GT.10*TOL)THEN
  32. DO IE2=1,2
  33. XY(IE2)=(XYC(IE2,I1)+XYC(IE2,I2))/2
  34. ENDDO
  35. CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  36. IF(ICOD.EQ.-1)GOTO 1
  37. ENDIF
  38. ENDDO
  39. IRET=IRET+1
  40. WRITE(IOIMP,*)'J3ORIE: PAS DE POINT A L"INTERIEUR DU CONTOURS'
  41. RETURN
  42. C
  43. 1 CONTINUE
  44. C
  45. IF(IMOD.EQ.0)THEN
  46. IORI=ISIGM
  47. RETURN
  48. ENDIF
  49. C
  50. C SI L'ORIENTATION EST NEGATIVE, ON LA CHANGE
  51. C
  52. IF(ISIGM.NE.IORI)THEN
  53. DO IE1=1,NPTO/2
  54. I1=NPTO+1-IE1
  55. DO IE2=1,2
  56. XY(IE2)=XYC(IE2,IE1)
  57. ENDDO
  58. DENS1=DENS(IE1)
  59. DO IE2=1,2
  60. XYC(IE2,IE1)=XYC(IE2,I1)
  61. ENDDO
  62. DENS(IE1)=DENS(I1)
  63. DO IE2=1,2
  64. XYC(IE2,I1)=XY(IE2)
  65. ENDDO
  66. DENS(I1)=DENS1
  67. ENDDO
  68. ENDIF
  69. C
  70. RETURN
  71. END
  72.  
  73.  
  74.  

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