*DECK TRCDRV
      SUBROUTINE TRCDRV(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY,IPSAL,IPFT,
     & NANIS,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* adapt SAL tracking to EXCELT format.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): R. Le Tellier
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): created linked list L_TRACK;
*         HENTRY(2): created sequential binary tracking file;
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
* NMU     number of polar angles.
* IMPX    print level flag.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,NANIS,IPFT,IMPX,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  IPSAL,KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) IPT,IPTAN,IPTGE
      DOUBLE PRECISION DEX
      PARAMETER (NSTATE=40,MXGAUS=64,IOUT=6,NNN=8,DEX=1.D0/512.D0,
     1 NBEX=7936,NCOR=1)
      CHARACTER TEXT12*12
      INTEGER ISTATE(NSTATE),ISTNEW(NSTATE),KCHAR(18)
      INTEGER IUNIT,MAX_REG,NB_UNK,LEAK,NBMED,NB_SURF,NAN360,IGIG,
     1 NPHI, NPSIX,NBCURR,MPHI,MPSI,NMAX2,NBCONE,ND_TURN,RECOR,TYPGEO,
     2 NBFOLD,NB_NODE,UPN,LONG,NBTRAC,ITR,ITRS,IJK,
     3 IJK0,IJK1,CPHI,CPSI,NBTER,NEST,IPI,IPR,BC_DATA_DIM2
*
      PARAMETER (NCOMNT=0,NDIM=2,NALBG=6)
      INTEGER ICODE(NALBG)
      CHARACTER COMNT(1)*80
      REAL GALBED(NALBG),EXTKOP(3)
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MATALB,MERGE,TYPE_BC2,
     1 IDATA_BC2,IBC_SURF2,ITRACK,NRSEG,IBC,KEYFLX
      REAL, ALLOCATABLE, DIMENSION(:) :: VOLSUR,BC_DATA,SURF2,ANGLE,
     1 TEMP,RTRACK,SEGLEN,VOL
*----
*  DATA STATEMENTS
*----
      INTEGER   SURFMAT(4,4),ITRANS(4)
      DATA      SURFMAT/ 0,3,0,4,
     >                   2,0,4,0,
     >                   0,1,0,2,
     >                   1,0,3,0 /
      DATA      ITRANS/ 4,3,2,1 / 
      SAVE      SURFMAT,ITRANS
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.NE.2) CALL XABORT('TRCDRV: TWO PARAMETERS EXPECTED.')
      WRITE(IOUT,100) HENTRY(1),HENTRY(2)
      IF(IENTRY(1).GT.2)
     1  CALL XABORT('TRCDRV: LCM OBJECT EXPECTED AT LHS.')
      IF(JENTRY(1).NE.0)
     1  CALL XABORT('TRCDRV: ENTRY IN CREATION MODE EXPECTED.')
      IF(IENTRY(2).NE.3) 
     1  CALL XABORT('TRCDRV: SEQ BINARY FILE EXPECTED AT LHS.')
      IF(JENTRY(2).NE.0) 
     1  CALL XABORT('TRCDRV: ENTRY IN CREATION MODE EXPECTED.')
      IPT=KENTRY(1)
      IUNIT=FILUNIT(KENTRY(2))
