*DECK XELNTR
      SUBROUTINE XELNTR(   NDIM,  IFOLD, IFTRAK,   NORE,   IPRT,
     >                       NS,     NV,  VOLIN,  MATIN,  MRGIN,
     >                    NSOUT,  NVOUT, VOLOUT, MATOUT, CUTOFX,
     >                    ITGEO,  ICODE, ALBEDO,  NANGL,    LIN)
************************************************************************
*                                                                      *
*           NAME: XELNTR                                               *
*      COMPONENT: EXCELL                                               *
*          LEVEL: 2 (CALLED BY 'EXCELT')                               *
*        VERSION: 1.0                                                  *
*       CREATION: 91/07                                                *
*       MODIFIED: 98/06 (G.M.) COMPRESS TRACKING FILE TO TAKE INTO     *
*                              ACCOUNT SUCCESSIVE IDENTICAL REGIONS    *
*                 00/03 (R.R.) DECLARE ALL VARIABLE TYPES              *
*         AUTHOR: ROBERT ROY                                           *
*                                                                      *
*     SUBROUTINE: THIS ROUTINE WILL COMPUTE RENORMALIZED TRACKS        *
*                 TO OBTAIN TRUE VOLUME VALUES. THE FILE "IFOLD"       *
*                 CONTAINS THE OLD TRACKS; THE FILE "IFTRAK" WILL      *
*                 CONTAIN THE NORMALIZED TRACKS.                       *
*                                                                      *
*           NOTE: THE FILES "IFOLD" AND "IFTRAK" ARE SUPPOSED TO BE:   *
*                 1) CONNECTED AND OPENED;                             *
*                 2) PLACED FOR ACCESSING THE FIRST RECORD (REWIND).   *
*                                                                      *
*--------+-------------- V A R I A B L E S -------------+--+-----------*
*  NAME  /                  DESCRIPTION                 /IO/MOD(DIMENS)*
*--------+----------------------------------------------+--+-----------*
* NDIM   / # OF DIMENSIONS (2D OR 3D).                  /I./INT        *
* IFOLD  / UNNORMALIZED TRACKING FILE # (AT INPUT).     /I./INT        *
* IFTRAK /   NORMALIZED TRACKING FILE # (AT OUTPUT).    /I./INT        *
* NORE   / INTEGER FLAG FOR NORMALIZATION               /I./INT        *
*        / -2 -> NORMALIZE TO ORIGINAL VOLUME all angles   /           *
*        / -1 -> NORMALIZE TO MERGED VOLUME by angle    /  /           *
*        /  0 -> NORMALIZE TO ORIGINAL VOLUME by angle  /  /           *
*        /  1 -> DO NOT NORMALIZE                       /  /           *
* IPRT   / INTERMEDIATE PRINTING LEVEL FOR PRINOUT.     /I./INT        *
* NS     / # OF SURFACES BEFORE MERGING.                /I./INT        *
* NV     / # OF ZONES BEFORE MERGING.                   /I./INT        *
* VOLIN  / VOLUMES & SURFACES BEFORE MERGING.           /I./REL(-NS:NV)*
* MATIN  / MATERIAL #S BEFORE MERGING.                  /I./INT(-NS:NV)*
* MRGIN  / MERGING INDEX.                               /I./INT(-NS:NV)*
* NSOUT  / # OF SURFACES AFTER  MERGING.                /I./INT        *
* NVOUT  / # OF ZONES AFTER  MERGING.                   /I./INT        *
* VOLOUT / VOLUMES & SURFACES AFTER  MERGING.           /I./REL(*)     *
* MATOUT / MATERIAL #S BEFORE MERGING.                  /I./INT(*)     *
* CUTOFX / CUTOFF FACTOR.                               /I./REL        *
* ITGEO  / KIND OF GEOMETRY.                            /I./INT        *
* ICODE  / INDEX OF BOUNDARY CONDITIONS.                /I./INT(6)     *
* ALBEDO / GEOMETRIC ALBEDOS ON EXTERNAL FACES.         /.O/REL(6)     *
* NANGL  / # OF ANGLES TO RENORMALIZE TRACKS BY ANGLE.  /I./INT        *
* LIN    / MAX. # OF TRACK SEGMENTS IN A SINGLE TRACK.  /I./INT        *
************************************************************************
C
      IMPLICIT           NONE
