Télécharger modeli.eso

Retour à la liste

modeli
C MODELI    SOURCE    MB234859  26/05/13    21:15:11     12548          
C----------------------------------------------------------------------C
C                     OPERATEUR MODELE                                 C
C                                                                      C
C  Creation d'un objet MODELE                                          C
C                                                                      C
C  Syntaxe : MOD1 = MODL GEO1 TYPE_CAL TYPE_MAT ( TYPE_ELE ) ;         C
C                                                                      C
C    GEO1        MAILLAGE de base                                      C
C    TYPE_CAL    MOT(S) pour definir la FORMULATION                    C
C    TYPE_MAT    MOT(S) pour definir le MATERIAU                       C
C    TYPE_ELE    MOT(S) pour definir les ELEMENTS FINIS a utiliser     C
C    MOD1        Resultat de type MODELE                               C
C----------------------------------------------------------------------C
C  PPU : Modif pour les materiaux unidirectionels en plasticite
 
      SUBROUTINE MODELI
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
-INC CCGEOME
C==DEB= FORMULATION HHO == Include specifique ==========================
-INC CCHHOPA
C==FIN= FORMULATION HHO ================================================
-INC SMCOORD
-INC SMELEME
-INC SMMODEL
      POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL
      POINTEUR nomid1.NOMID,nomid2.NOMID
-INC SMTABLE
-INC SMLMOTS
      POINTEUR OPNLIN.MLMOTS
 
      SEGMENT PLICON
        integer mlicon(NLCON),tlicon(NLCON)
      ENDSEGMENT
 
      EXTERNAL LONG
      PARAMETER (NBFORM=19,NBCON=15,NBEXT=1,NBDIF=1)
      PARAMETER (N1MAX=300,N2MAX=200)
      PARAMETER (NLOMAX=5,NGELT=14)
 
      DIMENSION LESMOD(N1MAX)
      CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX)
      CHARACTER*4 MOCON(NBCON),MOEXT(NBEXT),MOINCO(NBDIF),MNLVAR(1)
      CHARACTER*4 MNLOCA(NLOMAX),MCTCT(4),MGAUSS(4),MOGELT(NGELT),MDISC
      CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM
      CHARACTER*(LCONMO) CONM
      CHARACTER*(LOCOMP) MOPRID,MDIINC,MDIDUA
      CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX)
      CHARACTER*16 MOTROP(3),MOTPRO
      CHARACTER*(LOCHAI) LMOLIB,LMOFCT
 
      LOGICAL LOGRE,LOGIN,LMENLX,LMEVIX,LOSTAT,LOMELA,LMOEXT,LOBBAR
      LOGICAL LONAVI
 
C=DEB==== FORMULATION HHO ==== Declarations particulieres ==============
      PARAMETER (NMHHO=2)
      CHARACTER*4 mcHHO(NMHHO)
      CHARACTER*(LOCHAI) chaHHO
      LOGICAL loHHO
      DATA mcHHO / 'HHO_','HHO ' /
C=FIN==== FORMULATION HHO ==============================================
      DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/
c      DATA MDERIV/'LINEAIRE        ','QUADRATIQUE     ',
c    &             'TRUESDELL       ','JAUMANN         ',
c    &             'UTILISATEUR     ','FEFP            '/
C----------------------------------------------------------------------C
C              DEFINITION DES NOMS DE FORMULATIONS                     C
C----------------------------------------------------------------------C
      DATA MOFORM /
     &     'THERMIQUE       ','MECANIQUE       ','LIQUIDE         ',
     &     'POREUX          ','DARCY           ','CONTACT         ',
     &     'MAGNETODYNAMIQUE','NAVIER_STOKES   ','MELANGE         ',
     &     'EULER           ','FISSURE         ','LIAISON         ',
     &     'THERMOHYDRIQUE  ','ELECTROSTATIQUE ','DIFFUSION       ',
     &     'CHARGEMENT      ','METALLURGIE     ','CHANGEMENT_PHASE',
     &     'CONTRAINTE      '                                      /
 
C (fdp) Ajout d'un nouveau mot clef 'LIBRE' ou 'LIE' pour les JOI1
      DATA MOCON  / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS',
     &              'LIBR','LIE ','NON_','LINE','CHPO','GAP7','COMP',
     &              'EPSI'/
      DATA MOEXT  / 'PARA' /
      DATA MOINCO / 'INCO' /
      DATA MNLVAR / 'V_MO' /
      DATA MCTCT  / 'MESC','FAIB','SYME','MORT' /
      DATA MOGELT / 'BBAR',
     &              'QUAF','LINE','MACR','LINB',
     &              'LICE','LIMS','LBMS','MCCE','MCP1','MCMS',
     &              'QFCE','QFP1','QFMS' /
 
      LCVAR  = 0
      LCMAT  = 0
      LCMAF  = 0
      LCPAR  = 0
      LDERI  = 0
      NBGA   = 10
      NBDANG = 3
      ICAVIT = 0
      ISYME  = 0
      IFACAF = 0
      INLOC  = 0
      LULVIA = 0
C=DEB==== FORMULATION HHO ==== Initialisations particulieres ===========
      loHHO  = .FALSE.
C=FIN==== FORMULATION HHO ==============================================
      LMEVIX = .FALSE.
      LMENLX = .FALSE.
      LMOEXT = .FALSE.
      LOBBAR = .FALSE.
      LONAVI = .FALSE.
      ICONV  = 0
      IRAYE  = 0
      IPHAS  = 0
      IPMMEL = 0
      JLMOT1 = 0
      JLMOT2 = 0
      mmode2 = 0
      IPTABL = 0
      IPTABS = 0
      IPTABM = 0
      IPTBMO = 0
      IPTBDM = 0
      IPTMOD = 0
      IPGEOM = 0
      IPGEO2 = 0
C     ==================================================================
C     0- Acquisition des tables ou maillage
C     ==================================================================
C     Lecture d'une table BASE_MODALE
      CALL LIRTAB('BASE_MODALE',IPTABL,0,IRET)
      IF (IERR.NE.0) RETURN
      IF (IRET.GT.0) THEN
        IPTBMO=IPTABL
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        CHARIN='MODES'
        TYPOBJ='TABLE   '
        CALL ACCTAB(IPTBMO,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPTBDM = IOBRE
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        CHARIN='MAILLAGE'
        TYPOBJ='MAILLAGE'
        CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPMAIL = IOBRE
        IVALIN=1
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='ENTIER  '
        CHARIN='        '
        TYPOBJ='TABLE'
        CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
 
        IPTMOD = IOBRE
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        TYPOBJ='POINT'
        CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
     &                  IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)        
        IF (IERR.NE.0) RETURN
        NBNN = 1
        NBELEM = 1
        NBSOUS = 0
        NBREF = 0
        SEGINI IPT8
        IPT8.ITYPEL = 1
        IPT8.NUM(1,1) = IOBRE
        IPGEOM = IPT8
        IRET = 0
      ENDIF
C
C     Lecture d'une table STATIONNAIRE
      CALL LIRTAB('STATIONNAIRE',IPTABL,0,IRET)
      IF (IERR.NE.0) RETURN
      IF (IRET.GT.0) THEN
        IPTABS=IPTABL
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        CHARIN='MAILLAGE'
        TYPOBJ='TABLE   '
        CALL ACCTAB(IPTABS,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPTABM = IOBRE
        IVALIN=1
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='ENTIER  '
        CHARIN='        '
        TYPOBJ='MAILLAGE'
        CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPGEOM = IOBRE
        IRET = 0
      ENDIF
C
C     Lecture d'une TABLE de sous-type MAILLAGE
      IF (IPTABM.EQ.0) THEN
        CALL LIRTAB('MAILLAGE',IPTABL,0,IRET)
        IF (IERR.NE.0) RETURN
        IF (IRET.GT.0) THEN
          IPTABM = IPTABL
          IVALIN=1
          XVALIN=REAL(0.D0)
          LOGIN=.TRUE.
          IOBIN=0
          TAPIND='ENTIER  '
          CHARIN='        '
          TYPOBJ='MAILLAGE'
          CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                       TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
          IF (IERR.NE.0) RETURN
          IPGEOM = IOBRE
          IRET = 0
        ENDIF
      ENDIF
C
C     Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE
      CALL LIRTAB('DOMAINE',IPTABL,0,IRET)
      IF (IERR.NE.0) RETURN
      IF (IPTABL.GT.0) THEN
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        CHARIN='MAILLAGE'
        TYPOBJ='MAILLAGE'
        CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPGEOM = IOBRE
      ENDIF
C
C     Lecture d'un MAILLAGE (cas general) :
      IF (IPGEOM.LE.0) THEN
        CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET)
        IF (IERR.NE.0) RETURN
      ENDIF
C
C     Verification de l'unicite des elements
      IPT1 = IPGEOM
      CALL UNIQMA(IPT1,NBDI1,0)
      IF (NBDI1.NE.0) THEN
        MOTERR(1:8)='MAILLAGE'
        CALL ERREUR(1019)
        RETURN
      ENDIF
C     ==================================================================
C     1- Identification de la formulation : FORMOD
C     ==================================================================
C     NFOR  = 1 => Formulation simple
C     NFOR  = 2 => Formulation couplee
      NFOR =0
      ICOND=1
      CALL MESLIR(-182)
 
 51   CONTINUE
      CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND)
      IF (IERR.NE.0) RETURN
      IF (IPFORM.EQ.0) GOTO 52
C
      NFOR=NFOR+1
      IF (NFOR.GT.2) THEN
        CALL ERREUR(251)
        RETURN
      ENDIF
      LESFOR(NFOR)=MOFORM(IPFORM)
      ICOND=0
      CALL MESLIR(-181)
      GOTO 51
 52   CONTINUE
C
      IF (NFOR.EQ.1) THEN
        IF     (LESFOR(1).EQ.'THERMIQUE') THEN
          CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN
          CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN
          CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'POREUX') THEN
          CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'DARCY') THEN
          CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'CONTACT') THEN
          CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
          CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN
          CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF (LESFOR(1).EQ.'MELANGE') THEN
          CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
          DO i=1,N1MAX
            LESMOD(i)=0
          ENDDO
        ELSE IF(LESFOR(1).EQ.'EULER') THEN
          CALL MODE13(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'FISSURE') THEN
          CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'LIAISON') THEN
          CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN
          CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
          CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'DIFFUSION       ') THEN
          CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'CHARGEMENT      ') THEN
          CALL MODE19(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'METALLURGIE     ') THEN
