C WRPIL     SOURCE    PV090527  26/04/30    21:16:48     12529          

C=======================================================================
C      BUT     : ECRITURE DES PILES SUR LE FICHIER IOSAU
C      APPELE PAR SAUV
C      APPELLE : WRPOIN NOMMEF SOPAPF ECDIFE ECDIFM ECDIFR SOSOLF
C              : ECDES ECDIFP  JDANSI WRMAIL
C      ECRIT PAR FARVACQUE   - REPRIS PAR LENA
C
C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
C              GOUNAND (15/07/98)
C              ajout des tableaux de noms d'inconnues primales et duales
C              LNOMDD, LNOMDU gounand (06/11/2014)
C
C=======================================================================
C  TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL
C=======================================================================
      SUBROUTINE WRPIL(ICOLAC,IMAX,IFORM,LABEL,isilen)

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

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC CCNOYAU
-INC CCGEOME
-INC CCFXDR
-INC CCHAMP

-INC SMELEME
-INC SMBASEM
-INC SMRIGID
-INC SMCOORD
-INC SMSTRUC
-INC SMDEFOR
-INC SMLREEL
-INC SMLENTI
-INC SMCHARG
-INC SMEVOLL
-INC SMELSTR
-INC SMCLSTR
-INC SMTEXTE
-INC SMSUPER
-INC SMVECTD
-INC SMLMOTS
-INC SMTABLE
-INC SMLCHPO
-INC SMINTE
-INC SMLOBJE

-INC TMCOLAC

      SEGMENT/ITBBE1/( ITABE1(NN))
      SEGMENT/ITBBE2/( ITABE2(NN))
      segment itbbc2
       character*4 itabc2(nn)
      endsegment
      SEGMENT/ITBBM1/( ITABM1(NM))
      segment itbbc1
       character*4 itabc1(nm)
      endsegment
      SEGMENT/ITBBM2/( ITABM2(NM2))
      segment itbbc3
       character*4 itabc3(nm2)
      endsegment
      SEGMENT/ITBBM3/( ITABM3(NM2))
      segment itbbc4
       character*4 itabc4(nm2)
      endsegment
      SEGMENT/ITBBM4/( ITABM4(NM2))
      segment itbbc5
       character*4 itabc5(nm2)
      endsegment
      SEGMENT/ITABR1/( TABR1(L)*D)
      SEGMENT ITAMOT
      CHARACTER*(NN) ITAMO
      INTEGER ICOTA(NNN)
      ENDSEGMENT
      segment xmaaux
       real*8 reaux(laux,nelrig)
      endsegment

      CHARACTER*(8) ITYPE,ITYPO
      CHARACTER*512 CHA1
      CHARACTER*72 LABEL
      REAL*8 XRA
      LOGICAL LIRA
      DIMENSION ILENA(30)
      DIMENSION IPV(2)
      real*4 densi4

