Télécharger lektab.eso

Retour à la liste

lektab
C LEKTAB    SOURCE    CB215821  24/04/12    21:16:35     11897          
      SUBROUTINE LEKTAB(MTB,NOMI,IPOINT)
C---------------------------------------------------------------------
C Ce sous-programme recherche dans la table MTABLE l'indice NOMI.
C NOMI doit se trouver dans la liste LISTS. Le soustype de la table
C est controlé par l'opérateur appelé.
C
C Si l'objet trouvé à l'indice NOMI est du bon type, son pointeur
C IPOINT est renvoyé au sous-programme appelant.
C Sinon, il est calculé et placé à l'indice NOMI de la table MTABLE
C et son pointeur IPOINT est renvoyé au sous-programme appelant.
C---------------------------------------------------------------------
C
C---------------------------
C Paramètres Entrée/Sortie :
C---------------------------
C
C E/  MTABLE : Pointeur de la table contenant l'information cherchée
C E/  NOMI   : Indice de la table où on cherche une donnée
C  /S IPOINT : Pointeur sur l'objet trouvé ou ajouté à l'indice NOMI
C              En cas de problème IPOINT est nul.
C
C---------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC SMCOORD
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
      POINTEUR MELEMQ.MELEME
-INC SMMODEL
-INC SMTABLE
      POINTEUR IPTR.MTABLE,MTABM.MTABLE
      CHARACTER*8 MOTYP,TYPOBJ
      CHARACTER*72 ICHAI,CHARRE
      LOGICAL IRETL,IBOOL,LOGRE,VLOGI
      REAL*8 XRET,XVALRE
*
      CHARACTER*(*) NOMI
      CHARACTER*8 NOMC,NOMDOM
      PARAMETER (NBO=60)
      CHARACTER*8 LISTS(NBO),TYPE,NOM,MIND,MINDS,TYPI,MNEFMD
      DATA LISTS/'MATESI  ','XXVOLUM ','XXCOTE  ','XXDIAME ','XXDIEMIN',
     &     'MATC    ','XXPSOML ','INCO    ','KIZG    ','KOPT    ',
     &     'PASDETPS','DOMAINE ','DOMZ    ','EQEX    ','EQPR    ',
     &     'XXDIAGSI','KIZG1   ','KIZD    ','SOMMET  ','CENTRE  ',
     &     'FACE    ','FACEL   ','FACEP   ','XXNORMAF','XXSURFAC',
     &     'MAILLAGE','CETR&FAC','MATRIS  ','ELTFA   ','XXNORMAE',
     &     'KIZA    ','ARGS    ','SOMCEN  ','CESOCE  ','NORMALEV',
     &     'OENVELOP','XXMSOMME','MATEEF  ','ELKONV  ','XXDIAGFA',
     &     'M1BULLE ','CENTREP0','ELTP1NC ','CENTREP1','VOLUMAC ',
     &     'MACRO   ','QUADRATI','MACRO1  ','XXDXDY  ','MSOMMET ',
     &     'MMAIL   ','MLGVNIMP','MLGVTIMP','ENVELOPP','FACEL2  ',
     &     'QUAF    ','XXCTREP1','XXCTREP0','MAILFACE','ARETE   '/
C
C- Initialisations
C
C     write(6,*)'DEBUT LEKTAB MTB,NOMI=',MTB,NOMI
      MTABLE = ABS(MTB)
 
      CALL ECRCHA('INEFMD  ')
      CALL ECROBJ('TABLE',MTABLE)
      CALL EXIS
      CALL LIRLOG(VLOGI,1,IRET)
        IF(IRET.EQ.0)THEN
        write(6,*)'LEKTAB : Pb avec INEFMD'
        go to 5000
        ENDIF
      IF(VLOGI)THEN
       TYPE=' '
       CALL ACMO(MTABLE,'INEFMD  ',TYPE,INEFMD)
       IF(TYPE.EQ.'MOT')THEN
         CALL ACMM(MTABLE,'INEFMD  ',MNEFMD)
         IF(MNEFMD.EQ.'LINE')THEN
         INEFMD=1
         ELSEIF(MNEFMD.EQ.'MACRO')THEN
         INEFMD=2
         ELSEIF(MNEFMD.EQ.'QUAF    ')THEN
         INEFMD=3
         ELSEIF(MNEFMD.EQ.'LINB    ')THEN
         INEFMD=4
         ELSEIF(MNEFMD.EQ.'ISOQ    ')THEN
         INEFMD=5
         ELSE
         INEFMD=0
         ENDIF
       ELSEIF(TYPE.EQ.'ENTIER')THEN
         CALL ACME(MTABLE,'INEFMD  ',INEFMD)
       ELSE
         write(6,*)'LEKTAB : Pb avec INEFMD'
         GO TO 5000
       ENDIF
      ELSE
      INEFMD=0
      ENDIF
 
      KECR=0
      IF(MTB.LT.0)KECR=1
      NOM    = NOMI
      IPOINT = 0
      I211   = 0
      I221   = 0
      I231   = 0
      I241   = 0
      I251   = 0
      I271   = 0
      I291   = 0
      I301   = 0
      I331   = 0
      I341   = 0
      I371   = 0
      I391   = 0
      I501   = 0
      I511   = 0
      I1201  = 0
      I541   = 0
      I542   = 0
      I551   = 0
      I591   = 0
