c@a
c@versb
C-----------------------------------------------------------------------
C
CVERS                  Code_Saturne version 1.3
C                      ------------------------
C
C     This file is part of the Code_Saturne Kernel, element of the
C     Code_Saturne CFD tool.
C
C     Copyright (C) 1998-2008 EDF S.A., France
C
C     contact: saturne-support@edf.fr
C
C     The Code_Saturne Kernel is free software; you can redistribute it
C     and/or modify it under the terms of the GNU General Public License
C     as published by the Free Software Foundation; either version 2 of
C     the License, or (at your option) any later version.
C
C     The Code_Saturne Kernel is distributed in the hope that it will be
C     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
C     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C
C     You should have received a copy of the GNU General Public License
C     along with the Code_Saturne Kernel; if not, write to the
C     Free Software Foundation, Inc.,
C     51 Franklin St, Fifth Floor,
C     Boston, MA  02110-1301  USA
C
C-----------------------------------------------------------------------
c@verse
                        SUBROUTINE ENSLAG
C                       *****************
C     ------------------------------------------------------------------
     & ( IDBIA0 , IDBRA0 ,
     &   NBPMAX , NVP    , NVP1   , NVEP   , NIVEP  ,
     &   NFIN   , IFORCE ,
     &   ITEPA  ,
     &   ETTP   , TEPA   , RA)