C======================================================================
      WRITE (IOIMP,19) IONIVE
 19   FORMAT (//,' NIVEAU DU FICHIER DE SAUVEGARDE',I3)

*  verif ouverture du fichier de sauvegarde
      if (iform.eq.2) then
        if (ixdrw.eq.0) call erreur(-195)
        if (ixdrw.eq.0) call erreur(558)
        if (ierr.ne.0) return
      endif

      ITBBE1=0
      ITBBE2=0
      ITBBM1=0
      ITBBM2=0
      ITBBM3=0
      ITBBM4=0
      ITABR1=0

      SEGACT ICOLAC
      NITLAC=ICOLA(/1)
      IF (IPSAUV.NE.0) GOTO 7654

C  **** TITRE ********************************************
C
C     IQUOI=3
C     CALL ECDES (IOSAU,IQUOI,IFORM)
C     CALL ECDIFM (IOSAU,18,TITREE,IFORM)
C
C  **** INFORMATIONS GENERALES  MAILLAGE *****************
C  **** INFORMATIONS GENERALES A METTRE DANS LES COMMONS
C
      IQUOI=4
      CALL ECDES (IOSAU,IQUOI,IFORM)
      IF(IFORM.EQ.1) WRITE(IOSAU,701) IONIVE, IERMAX,IDIM
      IF(IFORM.EQ.0) WRITE(IOSAU)     IONIVE, IERMAX,IDIM
      if(iform.eq.2) then
       ios=IXDRINT( ixdrw, IONIVE )
       ios=IXDRINT( ixdrw, iermax )
       ios=IXDRINT( ixdrw, idim   )
       dimatt = dimatt + 4
      endif
 701  FORMAT(' NIVEAU',I4,' NIVEAU ERREUR',I4,' DIMENSION',I4)

      LCOMWR = -1
      if (ionive.lt.23) goto 9001
C     A partir du Niveau 23 :
C     Ecriture de la longueur des Chaines de CARACTERES des composantes ('MCHAML','CHPOINT','LISTMOTS',etc.)
C     Attention LOCOMP est un PARAMETER on ne peut pas l'envoyer a IXDRINT qui le reecrit en sortie pour controle
      LCOMWR = MIN(LOCOMP,LOCHAI)
      IF (IFORM.EQ.1) WRITE(IOSAU,700) LCOMWR
      IF (IFORM.EQ.0) WRITE(IOSAU)     LCOMWR
      if (iform.eq.2) then
        ios    = IXDRINT( ixdrw, LCOMWR )
        dimatt = dimatt + 2
      endif
 700  FORMAT(' TAILLE DES COMPOSANTES',I4)
 9001 continue

C     Ecriture de la DENSITE
      IF (IFORM.EQ.1)WRITE(IOSAU,702) DENSIT
      IF (IFORM.EQ.0)WRITE(IOSAU) DENSIT
      if (iform.eq.2) then
        densi4 = densit
        ios    = IXDRREAL( ixdrw, densi4 )
        dimatt = dimatt + 2
      endif
 702  FORMAT(' DENSITE',E12.5)
C
C ***** INFORMATIONS GENERALES CASTEM2000 *****************
C Depuis le niveau 6, N = 8 (avant 7)
      IQUOI=7
      CALL ECDES (IOSAU,IQUOI,IFORM)
      N = 8
      if (ionive.lt.6) N = 7
      IF(IFORM.EQ.1)WRITE(IOSAU,703) N
      IF(IFORM.EQ.0)WRITE(IOSAU) N
      if (iform.eq.2) then
        ios    = IXDRINT( ixdrw, n)
        dimatt = dimatt + 2
      endif
 703  FORMAT(' NOMBRE INFO CASTEM2000',I4)

C  A partir du niveau 20, NSDPGE n'est plus utile...
      izzz = 0
      IF (IFORM.EQ.1) THEN
        WRITE(IOSAU,704) IFOUR,NIFOUR,IFOMOD,ILGNI,IIMPI,IOSPI,ISOTYP
        IF (IONIVE.GE.20) WRITE(IOSAU,707) izzz
        if (IONIVE.ge.6.and.IONIVE.le.19) WRITE(IOSAU,706) izzz
      ENDIF
      IF (IFORM.EQ.0) WRITE(IOSAU) IFOUR,NIFOUR,IFOMOD,ILGNI,IIMPI,
     &                             IOSPI,ISOTYP,izzz
      if (iform.eq.2) then
        ios    = IXDRINT( ixdrw, ifour )
        ios    = IXDRINT( ixdrw, nifour)
        ios    = IXDRINT( ixdrw, ifomod)
        ios    = IXDRINT( ixdrw, ILGNI )
        ios    = IXDRINT( ixdrw, iimpi )
        ios    = IXDRINT( ixdrw, iospi )
        ios    = IXDRINT( ixdrw, isotyp)
        ios    = IXDRINT( ixdrw, izzz  )
        dimatt = dimatt + 9
      endif
 704  FORMAT(' IFOUR',I4,' NIFOUR',I4,' IFOMOD',I4,' ILGNI',I4,
     &       ' IIMPI',I4,' IOSPI' ,I4,' ISOTYP',I4)
 706  FORMAT(' NSDPGE',I6)
 707  FORMAT(' ------',I6)

 7654 CONTINUE
C
C ****** Noms des composantes primales et duales
C        repris de l'écriture des LISTMOTS
C        Ecriture depuis le niveau 19
      IF (IONIVE.LT.19) GOTO 9019
      IQUOI=8
      CALL ECDES (IOSAU,IQUOI,IFORM)
* Primal
      ILENA(1) = LEN(NOMDD(1))
      ILENA(2) = LNOMDD
      ITOTO=2
      CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
      NNA = ILENA(1)
      NNN = 0
      NN  = ILENA(1)*ILENA(2)
      SEGINI ITAMOT
      DO IMM=1,ILENA(2)
        ITAMO((IMM-1)*NNA+1:IMM*NNA)=NOMDD(IMM)
      ENDDO
      CALL ECDIFC( IOSAU,ITAMO,IFORM)
      SEGSUP ITAMOT
* Dual
      ILENA(1) = LEN(NOMDU(1))
      ILENA(2) = LNOMDU
      ITOTO = 2
      CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
      NNA = ILENA(1)
      NNN = 0
      NN  = ILENA(1)*ILENA(2)
      SEGINI ITAMOT
      DO IMM=1,ILENA(2)
        ITAMO((IMM-1)*NNA+1:IMM*NNA)=NOMDU(IMM)
      ENDDO
      CALL ECDIFC(IOSAU,ITAMO,IFORM)
      SEGSUP ITAMOT
 9019 CONTINUE

C=DEB= FORMULATION HHO = Sauvegarde Elements particuliers ==============
C=     Ecriture a partir du niveau 26
      IF (IONIVE.LT.26) GOTO 9026
      IQUOI = 9
      CALL ECDES(IOSAU,IQUOI,IFORM)
      CALL HHOPIL(4,IOSAU,IFORM)
      IF (IERR.NE.0) RETURN
 9026 CONTINUE
C=FIN= FORMULATION HHO =================================================

C  **** COORDONNEES + MELEME : APPEL DE MAILLA ********************
C
C      IF(IMAX.NE.0) CALL WRPOIN (IMAX,IFORM,ICOLAC)
C
C  **** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC *************
C
      DO 1099 IFILE=1,NITLAC
*pv on se sort pas le mmatri
         if (ifile.eq.16) goto 1099
*tc on ne sort pas les points
*         if(ifile.eq.32) GOTO 1099
         ITLACC=KCOLA(IFILE)
         IMAX1=ITLAC(/1)
         IF(IMAX1.EQ.0) GOTO 1099
         IDEB=1
         IF(IPSAUV.NE.0) IDEB=KCOLAC(IFILE)+1
         IF(IMAX1.LT.IDEB.AND.IFILE.NE.32) GOTO 1099
         ITYPE='        '
         CALL TYPFIL(ITYPE,IFILE)

         IF (IFILE.NE.8.AND.IFILE.NE.36.AND. ISILEN.NE.1)
     $     WRITE(IOIMP,801)IFILE,IMAX1,ITYPE
 801     FORMAT(/,'  LA PILE NUMERO',I4,' CONTIENT',I8,' OBJET(S) ',A8)
C
         IP1=ICOLA(IFILE)
         IF (IFILE.NE.8.AND.IFILE.NE.36)
     $      CALL NOMMEF (IP1,IMAX1,IFILE,IFORM,IDEB,isilen)
         GOTO(6001,6002,6003,6004,6005,6006,6007,6008,6009,6010,
     &        6011,6012,6013,6014,6015,6016,6017,6018,6019,6020,
     &        6021,6022,6023,6024,6025,6026,6027,6028,6029,6030,
     &        6031,6032,6033,6034,6035,6036,6037,6038,6039,6040,
     &        6041,6042,6043,6010,6045,6010,6010,6048,6049,6050,
     &        6051), IFILE
 1001    MOTERR(1:8)=ITYPE
         CALL ERREUR(336)
         GOTO 1099
C     **************************MELEME *********************************
 6001    CONTINUE
         DO 1100 IEL=IDEB,IMAX1
            MELEME=ITLAC(IEL)
            CALL WRMAIL(MELEME,IOSAU,IRETOU,IFORM)
 1100    CONTINUE
         GOTO 1098
C     **************************CHPOINT*********************************
 6002    CONTINUE
         CALL WRCHPO(IOSAU,ITLACC,IMAX1,IFORM,IDEB,LCOMWR)
         GOTO 1098
C     ***********************MRIGID*************************************
 6003    CONTINUE
         DO 1202 IEL=IDEB,IMAX1
            MRIGID=ITLAC(IEL)
            SEGACT MRIGID*mod
            NRIGEL=IRIGEL(/2)
            NRIGE =IRIGEL(/1)
            NBGEOR=0
            IF(IMGEO1.NE.0) THEN
               IMGEOD=IMGEO1
               SEGACT IMGEOD
               NBGEOR=IMGEOR(/1)
            ENDIF
*pv      IF(ICHOLE.GE.0) THEN
*pv         ICHOLX=0
*pv      ELSE
*pv         ICHOLX=-ICHOLE
*pv      ENDIF
            ICHOLX=0
            ILENA(1)=NRIGEL
            ILENA(2)=ICHOLX
            ILENA(3)=NBGEOR
            ILENA(4)=NRIGE
            ILENA(5)=IFORIG
            ITOTO=5
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)

            ITOTO=2
            if (ichar(mtymat(1:1)).eq.0) mtymat=' '
            READ (MTYMAT,FMT='(2A4)') IPV
            if (iform.ne.2) CALL ECDIFM (IOSAU,ITOTO,IPV,IFORM)
            if (iform.eq.2) then
             ios=IXDRSTRING( ixdrw, mtymat(1:8))
             dimatt = dimatt + 2
            endif

            NN=NRIGE*NRIGEL+NBGEOR +NRIGEL
            SEGINI ITBBE1
            NNN=0
            DO 1203 IR=1,NRIGEL
               DESCR=IRIGEL(3,IR)
               SEGACT DESCR
               xmatri=irigel(4,ir)
               if (xmatri.gt.0) then
               segact xmatri
               nelrig=re(/3)
               endif
               NLIGRP=NOELEP(/1)
               NLIGRD=NOELED(/1)
               II=NRIGE*(IR-1)
               DO 1204 NR=1,NRIGE
                  IRR=II+NR
                  ITABE1(IRR)=IRIGEL(NR,IR)
 1204          CONTINUE
               ITABE1(II+3)=NLIGRP
               if (ionive.le.19) ITABE1(II+4)=nelrig
               ITABE1(NRIGE*NRIGEL + NBGEOR + IR)=NLIGRD
               NNN=NNN+NLIGRP + NLIGRD
               SEGDES DESCR
 1203       CONTINUE
            IF(NBGEOR.NE.0) THEN
               DO 1206 I=1,NBGEOR
                  IVA=IMGEOR(I)
                  ITABE1(NRIGE*NRIGEL+I)=IVA
 1206          CONTINUE
               SEGDES IMGEOD
            ENDIF
 1207       CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)

            NN=NNN
            SEGADJ ITBBE1
            NM=NNN
            SEGINI ITBBM1,itbbc1
            J=0
            DO 1208 IR=1,NRIGEL
               DESCR=IRIGEL(3,IR)
               SEGACT DESCR
               NLIGRP=NOELEP(/1)
               NLIGRD=NOELED(/1)
               DO 1205 I=1,NLIGRP
                  J=J+1
                  ITABE1(J)=NOELEP(I)
                  READ (LISINC(I),FMT='(A4)') ITABM1(J)
                  itabc1(j)=lisinc(i)
 1205          CONTINUE
               DO 1209 I=1,NLIGRD
                  J=J+1
                  ITABE1(J)=NOELED(I)
                  READ (LISDUA(I),FMT='(A4)') ITABM1(J  )
                  itabc1(j)=lisdua(i)
 1209          CONTINUE
               SEGDES DESCR
 1208       CONTINUE
            CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
            if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
            if (iform.eq.2) then
             ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4))
             dimatt = dimatt + nm
            endif
            SEGSUP ITBBE1,ITBBM1,itbbc1
            CALL ECDIFR(IOSAU,NRIGEL,COERIG,IFORM)
            if (ionive.le.19) then
            do 1210 ir=1,nrigel
              xmatri=irigel(4,ir)
              segact xmatri
              lval=re(/1)*re(/2)*re(/3)
              CALL ECDIFR(IOSAU,lval,re,IFORM)
              segdes xmatri
 1210       continue
            endif
            SEGDES MRIGID
 1202    CONTINUE
         GOTO 1098