*----
* RECOVER INFORMATION FROM SAL AND GEO LINKED LIST
*----
      CALL LCMGET(IPSAL,'SIGNATURE   ',TEXT12)
      IF(TEXT12.NE.'L_TRACK     ')
     1  CALL XABORT('TRCDRV: A TRACKING OBJECT WAS EXPECTED  ')
      CALL LCMGET(IPSAL,'TRACK-TYPE  ',TEXT12)
      IF(TEXT12.NE.'SAL         ') 
     1  CALL XABORT('TRCDRV: A SAL TRACKING OBJECT WAS EXPECTED  ')
      TEXT12='STATE-VECTOR'
      CALL LCMGET(IPSAL,TEXT12,ISTATE)
      MAX_REG = ISTATE(1)      ! number of regions
      NB_UNK  = ISTATE(2)      ! number of unknowns in DRAGON
      LEAK=ISTATE(3)           ! leakage flag: 1 = absent leakage, 0 leakage
      NBMED=ISTATE(4)          ! maximum number of mixture
      NB_SURF=ISTATE(5)        ! number of outer surface
      IGIG = ISTATE(7)         ! nombre de gigogne max
      NPHI = ISTATE(8)         ! nb of horizontal angles
      NPSIX = ISTATE(9)        ! nb of vertical angles
      NBCURR  = ISTATE(10)     ! nb of current to describe a boundary current
      MPHI    = ISTATE(11)     ! nb of horizontal cones
      MPSI    = ISTATE(12)     ! nb of vertical cones to describe boundary conditions
      NMAX2   = ISTATE(13)     ! size of the buffer to store tracking
      ND_TURN = ISTATE(14)     ! for rotations or symetry
      RECOR   = ISTATE(15)     ! number of record used to write the tracking
      TYPGEO  = ISTATE(16)     ! type of the geometry
      NBFOLD  = ISTATE(17)     ! for rotations
      NB_NODE = ISTATE(18)     ! number of regions before merge
      UPN = ISTATE(19)         ! =-1: SAL solution; =0: DP-0 ; =1: DP-1; =999: specular bc
      NBCONE  = MPHI*MPSI      ! number of cones for current discretization
      IF(NBCONE.GT.1) THEN
      CALL XABORT('PCA FOR BOUNDARY CONDITIONS NOT AVAILABLE IN DRAGON')
      ENDIF
      IF(UPN.EQ.999) THEN
         WRITE(6,*) 'TRACKC: SPECULAR BOUNDARY CONDITIONS'
         ISPEC=1
         NSOUT=4
      ELSEIF(UPN.EQ.0) THEN
         WRITE(6,*) 'TRACKC: ISOTROPIC BOUNDARY CONDITIONS'
         ISPEC=0
         NSOUT=NB_SURF
      ELSE
         CALL XABORT('TRCDRV: ISOTROPIC/SPECULAR CONDITIONS ONLY')
      ENDIF
      WRITE(6,*) 'TYPE OF GEOMETRY :',TYPGEO
      IF((TYPGEO.NE.6).AND.(TYPGEO.NE.0)) WRITE(6,*)
     & 'WARNING ! ANISOTROPY TREATMENT NOT SUPPORTED FOR THIS GEOMETRY'
      NREG=MAX_REG
      NAN360=2*NPHI
      NAN90=NPHI/2
      WRITE(6,*) 'NUMBER OF REGIONS,SURFACES,NODES',NREG,NSOUT,NB_NODE
      CALL XDISET(ICODE,NALBG,0)
      ICODE(1)=-1
      ICODE(2)=-2
      ICODE(3)=-3
      ICODE(4)=-4
      ALLOCATE(MATALB(NSOUT+NREG+1),VOLSUR(NREG+NSOUT+1),MERGE(NB_NODE))
      CALL LCMGET(IPSAL,'MATCOD',MATALB(NSOUT+2))
      IF(ISPEC.EQ.1) THEN
         MATALB(1)=-4
         MATALB(2)=-2
         MATALB(3)=-1
         MATALB(4)=-3
         CALL XDRSET(GALBED,NALBG,1.0)
      ENDIF
      MATALB(NSOUT+1)=0
      CALL LCMGET(IPSAL,'VOLUME',VOLSUR(NSOUT+2))
      IF(ISPEC.EQ.1) THEN
         VOLSUR(1)=0.0
         VOLSUR(2)=0.0
         VOLSUR(3)=0.0
         VOLSUR(4)=0.0
      ENDIF
      VOLSUR(NSOUT+1)=0.0
      CALL LCMGET(IPSAL,'MERGE',MERGE)