C
      INTEGER            NDIM,IFTRAK,IFOLD,NS,NV,LIN,NANGL,NSOUT,NVOUT,
     >                   NORE,IPRT,MATIN(-NS:NV),MRGIN(-NS:NV),
     >                   MATOUT(-NSOUT:NVOUT),ICODE(6),ITGEO,
     >                   IANG,IC,IL,IP,IR,ISPEC,ITRAK,IVS,IVSC,JR,LINE,
     >                   MNSUR,MXSEG,MXVOL,NANG2,NBTRK,NCOMNT,IOUT,JL,
     >                   NALBG,NCOR,NSCRP,NSURC,NSURM,NVOLC,NVOLM,NTMP,
     >                   NSREN,NVREN,IPREN,NCSEG,NOLDS,NNEWS 
      INTEGER            IVSMAX(2)
      REAL               ERRCUR
      REAL               VOLIN(-NS:NV),VOLOUT(-NSOUT:NVOUT),
     >                   ASCRP,ALBEDO(6),
     >                   ERRSUR,ERRVOL,WEIGHT,CUTOFX,RCUT,VOLMIN,
     >                   TMPERR(10),ERRVM,ERRSM
      DOUBLE PRECISION   APRSUR,APRVOL,TOTVOL,TOTSUR,ZERO,ONE,TWO,
     >                   FOUR,HALF,QUART,HUND,PI,FACVOL,FACSUR,VOLREF,
     >                   AVGREN
      CHARACTER          CTRK*4, COMENT*80, CORIEN(0:3,-6:0)*4
      PARAMETER        ( PI=3.14159265358979323846D0, IOUT=6,
     >                   ZERO=0.D0, ONE=1.D0, TWO=2.D0, FOUR=4.D0,
     >                   HUND=1.D2, HALF=0.5D0, QUART=0.25D0 )
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NRSEG
      REAL, ALLOCATABLE, DIMENSION(:) :: DENSTY,PATH
      REAL, ALLOCATABLE, DIMENSION(:,:) :: ANGLES
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: VOLTRK
      DATA         ((CORIEN(JR,IR),IR=-6,0),JR=0,3)
     >       / ' 6  ',' 5  ',' 4  ',' 3  ',' 2  ',' 1  ','    ',
     >         ' Z+ ',' Z- ','****','****',' R+ ','****','    ',
     >         ' Z+ ',' Z- ','****','****','****','HBC ','    ',
     >         ' Z+ ',' Z- ',' Y+ ',' Y- ',' X+ ',' X- ','    '/
C----
C  SCRATCH STORAGE ALLOCATION
C   VOLTRK: volumes & surfaces as computed by tracking.
C   ANGLES: x,y,z components of angles.
C   DENSTY: weights by angle.
C   PATH  : relative path of each segment in a track.
C   NRSEG : material identification in a track.
C----
      ALLOCATE(NRSEG(LIN))
      ALLOCATE(ANGLES(3,NANGL),DENSTY(NANGL),PATH(LIN))
      ALLOCATE(VOLTRK(-NS:NV,0:NANGL))
C
C     READ FIRST RECORDS OF THE TRACKING FILE
      READ (IFOLD ) CTRK,NCOMNT,NSCRP
      DO 5 IC= 1, NCOMNT
         READ (IFOLD ) COMENT
    5 CONTINUE
      READ (IFOLD ) NSCRP,ISPEC,NSCRP,NSCRP,NALBG,NCOR,NSCRP,NSCRP
      IF( NALBG.LE.0.OR.NALBG.GT.6 )THEN
         CALL XABORT('XELNTR: NALBG.GT.6.OR.NALBG.LE.0'//
     >               ' ON TRACKING FILE')
      ENDIF
      READ (IFOLD )  (ASCRP,IR=-NS,NV)
      READ (IFOLD )  (NSCRP,IR=-NS,NV)
      READ (IFOLD )  (NSCRP,     IR=1,NALBG)
      READ (IFOLD )  (ALBEDO(IR),IR=1,NALBG)
      READ (IFOLD ) ((ANGLES(IR,JR),IR=1,NDIM),JR=1,NANGL)
      READ (IFOLD )  (DENSTY(JR),JR=1,NANGL)