C     ***************************        *******************************
 6004    CONTINUE
         GOTO 1098
C     ***********************          *********************************
 6005    CONTINUE
         GOTO 1098
C ********************************BLOQ STRUC
 6006    CONTINUE
         DO 60 IEL=IDEB,IMAX1
            MCLSTR=ITLAC(IEL)
            SEGACT MCLSTR
            N=ISOSTR(/1)
            ILENA(1)=N
            ITOTO=1
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFE (IOSAU,N    ,ISOSTR,IFORM)
            CALL ECDIFE (IOSAU,N    ,IRIGCL,IFORM)
            SEGDES MCLSTR
 60      CONTINUE
         GOTO 1098
C ********************************ELEM STRUC
 6007    CONTINUE
         DO 70 IEL=IDEB,IMAX1
            MELSTR=ITLAC(IEL)
            SEGACT MELSTR
            N=ISOSTU(/1)
            ILENA(1)=N
            ITOTO=1
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFE (IOSAU,N    ,ISOSTU,IFORM)
            CALL ECDIFE (IOSAU,N    ,IMELEM,IFORM)
            SEGDES MELSTR
 70      CONTINUE
         GOTO 1098
C     ********************MSOLUT*************************************
 6008    CONTINUE
C---- TRAITE PLUS LOIN  EN FIN DE SP -------------------------------
         GOTO 1099
C     ********************MSTRUC*************************************
 6009    CONTINUE
         DO 1900 IEL=IDEB,IMAX1
            MSTRUC=ITLAC(IEL)
            SEGACT MSTRUC
            NS=LISTRU(/1)
            ILENA(1)=NS
            ITOTO=1
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFE(IOSAU,NS,LISTRU,IFORM)
            SEGDES MSTRUC
 1900    CONTINUE
         GOTO 1098
C     ******************************* MTABLE **************************
 6010    CONTINUE
         NTOTO=6
         if(meffac.ne.0) segact meffac
         DO 710 IEL=IDEB,IMAX1
            MMM=0
            MTABLE=ITLAC(IEL)
            IF (MTABLE.EQ.0) GOTO 109
            SEGACT MTABLE
            L6=MLOTAB
            L=L6
            NN=0
            SEGINI ITBBE1
            IF (L.EQ.0) GOTO 109
            DO 711 K=1,L
               ITYPE=MTABTI(K)
               JI=0
*             IF(ITYPE.EQ.'METHODE ') ITYPE='MOT     '
               CALL  TYPFIL (ITYPE,JI)
               IF(JI.LE.0) GOTO 711
               ITYPE=MTABTV(K)
               J=0
               CALL  TYPFIL (ITYPE,J)
               IF(J.LE.0) GOTO 711
*  on ne sauve pas les fantomes si on n'est pas en increment
                if (ipsauv.eq.0.and.j.eq.47) then
                      segact mtable*mod
                      MTABTV(K)='ANNULE'
                      segact     mtable
                      goto 711
                endif
               IVA=MTABII(K)
               ITABE1(**)=JI
               ITABE1(**)=IVA
               IVA=MTABIV(K)