C     ------------------------------------------------------------------
C***********************************************************************
C FONCTION :
C ----------
c@foncb
CFONC
CFONC    SOUS-PROGRAMME DU MODULE LAGRANGIEN :
CFONC    -------------------------------------
CFONC
CFONC     SAUVEGARDE DES TRAJECTOIRES AU FORMAT ENSIGHT GOLD
CFONC
CFONC     1. AU PREMIER PASSAGE : OUVERTURE  D'UN FICHIER
CFONC        SCRATCH ET DEBUT D'ECRITURE SEQUENTIELLE
CFONC
CFONC     2. A CHAQUE PASSAGE : ECRITURE DANS LE TEMPORAIRE
CFONC
CFONC     3. AU DERNIER PASSAGE : ECRITURE SUR LE FICHIER FINAL
CFONC        AU BON FORMAT POUR ENSIGHT
CFONC
CFONC     REMARQUE : on dispose de 15 fichiers de sortie,
CFONC                les unites logiques sont defini dans INIINI.F
CFONC                et on y accede par IMPLA5(1) a IMPLA5(15)
CFONC
c@fonce
C-----------------------------------------------------------------------
C                             ARGUMENTS
c@argub
CARGU .______________.____._____.______________________________________.
CARGU !    NOM       !TYPE!MODE !                   ROLE               !
CARGU !______________!____!_____!______________________________________!
CARGU ! IDBIA0       ! E  !  -> ! NUMERO DE LA 1ERE CASE LIBRE DANS IA !
CARGU ! IDBRA0       ! E  !  -> ! NUMERO DE LA 1ERE CASE LIBRE DANS RA !
CARGU ! NBPMAX       ! E  !  -> ! NOMBRE MAX DE PARTICULIES AUTORISE   !
CARGU ! NVP          ! E  !  -> ! NOMBRE DE VARIABLES PARTICULAIRES    !
CARGU ! NVP1         ! E  !  -> ! NVP SANS POSITION, VFLUIDE, VPART    !
CARGU ! NVEP         ! E  !  -> ! NOMBRE INFO PARTICULAIRES (REELS)    !
CARGU ! NIVEP        ! E  !  -> ! NOMBRE INFO PARTICULAIRES (ENTIERS)  !
CARGU ! NFIN         ! E  !  -> ! NFIN = 1 SI DERNIER PAS DE TEMPS     !
CARGU !              !    !     ! NFIN = 0 SINON                       !
CARGU ! IFORCE       ! E  !  -> ! FORCE L'ECRITURE SI = NUMERO DE LA   !
CARGU !              !    !     !   PARTICULE COURANTE                 !
CARGU ! ITEPA        ! TE !  -> ! INFO PARTICULAIRES (ENTIERS)         !
CARGU ! (NBPMAX,NIVEP!    !     !   (CELLULE DE LA PARTICULE,...)      !
CARGU ! ETTP         ! TR !  -> ! TABLEAUX DES VARIABLES LIEES         !
CARGU !  (NBPMAX,NVP)!    !     !   AUX PARTICULES                     !
CARGU !              !    !     !   ETAPE COURANTE OU PRECEDENTE       !
CARGU ! TEPA         ! TR !  -> ! INFO PARTICULAIRES (REELS)           !
CARGU ! (NBPMAX,NVEP)!    !     !   (POIDS STATISTIQUES,...)           !
CARGU !______________!____!_____!______________________________________!
c@argue
C
c@commb
CCOMM                             COMMONS
CCOMM .______________.____._____.______________________________________.
CCOMM !    NOM       !TYPE!MODE !                   ROLE               !
CCOMM !______________!____!_____!______________________________________!
CCOMM !______________!____!_____!______________________________________!
c@comme
C
C     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
C            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
C     MODE : -> DONNEE, <- RESULTAT, <-> DONNEE MODIFIEE,
C            - TABLEAU DE TRAVAIL
C
C***********************************************************************
C
      IMPLICIT NONE
C
C**********************************************************************
C     DONNEES EN COMMON
C**********************************************************************
C
      INCLUDE "paramx.h"
      INCLUDE "entsor.h"
      INCLUDE "lagpar.h"
      INCLUDE "lagran.h"
C
C**********************************************************************
C
C ARGUMENTS
C
      INTEGER          IDBIA0 , IDBRA0
      INTEGER          NBPMAX , NVP    , NVP1   , NVEP  , NIVEP
      INTEGER          NFIN   , IFORCE
      INTEGER          ITEPA(NBPMAX,NIVEP)
      DOUBLE PRECISION ETTP(NBPMAX,NVP) , TEPA(NBPMAX,NVEP)
      DOUBLE PRECISION RA(*)
C
C VARIABLES LOCALES
C
      INTEGER          IDEBIA , IDEBRA
      INTEGER          NL , NP
C
      INTEGER          NUML
      INTEGER          NUME(NLISTE)
      INTEGER          II1 , II2 , LPOS , NLMAX , IOS
      INTEGER          NPT , IPT , LMAX
      INTEGER          IX,IY,IZ,II
      INTEGER          IU1L , IV1L  , IW1L
      INTEGER          IU2L , IV2L  , IW2L
      INTEGER          ITPL , IDML  , ITEL  , IMPL
      INTEGER          IHPL , IDCKL , IMCHL , IMCKL
      INTEGER          IFINIA, IFINRA
C
      DOUBLE PRECISION XPL , YPL , ZPL
      DOUBLE PRECISION U1L , V1L , W1L
      DOUBLE PRECISION U2L , V2L , W2L
      DOUBLE PRECISION TPL , DML , TEL , MPL
      DOUBLE PRECISION HPL , DCKL , MCHL , MCKL
      CHARACTER        FICH*80
      CHARACTER        NAME*80
C
      INTEGER IPASS
      DATA    IPASS /0/
      SAVE    IPASS
C
C**********************************************************************
C
C=======================================================================
C -1.  GESTION MEMOIRE
C=======================================================================
C
      IDEBIA = IDBIA0
      IDEBRA = IDBRA0
C
C=======================================================================
C 0. INITIALISATIONS
C=======================================================================
C
C--> Compteur de passages
C
      IPASS = IPASS+1
C
      NLMAX = 0
C
C=======================================================================
C 1. OUVERTURE DU FICHIER TAMPON AU PREMIER PASSAGE
C=======================================================================
C
      IF (IPASS.EQ.1) THEN
C
        OPEN (IMPLA3,FILE='SCRATCH3.lag',
     &        STATUS='UNKNOWN',FORM='UNFORMATTED',
     &        ACCESS='SEQUENTIAL')
C
        DO NL = 1,NBVIS
          NPLIST(NL) = 0
          LIST0(NL) = LISTE(NL)
        ENDDO
C
      ENDIF
C
C=======================================================================
C 2. ECRITURE SEQUENTIELLE DES INFOS TRAJECTOIRES
C    POUR CHAQUE PARTICULE A VISUALISER SUIVANT LA FREQUENCE
C=======================================================================
C
      IF ((MOD(IPASS-1,NVISLA).EQ.0 .OR. IFORCE.GT.0)
     &   .AND. NFIN.EQ.0) THEN
C
C
        DO NL = 1,NBVIS
C
          NP = LISTE(NL)
C
          IF ( (NP.GE.1 .AND. IFORCE.EQ.0 ) .OR.
     &                       (IFORCE.EQ.NP)      ) THEN
C
C sortie du domaine ?
            IF (ITEPA(NP,JISOR).GT.0) THEN
C
C--->incrementation du nombre d'enregistrement pour la particule NP :
              NPLIST(NL) = NPLIST(NL)+1
C
              IF (NPLIST(NL).GT.NLMAX) NLMAX = NPLIST(NL)
C
C--->numero de liste :
              WRITE(IMPLA3) NL
C
C--->coordonnees de la particule NP :
              WRITE(IMPLA3) ETTP(NP,JXP), ETTP(NP,JYP), ETTP(NP,JZP)
C
C--->vitesse du fluide vu :
              IF (IVISV1.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JUF), ETTP(NP,JVF), ETTP(NP,JWF)
              ENDIF
C
C--->vitesse de la particule :
              IF (IVISV2.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JUP), ETTP(NP,JVP), ETTP(NP,JWP)
              ENDIF
C
C--->temps de sejour :
              IF (IVISTP.EQ.1) THEN
                WRITE(IMPLA3) TEPA(NP,JRTSP)
              ENDIF
C
C--->diametre :
              IF (IVISDM.EQ.1) THEN
                  WRITE(IMPLA3) ETTP(NP,JDP)
              ENDIF
C
C--->masse :
              IF (IVISMP.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JMP)
              ENDIF
C
C--->temperature :
              IF (IVISTE.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JTP)
              ENDIF
C
C--->Specifique charbon :
C        Temperature
              IF (IVISHP.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JHP)
              ENDIF
C        Diametre du coeur retrecisant
              IF (IVISDK.EQ.1) THEN
                WRITE(IMPLA3) TEPA(NP,JRDCK)
              ENDIF
C        Masse charbon reactif
              IF (IVISCH.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JMCH)
              ENDIF
C        Masse de coke
              IF (IVISCK.EQ.1) THEN
                WRITE(IMPLA3) ETTP(NP,JMCK)
              ENDIF
C
            ENDIF
C
          ENDIF
C
        ENDDO
C
C
      ENDIF
C
C=======================================================================
C 3.1 FIN DU CALCUL (NFIN=1) : OUVERTURE DES FICHIERS RESU
C=======================================================================
C
      IF (NFIN.EQ.1) THEN
C
        NAME = ' '
        NAME = 'trajectoire'
C
C  0) ouverture du fichier .ensight.CASE :
C
        FICH = NAME
        CALL VERLON ( FICH, II1, II2, LPOS )
        FICH(II2+1:II2+14) = '.ensight.CASE'
        II2 = II2 + 14
        OPEN ( UNIT=IMPLA2, FILE=FICH (II1:II2),
     &         STATUS='UNKNOWN', FORM='FORMATTED',
     &         ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
        REWIND ( UNIT=IMPLA2,ERR=99 )
C
        REWIND(IMPLA2)
        WRITE(IMPLA2,5010)
        WRITE(IMPLA2,5011)
        WRITE(IMPLA2,5012)
C
C  1) ouverture du fichier .ensight.geom + entete fichier case(suite)
C
        FICH = NAME
        CALL VERLON ( FICH, II1, II2, LPOS )
        FICH(II2+1:II2+13) = '.ensight.geom'
        II2 = II2 + 13