C     BOUNDARY CONDITIONS STRUCTURES
C     cf t_tdtp_porte.f90, FLUSAL.f90
      IPTGE=LCMGID(IPSAL,'GEOMETRY')
      CALL LCMLIB(IPTGE)
      CALL LCMGET(IPTGE,'NB_SURF2',NB_SURF2)
      IF((ISPEC.EQ.0).AND.(NB_SURF2.NE.NSOUT)) THEN
         WRITE(6,*) 'NB_SURF2.NE.NSOUT PROBLEM ?'
      ENDIF
      CALL LCMGET(IPTGE,'NB_BC2',NB_BC2)
      ALLOCATE(TYPE_BC2(NB_BC2),IDATA_BC2(NB_BC2))
      CALL LCMLEN(IPTGE,'BC_DATA',BC_DATA_DIM2,ITYLCM)
      ALLOCATE(BC_DATA(2*BC_DATA_DIM2))
      CALL LCMGET(IPTGE,'TYPE_BC2',TYPE_BC2)
      CALL LCMGET(IPTGE,'IDATA_BC2',IDATA_BC2)
      CALL LCMGET(IPTGE,'BC_DATA',BC_DATA)
      IF(ISPEC.EQ.0) THEN
         ALLOCATE(IBC_SURF2(NB_SURF2),SURF2(2*NB_SURF2))
         CALL LCMGET(IPTGE,'IBC2_SURF2',IBC_SURF2)
         CALL LCMGET(IPTGE,'SURF2',SURF2)
c         CALL PRINIM('IBC_SU',IBC_SURF2,NB_SURF2)
c         CALL PRINDM('SURF2 ',SURF2,NB_SURF2)
      ENDIF
c         WRITE(6,*) 'NB_SURF2,NB_BC2,BC_DATA_DIM2 ',
c     1               NB_SURF2,NB_BC2,BC_DATA_DIM2
c         CALL PRINIM('TYPE_B',TYPE_BC2,NB_BC2)
c         CALL PRINIM('IDATA_',IDATA_BC2,NB_BC2)
c         CALL PRINDM('BC_DAT',BC_DATA,BC_DATA_DIM2)
      CALL CONVRD(NREG,NB_SURF2,NALBG,IBC_SURF2,MATALB(1),
     1            IDATA_BC2,BC_DATA,GALBED,SURF2,
     2            VOLSUR(1))

      IF(IMPX.GT.0) THEN
         CALL PRINAM('VOLUME',VOLSUR(1),NREG+NSOUT+1)
         CALL PRINIM('MATALB',MATALB(1),NREG+NSOUT+1)
         CALL PRINIM('ICODE ',ICODE,NALBG)
         CALL PRINAM('GALBED',GALBED,NALBG)
      ENDIF
!!!!      IS = 0
!!!!      DO IC = 1,NB_BC2
!!!!         IF(TYPE_BC2(IC).EQ.-4) THEN
!!!!            CONTINUE
!!!!         ELSEIF(TYPE_BC2(IC).EQ.0) THEN
!!!!            IS = IS + 1
!!!!            IF(IS .LE. NB_SURF) THEN
!!!!               IF(IBC_SURF2(IS) .EQ. IC) THEN
!!!!                  CONTINUE
!!!!               ELSE
!!!!                  CALL XABORT ("TRACKC: UNEXPECTED BC (1)")
!!!!               ENDIF
!!!!            ELSE
!!!!               CALL XABORT ("TRACKC: UNEXPECTED BC (2)")
!!!!            ENDIF
!!!!         ELSE
!!!!            CALL XABORT ("TRACKC: UNEXPECTED BC (3)")
!!!!         ENDIF
!!!!      ENDDO
!!!!      IF(IS .NE. NB_SURF) THEN
!!!!         CALL XABORT ("TRACKC: UNEXPECTED BC (4)")
!!!!      ENDIF
      IF(ISPEC.EQ.0) DEALLOCATE(SURF2,IBC_SURF2)
      DEALLOCATE(BC_DATA,IDATA_BC2,TYPE_BC2)