* on remplace les procedures par des entiers valant ?.
               if( j.eq.36) then
                 j = 26
                 iva= 1
               endif
               if(j.eq.47) then
                 itype = tyeffa(iva)
                 j=0
                 call typfil(itype,j)
                 iva= neffac(iva)
               endif
               ITABE1(**)=J
               ITABE1(**)=IVA
 711        CONTINUE
            MMM=ITABE1(/1)
 109        ITOTO=1
            ILENA(1)=MMM
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            IF (MTABLE.EQ.0) GOTO 710
            CALL ECDIFE (IOSAU,MMM,ITABE1,IFORM)
            SEGSUP ITBBE1
 713        SEGDES MTABLE
 710     CONTINUE
         GOTO 1098
 715     CONTINUE
         MOTERR(1:8)=ITYPE
         CALL ERREUR (336)
         SEGDES MTABLE
         SEGSUP ITBBE1
         GOTO 1099
C     *****************************        *****************************
 6011    CONTINUE
         GOTO 1098
C     *************************MSOSTU*******************************
 6012    CONTINUE
         NN=3
         SEGINI ITBBE1
         DO 2201 IEL=IDEB,IMAX1
            MSOSTU=ITLAC(IEL)
            IF(MSOSTU.EQ.0) GOTO 2201
            SEGACT MSOSTU
            NS=ISCHAM(/1)
            ITOTO    = 1
            ILENA(1)=NS
            CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
            ITOTO=3+NS
            NN=ITOTO
            SEGADJ ITBBE1
            ITABE1(1)=ITYSOU
            ITABE1(2)=ISRAID
            ITABE1(3)=ISMASS
            CALL JDANSI(ITABE1(4),ISCHAM(1),NS)
            CALL ECDIFE (IOSAU,ITOTO,ITABE1(1),IFORM)
            SEGDES MSOSTU
 2201    CONTINUE
         SEGSUP ITBBE1
         GOTO 1098
C     ***************************** IMATRI *****************************
 6013    CONTINUE
         DO 2300 IEL=IDEB,IMAX1
              xmatri=itlac(iel)
              segact xmatri
              lval=re(/1)*re(/2)*re(/3)
              ilena(1)=re(/1)
              ilena(2)=re(/2)
              ilena(3)=re(/3)
              ilena(4)=symre
***           write (6,*) ' imatri ',iel,re(/1),re(/2),re(/3),symre
              itoto=4
              CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
              if (symre.eq.0.and.ilena(1).eq.ilena(2)) then
*  cas symetrique on  ne sauve que la partie triangulaire
              laux = ilena(1)*(ilena(1)+1)/2
              nelrig=ilena(3)
              segini xmaaux
              do k=1,nelrig
               ip=0
               do j=1,ilena(2)
                do i=1,j
                 reaux(ip+i,k)=re(i,j,k)
*  Les raideurs calculees avec hook ne sont pas tres symetriques
                 if (abs(re(i,j,k)-re(j,i,k)).gt.
     >           (abs(re(i,j,k))+abs(re(j,i,k)))*xzprec*1d4+xpetit) then
                   call erreur(969)
**                 write(6,*) re(i,j,k),re(j,i,k)
                 endif
                enddo
                ip=ip+j
               enddo
               if (ip.ne.laux) call erreur(5)
              enddo
              call ecdifr(iosau,ip*nelrig,reaux,iform)
              segsup xmaaux
              else
*  cas general on sauve tout
              CALL ECDIFR(IOSAU,lval,re,IFORM)
              endif
              segdes xmatri
 2300    CONTINUE
         GOTO 1098
C     ***************************** MJONCT *****************************
 6014    CONTINUE
         CALL WRJONC (IOSAU,ITLACC,IMAX1,IFORM,IDEB)
         GOTO 1098
C     ***************************** MATTAC *****************************
 6015    CONTINUE
         CALL WRATTA (IOSAU,ITLACC,IMAX1,IRETOU,IFORM,IDEB)
         GOTO 1098
C     ***************************** MMATRI *****************************
 6016    CONTINUE
         CALL WRMMAT (IOSAU,ITLACC,IMAX1,IFORM,IDEB)
         GOTO 1098
C     *********************MDEFOR***********************************
 6017    CONTINUE
         DO 2700 IEL=IDEB,IMAX1
            MDEFOR=ITLAC(IEL)
            SEGACT MDEFOR
            NDEF=IELDEF(/1)
            ILENA(1)= NDEF
            ITOTO   = 1
            CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFR(IOSAU,NDEF,AMPL,IFORM)
            NN=7*NDEF
            SEGINI ITBBE1
            CALL JDANSI (ITABE1(1),       IELDEF(1),NDEF)
            CALL JDANSI (ITABE1(NDEF+1),  ICHDEF(1),NDEF)
            CALL JDANSI (ITABE1(2*NDEF+1),JCOUL(1),NDEF)
            CALL JDANSI (ITABE1(3*NDEF+1),MTVECT(1),NDEF)
            CALL JDANSI (ITABE1(4*NDEF+1),MDCHP(1),NDEF)
            CALL JDANSI (ITABE1(5*NDEF+1),MDCHEL(1),NDEF)
            CALL JDANSI (ITABE1(6*NDEF+1),MDMODE(1),NDEF)
            CALL ECDIFE (IOSAU,NN,ITABE1,IFORM)
            SEGSUP ITBBE1
C
            SEGDES MDEFOR
 2700    CONTINUE
         GOTO 1098
C     ***************************MLREEL******************************
 6018    CONTINUE
         DO 2800 IEL=IDEB,IMAX1
            MLREEL=ITLAC(IEL)
            SEGACT MLREEL
            L=PROG(/1)
            ILENA(1)=L
            ITOTO=1
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFR(IOSAU,L,PROG,IFORM)
            SEGDES MLREEL
 2800    CONTINUE
         GOTO 1098
C     *****************************MLENTI***************************
 6019    CONTINUE
         DO 2900 IEL=IDEB,IMAX1
            MLENTI=ITLAC(IEL)
            SEGACT MLENTI
            L=LECT(/1)
            ILENA(1)=L
            ITOTO=1
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIEE(IOSAU,L,LECT,IFORM)
            SEGDES MLENTI
 2900    CONTINUE
         GOTO 1098
