Télécharger la plaquette Cast3M


fr en

Télécharger g2orie.eso

Retour à la liste

Numérotation des lignes : 

g2orie

  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