Télécharger g2orie.eso

Retour à la liste

Numérotation des lignes :

  1. C G2ORIE SOURCE CHAT 05/01/13 00:14:52 5004
  2. CC **********************************************************************
  3. C FICHIER : GR2D_GEOM.F
  4. C
  5. C GESTION DES GRILLES GEOMETRIQUES (INDICES + POINTS)
  6. C
  7. C OBJET :
  8. C ------ CREATION -------
  9. C OBJET G2LLG2 : CREER UNE GRILLE INTERMEDIAIRE (ENTRE 2 GRILLES)
  10. C
  11. C ------ MODIFICATION ---
  12. C OBJET G2ORAC : REORIENTE UNE GRILLE GEOMETRIQUE
  13. C OBJET G2POLC : AJOUTE LIGNES ET COLONNES A UNE GRILLE GEOMETRIQUE
  14. C
  15. C ------ INFORMATIONS ---
  16. C OBJET G2ORIE : CALCULE L'ORIENTATION D'UNE GRILLE GEOMETRIQUE
  17. C
  18. C AUTEUR : O. STAB
  19. C DATE : 08.96
  20. C MODIFICATIONS :
  21. C AUTEUR, DATE, OBJET :
  22. C
  23. C
  24. C **********************************************************************
  25. C
  26. C
  27. C
  28. SUBROUTINE G2ORIE(IGR1,NBCOL,NBLIG,IDIMC,COORD,VK,IOP )
  29. C **********************************************************************
  30. C OBJET G2ORIE : CALCULE L'ORIENTATION D'UNE GRILLE GEOMETRIQUE
  31. C
  32. C EN ENTREE :
  33. C IGR1(NBCOL,NBLIG) : TABLEAU D'INDICES DES NOEUDS (LA GRILLE)
  34. C IDIMC : DIMENSION DE L'ESPACE (=3)
  35. C COORD : TABLEAU DES COORDONNEES DES NOEUDS
  36. C
  37. C VK : DIRECTION SOUHAITEE AU NOEUD (1,1)
  38. C
  39. C EN SORTIE :
  40. C IOP : ORIENTATION DE LA GRILLE PAR RAPPORT AU TRIEDRE,
  41. C POUR QUE (IGR1(1,I),IGR(J,1),VK) SOIT DIRECT
  42. C 1 = MEME ORIENTATION
  43. C -1 = ORIENTATION INVERSE
  44. C 0 = ERREUR DE COPLANARITE
  45. C
  46. C
  47. C **********************************************************************
  48. IMPLICIT INTEGER(I-N)
  49. -INC CCREEL
  50. INTEGER IGR1(*),NBCOL,NBLIG,IDIMC
  51. REAL*8 COORD(*),VK(*),XYZEPS
  52. INTEGER IOP
  53. C
  54. REAL*8 VI(3),VJ(3),XNVI,XNVJ,VIJ(3),V
  55. REAL*8 EPSI,ZERO
  56. INTEGER N1,N2
  57. EXTERNAL XNORVE
  58. REAL*8 XNORVE
  59. C
  60. C COMMON /CGEPSI/ XYZHUG,XYZMIN,XYZEPS
  61. C REAL*8 XYZHUG,XYZMIN,XYZEPS
  62. C
  63. C --- CALCUL DE L'ORIENTATION EN (1,1) ---
  64. C
  65. XYZEPS=1.D-10
  66. ZERO = 1.E-5
  67. N1 = IGR1(1)
  68. N2 = IGR1(2)
  69. C CALL DIFFVE(COORD((N2-1)*IDIMC+1),
  70. C > COORD((N1-1)*IDIMC+1),IDIMC,VI)
  71. DO 730 JG=1,IDIMC
  72. 730 VI(JG)=COORD((N2-1)*IDIMC+JG)-COORD((N1-1)*IDIMC+JG)
  73. XNVI = XNORVE(VI,IDIMC)
  74. N2 = IGR1(NBCOL+1)
  75. C CALL DIFFVE(COORD((N2-1)*IDIMC+1),
  76. C > COORD((N1-1)*IDIMC+1),IDIMC,VJ)
  77. DO 731 JG=1,IDIMC
  78. 731 VJ(JG) = COORD((N2-1)*IDIMC+JG) - COORD((N1-1)*IDIMC+JG)
  79. XNVJ = XNORVE(VJ,IDIMC)
  80. CALL VECTVE(VI,VJ,IDIMC,VIJ)
  81. V=0.D0
  82. DO 700 JG=1,IDIMC
  83. 700 V=V+VIJ(JG)*VK(JG)
  84. C V = SCALVE(VIJ,VK,IDIMC)
  85. C EPSI = XNVJ * XNVI * ZERO
  86. EPSI = MAX(XNVJ * XNVI * XYZEPS,XPETIT)
  87. IF( V.LT.-EPSI )THEN
  88. IOP = -1
  89. ELSE
  90. IF( V.GT.EPSI )THEN
  91. IOP = 1
  92. ELSE
  93. IOP = 0
  94. CALL DSERRE(1,-1,'G2ORIE',' VECTEURS COPLANAIRES')
  95. ENDIF
  96. ENDIF
  97. C
  98. 9999 END
  99.  
  100.  
  101.  
  102.  
  103.  

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