C
        WRITE(IMPLA2,5013) FICH (II1:II2)
        WRITE(IMPLA2,5014)
C
        OPEN ( UNIT=IMPLA1, FILE=FICH (II1:II2),
     &         STATUS='UNKNOWN', FORM='FORMATTED',
     &         ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
C
        REWIND ( UNIT=IMPLA1,ERR=99 )
C
C  2) ouverture du fichier .vitflu + entete fichier case(suite)
C
        IF (IVISV1.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.vitflu'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(1), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(1),ERR=99 )
C
          WRITE(IMPLA2,5015) FICH (II1:II2)
C
        ENDIF
C
C  3) ouverture du fichier .vitpar + entete fichier case(suite)
C
        IF (IVISV2.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.vitpar'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(2), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(2),ERR=99 )
C
          WRITE(IMPLA2,5016) FICH (II1:II2)
C
        ENDIF
C
C  4) ouverture du fichier .tpssej + entete fichier case(suite)
C
        IF (IVISTP.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.tpssej'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(3), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(3),ERR=99 )
C
          WRITE(IMPLA2,5017) FICH (II1:II2)
C
        ENDIF
C
C  5) ouverture du fichier .diamet + entete fichier case(suite)
C
        IF (IVISDM.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.diamet'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(4), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(4),ERR=99 )
C
          WRITE(IMPLA2,5018) FICH (II1:II2)
C
        ENDIF
C
C  6) ouverture du fichier .masse + entete fichier case(suite)
C
        IF (IVISMP.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.masse'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(5), FILE=FICH (II1:II2),
     *           STATUS='UNKNOWN', FORM='FORMATTED',
     *           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(5),ERR=99 )