C
C- Détermination du cas à traiter et ventilation
C
CG      SEGACT MTABLE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IPREC=0
      ISTOK=0
      IF (TYPE.EQ.'DOMAINE ') THEN
c
c  traitement special pour le cas ou PRECONDI n'existait pas
c
               ICHAI(1:8)='PRECONDI'
               MOTYP='MOT'
               TYPOBJ=' '
               CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:8),IBOOL
     $         ,IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
               IRETL=.TRUE.
               IF(TYPOBJ.EQ.'        ') IRETL = .FALSE.
      IF(.NOT.IRETL)CALL ECME(MTABLE,'PRECONDI',1)
      CALL ACME(MTABLE,'PRECONDI',IPREC)
      ENDIF
      ISTOK=IPREC
 
 
      CALL OPTLI(IP,LISTS,NOM,NBO)
C     write(6,*)' LEKTAB NOM=',nom
      IF (IP.EQ.0) THEN
         IF (NOM(1:4).EQ.'ARGS') THEN
            IP = 32
         ELSE
C           Indice %m1:8 : N'est pas un indice de table reconnu
            MOTERR(1:8) = NOM
            CALL ERREUR(791)
            RETURN
         ENDIF
      ENDIF
C     write(6,*)' LEKTAB IP=',IP, ' NOMI==========',NOMI
      GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90,100
     &     ,110,120,130,140,150,160,170,180,190,200
     &     ,210,220,230,240,250,260,270,280,290,300
     &     ,310,320,330,340,350,360,370,380,390,400
     &     ,410,420,430,440,450,460,470,480,490,500
     &     ,510,520,530,540,550,560,570,580,590,600),IP
C
C Si PRECONDI = 0 (IPREC=0) On recaclcule systématiquement les numéros
C suivant : 10 20 30 40 50 60 70 160 240 250 300 350 360 370 380 400
C           450 490
C
C-*DOMAINE.'MATESI'
C
 10   CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'MATESI',TYPE,MATRIK)
      IF (TYPE.NE.'MATRIK  '.OR.IPREC.EQ.0) THEN
         CALL ECROBJ('TABLE',MTABLE)
         CALL HRSI
         TYPE='MATRIK'
         CALL LIROBJ(TYPE,MATRIK,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATESI','MATRIK',MATRIK)
      ENDIF
      IPOINT = MATRIK
      IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
      RETURN
C
C-*DOMAINE.'XXVOLUM' : CHPO CENTRE contenant le volume des éléments
C
 20   CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
         TYPE=' '
         CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
         CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
         CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXVOLUM : MTABLE=',MTABLE
      RETURN
C
C-*DOMAINE.'XXCOTE'
C
 30   CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'XXCOTE',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXCOTE -> On le calcule'
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL KCOT
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCOTE','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXCOTE : MTABLE=',MTABLE
      RETURN
C
C-*DOMAINE.'XXDIAME'
C
 40   CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXDIAME ',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXDIAME -> On le calcule'
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL KDME
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAME','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXDIAME : MTABLE=',MTABLE
      RETURN
C
C-*DOMAINE.'XXDIEMIN'
C
 50   CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXDIEMIN',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXDIEMIN -> On le calcule'
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL KDMI
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIEMIN','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXDIEMIN : MTABLE=',MTABLE
      RETURN
C
C-*????.'MATC'
C
 60   CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'MATC',TYPE,MATRAK)
      IF (TYPE.NE.'MATRAK  '.OR.IPREC.EQ.0) THEN
