C EXIS      SOURCE    CB215821  24/04/12    21:15:50     11897          

      SUBROUTINE EXIS

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


-INC PPARAM
-INC CCOPTIO
-INC CCHAMP

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

      PARAMETER (NBFORM=20)
      PARAMETER (NLOMAX=5)
      CHARACTER*4 MNLOCA(NLOMAX)
      CHARACTER*(LOCOMP) CMOT
      CHARACTER*8 MOTYP,TYPOBJ,MOTYP1,MONU1
      CHARACTER*(LCONMO) MOFORM(NBFORM)
      CHARACTER*(LOCHAI) ICHAI,CHARRE,CCHAI
      LOGICAL IRET,IBOOL,LOGRE
      INTEGER ICLE
*
      PARAMETER (LSOL = 1)
      CHARACTER*4 MOTSOL(LSOL)
      DATA MOTSOL/'CONT'/

      PARAMETER (LMOD = 5)
      CHARACTER*(4) MOTMOD(LMOD)
      DATA MOTMOD/'FORM','CONS','ELEM','MATE','NON_'/
      MACRO,(FORMULATION,CONSTITUANT,ELEMENT,MATERIAU,NON_LOCAL)
*
      PARAMETER (NCLE=2)
      CHARACTER*2 LCLE(NCLE)
      DATA LCLE/'OU','ET'/

      PARAMETER (MCLE=1)
      CHARACTER*1 MOTCLE(MCLE)
      DATA MOTCLE/'*'/
      LOGICAL LDUM
*
      ICLE=0
      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       traitement special pour les objets de type TABLE
  4     CONTINUE
        CALL QUETYP(MOTYP,0,IRETOU)
        IF( IRETOU.NE.0) THEN
          IF    (MOTYP.EQ.'ENTIER  ') THEN
             CALL LIRENT(IVAL,1,IRETOU)
             IF(IERR.NE.0) RETURN
          ELSEIF(MOTYP.EQ.'MOT     ')THEN
             CALL LIRCHA(ICHAI,1,ILE)
             IF(IERR.NE.0) RETURN
          ELSEIF(MOTYP.EQ.'LOGIQUE ') THEN
             CALL LIRLOG(IBOOL,1,IRETOU)
             IF(IERR.NE.0) RETURN
          ELSEIF(MOTYP.EQ.'FLOTTANT') THEN
             CALL LIRREE(XRET,1,IRETOU)
             IF(IERR.NE.0) RETURN
          ELSE
             CALL LIROBJ(MOTYP,IOBJ,1,IRETOU)
             IF(IERR .NE. 0) RETURN
             CALL ACTOBJ(MOTYP,IOBJ,1)
          ENDIF
          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   ') GOTO 4
          IF(TYPOBJ.EQ.'        ') IRET = .FALSE.
          GOTO 100

        ELSE
          IRET=.TRUE.
          GOTO 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(IERR .NE. 0) RETURN
         CALL ACTOBJ(MOTYP,IVAL,1)

C        Verification que l'objet demande etait du type demande : toto*'MAILLAGE' par exemple
         CALL LIRMOT(MOTCLE,MCLE,IR,0)
         IF (IR.GT.0) THEN
           CALL LIRCHA(TYPOBJ,1,IRETOU)
           IF (IERR.NE.0) RETURN
           IF (TYPOBJ .EQ. 'FICHIER ')THEN
C            Cas du test d'existence d'un fichier
             IF(MOTYP .NE. 'MOT     ')THEN
               IRET = .FALSE.

             ELSE
               CALL QUEVAL(IVAL,'MOT',IRET1,ILON1,XDUM,CCHAI,LDUM,IDUM)