C
          WRITE(IMPLA2,5019) FICH (II1:II2)
C
        ENDIF
C
C  7) ouverture du fichier .temper + entete fichier case(suite)
C
        IF (IVISTE.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.temper'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(6), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(6),ERR=99 )
C
          WRITE(IMPLA2,5020) FICH (II1:II2)
C
        ENDIF
C
C  8) ouverture du fichier .tempch + entete fichier case(suite)
C
        IF (IVISHP.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.tempch'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(7), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(7),ERR=99 )
C
          WRITE(IMPLA2,5021) FICH (II1:II2)
C
        ENDIF
C
C  9) ouverture du fichier .dck + entete fichier case(suite)
C
        IF (IVISDK.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.dck'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(8), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(8),ERR=99 )
C
          WRITE(IMPLA2,5022) FICH (II1:II2)
C
        ENDIF
C
C  10) ouverture du fichier .mch + entete fichier case(suite)
C
        IF (IVISCH.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.mch'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(9), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(9),ERR=99 )
C
          WRITE(IMPLA2,5023) FICH (II1:II2)
C
        ENDIF
C
C  11) ouverture du fichier .mch + entete fichier case(suite)
C
        IF (IVISCK.EQ.1) THEN
          FICH = NAME
          CALL VERLON ( FICH, II1, II2, LPOS )
          FICH(II2+1:II2+7) = '.mck'
          II2 = II2 + 7
          OPEN ( UNIT=IMPLA5(10), FILE=FICH (II1:II2),
     &           STATUS='UNKNOWN', FORM='FORMATTED',
     &           ACCESS='SEQUENTIAL', IOSTAT=IOS, ERR=99 )
          REWIND ( UNIT=IMPLA5(10),ERR=99 )
C
          WRITE(IMPLA2,5024) FICH (II1:II2)
C
        ENDIF