c?    IF (TYPE.NE.'MATRAK  ') THEN
         CALL KMEC(MTABLE,MATRAK)
         IF (MATRAK.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATC','MATRAK',MATRAK)
      ENDIF
      IPOINT = MATRAK
      IF(KECR.EQ.1)CALL ECROBJ('MATRAK',MATRAK)
      RETURN
C
C-*DOMAINE.'XXPSOML' : MCHAML, intégrale des fonctions tests par élément
C
 70   CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'XXPSOML',TYPE,ICHE)
      IF (TYPE.NE.'MCHAML  '.OR.IPREC.EQ.0) THEN
         CALL ECROBJ('TABLE',MTABLE)
         CALL KPSOML
         TYPE = 'MCHAML'
         CALL LIROBJ(TYPE,ICHE,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXPSOML','MCHAML',ICHE)
      ENDIF
      IPOINT = ICHE
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MCHAML  ',IPOINT,1)
        CALL ECROBJ('MCHAML  ',IPOINT)
      ENDIF
      RETURN
C
C- ????-INCO : TABLE de sous-type INCO
C
 80   CONTINUE
      MIND  = LISTS(8)
      MINDS = LISTS(8)
      GOTO 1000
C
C- ????-KIZG : TABLE de sous-type KIZG
C
 90   CONTINUE
      MIND  = LISTS(9)
      MINDS = LISTS(9)
      GOTO 1000
C
C- ????-KOPT : TABLE de sous-type KOPT
C
 100  CONTINUE
      MIND  = LISTS(10)
      MINDS = LISTS(10)
      GOTO 1000
C
C- ????-PASDETPS : TABLE de sous-type PASDETPS
C
 110  CONTINUE
      MIND  = LISTS(11)
      MINDS = LISTS(11)
      GOTO 1000
C
C- ????-DOMAINE : TABLE de sous-type DOMAINE
C
 120  CONTINUE
      MIND  = LISTS(12)
      MINDS = LISTS(12)
      GOTO 1000
C
C- ????-DOMZ : TABLE de sous-type DOMAINE
C
 130  CONTINUE
      MIND  = LISTS(13)
      MINDS = LISTS(12)
      GOTO 1000
C
C- ????-EQEX : TABLE de sous-type EQEX
C
 140  CONTINUE
      MIND  = LISTS(14)
      MINDS = LISTS(14)
      GOTO 1000
C
C- ????-EQPR : TABLE de sous-type EQPR
C
 150  CONTINUE
      MIND  = LISTS(15)
      MINDS = LISTS(15)
      GOTO 1000
C
C-*DOMAINE.'XXDIAGSI'
C
 160  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXDIAGSI',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
         CALL ECROBJ('TABLE   ',MTABLE)
 
         SEGACT,MCOORD
         CALL CADGSI
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1) CALL ECMO(MTABLE,'XXDIAGSI','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
      RETURN
C
C- ????-KIZG1 : TABLE de sous-type KIZG1
C
 170  CONTINUE
      MIND  = LISTS(17)
      MINDS = LISTS(17)
      GOTO 1000
C
C- ????-KIZD : TABLE de sous-type KIZD
C
 180  CONTINUE
      MIND  = LISTS(18)
      MINDS = LISTS(18)
      GOTO 1000
C
C- DOMAINE.'SOMMET' : MELEME de POI1 contenant les sommets du maillage
C
 190  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'SOMMET',TYPE,MELEM1)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPE = ' '
         CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
         IF (TYPE.NE.'MAILLAGE') GOTO 5000
         CALL ECRCHA('POI1')
         CALL ECROBJ('MAILLAGE',MELEME)
         CALL PRCHAN
         CALL LIROBJ('MAILLAGE',MELEM1,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
         CALL ECMO(MTABLE,'SOMMET','MAILLAGE',MELEM1)
      ENDIF
      IPOINT = MELEM1
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'CENTRE' : MELEME de POI1 contenant les centres du maillage
C
 200  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPE = ' '
         CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
         IF (TYPE.NE.'MAILLAGE') GOTO 5000
         CALL ECROBJ('MAILLAGE',MELEME)
         CALL CRECTR
         CALL LIROBJ('MAILLAGE',MELEMC,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
         CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMC)
      ENDIF
      IPOINT = MELEMC
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'FACE' : MELEME de POI1 contenant les faces du maillage
C
 210  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'FACE',TYPE,MELEF1)
      IF (TYPE.NE.'MAILLAGE') THEN
         I211 = 1
         GOTO 1100
      ENDIF
 211  CONTINUE
      IPOINT = MELEF1
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'FACEL' : MELEME des connectivités centre-face-centre
C
 220  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
      IF (TYPE.NE.'MAILLAGE') THEN
         I221 = 1
         GOTO 1100
      ENDIF
 221  CONTINUE
      IPOINT = MELEMF
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'FACEP' : MELEME des connectivités sommet-face-sommet
C
 230  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
      IF (TYPE.NE.'MAILLAGE') THEN
         I231 = 1
         GOTO 1100
      ENDIF
 231  CONTINUE
      IPOINT = MELEMP
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'XXNORMAE' : CHPO FACE contenant la normale choisie à la face
C
 240  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'XXNORMAF',TYPE,ICHPV)
 
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
         I241 = 1
         GOTO 1200
      ENDIF
 241  CONTINUE
      IPOINT = ICHPV
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'XXSURFAC' : CHPO FACE contenant l'aire de la face
C
 250  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'XXSURFAC',TYPE,ICHP)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
         I251 = 1
         GOTO 1200
      ENDIF
 251  CONTINUE
      IPOINT = ICHP
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'MAILLAGE' : Maillage géométrique du domaine considéré
C
 260  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      IPOINT = MELEME
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'CETR&FAC' : Inutilisé (à verifier) -> renvoie 'CENTRE'
C
 270  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMK)
      IF (TYPE.NE.'MAILLAGE') THEN
         I271 = 1
         GOTO 1100
      ENDIF
 271  CONTINUE
      IPOINT = MELEMK
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C- ????.'MATRIS'
C
 280  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'MATRIS',TYPE,MTABM)
      IF (TYPE.NE.'TABLE   ') THEN
         IMPR=1
         CALL ECRENT(IMPR)
         CALL ECRCHA('IMPR')
         CALL ECROBJ('TABLE',MTABLE)
         CALL PROGCS
         CALL LIROBJ('TABLE',MTABM,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      CALL ECMO(MTABLE,'MATRIS','TABLE',MTABM)
      ENDIF
      IPOINT = MTABM
      IF(KECR.EQ.1)CALL ECROBJ('TABLE',MTABM)
      RETURN
C
C- DOMAINE.'ELTFA' : MELEME connectivite face par élément (Hdiv)
C
 290  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'ELTFA',TYPE,MELAF)
      IF (TYPE.NE.'MAILLAGE') THEN
         I291 = 1
         GOTO 1100
      ENDIF
 291  CONTINUE
      IPOINT = MELAF
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'XXNORMAE' : MCHAML d'orientation des normales
C
 300  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'XXNORMAE',TYPE,ICHE)
      IF (TYPE.NE.'MCHAML  '.OR.IPREC.EQ.0) THEN
         I301 = 1
         GOTO 1200
      ENDIF
 301  CONTINUE
      IPOINT = ICHE
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MCHAML  ',IPOINT,1)
        CALL ECROBJ('MCHAML  ',IPOINT)
      ENDIF
      RETURN