C     ****************************MCHARG*****************************
 6020    CONTINUE
         NN=0
         NM=0
         NM2=0
         SEGINI ITBBM1,itbbc1
         SEGINI ITBBM2,itbbc3
         SEGINI ITBBM3,itbbc4
         SEGINI ITBBM4,itbbc5
         SEGINI ITBBE1
         SEGINI ITBBE2,itbbc2
         DO 3000 IEL=IDEB,IMAX1
           IF (IONIVE.GT.10) THEN
            MCHARG=ITLAC(IEL)
            SEGACT MCHARG*mod
            N=KCHARG(/1)
            ILENA(1)=N
            ITOTO=1
            CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
            NN=2*N
            SEGADJ ITBBE2,itbbc2
            NM=2*N
            SEGADJ ITBBM1,itbbc1
            NM2=N
            SEGADJ ITBBM2,itbbc3
            SEGADJ ITBBM3,itbbc4
            SEGADJ ITBBM4,itbbc5
            NN=7*N
            SEGADJ ITBBE1
            DO 3003 I=1,N
               ICHARG=KCHARG(I)
               SEGACT ICHARG*mod
               I2=2*I
               I3=7*I
               if (ichar(chatyp(1:1)).eq.0) chatyp=' '
               READ (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
               itabc1(i2-1)=chatyp(1:4)
               itabc1(i2)=chatyp(5:8)
               if (ichar(chanat(i)(1:1)).eq.0) chanat(i)=' '
               READ (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
               itabc2(i2-1)=chanat(i)(1:4)
               itabc2(i2)=chanat(i)(5:8)
               if (ichar(chanom(i)(1:1)).eq.0) chanom(i)=' '
               READ (CHANOM(I),FMT='(1A4)') ITABM2(I)
               itabc3(i)=chanom(i)
               if (ichar(chamob(i)(1:1)).eq.0) chamob(i)=' '
               READ (CHAMOB(I),FMT='(1A4)') ITABM3(I)
               itabc4(i)=chamob(i)
               if (ichar(chalie(i)(1:1)).eq.0) chalie(i)=' '
               READ (CHALIE(I),FMT='(1A4)') ITABM4(I)
               itabc5(i)=chalie(i)
               ITABE1(I3-6)=ICHPO1
               ITABE1(I3-5)=ICHPO2
               ITABE1(I3-4)=ICHPO3
               ITABE1(I3-3)=ICHPO4
               ITABE1(I3-2)=ICHPO5
               ITABE1(I3-1)=ICHPO6
               ITABE1(I3)  =ICHPO7
               SEGDES ICHARG
 3003       CONTINUE
            if (iform.ne.2) then
              CALL ECDIFM(IOSAU,2*N,ITABE2,IFORM)
              CALL ECDIFM(IOSAU,N,ITABM2,IFORM)
              CALL ECDIFM(IOSAU,N,ITABM3,IFORM)
              CALL ECDIFM(IOSAU,N,ITABM4,IFORM)
              CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
            endif
            if (iform.eq.2) then
              ios=IXDRSTRING( ixdrw, itabc2(1)(1:4*2*n))
              ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*n))
              ios=IXDRSTRING( ixdrw,itabc4(1)(1:4*n))
              ios=IXDRSTRING( ixdrw,itabc5(1)(1:4*n))
              ios=IXDRSTRING( ixdrw,itabc1(1)(1:4*nm))
            endif
            dimatt = dimatt + (5*n) +nm
            CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
            SEGDES MCHARG

C= Niveaux < 10 :
            ELSE IF(IONIVE.GE.7.AND.IONIVE.LE.10) THEN
               MCHARG=ITLAC(IEL)
               SEGACT MCHARG*mod
               N=KCHARG(/1)
               ILENA(1)=N
               ITOTO=1
               CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
               NN=2*N
               SEGADJ ITBBE2,itbbc2
               NM=2*N
               SEGADJ ITBBM1,itbbc1
               NM2=N
               SEGADJ ITBBM2,itbbc3
               NN=3*N
               SEGADJ ITBBE1
               DO 3002 I=1,N
                  ICHARG=KCHARG(I)
                  SEGACT ICHARG*mod
                  I2=2*I
                  I3=3*I
                  if (ichar(chatyp(1:1)).eq.0) chatyp=' '
                  READ (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
                  itabc1(i2-1)=chatyp(1:4)
                  itabc1(i2)=chatyp(5:8)
                  if (ichar(chanat(i)(1:1)).eq.0) chanat(i)=' '
                  READ (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
                  itabc2(i2-1)=chanat(i)(1:4)
                  itabc2(i2)=chanat(i)(5:8)
                  if (ichar(chanom(i)(1:1)).eq.0) chanom(i)=' '
                  READ (CHANOM(I),FMT='(1A4)') ITABM2(I)
                  itabc3(i)=chanom(i)
                  ITABE1(I3-2)=ICHPO1
                  ITABE1(I3-1)=ICHPO2
                  ITABE1(I3)=ICHPO3
                  SEGDES ICHARG
 3002          CONTINUE
               if (iform.ne.2) CALL ECDIFM(IOSAU,2*N,ITABE2,IFORM)
               if (iform.eq.2)ios=IXDRSTRING( ixdrw, itabc2(1)(1:4*2*n))
               if (iform.ne.2) CALL ECDIFM(IOSAU,N,ITABM2,IFORM)
               if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc3(1)(1:4*n))
               if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
               if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:4*nm))
               dimatt = dimatt + (3*n) +nm
               CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
               SEGDES MCHARG
           ELSE
               MCHARG=ITLAC(IEL)
               SEGACT MCHARG*mod
               N=KCHARG(/1)
               ILENA(1)=N
               ITOTO=1
               CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
               NM=2*N
               SEGADJ ITBBM1,itbbc1
               NN=3*N
               SEGADJ ITBBE1
               DO 3001 I=1,N
                  ICHARG=KCHARG(I)
                  SEGACT ICHARG*mod
                  IF(CHATYP.NE.'CHPOINT ') THEN
*---- cas du nouveau chargement . Incompatible avec niveau 6 ----
                     CALL ERREUR(691)
                     GOTO 1099
                  ENDIF
                  I2=2*I
                  I3=3*I
                  if (ichar(chanat(i)(1:1)).eq.0) chanat(i)=' '
                  READ (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
                  itabc1(i2-1)=chanat(i)(1:4)
                  itabc1(i2)=chanat(i)(5:8)
                  ITABE1(I3-2)=ICHPO1
                  ITABE1(I3-1)=ICHPO2
                  ITABE1(I3  )=ICHPO3
                  SEGDES ICHARG
 3001          CONTINUE
               if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
               if (iform.eq.2) then
                ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4))
                dimatt = dimatt + nm
               endif
               CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
               SEGDES MCHARG
            ENDIF

 3000    CONTINUE
         SEGSUP ITBBE1,ITBBM1,itbbc1,ITBBE2,itbbc2,ITBBM2,itbbc3,
     &          ITBBM3,itbbc4,ITBBM4,itbbc5
         GOTO 1098

C     ****************************        **************************
 6021    CONTINUE
         GOTO 1098