C     QUADRATURES INFO
      ALLOCATE(ANGLE(NDIM*NAN360),TEMP(2*NAN360))
      IPTAN=LCMGID(IPSAL,'CHARACTER')
      CALL LCMGET(IPTAN,'AQ2D    ',TEMP)
      CALL TRCCOS(NAN360,TEMP,ANGLE,ANGLE(NAN360+1))
      IF(IMPX.GT.0) THEN
         CALL PRINDM('ANGLES  ',TEMP,NAN90)
         CALL PRINAM('COS     ',ANGLE,NAN90)
         CALL PRINAM('SIN     ',ANGLE(NAN360+1),NAN90)
      ENDIF
      DEALLOCATE(TEMP)
*
*     c.f tracking_1.md9, tracking_2.md9, t_tdtutil.md9
*----
*  RECOVER INFORMATION FROM SAL TRACKING FILE
*  FILL IN TRACKING FILE IN EXCELT FORMAT
*----
      ALLOCATE(RTRACK(NMAX2),ITRACK(2*NMAX2))
      MXSEG=0
      NBTR=0
      REWIND IPFT
      DO IREC=1,RECOR
         READ(IPFT) LONG,NBTRAC,(ITRACK(K),K=1,LONG),
     1             (RTRACK(K),K=1,LONG),
     2             (ITRACK(K),K=1+NMAX2,LONG+NMAX2)
         NBTR=NBTR+NBTRAC
         IJK0=0
         DO ITR=1,NBTRAC
            NBTER=ITRACK(IJK0+1)
            NSUB=ITRACK(IJK0+2)
            MXSEG=MAX(MXSEG,NBTER+2*NSUB)
            DENS=RTRACK(IJK0+8)
            IJK1=IJK0+NBTER+NNN
            IJK1=IJK1+2*NSUB
            IJK0=IJK1
         ENDDO
      ENDDO
      IF(IMPX.GT.0) THEN
         WRITE(6,*) 'MXSEG,NBTR', MXSEG,NBTR
      ENDIF
      WRITE(IUNIT) '$TRK',NCOMNT,NBTR
      IF(NCOMNT.GT.0) THEN
         NCOM=NCOMNT
         DO ICOM=1,NCOM
            WRITE(IUNIT,*) COMNT(ICOM)
         ENDDO
      ENDIF
      NANGL=NAN360
      WRITE(IUNIT) NDIM,ISPEC,NREG,NSOUT,NALBG,NCOR,NANGL,MXSEG
      WRITE(IUNIT) (VOLSUR(II),II=1,NSOUT+NREG+1)
      WRITE(IUNIT) (MATALB(II),II=1,NSOUT+NREG+1)
      WRITE(IUNIT) (ICODE(II),II=1,NALBG)
      WRITE(IUNIT) (GALBED(II),II=1,NALBG)
      WRITE(IUNIT) (ANGLE(II),ANGLE(NAN360+II),II=1,NANGL)
      WRITE(IUNIT) (DENS,II=1,NANGL)
      ALLOCATE(NRSEG(MXSEG),SEGLEN(MXSEG))
      REWIND IPFT
      DO IREC=1,RECOR
         READ(IPFT) LONG,NBTRAC,(ITRACK(K),K=1,LONG),
     1             (RTRACK(K),K=1,LONG),
     2             (ITRACK(K),K=1+NMAX2,LONG+NMAX2)
         IF(IMPX.GT.1) THEN
            WRITE(6,*) 'RECORD',IREC,': NMAX2,LONG,NBTRAC',
     1                                  NMAX2,LONG,NBTRAC
         ENDIF
         IJK0=0
         IF(IMPX.GT.1) THEN
         WRITE(6,'(//,2x,''traject phi psi  domain  tracks  '',
     1            ''surface cphi cpsi  cosine weight'',/,2x,7(''-''),
     2            2(1x,3(''-'')),3(2x,6(''-'')),''-'',2(1x,4(''-'')),
     3            2x,6(''-''),1x,6(''-''))')
         ENDIF
         ISURF=0
         ISURF1=0
         DO ITR=1,NBTRAC
