C EXIS      SOURCE    JC220346  12/09/17    21:15:00     7510           

      SUBROUTINE EXIS

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC CCOPTIO
-INC CCHAMP

-INC SMSOLUT
-INC SMLMOTS
-INC SMLENTI
-INC SMLREEL
-INC SMCHARG
-INC SMMODEL
-INC SMNUAGE

      SEGMENT LIMODE(0)

      PARAMETER (NBFORM=20)
      CHARACTER*4 CMOT
      CHARACTER*8 MOTYP,TYPOBJ,MOTYP1,MONU1
      CHARACTER*(LCONMO) MOFORM(NBFORM)
      CHARACTER*72 ICHAI,CHARRE
      LOGICAL IRET,IBOOL,LOGRE
*
      PARAMETER (LSOL = 1)
      CHARACTER*4 MOTSOL(LSOL)
      DATA MOTSOL/'CONT'/
*
      PARAMETER (NCLE=2)
      CHARACTER*2 LCLE(NCLE)
      DATA LCLE/'OU','ET'/
*
      ILE=1
      IOBJLU=0
      CALL LIROBJ('OBJET   ',MTABLE,0,IRETOU)
      IF(IRETOU.NE.0) THEN
          IOBJLU=1
      ELSE
          CALL LIROBJ('TABLE   ',MTABLE,0,IRETOU)
      ENDIF
      IF (IRETOU.NE.0) THEN
c
c  traitement special pour les tables
c
  4      CONTINUE
         CALL QUETYP(MOTYP,0,IRETOU)
         IF( IRETOU.NE.0) THEN
               IF(MOTYP.EQ.'ENTIER  ') THEN
                  CALL LIRENT(IVAL,1,IRETOU)
               ELSEIF(MOTYP.EQ.'MOT     ')THEN
                  CALL LIRCHA(ICHAI,1,ILE)
               ELSEIF(MOTYP.EQ.'LOGIQUE ') THEN
                  CALL LIRLOG(IBOOL,1,IRETOU)
               ELSEIF(MOTYP.EQ.'FLOTTANT') THEN
                   CALL LIRREE(XRET,1,IRETOU)
               ELSE
                   CALL LIROBJ(MOTYP,IOBJ,1,IRETOU)
               ENDIF
               IF(IERR.NE.0) RETURN
               TYPOBJ=' '
               CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:ILE),IBOOL
     $         ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
               IF( TYPOBJ.EQ.'        '.AND.MOTYP.EQ.'MOT     '.
     $    AND.IOBJLU.EQ.1) CALL ACCTAB (MTABLE,'METHODE ',IVAL,
     $ XRET,ICHAI(1:ILE),IBOOL,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,
     $ LOGRE,IOBRE)
               MTABLE = IOBRE
               IRET=.TRUE.
               IF(TYPOBJ.EQ.'TABLE   ') GO TO 4
               IF(TYPOBJ.EQ.'        ') IRET = .FALSE.
               GO TO 100
          ELSE
               IRET=.TRUE.
               GO TO 100
          ENDIF
      ELSE
         IRET =.TRUE.
         CALL QUETYP(MOTYP,0,IRETOU)
         IF (IRETOU.EQ.0) THEN
           IRET = .FALSE.
           GOTO 100
         ENDIF
         CALL LIROBJ(MOTYP,IVAL,1,IRETOU)
         IF (MOTYP.NE.'CHPOINT ' .AND.
     &       MOTYP.NE.'LISTMOTS' .AND.MOTYP.NE.'MCHAML  '.AND.
     &       MOTYP.NE.'LISTENTI' .AND.MOTYP.NE.'LISTREEL'.AND.
     &       MOTYP.NE.'MMODEL  ' .AND.MOTYP.NE.'NUAGE   '.AND.
     &       MOTYP.NE.'CHARGEME' ) THEN
            IF (MOTYP.EQ.'ANNULE  ') THEN
               IRET = .FALSE.
               GOTO 100
            ELSE IF (MOTYP.EQ.'SOLUTION') THEN
               CALL LIRMOT(MOTSOL,LSOL,IPOS,0)
               IF (MOTSOL(IPOS).EQ.'CONT') THEN
                  MSOLUT = IVAL
                  SEGACT MSOLUT
                  MSOLEN = MSOLIS(6)
                  SEGDES MSOLUT
                  IF (MSOLEN.EQ.0) THEN
                     IRET = .FALSE.
                     GOTO 100
                  ENDIF
               ENDIF
            ENDIF
            GOTO 100
         ENDIF
      ENDIF
