[updated 8.Sep.2008]

      SUBROUTINE ECCTRM (NOMTRM,NIVTRM)

  Auteur : O.DeBayser (Octobre 1989)
  Derniere modification : D.Martin (2 juin 1994)
  Version 1.0.0
   
  Ecriture du terme de nom NOMTRM  de niveau NIVTRM si NIVTRM > 0 
  ou de tous les termes de nom NOMTRM si NIVTRM=0
  et des coordonnees des noeuds ou il est defini
  sur le fichier de meme nom
 
  LE PRINCIPE DE CETTE PROCEDURE EST ENTIEREMENT A REVOIR :
  - separer les coordonnees
  - comment ne pas ecraser des termes de meme NOM/NIVEAU
    lors d'iterations ....
                                  Signe : Le vengeur masque
   
 -- Arguments d'entree -- 
  NOMTRM Nom des termes a envoyer sur le fichier
  NIVTRM Si > 0 niveau du terme de nom NOMTRM a ecrire 
         Si = 0 ecriture de tous les termes de nom NOMTRM sur le fichier
 ** Ecritures en sortie ***
  NDIM,NBCOOR dimension d'espace,nombre de points
  POINTS      'ndim' coordonnees par point
  NVTERM,NCPINL,NBVECT,ITYPTR niveau du terme(0 si plusieurs)
                             nombre de composantes par vecteurs
                             nombre de vecteurs
                             type 2 pour 'reel' ou 4 pour 'complexe'
  VECTEURS    'ncpinl' valeurs par vecteur

      CHARACTER*(*) NOMTRM
      INTEGER NIVTRM
   
      INCLUDE 'ALLOC'
      INCLUDE 'CONTEX'
   
      CHARACTER     ERCODE*120,NOMWRK*16
      INTEGER       KLUNIT,KELCHN,KLTERM
      INTEGER       IUNIT,NVTERM,MCMTRM,MCDTRM,LGENTE,NBTERM,INCTRM
     &             ,NCHTRM
      LOGICAL       OPNED,FIRST
      COMMON/FORMAH/ERCODE 
      EQUIVALENCE  (NOMWRK,ERCODE(105:105))

      CALL PRFXMJ (1,'*EccTrm*')
 
      NOMWRK=NOMTRM
      NVTERM=NIVTRM
      CALL TBAR2  (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
      CALL SDEXDB (IST(MCDTRM),LGENTE,NBTERM,INCTRM,NCHTRM)             !utilite
 
      Ouverture du fichier
 
      INQUIRE (FILE=NOMTRM,NUMBER=IUNIT,OPENED=OPNED,EXIST=FIRST
     &       ,ERR=99901)
      IF ((.NOT.FIRST).OR.(FIRST.AND..NOT.OPNED)) THEN
         IUNIT=KLUNIT ()                                                !sdexplo
         OPEN (UNIT=IUNIT,FILE=NOMTRM,STATUS='UNKNOWN'
     &        ,ACCESS='SEQUENTIAL',FORM='FORMATTED',ERR=99902)
      ENDIF
      FIRST=.TRUE.
      ICAR  =0
      NBCOAV=0
 
1     NUTERM=0 
      NUTERM=KELCHN (NOMWRK(:NCHTRM),AST(MCMTRM+ICAR),NBTERM,NCHTRM)    !utilite
      IF (NUTERM.LE.0) CALL ERTERM (1,NOMTRM,NIVTRM)                    !utilite
      IF (NVTERM.EQ.0)  
     &   NUTERM=KLTERM (NOMWRK(:NCHTRM),NVTERM,AST(MCMTRM),IST(MCDTRM)) !sdexplo
 
      On cherche les caracteristiques du terme
 
      CALL TBAR2  (ERCODE,'$SDTRM',1,MCDTRM,'#NCONU',1,MCINCO)
      IADTRM=MCDTRM+LGENTE+INCTRM*(NUTERM-1)
      CALL GETTRV (IST(IADTRM),NVTERM,ITYPTR,ITYCAL,NUKALE,NUDONN
     &            ,IPTDIR,NUINCO,NVDUME,NBCOEF,NVNUME,NVCORC,IATRDO
     &            ,NIVIMP)                                              !utilite
      CALL SDEXCO (NUINCO,IST(MCINCO),NCPINL,INTERP,NBTNEL)             !utilite
 
      CALL TBRR3  (ERCODE,NOMTRM,NVTERM,LGTERM,'#ORNOE',INTERP,MCCOOR
     &                                        ,'#GNEDO',NVNUME,MCNUME)
      CALL TBAR3  (ERCODE,NOMTRM,NVTERM,MCTERM,'#ORNOE',INTERP,MCCOOR
     &                                        ,'#GNEDO',NVNUME,MCNUME)
 
      IF (FIRST) THEN
         CALL TBRR2  (ERCODE,'#ORNOE',INTERP,MCCOOR
     &                      ,'#GNEDO',NVNUME,MCNUME)
         CALL TBAR2  (ERCODE,'#ORNOE',INTERP,MCCOOR
     &                      ,'#GNEDO',NVNUME,MCNUME)
         WRITE (IUNIT,*) NDIM,NBCOEF
         MCNUME=MCNUME+1
         NBCOEF=IST(MCNUME)
         DO 10 I=1,NBCOEF
            IACOOR = MCCOOR+NDIM*(IST(MCNUME+I)-1)
            WRITE (IUNIT,*) (RST(IDIM),IDIM=IACOOR,IACOOR+NDIM-1)
10       CONTINUE
         CALL TBSAVE ('#GNEDO',NVNUME)
         CALL TBSAVE ('#ORNOE',INTERP)
      ENDIF 
      CALL TBRR1  (ERCODE,NOMTRM,NVTERM,LGTERM)
      CALL TBAR1  (ERCODE,NOMTRM,NVTERM,MCTERM)
      WRITE (IUNIT,*) NVTERM,NCPINL,LGTERM/NCPINL,ITYPTR
      IF(ITYPTR.EQ.INTTYP('REEL')) THEN
         IATERM=MCTERM
         DO 12 I=1,LGTERM/NCPINL
            WRITE (IUNIT,*) (RST(IATERM-1+ICOMP),ICOMP=1,NCPINL)
            IATERM=IATERM+NCPINL
12       CONTINUE
      ELSE 
         IATERM=MCTERM
         DO 14 I=1,LGTERM/NCPINL
            WRITE (IUNIT,*) (CST(IATERM-1+ICOMP),ICOMP=1,NCPINL)
            IATERM=IATERM+NCPINL
14       CONTINUE
      ENDIF
      CALL TBSAVE ( NOMTRM ,NVTERM)
      IF (NIVTRM.LE.0) THEN 
         On va au terme suivant si il y a lieu ... 
         ICAR  =NUTERM*NCHTRM
         NBTERM=NBTERM-NUTERM
         FIRST =.FALSE.
         NVTERM=0
         GOTO 1
      ENDIF
99999 IF (NIVTRM.LE.0) THEN
         WRITE (IMPMES,10001) NOMWRK(1:NCHTRM),NIVTRM
      ELSE
         WRITE (IMPMES,10000) NOMWRK(1:NCHTRM),NIVTRM
      ENDIF
 
      CALL PRFXMJ (-1,'*EccTrm*')  
      RETURN

10000 FORMAT(' *EccTrm* Ecriture des termes ',A
     &,' sur un fichier de meme nom')
10001 FORMAT(' *EccTrm* Ecriture du terme ',A,' niveau',I4
     &,' sur un fichier de meme nom')

99900 CALL PRNOMS ('#OMTRM',1,NCHTRM,NBTERM,IMPPAL)                     !prsd
      CALL BAISE  (' Terme '//NOMWRK(1:NCHTRM)//' inexistant!')
99901 CALL BAISE  ('Probleme sur ''INQUIRE'' avec le fichier'
     &//NOMWRK(:NCHTRM))
99902 NOMWRK=NOMTRM
      CALL ENCLER (IUNIT,ERCODE(1:4))  
      CALL BAISE  (' Probleme d''ouverture du fichier '
     &//NOMWRK(1:NCHTRM) //' - Unite logique '//ERCODE(1:4))
                                                                    END !EccTrm