cjk148537 : ce n'est pas l exemple a suivre
          CALL MODE21(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
          CALL MODE22(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE IF(LESFOR(1).EQ.'CONTRAINTE') THEN
          CALL MODE24(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
        ELSE
          CALL ERREUR (251)
        ENDIF
        IF (IERR.NE.0) RETURN
      ELSE IF (NFOR.EQ.2) THEN
        IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR.
     &      (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN
          CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX)
        ELSE
          CALL ERREUR(251)
        ENDIF
        IF (IERR.NE.0) RETURN
C
        MN3    = 12
        NOBMOD = 0
        NMAT   = 0
        GOTO 43
      ENDIF
C     ==================================================================
C     2- Identification du type de materiau : MATMOD
C     ==================================================================
C     NMAT  = 0 => Valeur par defaut
C     NMAT /= 0 => Decrypter le contenu des LESPRO
      NMAT = 0
      IF (IPTABM.GT.0.AND.IPTABS.EQ.0) GOTO 674
      CALL MESLIR(-180)
C
 41   CONTINUE
      IF (NMAT.NE.0) CALL MESLIR(-179)
      CALL LIRMOT(MOPROP,NPROP,LAPROP,0)
      IF (IERR.NE.0) RETURN
      IF (LAPROP.EQ.0) GOTO 42
C
      NMAT=NMAT+1
      LESPRO(NMAT)=MOPROP(LAPROP)
CC    WRITE(*,*) 'NMAT ',LESPRO(NMAT),NMAT
      GOTO 41
  42  CONTINUE
C
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation THERMIQUE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      IF (LESFOR(1).EQ.'THERMIQUE        ') THEN
C
        MN3    = 7
        NOBMOD = 0
C
C       Comportement par defaut
        IF (NMAT.EQ.0) THEN
          NMAT = 2
          LESPRO(1)='ISOTROPE        '
          LESPRO(2)='CONDUCTION      '
        ELSE
C
C         Comportement SOURCE
C         ------------------------
          CALL PLACE(LESPRO,NMAT,IPLAC,'SOURCE          ')
          IF (IPLAC.EQ.0) GOTO 113
C
C         Liste des EF disponibles pour les SOURCES
          CALL MODE23(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
C
          CALL PLACE(LESPRO,NMAT,IPLAC,'GAUSSIENNE      ')
          IF (IPLAC.NE.0) THEN
            IF (IDIM.EQ.1) THEN
              INTERR(1) = IDIM
              CALL ERREUR(1104)
              RETURN
            ENDIF
            DO i=2,NMAT
              CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
              IF ((i.EQ.2).AND.(IPLAC.EQ.0)) THEN
                NMAT=NMAT+1
                LESPRO(NMAT)='SPHERIQUE       '
              ELSE IF (IPLAC.EQ.4) THEN
                IF (IDIM.LT.3) THEN
                  INTERR(1)=IDIM
                  CALL ERREUR(709)
                  RETURN
                ENDIF
              ENDIF
            ENDDO
          ENDIF
          GOTO 112
C
 113      CONTINUE
C
C         "Tropie"
          CALL MODTHE(MOTROP,NTROP)
          CALL PLACE(MOTROP,NTROP,IPLAC,LESPRO(1))
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,1,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            NMAT=NMAT+1
            LESPRO(1)='ISOTROPE        '
          ENDIF
 
          IF (NMAT.LT.2) THEN
            CALL PLACE(LESPRO,NMAT,IPLAC,'CONDUCTION      ')
            IF (IPLAC.EQ.0) THEN
              NMAT=NMAT+1
              LESPRO(NMAT)='CONDUCTION'
            ENDIF
          ENDIF
C
C         Comportement ADVECTION
C         ------------------------
          CALL PLACE(LESPRO,NMAT,IADVE,'ADVECTION       ')
          CALL PLACE(LESPRO,NMAT,IPHAS,'PHASE           ')
          IF ((IADVE+IPHAS).EQ.0) GOTO 110
          CALL PLACE(LESPRO,NMAT,IPLAC,'CONDUCTION      ')
          IF (IPLAC.EQ.0) THEN
            NMAT=NMAT+1
            LESPRO(NMAT)='CONDUCTION      '
          ENDIF
 110      CONTINUE
C
C         Comportement CONVECTION
C         ------------------------
          CALL PLACE(LESPRO,NMAT,IPLAC,'CONVECTION      ')
          IF (IPLAC.EQ.0) GOTO 111
          ICONV=IPLAC
C
C         Liste des EF disponibles pour la CONVECTION
          CALL MODEL4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
C
 111      CONTINUE
C
C         Comportement RAYONNEMENT
C         ------------------------
          CALL PLACE(LESPRO,NMAT,IPLAC,'RAYONNEMENT     ')
          IF (IPLAC.EQ.0) GOTO 112
          IRAYE=IPLAC
C
C         Liste des EF disponibles pour le RAYONNEMENT
          CALL MODEL9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
C
          DO i=2,NMAT
            CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
C
            IF      (MOPROP(IPLAC).EQ.'CAVITE          ') THEN
              ICAVIT=1
C
            ELSE IF (MOPROP(IPLAC).EQ.'FAC_A_FAC       ') THEN
              IFACAF=1
              CALL LIROBJ('MAILLAGE',IPFAC1,1,IRETOU)
              IF(IERR.NE.0) RETURN
              CALL LIROBJ('MAILLAGE',IPFAC2,1,IRETOU)
              IF(IERR.NE.0) RETURN
              CALL LIROBJ('MAILLAGE',IPFAC3,1,IRETOU)
              IF(IERR.NE.0) RETURN
              CALL LIROBJ('MMODEL'  ,IMOCO ,1,IRETOU)
              IF(IERR.NE.0) RETURN
              CALL ACTOBJ('MAILLAGE',IPFAC1,1)
              CALL ACTOBJ('MAILLAGE',IPFAC2,1)
              CALL ACTOBJ('MAILLAGE',IPFAC3,1)
              CALL ACTOBJ('MMODEL'  ,IMOCO,1)
              IF (IERR.NE.0) RETURN
C
            ELSE IF (MOPROP(IPLAC).EQ.'SYMETRIE        ') THEN
              ISYME=1
              CALL LIROBJ('POINT',IPP1,1,IRETOU)
              IF(IERR.NE.0) RETURN
              CALL LIROBJ('POINT',IPP2,1,IRETOU)
              IF(IDIM.EQ.3)CALL LIROBJ('POINT',IPP3,1,IRETOU)
              IF(IERR.NE.0) RETURN
C
            ELSE IF (MOPROP(IPLAC).EQ.'NGAU            ') THEN
              CALL LIRENT(NBGA,1,IRETOU)
              IF(IERR.NE.0) RETURN
C
            ELSE IF (MOPROP(IPLAC).EQ.'DANG            ') THEN
              CALL LIRENT( NBDANG,1,IRETOU)
              IF(IERR.NE.0) RETURN
C
            ENDIF
          ENDDO
          NOBMOD = 2*ICAVIT+ISYME*IDIM+IFACAF*4
C
 112      CONTINUE
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation MECANIQUE/POREUX
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'MECANIQUE        ' .OR. 
     &         LESFOR(1).EQ.'POREUX           ') THEN
C
        MN3    = 12
        NOBMOD = 0
C
C       Comportement par defaut
        IF ((NMAT.EQ.0).OR.(NMAT.EQ.1)) THEN
          NMAT=2
          LESPRO(1)='ELASTIQUE       '
          LESPRO(2)='ISOTROPE        '
        ELSE
C
C         Comportement lineaire
          CALL MODELA(MOPROP,NMOD)
          CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2))
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,2,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            LESPRO(2)='ISOTROPE'
            NMAT=NMAT+1
          ENDIF
C
C         Comportement non lineaire
          CALL MODNLI(MOPROP,NMOD)
          CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
          IF (IPLAC.EQ.1) THEN
C           Par defaut : PLASTIQUE ISOTROPE
            NMAT=NMAT+1
            LESPRO(NMAT)='ISOTROPE'
          ELSE IF (IPLAC.EQ.2) THEN
C           Par defaut : FLUAGE NORTON
            NMAT=NMAT+1
            LESPRO(NMAT)='NORTON'
          ELSE IF (IPLAC.EQ.3) THEN
C           Par defaut : VISCOPLASTIQUE ONERA
            NMAT=NMAT+1
            LESPRO(NMAT)='ONERA'
          ELSE IF (IPLAC.EQ.4) THEN
C           Par defaut : ENDOMMAGEMENT MAZARS
            NMAT=NMAT+1
            LESPRO(NMAT)='MAZARS'
          ELSE IF (IPLAC.EQ.5) THEN
C           Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y
            NMAT=NMAT+1
            LESPRO(NMAT)='PSURY'
          ELSE IF (IPLAC.EQ.6) THEN
C           Pas de comportement par defaut pour 'NON_LINEAIRE'
            CALL ERREUR(945)
            RETURN
          ELSE IF (IPLAC.EQ.7) THEN
C           Pas de comportement par defaut en 'MECANIQUE'
            IF (LESFOR(1).EQ.'MECANIQUE') CALL ERREUR(946)
            IF (LESFOR(1).EQ.'POREUX')    CALL ERREUR(251)
            RETURN
          ENDIF
C
C         Lois externes : lecture d'arguments supplementaires
          CALL PLACE(LESPRO,NMAT,IPLAC,'VISCO_EXTERNE   ')
          LMEVIX=(IPLAC.NE.0)
          CALL PLACE(LESPRO,NMAT,IPLAC,'NON_LINEAIRE    ')
          IF (IPLAC.NE.0) THEN
            CALL PLACE(LESPRO,NMAT,IPLAC,'UTILISATEUR     ')
            LMENLX=(IPLAC.NE.0)
          ENDIF
          LMOEXT=LMEVIX.OR.LMENLX
C
          CALL PLACE(LESPRO,NMAT,IPLAC,'MODAL           ')
          IF (IPLAC.NE.0) THEN
            IF (IPTMOD.GT.0) NOBMOD = 1
            IF (IPMOD3.GT.0) NOBMOD = NOBMOD + 1
          ENDIF
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation LIQUIDE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'LIQUIDE          ') THEN
C
        MN3    = 12
        NOBMOD = 0
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation DARCY
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'DARCY            ') THEN
C
        MN3    = 7
        NOBMOD = 0
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation CONTACT
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'CONTACT         ') THEN
C
        MN3    = 1
        NOBMOD = 3
C
        ITCO=1
        IFRT=0
        IMUL=0
        IF (NMAT.EQ.0) THEN
          NMAT=1
          LESPRO(1)='UNILATERAL      '
        ELSE
          CALL PLACE(LESPRO,NMAT,IPLAC,'UNILATERAL      ')
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,1,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            NMAT=NMAT+1
            LESPRO(1)='UNILATERAL      '
          ENDIF
C
          CALL PLACE(LESPRO,NMAT,IPLAC,'FROCABLE        ')
          IF (IPLAC.NE.0) ITCO = 0
          CALL PLACE(LESPRO,NMAT,IPLAC,'FROTTANT        ')
          IF (IPLAC.NE.0) IMUL = 3
          CALL PLACE(LESPRO,NMAT,IPLAC,'COULOMB         ')
          IF (IPLAC.NE.0) IFRT = 1