c
c  existence d une composante dans un mchaml ou un champoint
c
      IF (MOTYP.EQ.'CHPOINT '.OR.MOTYP.EQ.'MCHAML  ') THEN
        CALL LIRCHA(CMOT,0,IRETOU)
        if (IRETOU.EQ.0) then
          if (MOTYP.EQ.'MCHAML  ') then
              CALL QUETYP(MOTYP1,0,IRETO1)
              IF (IRETO1.NE.0) THEN
                  IF (MOTYP1.NE.'MAILLAGE'.AND.MOTYP1.NE.'MMODEL') THEN
                      MOTERR(1:8)=MOTYP1
                      CALL ERREUR(39)
                      RETURN
                  ENDIF
                  call exiszo(ival,iret)
                  IF (IERR.NE.0) RETURN
                  GOTO 100
              ELSE
                  GOTO 122
              ENDIF
          else
              GOTO 122
          endif
        endif
        CALL EXISCO(MOTYP,IVAL,CMOT,IRET)
        IF(IERR.NE.0) RETURN
        GOTO 100
c
c  existence d'un mot/listmots dans un listmots
c
      ELSE IF (MOTYP.EQ.'LISTMOTS') THEN
        CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETO1)
        IF (IRETO1.NE.0) THEN
            SEGACT MLMOT1
            NTEST=MLMOT1.MOTS(/2)
            IF (NTEST.EQ.0) THEN
                MOTERR(1:8)='LISTMOTS'
                INTERR(1)=MLMOT1
                CALL ERREUR(356)
                RETURN
            ENDIF
            CALL LIRMOT(LCLE,NCLE,ICLE,0)
        ELSE
            CALL LIRCHA(CMOT,0,IRETO2)
            IF (IRETO2.EQ.0) GOTO 122
            NTEST=1
        ENDIF

        MLMOTS=IVAL
        SEGACT MLMOTS
        JGM=MOTS(/2)
        DO 22 I=1,NTEST
            IRET=.FALSE.
            IF (IRETO1.NE.0) CMOT=MLMOT1.MOTS(NTEST+1-I)
            DO 20 J=1,JGM
                IF (MOTS(J).EQ.CMOT) THEN
                    IRET=.TRUE.
                    IF (ICLE.EQ.0) THEN
                        CALL ECRLOG(IRET)
                    ELSEIF (ICLE.EQ.1) THEN
*                       Mot-clé 'OU' : un mot trouve => on peut sortir
                        GOTO 21
                    ENDIF
                    GOTO 22
                ENDIF
  20        CONTINUE
            IF (ICLE.EQ.0) THEN
                CALL ECRLOG(IRET)
            ELSEIF (ICLE.EQ.2) THEN
*               Mot-clé 'ET' : un mot non trouve => on peut sortir
                GOTO 21
            ENDIF
  22    CONTINUE
  21    SEGDES MLMOTS
        IF (IRETO1.NE.0) SEGDES MLMOT1
        IF (ICLE.EQ.0) RETURN
        GOTO 100
