stoseg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\stoseg.f
00002 !
00069                      SUBROUTINE STOSEG
00070 !                    *****************
00071 !
00072      &(IFABOR,NELEM,NELMAX,NELMAX2,IELM,IKLE,NBOR,NPTFR,
00073      & GLOSEG,MAXSEG,ELTSEG,ORISEG,NSEG,NELBOR,NULONE,KNOLG,
00074      & IKLBOR,NELEBX,NELEB)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V7P0                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| ELTSEG         |<--| SEGMENTS OF EVERY TRIANGLE.
00087 !| GLOSEG         |<--| GLOBAL NUMBERS OF POINTS OF SEGMENTS.
00088 !| IELM           |-->| 11: TRIANGLES.
00089 !|                |   | 21: QUADRILATERALS.
00090 !| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
00091 !|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID
00092 !|                |   | BOUNDARY
00093 !| IKLE           |-->| CONNECTIVITY TABLE.
00094 !| KNOLG          |-->| GLOBAL NUMBER OF A LOCAL POINT IN PARALLEL
00095 !| MAXSEG         |<--| MAXIMUM NUMBER OF SEGMENTS
00096 !| NBOR           |-->| GLOBAL NUMBERS OF BOUNDARY POINTS.
00097 !| NELBOR         |-->| NUMBER OF ELEMENT CONTAINING SEGMENT K OF
00098 !|                |   | THE BOUNDARY.
00099 !| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
00100 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN 3D
00101 !| NELMAX2        |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
00102 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS.
00103 !| NSEG           |<--| NUMBER OF SEGMENTS OF THE MESH.
00104 !| NULONE         |-->| LOCAL NUMBER OF BOUNDARY POINTS IN A BOUNDARY
00105 !|                |   | ELEMENT.
00106 !| ORISEG         |<--| ORIENTATION OF SEGMENTS OF EVERY TRIANGLE.
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !
00109       USE BIEF, EX_STOSEG => STOSEG
00110 !
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       INTEGER, INTENT(IN)    :: NELMAX,NELMAX2,NPTFR,NSEG,MAXSEG,IELM
00118       INTEGER, INTENT(IN)    :: NELEM,NELEBX,NELEB
00119       INTEGER, INTENT(IN)    :: NBOR(NPTFR)
00120       INTEGER, INTENT(IN)    :: IFABOR(NELMAX2,*),IKLE(NELMAX,*)
00121       INTEGER, INTENT(IN)    :: NELBOR(NELEBX),NULONE(NELEBX)
00122       INTEGER, INTENT(IN)    :: IKLBOR(NELEBX,2)
00123       INTEGER, INTENT(INOUT) :: GLOSEG(MAXSEG,2)
00124       INTEGER, INTENT(INOUT) :: ELTSEG(NELMAX,*),ORISEG(NELMAX,3)
00125       INTEGER, INTENT(IN)    :: KNOLG(*)
00126 !
00127 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00128 !
00129       INTEGER IPTFR,NSE,IELEB
00130 !
00131       INTEGER NEL,IFA,I1,I2,J1,J2,IFACE,JFACE,IG1,IG2
00132       INTEGER IELEM,IELEM1,IELEM2
00133 !
00134       INTEGER NEXT(3)
00135       DATA NEXT / 2,3,1 /
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       IF(IELM.NE.11.AND.IELM.NE.12.AND.IELM.NE.13.AND.IELM.NE.14) THEN
00140         IF (LNG.EQ.1) WRITE(LU,500) IELM
00141         IF (LNG.EQ.2) WRITE(LU,501) IELM
00142 500     FORMAT(1X,'STOSEG (BIEF) : ELEMENT NON PREVU : ',1I6)
00143 501     FORMAT(1X,'STOSEG (BIEF) : UNEXPECTED ELEMENT: ',1I6)
00144         CALL PLANTE(1)
00145         STOP
00146       ENDIF
00147 !
00148 !     INITIALISES ELTSEG
00149 !
00150       DO IELEM = 1 , NELEM
00151         ELTSEG(IELEM,1) = 0
00152         ELTSEG(IELEM,2) = 0
00153         ELTSEG(IELEM,3) = 0
00154       ENDDO
00155 !
00156 !-----------------------------------------------------------------------
00157 !
00158 !     LOOP ON BOUNDARY POINTS :
00159 !
00160       DO IELEB = 1 , NELEB
00161 !
00162 !         NOTE: ON BOUNDARIES, SEGMENTS ARE NOT ORIENTED LOWER RANK
00163 !               TO HIGHER RANK, AS IS DONE FOR INTERNAL SEGMENTS
00164           GLOSEG(IELEB,1) = NBOR(IKLBOR(IELEB,1))
00165           GLOSEG(IELEB,2) = NBOR(IKLBOR(IELEB,2))
00166           NEL = NELBOR(IELEB)
00167           IFA = NULONE(IELEB)
00168           ELTSEG(NEL,IFA) = IELEB
00169           ORISEG(NEL,IFA) = 1
00170 !
00171       ENDDO
00172 !
00173       NSE=NELEB
00174 !
00175 !-----------------------------------------------------------------------
00176 !
00177 !     LOOP ON ELEMENTS FOR NUMBERING INTERNAL SEGMENTS AND FILLING:
00178 !     GLOSEG, ELTSEG, ORISEG
00179 !
00180       DO IELEM1 = 1 , NELEM
00181         DO IFACE = 1 , 3
00182           IF(ELTSEG(IELEM1,IFACE).EQ.0) THEN
00183 !           NEW SEGMENT (HENCE INTERNAL SO IFABOR<>0)
00184             NSE = NSE + 1
00185 !           BOTH NEIGHBOURING ELEMENTS ARE TREATED FOR THIS SEGMENT
00186             I1 = IKLE(IELEM1,     IFACE)
00187             I2 = IKLE(IELEM1,NEXT(IFACE))
00188             IF(I1.EQ.I2) THEN
00189               IF(LNG.EQ.1) THEN
00190                 WRITE(LU,*) 'STOSEG : SEGMENT AVEC UN SEUL POINT'
00191                 WRITE(LU,*) '         ELEMENT ',IELEM1,' FACE ',IFACE
00192               ENDIF
00193               IF(LNG.EQ.2) THEN
00194                 WRITE(LU,*) 'STOSEG: EDGE MADE OF ONLY ONE POINT'
00195                 WRITE(LU,*) '        ELEMENT ',IELEM1,' FACE ',IFACE
00196               ENDIF
00197               CALL PLANTE(1)
00198               STOP
00199             ENDIF
00200             ELTSEG(IELEM1,IFACE) = NSE
00201             IF(NCSIZE.GT.1) THEN
00202               IG1=KNOLG(I1)
00203               IG2=KNOLG(I2)
00204             ELSE
00205               IG1=I1
00206               IG2=I2
00207             ENDIF
00208 !           SEGMENT ORIENTED LOWER RANK TO HIGHER RANK
00209             IF(IG1.LT.IG2) THEN
00210               GLOSEG(NSE,1) = I1
00211               GLOSEG(NSE,2) = I2
00212               ORISEG(IELEM1,IFACE) = 1
00213             ELSE
00214               GLOSEG(NSE,1) = I2
00215               GLOSEG(NSE,2) = I1
00216               ORISEG(IELEM1,IFACE) = 2
00217             ENDIF
00218 !           OTHER ELEMENT NEIGHBOURING THIS SEGMENT
00219             IELEM2 = IFABOR(IELEM1,IFACE)
00220 !           IELEM2 = 0 OR -1 MAY OCCUR IN PARALLEL MODE
00221             IF(IELEM2.GT.0) THEN
00222 !             LOOKS FOR THE RIGHT SIDE OF ELEMENT IELEM2
00223               DO JFACE = 1,3
00224                 J1 = IKLE(IELEM2,     JFACE)
00225                 J2 = IKLE(IELEM2,NEXT(JFACE))
00226 !               ALL ELEMENTS HAVE A COUNTER-CLOCKWISE NUMBERING
00227                 IF(I1.EQ.J2.AND.I2.EQ.J1) THEN
00228                   ELTSEG(IELEM2,JFACE) = NSE
00229                   ORISEG(IELEM2,JFACE) = 3-ORISEG(IELEM1,IFACE)
00230 !                 SIDE FOUND, NO NEED TO GO ON
00231                   GO TO 1000
00232                 ELSEIF(I1.EQ.J1.AND.I2.EQ.J2) THEN
00233 !                 SIDE BADLY ORIENTED
00234                   IF(LNG.EQ.1) THEN
00235                     WRITE(LU,*) 'STOSEG : MAILLAGE DEFECTUEUX'
00236                     WRITE(LU,*) '         LA FACE ',JFACE
00237                     WRITE(LU,*) '         DE L''ELEMENT ',IELEM2
00238                     WRITE(LU,*) '         EST MAL ORIENTEE'
00239                     WRITE(LU,*) '         (POINTS ',I1,' ET ',I2,')'
00240                   ENDIF
00241                   IF(LNG.EQ.2) THEN
00242                     WRITE(LU,*) 'STOSEG: WRONG MESH'
00243                     WRITE(LU,*) '        FACE ',JFACE
00244                     WRITE(LU,*) '        OF ELEMENT ',IELEM2
00245                     WRITE(LU,*) '        IS NOT WELL ORIENTED'
00246                     WRITE(LU,*) '         (POINTS ',I1,' AND ',I2,')'
00247                   ENDIF
00248                   CALL PLANTE(1)
00249                   STOP
00250                 ENDIF
00251               ENDDO
00252 !             SIDE NOT FOUND, THIS IS AN ERROR
00253               IF(LNG.EQ.1) THEN
00254                 WRITE(LU,*) 'STOSEG : MAILLAGE DEFECTUEUX'
00255                 WRITE(LU,*) '         ELEMENTS ',IELEM1,' ET ',IELEM2
00256                 WRITE(LU,*) '         LIES PAR LES POINTS ',I1,' ET ',I2
00257                 WRITE(LU,*) '         MAIS CES POINTS NE FONT PAS UNE'
00258                 WRITE(LU,*) '         FACE DE L''ELEMENT ',IELEM2
00259               ENDIF
00260               IF(LNG.EQ.2) THEN
00261                 WRITE(LU,*) 'STOSEG: WRONG MESH'
00262                 WRITE(LU,*) '        ELEMENTS ',IELEM1,' AND ',IELEM2
00263                 WRITE(LU,*) '        LINKED BY POINTS ',I1,' AND ',I2
00264                 WRITE(LU,*) '        BUT THESE POINTS ARE NOT AN EDGE'
00265                 WRITE(LU,*) '        OF ELEMENT ',IELEM2
00266               ENDIF
00267               CALL PLANTE(1)
00268               STOP
00269             ENDIF
00270 1000        CONTINUE
00271           ENDIF
00272         ENDDO
00273       ENDDO
00274 !
00275 !-----------------------------------------------------------------------
00276 !
00277 !     CHECKS
00278 !
00279       IF(NSEG.NE.NSE) THEN
00280         IF (LNG.EQ.1) WRITE(LU,502) NSE,NSEG
00281         IF (LNG.EQ.2) WRITE(LU,503) NSE,NSEG
00282 502     FORMAT(1X,'STOSEG (BIEF) : MAUVAIS NOMBRE DE SEGMENTS : ',1I6,
00283      &            '                AU LIEU DE ',1I6,' ATTENDUS')
00284 503     FORMAT(1X,'STOSEG (BIEF): WRONG NUMBER OF SEGMENTS : ',1I6,
00285      &            '               INSTEAD OF ',1I6,' EXPECTED')
00286         CALL PLANTE(1)
00287         STOP
00288       ENDIF
00289 !
00290 !-----------------------------------------------------------------------
00291 !
00292       RETURN
00293       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0