C ZPMODE    SOURCE    FANDEUR   14/01/22    21:15:20     7891           

*---------------------------------------
*      ECRITURE D'UN OBJET MODELE
*---------------------------------------

      SUBROUTINE ZPMODE (MMODEL)

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

-INC CCOPTIO
-INC CCHAMP

-INC SMMODEL

       character*16 mderiv(6)
       character*8 nomtyp(14)
       character*512 motlib
       logical b_z

       DATA MDERIV/'Lineaire        ','Quadratique     ',
     $  'TRUSDELL        ','JAUMANN         ','Utilisateur     ',
     $  'FEFP            '/      
       data nomtyp/
     1              'DEPLACEM', 'FORCES  ', 'GRADIENT', 'CONTRAIN',
     1              'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
     1              'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL',             
     1              'DEFINELA', 'PARAMEXT'/
      SEGACT,MMODEL
      N1=KMODEL(/1)

      WRITE(IOIMP,190)
      WRITE(IOIMP,200)
      WRITE(IOIMP,201)
      WRITE(IOIMP,210) N1
      WRITE(IOIMP,201)
      WRITE(IOIMP,200)

      DO N=1,N1
        IMODEL=KMODEL(N)
        SEGACT,IMODEL
        WRITE(IOIMP,2) N
        WRITE(IOIMP,3) IMAMOD,NOMTP(NEFMOD)
        IF (CONMOD.NE.'                ') WRITE(IOIMP,4)CONMOD
        IF (conmod(17:24).NE.'        ') WRITE(IOIMP,8) conmod(17:24)

        nfor = formod(/2)
        NMAT = MATMOD(/2)
        nobmod = tymode(/2)

        WRITE(IOIMP,5) (FORMOD(i),i=1,NFOR)
        IF (IPDPGE.NE.0) WRITE(IOIMP,7) IPDPGE
        IF (NMAT.NE.0) WRITE(IOIMP,6) (MATMOD(i),i=1,NMAT)
        mecfor=0
        mdifor = 0
        do i=1,nfor
          if(formod(i).eq.'MECANIQUE'.or.formod(i).eq.'POREUX')mecfor=1
          if(formod(i).eq.'DIFFUSION') mdifor=1
        enddo
        if(mecfor.eq.1) write(ioimp,27) mderiv(ideriv) 

        do io=1,14
          nomid = lnomid(io)
          if(nomid.ne.0) then
             segact nomid
             if(lesobl(/2).ne.0) then
               write(ioimp,20) nomtyp(io)
          if(lesobl(/2).NE.0)write(ioimp,21)(lesobl(iu),iu=1,lesobl(/2))
          if(lesfac(/2).NE.0)write(ioimp,21)(lesfac(iu),iu=1,lesfac(/2))  
             endif      
             segdes nomid
          endif
        enddo
c*      if( formod(1).eq.'MECANIQUE'.or.formod(1).eq.'POREUX'. or.
c*   $ formod(/2).eq.2) then
        if( mecfor.eq.1 .OR. nfor.EQ.2 ) then
         write(ioimp,23)(infele(iu),iu=1,6),infele(13),infele(14)      
        endif
c*        if (inatuu.ne.0 .or. imatee.ne.0) then
        if (inatuu.ne.0) then
          write(ioimp,22) cmatee, imatee, inatuu
          if (inatuu.eq.-1) then
            write(ioimp,221) matmod(nmat)
          endif
          if (inatuu.eq.-2) then
            iviex = 0
            CALL PLACE(tymode,nobmod,iviex,'IVIEX   ')
            write(ioimp,222) ivamod(iviex)
          endif
        endif

*       if (infmod(/1).gt.2)  write(IOIMP,*)
*     $ 'segment d integtration ',(infmod(iu),iu=3,infmod(/1))                  

        IF (nobmod.NE.0) THEN
          if ((mecfor.eq.1 .and. inatuu.lt.0) .or. mdifor.eq.1) then
            noblib = 0
            if (mdifor.eq.1) then
              CALL PLACE(tymode,nobmod,noblib,'LDIEXT  ')
            else
              CALL PLACE(tymode,nobmod,noblib,'LMEEXT  ')
            endif
            if (noblib.gt.0) then
              call queval(ivamod(noblib+1),'MOT',ier,lgmot,r_z,
     &                    motlib,b_z,i_z)
              lglib = INDEX(motlib,'=')
              if (lglib.gt.41) then
                write(ioimp,223) motlib(1:40)//'...'
              else
                write(ioimp,223) motlib(1:lglib-1)
              endif               
              write(ioimp,224) motlib(lglib+1:lgmot)
            endif
          else
            WRITE(IOIMP,12) (TYMODE(i),IVAMOD(i),i=1,nobmod)
          endif
        ENDIF

        SEGDES,IMODEL
      ENDDO
      SEGDES,MMODEL

      WRITE(IOIMP,190)

 190  FORMAT(//)
 200  FORMAT(1X,'+',77('-'),'+')
 201  FORMAT(1X,'|',T80,'|')
 210  FORMAT(' |          OBJET MMODEL CONTENANT ',I6,
     .       ' ZONE(S) ELEMENTAIRE(S) '     ,T80,'|')
 2    FORMAT(//10X,' MODELE ASSOCIE A LA ZONE ELEMENTAIRE',I6/
     .         10X,' ------------------------------------------')
 3    FORMAT(/1X,'  POINTEUR SUR L''OBJET MAILLAGE : ',I9,/,
     .        1X,'  TYPE D''ELEMENT FINI  :  ',3X,A4)
 4    FORMAT(1X,'  NOM DU CONSTITUANT   :  ',3X,A24)
 5    FORMAT(1X,'  FORMULATION          :  ',5(3X,A16))
 6    FORMAT(1X,'  MODELE DE MATERIAU   :  ',5(3X,A16))
 7    FORMAT(1X,'  POINT SUPPORT DPGE   :  ',I9)
 8    FORMAT(1X,'  NOM DE LA PHASE      :  ',3X,A8)
 9    FORMAT(1X,'  VARIABLES INTERNES   :    ',12(1X,A4))
 10   FORMAT(1X,'  PARAMETRES MATERIAUX :    ',12(1X,A4))
 12   FORMAT('   Liste des objets associes : type-valeur',/,
     .       3(1X,A8,2X,I9,10X))
 20   FORMAT(1x,'  Liste des noms de composantes de ',a8)
 21   format (10x, 16(A4,1X))
 22   format(1x,'  MATERIAU cmate imate inatu   : ',a8,2I5)
 221  format(1x,'           NOM LOI UTILISATEUR : "',a16,'"')
 222  format(1x,'           LOI VISCO_EXTERNE   : ',I5)
 223  format(1x,'           "LIBRAIRIE" EXTERNE : "',A,'"')
 224  format(1x,'           "FONCTION" EXTERNE  : "',A,'"')
 23   format(1X,'  numero de l element fini (nefmod):' , i5,/, 
     $       1X,'  points integration epaisseur     :' , i5,/,
     $       1X,'  points de gauss pour masse       :' , i5,/,
     $       1X,'  points support de contraintes    :' , i5,/,
     $       1X,'  nombre de caracteristiques       :' , i5,/, 
     $       1X,'  points de gauss pour rigidite    :' , i5,/, 
     $       1X,'  numero de la formulation E.F(mfr):' , i5,/,
     $       1X,'  numero de  l element geometrique :' , i5)
 27   format(1x,'  Hypothese de deformations : ',a16)               

      RETURN
      END