c
c  existence d'un entier dans un listenti
c
      ELSE IF (MOTYP.EQ.'LISTENTI') THEN
        CALL LIRENT(ITEST,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
        IRET=.FALSE.
        MLENTI=IVAL
        SEGACT MLENTI
        JG=LECT(/1)
        DO 30 J=1,JG
          IF(LECT(J).EQ.ITEST) THEN
          IRET=.TRUE.
          GO TO 31
          ENDIF
  30    CONTINUE
  31    SEGDES MLENTI
        GOTO 100
c
c  existence d'un reel dans un listreel
c
      ELSE IF (MOTYP.EQ.'LISTREEL') THEN
        CALL LIRREE(XTEST,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
*       lecture eventuelle d une tolerance
        CALL LIRREE(XTOL,0,IRETOU)
        IRET=.FALSE.
        MLREEL=IVAL
        SEGACT MLREEL
        JG=PROG(/1)
        IF (IRETOU.EQ.0) THEN
          DO 40 J=1,JG
            IF(PROG(J).EQ.XTEST) THEN
            IRET=.TRUE.
            GO TO 41
            ENDIF
  40      CONTINUE
        ELSE
          DO 42 J=1,JG
            IF(abs(PROG(J)-XTEST).LE.XTOL) THEN
            IRET=.TRUE.
            GO TO 41
            ENDIF
  42      CONTINUE
        ENDIF
  41    SEGDES MLREEL
        GOTO 100
c
c  existence d'une formulation ou un constituant dans
c                     un mmodel
c
      ELSE IF (MOTYP.EQ.'MMODEL  ') THEN
        CALL LIRCHA(CMOT,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
         IF (CMOT.EQ.'FORM'.OR.CMOT.EQ.'CONS'.OR.CMOT.EQ.'ELEM'
     &   .OR.CMOT.EQ.'MATE') THEN
         ICOND=1
         INFOR=1
119      call lircha(moform(infor),icond,ireto)
         IF(IERR.NE.0) RETURN
         ICOND=0
         IF(IRETO.NE.0) THEN
           INFOR=INFOR+1
           IF(INFOR.GT.NBFORM) THEN
             CALL ERREUR(5)
             RETURN
           ENDIF
           GO TO 119
         ENDIF
         INFOR=INFOR-1
*
         MMODEL=IVAL
         SEGACT MMODEL
         NSOUS=KMODEL(/1)
c
*  en cas de modele melange derouler : creer un nouveau mmode
      segini limode
      do im = 1,NSOUS
        imodel = kmodel(im)
        segact imodel
        limode(**) = imodel
        if (formod(1).eq.'MELANGE') then
          if (ivamod(/1).ge.1) then
            do ivm1 = 1,ivamod(/1)
              if (tymode(ivm1).eq.'IMODEL') then
                   limode(**) = ivamod(ivm1)
              endif
            enddo
          endif
        endif
      enddo

      segdes mmodel
      if (limode(/1).gt.0) then
       N1 = limode(/1)
       segini,mmodel
       do is = 1,limode(/1)
         kmodel(is) = limode(is)
       enddo
       NSOUS = N1
      else
*       write(6,*) 'pas de modele'
       call erreur(251)
      endif
c
*
         DO 1119 I=1,NSOUS
           IMODEL=KMODEL(I)
           SEGACT IMODEL
           IF(CMOT.EQ.'FORM') THEN
           NFOR=FORMOD(/2)
           IF(NFOR.NE.INFOR) GO TO 1119
           IF(NFOR.EQ.1) THEN
            IF(MOFORM(1).EQ.FORMOD(1)) GO TO 1118
           ELSE IF(NFOR.EQ.2) THEN
            IF(((MOFORM(1).EQ.FORMOD(1)).AND.(MOFORM(2).EQ.FORMOD(2))).
     .      OR.((MOFORM(1).EQ.FORMOD(2)).AND.(MOFORM(2).EQ.FORMOD(1))))
     .      GO TO 1118
           ENDIF
           ELSE IF (CMOT.EQ.'CONS') THEN
            DO 425 IJ=1,INFOR
            IF(MOFORM(IJ).EQ.CONMOD) GO TO 1118
 425        CONTINUE
           ELSE IF (CMOT.EQ.'ELEM') THEN
            DO 426 IJ=1,INFOR
            IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GO TO 1118
 426        CONTINUE
           ELSE IF (CMOT.EQ.'MATE') THEN
            NMAT=MATMOD(/2)
            DO 427 IJ=1,INFOR
            IBOOL = .TRUE.
            DO 4275 JJ=1,NMAT
            IBOOL = (MATMOD(JJ).NE.MOFORM(IJ)).AND. IBOOL
 4275       CONTINUE
            IF (IBOOL) GOTO 1119
 427        CONTINUE
            GOTO 1118
           ENDIF
           SEGDES IMODEL
1119     continue
*
         IRET=.FALSE.
         SEGSUP MMODEL
         segsup limode
         GO TO 100
*
1118     continue
         IRET=.TRUE.
         SEGDES IMODEL
         SEGSUP MMODEL
         segsup limode
         GO TO 100
      ELSE
         MOTERR(1:4)=CMOT
         CALL ERREUR(7)
         RETURN
      ENDIF
c
c       cas de l'objet chargeme
c
      ELSE IF (MOTYP.EQ.'CHARGEME') THEN
        CALL LIRCHA(CMOT,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
        IRET = .FALSE.
        MCHARG = IVAL
        SEGACT MCHARG
        IDIM1 = KCHARG(/1)
        IF (CMOT.EQ.'LIBR'.OR.CMOT.EQ.'LIE ') THEN
          DO 302 I=1,IDIM1
             IF (CMOT.EQ.CHALIE(I)) THEN
               IRET = .TRUE.
               GOTO 301
             ENDIF
 302      CONTINUE
        ELSE
          DO 300 I=1,IDIM1
             IF (CMOT.EQ.CHANOM(I)) THEN
               IRET = .TRUE.
               GOTO 301
             ENDIF
 300      CONTINUE
        ENDIF
 301    CONTINUE
        SEGDES MCHARG
        GOTO 100
c
c       cas de l'objet nuage
c
      ELSE
        CALL LIRCHA(MONU1,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
        IRET=.FALSE.
        MNUAGE=IVAL
        SEGACT MNUAGE
        IDIM1 = NUANOM(/2)
        DO 200 I=1,IDIM1
           IF (MONU1.EQ.NUANOM(I)) THEN
             IRET = .TRUE.
             GOTO 201
           ENDIF
 200    CONTINUE
 201    CONTINUE
        SEGDES MNUAGE
        GOTO 100
      ENDIF
c
 122  CONTINUE
      IRET=.TRUE.
      IF(MOTYP.NE.'ANNULE  ') GOTO 100
      IRET=.FALSE.
 100  CONTINUE
      CALL ECRLOG(IRET)
      RETURN
      END