C
C- ????.'KIZA' : TABLE de sous-type KIZA
C
 310  CONTINUE
      MIND=LISTS(31)
      MINDS=LISTS(31)
      GOTO 1000
C
C- ????.'ARGS...' : CHPO
C
 320  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,NOM,TYPE,MCHP)
      IF (TYPE.NE.'CHPOINT ') THEN
         NC = 10
         CALL COCHPT(NC,MCHP)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,NOM,'CHPOINT',MCHP)
      ENDIF
      IPOINT = MCHP
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'SOMCEN'
C  Cet indice contient un maillage de connectivités sommet-centre
C  Il est constitué d'éléments de type POLY :
C    - le premier noeud est le sommet considéré ;
C    - les noeuds suivants sont les centres des éléments
C      contenant le sommet considéré.
C
 330  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
*      CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
      CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
*      IF (TYPE.NE.'MAILLAGE') THEN
*         I331 = 1
*         GOTO 1300
*      ENDIF
 331  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'SOMCEN',TYPE,MSOCEN)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPE = 'MAILLAGE'
         CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
*         CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
         CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
         CALL POIELE(MMELEM,MMLEMS,MELCEN,MSOCEN)
         CALL ECMO(MTABLE,'SOMCEN','MAILLAGE',MSOCEN)
      ENDIF
      IPOINT = MSOCEN
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'CESOCE'
C  cet indice contient un maillage de connectivités
C  centre-(sommet)-centre.
C  Il est constitué d'éléments de type POLY :
C    - le premier noeud est le centre de l'élément considéré ;
C    - les noeuds suivants sont les centres des éléments
C      ayant au moins un sommet commun avec l'élément considéré.
C
 340  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
*      CALL ACMO(MTABLE,'MMAIL',TYPE,MMELEM)
      CALL ACMO(MTABLE,'MAILLAGE',TYPE,MMELEM)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
*      IF (TYPE.NE.'MAILLAGE') THEN
*         I341 = 1
*         GOTO 1300
*      ENDIF
 341  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'CESOCE',TYPE,MSOCEN)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPE = 'MAILLAGE'
         CALL ACMO(MTABLE,'CENTRE',TYPE,MELCEN)
*         CALL ACMO(MTABLE,'MSOMMET',TYPE,MMLEMS)
         CALL ACMO(MTABLE,'SOMMET',TYPE,MMLEMS)
         CALL ELPOEL(MMELEM,MMLEMS,MELCEN,MCESOC)
         CALL ECMO(MTABLE,'CESOCE','MAILLAGE',MCESOC)
      ENDIF
      IPOINT = MCESOC
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C-*NORMALEV
C
 350  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'NORMALEV',TYPE,MNORM)
 351  CONTINUE
      IF (TYPE.NE.'MAILLAGE'.OR.IPREC.EQ.0) THEN
      TYPE = 'MAILLAGE'
      CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
C petite verification
      SEGACT MELEMQ
      ICONF=1
      DO 62486 L=1,MAX(1,MELEMQ.LISOUS(/1))
      IPT1=MELEMQ
      IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
      SEGACT IPT1
      IF(IDIM.EQ.2.AND.NOMS(IPT1.ITYPEL).NE.'SEG3')THEN
      ICONF=0
      ENDIF
      IF(IDIM.EQ.3.AND.NOMS(IPT1.ITYPEL).NE.'TRI7'
     &            .AND.NOMS(IPT1.ITYPEL).NE.'QUA9')THEN
      ICONF=0
      ENDIF