C        LOOP OVER THE TRAJECTORIES
            IPI=IJK0
            IPR=IJK0
            IJK=IJK0+NNN+1
C           number of elements in the trajectory
            NBTER=ITRACK(IPI+1)                                  ! ientry 1
C           number of sub-trajectories
            NSUB=ITRACK(IPI+2)                                   ! ientry 2
            IJK1=IJK+NBTER-1
            WEIGHT=RTRACK(IPR+7)                                 ! rentry 7
            IF((NBTER.NE.0).AND.(IMPX.GT.1)) THEN
               WRITE(6,'(/,2x,i5,15x,i10,28x,e12.4)') ITR,NBTER,WEIGHT
            ENDIF
C           left surface (0 for cyclic tracking)
            ICURR=ITRACK(IPI+5)                                  ! ientry 5
            IF(ICURR.NE.0) THEN
               ISURF=1+(ICURR-1)/NBCONE
               CPHI=ICURR-(ISURF-1)*NBCONE
               CPSI=1+(CPHI-1)/MPHI
               CPHI=CPHI-(CPSI-1)*MPHI
               IF(IMPX.GT.1) THEN
                  WRITE(6,'(21x,a,10x,2i7,i5,e12.4)')'l',ISURF,CPHI,
     1                 CPSI,RTRACK(IPR+5)
               ENDIF
            ENDIF
C           right surface (0 for cyclic tracking)
            ICURR=ITRACK(IPI+6)                                  ! ientry 6
            IF(ICURR.NE.0) THEN
               ISURF1=1+(ICURR-1)/NBCONE
               CPHI=ICURR-(ISURF1-1)*NBCONE
               CPSI=1+(CPHI-1)/MPHI
               CPHI=CPHI-(CPSI-1)*MPHI
               IF(IMPX.GT.1) THEN
                  WRITE(6,'(21x,a,10x,2i7,i5,e12.4)')'r',ISURF1,CPHI,
     1               CPSI,RTRACK(IPR+6)
               ENDIF
            ENDIF
            IF((ISPEC.EQ.1).AND.((TYPGEO.EQ.6).OR.(TYPGEO.EQ.5))) THEN
               COSSURF=RTRACK(IPR+2)                             ! rentry 2
               COSX=ANGLE(ITRACK(IJK1+2))
               IF(ABS(COSX-COSSURF).LT.1E-6) THEN
                  ISURF=1
               ELSEIF(ABS(SQRT(1-COSX*COSX)-COSSURF).LT.1E-6) THEN
                  ISURF=2
               ELSE
                  WRITE(*,*) 'COSSURF,COSX,SQRT(1-COSX*COSX) :',
     &                        COSSURF,COSX,SQRT(1-COSX*COSX) 
                  CALL XABORT ('TRACKC:PROBLEM 1')
               ENDIF
               ISURF1=ISURF
            ENDIF
            IF(IMPX.GT.2) THEN
               WRITE(6,'("   sub-trajectories:")')
               IF(ISPEC.EQ.1) THEN
                  WRITE(6,*) '  starting cos with surface:',COSSURF
                  WRITE(6,*) '  starting cos with x axis: ',COSX
               ENDIF
               WRITE(6,150)
               WRITE(6,200)
            ENDIF
            II=NNN
            NSEG=0
            ! CASE OF A GEOMETRY WITH SPECULAR REFLECTIVE CONDITION 
            ! WHICH IS NOT A RECTANGULAR -> ANISOTROPY TREATMENT NOT
            ! SUPPORTED
            IF(ISURF.EQ.0) ISURF=1
            DO ITRS=1,NSUB
C           LOOP OVER THE SUB-TRAJECTORIES
               IJK1=IJK1+1
C              number of elements in the sub-trajectory
               NEST=ITRACK(IJK1)
               IJK1=IJK1+1
