The TELEMAC-MASCARET system  trunk
circul.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE circul
3 ! *****************
4 !
5  &(ikle,itest1 ,ielem,i1,i2,i3,x,y,nnelmax)
6 !
7 !***********************************************************************
8 ! STBTEL VERSION 5.2 16/08/89 J.C. GALLAND (LNH)
9 !***********************************************************************
10 !
11 ! FONCTION : CALCUL DE L'AIRE FORMEE PAR LES TROIS POINTS I1,I2,I3
12 ! ET PERMUTATION DES POINTS I2 ET I3 LORSQU'ELLE EST
13 ! NEGATIVE.
14 !
15 !-----------------------------------------------------------------------
16 ! ARGUMENTS
17 ! .________________.____.______________________________________________.
18 ! | NOM |MODE| ROLE |
19 ! |________________|____|______________________________________________|
20 ! | IKLE |<-->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT |
21 ! | ITEST1 | -->| COMPTEUR |
22 ! | IELEM | -->| NUMERO DE L'ELEMENT COURANT |
23 ! | I1,I2,I3 | -->| PERMUTATION DES IKLE |
24 ! | X,Y | -->| COORDONNEES DES POINTS DU MAILLAGE |
25 ! |________________|____|______________________________________________
26 ! | COMMON: | |
27 ! | GEO: | |
28 ! | NDP | -->| NOMBRE DE NOEUDS PAR ELEMENTS
29 ! | NPOIN | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
30 ! | NELEM | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
31 ! | NPMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
32 ! | | | (NPMAX = NPOIN + 0.1*NELEM)
33 ! | NNELMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
34 ! | | | LES ELEMENTS (NNELMAX = NELEM + 0.2*NELEM)
35 ! |________________|____|______________________________________________|
36 ! MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
37 !-----------------------------------------------------------------------
38 ! APPELE PAR : LECSTB
39 ! APPEL DE :
40 !***********************************************************************
41 !
44  IMPLICIT NONE
45 !
46  INTEGER, INTENT(IN) :: NNELMAX
47  INTEGER, INTENT(IN) :: IELEM
48  INTEGER, INTENT(INOUT) :: IKLE(nnelmax,4)
49  INTEGER, INTENT(IN) :: I1 , I2 , I3
50  INTEGER, INTENT(INOUT) :: ITEST1
51  DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*)
52 
53  INTEGER I
54 !
55  DOUBLE PRECISION X2 , X3 , Y2 , Y3
56  DOUBLE PRECISION AIRE
57 !
58 !
59  x2 = x(ikle(ielem,i2))-x(ikle(ielem,i1))
60  x3 = x(ikle(ielem,i3))-x(ikle(ielem,i1))
61 !
62  y2 = y(ikle(ielem,i2))-y(ikle(ielem,i1))
63  y3 = y(ikle(ielem,i3))-y(ikle(ielem,i1))
64 !
65  aire = x2*y3 - x3*y2
66 !
67  IF (aire.LT.0.d0) THEN
68  itest1 = itest1 + 1
69  i = ikle(ielem,i2)
70 !
71  ikle(ielem,i2) = ikle(ielem,i3)
72  ikle(ielem,i3) = i
73  ENDIF
74 !
75  RETURN
76  END
subroutine circul(IKLE, ITEST1, IELEM, I1, I2, I3, X, Y, NNELMAX)
Definition: circul.f:7