C
          IF (IMUL.EQ.3) THEN
            IF ((ITCO.EQ.1).AND.(IFRT.EQ.0)) THEN
              moterr = 'FROTTANT : mot-cle COULOMB ou '//
     &                 'FROCABLE obligatoire'
              call erreur(-385)
              CALL ERREUR(498)
            ENDIF
            IF (ifrt.ne.0 .and. itco.eq.0) then
              moterr = 'FROTTANT : COULOMB ou FROCABLE mais pas les 2'
              call erreur(-385)
              CALL ERREUR(21)
              RETURN
            endif
          ELSE
            if (ifrt.ne.0 .or. itco.eq.0) then
              moterr = 'Mot-cle FROTTANT a preciser '//
     &                 'si COULOMB ou FROCABLE fourni'
              call erreur(-385)
              CALL ERREUR(498)
              RETURN
            endif
          ENDIF
C
        ENDIF
C
        IF (ITCO.EQ.1) THEN
C         Mot-cle donnant la formulation
          CALL LIRMOT(MCTCT,4,ITCO,0)
          IF(ITCO.EQ.0) ITCO=1
C         Mortar : uniquement disponible en 2D
          IF ((ITCO.EQ.4) .AND. (IDIM.NE.2)) THEN
              INTERR(1) = IDIM
              CALL ERREUR(1104)
              RETURN
          ENDIF
        ENDIF
C
C       Lecture du second maillage
        CALL LIROBJ('MAILLAGE',IPGEO2,1,IRETOU)
        IF (IERR.NE.0) RETURN
C
C       Creation des noeuds support des mult. de Lagrange
        IPGEO1=IPGEOM
        IPRIG=0
        CALL MOCON1(IPGEO1,IPGEO2,IMUL,ITCO,IPGEOM,IPGEOY,IP1,IP2,IPRIG)
        IF (IERR.NE.0) RETURN
        IF (ITCO.NE.0) THEN
          IPGEO1=IP1
          IPGEO2=IP2
          IF (IPRIG.NE.0) NOBMOD=4
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation MAGNETODYNAMIQUE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
C
        MN3    = 7
        NOBMOD = 0
C
C       Comportement par defaut
        IF ((NMAT.EQ.0).OR.(NMAT.EQ.1)) THEN
          NMAT=2
          LESPRO(1)='POTENTIEL_VECTEU'
          LESPRO(2)='ISOTROPE        '
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation NAVIER_STOKES/EULER
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES    ' .OR. 
     &         LESFOR(1).EQ.'EULER            ') THEN
C
        MN3    = 7
        NOBMOD = 0
C
        IF (NMAT.EQ.0) THEN
          NMAT = 1
          LESPRO(NMAT)='NEWTONIEN'
        ELSE
          DO i=1,NMAT
            CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
            IF (IPLAC.EQ.4) THEN
              MN3 = 12
              NOBMOD = 1
            ENDIF
          ENDDO
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation MELANGE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'MELANGE         ') THEN
C
        MN3    = 7
        NOBMOD = 0
C
        IF (NMAT.EQ.0) THEN
          NMAT = 1
          LESPRO(1)='PARALLELE       '
        ELSE
          CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,1,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            NMAT=NMAT+1
            LESPRO(1)='PARALLELE       '
          ENDIF
        ENDIF
C
        CALL LIROBJ('MMODEL',IPMOD,0,IOK)
        IF (IERR.NE.0) RETURN
        IF (IOK.EQ.1) THEN
          CALL ACTOBJ('MMODEL',IPMOD,1)
          IF (IERR.NE.0) RETURN
          LESMOD(1)=IPMOD
        ENDIF
C
        CALL PLACE(LESPRO,NMAT,IPARA,'PARALLELE      ')
        CALL PLACE(LESPRO,NMAT,ISERI,'SERIE          ')
        IF ((IPARA+ISERI).NE.0) THEN
          IF (IPMOD.LE.0) THEN
            CALL ERREUR(21)
            RETURN
          ENDIF
          IPMMEL = IPMOD
          MMODE1 = IPMOD
          NOBMOD = MMODE1.KMODEL(/1)
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation FISSURE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'FISSURE         ') THEN
C
        MN3    = 7
        NOBMOD = 0
C
        IF (NMAT.EQ.0) THEN
          NMAT = 3
          LESPRO(1)='MASS'
          LESPRO(2)='PARF'
          LESPRO(3)='POISEU_BLASIUS'
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation LIAISON
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'LIAISON         ') THEN
C
        MN3    = 12
        NOBMOD = 0
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation THERMOHYDRIQUE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'THERMOHYDRIQUE  ') THEN
C
        MN3    = 12
        NOBMOD = 0
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation ELECTROSTATIQUE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
C
        MN3    = 12
        NOBMOD = 0
C
        IPROP = 3
        IF (IDIM.EQ.1) IPROP = 1
        CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
        IF (IPLAC.EQ.0) THEN
          DO i=NMAT,1,-1
            LESPRO(i+1)=LESPRO(i)
          ENDDO
          NMAT=NMAT+1
          LESPRO(1)='ISOTROPE        '
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation DIFFUSION
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'DIFFUSION       ') THEN
C
        MN3    = 12
        NOBMOD = 1
C
C       Comportement par defaut
        IF (NMAT.EQ.0) THEN
          NMAT = 2
          LESPRO(1)='ISOTROPE        '
          LESPRO(2)='FICK            '
        ELSE
C
C         "Tropie"
          CALL MODTHE(MOTROP,NTROP)
          CALL PLACE(MOTROP,NTROP,IPLAC,LESPRO(1))
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,1,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            NMAT=NMAT+1
            LESPRO(1)='ISOTROPE        '
          ENDIF
C
          CALL MODDIF(MOPROP,NMOD)
          CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
          IF (IPLAC.EQ.0) THEN
            NMAT=NMAT+1
            LESPRO(NMAT)='FICK            '
          ELSE IF (MOPROP(IPLAC).EQ.'UTILISATEUR     ') THEN
            LMOEXT=.TRUE.
          ELSE IF (MOPROP(IPLAC).EQ.'SORET           ') THEN
            CHARIN = 'T       '
C           Lecture du mot-cle 'PARA_LOI' et donnees associees
            CALL LIRMOT(MOEXT,1,LEXT,0)
            IF (IERR.NE.0) RETURN
            IF (LEXT.EQ.1) THEN
              CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
              IF (IERR.NE.0) RETURN
              IF (IRET.EQ.0) THEN
                CALL LIRCHA(CHARIN,1,IRETI)
                IF (IERR.NE.0) RETURN
                IRETI=LONG(CHARIN)
                IF (IRETI.EQ.0) CALL ERREUR(643)
              ELSE
                SEGACT,mlmots
                NBCOMP = mots(/2)
                IF (NBCOMP.EQ.0) THEN
                  CALL ERREUR(964)
                ELSE
                  CHARIN = MOTS(1)
                  IRETI = LONG(CHARIN)
                  IF (IRETI.EQ.0) CALL ERREUR(643)
                ENDIF
              ENDIF
              IF (IERR.NE.0) RETURN
              IRETMA = 6
              IF (IRETI.GT.IRETMA) THEN
                INTERR(1)   = IRETMA
                MOTERR(1:8) = CHARIN(1:IRETI)
                CALL ERREUR(-353)
              ENDIF
              IRETI = MIN(IRETI,IRETMA)
              CHARIN(IRETI+1:8) = ' '
            ENDIF
            JGM = 1
            JGN = LOCOMP
            SEGINI,mlmots
            mots(1) = CHARIN
            LCPAR = mlmots
          ENDIF
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation CHARGEMENT
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'CHARGEMENT      ') THEN
C
        MN3    = 12
        NOBMOD = 0
C
        IF (NMAT.EQ.0) THEN
          CALL ERREUR(251)
          RETURN
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation METALLURGIE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'METALLURGIE     ') THEN
C
        IF (NMAT.NE.4) THEN
          CALL ERREUR(5)
          RETURN
        ENDIF
C
        MN3    = 12
        NOBMOD = 4
C
        DO i=1,4
          CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
          IF (IPLAC.EQ.0) THEN
            CALL ERREUR(1077)
            RETURN
          ENDIF
          CALL LIROBJ('LISTMOTS',LUMOTS,1,IRETOU)
          MLMOTS = LUMOTS
          SEGACT,MLMOTS*NOMOD
          IF (IPLAC.EQ.1) THEN 
            LCVAR  = MLMOTS
            MLMOT1 = MLMOTS
            NB_PHA = MLMOTS.MOTS(/2)
          ELSE IF (IPLAC.EQ.2) THEN 
            IREACT = MLMOTS
            MLMOT2 = MLMOTS
            NB_REA = MLMOTS.MOTS(/2)
          ELSE IF (IPLAC.EQ.3) THEN 
            IPRODU = MLMOTS
            MLMOT3 = MLMOTS
            NB_PRO = MLMOTS.MOTS(/2)
          ELSE IF (IPLAC.EQ.4) THEN 
            LCMAT  = MLMOTS
            NB_TYP = MLMOTS.MOTS(/2)
            DO JJ = 1,NB_TYP
             LESPRO(JJ) = MLMOTS.MOTS(JJ)
            ENDDO
          ENDIF
        ENDDO
C
C       Un type de reaction definit pour chaque reaction
        IF( NB_TYP .NE. NB_PRO ) THEN
          CALL ERREUR(1077)
          RETURN
        ENDIF
C
C       Autant de produits que de reactifs
        IF( NB_PRO .NE. NB_REA ) THEN
          CALL ERREUR(1078)
          RETURN
        ENDIF
C
CCCC    On initialise le MLMOT1 des PHASES si celui ci n'a pas ete lu
        icompt = 0
CCCC    IF(LCVAR.LE. 0) THEN
CCCC      icompt = 1
CCCC      NB_PHA = NB_REA + NB_PRO
CCCC      JGN = LOCOMP
CCCC      JGM = NB_PHA
CCCC      SEGINI, MLMOT1
CCCC      LCVAR = MLMOT1
CCCC      On remplira ensuite MATMOD() avec lespro()
CCCC      lespro(1) = MOPROP(1)
CCCC    endif
 
        DO IPHA = 1, NB_PRO
 
C         Produits differents du reactif pour chaque reaction
          IF( MLMOT2.MOTS(IPHA) .EQ. MLMOT3.MOTS(IPHA) ) THEN
            MOTERR(1:4)=MLMOT2.MOTS(IPHA)
            MOTERR(5:8)=MLMOT3.MOTS(IPHA)
            CALL ERREUR(1075)
            RETURN
          ENDIF
C
          CALL PLACE(MLMOT1.MOTS,NB_PHA,IRPHAS,MLMOT2.MOTS(IPHA))
          CALL PLACE(MLMOT1.MOTS,NB_PHA,IPPHAS,MLMOT3.MOTS(IPHA))