C              angle index of the sub-trajectory
               IPHI=ITRACK(IJK1)
               IF(ITRS.EQ.1) IANGL=IPHI
               IF(IMPX.GT.2) THEN
                  WRITE(6,'(i6,"*",6x,i6,5x,i6)') ITRS,NEST,IPHI
               ENDIF
               NA=(IPHI-1)/(NAN90)+1
               IF(ISPEC.EQ.1) THEN
                  IF(ITRS.EQ.1) THEN
                     IF(IMPX.GT.2) WRITE(6,*) '  -> surface',ISURF
                  ELSE
                     IF(NA.EQ.NAOLD) THEN ! specular translation
                        ISURF=ITRANS(ISURF)
                     ELSE
                        ISURF=SURFMAT(NA,NAOLD)
                     ENDIF
                     IF(IMPX.GT.2) THEN
                        WRITE(6,*)'NA=',NA,'NAOLD=',NAOLD,'ISURF=',ISURF
                        IF(ISURF.EQ.0) THEN
                           WRITE(6,*) '  -> diagonal symmetry '
                        ELSE
                           WRITE(6,*) '  -> surface',ISURF
                        ENDIF
                     ENDIF
                  ENDIF
               ENDIF
               IF(ISURF.NE.0) THEN
                  NSEG=NSEG+1
                  NRSEG(NSEG)=-ISURF
                  SEGLEN(NSEG)=0.5
                  IF(ITRS.GT.1) THEN
                     NSEG=NSEG+1
                     NRSEG(NSEG)=-ISURF
                     SEGLEN(NSEG)=0.5
                  ENDIF
               ENDIF
               DO I=1,NEST
                  II=II+1
                  IF(IMPX.GT.3) THEN
                     WRITE(6,'(5x,i6,"*",3(1p,i6,1p,e10.2,i7))') I,
     1               ITRACK(IPI+II),RTRACK(IPR+II),ITRACK(IPI+II+NMAX2)
                  ENDIF
                  NSEG=NSEG+1
                  NRSEG(NSEG)=MERGE(ITRACK(IPI+II))
                  SEGLEN(NSEG)=RTRACK(IPR+II)
               ENDDO
               NAOLD=NA
            ENDDO
            ! CASE OF A GEOMETRY WITH SPECULAR REFLECTIVE CONDITION 
            ! WHICH IS NOT A RECTANGULAR -> ANISOTROPY TREATMENT NOT
            ! SUPPORTED
            IF(ISURF1.EQ.0) ISURF1=1
            NSEG=NSEG+1
            NRSEG(NSEG)=-ISURF1
            SEGLEN(NSEG)=0.5
            IF(IMPX.GT.4) THEN
               WRITE(6,*) 'EXCELT ENTRY WITH',NSEG,'SEGMENTS:'
               WRITE(6,*) (NRSEG(II),II=1,NSEG)
               WRITE(6,*) (SEGLEN(II),II=1,NSEG)
            ENDIF
            DO II=1,NSEG
               IF((NRSEG(II).LT.(-NSOUT))
     1         .OR.(NRSEG(II).GT.NREG)) THEN
                  WRITE(*,*) 'NSOUT=',NSOUT,' NREG=',NREG
                  CALL PRINIM('NRSEG ',NRSEG,NSEG)
                  CALL XABORT('TRCDRV: WRONG REGION INDEX')
               ENDIF
            ENDDO
            WRITE(IUNIT) IANGL,NSEG,WEIGHT,
     1                  (NRSEG(II),II=1,NSEG),(SEGLEN(II),II=1,NSEG)
            IJK0=IJK1
         ENDDO
      ENDDO