C
      FACSUR= 0.0D0
      FACVOL= TWO
      IF( ISPEC.EQ.0 )THEN
         IF( NDIM.EQ.2 )THEN
            FACSUR= QUART*PI
         ELSEIF( NDIM.EQ.3 )THEN
            FACSUR= ONE
         ENDIF
      ELSEIF( ISPEC.EQ.1 )THEN
         IF( NDIM.EQ.2 )THEN
            FACSUR= HALF*PI
         ELSEIF( NDIM.EQ.3 )THEN
            FACSUR= ONE
         ENDIF
      ENDIF
C
C     INITIALIZE NORMALIZED FACTORS
C     NORE = -1 -> FOR MERGED VOLUME
C          =  0 -> FOR ORIGINAL VOLUMES
C          =  1 -> NO NORMALIZE BUT FIND TRACK ERROR ON MERGED VOLUME
      NSREN=NSOUT
      NVREN=NVOUT
      IF(NORE.EQ.0) THEN
        NSREN=NS
        NVREN=NV
      ENDIF
      DO 10 IVS= -NSREN, NVREN
        DO 11 IANG= 0, NANGL
           VOLTRK(IVS,IANG)= ZERO
   11 CONTINUE
   10 CONTINUE
C
C     COMPUTE CUTOFF FOR LINE RELATIVE TO MERGED VOLUME
      VOLMIN=VOLOUT(1)
      DO 12 IVS= 2, NVOUT
        VOLMIN= MIN(VOLMIN,VOLOUT(IVS))
   12 CONTINUE
      RCUT= VOLMIN*CUTOFX
      IF( IPRT.GE.999 )THEN
         WRITE(IOUT,'(11X,A32,F20.15)')
     >      'CUTOFF FACTOR FOR LINES    =    ',RCUT
      ENDIF
C
C     LOOP OVER TRACKING (UNNORMALIZED TRACKS)
C     AND COMPUTE VOLUME OF TRACK
      NBTRK= 0
      MXSEG= 0

      IF( IPRT .GE. 999 ) THEN
        WRITE(IOUT,'(A22)') 'INITIAL line segments ' 
      ENDIF
   20 CONTINUE
         READ(IFOLD,END=40) IANG,LINE,WEIGHT,
     >                      (NRSEG(IL),IL=1,LINE),
     >                      (PATH(IL),IL=1,LINE)
         IF( LINE.GT.LIN )THEN
            WRITE(IOUT,'(11X,A32,I20)')
     >      'NUMBER OF ELEMENTS IN LINE =    ',LINE
            WRITE(IOUT,'(11X,A32,I20)')
     >      'MAXIMUM NUMBER OF ELEMENTS =    ',LIN
            CALL XABORT( 'XELNTR: TRACKING FILE CORRUPTED' )
         ENDIF
         MXSEG= MAX(MXSEG,LINE)
         DO 31 IL  = 1, LINE
           IF(NORE.EQ.0) THEN
             IPREN=NRSEG(IL)
           ELSE
             IPREN=MRGIN(NRSEG(IL))
           ENDIF
           VOLTRK(IPREN,IANG)= VOLTRK(IPREN,IANG) + WEIGHT * PATH(IL)
   31    CONTINUE
         NBTRK= NBTRK + 1
         IF( IPRT .GE. 999 ) THEN
           WRITE(IOUT,6100) NBTRK,IANG,LINE,WEIGHT,WEIGHT/DENSTY(IANG) 
           WRITE(IOUT,6101)
     >          (PATH(JL),NRSEG(JL),MRGIN(NRSEG(JL)),JL=1,LINE)
         ENDIF
      GO TO 20
C
C     COMPUTE TRACK NORMALIZATION FACTOR
   40 CONTINUE
      DO 47 IVS=  -NSREN, NVREN
        IF(NORE.EQ.0) THEN
          VOLREF=DBLE(VOLIN(IVS))
        ELSE
          VOLREF=DBLE(VOLOUT(IVS))
        ENDIF
        DO 46 IANG= 1, NANGL
           VOLTRK(IVS,0)= VOLTRK(IVS,0) + VOLTRK(IVS,IANG)
           VOLTRK(IVS,IANG)= VOLTRK(IVS,IANG)*DENSTY(IANG)
           IF( VOLTRK(IVS,IANG).NE.ZERO )THEN
              VOLTRK(IVS,IANG)= VOLREF/VOLTRK(IVS,IANG)
           ELSE
              VOLTRK(IVS,IANG)= ONE
           ENDIF
   46   CONTINUE
   47 CONTINUE
      IF(NORE .EQ. -2) THEN
        DO 48 IVS= 1, NVREN
          AVGREN=DBLE(VOLOUT(IVS))/(VOLTRK(IVS,0)*FACVOL)
          DO 44 IANG= 1, NANGL
            VOLTRK(IVS,IANG)=AVGREN
   44     CONTINUE
   48   CONTINUE
      ENDIF   