C           SI LE NOM DU PRODUIT OU DU REACTIF N'A PAS ETE LU DANS LE
C           MLMOT1 DES PHASES :
C             ON LE RAJOUTE        SI LCVAR N'AVAIT PAS ETE LU
C             ON EMET UNE ERREUR   SINON
          IF (IRPHAS .EQ. 0) THEN
            IF( ICOMPT .GE. 1 ) THEN
              MLMOT1.MOTS(ICOMPT) = MLMOT2.MOTS(IPHA)
              ICOMPT = ICOMPT + 1
            ELSE
              MOTERR(1:4)=MLMOT2.MOTS(IPHA)
              CALL ERREUR(1080)
              RETURN
            ENDIF
          ENDIF
          IF (IPPHAS .EQ. 0) THEN
            IF( ICOMPT .GE. 1 ) THEN
              MLMOT1.MOTS(ICOMPT) = MLMOT3.MOTS(IPHA)
              ICOMPT = ICOMPT + 1
            ELSE
              MOTERR(1:4)=MLMOT3.MOTS(IPHA)
              CALL ERREUR(1080)
              RETURN
            ENDIF
          ENDIF
 
        ENDDO
C
CCCC    On corrige la taille de MLMOT1 :
CCCC    if( icompt .ge. 1 ) then
CCCC      JGM = icompt - 1
CCCC      JGN = MLMOT1.MOTS(/1)
CCCC      SEGADJ, MLMOT1
CCCC    endif
 
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation CHANGEMENT_PHASE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
C
        MN3    = 12
        NOBMOD = 2
        JGM    = 2
C
        IF (NMAT.EQ.0) THEN
          NMAT=1
          LESPRO(1)='PARFAIT         '
        ELSE
          CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
          IF (IPLAC.EQ.0) THEN
            WRITE(*,*) 'PAS TROUVE LA FORMULATION PHASE'
            CALL ERREUR(5)
            RETURN
          ELSE IF (IPLAC.EQ.2) THEN
            JGM    = 4
            NOBMOD = 3
          ENDIF
        ENDIF
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     Formulation CONTRAINTE
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ELSE IF (LESFOR(1).EQ.'CONTRAINTE      ') THEN
C
        MN3    = 1
        NOBMOD = 2
        LACTR  = 3
C
        IF (NMAT.EQ.0) THEN
          NMAT=1
          LESPRO(1)='RELATION        '
        ELSE
          CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
          IF (IPLAC.EQ.0) THEN
            DO i=NMAT,1,-1
              LESPRO(i+1)=LESPRO(i)
            ENDDO
            NMAT=NMAT+1
            LESPRO(1)='RELATION        '
          ENDIF
        ENDIF
C
        CALL PLACE(LESPRO,NMAT,IPLAC,'ROTATION')
        IF (IPLAC.NE.0) THEN
          LACTR = IPLAC
          NOBMOD=3
          CALL MESLIR(0)
          CALL LIROBJ('POINT',IP1,1,IOK)
          IF (IDIM.EQ.3) THEN 
            NOBMOD=4
            CALL LIROBJ('POINT',IP2,1,IOK)
            IF (IERR.NE.0) RETURN
          ENDIF
        ENDIF
C
        CALL PLACE(LESPRO,NMAT,IPLAC,'DEPLACEMENT')
        IF (IPLAC.NE.0) THEN
          LACTR = IPLAC
          NOBMOD=3
          CALL LIROBJ('POINT',IP1,1,IOK)
          IF (IERR.NE.0) RETURN
        ENDIF
C
        IPGEOC=IPGEOM
        IF (LACTR.EQ.1.OR.LACTR.EQ.2) CALL MOCON2(IPGEOC,IPT7)
        IF (LACTR.EQ.3)               CALL MOCON3(IPGEOC,IPT7)
        IPGEOM=IPT7
C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ENDIF
C     ==================================================================
C     3- Lecture eventuelle des types d'ELEMENTS FINIS a utiliser
C     ==================================================================
 43   CONTINUE
C=DEB==== FORMULATION HHO ==== Cas particulier =========================
      CALL LIRMOT(mcHHO,NMHHO,iHHO,0)
      IF (IERR.NE.0) RETURN
      IF (iHHO.NE.0) THEN
        CALL REFUS
        CALL LIRCHA(chaHHO,1,IRETI)
        IF (IERR.NE.0) RETURN
        loHHO = .TRUE.
      END IF
C=FIN==== FORMULATION HHO ==============================================
C
      ITEF=0
      IF (NBTEF.EQ.0) GOTO 2
      CALL MESLIR(-178)
C
C     Lecture d'un Element Fini
 1    CONTINUE
      CALL LIRMOT(NOMTP,LNOMTP,LETEF,0)
      IF (IERR.NE.0) RETURN
      IF (LETEF.EQ.0) GOTO 2
      ITEF=ITEF+1
      LESTEF(ITEF)=NOMTP(LETEF)
      CALL MESLIR(-177)
      GOTO 1
 2    CONTINUE
C
C     Lecture d'un mot generique pour un type d'element Fini
      IF (ITEF.EQ.0) THEN
        CALL LIRMOT(MOGELT,NGELT,LETEF,0)
        IF (IERR.NE.0) RETURN
        IF (LETEF.EQ.0) GOTO 3
        ITEF=ITEF+1
        IF (MOGELT(LETEF).EQ.'BBAR') THEN
          LOBBAR=.TRUE.
        ELSE
          LONAVI=.TRUE.
          MDISC=MOGELT(LETEF)
        ENDIF
      ENDIF
 3    CONTINUE
C
C     Mot-cle 'INCO' et noms d'inconnues primales et duales
      CALL LIRMOT(MOINCO,NBDIF,LEXT,0)
C
      IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
        IF (LEXT.EQ.0) THEN
          CALL ERREUR(1093)
          RETURN
        ENDIF
        JGN   =LOCOMP
        SEGINI,MLMOT1
        IPRIDU=MLMOT1
        DO IMOT=1,JGM
          CALL LIRCHA(MOPRID,1,ILONG)
          IF (IERR.NE.0) RETURN
          MLMOT1.MOTS(IMOT) = MOPRID
        ENDDO
C
      ELSE IF (LESFOR(1).EQ.'DIFFUSION       ') THEN
        IF (LEXT.EQ.0) THEN
          MDIINC='CO      '
          MDIDUA='QCO     '
        ELSE
          MDIINC='        '
          MDIDUA='Q       '
          CHARIN='        '
          CHARRE='        '
C
C         Lecture sous forme de LISTMOTS ou MOTS
          CALL LIROBJ('LISTMOTS',MLMOTS,0,IRET)
          IF (IERR.NE.0) RETURN
          IF (MLMOTS.NE.0) THEN
            SEGACT,MLMOTS
            NBCOMP = MOTS(/2)
            IF (NBCOMP.NE.1) THEN
              CALL ERREUR(643)
              RETURN
            ENDIF
            CHARIN=MOTS(1)
            CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETE)
            IF (IERR.NE.0) RETURN
            IF (MLMOTS.NE.0) THEN
              SEGACT,MLMOTS
              NBCOMP = MOTS(/2)
              IF (NBCOMP.NE.1) THEN
                CALL ERREUR(643)
                RETURN
              ENDIF
              CHARRE=MOTS(1)
            ENDIF
          ELSE
            CALL LIRCHA(CHARIN,1,IRETI)
            IF (IERR.NE.0) RETURN
            CALL LIRCHA(CHARRE,0,IRETE)
            IF (IERR.NE.0) RETURN
          ENDIF
C
C         Verification sur la taille des inconnues
          IRETMA = 6
          IRETI = LONG(CHARIN)
          IF (IRETI.EQ.0) THEN
            CALL ERREUR(643)
            RETURN
          ENDIF
          IF (IRETI.GT.IRETMA) THEN
            INTERR(1)   = IRETMA
            MOTERR(1:8) = CHARIN(1:IRETI)
            CALL ERREUR(-353)
          ENDIF
          IRETI = MIN(IRETI,IRETMA)
          MDIINC(1:IRETI)=CHARIN(1:IRETI)
C
          IF (IRETE.GT.0) THEN
            IRETE = LONG(CHARRE)
            IF (IRETE.EQ.0) THEN
              CALL ERREUR(643)
              RETURN
            ENDIF
            IRETMA = IRETMA + 2
            IF (IRETE.GT.IRETMA) THEN
              INTERR(1)   = IRETMA
              MOTERR(1:8) = CHARRE(1:IRETE)
              CALL ERREUR(-353)
            ENDIF
            IRETE=MIN(IRETE,IRETMA)
            MDIDUA(1:IRETE)=CHARRE(1:IRETE)
          ELSE
            MDIDUA(2:1+IRETI)=MDIINC(1:IRETI)
          ENDIF
        ENDIF
C        
C       Verification des noms de primale et duale lues
        CALL VERMDI(MDIINC,MDIDUA)
        IF (IERR.NE.0) RETURN
 
C       On les place dans un LISTMOTS pour TYMODE et IVAMODE
        JGN = LOCOMP
        JGM = 2
        SEGINI,MLMOT1
        IPLRDI=MLMOT1
        MLMOT1.MOTS(1) = MDIINC
        MLMOT1.MOTS(2) = MDIDUA
C
      ELSE
        IF (LEXT.GT.0) THEN
          CALL LIROBJ('LISTMOTS',JLMOT1,1,IRET)
          IF (IERR.NE.0) RETURN
          CALL LIROBJ('LISTMOTS',JLMOT2,1,IRET)
          IF (IERR.NE.0) RETURN
          MLMOT5 = JLMOT1
          MLMOT6 = JLMOT2
          SEGACT,MLMOT5,MLMOT6
          IF (MLMOT5.MOTS(/2).NE.MLMOT6.MOTS(/2)) THEN
            CALL ERREUR(26)
            RETURN
          ENDIF
          NOBMOD = 2
        ENDIF
      ENDIF
C
C     Loi UTILISATEUR : recuperer les informations supplementaires
      IF (LMOEXT) THEN
        CALL MODEXT(MOTPRO,LCPAR,LCMAT,LCVAR,LDERI,
     &              LMOLOI,LMOPTR,LMOLIB,LMOLGB,LMOFCT,LMOLGT) 
c*        if (lmoptr.le.0) return
        IF (IERR.NE.0) RETURN
C
        IF (LMOLOI.GT.0) NOBMOD = NOBMOD + 4
        IF (LMEVIX)      NOBMOD = NOBMOD + 1
C
C       Donnee 'C_MATERIAU' manquante
        IF (LMENLX) THEN
          IF (LCMAT.EQ.0) THEN
            CALL ERREUR(641)
            RETURN
          ENDIF
        ENDIF
C
C       Ajouter le numero ou le nom de la loi utilisateur
        NMAT = NMAT + 1
        LESPRO(NMAT) = MOTPRO
      ENDIF