*----
* FILL IN TRACKING LINKED LIST IN EXCELT FORMAT
*----
      TEXT12='L_TRACK'
      READ(TEXT12,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPT,'SIGNATURE',3,3,KCHAR)
      TEXT12='EXCELL'
      READ(TEXT12,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPT,'TRACK-TYPE',3,3,KCHAR)
      TEXT12=' '
      READ(TEXT12,'(A4)') IBLANK
      CALL XDISET(KCHAR,18,IBLANK)
      TEXT12='SAL TRACKING'
      READ(TEXT12,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPT,'TITLE',18,3,KCHAR)
      CALL XDISET(ISTNEW,NSTATE,0)
      ISTNEW(1)=NREG
      ISTNEW(2)=NREG*NANIS*(NANIS+1)/2
      ISTNEW(3)=LEAK
      ISTNEW(4)=NBMED
      ISTNEW(5)=NSOUT
      ISTNEW(6)=NANIS
      ISTNEW(7)=1
      ISTNEW(8)=0
      ISTNEW(9)=ISPEC
      ISTNEW(10)=ISPEC
      ISTNEW(11)=NANGL
      ISTNEW(12)=0
      TEXT12='STATE-VECTOR'
      CALL LCMPUT(IPT,TEXT12,NSTATE,1,ISTNEW)
      ALLOCATE(IBC(NSOUT))
      IF(TYPGEO.EQ.5) THEN
         DO I=1,NSOUT
            IBC(I)=ITRANS(I)
         ENDDO
      ELSE
         DO I=1,NSOUT
            IBC(I)=I
         ENDDO
      ENDIF
      CALL LCMPUT(IPT,'BC-REFL+TRAN',NSOUT,1,IBC)
      DEALLOCATE(IBC)
      CALL LCMPUT(IPT,'MATCOD',NREG,1,MATALB(NSOUT+2))
      ALLOCATE(KEYFLX(NREG),VOL(NREG))
      CALL LCMGET(IPSAL,'KEYFLX',KEYFLX)
      CALL LCMPUT(IPT,'KEYFLX',NREG,1,KEYFLX)
      CALL LCMGET(IPSAL,'VOLUME',VOL)
      CALL LCMPUT(IPT,'VOLUME',NREG,2,VOL)
      DEALLOCATE(VOL,KEYFLX)
      EXTKOP(1)=0.0
      EXTKOP(2)=DENS
      EXTKOP(3)=0.0
      CALL LCMPUT(IPT,'EXCELTRACKOP',3,2,EXTKOP)
      CALL LCMPUT(IPT,'ALBEDO',NALBG,2,GALBED)
      CALL LCMLEN(IPSAL,'FUNC-TABLES',ILENG,ITYLCM)
      IF(ILENG.EQ.0) CALL XABORT('TRCDRV: PROBLEM 3')
      CALL LCMSIX(IPSAL,'FUNC-TABLES',1)
      CALL LCMSIX(IPT,'FUNC-TABLES',1)
      CALL LCMEQU(IPSAL,IPT)
      CALL LCMSIX(IPT,' ',2)
      CALL LCMSIX(IPSAL,' ',2)
      CALL XDREXP(IPT,DEX,NBEX)
*
      DEALLOCATE(SEGLEN,NRSEG,ITRACK,RTRACK,ANGLE,MERGE,VOLSUR,MATALB)
*
      WRITE(6,"(A23,//)") '->@END MODULE : TRACKC:'
      RETURN
*
  100 FORMAT(/
     1 23H->@BEGIN MODULE TRACKC /
     2 49H->DESCRIPTION : IMPORTATION OF A SALOME TRACKING /
     3 47H->COPYRIGHTS : ECOLE POLYTECHNIQUE DE MONTREAL /
     4 49H               GNU LESSER GENERAL PUBLIC LICENSE /
     5 19H->TRACKING FILES : ,A12,/,19x,A12//) 
  150 FORMAT ("   nber",2x,"nber of elem",2x," angle",/,
     1 "   ----",2x,"------------",2x," -----")
  200 FORMAT(5x,"   nber",2x,"reg",2x," length",3x,"elem",/,5x,
     1 "   ----",2x,"---",2x," ------",3x,"----",1x)
      END