C
C=======================================================================
C 3.2 FIN DU CALCUL (NFIN=1): ECRITURE SUR FICHIERS FINAUX
C                             ET FERMETURE DU TEMPORAIRE
C                             OU SAUVEGARDE INTERMEDIAIRE
C=======================================================================
C
C 1) ON COMPTE LE NOMBRE TOTAL D'ENREGISTREMENTS
C
        NPT = 0
        NLMAX = 0
        LMAX = 0
        DO NL = 1,NBVIS
          NPT = NPT + NPLIST(NL)
          LMAX = MAX(LMAX,NPLIST(NL))
          IF (NPLIST(NL).GT.NLMAX) NLMAX = NPLIST(NL)
          NUME(NL) = 0
        ENDDO
C
C 2) Allocation Memoire
C
        IFINIA = IDEBIA
        IX     = IDEBRA
        IY     = IX+LMAX
        IZ     = IY+LMAX
        IFINRA = IZ +LMAX
C
        IF (IVISV1.EQ.1) THEN
          IU1L   = IFINRA
          IV1L   = IU1L  +LMAX
          IW1L   = IV1L  +LMAX
          IFINRA = IW1L  +LMAX
        ENDIF
        IF (IVISV2.EQ.1) THEN
          IU2L   = IFINRA
          IV2L   = IU2L  +LMAX
          IW2L   = IV2L  +LMAX
          IFINRA = IW2L  +LMAX
        ENDIF
        IF (IVISTP.EQ.1) THEN
          ITPL = IFINRA
          IFINRA = ITPL +LMAX
        ENDIF
        IF (IVISDM.EQ.1) THEN
          IDML = IFINRA
          IFINRA = IDML +LMAX
        ENDIF
        IF (IVISMP.EQ.1) THEN
          IMPL = IFINRA
          IFINRA = IMPL +LMAX
        ENDIF
        IF (IVISTE.EQ.1) THEN
          ITEL = IFINRA
          IFINRA = ITEL +LMAX
        ENDIF
        IF (IVISHP.EQ.1) THEN
          IHPL = IFINRA
          IFINRA = IHPL +LMAX
        ENDIF
        IF (IVISDK.EQ.1) THEN
          IDCKL= IFINRA
          IFINRA = IDCKL +LMAX
        ENDIF
        IF (IVISCH.EQ.1) THEN
          IMCHL = IFINRA
          IFINRA = IMCHL +LMAX
        ENDIF
        IF (IVISCK.EQ.1) THEN
          IMCKL = IFINRA
          IFINRA = IMCKL +LMAX
        ENDIF
C
        CALL RASIZE('ENSLAG',IFINRA)
C       ===========
C
C 3) ON REMPLIT LES ENTETES DES FICHIERS : geo + variable
C
        REWIND(IMPLA1)
C
        WRITE(IMPLA1,3000)
        WRITE(IMPLA1,3001)
        WRITE(IMPLA1,3002)
        WRITE(IMPLA1,3003)
C
        IF (IVISV1.EQ.1) THEN
          REWIND(IMPLA5(1))
          WRITE(IMPLA5(1),4000)
        ENDIF
C
        IF (IVISV2.EQ.1) THEN
          REWIND(IMPLA5(2))
          WRITE(IMPLA5(2),4001)
        ENDIF
C
        IF (IVISTP.EQ.1) THEN
          REWIND(IMPLA5(3))
          WRITE(IMPLA5(3),4002)
        ENDIF
C
        IF (IVISDM.EQ.1) THEN
          REWIND(IMPLA5(4))
          WRITE(IMPLA5(4),4003)
        ENDIF
C
        IF (IVISMP.EQ.1) THEN
          REWIND(IMPLA5(5))
          WRITE(IMPLA5(5),4004)
        ENDIF
C
        IF (IVISTE.EQ.1) THEN
          REWIND(IMPLA5(6))
          WRITE(IMPLA5(6),4005)
        ENDIF
C
        IF (IVISHP.EQ.1) THEN
          REWIND(IMPLA5(7))
          WRITE(IMPLA5(7),4006)
        ENDIF
C
        IF (IVISDK.EQ.1) THEN
          REWIND(IMPLA5(8))
          WRITE(IMPLA5(8),4007)
        ENDIF