C     ==================================================================
C     4- Lecture de mots-cles supplementaires
C     ==================================================================
 674  CONTINUE
      CONM   = '                '
      KCONS  = 0
      NGINT  = 0
      NGRIG  = 0
      NGMAS  = 0
      NGCON  = 0
      IPTGEN = 0
      PHAM   = '        '
      IPMOD1 = 0
      klcon  = 0
      plicon = 0
      ILIE   = 0
      kbnlin = 0
      IPMOD3 = 0
      JDERIV = LDERI
 
 675  CONTINUE
      CALL LIRMOT(MOCON,NBCON,LECON,0)
      IF (LECON.EQ.0) GOTO 22
C
C     'CONS' : nom du constituant
      IF (LECON.EQ.1) THEN
        CALL LIRCHA(CONM,1,KCONS)
        IF (IERR.NE.0) RETURN
C
C     'INTE' : nombre de points d'integration dans l'epaisseur
      ELSE IF (LECON.EQ.2) THEN
        i1foi = 1
 677    CONTINUE
        LEGAUS=0
        CALL LIRMOT(MGAUSS,4,LEGAUS,0)
        IF (IERR.NE.0) RETURN
        IF (I1FOI.NE.1.AND.LEGAUS.EQ.0) GOTO 676
        CALL LIRENT(ITT,1,IRET)
        IF (IERR.NE.0) RETURN
        IF (ITT.LT.1) THEN
          INTERR(1) = ITT
          CALL ERREUR(36)
          RETURN
        ENDIF
        if (legaus.eq.0 .or. legaus.eq.1) then
c itt doit etre impair (> 0)
          IF (MOD(itt,2).EQ.0) THEN
            call erreur(607)
            return
          ENDIF
          NGINT = itt
        endif
        IF (LEGAUS.EQ.2) NGRIG = ITT
        IF (LEGAUS.EQ.3) NGMAS = ITT
        IF (LEGAUS.EQ.4) NGCON = ITT
        IF (I1FOI.EQ.1.AND.LEGAUS.EQ.0) GOTO 676
        I1FOI = 0
c INTE itt <=> INTE EPAI itt ; autres mots a ecrire
c Syntaxe de modeli non decrite :
c Si plusieurs mots de MGAUSS 
c INTE MOT1 itt1 MOT2 itt2 ... ; (couples MOTi iiti obligatoires)
        goto 677
 676  CONTINUE
C
C     'DPGE' : point support des deformations planes generalisees
      ELSE IF (LECON.EQ.3) THEN
        CALL LIROBJ('POINT',IPTGEN,1,IRET)
        IF (IERR.NE.0) RETURN
C       Transformer le point en maillage de POI1 (avec un seul element)
        CALL CRELEM(IPTGEN)
C       On verifie s'il n'a pas deja ete preconditionne.
        CALL CRECH1(IPTGEN,1)
C
C     'PHAS' : nom de phase
      ELSE IF (LECON.EQ.4) THEN
        CALL LIRCHA(PHAM,1,IRET)
        IF (IERR.NE.0) RETURN
C
C     'STAT' : 
      ELSE IF (LECON.EQ.5) THEN
        NMAT = NMAT + 1
        LESPRO(NMAT) = 'STATIONNAIRE'
        IF (IPTABS.LE.0) THEN
         CALL LIROBJ('MMODEL',IPMOD1,1,IRET)
         IF (IERR.NE.0) RETURN
        ENDIF
C
C     'LCOI'/'LCOS' : options non documentees pour le modele LIAISON ! 
C     Lecture obligatoire du modele associe (sinon options sans interet)
      ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN
        IF (LESFOR(1).NE.'LIAISON') THEN
          CALL ERREUR(251)
          RETURN
        ENDIF
        CALL LIROBJ('MMODEL  ',ipmod2,1,iret)
        IF (IERR.NE.0) RETURN
        CALL ACTOBJ('MMODEL  ',ipmod2,1)
        IF (IERR.NE.0) RETURN
        mmode2 = ipmod2
        n2 = mmode2.kmodel(/1)
        if (n2.ne.1) then
          write(ioimp,*) 'Liaison conditionnelle mal specifiee (1)'
          call erreur(5)
          return
        endif
        imode2 = mmode2.kmodel(1)
        if (imode2.formod(1).ne.'LIAISON') THEN
          write(ioimp,*) 'Liaison conditionnelle mal specifiee (2)'
          call erreur(5)
          return
        endif
        if (klcon.eq.0) then
          nlcon = 10
          segini plicon
        endif
        klcon = klcon + 1
        if (klcon.gt.nlcon) then
          nlcon = nlcon + 10
          segadj plicon
        endif
        mlicon(klcon) = ipmod2
        tlicon(klcon) = lecon
        NOBMOD=klcon
C
C     'LIBRE' : option pour les elements JOI1
      ELSE IF (LECON.EQ.8) THEN
        ILIE = 0
C
C     'LIE' : option pour les elements JOI1
      ELSE IF (LECON.EQ.9) THEN
        ILIE = 1
C
C     'NON_LOCAL' : option pour les modelisations non locales
      ELSE IF (LECON.EQ.10) THEN
        IF (LESFOR(1).NE.'MECANIQUE'.AND.LESFOR(1).NE.'POREUX') THEN
          CALL ERREUR(251)
          RETURN
        ENDIF
C
        MN3 = 14
        CALL MODNLO(MNLOCA,NLODIM)
        CALL LIRMOT(MNLOCA,NLODIM,INLOC,1)
        IF (IERR.NE.0) RETURN
        CALL LIRMOT(MNLVAR,1,INLVIA,1)
        IF (IERR.NE.0) RETURN
        CALL LIROBJ('LISTMOTS',LULVIA,1,IRET)
        IF (IERR.NE.0) RETURN
C
C     'LINE'/'CHPO'/'GAP7' :  ???
      ELSE IF (LECON.GE.11.and.LECON.LE.13) THEN
        if (kbnlin.eq.0) then
          jgn = 4
          JGM = 3
          segini opnlin
        endif
        kbnlin = kbnlin + 1
        opnlin.mots(kbnlin) = mocon(lecon)
C
C     'COMP' :
      ELSE IF (LECON.EQ.14) THEN
        NMAT = NMAT + 1
        LESPRO(NMAT) = 'COMPORTEMENT'
         CALL LIROBJ('MMODEL',IPMOD3,1,IRET)
         IF (IERR.NE.0) RETURN
C
C     'EPSI' : option desuete
      ELSE IF (LECON.EQ.15) THEN
C       CALL LIRMOT(MDERIV,6,IRET,1)
C       IF(IERR.NE.0) RETURN
C       JDERIV=IRET
cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
        MOTERR(1:40)='MODE ... EPSI ... ;'
        CALL ERREUR(1056)
        RETURN
C
      ENDIF
      GOTO 675
 22   CONTINUE
C     ==================================================================
C     5- Creation du modele MMODEL
C     ==================================================================
      IF (IPTABM.GT.0.AND.IPTABS.EQ.0.AND.IPMOD1.GT.0) GOTO 91
C
      CALL ACTOBJ('MAILLAGE',IPGEOM,1)
      MELEME = IPGEOM
      NSOU   = MELEME.LISOUS(/1)
      NSOU1  = MAX(1,NSOU)
 
C=DEB==== FORMULATION HHO ==== Premieres verifications =================
      iplHHO = 0
      IF (loHHO) THEN