C     *****************************MEVOLL***************************
 6022    CONTINUE
         NN=0
         NM=0
         NM2=20
         SEGINI ITBBM2,itbbc3
         SEGINI ITBBE2,itbbc2
         SEGINI ITBBE1,ITBBM1,itbbc1
         LDECA = 11
         if (ionive.lt.3) LDECA = 7
         LDECA2=18
         DO 3200 IEL=IDEB,IMAX1
            MEVOLL=ITLAC(IEL)
            SEGACT MEVOLL*mod
            N=IEVOLL(/1)
            ILENA(1)=N
            ITOTO=1
            NM2=20
            SEGADJ ITBBM2,itbbc3
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            READ (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2)
            itabc3(1)=ityevo(1:4)
            itabc3(2)=ityevo(5:8)
            if (ichar(ievtex(1:1)).eq.0) ievtex=' '
            READ (IEVTEX,FMT='(18A4)') (ITABM2(2+JPV),JPV=1,18)
            do jpv=1,18
             itabc3(2+jpv)=ievtex(1+(jpv-1)*4:jpv*4)
            enddo
            if (iform.ne.2) CALL ECDIFM (IOSAU,NM2,ITABM2,IFORM)
            if (iform.eq.2) then
             ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*nm2))
             dimatt = dimatt + nm2
            endif
            IF (IONIVE.GE.25) THEN
              NN=6*N
            ELSE
              NN=3*N
            ENDIF
            SEGADJ ITBBE1
            NM=LDECA*N
            SEGADJ ITBBM1,itbbc1
            NM2=LDECA2*N
            SEGADJ ITBBM2,itbbc3
C        LOOP SUR LES KEVOL-
            DO 3201 IN=1,N
               KEVOLL=IEVOLL(IN)
               SEGACT KEVOLL*mod
               IF (IONIVE.GE.25) THEN
                 I4=6*IN
                 ITABE1(I4-5)= IPROGX
                 ITABE1(I4-4)= IPROGY
                 ITABE1(I4-3)= NUMEVX
                 ITABE1(I4-2)= LSTYL
                 ITABE1(I4-1)= MMARQ
                 ITABE1(I4  )= KTAIL
               ELSE
                 I4=3*IN
                 ITABE1(I4-2)= IPROGX
                 ITABE1(I4-1)= IPROGY
                 ITABE1(I4  )= NUMEVX
               ENDIF
               I7=LDECA*(IN-1)
               I8=LDECA2*(IN-1)
               if (ichar(nomevx(1:1)).eq.0) nomevx=' '
               READ (NOMEVX,FMT='(3A4)') (ITABM1(I7+I),I=1,3)
               itabc1(i7+1)=nomevx(1:4)
               itabc1(i7+2)=nomevx(5:8)
               itabc1(i7+3)=nomevx(9:12)
               if (ichar(nomevy(1:1)).eq.0) nomevy=' '
               READ (NOMEVY,FMT='(3A4)') (ITABM1(I7+I+3),I=1,3)
               itabc1(i7+3+1)=nomevy(1:4)
               itabc1(i7+3+2)=nomevy(5:8)
               itabc1(i7+3+3)=nomevy(9:12)
               if (ichar(numevy(1:1)).eq.0) numevy=' '
               READ (NUMEVY,FMT='(A4)') ITABM1(I7 +7)
               itabc1(i7+7)=numevy
               IF(IONIVE.GE.3) THEN
                  if (ichar(typx(1:1)).eq.0) typx=' '
                  READ (TYPX,FMT='(2A4)') (ITABM1(I7+7+I),I=1,2)
                  itabc1(i7+7+1)=typx(1:4)
                  itabc1(i7+7+2)=typx(5:8)
                  if (ichar(typy(1:1)).eq.0) typy=' '
                  READ (TYPY,FMT='(2A4)') (ITABM1(I7+9+I),I=1,2)
                  itabc1(i7+9+1)=typy(1:4)
                  itabc1(i7+9+2)=typy(5:8)
                  if (ichar(kevtex(1:1)).eq.0) kevtex=' '
                  READ(KEVTEX,FMT='(18A4)')(ITABM2(I8+JPV),JPV=1,18)
                  do jpv=1,18
                   itabc3(i8+jpv)=kevtex(1+(jpv-1)*4:4*jpv)
                  enddo
               ENDIF
               SEGDES KEVOLL
 3201       CONTINUE
            SEGDES MEVOLL
            IF (IONIVE.GE.25) THEN
              NN=6*N
            ELSE
              NN=3*N
            ENDIF
            CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
            NN=LDECA*N
            if (iform.ne.2) CALL ECDIFM(IOSAU,NN,ITABM1,IFORM)
            if (iform.eq.2) then
             ios=IXDRSTRING( ixdrw,itabc1(1)(1:4*nn))
             dimatt = dimatt + nn
            endif
            IF(IONIVE.GE.3) then
             if (iform.ne.2) CALL ECDIFM (IOSAU,NM2,ITABM2,IFORM)
             if (iform.eq.2) then
              ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*nm2))
              dimatt = dimatt + nm2
            endif
          endif
 3200    CONTINUE
         SEGSUP ITBBM2,itbbc3
         SEGSUP ITBBE2,itbbc2
         SEGSUP ITBBE1,ITBBM1,itbbc1
         GOTO 1098
C     **********************SUPERELE************************************
 6023    CONTINUE
         NTOTO=6
         ITOTO=1
         DO 230 IEL=IDEB,IMAX1
            MSUPER=ITLAC(IEL)
            SEGACT MSUPER
            ILENA(1)=NTOTO
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            ILENA(1)=MRIGTO
            ILENA(2)=MSUPEL
            ILENA(3)=MSURAI
            ILENA(4)=MBLOQU
            ILENA(5)=MSUMAS
C *** On ecrit MCROUT pour memoire mais il ne sera pas sauve (MMATRI)
            ILENA(6)=MCROUT
            CALL ECDIFE (IOSAU,NTOTO,ILENA,IFORM)
            SEGDES MSUPER
 230     CONTINUE
         GOTO 1098