C
C     COMPUTE ERRORS ON VOLUMES
      TOTSUR=ZERO
      APRSUR=ZERO
      TOTVOL=ZERO
      APRVOL=ZERO
      ERRSM=0.0
      ERRVM=0.0
      IVSMAX(1)=0
      IVSMAX(2)=0
      IVSC=0 
      DO 50 IVS= -NSREN, NVREN
         IF( NORE.EQ.0 )THEN
            VOLREF=DBLE(VOLIN(IVS))
         ELSE
            VOLREF=DBLE(VOLOUT(IVS))
         ENDIF
         IF( VOLTRK(IVS,0).EQ.ZERO .AND. VOLREF.GT.ZERO )THEN
            IF( IVS.LT.0 )THEN
               IF( NORE.EQ.0 )THEN
                  WRITE(IOUT,9010) IVS
               ELSE
                  WRITE(IOUT,9011) IVS
               ENDIF
            ELSEIF( IVS.GT.0 )THEN
               IF( NORE.EQ.0 )THEN
                  WRITE(IOUT,9000) IVS
               ELSE
                  WRITE(IOUT,9001) IVS
               ENDIF
            ENDIF
            IVSC=IVS
         ENDIF
         IF( IVS.LT.0 )THEN
            VOLTRK(IVS,0)= FACSUR*VOLTRK(IVS,0)
            IF( VOLIN(IVS).NE.0.0 )THEN
               ERRCUR=REAL(100.0*ABS(1.0-VOLTRK(IVS,0)/VOLREF))
               IF(ERRCUR .GT. ERRSM) THEN
                 IVSMAX(1)=IVS  
                 ERRSM=ERRCUR
               ENDIF
            ENDIF
            TOTSUR=TOTSUR+VOLREF
            APRSUR=APRSUR+VOLTRK(IVS,0)
         ELSEIF( IVS.GT.0 )THEN
            VOLTRK(IVS,0)= FACVOL*VOLTRK(IVS,0)
            TOTVOL=TOTVOL+VOLREF
            APRVOL=APRVOL+VOLTRK(IVS,0)
            IF( VOLREF.NE.ZERO )THEN
               ERRCUR=REAL(100.0*ABS(1.0-VOLTRK(IVS,0)/VOLREF))
               IF(ERRCUR .GT. ERRVM) THEN
                 IVSMAX(2)=IVS  
                 ERRVM=ERRCUR
               ENDIF
            ENDIF
         ENDIF
   50 CONTINUE
      ERRSUR=100.*(1.0-REAL(APRSUR/TOTSUR))
      ERRVOL=100.*(1.0-REAL(APRVOL/TOTVOL))