C= Pour l'instant, HHO en formulation MECANIQUE !
        IF ( (NFOR.EQ.1 .AND. LESFOR(1).NE.'MECANIQUE') .OR. 
     &       (NFOR.NE.1) ) THEN
          MOTERR = 'Formulation HHO --> MECANIQUE only'
          CALL ERREUR(-385)
          CALL ERREUR(251)
          RETURN
        END IF
        IF ( .NOT. ( IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) THEN
          MOTERR = 'Formulation HHO --> 2D PLAN DEFO/CONT only'
          CALL ERREUR(-385)
c-dbg        IF ( .NOT. ( (IFOMOD.EQ.2)                   .OR.
c-dbg     &               (IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) ) THEN
c-dbg          write(ioimp,*) 'Formulation HHO --> 2D PLAN DEFO/CONT or 3D'
          CALL ERREUR(251)
          RETURN
        END IF
C= 
        CALL HHOPRE(CHAHHO,IPGEOM,iplHHO,iret)
        IF (iret.NE.0) THEN
          CALL ERREUR(iret)
          RETURN
        ENDIF
        nobHHO = NOBMOD
        NOBMOD = NOBMOD + MTYHHO
      END IF
C=FIN==== FORMULATION HHO ==============================================
 
      N1 = NSOU1
      SEGINI,MMODEL,MMODE2
      IPMODE = MMODEL
C
C     Par defaut, le nom du constituant est le pointeur sur le MMODEL
      IF (KCONS.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE
C     ==================================================================
C     6- Creation des modeles elementaires IMODEL
C     ==================================================================
      IPT1 = MELEME
      DO 10 IM = 1, NSOU1
 
        IF (NSOU.NE.0) IPT1 = MELEME.LISOUS(IM)
        ITYP1 = IPT1.ITYPEL
        NBNN  = IPT1.NUM(/1)
        NBEL  = IPT1.NUM(/2)
C +--------------------------------------------------------------------+
C | Creation du modele elementaire IMODEL                              |
C +--------------------------------------------------------------------+
        SEGINI,IMODEL
        MMODEL.KMODEL(IM) = IMODEL
C +--------------------------------------------------------------------+
C | Remplissage du IMODEL                                              |
C +--------------------------------------------------------------------+
        IMODEL.IMAMOD = IPT1
        IMODEL.CONMOD(1:16)  = CONM
        IMODEL.CONMOD(17:24) = PHAM
        DO I = 1, NFOR
          IMODEL.FORMOD(I) = LESFOR(I)
        ENDDO
        IF (NMAT.NE.0) THEN
          DO I = 1, NMAT
            IMODEL.MATMOD(I) = LESPRO(I)
          ENDDO
        ENDIF
C
C       Informations liees au MATERIAU/COMPORTEMENT
        CMATE = '        '
        IMATE = 0
        INATU = 0
        CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
        IF (IERR.NE.0) THEN
          write(ioimp,*) ' Probleme apres NOMATE'
          KERRE=251
          GOTO 99
        ENDIF
C       Modele VISCO_EXTERNE : On recupere IVIEX stocke dans INATU
        IF (LMEVIX) THEN
          IVIEX = -2 - INATU
          INATU = -2
        ENDIF
        IMODEL.CMATEE = CMATE
        IMODEL.IMATEE = IMATE
        IMODEL.INATUU = INATU
        IMODEL.IDERIV = JDERIV
C +--------------------------------------------------------------------+
C | Remplissage des couples TYMODE/IVAMOD                              |
C +--------------------------------------------------------------------+
        IF (LESFOR(1).EQ.'THERMIQUE       ') THEN
          IF (IRAYE.NE.0) THEN
            IF (ICAVIT.NE.0) THEN
              TYMODE(1)='ENTIER'
              IVAMOD(1)=NBGA
              TYMODE(2)='ENTIER'
              IVAMOD(2)=NBDANG
              IF (ISYME.EQ.1) THEN
                TYMODE(3)='POINT'
                TYMODE(4)='POINT'
                IF(IDIM.EQ.3)TYMODE(5)='POINT'
                IVAMOD(3)=IPP1
                IVAMOD(4)=IPP2
                IF(IDIM.EQ.3)IVAMOD(5)=IPP3
              ENDIF
            ELSE IF(IFACAF.NE.0) THEN
              TYMODE(1)='MAILLAGE'
              IVAMOD(1)= IPFAC1
              TYMODE(2)='MAILLAGE'
              IVAMOD(2)= IPFAC2
              TYMODE(3)='MAILLAGE'
              IVAMOD(3)= IPFAC3
              TYMODE(4)='MMODEL'
              IVAMOD(4)= IMOCO
            ENDIF
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'MECANIQUE       ') THEN
          IF (LESPRO(2)(1:8).EQ.'MODAL   '.AND.IPTBMO.GT.0) THEN
            TYMODE(1) = 'TABLE' 
            IVAMOD(1) = IPTBMO
            IF (IPMOD3.GT.0) THEN
              NOBMOD = IVAMOD(/1)
              TYMODE(NOBMOD) = 'MMODEL  '
              IVAMOD(NOBMOD) = IPMOD3
            ENDIF
          ELSE IF (JLMOT1.GT.0) THEN
            IVAMOD(1) = JLMOT1
            IVAMOD(2) = JLMOT2
            TYMODE(1) = 'LISTMOTS'
            TYMODE(2) = 'LISTMOTS'
            LCVAR = JLMOT1
            LCMAT = JLMOT2
          ELSE IF (LMOEXT) THEN
            IF (LMOLOI.GT.0) THEN
C
C             Indicateur 'LOIEXT' pour retrouver ses petits
              CALL POSCHA('LOIEXT  ',I_POS)
              TYMODE(1)='MOT     '
              IVAMOD(1)= I_POS
C
C             Pointeur vers la loi (donne par PTRLOI)
              TYMODE(2)='ENTIER  '
              IVAMOD(2)= LMOPTR
C
C             LMOLIB : Nom de la bibliotheque (sans chemin et extension)
              CALL POSCHA(LMOLIB(1:LMOLGB),I_POS)
              TYMODE(3)='MOT     '
              IVAMOD(3)= I_POS
C
C             LMOFCT : Nom de la fonction (dans la bibliotheque)
              CALL POSCHA(LMOFCT(1:LMOLGT),I_POS)
              TYMODE(4)='MOT     '
              IVAMOD(4)= I_POS
            ENDIF
 
            IF (LMEVIX) THEN
              IMODEL.TYMODE(NOBMOD) = 'IVIEX   '
              IMODEL.IVAMOD(NOBMOD) = IVIEX
            ENDIF
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'CONTACT         ') THEN
          TYMODE(1)='MAILLAGE'
          IVAMOD(1)=IPGEO1
          TYMODE(2)='MAILLAGE'
          IVAMOD(2)=IPGEO2
          TYMODE(3)='ENTIER'
          IVAMOD(3)=ITCO
          IF (NOBMOD.EQ.4) THEN
            TYMODE(4)='RIGIDITE'
            IVAMOD(4)=IPRIG
          ENDIF
          IF(ITCO.EQ.3) THEN
            SEGINI,IMODE1
            MMODE2.KMODEL(IM)=IMODE1
            IMODE1.IMAMOD=IPGEOY
            IMODE1.TYMODE(1)='MAILLAGE'
            IMODE1.IVAMOD(1)=IPGEO2
            IMODE1.TYMODE(2)='MAILLAGE'
            IMODE1.IVAMOD(2)=IPGEO1
            IMODE1.TYMODE(3)='ENTIER'
            IMODE1.IVAMOD(3)=1
            IF (NOBMOD.EQ.4) THEN
              IMODE1.TYMODE(4)='RIGIDITE'
              IMODE1.IVAMOD(4)=IPRIG
            ENDIF
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES   ') THEN
          IF (NOBMOD.GT.0) THEN
            TYMODE(1) = 'LISTMOTS'
            IVAMOD(1) = OPNLIN
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'LIAISON         ') THEN
          if (klcon.gt.0) THEN
            do i = 1, klcon
              if (tlicon(i).eq.6) TYMODE(noblia+i) = 'CONDINFE'
              if (tlicon(i).eq.7) TYMODE(noblia+i) = 'CONDSUPE'
              IVAMOD(noblia+i) = mlicon(i)
            enddo
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'MELANGE         ') THEN
          IF (IPMMEL.GT.0) THEN
            MMODE1 = IPMMEL
            N1MEL  = MMODE1.KMODEL(/1)
            KBMOD  = 0
            DO I = 1,N1MEL
              IMODE1 = MMODE1.KMODEL(I)
              IF (IMODE1.IMAMOD.EQ.IMAMOD) THEN
                IF (KBMOD.EQ.0) THEN
                  IMODE2 = IMODE1
                ELSE
                  IF (IMODE1.FORMOD(1).NE.IMODE2.FORMOD(1).OR.
     &                IMODE1.IMATEE.NE.IMODE2.IMATEE) GOTO 117
                ENDIF
                KBMOD = KBMOD + 1
                TYMODE(KBMOD) = 'IMODEL'
                IVAMOD(KBMOD) = IMODE1
              ENDIF
 117          CONTINUE
            ENDDO
C
            IF (KBMOD.EQ.0) THEN
              CALL ERREUR(21)
              RETURN
            ENDIF
C
            IF (KBMOD.NE.N1MEL) THEN
              NOBMOD = KBMOD
              SEGADJ,IMODEL
            ENDIF
C
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'DIFFUSION       ') THEN
          JGN = LOCOMP
          JGM = 2
          SEGINI,MLMOT1
          TYMODE(1)='LISTMOTS'
          IVAMOD(1)=iplrdi
          IF (LMOLOI.GT.0) THEN
C           Indicateur 'LOIEXT' pour retrouver ses petits
            CALL POSCHA('LOIEXT  ',I_POS)
            TYMODE(2)='MOT     '
            IVAMOD(2)= I_POS
 
C           Pointeur vers la loi (donne par PTRLOI)
            TYMODE(3)='ENTIER  '
            IVAMOD(3)= LMOPTR
 
C           LMOLIB : Nom de la bibliotheque (sans chemin et extension)
            CALL POSCHA(LMOLIB(1:LMOLGB),I_POS)
            TYMODE(4)='MOT     '
            IVAMOD(4)= I_POS
 
C           LMOFCT : Nom de la fonction (dans la bibliotheque)
            CALL POSCHA(LMOFCT(1:LMOLGT),I_POS)
            TYMODE(5)='MOT     '
            IVAMOD(5)= I_POS
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'METALLURGIE     ') THEN
C         LCVAR : les noms des phases
          IVAMOD(1) = LCVAR
          TYMODE(1) = 'LISTMOTS'
C         IREACT : les noms des reactifs
          IVAMOD(2) = ireact
          TYMODE(2) = 'LISTMOTS'
C         IPRODU : les noms des produits
          IVAMOD(3) = iprodu
          TYMODE(3) = 'LISTMOTS'
C         LCMAT : les noms des types de reactions
          IVAMOD(4) = LCMAT
          TYMODE(4) = 'LISTMOTS'
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
C
C         Maillage support de mult. de Lagrange IPGEO2 & IPGEO3
          CALL IMPP1(IPT1,IPGEO2,IPGEO3,LESPRO(1))
C
C         IPRIDU : les noms des variables primales et duales
          IVAMOD(1) = IPRIDU
          TYMODE(1) ='LISTMOTS'
          IVAMOD(2) = IPGEO2
          TYMODE(2) ='MAILLAGE'
          IF (LESPRO(1).EQ.'SOLUBILITE      ') THEN
            IVAMOD(3) = IPGEO3
            TYMODE(3) ='MAILLAGE'
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ELSE IF (LESFOR(1).EQ.'CONTRAINTE      ') THEN
          TYMODE(1)='ENTIER'
          IVAMOD(1)=LACTR
          TYMODE(2)='MAILLAGE'
          IVAMOD(2)=IPGEOC 
          IF (LACTR.EQ.1) THEN
            TYMODE(3)='POINT'
            IVAMOD(3)=IP1    
            IF (IDIM.EQ.3) THEN
              TYMODE(4)='POINT'
              IVAMOD(4)=IP2    
            ENDIF
          ELSE IF (LACTR.EQ.2) THEN
            TYMODE(3)='POINT'
            IVAMOD(3)=IP1    
          ENDIF
C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ENDIF
 
C=DEB==== FORMULATION HHO ==== Remplissage de donnees ==================
C                  NEFMOD = HHO_NUM_ELEMENT pour tous les elements =====
        IF (loHHO) THEN
          CALL HHOPRM(chaHHO,imodel,nobHHO,iplHHO,KERRE)
          IF (KERRE.NE.0) GOTO 99
          imodel.NEFMOD = HHO_NUM_ELEMENT
          GOTO 101
        ENDIF
C=FIN==== FORMULATION HHO ==============================================
C +--------------------------------------------------------------------+
C | Determination de la valeur de NEFMOD pour IMODEL                   |
C +--------------------------------------------------------------------+
        IF (ITYP1.EQ.48) THEN
C         NEPAPA = si EF specifique demande -> on utilise ses inconnues
          NEPAPA = 0
          IMODEL.NEFMOD = 259
          IF (ITEF.GT.0) THEN
            DO i=1,ITEF
              CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
              IF (MELE.NE.0) NEPAPA = MELE
            ENDDO
          ENDIF
          IF (NEPAPA.EQ.0) THEN
c           2D : on choisit les inconnues du QUA4 pour toute formulation
            IF (IDIM.EQ.2) THEN
              NEPAPA=8
c           3D : on choisit les inconnues du CUB8 pour toute formulation
            ELSE IF (IDIM.EQ.3) THEN
              NEPAPA=14
            ELSE
              CALL ERREUR(610)
              RETURN
            ENDIF
          ENDIF
          GOTO 101
        ENDIF
C
        NEFMOD = 0
        IF (ITEF.NE.0) THEN
          DO i=1,ITEF
            IF (LONAVI) THEN
              CALL MODE25(MDISC,ITYP1,MELE)
            ELSE
              IF (LOBBAR) CALL MODE20(ITYP1,LESTEF(I))
              CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
            ENDIF
            IF (MELE.EQ.0) GOTO 9
            IF (LONAVI)    GOTO 6
            MEGE=NUMGEO(MELE)
            IF (MEGE.EQ.0) GOTO 9
            IF (MEGE.EQ.ITYP1) GOTO 6
c kich cas du POI1
            IF (ITYP1.EQ.1) GOTO 6
          ENDDO