C     ************************* LOGIQUE  ***************************
 6024    CONTINUE
         ITOTO=1
         IVLON=IMAX1-IDEB+1
         ILENA(1)=IVLON
         CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
         NN=IVLON
         SEGINI ITBBE1
         DO 240 I=1,IVLON
            IVA=ITLAC(I+IDEB-1)
            CALL QUEVAL(IVA,'LOGIQUE ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA)
            IF(LIRA)ITOTO=1
            IF(.NOT.LIRA)ITOTO=0
            ITABE1(I)=ITOTO
 240     CONTINUE
         CALL ECDIFE( IOSAU,IVLON,ITABE1(1),IFORM)
         SEGSUP ITBBE1
         GOTO 1098
C     ************************* FLOTTANT ***************************
 6025    CONTINUE
         ITOTO=1
         IVLON=IMAX1-IDEB+1
         ILENA(1)=IVLON
         L=IVLON
         SEGINI ITABR1
         CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
         DO 250 I=1,IVLON
            IVA=ITLAC(I+IDEB-1)
            CALL QUEVAL(IVA,'FLOTTANT',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA)
            TABR1(I)=XRA
 250     CONTINUE
         CALL ECDIFR(IOSAU,IVLON,TABR1,IFORM)
         SEGSUP ITABR1
         GOTO 1098
C     **************************** ENTIER***************************
 6026    CONTINUE
         IVLON=IMAX1-IDEB+1
         ILENA(1)=IVLON
         ITOTO=1
         CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
         NN=IVLON
         SEGINI ITBBE1
*        write (6,*) ' wrpil ideb ivlon itlacc ',ideb,ivlon,itlacc
         DO 260 I=1,IVLON
            IVA=ITLAC(I+IDEB-1)
            CALL QUEVAL(IVA,'ENTIER  ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA)
            ITABE1(I)=IVALIN
 260     CONTINUE
*        write (6,*) ' wrpil entiers ',(itabe1(i),i=1,ivlon)
         CALL ECDIEE( IOSAU,IVLON,ITABE1(1),IFORM)
         GOTO 1098
C     **************************** MOT   ***************************
 6027    CONTINUE
         NN=0
         NNN=0
         SEGINI ITAMOT
         IVLON=IMAX1-IDEB+1
         DO 270 I=1,IVLON
            IVA=ITLAC(I+IDEB-1)
C  CHA1 EST UNE CHAINE DE 512 CARACTERES
            CALL QUEVAL(IVA,'MOT     ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA)
            NN1=NN
            NN=NN+IVALIN
            NNN=NNN+1
            SEGADJ ITAMOT
            ICOTA(NNN)=NN
            ITAMO(1+NN1:IVALIN+NN1)=CHA1(1:IVALIN)
 270     CONTINUE
         ILENA(1)=NN
         ITOTO=2
         ILENA(2)=IVLON
         CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
         CALL ECDIFC( IOSAU,ITAMO,IFORM)
         CALL ECDIFE( IOSAU,IVLON,ICOTA,IFORM)
         SEGSUP ITAMOT
         GOTO 1098
C     ****************************TEXTE    *************************
 6028    CONTINUE
         DO 2928 IEL=IDEB,IMAX1
            MTEXTE=ITLAC(IEL)
            SEGACT MTEXTE
CCCC  L       =(NCART+3)/4
            L=NCART
            ITOTO=1
            ILENA(1)=L
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFC( IOSAU,MTEXT,IFORM)
            SEGDES MTEXTE
 2928    CONTINUE
         GOTO 1098
C     ****************************LISTMOTS *************************
 6029    CONTINUE
         DO 2929 IEL=IDEB,IMAX1
            MLMOTS=ITLAC(IEL)
            SEGACT MLMOTS
            ILENA(1)=MOTS(/1)
            ILENA(2)=MOTS(/2)
            ITOTO=2
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            NNA=ILENA(1)
            NNN = 0
            NN = ILENA(1)*ILENA(2)
            SEGINI ITAMOT
            DO 2930 IMM=1,ILENA(2)
               ITAMO((IMM-1)*NNA+1:IMM*NNA)=MOTS(IMM)
 2930       CONTINUE
            CALL ECDIFC( IOSAU,ITAMO,IFORM)
            SEGDES MLMOTS
            SEGSUP ITAMOT
 2929    CONTINUE
         GOTO 1098
C     **************************** VECTEUR**************************
 6030    CONTINUE
         DO 300 IEL=IDEB,IMAX1
            MVECTE =ITLAC(IEL)
            CALL WRVECT (MVECTE,IOSAU,IRETOU,IFORM)
 300     CONTINUE
         GOTO 1098
C     ************************* VECTD    ***************************
 6031    CONTINUE
         DO 310 IEL=IDEB,IMAX1
            MVECTD=ITLAC(IEL)
            SEGACT MVECTD
            INC=VECTBB(/1)
            ILENA(1)=INC
            ITOTO=1
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFR(IOSAU,INC,VECTBB,IFORM)
            SEGDES MVECTD
 310     CONTINUE
         GOTO 1098
C     ************************* POINT    ***************************
 6032    CONTINUE
* on sauve tout le itlac car numerotation a pu changer
         ILENA(1)=IMAX1
         ITOTO=1
         CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
         CALL ECDIFE( IOSAU,IMAX1,ITLAC,IFORM)
         GOTO 1098
C     ************************* CONFIG   ***************************
 6033    CONTINUE
         CALL WRCONF(IOSAU,ITLACC,IMAX1,IFORM,IDEB,IDIM,MCOORD)
         GOTO 1098
C     ******************* MLCHPO ************************************
 6034    CONTINUE
         DO 340 IEL=IDEB,IMAX1
            MLCHPO=ITLAC(IEL)
            SEGACT MLCHPO
            N1=ICHPOI(/1)
            ILENA(1)=N1
            ITOTO=1
            CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
            CALL ECDIFE(IOSAU,N1,ICHPOI,IFORM)
            SEGDES MLCHPO
 340     CONTINUE
         GOTO 1098
C     ****************************MBASEM*****************************
 6035    CONTINUE
         NN=0
         DO 3500 IEL=IDEB,IMAX1
            MBASEM=ITLAC(IEL)
            SEGACT MBASEM
            N=LISBAS(/1)
            ITOTO=1
            ILENA(1)=N
            CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
            ITOTO=1
            DO 3501 I=1,N
               MSOBAS=LISBAS(I)
               SEGACT MSOBAS
               NIBST=IBSTRM(/1)
               ILENA(1)=NIBST
               CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
               CALL ECDIFE(IOSAU,NIBST,IBSTRM(1),IFORM)
               SEGDES MSOBAS
 3501       CONTINUE
            SEGDES MBASEM
 3500    CONTINUE
         GOTO 1098
C     **********************PROCEDUR************************************
 6036    CONTINUE
         GOTO 1098
C     **********************BLOC****************************************
 6037    CONTINUE
         GOTO 1098
C     *********************** MODELE MMODEL ****************************
 6038    CONTINUE
         CALL WRMODL(IOSAU,ITLACC,IDEB,IMAX1,IONIVE,IFORM)
         GOTO 1098
C     *********************** MCHAML ***********************************
 6039    CONTINUE
         CALL WRCHAM(IOSAU,ITLACC,IMAX1,IFORM,IONIVE,IDEB)
         GOTO 1098
C     **************************  MINTE  *******************************
 6040    CONTINUE
         L=50*4+6*50*40
         SEGINI ITABR1
         DO 2840 IEL=IDEB,IMAX1
            MINTE=ITLAC(IEL)
            SEGACT MINTE
            NBNO  =SHPTOT(/2)
            NBPGAU=SHPTOT(/3)
            ITOTO = 2
            ILENA(1) = NBNO
            ILENA(2) = NBPGAU
            CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
            LR1=NBPGAU*4+6*NBPGAU*NBNO
            if (LR1.gt.L) then
              write(ioimp,*) 'WRPIL - MINTE - segadj',L,LR1
              L = LR1
              segadj,ITABR1
            endif
            I=0
            DO 2841 IC=1,NBPGAU
               I=I+1
               TABR1(I)=POIGAU(IC)
               I=I+1
               TABR1(I)=QSIGAU(IC)
               I=I+1
               TABR1(I)=ETAGAU(IC)
               I=I+1
               TABR1(I)=DZEGAU(IC)
               DO 2842 IB=1,NBNO
                  DO 2843 IA=1,6
                     I=I+1
                     TABR1(I)=SHPTOT(IA,IB,IC)
 2843             CONTINUE
 2842          CONTINUE
 2841       CONTINUE
            CALL ECDIFR(IOSAU,LR1,TABR1,IFORM)
            SEGDES MINTE
 2840    CONTINUE
         SEGSUP ITABR1
         GOTO 1098
C     *********************** NUAGE ***************************
 6041    CONTINUE
         CALL WRNUAG(IOSAU,ITLACC,IMAX1,IFORM,IDEB)
         GOTO 1098
C     ********************** MATRAK *********************************
 6042    CONTINUE
         CALL WRMTAK(IOSAU,ITLACC,IMAX1,IFORM,IDEB)
         GOTO 1098
C     ********************** MATRIK *********************************
 6043    CONTINUE
         CALL WRMTIK(IOSAU,ITLACC,IMAX1,IFORM,IDEB)
         GOTO 1098
C     *****************************METHODE *********************
 6045    CONTINUE
         IVLON=IMAX1-IDEB+1
C      APPELE PAR WRPI
         ILENA(1)=IVLON
         ITOTO=1
         CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
         CALL ECDIFE(IOSAU,IVLON,ITLAC(IDEB),IFORM)
         GOTO 1098

C     *********************** IELVAL ***********************************
 6048    CONTINUE
C  Ecriture des IELVAL depuis le niveau 20 :
         if (IONIVE.lt.20) goto 1098
         CALL WRIELV(IOSAU,ITLACC,IDEB,IMAX1,IONIVE,IFORM)
         GOTO 1098

C     *********************** ANNOTATI *********************************
 6049    CONTINUE
         GOTO 1098
C     *********************** LISTOBJE**********************************
 6050    CONTINUE
         DO 550 IEL=IDEB,IMAX1
            MLOBJE=ITLAC(IEL)
            IF (MLOBJE.EQ.0) GOTO 550
            SEGACT, MLOBJE
            NOB1=LISOBJ(/1)
            IF (IONIVE.GT.27) THEN
              NRE1=RLIREE(/1)
            ELSE
              NRE1=0
            ENDIF
            N1=MAX(NOB1,NRE1)
            ITYPO = TYPOBJ
            IK = 1
            IF (NRE1.GT.0) IK = 2
C           write(6,*) '**** ITYPO=',ITYPO
            ILENA(1)=NOB1
            ILENA(2)=NRE1
            ITOTO=2
            CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM)
            NM2 = 2
            SEGINI, ITBBM2,itbbc3
            READ (ITYPO,FMT='(2A4)') ITABM2(1),ITABM2(2)
            itabc3(1)=TYPOBJ(1:4)
            itabc3(2)=TYPOBJ(5:8)
C           write(6,*) '**** ITABM2=',ITABM2(1),ITABM2(2)
            if (iform.ne.2) CALL ECDIFM(IOSAU,NM2,ITABM2,IFORM)
            if (iform.eq.2) then
              ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*nm2))
              dimatt = dimatt + nm2
            endif
