verifi.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE verifi
!                       *****************
!
     &(x,y,ikle,ncolor,trav1,epsi,mesh,ndp,npoin,nelem,nelmax)
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2         09/08/89    J-C GALLAND  (LNH)
!***********************************************************************
!
!     FONCTION  :  ELIMINATION DES TROUS DANS LA NUMEROTATION DES NOEUDS
!                  ET RE-ORIENTATION DES ELEMENTS DU MAILLAGE
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |   X,Y          |<-->| COORDONNEES DU MAILLAGE .
! |   IKLE         |<-->| NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
! |   NCOLOR       |<-->| TABLEAU DES COULEURS DES POINTS DU MAILLAGE
! |   TRAV1,2      |<-->| TABLEAUX DE TRAVAIL
! |   EPSI         | -->| DISTANCE MINIMALE ENTRE 2 NOEUDS DU MAILLAGE
! |________________|____|______________________________________________
! | 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 : REMAIL, CIRCUL
!***********************************************************************
!
      USE declarations_special
      USE interface_stbtel, ex_verifi => verifi
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) ::  MESH , NDP , NELMAX
      INTEGER, INTENT(INOUT) :: NPOIN, NELEM
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4) , NCOLOR(*)
      INTEGER, INTENT(INOUT) :: TRAV1(*)
!
      DOUBLE PRECISION, INTENT(INOUT) :: X(*) , Y(*)
      DOUBLE PRECISION, INTENT(INOUT) :: EPSI
!
      INTEGER ITEST , ITEST1 , IELEM
! COMMON
!
!
!=======================================================================
! ON VERIFIE QUE TOUS LES POINTS SONT DISTINCTS
!=======================================================================
!
      CALL remail (ikle,ncolor,trav1,x,y,epsi,
     &             ndp,npoin,nelem,nelmax)
!
!=======================================================================
! ON VERIFIE QUE TOUS LES ELEMENTS SONT CORRECTEMENT ORIENTES
!=======================================================================
!
      itest = 0
!
! CAS DES QUADRANGLES
!
      IF (mesh.EQ.2) THEN
!
        DO ielem=1,nelem
!
          itest1 = 0
          CALL circul (ikle,itest1,ielem,1,2,3,x,y,nelmax)
          CALL circul (ikle,itest1,ielem,2,3,4,x,y,nelmax)
          CALL circul (ikle,itest1,ielem,3,4,1,x,y,nelmax)
          CALL circul (ikle,itest1,ielem,4,1,2,x,y,nelmax)
          IF (itest1.GT.0) itest = itest + 1
!
        ENDDO
!
! CAS DES TRIANGLES
!
      ELSE IF (mesh.EQ.3) THEN
!
        DO ielem=1,nelem
!
          itest1 = 0
          CALL circul (ikle,itest1,ielem,1,2,3,x,y,nelmax)
          IF (itest1.GT.0) itest = itest + 1
!
        ENDDO
!
      ELSE
        WRITE(lu,3090) mesh
 3090   FORMAT(/,' LECSTB TYPE OF MESH NOT AVAILABLE , MESH = ',i4)
      ENDIF
!
      WRITE(lu,3100) itest
 3100 FORMAT(1x,'NUMBER OF ELEMENTS BADLY ORIENTED : ',i5)
!
      RETURN
      END