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