C           write(6,*) '**** LISOBJ(1)=',LISOBJ(1)
            IF (IK.EQ.1) CALL ECDIFE(IOSAU,N1,LISOBJ,IFORM)
            IF (IK.EQ.2) CALL ECDIFR(IOSAU,N1,RLIREE,IFORM)
            SEGDES, MLOBJE
 550     CONTINUE
         GOTO 1098

C     *********************** IMODEL ***********************************
 6051    CONTINUE
c-dbg         write(ioimp,*) 'WRPIL->WRIMOD',IONIVE
C  Ecriture des IMODEL depuis le niveau 26 :
         if (IONIVE.lt.26) goto 1098
         CALL WRIMOD(IOSAU,ITLACC,IDEB,IMAX1,IONIVE,IFORM)
         GOTO 1098

C     ******************************************************************

 1098    CONTINUE

C     ********************** Fin de boucle IFILE **********************
 1099 CONTINUE

C     **********************MSOLUT: TRAITE EN DERNIER*****************
      IFILE=8
      ITLACC=KCOLA(IFILE)
      IMAX1=ITLAC(/1)
      IDEB=1
      IF(IPSAUV.NE.0) IDEB=KCOLAC(IFILE)+1
      IF(IMAX1.LT.IDEB) GOTO 2099
      ITYPE='        '
      CALL TYPFIL(ITYPE,IFILE)
      WRITE(IOIMP,801)IFILE,IMAX1,ITYPE
      IP1=ICOLA(IFILE)
      ITLACC=KCOLA(IFILE)

      CALL NOMMEF(IP1,IMAX1,IFILE,IFORM,IDEB,isilen)
      if (IONIVE.le.2) goto 2099
      DO 1800 IEL=IDEB,IMAX1
         MSOLUT=ITLAC(IEL)
         CALL WRSOLU(MSOLUT,IRETOU,IFORM)
 1800 CONTINUE
C     *****************************************************************
 2099 CONTINUE
C
      IQUOI=5
      CALL ECDES(IOSAU,IQUOI,IFORM)
      IF (IFORM.EQ.0) WRITE(IOSAU) LABEL
      IF (IFORM.EQ.1) WRITE(IOSAU,772) LABEL
 772  FORMAT(A72)
      if (iform.eq.2) then
        ios=IXDRSTRING( ixdrw, label(1:72))
        dimatt = dimatt + 18
      else
*       sur certaines machines, la fermeture du fichier pouvait poser
*       probleme (buffer non ecrit avant de sortir de castem)
        CALL FLUSH(IOSAU)
      endif

      MOTERR=LABEL
      CALL ERREUR(-345)
      SEGDES,ICOLAC

      RETURN
      END