C
  9       CONTINUE
          KERRE=16
          GOTO 99
C
  6       CONTINUE
          NEFMOD=MELE
C         Cas particulier pour les elements polygonaux
          IF (ITYP1.EQ.32) NEFMOD=MELE+NBNN-3
C       Affectation des elements finis de maniere automatique
        ELSE
C         Formulation DARCY
          IF (LESFOR(1).EQ.'DARCY') THEN
            IF (ITYP1.EQ. 3) NEFMOD=143
C           IF (ITYP1.EQ. 4) NEFMOD=99
C           IF (ITYP1.EQ. 8) NEFMOD=100
C           IF (ITYP1.EQ.23) NEFMOD=101
C           IF (ITYP1.EQ.16) NEFMOD=102
C           IF (ITYP1.EQ.14) NEFMOD=103
            IF (ITYP1.EQ. 7) NEFMOD=99
            IF (ITYP1.EQ.11) NEFMOD=100
            IF (ITYP1.EQ.35) NEFMOD=101
            IF (ITYP1.EQ.34) NEFMOD=102
            IF (ITYP1.EQ.33) NEFMOD=103
C         Formulation CONTACT
          ELSE IF (LESFOR(1).EQ.'CONTACT') THEN
            NEFMOD=ITYP1
            IF      (ITCO.EQ.0) THEN
              IF (IDIM.EQ.2) NEFMOD=261
              IF (IDIM.EQ.3) NEFMOD=262
            ELSE IF (IFRT.EQ.1) THEN
              IF (IDIM.EQ.2) NEFMOD=107
              IF (IDIM.EQ.3) NEFMOD=165
            ENDIF
C         Formulation POREUX
          ELSE IF (LESFOR(1).EQ.'POREUX') THEN 
            IF (ITYP1.EQ. 6) NEFMOD=79
            IF (ITYP1.EQ.10) NEFMOD=80
            IF (ITYP1.EQ.15) NEFMOD=81
            IF (ITYP1.EQ.24) NEFMOD=82
            IF (ITYP1.EQ.17) NEFMOD=83
            IF (ITYP1.EQ.29) NEFMOD=108
            IF (ITYP1.EQ.30) NEFMOD=109
            IF (ITYP1.EQ.31) NEFMOD=110
C         Autres formulations
          ELSE
            CALL PLACE(MOTEF,NBTEF,NELE,NOMS(ITYP1))
            IF (NELE.EQ.0) GOTO 8
            CALL PLACE(NOMTP,LNOMTP,MELE,MOTEF(NELE))
            IF (MELE.NE.0) GOTO 7
C
  8         CONTINUE
C           Cas particulier dimension 1 : [M-T]1D[2-3]
            IF (IDIM.EQ.1) THEN
              DO IE=1,NBTEF
                CALL PLACE(NOMTP,LNOMTP,MELE,MOTEF(IE))
                MEGE=NUMGEO(MELE)
                IF (MEGE.EQ.ITYP1) GOTO 7
              ENDDO
            ENDIF
C
            KERRE=16
            GOTO 99
C
  7         CONTINUE
            NEFMOD=MELE
          ENDIF
        ENDIF
C
        IF (NEFMOD.EQ.0) THEN
          KERRE=16
          GOTO 99
        ENDIF
C +--------------------------------------------------------------------+
C | Verifications supplementaires entre type d'EF et formulation       |
C +--------------------------------------------------------------------+
 101    CONTINUE
        MFR = NUMMFR(NEFMOD)
CC        WRITE(ioimp,*)'  ITYP1  =',ITYP1,NEFMOD,MFR
C
        IF (LESFOR(1).EQ.'THERMIQUE       ') THEN
          IF (IPHAS.NE.0) THEN
c    test que les elements sont lineaires
            IPT4 = IMODEL.IMAMOD
            ITT  = IPT4.ITYPEL
            IF (KDEGRE(ITT) .GT. 2) THEN
              KERRE=982
              GOTO 99
            ENDIF
          ENDIF
 
        ELSE IF ((LESFOR(1).EQ.'MECANIQUE       ')  .OR.
     &           (LESFOR(1).EQ.'POREUX          ')) THEN
C
C         Elements polygonaux
          IF ((ITYP1.EQ.32).AND.(NBNN.GT.14)) THEN
            INTERR(1) = 32
            KERRE=52
            GOTO 99
          ENDIF
C
C         Cas du materiau unidirectionnel
          IF (IMATE.EQ.4) THEN
C  Cas des cerces : sans interet !
            IF (MFR.EQ.27) THEN
              KERRE=251
              GOTO 99
            ENDIF
C  Cas de la plasticite
            IF (INATU.NE.0) THEN
C
C             Comportement ACIER_UNI OK si massif bidim ou coque tridim
              IF (INATU.EQ.40)THEN
                IF ((MFR.NE.1.OR.IFOUR.GT.0).AND.
     &             ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN
                  KERRE=251
                  GOTO 99
                ENDIF
C             Autres comportements OK si COQ2 et massif
              ELSE IF (NEFMOD.NE.44.AND.MFR.NE.1) THEN
                KERRE=251
                GOTO 99
              ENDIF
            ENDIF
          ENDIF
C
C         Cas du materiau 'ZONE_COHESIVE'
          IF ((IMATE.EQ.12).AND.(MFR.NE.77)) THEN
            KERRE=251
            GOTO 99
          ENDIF
C
C  Cas du modele section : on n'autorise pour le moment que TIMO
          IF (CMATE.EQ.'SECTION'.AND.NEFMOD.NE.84) THEN
            KERRE=251
            GOTO 99
          ENDIF
C
C         Comportement GURSON OK en 3D, axisymetrique ou deformations planes
          IF (INATU.EQ.38) THEN
            IF ( IFOUR.NE.0 .AND. IFOUR.NE.2 .AND. IFOUR.NE.-1 ) THEN
              MOTERR(1:8)='GURSON'
              MOTERR(9:16)='MECANIQU'
              INTERR(1) = IFOUR
              KERRE=81
              GOTO 99
            ENDIF
          ENDIF
C
C         Comportement ISS_GRANGE OK qu'en 3D
          IF (INATU.EQ.151 .AND. IFOUR.NE.2) THEN
            INTERR(1) = IFOUR
            KERRE=709
            GOTO 99
          ENDIF
C
C  Le modele RUP_THER n'est utilisable qu'en 3D
          IF (INATU.EQ.152 .AND. IFOUR.NE.2) THEN
            INTERR(1) = IFOUR
            KERRE=709
            GOTO 99
          ENDIF
C
C  Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1
          IF (INATU.EQ.34 .AND. IFOUR.NE.2 .AND. MFR.EQ.75) THEN
            INTERR(1) = IFOUR
            KERRE=709
            GOTO 99
          ENDIF
C
C.. Restrictions en formulation 'MECANIQUE' avec une loi de
C   comportement non lineaire externe
C   Rappel : LMOEXT exprime la condition (NFOR.EQ.1) ET
C     (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
          IF ( LMOEXT ) THEN
C           En formulation 'MECANIQUE', les lois non lineaires externes
C           n'autorisent qu'une seule composante de temperature
C           => incompatibilite avec des modeles de coques n'ayant pas
C           de points d'integration dans l'epaisseur (trois composantes
C           dans ce cas, 'TINF', 'T   ' et 'TSUP')
C           Le test ci-dessous est coherent avec celui de IDTEMP.
            IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND.
     &           (NGINT.EQ.0) ) THEN
              KERRE=951
              GOTO 99
            ENDIF
C           Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour
C           l'instant qu'aux elements massifs, avec option de calcul 3D
C           Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL'
            IF ( LMEVIX ) THEN
              IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN
                KERRE = 950
              ELSE IF ( IVIEX.NE.1 ) THEN
                KERRE = 958
              ELSE
                KERRE = 0
              ENDIF
              IF (KERRE.NE.0) GOTO 99
            ENDIF
          ENDIF
C
        ELSE IF (LESFOR(1).EQ.'DIFFUSION       ') THEN
          IF (IFOUR.EQ.2 .AND. NEFMOD.GE.4 .AND. NEFMOD.LT.11) THEN
            KERRE=16
            GOTO 99
          ENDIF
          IF (MFR.NE.1  .AND. MFR.NE.3  .AND. MFR.NE.5  .AND.
     &        MFR.NE.7  .AND. MFR.NE.9  .AND. MFR.NE.73 .AND.
     &        MFR.NE.27 .AND. MFR.NE.75 .AND. MFR.NE.79 ) THEN
            KERRE=16
            GOTO 99
          ENDIF
C
        ENDIF
C +--------------------------------------------------------------------+
C | Remplissage INFMOD et INFELE du IM-eme modele elementaire IMODEL   |
C +--------------------------------------------------------------------+
        IF (NGINT.NE.0.AND.NEFMOD.NE.28) THEN
          KERRE=608
          GOTO 99
        ENDIF
        INFMOD(1) = NGINT
 
C (fdp) Pour les elements JOI1 seulement, on stocke -1*ILIE dans INFMOD(9)
        IF (ILIE.NE.0) THEN
          IF (NEFMOD.NE.265) THEN
            KERRE=19
            GOTO 99
          ENDIF
          INFMOD(9) = -1 * ILIE
        ENDIF
*  AM  cas non-local
        IF (INLOC.NE.0) THEN
          INFMOD(13) = -1*INLOC
          INFMOD(14) = LULVIA
        ENDIF
 
C  Initialisation du infele et des segments d'integration
        INFELE(2) = NGINT
        INFELE(3) = NGMAS
        INFELE(4) = NGCON
        INFELE(6) = NGRIG
 
C  Cas particulier des relations de conformite pour les SURE
        IF (ITYP1.EQ.48) THEN
          IMODEL.INFELE( 1) = NEFMOD
          IMODEL.INFELE(13) = NUMMFR(NEPAPA)
          IMODEL.INFELE(14) = 48
        ENDIF
C
        CALL PRQUOI(IMODEL)
        IF (IERR.NE.0) RETURN
C +--------------------------------------------------------------------+
C | Initialisation des nomid (NOMS des composantes)                    |
C +--------------------------------------------------------------------+
C       Cas particulier des relations de conformite pour les SURE
c       on recupere les noms de composantes 'DEPLACEM' et 'FORCES'
c       des elements parents (NEPAPA => QUA4 ou CUB8)
        IF (ITYP1.EQ.48) THEN
          NEPOLD=IMODEL.NEFMOD
          IMODEL.NEFMOD=NEPAPA
        ENDIF
        CALL INOMID(IMODEL,LCVAR,LCMAT,LCMAF,LCPAR)
        IF (IERR.NE.0) RETURN
        IF (ITYP1.EQ.48) THEN
          IMODEL.NEFMOD=NEPOLD
        ENDIF
 
C       Test CLEMENT entre INFELE(16) et la dimension du NOMID des DEFORMATIONS
C       ATTENTION (celui des CONTRAINTES peut contenir une info en plus sur les MODES en fourier...)
        nomid = imodel.LNOMID(5)
        IF (nomid.GT.0) THEN
          imodel.INFELE(16) = nomid.LESOBL(/2) + nomid.LESFAC(/2)
        ELSE
          imodel.INFELE(16) = 0
        ENDIF
C +--------------------------------------------------------------------+
C | Quelques verifications supplementaires                             |
C +--------------------------------------------------------------------+
 
C=DEB==== FORMULATION HHO ==== Verification des noms primales/duales====
        IF (loHHO) THEN
          nomid1 = imodel.LNOMID(1)
          nomid2 = imodel.LNOMID(2)
c*          SEGACT,nomid1,nomid2
          n_z1 = nomid1.LESOBL(/2)
          n_z2 = nomid2.LESOBL(/2)
          IF (n_z1.EQ.0 .OR. n_z1.NE.n_z2) THEN
            write(ioimp,*) 'MODELI HHO: PRIMAL/DUAL number incorrect'
            CALL ERREUR(5)
            RETURN
          END IF
          DO i = 1, n_z1
            CALL VERMDI(nomid1.LESOBL(i),nomid2.LESOBL(i))
            IF (IERR.NE.0) RETURN
          END DO
          n_z1 = nomid1.LESFAC(/2)
          n_z2 = nomid2.LESFAC(/2)
          IF (n_z1.NE.0 .OR. n_z2.NE.0) THEN
            write(ioimp,*) 'MODELI HHO: LESFAC incorrect'
            CALL ERREUR(5)
            RETURN
          END IF
        END IF
C=FIN==== FORMULATION HHO ==============================================
 
        mfr2 = INFELE(13)
        IF (FORMOD(1).EQ.'CONTRAINTE') mfr2 = 0
        IPMO = IMODEL
        CALL COTEMO(IPMO,MFR2)
        IF (IERR.NE.0) RETURN
C +--------------------------------------------------------------------+
C | Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)  |
C | Ce point n'est pris en compte que si cela est necessaire           |
C +--------------------------------------------------------------------+
        CALL INFDPG(mfr2,IFOUR,LOGRE,ndpge)
        IF (LOGRE) THEN
