Sources Esope | Cast3M

g2kkm2
C G2KKM2    SOURCE    CHAT      06/03/29    21:21:45     5360
C
C     **********************************************************************
C     FICHIER  : GR2D_INTERFACE.F
C
C           RECONNAISSANCE D'UN MAILLAGE DE TYPE GRILLE
C           INTERFACE MAILLAGE ET GRILLE
C
C     OBJET    :
C
C     OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D
C     OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS
C     OBJET G2ORQ4 : CREATION D'UNE GRILLE ORIENTE A PARTIR D'UN MAILLAGE
C     OBJET Q4ORG2 : TRANSFORME 2 MAILLAGES Q4 EN 2 GRILLES COMPATIBLES
C
C     AUTEUR   : O. STAB
C     DATE     : 06.96
C     MODIFICATIONS :
C        AUTEUR, DATE, OBJET :
C
C
C     **********************************************************************
C
C
      SUBROUTINE G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
     >                   NN,IEK,ICK,NKK,NKKMAX,iarr)
C     **********************************************************************
C     OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D
C
C     EN ENTREE   :
C         ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D
C         NKKMAX       : NOMBRE MAXIMUM DE COINS
C
C     EN SORTIE   :
C         NN   : NOMBRE DE NOEUDS ENTRE 2 COINS
C                (IEK,ICK)(I) --- NN(I) --- (IEK,ICK)(I+1)
C         (IEK,ICK)  : INDICE DES COINS = ITRNOE((IEK-1)*NBNMAX+ICK)
C
C         NKK  : NOMBRE DE COINS
C         iarr    : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES
C
C     REMARQUE : FONCTIONNE SUR DES MAILLAGE MIXTES
C
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE
      INTEGER NN(*),IEK(*),ICK(*),NKK,NKKMAX,iarr
C
      INTEGER  I,IE,IC,NBC,J,IES,ICS,IDEB
      INTEGER  STRNBN
      EXTERNAL STRNBN
C
C     ---------  INITIALISATION ------------------
      DO 10 I=1,NKKMAX
        NN(I)  = 0
        IEK(I) = 0
        ICK(I) = 0
   10 CONTINUE
      NKK = 0
C
C     --------- 1. RECHERCHE D'UN ELEMENT DE LA FRONTIERE --------
      IE = 0
   20 IE = IE + 1
      IF(IE.GT.NBE)THEN
         iarr = -1
         CALL DSERRE(1,iarr,' G2KKM2 ',
     >   ' ON NE TROUVE PAS DE FRONTIERE SUR LES NBE ELEMENTS ')
         GOTO 9999
      ENDIF
      NBC = STRNBN(IE,ITRNOE,NBNMAX)
      IC = 0
      DO 30 J=1,NBC
       IF(ITRTRI((IE-1)*NBCMAX+J).EQ.0)IC = J
   30 CONTINUE
      IF( IC.EQ.0 )GOTO 20
C
C     --------- 2. PARCOURS DE LA FRONTIERE -------
C
      IDEB = IE
C     --- 1. UN ELEMENT AVEC UNE ARETE FRONTIERE ---
C         ON PASSE A L'ARETE SUIVANTE PUIS SUR L'ELEMENT
C
  100 NBC = STRNBN(IE,ITRNOE,NBNMAX)
      IC  = MOD(IC,NBC) + 1
      CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS)
      IF(NKK.NE.0)NN(NKK) = NN(NKK) + 1
C
C     --- UN COIN TOPOLOGIQUE ---
      IF( IES.EQ.0 )THEN
C     --- ON RETROUVE LE PREMIER COIN ---
C        IF( IKK(1).EQ.ITRNOE((IE-1)*NBNMAX+IC))GOTO 9999
        IF( ITRNOE((IEK(1)-1)*NBNMAX+ICK(1)).EQ.
     >      ITRNOE((IE-1)*NBNMAX+IC) )GOTO 9999
        NKK = NKK + 1
        IEK(NKK) = IE
        ICK(NKK) = IC
C        IKK(NKK) = ITRNOE((IE-1)*NBNMAX+IC)
        NN(NKK)  = 1
        ICS = IC
C       ICS = MOD(IC,NBCMAX) + 1
        IES = IE
      ELSE
C     --- ON PASSE SUR L'ARETE DE FRONTIERE ---
      ICS = MOD(ICS,NBCMAX) + 1
      ENDIF
C
      IF(ITRTRI((IES-1)*NBCMAX+ICS).NE.0)THEN
         iarr = -1
         CALL DSERRE(1,iarr,' G2KKM2 ',
     >   ' ON A PERDU LA FRONTIERE ')
         GOTO 9999
      ENDIF
      IE = IES
      IC = ICS
C     --- IL N'Y A PAS DE COIN : POUR EVITER LES BOUCLES ---
      IF((IE.EQ.IDEB).AND.(NKK.EQ.0))GOTO 9999
C
      GOTO 100
C
 9999 END