C
C     CONSTRUCT THE NEW TRACKING FILE
      REWIND IFOLD
      READ (IFOLD ) CTRK,NSCRP,NSCRP
      WRITE(IFTRAK) CTRK,NCOMNT,NBTRK
      DO 55 IC= 1, NCOMNT
         READ (IFOLD ) COMENT
         WRITE(IFTRAK) COMENT
   55 CONTINUE
      READ (IFOLD )  (NSCRP,IR=1,8)
      WRITE(IFTRAK) NDIM,ISPEC,NVOUT,NSOUT,NALBG,NCOR,NANGL,MXSEG
      READ (IFOLD )  (ASCRP,     IR=-NS,NV)
      WRITE(IFTRAK)  (VOLOUT(IR),IR=-NSOUT,NVOUT)
      READ (IFOLD )  (NSCRP,     IR=-NS,NV)
      WRITE(IFTRAK)  (MATOUT(IR),IR=-NSOUT,NVOUT)
      READ (IFOLD )  (NSCRP,     IR=1,NALBG)
      WRITE(IFTRAK)  ( ICODE(IR),IR=1,NALBG)
      READ (IFOLD )  (ASCRP,     IR=1,NALBG)
      WRITE(IFTRAK)  (ALBEDO(IR),IR=1,NALBG)
      READ (IFOLD ) ((ASCRP,     IR=1,NDIM ),JR=1,NANGL)
      WRITE(IFTRAK) ((ANGLES(IR,JR),IR=1,NDIM),JR=1,NANGL)
      READ (IFOLD )  (ASCRP,     JR=1,NANGL)
      WRITE(IFTRAK)  (DENSTY(JR),JR=1,NANGL)
      IF( IPRT .GE. 999 ) THEN
        WRITE(IOUT,'(A22)') 'FINAL line segments   ' 
      ENDIF
      DO 70 ITRAK=1, NBTRK
         READ(IFOLD) IANG,LINE,WEIGHT,
     >               (NRSEG(IL),IL=1,LINE),
     >               (PATH(IL),IL=1,LINE)
         IF(RCUT .GT. 0.0)THEN
            IL= 0
   23       CONTINUE
               IF(IL.EQ.LINE) GO TO 25
               IL= IL+1
               IF(PATH(IL).LT.RCUT)THEN
                  IF(IL.NE.LINE)THEN
                     DO 24 JL= IL+1, LINE
                        NRSEG(JL-1)= NRSEG(JL)
                        PATH(JL-1)=  PATH(JL)
   24                CONTINUE
                  ELSE
                     LINE= LINE-1
                     GO TO 25
                  ENDIF
                  LINE= LINE-1
                  IL= IL-1
               ENDIF
               GO TO 23
   25       CONTINUE
         ENDIF
         IF( NORE.LT.1 )THEN
C
C           RENORMALIZE TRACK LENGHTS
            DO 60 IL  = 1, LINE
               IF( NRSEG(IL).GT.0 )THEN
                  IF(NORE.EQ.0) THEN
                     IPREN=NRSEG(IL)
                  ELSE
                     IPREN=MRGIN(NRSEG(IL))
                  ENDIF
                  PATH(IL)= REAL(VOLTRK(IPREN,IANG)) * PATH(IL)
               ENDIF
   60       CONTINUE
         ENDIF
C
C        CHANGE #ING ACCORDING TO MERGES
         DO 65 IL  = 1, LINE
             NRSEG(IL)= MRGIN(NRSEG(IL))
   65    CONTINUE
C
C        START MODIFICATIONS 98/06/02
C        COMPRESS TRACKING FILE FOR SUCCESSIVE IDENTICAL REGIONS
         NOLDS=NRSEG(1)
         NCSEG=1
         DO 66 IL = 2, LINE
            NNEWS=NRSEG(IL)
            IF( NNEWS.LT.0 .OR. NNEWS.NE.NOLDS )THEN
               NOLDS=NNEWS
               NCSEG=NCSEG+1
               NRSEG(NCSEG)=NRSEG(IL)
               PATH(NCSEG)=PATH(IL)
            ELSEIF( NNEWS.EQ.NOLDS )THEN
               PATH(NCSEG)=PATH(NCSEG)+PATH(IL)
            ENDIF
 66      CONTINUE
         WRITE(IFTRAK) IANG,NCSEG,WEIGHT,
     >                (NRSEG(IL),IL=1,NCSEG),
     >                (PATH(IL),IL=1,NCSEG)
         IF( IPRT.GE.999 ) THEN
              WRITE(IOUT,'(2H #,I8,12H WRITE IANG=,I8,5H LEN=,I8)')
     >                       ITRAK,            IANG,      NCSEG
              WRITE(IOUT,'(1P,(1X,E15.6,1X,I8))' )
     >                 (PATH(JL),NRSEG(JL),JL=1,NCSEG)
         ENDIF