C
        IF (IVISCH.EQ.1) THEN
          REWIND(IMPLA5(9))
          WRITE(IMPLA5(9),4008)
       ENDIF
C
        IF (IVISCK.EQ.1) THEN
          REWIND(IMPLA5(10))
          WRITE(IMPLA5(10),4009)
        ENDIF
C
        DO NL = 1,NBVIS
C
          NP = LISTE(NL)
C
          IF (ITEPA(NP,JISOR).GT.0) THEN

            REWIND(IMPLA3)
C
            IPT = 0
            DO II=1,NPT
C
              READ(IMPLA3) NUML
              READ(IMPLA3) XPL,YPL,ZPL
              IF (IVISV1.EQ.1) READ(IMPLA3) U1L,V1L,W1L
              IF (IVISV2.EQ.1) READ(IMPLA3) U2L,V2L,W2L
              IF (IVISTP.EQ.1) READ(IMPLA3) TPL
              IF (IVISDM.EQ.1) READ(IMPLA3) DML
              IF (IVISMP.EQ.1) READ(IMPLA3) MPL
              IF (IVISTE.EQ.1) READ(IMPLA3) TEL
              IF (IVISHP.EQ.1) READ(IMPLA3) HPL
              IF (IVISDK.EQ.1) READ(IMPLA3) DCKL
              IF (IVISCH.EQ.1) READ(IMPLA3) MCHL
              IF (IVISCK.EQ.1) READ(IMPLA3) MCKL
C
              IF (NUML .EQ. NL ) THEN
C
                IPT = IPT+1

                RA(IX+IPT-1) = XPL
                RA(IY+IPT-1) = YPL
                RA(IZ+IPT-1) = ZPL
                IF (IVISV1.EQ.1) THEN
                  RA(IU1L+IPT-1) = U1L
                  RA(IV1L+IPT-1) = V1L
                  RA(IW1L+IPT-1) = W1L
                ENDIF
                IF (IVISV2.EQ.1) THEN
                  RA(IU2L+IPT-1) = U2L
                  RA(IV2L+IPT-1) = V2L
                  RA(IW2L+IPT-1) = W2L
                ENDIF
                IF (IVISTP.EQ.1) THEN
                  RA(ITPL+IPT-1) = TPL
                ENDIF
                IF (IVISDM.EQ.1) THEN
                  RA(IDML+IPT-1) = DML
                ENDIF
                IF (IVISMP.EQ.1) THEN
                  RA(IMPL+IPT-1) = MPL
                ENDIF
                IF (IVISTE.EQ.1) THEN
                  RA(ITEL+IPT-1) = TEL
                ENDIF
                IF (IVISHP.EQ.1) THEN
                  RA(IHPL+IPT-1) = HPL
                ENDIF
                IF (IVISDK.EQ.1) THEN
                  RA(IDCKL+IPT-1) = DCKL
                ENDIF
                IF (IVISCH.EQ.1) THEN
                  RA(IMCHL+IPT-1) = MCHL
                ENDIF
                IF (IVISCK.EQ.1) THEN
                  RA(IMCKL+IPT-1) = MCKL
                ENDIF
C
              ENDIF
            ENDDO
C
C  Ecriture Fichier Geometrie
C
            WRITE(IMPLA1,3010)
            WRITE(IMPLA1,1010) NL
            WRITE(IMPLA1,3004) LIST0(NL)
            WRITE(IMPLA1,3005)
            WRITE(IMPLA1,1010) IPT
            DO II=1,IPT
              WRITE(IMPLA1,1030) RA(IX+II-1)
            ENDDO
            DO II=1,IPT
              WRITE(IMPLA1,1030) RA(IY+II-1)
            ENDDO
            DO II=1,IPT
              WRITE(IMPLA1,1030) RA(IZ+II-1)
            ENDDO
            WRITE(IMPLA1,3006)
            WRITE(IMPLA1,1010) IPT-1
            DO II=1,IPT-1
              WRITE(IMPLA1,1020) II,II+1
            ENDDO
