The TELEMAC-MASCARET system  trunk
verifs.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE verifs
3 ! *****************
4 !
5  &(ifabor,ikle,trav1,nptfr,numpb,nbpb)
6 !
7 !***********************************************************************
8 ! PROGICIEL : STBTEL V5.2 10/02/93 J.M. JANIN (LNH)
9 ! 25/02/99 P. LANG (SOGREAH)
10 !***********************************************************************
11 !
12 !brief REPERAGE DES POINTS APPARTENANT A PLUS DE TROIS
13 ! SEGMENTS FRONTIERES APRES ELIMINATION DES ELEMENTS SECS
14 !
15 !history S.E.BOURBAN (HRW)
16 !+ 21/03/2017
17 !+ V7P3
18 !+ Replacement of the DATA declarations by the PARAMETER associates
19 !
20 !-----------------------------------------------------------------------
21 ! ARGUMENTS
22 ! .________________.____.______________________________________________.
23 ! | NOM |MODE| ROLE |
24 ! |________________|____|______________________________________________|
25 ! | NBOR |<-- | TABLEAU DES POINTS DE BORD |
26 ! | IFABOR | -->| TABLEAU DES VOISINS DES FACES. |
27 ! | IKLE | -->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT |
28 ! | TRAV1 |<-->| TABLEAU DE TRAVAIL |
29 ! | NPTFR |<-- | NOMBRE DE POINTS DE BORD |
30 ! | X,Y |--> | COORDONNEES DES POINTS DU MAILLAGE |
31 ! | NUMPB |<-- | NUMEROS DES POINTS POSANT PROBLEME |
32 ! | NBPB |<-- | NOMBRE DE POINTS POSANT PROBLEME |
33 ! |________________|____|______________________________________________
34 ! | COMMON: | |
35 ! | GEO: | |
36 ! | MESH | -->| TYPE DES ELEMENTS DU MAILLAGE
37 ! | NDP | -->| NOMBRE DE NOEUDS PAR ELEMENTS
38 ! | NPOIN | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
39 ! | NELEM | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
40 ! | NPMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
41 ! | | | (NPMAX = NPOIN + 0.1*NELEM)
42 ! | NELMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
43 ! | | | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
44 ! |________________|____|______________________________________________|
45 ! MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
46 !-----------------------------------------------------------------------
47 ! APPELE PAR : STBTEL
48 ! APPEL DE : -
49 !***********************************************************************
50 !
53  IMPLICIT NONE
54 !
55  INTEGER, INTENT(IN) :: IFABOR(nelmax,*) , IKLE(nelmax,4)
56  INTEGER, INTENT(INOUT) :: TRAV1(npoin,2)
57  INTEGER, INTENT(INOUT) :: NPTFR
58  INTEGER, INTENT(INOUT) :: NUMPB(100), NBPB
59 !
60  INTEGER I, J
61  INTEGER ISUIV , IELEM , IFACE
62  INTEGER I1 , I2
63  LOGICAL EXIST
64 !
65 ! DATA SOMSUI / 2 , 3 , 4 , 0 /
66  INTEGER :: SOMSUI(4) = (/ 2 , 3 , 4 , 0 /)
67 !
68 !=======================================================================
69 ! INITIALISATION
70 !=======================================================================
71 !
72  WRITE(lu,1020)
73  nbpb = 0
74  somsui(ndp) = 1
75  IF (mesh.NE.2.AND.mesh.NE.3) THEN
76  WRITE(lu,4000) mesh
77 4000 FORMAT(/,1x,'RANBO : MESH NOT ALLOWED , MESH = ',i4,/)
78  CALL plante(1)
79  stop
80  ENDIF
81 !
82 !=======================================================================
83 ! RECHERCHE DES ARETES DE BORD,NUMEROTEES DE 1 A NPTFR
84 !=======================================================================
85 !
86  nptfr = 0
87  DO ielem=1,nelem
88  DO iface=1,ndp
89  IF (ifabor(ielem,iface).LE.0) THEN
90  nptfr = nptfr + 1
91  trav1(nptfr,1) = ikle(ielem, iface )
92  trav1(nptfr,2) = ikle(ielem,somsui(iface))
93  ENDIF
94  ENDDO
95  ENDDO
96 !
97 !=======================================================================
98 ! ON VERIFIE QUE CHAQUE POINT N'APPARAIT QUE DEUX FOIS
99 ! ( UNE FOIS COMME NOEUD 1 , UNE FOIS COMME NOEUD 2 )
100 !=======================================================================
101 !
102  DO i=1,nptfr
103  i1 = 1
104  i2 = 1
105  DO isuiv=1,nptfr
106  IF (trav1(i,1).EQ.trav1(isuiv,2)) i1 = i1 + 1
107  IF (trav1(i,2).EQ.trav1(isuiv,1)) i2 = i2 + 1
108  ENDDO
109  IF (i1.NE.2) THEN
110  IF (nbpb.EQ.0) THEN
111  nbpb = 1
112  numpb(nbpb) = trav1(i,1)
113  ELSE
114  exist = .false.
115  DO j=1,nbpb
116  IF (numpb(j).EQ.trav1(i,1)) exist = .true.
117  ENDDO
118  IF (.NOT.exist) THEN
119  nbpb = nbpb + 1
120  IF (nbpb.GT.100) THEN
121  WRITE(lu,9001)
122  CALL plante(1)
123  stop
124  ENDIF
125  numpb(nbpb) = trav1(i,1)
126  ENDIF
127  ENDIF
128  ENDIF
129  IF (i2.NE.2) THEN
130  IF (nbpb.EQ.0) THEN
131  nbpb = 1
132  numpb(nbpb) = trav1(i,2)
133  ELSE
134  exist = .false.
135  DO j=1,nbpb
136  IF (numpb(j).EQ.trav1(i,2)) exist = .true.
137  ENDDO
138  IF (.NOT.exist) THEN
139  nbpb = nbpb + 1
140  IF (nbpb.GT.100) THEN
141  WRITE(lu,9001)
142  CALL plante(1)
143  stop
144  ENDIF
145  numpb(nbpb) = trav1(i,2)
146  ENDIF
147  ENDIF
148  ENDIF
149  ENDDO
150 !
151  RETURN
152 !
153 ! -------------------------FORMATS------------------------------------------
154  1020 FORMAT (//,1x,'SEARCHING ABOUT CONNECTED ISLANDS',/,
155  & 1x,'---------------------------------')
156  9001 FORMAT (1x,'*****************************************',/,
157  & 1x,'ERROR - ROUTINE VERIFS',/,
158  & 1x,'NB OF CONNECTION POINTS GREATHER THAN 100',/,
159  & 1x,'*****************************************')
160 !
161  END
subroutine verifs(IFABOR, IKLE, TRAV1, NPTFR, NUMPB, NBPB)
Definition: verifs.f:7