C       END MODIFICATIONS 98/06/02
C
   70 CONTINUE
      IF(IPRT .GE. 5) THEN
         MNSUR = -NSREN
         MXVOL =  NVREN
         NSURC = -1
         WRITE(IOUT,'(1H )')
         WRITE(IOUT,7000) ERRSUR,ERRSM
         WRITE(IOUT,7005) -IVSMAX(1),4.0*VOLTRK(IVSMAX(1),0)
         DO 80 IP  = 1, (9 - MNSUR) / 10
            NSURM= MAX( MNSUR, NSURC-9 )
            WRITE(IOUT,7100)(' FACE',-IR,IR=NSURC,NSURM,-1)
            IF(NORE.EQ.0) THEN
              WRITE(IOUT,7110)
     >             (4.*VOLIN(IR),IR=NSURC,NSURM,-1)
              WRITE(IOUT,7111)
     >             (CORIEN(ITGEO,MATIN(IR)),IR=NSURC,NSURM,-1)
            ELSE
              WRITE(IOUT,7110)
     >             (4.*VOLOUT(IR),IR=NSURC,NSURM,-1)
              WRITE(IOUT,7111)
     >             (CORIEN(ITGEO,MATOUT(IR)),IR=NSURC,NSURM,-1)
            ENDIF
            WRITE(IOUT,7101) (FOUR*VOLTRK(IR,0),IR=NSURC,NSURM,-1)
            NTMP=0
            DO 81  IR=NSURC,NSURM,-1
              IF(NORE.EQ.0) THEN
                VOLREF=DBLE(VOLIN(IR))
              ELSE
                VOLREF=DBLE(VOLOUT(IR))
              ENDIF
              NTMP=NTMP+1
              IF(VOLREF.NE.ZERO) THEN
                TMPERR(NTMP)=REAL(HUND-HUND*VOLTRK(IR,0)/VOLREF)
              ELSE
                TMPERR(NTMP)=0.0
              ENDIF
  81        CONTINUE
            WRITE(IOUT,7102) (TMPERR(IR),IR=1,NTMP)
            IF(NORE .EQ. 0 .OR. NORE .EQ. -2) THEN
              WRITE(IOUT,7103) (' FACE',-MRGIN(IR),IR=NSURC,NSURM,-1)
            ENDIF
            WRITE(IOUT,7104)
            NSURC = NSURC - 10
   80    CONTINUE
         NVOLC= 1
         WRITE(IOUT,'(1H )')
         WRITE(IOUT,7001) ERRVOL,ERRVM
         WRITE(IOUT,7006) IVSMAX(2),VOLTRK(IVSMAX(2),0)
         DO 90 IP  = 1, (9 + MXVOL) / 10
            NVOLM= MIN( MXVOL, NVOLC+9 )
            WRITE(IOUT,7100) (' ZONE',IR,IR=NVOLC,NVOLM)
            IF(NORE.EQ.0) THEN
              WRITE(IOUT,7120)
     >             (VOLIN(IR),IR=NVOLC,NVOLM)
              WRITE(IOUT,7121)
     >             (' MIX ', MATIN(IR),IR=NVOLC,NVOLM)
            ELSE
              WRITE(IOUT,7120)
     >             (VOLOUT(IR),IR=NVOLC,NVOLM)
              WRITE(IOUT,7121)
     >             (' MIX ', MATOUT(IR),IR=NVOLC,NVOLM)
            ENDIF
            WRITE(IOUT,7101) (VOLTRK(IR,0),IR=NVOLC,NVOLM)
            NTMP=0
            DO 91  IR= NVOLC,NVOLM
              IF(NORE.EQ.0) THEN
                VOLREF=DBLE(VOLIN(IR))
              ELSE
                VOLREF=DBLE(VOLOUT(IR))
              ENDIF
              NTMP=NTMP+1
              IF(VOLREF.NE.ZERO) THEN
                TMPERR(NTMP)=REAL(HUND-HUND*VOLTRK(IR,0)/VOLREF)
              ELSE
                TMPERR(NTMP)=0.0
              ENDIF
  91        CONTINUE
            WRITE(IOUT,7102) (TMPERR(IR),IR=1,NTMP)
            IF(NORE.EQ.0) THEN
              WRITE(IOUT,7103) (' ZONE',MRGIN(IR),IR=NVOLC,NVOLM)
            ENDIF
            WRITE(IOUT,7104)
            NVOLC = NVOLC + 10
   90    CONTINUE
         IF(IPRT .GT. 5)THEN
           NVOLC= 1
           NANG2= NANGL+2
           WRITE(IOUT,'(1H )')
           IF( NORE.GT.0 )THEN
              WRITE(IOUT,7003)
           ELSEIF(NORE .EQ. -2) THEN
              WRITE(IOUT,7004)
           ELSE
              WRITE(IOUT,7002)
           ENDIF
           DO 110 IP  = 1, (9 + MXVOL) / 10
             NVOLM= MIN( MXVOL, NVOLC+9 )
             WRITE(IOUT,7100) (' VOL ',IR,IR=NVOLC,NVOLM)
             IF(NORE .EQ. -2 ) THEN
               IANG=1
               WRITE(IOUT,7131)  
     >            (VOLTRK(IR,IANG),IR=NVOLC,NVOLM)
             ELSE
               DO 100 IANG= 1, NANGL
                 WRITE(IOUT,7130) IANG, 
     >            (VOLTRK(IR,IANG),IR=NVOLC,NVOLM)
  100          CONTINUE
             ENDIF
             WRITE(IOUT,7104)
             NVOLC = NVOLC + 10
  110      CONTINUE
         ENDIF
      ELSE IF(IPRT .GE. 1) THEN
         WRITE(IOUT,'(1H )')
         WRITE(IOUT,7000) ERRSUR,ERRSM
         WRITE(IOUT,7005) -IVSMAX(1),4.0*VOLTRK(IVSMAX(1),0)
         WRITE(IOUT,'(1H )')
         WRITE(IOUT,7001) ERRVOL,ERRVM
         WRITE(IOUT,7006) IVSMAX(2),VOLTRK(IVSMAX(2),0)
      ENDIF
      IF( IVSC.NE.0 )THEN
         WRITE(IOUT,9020)
         CALL XABORT( 'XELNTR: CHECK NUMBERING OR USE FINER TRACKING')
      ENDIF