62486 CONTINUE
 
      IF(ICONF.EQ.0)THEN
      TYPE=' '
      CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
      IF(TYPE.NE.'MAILLAGE')THEN
        CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
           IF (IRET.EQ.0) GOTO 5000
        IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
        IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
        IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')THEN
          CALL ACTOBJ('MAILLAGE',MENVEL,1)
          CALL ECROBJ('MAILLAGE',MENVEL)
        ENDIF
        IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')THEN
          CALL ACTOBJ('CHPOINT',MCHPOI,1)
          CALL ECROBJ('CHPOINT',MCHPOI)
        ENDIF
      ENDIF
 
      CALL ACME(MTABLE,'INEFMD',INEFMD)
      CALL ACMF(MTABLE,'TOLER',TOLER)
      CALL ACMM(MTABLE,'NOMDOM',NOMDOM)
      MACRO=0
      MTABI=0
      CALL KKDOM(MENVEL,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD)
      CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
      CALL ACMO(MTABD,'SOMMET',TYPE,MELEMS)
      ELSE
      CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
      CALL ACMO(MTABLE,'SOMMET',TYPE,MELEMS)
      ENDIF
 
      CALL NORMNO(MELEME,MELEMS,MNORM,IRET)
        IF (IRET.EQ.0) THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
           MOTERR(1:8) = 'NORMALEV'
           MOTERR(9:16) = TYPE
           CALL ERREUR(787)
           RETURN
        ENDIF
      ENDIF
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'NORMALEV','CHPOINT',MNORM)
      IPOINT=MNORM
      IF(NOM.EQ.'OENVELOP')IPOINT=MCHPOI
      IF(KECR.EQ.1.AND.NOMI.EQ.'NORMALEV')THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
 
      IF(KECR.EQ.1.AND.NOMI.EQ.'OENVELOP')THEN
        CALL ACTOBJ('CHPOINT',IPOINT,1)
        CALL ECROBJ('CHPOINT',IPOINT)
      ENDIF
 
      RETURN
C
C-*OENVELOP
C
 360  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'OENVELOP',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT'.OR.IPREC.EQ.0)THEN
      TYPE=' '
      GO TO 351
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'XXMSOMME'
C
 370  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXMSOMME',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C     write(6,*) 'On ne trouve pas XXDIAGSI -> On le calcule'
      CALL ACMO(MTABLE,'MMAIL   ',TYPE,MELEME)
       IF (TYPE.NE.'MAILLAGE') THEN
          I371 = 1
          GOTO 1300
       ENDIF
         CALL ECRCHA('MSOMMET')
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL CADGSI
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXMSOMME','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
      RETURN
C                                   /\
C-*DOMAINE.'MATEEF' : En chantier  /! \ /
C                                 /  <-/
 380  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MATEEF',TYPE,MATRIK)
      IF (TYPE.NE.'MATRIK  '.OR.IPREC.EQ.0) THEN
         CALL ECROBJ('TABLE',MTABLE)
C        CALL HREF
         MOTERR(1:27) = ' LEKTAB : HREF hors service'
         CALL ERREUR(-301)
         TYPE='MATRIK'
         CALL LIROBJ(TYPE,MATRIK,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'MATEEF','MATRIK',MATRIK)
      ENDIF
      IPOINT = MATRIK
      IF(KECR.EQ.1)CALL ECROBJ('MATRIK',MATRIK)
      RETURN
C
C- DOMAINE.'ELKONV'
C
 390  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'FACEL',TYPE,MELEMF)
      IF (TYPE.NE.'MAILLAGE') THEN
C        write(6,*)' LEKTAB FACEL n existe pas on le cree '
         I391 = 1
         GOTO 1100
      ENDIF
C     write(6,*)' LEKTAB FACEL existe '
 391  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'ELKONV',TYPE,MKONV)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPI = 'MAILLAGE'
         CALL ACMO(MTABLE,'FACE',TYPI,MELEF1)
         CALL ACMO(MTABLE,'FACEL',TYPI,MELEMF)
         CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMK)
         CALL ACMO(MTABLE,'ELTFA',TYPI,MELAF)
C        write(6,*)' melef1,melemf,melemk,melaf='
C    &              ,melef1,melemf,melemk,melaf
         CALL ELKONV(MELAF,MELEMF,MELEF1,MELEMK,MKONV)
         CALL ECMO(MTABLE,'ELKONV','MAILLAGE',MKONV)
      ENDIF
      IPOINT = MKONV
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'XXDIAGFA'
C
 400  CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'XXDIAGFA',TYPE,MCHPOI)
      IF(TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0)THEN
C        write(6,*)' On a pas trouve XXDIAGFA On le calcule '
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL CADGFA
         TYPE='CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDIAGFA','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*)' retour XXDIAGFA : MTABLE=',MTABLE
      RETURN
C
C- ????.'M1BULLE' : En chantier
C
 410  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'M1BULLE',TYPE,IPOINT)
      IF(TYPE.NE.'MAILLAGE')THEN
C        write(6,*)' On a pas trouve M1BULLE On le calcule '
         CALL ACMO(MTABLE,'MAILLAGE',TYPI,MELEME)
         CALL ACMO(MTABLE,'CENTRE',TYPI,MELEMC)
         CALL GENMCT(MELEME,MELEMC,IPOINT)
         CALL ECMO(MTABLE,'M1BULLE','MAILLAGE',IPOINT)
         IF(KECR.EQ.1)THEN
           CALL ACTOBJ('MAILLAGE',IPOINT,1)
           CALL ECROBJ('MAILLAGE',IPOINT)
         ENDIF
      ENDIF
      RETURN
