Download g2orie.eso

Back to the list

   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)
  68 : C      CALL DIFFVE(COORD((N2-1)*IDIMC+1),
  69 : C     >            COORD((N1-1)*IDIMC+1),IDIMC,VI)
  70 :       DO 730 JG=1,IDIMC
  71 :  730  VI(JG)=COORD((N2-1)*IDIMC+JG)-COORD((N1-1)*IDIMC+JG)
  72 :       XNVI = XNORVE(VI,IDIMC)
  73 :       N2 = IGR1(NBCOL+1)
  73 : C      CALL DIFFVE(COORD((N2-1)*IDIMC+1),
  74 : C     >            COORD((N1-1)*IDIMC+1),IDIMC,VJ)
  75 :       DO 731 JG=1,IDIMC
  76 :   731 VJ(JG) = COORD((N2-1)*IDIMC+JG) - COORD((N1-1)*IDIMC+JG)
  77 :       XNVJ = XNORVE(VJ,IDIMC)
  77 :       CALL VECTVE(VI,VJ,IDIMC,VIJ)
  78 :       V=0.D0
  79 :       DO 700 JG=1,IDIMC
  80 :   700 V=V+VIJ(JG)*VK(JG)      
  81 : C      V = SCALVE(VIJ,VK,IDIMC)
  82 : C      EPSI = XNVJ * XNVI * ZERO
  83 :       EPSI = MAX(XNVJ * XNVI * XYZEPS,XPETIT)
  84 :       IF( V.LT.-EPSI )THEN
  85 :        IOP = -1
  86 :       ELSE
  87 :       IF( V.GT.EPSI )THEN
  88 :         IOP = 1
  89 :       ELSE
  90 :         IOP = 0
  90 :         CALL DSERRE(1,-1,'G2ORIE',' VECTEURS COPLANAIRES')        
  91 :       ENDIF
  92 :       ENDIF
  93 : C
  94 :  9999 END
  95 :  
  96 :  
  97 :  
  98 :  

© Cast3M 2003 - All rights reserved.
Disclaimer