C               PRINT *,'EXIS:',MOTYP,IVAL,':',CCHAI(1:ILON1),':'
               INQUIRE( FILE=CCHAI(1:ILON1), EXIST=IRET )
             ENDIF

           ELSEIF (TYPOBJ .NE. MOTYP) THEN
             IRET = .FALSE.
           ENDIF
           GOTO 100

         ELSEIF (MOTYP.NE.'CHPOINT ' .AND. MOTYP.NE.'MCHAML  '.AND.
     &           MOTYP.NE.'MMODEL  ' .AND. MOTYP.NE.'LISTMOTS'.AND.
     &           MOTYP.NE.'LISTENTI' .AND. MOTYP.NE.'LISTREEL'.AND.
     &           MOTYP.NE.'NUAGE   ' .AND. MOTYP.NE.'CHARGEME' ) THEN

            IF (MOTYP.EQ.'ANNULE  ') THEN
               IRET = .FALSE.

            ELSEIF (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.
                  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
      ELSEIF (MOTYP.EQ.'LISTMOTS') THEN
        MLMOTS=IVAL
        SEGACT,MLMOTS
        JGN   =MOTS(/1)
        JGM   =MOTS(/2)
        ILON  =JGN
        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(CCHAI,0,ILON)
            IF (ILON.EQ.0) GOTO 122
            NTEST=1

            IF(ILON .GT. JGN)THEN
              MOTERR   =CCHAI
              INTERR(1)=JGN
              CALL ERREUR(-371)
              ILON     =JGN
            ENDIF
        ENDIF

        DO 22 I=1,NTEST
            IRET=.FALSE.
            IF (IRETO1.NE.0) CCHAI=MLMOT1.MOTS(NTEST+1-I)
            DO 20 J=1,JGM
                IF (MOTS(J).EQ.CCHAI(1:ILON)) 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    IF (ICLE.EQ.0) RETURN
        GOTO 100
c
c  existence d'un entier dans un listenti
c
      ELSEIF (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.
          GOTO 100
          ENDIF
  30    CONTINUE
        GOTO 100
c
c  existence d'un reel dans un listreel
c
      ELSEIF (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.
            GOTO 100
            ENDIF
  40      CONTINUE
        ELSE
          DO 42 J=1,JG
            IF(abs(PROG(J)-XTEST).LE.XTOL) THEN
            IRET=.TRUE.
            GOTO 100
            ENDIF
  42      CONTINUE
        ENDIF
        GOTO 100
c
c  existence d'une formulation ou un constituant dans
c                     un mmodel
c
      ELSEIF (MOTYP.EQ.'MMODEL  ') THEN
        CALL LIRMOT(MOTMOD,LMOD,IRETOU,0)
        IF (IRETOU.EQ.0) GOTO 122
        CMOT=MOTMOD(LMOD)
        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
          GOTO 119
        ENDIF
        INFOR=INFOR-1

C       Extension du MMODEL en cas de modele de MELANGE
        CALL MODETE(IVAL,mmodel,IMELAN)
        NSOUS=KMODEL(/1)
        IF(NSOUS .EQ. 0)THEN
          CALL ERREUR(21)
          RETURN
        ENDIF

        DO 1119 I=1,NSOUS
          IMODEL=KMODEL(I)

C         =============================================================
          CASE, IRETOU
C         -------------------------------------------------------------
          WHEN,FORMULATION
C         -------------------------------------------------------------
           NFOR=FORMOD(/2)
           IF(NFOR.NE.INFOR) GOTO 1119
           IF(NFOR.EQ.1) THEN
            IF(MOFORM(1).EQ.FORMOD(1)) GOTO 1118
           ELSEIF(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))))
     &      GOTO 1118
           ENDIF

C         -------------------------------------------------------------
          WHEN,CONSTITUANT
C         -------------------------------------------------------------
           DO 425 IJ=1,INFOR
             IF(MOFORM(IJ).EQ.CONMOD) GOTO 1118
 425       CONTINUE
C         -------------------------------------------------------------
          WHEN,ELEMENT
C         -------------------------------------------------------------
           DO 426 IJ=1,INFOR
             IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GOTO 1118
 426       CONTINUE
C         -------------------------------------------------------------
          WHEN,MATERIAU
C         -------------------------------------------------------------
           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
C         -------------------------------------------------------------
          WHEN,NON_LOCAL
C         -------------------------------------------------------------
           MN3=INFMOD(/1)
           IF(MN3.LE.12) GOTO 1119
           INLOC=-1*INFMOD(13)
           IF(INLOC.EQ.0) GOTO 1119
           CALL MODNLO(MNLOCA,NLODIM)
           DO 428 IJ=1,INFOR
             IF(MNLOCA(INLOC).EQ.MOFORM(IJ)(1:4)) GOTO 1118
 428       CONTINUE
C         -------------------------------------------------------------
          ENDCASE
C         =============================================================

1119      continue
*
        IRET=.FALSE.
        GOTO 100
*
1118    continue
        IRET=.TRUE.
        GOTO 100
c
c       cas de l'objet chargeme
c
      ELSEIF (MOTYP.EQ.'CHARGEME') THEN
        CALL LIRCHA(CMOT,0,IRETOU)
        IF (IRETOU.EQ.0) GOTO 122
        IRETO2 = 0
        CALL LIRCHA(MOTYP1,0,IRETO2)
        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
               IF (IRETO2.EQ.0) THEN
                 IRET = .TRUE.
                 GOTO 301
               ENDIF
               ICHARG=KCHARG(I)
               SEGACT,ICHARG
               IF (MOTYP1.EQ.CHATYP) THEN
                 IRET = .TRUE.
                 GOTO 301
               ENDIF
             ENDIF
 300      CONTINUE
        ENDIF
 301    CONTINUE
        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
        GOTO 100
      ENDIF
c
 122  CONTINUE
      IRET=.TRUE.
      IF(MOTYP.NE.'ANNULE  ') GOTO 100
      IRET=.FALSE.
 100  CONTINUE
      CALL ECRLOG(IRET)
      END