C
C- DOMAINE.'CENTREP0'
C
 420  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'CENTREP0',TYPE,IPOINT)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL KCTRP0(MTABLE,IPOINT)
      ENDIF
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'ELTP1NC '
C
 430  CONTINUE
      IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
      TYPE=' '
      CALL ACMO(MTABLE,'ELTP1NC ',TYPE,IPOINT)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL KCTRP1(MTABLE,IPOINT,2)
      ENDIF
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'CENTREP1'
C
 440  CONTINUE
      IF(INEFMD.EQ.0.OR.INEFMD.EQ.1.OR.INEFMD.EQ.4)GO TO 5000
      TYPE=' '
      CALL ACMO(MTABLE,'CENTREP1',TYPE,IPOINT)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL KCTRP1(MTABLE,IPOINT,1)
      ENDIF
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C-*DOMAINE.'VOLUMAC '
C
 450  CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'VOLUMAC ',TYPE,IPOINT)
      IF(IPOINT.NE.0)RETURN
 
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
      IF(MELEME.EQ.0)THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = 'VOLUMAC '
         MOTERR(9:16) = 'NONMACRO'
         CALL ERREUR(787)
         RETURN
      ENDIF
 
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL KMACRO(MACRO,MELEME,MTABLE)
         RETURN
      ENDIF
      TYPE = ' '
      CALL ACMO(MTABLE,'CENTREP0',TYPE,MELEMQ)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL KCTRP0(MTABLE,MELEMQ)
         RETURN
      ENDIF
 
      CALL KVOL(MELEME,MELEMQ,'CENTREP0',IPOINT)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'VOLUMAC ','CHPOINT ',IPOINT)
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
 
C
C- DOMAINE.'MACRO   '
C
 460  CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO',TYPE,MELEME)
      IPOINT = MELEME
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'QUADRATI'
C
 470  CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'QUADRATI',TYPE,MELEME)
      IPOINT = MELEME
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'MACRO1'
C
 480  CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'MACRO1',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
         TYPE=' '
         CALL ACMO(MTABLE,'MACRO',TYPE,MACRO)
         IF(TYPE.NE.'MAILLAGE')THEN
            TYPE=' '
            CALL ACMO(MTABLE,'MAILLAGE',TYPE,IPOINT)
            RETURN
         ELSE
            CALL KMACRO(MACRO,IPOINT,MTABLE)
            RETURN
         ENDIF
      ENDIF
 
      IPOINT = MELEME
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C-*????.'XXDXDY' : En chantier
C
 490  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXDXDY',TYPE,MCHPOI)
C     write(6,*)' ACMO   XXDXDY : MTABLE=',MTABLE
      IF (TYPE.NE.'CHPOINT '.OR.IPREC.EQ.0) THEN
C        write(6,*)' On a pas trouve XXDXDY  On le calcule '
         CALL ECROBJ('TABLE   ',MTABLE)
C        write(6,*)' ECROBJ XXDXDY : MTABLE=',MTABLE
         CALL KDXDY
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXDXDY','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*)' retour XXDXDY : MTABLE=',MTABLE
      RETURN
C
C- DOMAINE.'MSOMMET'
C
 500  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MSOMMET ',TYPE,MMLEMS)
      IF(TYPE.NE.'MAILLAGE')THEN
        I501 = 1
        GO TO 1300
      ENDIF
 501  CONTINUE
      IPOINT = MMLEMS
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'MMAIL  '
C
 510  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MMAIL   ',TYPE,MMELEM)
      IF(TYPE.NE.'MAILLAGE')THEN
         I511 = 1
         GOTO 1300
      ENDIF
 511  CONTINUE
      IPOINT = MMELEM
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'MLGVNIMP'
C
 520  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MLGVNIMP',TYPE,MELETI)
 
      IF(TYPE.EQ.'MAILLAGE')THEN
      IPOINT = MELETI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
      ELSE
      TYPE=' '
      CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') GO TO 5000
      CALL MEULTI(MELEME,MELETI,TYPE)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      CALL ECMO(MTABLE,'MLGVNIMP','MAILLAGE',MELETI)
      IPOINT = MELETI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
      ENDIF
C
C- DOMAINE.'MLGVTIMP'
C
 530  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'MLGVTIMP',TYPE,MELETI)
 
      IF(TYPE.EQ.'MAILLAGE')THEN
      IPOINT = MELETI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
      ELSE
      TYPE=' '
      CALL ACMO(MTABLE,'SOMMET',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') GO TO 5000
      CALL MEULTI(MELEME,MELETI,TYPE)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      CALL ECMO(MTABLE,'MLGVTIMP','MAILLAGE',MELETI)
      IPOINT = MELETI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
      ENDIF
C
C- DOMAINE.'ENVELOPP'
C
 540  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'ENVELOPP',TYPE,MENVEL)
 
      IF(TYPE.EQ.'MAILLAGE')THEN
      IPOINT = MENVEL
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
      ELSE
      TYPE = ' '
