C WRMTIK    SOURCE    MAGN      09/07/30    21:21:14     6458           
      SUBROUTINE WRMTIK(IFSAU,ITLACC,IMAX1,IFORM,IDEB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C***********************************************************************
C NOM         : WRMTIK
C DESCRIPTION : Ecriture des objets de type MATRIK sur le
C               fichier IFSAU
C               (appelé par wrpil.eso)
C     
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES (E/S)    : ECDIFE (ecriture d'un tableau d'entiers)
C                    ECDIFR (ecriture d'un tableau de REAL*8)
C                    ECDIFM (ecriture d'un tableau de CHARACTER*4)
C***********************************************************************
C SYNTAXE GIBIANE    : SAUV
C ENTREES            : IFSAU, numéro du fichier en écriture
C                      IDEB, IMAX1, indice de début et de fin
C                      de la pile des objets MATRIK (ITLACC)
C                      à écrire.
C                      IFORM, le fichier a ecrire est formaté ou
C                             non.
C***********************************************************************
C VERSION    : v1, 15/07/98, version initiale
C HISTORIQUE : v1, 15/07/98, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCOPTIO
-INC SMMATRIK
-INC TMCOLAC
      SEGMENT/ITBBM1/( ITABM1(NM))
C     
      INTEGER NDTAB
      INTEGER IEL,I,J,K,L
      INTEGER ILENA(11)
      INTEGER IV1,IV2,IV3,IV4
C======================================================================
*     
* Executable statements
*     
C     
C ... BOUCLE SUR LES MATRIK DE LA PILE
      NM=0
      SEGINI ITBBM1
      DO 1 IEL=IDEB,IMAX1
         MATRIK=ITLAC(IEL)
         IF (MATRIK.EQ.0) THEN
            WRITE(IOIMP,*) 'Failing to save a nil pointer'
            WRITE(IOIMP,*) 'MATRIK type object...'
            GOTO 9999
         ENDIF
C.... On initialise des piles d'objets non connus de CASTEM
C     MINC, PMORS, IZA, IDMAT
C     (Pb : des entiers distincts (par ex. KISPGP, KISPGT)
C      peuvent etre egaux (i.e. pointer sur le meme objet)
C      On ne veut pas sauvegarder l'objet deux fois...)
         SEGINI ITLAC1
         SEGINI ITLAC2
         SEGINI ITLAC3
         SEGINI ITLAC4
C     Sauvegarde du chapeau
C       Dimensions
         SEGACT MATRIK
         NRIGE =IRIGEL(/1)
         NMATRI=IRIGEL(/2)
         NKID=KIDMAT(/1)
         NKMT=KKMMT(/1)
         ILENA(1)=NRIGE
         ILENA(2)=NMATRI
         ILENA(3)=NKID
         ILENA(4)=NKMT
         NDTAB=4
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
C       Rigidités élémentaires
         NDTAB = NRIGE * NMATRI
         CALL ECDIFE(IFSAU,NDTAB,IRIGEL,IFORM)
C       Matrice assemblée
         ILENA( 1)=KSYM
         ILENA( 2)=KMINC
         ILENA( 3)=KMINCP
         ILENA( 4)=KMINCD
         ILENA( 5)=KIZM
         ILENA( 6)=KISPGT
         ILENA( 7)=KISPGP
         ILENA( 8)=KISPGD
         ILENA( 9)=KNTTT
         ILENA(10)=KNTTP
         ILENA(11)=KNTTD
         NDTAB=11
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
         NDTAB=NKID
         CALL ECDIFE(IFSAU,NDTAB,KIDMAT,IFORM)
         NDTAB=NKMT
         CALL ECDIFE(IFSAU,NDTAB,KKMMT,IFORM)
C     Sauvegarde des IMATRI
         DO 11 I=1,NMATRI
            IMATRI=IRIGEL(4,I)
            IF (IMATRI.NE.0) THEN
               SEGACT IMATRI
               NBSOUS=LIZAFM(/1)
               NBME=LIZAFM(/2)
               ILENA(1)=NBSOUS
               ILENA(2)=NBME
               NDTAB=2
               CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
               NM=4*NBME
               SEGADJ ITBBM1
               DO 111 J=1,NBME
                  J4=(4*J)-3
                  READ (LISPRI(J),FMT='(2A4)') ITABM1(J4),ITABM1(J4+1)
                  READ (LISDUA(J),FMT='(2A4)') ITABM1(J4+2),ITABM1(J4+3)
 111           CONTINUE
               CALL ECDIFM(IFSAU,NM,ITABM1,IFORM)
               NDTAB=NBSOUS*NBME
               CALL ECDIFE(IFSAU,NDTAB,LIZAFM,IFORM)
               ILENA(1)=KSPGP
               ILENA(2)=KSPGD
               NDTAB=2
               CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
C        Sauvegarde des IZAFM
               DO 112 K=1,NBME
                  DO 1121 L=1,NBSOUS
                     IZAFM=LIZAFM(L,K)
                     IF (IZAFM.NE.0) THEN
                        SEGACT IZAFM
                        NBEL=AM(/1)
                        NP  =AM(/2)
                        MP  =AM(/3)
                        ILENA(1)=NBEL
                        ILENA(2)=NP
                        ILENA(3)=MP
                        NDTAB=3
                        CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
                        NDTAB=NBEL*NP*MP
                        CALL ECDIFR(IFSAU,NDTAB,AM,IFORM)
                        SEGDES IZAFM
                     ENDIF
 1121             CONTINUE
 112           CONTINUE
               SEGDES IMATRI
            ENDIF
 11      CONTINUE
C     Sauvegarde des MINC
         IV1=KMINC
         IF (IV1.NE.0) THEN
            CALL AJOUN2(ITLAC1,IV1)
         ENDIF
         JMINC=IV1
         IV1=KMINCP
         IF (IV1.NE.0) THEN
            CALL AJOUN2(ITLAC1,IV1)
         ENDIF
         JMINCP=IV1
         IV1=KMINCD
         IF (IV1.NE.0) THEN
            CALL AJOUN2(ITLAC1,IV1)
         ENDIF
         JMINCD=IV1
         NBMINC=MAX(JMINC,JMINCP,JMINCD)
         ILENA(1)=NBMINC
         ILENA(2)=JMINC
         ILENA(3)=JMINCP
         ILENA(4)=JMINCD
         NDTAB=4
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
         DO 12 I=1,NBMINC
            MINC=ITLAC1.ITLAC(I)
            SEGACT MINC
            NPT=MPOS(/1)
            NBI=MPOS(/2)-1
            ILENA(1)=NPT
            ILENA(2)=NBI
            NDTAB=2
            CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
            NM=2*NBI
            SEGADJ ITBBM1
            DO 121 J=1,NBI
               J2=(2*J)-1
               READ (LISINC(J),FMT='(2A4)') ITABM1(J2),ITABM1(J2+1)
 121        CONTINUE
            CALL ECDIFM(IFSAU,NM,ITABM1,IFORM)
            NDTAB=NPT+1
            CALL ECDIFE(IFSAU,NDTAB,NPOS,IFORM)
            NDTAB=NPT*(NBI+1)
            CALL ECDIFE(IFSAU,NDTAB,MPOS,IFORM)
            SEGDES MINC
 12      CONTINUE
C     Sauvegarde des PMORS
         IV2=KIDMAT(4)
         IF (IV2.NE.0) THEN
            CALL AJOUN2(ITLAC2,IV2)
         ENDIF
         JMORS=IV2
         IV2=KIDMAT(6)
         IF (IV2.NE.0) THEN
            CALL AJOUN2(ITLAC2,IV2)
         ENDIF
         JMRST=IV2
         NBMORS=MAX(JMORS,JMRST)
         ILENA(1)=NBMORS
         ILENA(2)=JMORS
         ILENA(3)=JMRST
         NDTAB=3
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
         DO 13 I=1,NBMORS
            PMORS=ITLAC2.ITLAC(I)
            SEGACT PMORS
            NTT=IA(/1)-1
            NJA=JA(/1)
            ILENA(1)=NTT
            ILENA(2)=NJA
            NDTAB=2
            CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
            NDTAB=NTT+1
            CALL ECDIFE(IFSAU,NDTAB,IA,IFORM)
            NDTAB=NJA
            CALL ECDIFE(IFSAU,NDTAB,JA,IFORM)
            SEGDES PMORS
 13      CONTINUE
C     Sauvegarde des IDMAT (faite avant les IZA
C     car IDIAG pointe sur un IZA)
         IV4=KIDMAT(1)
         IF (IV4.NE.0) THEN
            CALL AJOUN2(ITLAC4,IV4)
         ENDIF
         JDMATP=IV4
         IV4=KIDMAT(2)
         IF (IV4.NE.0) THEN
            CALL AJOUN2(ITLAC4,IV4)
         ENDIF
         JDMATD=IV4
         NBIDMA=MAX(JDMATP,JDMATD)
         ILENA(1)=NBIDMA
         ILENA(2)=JDMATP
         ILENA(3)=JDMATD
         NDTAB=3
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
C     Sauvegarde des IZA
         IV3=KIDMAT(3)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JS2B=IV3
         IV3=KIDMAT(5)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JISA=IV3
         IV3=KIDMAT(7)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JIST=IV3
         IV3=KKMMT(4)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JZDU=IV3
         IV3=KKMMT(5)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JZDP=IV3
         IV3=KKMMT(6)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JZFU=IV3
         IV3=KKMMT(7)
         IF (IV3.NE.0) THEN
            CALL AJOUN2(ITLAC3,IV3)
         ENDIF
         JZFP=IV3
         NBIZA=MAX(JS2B,JISA,JIST,JZDU,JZDP,JZFU,JZFP)
C     On sauvegarde les IZA contenus dans les IDMAT
         DO 16 I=1,NBIDMA
            IDMAT=ITLAC4.ITLAC(I)
            SEGACT IDMAT*MOD
            NBLK=IDESCL(/1)
C       IDIAG
            IV3=IDIAG
            IF (IV3.NE.0) THEN
               CALL AJOUN2(ITLAC3,IV3)
               NBIZA=MAX(NBIZA,IV3)
            ENDIF
            IDIAG=IV3
C       IDESCL
            DO 161 J=1,NBLK
               IV3=IDESCL(J)
               IF (IV3.NE.0) THEN
                  CALL AJOUN2(ITLAC3,IV3)
                  NBIZA=MAX(NBIZA,IV3)
               ENDIF
               IDESCL(J)=IV3
 161        CONTINUE
C       IDESCU
            DO 162 J=1,NBLK
               IV3=IDESCU(J)
               IF (IV3.NE.0) THEN
                  CALL AJOUN2(ITLAC3,IV3)
                  NBIZA=MAX(NBIZA,IV3)
               ENDIF
               IDESCU(J)=IV3
 162        CONTINUE
            SEGDES IDMAT
 16      CONTINUE
         DO 15 I=1,NBIDMA
            IDMAT=ITLAC4.ITLAC(I)
            SEGACT IDMAT
            NTT =KZA(/1)
            NPT =NUAN(/1)
            NBLK=IDESCL(/1)
            ILENA(1)=NTT
            ILENA(2)=NPT
            ILENA(3)=NBLK
            ILENA(4)=IDIAG
            NDTAB=4
            CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
            NDTAB=NTT
            CALL ECDIFE(IFSAU,NDTAB,KZA,IFORM)
            NDTAB=2*NTT
            CALL ECDIFE(IFSAU,NDTAB,NUIA,IFORM)
            NDTAB=NPT
            CALL ECDIFE(IFSAU,NDTAB,NUAN,IFORM)
            NDTAB=NPT
            CALL ECDIFE(IFSAU,NDTAB,NUNA,IFORM)
            NDTAB=NBLK
            CALL ECDIFE(IFSAU,NDTAB,IDESCL,IFORM)
            NDTAB=NBLK
            CALL ECDIFE(IFSAU,NDTAB,IDESCU,IFORM)
            NDTAB=NBLK+1
            CALL ECDIFE(IFSAU,NDTAB,NLDBLK,IFORM)
            SEGDES IDMAT
 15      CONTINUE
         ILENA( 1)=NBIZA
         ILENA( 2)=JS2B
         ILENA( 3)=JISA
         ILENA( 4)=JIST
         ILENA( 5)=JZDU
         ILENA( 6)=JZDP
         ILENA( 7)=JZFU
         ILENA( 8)=JZFP
         NDTAB=8
         CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
         DO 14 I=1,NBIZA
            IZA=ITLAC3.ITLAC(I)
            SEGACT IZA
            NBVA=A(/1)
            ILENA(1)=NBVA
            NDTAB=1
            CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
            NDTAB=NBVA
            CALL ECDIFR(IFSAU,NDTAB,A,IFORM)
            SEGDES IZA
 14      CONTINUE
C    Restauration des pointeurs des IZA dans IDMAT
         DO 17 I=1,NBIDMA
            IDMAT=ITLAC4.ITLAC(I)
            SEGACT IDMAT*MOD
            NBLK=IDESCL(/1)
C       IDIAG
            IV3=IDIAG
            IF (IV3.NE.0) IDIAG=ITLAC3.ITLAC(IV3)
C       IDESCL
            DO 171 J=1,NBLK
               IV3=IDESCL(J)
               IF (IV3.NE.0) IDESCL(J)=ITLAC3.ITLAC(IV3)
 171        CONTINUE
C       IDESCU
            DO 172 J=1,NBLK
               IV3=IDESCU(J)
               IF (IV3.NE.0) IDESCU(J)=ITLAC3.ITLAC(IV3)
 172        CONTINUE
            SEGDES IDMAT
 17      CONTINUE
         SEGDES MATRIK
         SEGSUP ITLAC4
         SEGSUP ITLAC3
         SEGSUP ITLAC2
         SEGSUP ITLAC1
 1    CONTINUE
      SEGSUP ITBBM1
*     
* Normal termination
*     
      RETURN
*     
* Format handling
*     
*     
* Error handling
*     
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine wrmtik'
      RETURN
*     
* End of subroutine WRMTIK
*     
      END