C VCONMO    SOURCE    CHAT      11/03/16    21:33:25     6902           
      SUBROUTINE VCONMO(IPMODL,IRET)
C_______________________________________________________________________
C
C     V(ERIFICATION DU MODELE POUR LES) CON(NECTIVITES DU) MO(DEL)
C
C     -- LE MODELE A UN SEUL CONSTITUENT
C     -- LE MODELE EST GEOMETRIQUEMENT SIMPLE
C
C    Entrees:
C    ________
C
C     IPMODL Pointeur sur un objet MMODEL
C
C    Sorties:
C    ________
C
C     IRET   1 ou 0 suivant OK ou non
C
C    Appele par CONNEC
C    ----------
C
C    Appel a  MADJAC test l'adjacence de 2 maillage (CLB)
C    --------
C
C     P.PEGON 26/10/92
C_______________________________________________________________________
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      LOGICAL LOG1
C
-INC SMMODEL
-INC CCOPTIO
-INC SMELEME
-INC SMLENTI
-INC SMCOORD
      CHARACTER*(LCONMO) CONSTI
C
C     ACTIVATION DU MODELE
C
      MMODEL=IPMODL
      SEGACT,MMODEL
      NSOUS=KMODEL(/1)
C
C     SI NSOUS=1 TOUT EST PARFAIT ET ON SORT
C
      IRET=1
      IF(NSOUS.EQ.1)GOTO 11
C
C     SINON ....
C     ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE
C
      DO 1 ISOUS=1,NSOUS
        IMODEL=KMODEL(ISOUS)
        SEGACT,IMODEL
        MELEME=IMAMOD
        SEGACT,MELEME
 1    CONTINUE
C
C     VOYONS LE CONSTITUANT
C
      IMODEL=KMODEL(1)
      CONSTI=CONMOD
      DO 2 ISOUS=2,NSOUS
        IMODEL=KMODEL(ISOUS)
        IF(CONMOD.NE.CONSTI)THEN
          IRET=0
          CALL ERREUR(732)
          GOTO 9
        ENDIF
 2    CONTINUE
C
C     VOYONS L'ADJACENCE
C
      JG=NSOUS
      SEGINI,MLENTI
      DO 3 ISOUS=1,NSOUS
        IMODEL=KMODEL(ISOUS)
        LECT(ISOUS)=IMAMOD
 3    CONTINUE
C
C     ON SELECTIONE LA PREMIERE ZONE ET L'ON BOUCLE
C     EN VERIFIANT QUE UNE DES ZONES NON ENCORE SELECTIONNEES
C     EST ADJACENTE A L'UNE DES ZONES DEJA SELECTIONNEES
C
      DO 7 ISOUS=2,NSOUS
        DO 5 JSOUS=ISOUS,NSOUS
          DO 4 KSOUS=1,ISOUS-1
C
C            WARNING !!!! ON NE PEUT PAS ECRIRE
C            CALL MADJAC(LECT(JSOUS),LECT(KSOUS),LOG1)
C            CAR MADJAC RESTE UNE ROUTINE ESOPE
C
            MEL1=LECT(JSOUS)
            MEL2=LECT(KSOUS)
            CALL MADJAC(MEL1,MEL2,LOG1)
            IF (LOG1) GOTO 6
 4        CONTINUE
 5      CONTINUE
        IRET=0
        CALL ERREUR(733)
        GOTO 8
 6      IDUM=LECT(ISOUS)
        LECT(ISOUS)=LECT(JSOUS)
        LECT(JSOUS)=IDUM
 7    CONTINUE
C
C     ON FERME
C
 8    SEGSUP,MLENTI
 9    DO 10 ISOUS=1,NSOUS
        IMODEL=KMODEL(ISOUS)
        MELEME=IMAMOD
        SEGDES,MELEME,IMODEL
 10   CONTINUE
 11   SEGDES MMODEL
C
      RETURN
      END