C     CALL ACMO(MTABLE,'FACEP',TYPE,MELEMP)
      CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
      IF (TYPE.NE.'MAILLAGE') THEN
         I541 = 1
         GOTO 1100
      ENDIF
      ENDIF
 541  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'QUAF',TYPE,MELEMQ)
 542  CONTINUE
      CALL MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'ENVELOPP','MAILLAGE',MENVEL)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'OENVELOP','CHPOINT',MCHPOI)
      IPOINT = MENVEL
      IF(KECR.EQ.1.AND.NOMI.EQ.'ENVELOPP')THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'FACEL2' : MELEME connectivite face -> centre (partitionne)
C                     rgt partitionne
 550  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'FACEL2',TYPE,MELEF2)
      IF (TYPE.NE.'MAILLAGE') THEN
         I551 = 1
         GOTO 1100
      ENDIF
 551  CONTINUE
      IPOINT = MELEF2
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'QUAF    ' : Maillage QUAF du domaine considéré
C
 560  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE=' '
      CALL ACMO(MTABLE,'QUAF    ',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      IPOINT = MELEME
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'XXCTREP1'
C
 570  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXCTREP1',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT ') THEN
         CALL ECRCHA('CENTREP1')
         CALL ECROBJ('TABLE   ',MTABLE)
         CALL CADGSI
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,MCHPOI,1,IRET)
         IF (IRET.EQ.0) GOTO 5000
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP1','CHPOINT ',MCHPOI)
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
C     write(6,*) 'Retour XXDIAGSI : MTABLE=',MTABLE
      RETURN
C
C- DOMAINE.'XXCTREP0'
C
 580  CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'XXCTREP0',TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT ') THEN
       TYPE = ' '
       CALL ACMO(MTABLE,'XXVOLUM ',TYPE,MCHPOI)
       IF (TYPE.NE.'CHPOINT ') THEN
      write(6,*) 'On ne trouve pas XXVOLUM -> On le calcule'
         TYPE=' '
         CALL ACMO(MTABLE,'CENTRE',TYPE,MELEMC)
         CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
         CALL KVOL(MELEME,MELEMC,'CENTRE',MCHPOI)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXCTREP0','CHPOINT ',MCHPOI)
      IF(ISTOK.EQ.1)CALL ECMO(MTABLE,'XXVOLUM ','CHPOINT ',MCHPOI)
       ENDIF
      ENDIF
      IPOINT = MCHPOI
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('CHPOINT ',IPOINT,1)
        CALL ECROBJ('CHPOINT ',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'MAILFACE' : MELEME des elements face
C
 590  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'MAILFACE',TYPE,MFF2)
      IF (TYPE.NE.'MAILLAGE') THEN
         I591 = 1
         GOTO 1100
      ENDIF
 591  CONTINUE
      IPOINT = MFF2
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- DOMAINE.'ARETE   ' : MELEME des éléments arêtes
C
 600  CONTINUE
      CALL ACMM(MTABLE,'SOUSTYPE',TYPE)
      IF (TYPE.NE.'DOMAINE ') GOTO 5010
      TYPE = ' '
      CALL ACMO(MTABLE,'QUAF    ',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      TYPE = ' '
      CALL ACMO(MTABLE,'ARETE   ',TYPE,MARET)
      IF (TYPE.NE.'MAILLAGE') THEN
         CALL ECROBJ('MAILLAGE',MELEME)
         CALL CHANLG
         CALL LIROBJ('MAILLAGE',MARET,1,IRETOU)
       IF (IRETOU.NE.1) THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = 'ARETE'
         MOTERR(9:16) = 'MAILLAGE'
         CALL ERREUR(787)
         RETURN
       ENDIF
      ENDIF
      IPOINT = MARET
      IF(KECR.EQ.1)THEN
        CALL ACTOBJ('MAILLAGE',IPOINT,1)
        CALL ECROBJ('MAILLAGE',IPOINT)
      ENDIF
      RETURN
C
C- Emplacement libre
C
 610  CONTINUE
      IPOINT = 0
      RETURN
C
C
C---------------------------------------------------------
C Traitement commun à plusieures options et mise en facteur
C---------------------------------------------------------
C
C
C- Recherche à l'indice mot MIND d'une table de sous-type MINDS
C- ATTENTION : ERREUR NON GERE POUR L'INSTANT : Si IPTR.EQ.0 5000
C
 1000 CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,MIND,TYPE,IPTR)
      IF (TYPE.EQ.'TABLE   ') THEN
         TYPE = ' '
         CALL ACMM(IPTR,'SOUSTYPE',TYPE)
         IF (TYPE.EQ.MINDS) THEN
            IPOINT = IPTR
         ENDIF
      ELSE IF(TYPE.EQ.'MMODEL')THEN
         CALL LEKMOD(IPTR,IPOINT,INEFMD)
         IF(IPOINT.EQ.0)RETURN
      ENDIF
      RETURN