C
C  Ecriture Fichiers Variables
C
            IF (IVISV1.EQ.1) THEN
C
              WRITE(IMPLA5(1),3010)
              WRITE(IMPLA5(1),1010) NL
              WRITE(IMPLA5(1),3005)
              DO II=1,IPT
                WRITE(IMPLA5(1),1030) RA(IU1L+II-1)
              ENDDO
              DO II=1,IPT
                WRITE(IMPLA5(1),1030) RA(IV1L+II-1)
              ENDDO
              DO II=1,IPT
                WRITE(IMPLA5(1),1030) RA(IW1L+II-1)
              ENDDO
            ENDIF
C
            IF (IVISV2.EQ.1) THEN
              WRITE(IMPLA5(2),3010)
              WRITE(IMPLA5(2),1010) NL
              WRITE(IMPLA5(2),3005)
              DO II=1,IPT
                WRITE(IMPLA5(2),1030) RA(IU2L+II-1)
              ENDDO
              DO II=1,IPT
                WRITE(IMPLA5(2),1030) RA(IV2L+II-1)
              ENDDO
              DO II=1,IPT
                WRITE(IMPLA5(2),1030) RA(IW2L+II-1)
              ENDDO
            ENDIF
C
            IF (IVISTP.EQ.1) THEN
              WRITE(IMPLA5(3),3010)
              WRITE(IMPLA5(3),1010) NL
              WRITE(IMPLA5(3),3005)
              DO II=1,IPT
                WRITE(IMPLA5(3),1030) RA(ITPL+II-1)
              ENDDO
            ENDIF
            IF (IVISDM.EQ.1) THEN
              WRITE(IMPLA5(4),3010)
              WRITE(IMPLA5(4),1010) NL
              WRITE(IMPLA5(4),3005)
              DO II=1,IPT
                WRITE(IMPLA5(4) ,1030) RA(IDML+II-1)
              ENDDO
            ENDIF
            IF (IVISMP.EQ.1) THEN
              WRITE(IMPLA5(5),3010)
              WRITE(IMPLA5(5),1010) NL
              WRITE(IMPLA5(5),3005)
              DO II=1,IPT
                WRITE(IMPLA5(5),1030) RA(IMPL+II-1)
              ENDDO
            ENDIF
            IF (IVISTE.EQ.1) THEN
              WRITE(IMPLA5(6),3010)
              WRITE(IMPLA5(6),1010) NL
              WRITE(IMPLA5(6),3005)
              DO II=1,IPT
                WRITE(IMPLA5(6),1030) RA(ITEL+II-1)
              ENDDO
            ENDIF
            IF (IVISHP.EQ.1) THEN
              WRITE(IMPLA5(7),3010)
              WRITE(IMPLA5(7),1010) NL
              WRITE(IMPLA5(7),3005)
              DO II=1,IPT
                WRITE(IMPLA5(7),1030) RA(IHPL+II-1)
              ENDDO
            ENDIF
            IF (IVISDK.EQ.1) THEN
              WRITE(IMPLA5(8),3010)
              WRITE(IMPLA5(8),1010) NL
              WRITE(IMPLA5(8),3005)
              DO II=1,IPT
                WRITE(IMPLA5(8),1030) RA(IDCKL+II-1)
              ENDDO
            ENDIF
            IF (IVISCH.EQ.1) THEN
              WRITE(IMPLA5(9),3010)
              WRITE(IMPLA5(9),1010) NL
              WRITE(IMPLA5(9),3005)
              DO II=1,IPT
                WRITE(IMPLA5(9),1030) RA(IMCHL+II-1)
              ENDDO
            ENDIF
            IF (IVISCK.EQ.1) THEN
              WRITE(IMPLA5(10),3010)
              WRITE(IMPLA5(10),1010) NL
              WRITE(IMPLA5(10),3005)
              DO II=1,IPT
                WRITE(IMPLA5(10),1030) RA(IMCKL+II-1)
              ENDDO
            ENDIF