C Erreur si ce point support n'est pas fourni avec le mot-cle GENE.
          IF (IPTGEN.EQ.0) THEN
            CALL ERREUR(925)
            RETURN
          ENDIF
          imodel.IPDPGE = IPTGEN
        ELSE
          IF (IPTGEN.NE.0) THEN
            write(ioimp,*) 'Mot-cle GENE + Point ignores...'
          ENDIF
          IMODEL.IPDPGE = 0
        ENDIF
 
        SEGACT,IMODEL*NOMOD
 
 10   CONTINUE
C ****************************************************************
C  Fin de la boucle (10) sur les maillages elementaires de IPGEOM
C ****************************************************************
C     Contact symetrique : tout mettre dans un meme modele
      n1o = kmodel(/1)
      n1 = n1o
      do i = 1, n1o
        imode1 = mmode2.kmodel(i)
        if (imode1.ne.0) then
          n1 = n1+1
        endif
      enddo
* On a trouve du contact :
      if (n1.gt.n1o) then
        segadj mmodel
        nsou1 = n1
        do i = 1, n1o
          imode1 = mmode2.kmodel(i)
          if (imode1.ne.0) then
            kmodel(n1)=imode1
            n1=n1-1
            imodel=kmodel(i)
            imode1.nefmod=nefmod
            imode1.conmod=conmod
            do ip=1,infmod(/1)
              imode1.infmod(ip)=infmod(ip)
            enddo
            do ip=1,formod(/2)
              imode1.formod(ip)=formod(ip)
            enddo
            do ip=1,matmod(/2)
              imode1.matmod(ip)=matmod(ip)
            enddo
            imode1.ipdpge=ipdpge
            imode1.cmatee=cmatee
            imode1.imatee=imatee
            imode1.inatuu=inatuu
            imode1.ideriv=ideriv
            do ip=1,lnomid(/1)
              imode1.lnomid(ip)=lnomid(ip)
            enddo
            do ip=1,infele(/1)
              imode1.infele(ip)=infele(ip)
            enddo
            do ip=1,tymode(/2)
              imode1.tymode(ip)=tymode(ip)
            enddo
          endif
        enddo
        n1 = nsou1
      endif
      segsup mmode2
 
      IPMODE=MMODEL
 
C TABLE DE MODES            --------------------------------
      IF (IPTBDM.GT.0) THEN
        MMODEL = IPMODE
        imodel = kmodel(1)
        segact imodel*mod
        call dimen7(iptbdm,idimen)
        NBNN = 1
        NBELEM = idimen - 2
        NBSOUS = 0
        NBREF = 0
        SEGINI IPT8
        IPT8.ITYPEL = 1
 
        IKM = 0
        DO ik = 1,NBELEM
        IKM = IKM + 1
        IVALIN=IKM
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='ENTIER  '
        CHARIN='        '
        TYPOBJ='TABLE'
        CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
     &                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
        IF (IERR.NE.0) RETURN
        IPTMOD = IOBRE
        IVALIN=0
        XVALIN=REAL(0.D0)
        LOGIN=.TRUE.
        IOBIN=0
        TAPIND='MOT     '
        TYPOBJ='POINT'
        CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
     &                  IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)        
        IF (IERR.NE.0) RETURN
 
        ipt8.num(1,ikm) = iobre
        ENDDO
 
        NBELEM = IKM
        segadj IPT8
        imamod = ipt8
 
      ENDIF 
C fin TABLE DE MODES        --------------------------------
C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd
  91  CONTINUE
      IF (IPTABS.GT.0.OR.IPMOD1.GT.0) THEN
c verification formulation
        IF (ipmod1.gt.0) THEN
          CALL ACTOBJ('MMODEL',IPMOD1,1)
          IF (IERR.NE.0) RETURN
          mmode1 = ipmod1
          imode1 = mmode1.kmodel(1)
          do jj=1,NFOR
            if (imode1.formod(jj).ne.LESFOR(JJ)) then
              call erreur(21)
              return
            endif   
          enddo
        ENDIF
c duplique le modele cree       
        if (ipmod1.le.0) ipmod1 = ipmode
C modele : pointer le modele elementaire approprie
        IF (iptabm.eq.0) THEN
          MMODE1 = ipmod1
          DO im = 1,kmodel(/1)
            imodel = kmodel(im)
            segact imodel*mod
            nobmod = ivamod(/1)
            nobmod = nobmod + 1
            nfor = formod(/2)
            nmat = matmod(/2)
            mn3 = infmod(/1)
            segadj imodel
            kbmod = 0
            do im1 = 1,MMODE1.KMODEL(/1)
              imode1 = mmode1.kmodel(im1)
              imomo = imode1
              lostat = .true.
 
C  criteres de verif assez sommaires ...
              if (imode1.nefmod.eq.nefmod.and.
     &            imode1.imamod.ne.imamod.and.
     &           (imode1.matmod(/2).eq.matmod(/2).or.
     &            imode1.matmod(/2).eq.(matmod(/2)-1)).and.
     &            imode1.formod(/2).eq.formod(/2)) then
                do lmo = 1,formod(/2)
                 if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false.
                enddo
                do lmo = 1,imode1.matmod(/2)
                 if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false.
                enddo
              else
                lostat = .false.
              endif
              if (lostat.and.formod(1).eq.'MELANGE') then
C  verifs supplementaires : les modeles de ivamod sont ils bien construi
                lomela = .true.
                if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false.
                if (imode1.ivamod(/1).gt.0) then
                  do ivm3 = 1,imode1.ivamod(/1)
                    IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
                      imode3 = imode1.ivamod(ivm3)
                      segact imode3
                    ENDIF
                  enddo
                endif
                IF (nobmod.gt.1) THEN
                  do ivm1 = 1,(nobmod-1)
                    if (tymode(ivm1).eq.'IMODEL  ') then
                      imode2 = ivamod(ivm1)
                      segact imode2
                      if (imode2.ivamod(/1).ge.1) then
                        do ivm2 = 1,imode2.ivamod(/1)
                          if (imode2.tymode(ivm2).eq.'IMODEL') then
                            imode4 = imode2.ivamod(ivm2)
                            segact imode4
                            if (imode1.ivamod(/1).ge.1) then
                              do ivm3 = 1,imode1.ivamod(/1)
                               IF (imode1.tymode(ivm3).eq.'IMODEL') THEN
                                  imode3 = imode1.ivamod(ivm3)
                                  lostat = .true.
C  criteres de verif assez faibles ...
                                 if (imode3.nefmod.eq.imode4.nefmod.and.
     &               imode3.imamod.eq.imode4.imamod.and.
     &               imode3.matmod(/2).eq.imode4.matmod(/2).and.
     &               imode3.conmod(17:24).eq.imode4.conmod(17:24).and.
     &               imode3.formod(/2).eq.imode4.formod(/2)) then
                                    do lmo = 1,imode4.formod(/2)
          if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false.
                                    enddo
                                    do lmo = 1,imode4.matmod(/2)
          if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false.
                                    enddo
                                  else
                                    lostat = .false.
                                  endif
                                  if (lostat) goto 75
                                ENDIF
                              enddo
                            else
                              lostat = .false.
                            endif
                          endif
                        enddo
                      else
                        lomela = .false.
                      endif
 75                   lomela = lomela.and.lostat
                    endif
                  enddo
                ENDIF
                lostat = lomela
                do ivm3 = 1,imode1.ivamod(/1)
c                 imode1 = imomo
                  IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
                    imode3 = imode1.ivamod(ivm3)
                  ENDIF
                enddo
              endif
              if (lostat) then
                kbmod = kbmod + 1
                tymode(nobmod) = 'IMODEL'
                ivamod(nobmod) = imomo
                goto 79
              endif
            enddo
C *** ca se passe mal
            if (kbmod.ne.1) then
              write(ioimp,*) ' STATIO EN DEFAUT voir notice ',kbmod,im
              KERRE=251
              GOTO 99
            endif
C ***
 79         CONTINUE
          ENDDO
        ENDIF
 
C : table : dupliquer modele elementaire et pointer
        if (iptabm.gt.0) then
          call modsta(ipmode,iptabm,ipmod1)
        endif
 
      ENDIF
C  fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd
 
      if (plicon.ne.0) segsup,plicon
 
C  Ecriture de l'objet MODELE cree
      CALL ACTOBJ('MMODEL  ',IPMODE,1)
      CALL ECROBJ('MMODEL  ',IPMODE)
      RETURN
C     ==================================================================
C     7- Traitement des erreurs
C     ==================================================================
 99   CONTINUE
      CALL ERREUR(KERRE)
C
      DO im = 1, kmodel(/1)
        imodel = kmodel(im)
        IF (imodel.NE.0) SEGSUP,imodel
      ENDDO
      SEGSUP,MMODEL
      if (plicon.ne.0) segsup,plicon
 
      END