C----
C  SCRATCH STORAGE DEALLOCATION
C----
      DEALLOCATE(VOLTRK,NRSEG,PATH,DENSTY,ANGLES)
      RETURN
C----
C  Formats
C----
 6100 FORMAT(1X,'TRACK # ',I8,3X,'ANGLE ',I8,
     >       1X,'WITH ',I8,1X,'SEGMENTS',
     >       3X,'TOTAL WEIGHT =',1P,E15.6,3X,'VOLUME WEIGHT =',E15.6)
 6101  FORMAT(1P,(1X,E15.6,1X,2I8))
 7000 FORMAT(/' TRACKING ERRORS ON SURFACE   AVERAGE ERROR: ',F10.4,
     >        ' % ',5X,'MAXIMUM ERROR: ',F10.4,' % ')
 7001 FORMAT( ' TRACKING ERRORS ON VOLUME    AVERAGE ERROR: ',F10.4,
     >        ' % ',5X,'MAXIMUM ERROR: ',F10.4,' % ')
 7002 FORMAT(/' ANGLE-BY-ANGLE RENORMALIZATION FACTORS: '/)
 7003 FORMAT(/' ANGLE-BY-ANGLE RENORMALIZATION FACTORS(**NOT USED): '/)
 7004 FORMAT(/' GLOBAL RENORMALIZATION FACTORS: '/)
 7005 FORMAT(' MAXIMUM ERROR ON SURFACE=',I8,' WITH AREA  =',1P,E11.4)
 7006 FORMAT(' MAXIMUM ERROR IN REGION =',I8,' WITH VOLUME=',1P,E11.4)
 7100 FORMAT(10X,10(A5,I7))
 7101 FORMAT(' APPROX   ',1P,10E12.4)
 7102 FORMAT(' ERR(%)   ',10F12.5)
 7103 FORMAT(' MERGE TO ',10(A5,I7))
 7104 FORMAT(' ')
 7110 FORMAT(' SURFACE  ',1P,10E12.4)
 7111 FORMAT(' SIDE     ',10(A4,8X))
 7120 FORMAT(' VOLUME   ',1P,10E12.4)
 7121 FORMAT(' MIXTURE  ',10(A4,1X,I7))
 7130 FORMAT(' ANG ',I4,1X,1P,10E12.4)
 7131 FORMAT(10X,1P,10E12.4)
C
 9000 FORMAT(' *** WARNING - ORIGINAL VOLUME  # ',I10,' NOT TRACKED ')
 9001 FORMAT(' *** WARNING - MERGED VOLUME    # ',I10,' NOT TRACKED ')
 9010 FORMAT(' *** WARNING - ORIGINAL SURFACE # ',I10,' NOT TRACKED ')
 9011 FORMAT(' *** WARNING - MERGED SURFACE   # ',I10,' NOT TRACKED ')
 9020 FORMAT(' *** ERROR - ONE MERGED VOLUME OR SURFACE NOT TRACKED')
      END