C
          ENDIF
C
        ENDDO
C
        CLOSE(IMPLA1)
        CLOSE(IMPLA2)
        CLOSE(IMPLA3)
        IF (IVISV1.EQ.1) CLOSE(IMPLA5(1))
        IF (IVISV2.EQ.1) CLOSE(IMPLA5(2))
        IF (IVISTP.EQ.1) CLOSE(IMPLA5(3))
        IF (IVISDM.EQ.1) CLOSE(IMPLA5(4))
        IF (IVISMP.EQ.1) CLOSE(IMPLA5(5))
        IF (IVISTE.EQ.1) CLOSE(IMPLA5(6))
        IF (IVISHP.EQ.1) CLOSE(IMPLA5(7))
        IF (IVISDK.EQ.1) CLOSE(IMPLA5(8))
        IF (IVISCH.EQ.1) CLOSE(IMPLA5(9))
        IF (IVISCK.EQ.1) CLOSE(IMPLA5(10))
C
      ENDIF
C
C
      RETURN
C
   99 CONTINUE
      WRITE (NFECRA,9999) FICH (II1:II2), IOS
      CALL CSEXIT(1)
C
C--------
C FORMATS
C--------
C
 1000 FORMAT (A)
 1010 FORMAT (I10)
 1020 FORMAT (I10,I10)
 1030 FORMAT (e12.5)
C
 3000 FORMAT('geometrie trajectoire')
 3001 FORMAT('au format ensight6 : .case')
 3002 FORMAT('node id assign')
 3003 FORMAT('element id assign')
 3004 FORMAT('trajectoire',I10)
 3005 FORMAT('coordinates')
 3006 FORMAT('bar2')
C
 3010 FORMAT('part')
C
 4000 FORMAT('vitesse fluide vu')
 4001 FORMAT('vitesse particules')
 4002 FORMAT('temps de sejour')
 4003 FORMAT('diametre')
 4004 FORMAT('masse')
 4005 FORMAT('temerature')
 4006 FORMAT('temperature')
 4007 FORMAT('dck')
 4008 FORMAT('mch')
 4009 FORMAT('mck')
C
 5010 FORMAT('FORMAT')
 5011 FORMAT('type: ensight gold')
 5012 FORMAT('GEOMETRY')
 5013 FORMAT('model: ',A)
 5014 FORMAT('VARIABLE')
 5015 FORMAT('vector per node: vitesse_fluide_vu       ',A )
 5016 FORMAT('vector per node: vitesse_particules      ',A )
 5017 FORMAT('scalar per node: temps_de_sejour         ',A )
 5018 FORMAT('scalar per node: diametre                ',A )
 5019 FORMAT('scalar per node: masse                   ',A )
 5020 FORMAT('scalar per node: temperature             ',A )
 5021 FORMAT('scalar per node: temperature             ',A )
 5022 FORMAT('scalar per node: dck                     ',A )
 5023 FORMAT('scalar per node: mch                     ',A )
 5024 FORMAT('scalar per node: mck                     ',A )
C
 6000 FORMAT('geometrie trajectoire')
 6001 FORMAT('au format ensight6 (case)')
 6002 FORMAT('node id assign')
 6003 FORMAT('element id assign')
C

C
 9999 FORMAT(
     &'@                                                            ',/,
     &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,
     &'@                                                            ',/,
     &'@ @@ ATTENTION : ARRET A L''EXECUTION DU MODULE LAGRANGIEN   ',/,
     &'@    *********                                               ',/,
     &'@    ERREUR D''OUVERTURE SUR LE FICHIER : ',A                 ,/,
     &'@    AVEC UN IOSTAT EGAL A : ',I6                             ,/,
     &'@    (ENSLAG)                                                ',/,
     &'@                                                            ',/,
     &'@  Verifier les numero de fichiers utilises par le Lagrangien',/,
     &'@                                                            ',/,
     &'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,
     &'@                                                            ',/)
C
C----
C FIN
C----
C
      END
c@z