C
C- Construction des indices 'FACE', 'FACEP', 'FACEL', 'CENTRE', 'ELTFA', 'FACEL2'
C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
C
 1100 CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'MAILLAGE',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') GOTO 5000
 
      NOMC=' '
      CALL TQ2CF(MELEME,MELEMQ,MELEMK,
     & MELEF1,MELAF,MELEMP,MELEMF,MELEF2,MFF2,NOMC,IKR)
      IF(IKR.EQ.1)IQUAD=1
 
      IF(IQUAD.EQ.1)THEN
         CALL ECMO(MTABLE,'QUADRATIQUE','MAILLAGE',MELEME)
         CALL ECMO(MTABLE,'MAILLAGE','MAILLAGE',MELEMQ)
      ENDIF
 
         CALL ECMO(MTABLE,'FACE','MAILLAGE',MELEF1)
         CALL ECMO(MTABLE,'FACEL','MAILLAGE',MELEMF)
         CALL ECMO(MTABLE,'FACEL2','MAILLAGE',MELEF2)
         CALL ECMO(MTABLE,'FACEP','MAILLAGE',MELEMP)
         CALL ECMO(MTABLE,'CENTRE','MAILLAGE',MELEMK)
         CALL ECMO(MTABLE,'ELTFA','MAILLAGE',MELAF)
         CALL ECMO(MTABLE,'MAILFACE','MAILLAGE',MFF2)
 
      IF (I211 .EQ.1) GOTO 211
      IF (I221 .EQ.1) GOTO 221
      IF (I231 .EQ.1) GOTO 231
      IF (I271 .EQ.1) GOTO 271
      IF (I291 .EQ.1) GOTO 291
      IF (I391 .EQ.1) GOTO 391
      IF (I541 .EQ.1) GOTO 541
      IF (I551 .EQ.1) GOTO 551
      IF (I1201.EQ.1) GOTO 1201
      IF (I591 .EQ.1) GOTO 591
C
C- Construction des indices 'XXNORMAE', 'XXSURFAC' et 'XXNORMAF'
C- d'une table de sous-type 'DOMAINE' utilisé pour certaines options
C
 1200 CONTINUE
      TYPE = ' '
      CALL ACMO(MTABLE,'FACE',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') THEN
         I1201 = 1
         GOTO 1100
      ENDIF
 1201 CONTINUE
      CALL KNRF(MTABLE,ICHE,ICHPV,ICHP)
       IF(ISTOK.EQ.1)THEN
         CALL ECMO(MTABLE,'XXNORMAE','MCHAML  ',ICHE)
         CALL ECMO(MTABLE,'XXSURFAC','CHPOINT ',ICHP)
         CALL ECMO(MTABLE,'XXNORMAF','CHPOINT ',ICHPV)
       ENDIF
 
      IF (I241.EQ.1) GOTO 241
      IF (I251.EQ.1) GOTO 251
      IF (I301.EQ.1) GOTO 301
      IF (I542.EQ.1) GOTO 542
C
C   Construction des indices 'MSOMMET' et 'MMAIL' d'une table
C   de sous-types 'DOMAINE'.
C   A l'indice 'MSOMMET', on trouve le maillage des "vrais"
C   sommets (les sommets géométriques des éléments), par
C   opposition à l'indice 'SOMMET' qui est le spg des inconnues
C   définies dans l'espace L2.
C   A l'indice 'MMAIL' qui lui correspond, on trouve le maillage
C   des "vrais" éléments (les éléments géométriques :
C        ils ont le type le plus simple pour un forme
C        géométrique donnée (ex. TRI3, PYR5, CUB8...))
C   par opposition à l'indice 'MAILLAGE' qui contient
C   éventuellement des éléments avec plus de points qui sont les
C   spg des différentes inconnues.
C  spg=support géométrique.
C
 1300 CONTINUE
      TYPE=' '
      CALL ACMO(MTABLE,'QUAF    ',TYPE,MELEME)
      IF (TYPE.NE.'MAILLAGE') GO TO 5000
      CALL MSOMET(MELEME,MMELEM,MMLEMS,TYPE)
      IF (TYPE.NE.'MAILLAGE') THEN
C        Indice %m1:8 : Objet de type %m9:16 incorrect
 
         MOTERR(1:8) = NOM
         MOTERR(9:16) = TYPE
         CALL ERREUR(787)
         RETURN
      ENDIF
      CALL ECMO(MTABLE,'MMAIL   ','MAILLAGE',MMELEM)
      CALL ECMO(MTABLE,'MSOMMET ','MAILLAGE',MMLEMS)
 
      IF (I331.EQ.1) GOTO 331
      IF (I341.EQ.1) GOTO 341
      IF (I371.EQ.1) GOTO 370
      IF (I501.EQ.1) GOTO 501
      IF (I511.EQ.1) GOTO 511
C
C----------------------------------------
C Erreur détectée : traitement impossible
C----------------------------------------
C
 5000 CONTINUE
C     Indice %m1:8 : Problème de données détecté dans lektab
 
      IPOINT      = 0
      MOTERR      = NOM
      CALL ERREUR(792)
      RETURN
 5010 CONTINUE
C     Indice %m1:8 : La table n'est pas de sous-type %m9:16
 
      IPOINT       = 0
      MOTERR       = NOM
      MOTERR(9:16) ='DOMAINE '
      CALL ERREUR(790)
      RETURN
C
      END