verifs.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE verifs
!                       *****************
!
     &(ifabor,ikle,trav1,nptfr,numpb,nbpb)
!
!***********************************************************************
!  PROGICIEL : STBTEL V5.2        10/02/93    J.M. JANIN   (LNH)
!                                 25/02/99    P. LANG      (SOGREAH)
!***********************************************************************
!
!brief    REPERAGE DES POINTS APPARTENANT A PLUS DE TROIS
!               SEGMENTS FRONTIERES APRES ELIMINATION DES ELEMENTS SECS
!
!history  S.E.BOURBAN (HRW)
!+        21/03/2017
!+        V7P3
!+   Replacement of the DATA declarations by the PARAMETER associates
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________.
! |      NOM       |MODE|                   ROLE                       |
! |________________|____|______________________________________________|
! |    NBOR        |<-- | TABLEAU DES POINTS DE BORD                   |
! |    IFABOR      | -->| TABLEAU DES VOISINS DES FACES.               |
! |    IKLE        | -->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT |
! |    TRAV1       |<-->| TABLEAU DE TRAVAIL                           |
! |    NPTFR       |<-- | NOMBRE DE POINTS DE BORD                     |
! |    X,Y         |--> | COORDONNEES DES POINTS DU MAILLAGE           |
! |    NUMPB       |<-- | NUMEROS DES POINTS POSANT PROBLEME           |
! |    NBPB        |<-- | NOMBRE DE POINTS POSANT PROBLEME             |
! |________________|____|______________________________________________
! | COMMON:        |    |
! |  GEO:          |    |
! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |________________|____|______________________________________________|
!  MODE: -->(DONNEE NON MODIFIEE),<--(RESULTAT),<-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
! APPELE PAR : STBTEL
! APPEL DE : -
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: IFABOR(nelmax,*) , IKLE(nelmax,4)
      INTEGER, INTENT(INOUT) :: TRAV1(npoin,2)
      INTEGER, INTENT(INOUT) :: NPTFR
      INTEGER, INTENT(INOUT) :: NUMPB(100), NBPB
!
      INTEGER I, J
      INTEGER ISUIV , IELEM , IFACE
      INTEGER I1 , I2
      LOGICAL EXIST
!
!      DATA SOMSUI / 2 , 3 , 4 , 0 /
      INTEGER :: SOMSUI(4) = (/ 2 , 3 , 4 , 0 /)
!
!=======================================================================
! INITIALISATION
!=======================================================================
!
      WRITE(lu,1020)
      nbpb = 0
      somsui(ndp) = 1
      IF (mesh.NE.2.AND.mesh.NE.3) THEN
        WRITE(lu,4000) mesh
4000    FORMAT(/,1x,'RANBO : MESH NOT ALLOWED , MESH = ',i4,/)
        CALL plante(1)
        stop
      ENDIF
!
!=======================================================================
! RECHERCHE DES ARETES DE BORD,NUMEROTEES DE 1 A NPTFR
!=======================================================================
!
      nptfr = 0
      DO ielem=1,nelem
        DO iface=1,ndp
          IF (ifabor(ielem,iface).LE.0) THEN
            nptfr = nptfr + 1
            trav1(nptfr,1) = ikle(ielem,       iface )
            trav1(nptfr,2) = ikle(ielem,somsui(iface))
          ENDIF
        ENDDO
      ENDDO
!
!=======================================================================
! ON VERIFIE QUE CHAQUE POINT N'APPARAIT QUE DEUX FOIS
! ( UNE FOIS COMME NOEUD 1 , UNE FOIS COMME NOEUD 2 )
!=======================================================================
!
      DO i=1,nptfr
        i1 = 1
        i2 = 1
        DO isuiv=1,nptfr
          IF (trav1(i,1).EQ.trav1(isuiv,2)) i1 = i1 + 1
          IF (trav1(i,2).EQ.trav1(isuiv,1)) i2 = i2 + 1
        ENDDO
        IF (i1.NE.2) THEN
          IF (nbpb.EQ.0) THEN
            nbpb = 1
            numpb(nbpb) = trav1(i,1)
          ELSE
            exist = .false.
            DO j=1,nbpb
              IF (numpb(j).EQ.trav1(i,1)) exist = .true.
            ENDDO
            IF (.NOT.exist) THEN
              nbpb = nbpb + 1
              IF (nbpb.GT.100) THEN
                WRITE(lu,9001)
                CALL plante(1)
                stop
              ENDIF
              numpb(nbpb) = trav1(i,1)
            ENDIF
          ENDIF
        ENDIF
        IF (i2.NE.2) THEN
          IF (nbpb.EQ.0) THEN
            nbpb = 1
            numpb(nbpb) = trav1(i,2)
          ELSE
            exist = .false.
            DO j=1,nbpb
              IF (numpb(j).EQ.trav1(i,2)) exist = .true.
            ENDDO
            IF (.NOT.exist) THEN
              nbpb = nbpb + 1
              IF (nbpb.GT.100) THEN
                WRITE(lu,9001)
                CALL plante(1)
                stop
              ENDIF
              numpb(nbpb) = trav1(i,2)
            ENDIF
          ENDIF
        ENDIF
      ENDDO
!
      RETURN
!
! -------------------------FORMATS------------------------------------------
 1020 FORMAT (//,1x,'SEARCHING ABOUT CONNECTED ISLANDS',/,
     &          1x,'---------------------------------')
 9001 FORMAT (1x,'*****************************************',/,
     &        1x,'ERROR - ROUTINE VERIFS',/,
     &        1x,'NB OF CONNECTION POINTS GREATHER THAN 100',/,
     &        1x,'*****************************************')
!
      END