*DECK NXTSGT
      SUBROUTINE NXTSGT(IPTRK ,IPRINT,MAXMSH,ITYPG ,IGEO  ,ILEV  ,
     >                  MAXMSS,NMIX  ,NM    ,MIX   ,DAMESH,ISPLT ,
     >                  NMIXS ,NMS   ,MIXS  ,DAMESS,
     >                  ITSYM ,NREGS ,NSURS ,NREGN ,NSURN ,NEREN ,
     >                  IDREG ,IDSUR , IREN  )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Discretize geometry according to splitting options for
* HEXT and HEXTZ geometry.
*
*Copyright:
* Copyright (C) 2005 Ecole Polytechnique de Montreal.
*
*Author(s):
* G. Marleau
*
*Update(s):
* 2005/09/29: Validated with DRAGON and documented in
*             Report IGE-260.
*
*Reference:
*  G. Marleau,
*  \textsl{New Geometries Processing in DRAGON: The NXT: Module},
*  Report IGE-260, \'{E}cole Polytechnique de Montr\'{e}al,
*  Montr\'{e}al, 2005.
*
*Parameters: input
* IPTRK   pointer to the TRACKING data structure.
* IPRINT  intermediate printing level for output.
* MAXMSH  maximum number of elements in MESH array.
* ITYPG   type of geometry.
* IGEO    geometry number.
* ILEV    geometry level.
* MAXMSS  maximum number of elements in MESH array after split.
* NMIX    number of elements in MIX array.
* NM      mesh size in all directions ($X$, $Y$, $Z$ and $R$)
* MIX     final mixture description for geometry (including MMIX).
* DAMESH  final mesh description for geometry.
* ISPLT   final split desctiption for geometry.
* NMS     mesh size after splitting.
* ITSYM   flag for symmetries to test.
* NREGS   maximum number of regions in splitted geometry.
* NSURS   maximum number of surfaces in splitted geometry.
* NREGN   number of regions in splitted geometry after symmetry.
* NSURN   number of surfaces in splitted geometry after symmetry.
* NEREN   maximum number of elements in IREN.
*
*Parameters: input/output
* MIXS     mixture description for rotated geometry (including MMIX).
* DAMESS   mesh description for rotated geometry.
* IDREG    region identifier after symmetry.
* IDSUR    surface identifier after symmetry.
*
*Parameters: temporary storage
* IREN     surface/region renumbering vector.
*
*-----------------------------------------------------------------------
*
      USE              GANLIB
      IMPLICIT         NONE
*----
*  Subroutine arguments
*----
      TYPE(C_PTR)      IPTRK
      INTEGER          IPRINT,MAXMSH,ITYPG,IGEO,ILEV,MAXMSS,NMIX,NM(4)
      INTEGER          MIX(NMIX,2)
      DOUBLE PRECISION DAMESH(-1:MAXMSH,4)
      INTEGER          ISPLT(MAXMSH,4)
      INTEGER          NMIXS,NMS(4)
      INTEGER          MIXS(NMIXS,2)
      DOUBLE PRECISION DAMESS(-1:MAXMSS,4)
      INTEGER          ITSYM(4),NREGS,NSURS,NREGN,NSURN,NEREN
      INTEGER          IDREG(NREGS),IDSUR(NSURS),IREN(2,NEREN)
*----
*  Local parameters
*----
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='NXTSGT')
      DOUBLE PRECISION DZERO,DONE,DDC,DCAOF
      PARAMETER       (DZERO=0.0D0,DONE=1.0D0,DDC=1.0D-3,
     >                 DCAOF=DONE+DDC)
*----
*  Local variables
*----
      INTEGER          NX ,NZ ,NRTP ,NRP ,NSTP ,NSP ,
     >                 NXS,NZS,NRTPS,NRPS,NSTPS,NSPS,
     >                 NZMX1,NZSMX1,NBSX,NBSZ,NZSR,NSPLAN
      INTEGER          IPLOC,IX,IXS,IZ,IZS,III,JJJ,
     >                 ISECT,IDMIX
      INTEGER          IOFZ,IOFZS,IOFS,IOFSS,IOFXL,IOFXC,IOFXLS
      INTEGER          IODZ,IODHZ,IORHZ,IORZ,IRN,IRO,IRR,IRT,
     >                 ISTOP,ISBOT,IDS,IDV
      DOUBLE PRECISION DELTH,DELTH0,DDD
      CHARACTER        NAMREC*12
*----
*  Data
*----
      CHARACTER        CLEV(2)*1
      SAVE             CLEV
      DATA             CLEV /'C','P'/
*----
*  Static variables used
*  before split
*  NX    =  mesh in x (from 0 to SIDE)
*  NZ    =  mesh in z (from zmin to zmax)
*  NRTP  =  number of region in a triangle for each z plane
*  NRP   =  number of region in a z plane
*  NSTP  =  number of surfaces in a triangle for each z plane
*  NSP   =  number of surfaces in a z plane
*  after split
*  NXS   =  mesh in x (from 0 to SIDE)
*  NZS   =  mesh in z (from zmin to zmax)
*  NRTPS =  number of region in a triangle for each z plane
*  NRPS  =  number of region in a z plane
*  NSTPS =  number of surfaces in a triangle for each z plane
*  NSPS  =  number of surfaces in a z plane
*----
      NX=NM(1)
      NZ=NM(3)
      NRTP=NX**2
      NRP=6*NRTP
      NSTP=2*NX-1
      NSP=6*NSTP
      NXS=NMS(1)
      NZS=NMS(3)
      NRTPS=NXS**2
      NRPS=6*NRTPS
      NSTPS=2*NXS-1
      NSPS=6*NSTPS
*      write(6,*) 'NX,NZ,NRTP,NRP,NSTP,NSP,NXS,NZS,NRTPS,NRPS,NSTPS,NSPS'
*     >,NX,NZ,NRTP,NRP,NSTP,NSP,NXS,NZS,NRTPS,NRPS,NSTPS,NSPS
*----
*  Processing starts:
*  print routine openning output header if required
*  and initialize various parameters.
*----
      IPLOC=IPRINT
      IF(IPLOC .GE. 100) THEN
        WRITE(IOUT,6000) NAMSBR
        WRITE(IOUT,6002) ITYPG
        WRITE(IOUT,6010) NX,NZ
        WRITE(IOUT,6011) 'MESHH ='
        WRITE(IOUT,6012) (DAMESH(IX,1),IX=-1,2*NX)
        WRITE(IOUT,6011) 'SPLTH ='
        WRITE(IOUT,6013) ISPLT(1,1)
        IF(NZ .GT. 0) THEN
          WRITE(IOUT,6011) 'MESHZ ='
          WRITE(IOUT,6012) (DAMESH(IZ,3),IZ=-1,NZ)
          WRITE(IOUT,6011) 'SPLTZ ='
          WRITE(IOUT,6013) (ISPLT(IZ,3),IZ=1,NZ)
        ENDIF
      ENDIF
*      write(6,*) 'NX,NZ,NXS,NZS',NX,NZ,NXS,NZS
*      write(6,*) 'NREGS,NSURS',NREGS,NSURS
*----
*  Triangular mesh
*----
      NBSX=ABS(ISPLT(1,1))
*----
*  Note : last crown may have a width different
*  from the other crowns
*  Splitting is with respect to width of internal crowns
*  unless only one crown considered
*----
      IF(NX .EQ. 1) THEN
        DELTH0=(DAMESH(1,1)-DAMESH(0,1))/DBLE(NBSX)
        DELTH=DELTH0
      ELSE
        DELTH0=DAMESH(1,1)-DAMESH(0,1)
        DELTH=DAMESH(2,1)-DAMESH(1,1)
        DDD=DELTH-DELTH0
        DELTH=DELTH/DBLE(NBSX)
        IF(DDD .GT. DELTH) THEN
          WRITE(IOUT,9000) DELTH0,DELTH,DDD
          CALL XABORT(NAMSBR//
     >      ': Invalid SPLIT for HEXT and HEXTZ geometries')
        ENDIF
        DELTH0=DELTH-DDD
      ENDIF
      DAMESS(-1,1)=DAMESH(-1,1)
      DAMESS(0,1)=DAMESH(0,1)
      DAMESS(1,1)=DAMESS(0,1)+DELTH0
      III=1
      DO IXS=1,NBSX-1
        III=III+1
        DAMESS(III,1)=DAMESS(III-1,1)+DELTH
      ENDDO
      DO JJJ=2,2*NX-1
        DO IXS=1,NBSX
          III=III+1
          DAMESS(III,1)=DAMESS(III-1,1)+DELTH
        ENDDO
      ENDDO
      DO IXS=1,NBSX-1
        III=III+1
        DAMESS(III,1)=DAMESS(III-1,1)+DELTH
      ENDDO
      III=III+1
      DAMESS(III,1)=DAMESS(III-1,1)+DELTH0
*----
*  Y mesh identical to X mesh except for off center
*----
      DO IXS=-1,2*NXS
        DAMESS(IXS,2)=DAMESS(IXS,1)
      ENDDO
*----
*  Z mesh
*----
      IF(NZ .EQ. 0) THEN
        DAMESS(-1,3)=DZERO
        DAMESS(0,3)=DZERO
      ELSE
        DAMESS(-1,3)=DAMESH(-1,3)
        DAMESS(0,3)=DAMESH(0,3)
        III=0
        DO IZ=1,NZ
          NBSZ=ABS(ISPLT(IZ,3))
          DDD=(DAMESH(IZ,3)-DAMESH(IZ-1,3))/DBLE(NBSZ)
          DO IZS=1,NBSZ
            III=III+1
            DAMESS(III,3)=DAMESS(III-1,3)+DDD
          ENDDO
        ENDDO
      ENDIF
      IF(IPLOC .GE. 100) THEN
        WRITE(IOUT,6020) NXS,NZS
        WRITE(IOUT,6011) 'MESHH ='
        WRITE(IOUT,6012) (DAMESS(IX,1),IX=-1,2*NXS)
        IF(NZS .GT. 0) THEN
          WRITE(IOUT,6011) 'MESHZ ='
          WRITE(IOUT,6012) (DAMESS(IZ,3),IZ=-1,NZS)
        ENDIF
      ENDIF
      CALL XDISET(IDREG,NREGS,0)
      CALL XDISET(IDSUR,NSURS,0)
      NRP=6*NRTP
      NRPS=6*NRTPS
*      write(6,*) 'NRP,NRPS,NRTP,NRTPS=',NRP,NRPS,NRTP,NRTPS
*----
*  Loop over planes (3D)
*----
      NZMX1=MAX(1,NZ)
      NZSMX1=MAX(1,NZS)
*----
*  Regions
*  Mixture and global numbering
*----
      IOFZ=0
      IOFZS=0
      DO IZ=1,NZMX1
        IF(NZ .EQ. 0) THEN
          NBSZ=1
        ELSE
          NBSZ=MAX(1,ISPLT(IZ,3))
        ENDIF
        IOFXC=IOFZ
        DO IZS=1,NBSZ
          IOFS=IOFZ
          IOFSS=IOFZS
*----
*  Loop over sectors
*----
          DO ISECT=1,6
            IOFXL=IOFS
            IOFXLS=IOFSS
*----
*  Loop over lines
*----
            DO IX=1,NX
              IF(IX .EQ. 1) THEN
*----
*  A single triangle in first line
*----
                IOFXL=IOFXL+1
                DO IXS=1,NBSX
                  DO III=1,2*IXS-1
                    IOFXLS=IOFXLS+1
*      write(6,'(A4,10I10)') 'Loop',IZ,IZS,ISECT,IX,IXS,III,IOFXL,IOFXLS
                    MIXS(IOFXLS,1)=MIX(IOFXL,1)
                    MIXS(IOFXLS,2)=MIX(IOFXL,2)
                    IDREG(IOFXLS)=IOFXLS
                  ENDDO
                ENDDO
              ELSE
*----
*  For remaining lines
*  IREN(1,*) is original cell position on line
*  IREN(2,*) is number of times this cell is used on
*  each initial splitted mesh
*  (NBSX for right triangle and 0 for left triangle)
*----
*  Loop over all right triangles in line
*----
                DO III=2,2*IX-2,2
                  IOFXL=IOFXL+1
                  IREN(1,III)=IOFXL
                  IREN(2,III)=NBSX
                ENDDO
*----
*  Loop over all left triangles in line
*----
                DO III=1,2*IX-1,2
                  IOFXL=IOFXL+1
                  IREN(1,III)=IOFXL
                  IREN(2,III)=0
                ENDDO
*      write(6,'(A6,2X,3I10)')
*     >     ('IREN =',III,IREN(1,III),IREN(2,III),III=1,2*IX-1)
                DO IXS=1,NBSX
*----
*  Process left triangles on line
*----
                  DO III=1,2*IX-1
                    IDMIX=IREN(1,III)
                    DO JJJ=1,IREN(2,III)
                      IOFXLS=IOFXLS+1
*      write(6,'(A4,10I10)') 'Loop',IZ,IZS,ISECT,IX,IXS,III,IDMIX,IOFXLS
                      MIXS(IOFXLS,1)=MIX(IDMIX,1)
                      MIXS(IOFXLS,2)=MIX(IDMIX,2)
                      IDREG(IOFXLS)=IOFXLS
                    ENDDO
                  ENDDO
*----
*  Prepare for right triangles
*----
                  DO III=2,2*IX-2,2
                    IREN(2,III)=NBSX-1
                  ENDDO
                  DO III=1,2*IX-1,2
                    IREN(2,III)=IREN(2,III)+1
                  ENDDO
*      write(6,'(A6,2X,3I10)')
*     >     ('IREN =',III,IREN(1,III),IREN(2,III),III=1,2*IX-1)
*----
*  Process right triangles on line
*----
                  DO III=1,2*IX-1
                    IDMIX=IREN(1,III)
                    DO JJJ=1,IREN(2,III)
                      IOFXLS=IOFXLS+1
*      write(6,'(A4,10I10)') 'Loop',IZ,IZS,ISECT,IX,IXS,III,IDMIX,IOFXLS
                      MIXS(IOFXLS,1)=MIX(IDMIX,1)
                      MIXS(IOFXLS,2)=MIX(IDMIX,2)
                      IDREG(IOFXLS)=IOFXLS
                    ENDDO
                  ENDDO
                ENDDO
              ENDIF
            ENDDO
            IOFSS=IOFSS+NRTPS
            IOFS=IOFS+NRTP
          ENDDO
          IOFZS=IOFZS+NRPS
        ENDDO
        IOFZ=IOFZ+NRP
      ENDDO
*----
*  Save MESH and mixture information on IPTRK
*----
      IF(NXS .GT. 0) THEN
        WRITE(NAMREC,'(A1,I8.8,A3)') CLEV(ILEV),IGEO,'SMX'
        CALL LCMPUT(IPTRK,NAMREC,2*(2*NXS+2),4,DAMESS(-1,1))
        WRITE(NAMREC,'(A1,I8.8,A3)') CLEV(ILEV),IGEO,'SMY'
        CALL LCMPUT(IPTRK,NAMREC,2*(2*NXS+2),4,DAMESS(-1,2))
      ENDIF
      IF(NZS .GT. 0) THEN
        WRITE(NAMREC,'(A1,I8.8,A3)') CLEV(ILEV),IGEO,'SMZ'
        CALL LCMPUT(IPTRK,NAMREC,2*(NZS+2),4,DAMESS(-1,3))
      ENDIF
      WRITE(NAMREC,'(A1,I8.8,A3)') CLEV(ILEV),IGEO,'MIX'
      CALL LCMPUT(IPTRK,NAMREC,NMIXS,1,MIXS(1,1))
      WRITE(NAMREC,'(A1,I8.8,A3)') CLEV(ILEV),IGEO,'HOM'
      CALL LCMPUT(IPTRK,NAMREC,NMIXS,1,MIXS(1,2))
      IF(IPLOC .GE. 100) THEN
        WRITE(IOUT,6033)
        WRITE(IOUT,6034)  (MIXS(III,1),III=1,NREGS)
        WRITE(IOUT,6036)
        WRITE(IOUT,6034)  (MIXS(III,2),III=1,NREGS)
        WRITE(IOUT,6030) 'before symmetries   '
        WRITE(IOUT,6034)  (IDREG(III),III=1,NREGS)
      ENDIF
*----
*  Hexagnal surfaces
*----
      ISBOT=0
      DO IZS=1,NZSMX1
        DO ISECT=1,6
          DO III=1,NXS-1
            ISBOT=ISBOT+1
            IDSUR(ISBOT)=ISBOT
          ENDDO
          DO III=1,NXS
            ISBOT=ISBOT+1
            IDSUR(ISBOT)=ISBOT
          ENDDO
        ENDDO
      ENDDO
      IF(NZ .GT. 0) THEN
*----
*  Z- and Z+ surfaces
*----
        ISTOP=ISBOT+6*NRTPS
        DO ISECT=1,6
          DO III=1,NRTPS
            ISBOT=ISBOT+1
            IDSUR(ISBOT)=ISBOT
            ISTOP=ISTOP+1
            IDSUR(ISTOP)=ISTOP
          ENDDO
        ENDDO
      ENDIF
      IF(IPLOC .GE. 100) THEN
        WRITE(IOUT,6032) 'before symmetries   '
        WRITE(IOUT,6034)  (IDSUR(III),III=1,NSURS)
        WRITE(IOUT,6035)   ITSYM
      ENDIF
*----
*  Z symmetry
*----
      IF(ABS(ITSYM(3)) .EQ. 1) THEN
*----
*  1- Eliminate reflected regions
*----
        NZSR=NZS/2
        DO IZS=1,NZSR
          IODZ=(IZS-1)*NRPS
          IORZ=(NZS-IZS)*NRPS
          DO III=1,NRPS
            IODHZ=IODZ+III
            IORHZ=IORZ+III
            IDREG(IORHZ)=-ABS(IDREG(IODHZ))
          ENDDO
        ENDDO
*----
*  2- Eliminate reflected hexagonal surfaces
*----
        NSPLAN=12*NXS-6
        DO IZS=1,NZSR
          IODZ=(IZS-1)*NSPLAN
          IORZ=(NZS-IZS)*NSPLAN
          DO III=1,NSPLAN
            IODHZ=IODZ+III
            IORHZ=IORZ+III
            IDSUR(IORHZ)=-ABS(IDSUR(IODHZ))
          ENDDO
        ENDDO
*----
*  4- Eliminate reflected Z- surfaces
*----
        ISBOT=NSPLAN*NZSR
        ISTOP=ISBOT+NRPS
        DO III=1,NRPS
          ISBOT=ISBOT+1
          ISTOP=ISTOP+1
          IDSUR(ISTOP)=-ABS(IDSUR(ISBOT))
        ENDDO
      ENDIF
*----
*  Renumber regions
*----
      IRN=0
      DO IRO=1,NREGS
        IDV=IDREG(IRO)
        IF(IDV .GT. 0) THEN
          IRN=IRN+1
          IREN(1,IRN)=IDV
          DO IRT=1,IRN-1
            IF(IDV .LT. IREN(1,IRT)) THEN
              DO IRR=IRN-1,IRT,-1
                IREN(1,IRR+1)=IREN(1,IRR)
              ENDDO
              IREN(1,IRT)=IDV
            ENDIF
          ENDDO
        ENDIF
      ENDDO
      NREGN=IRN
      DO IRN=1,NREGN
        IDV=IREN(1,IRN)
        DO IRT=1,NREGS
          IF(IDREG(IRT) .EQ. IDV ) THEN
            IDREG(IRT)=IRN
          ELSE IF(IDREG(IRT) .EQ. -IDV ) THEN
            IDREG(IRT)=-IRN
          ENDIF
        ENDDO
      ENDDO
*----
*  Renumber surfaces
*----
      IRN=0
      DO IRO=1,NSURS
        IDS=IDSUR(IRO)
        IF(IDS .GT. 0) THEN
          IRN=IRN+1
          IREN(1,IRN)=IDS
          DO IRT=1,IRN-1
            IF(IDS .LT. IREN(1,IRT)) THEN
              DO IRR=IRN-1,IRT,-1
                IREN(1,IRR+1)=IREN(1,IRR)
              ENDDO
              IREN(1,IRT)=IDS
            ENDIF
          ENDDO
        ENDIF
      ENDDO
      NSURN=IRN
      DO IRN=1,NSURN
        IDS=IREN(1,IRN)
        DO IRT=1,NSURS
          IF(IDSUR(IRT) .EQ. IDS ) THEN
            IDSUR(IRT)=IRN
          ELSE IF(IDSUR(IRT) .EQ. -IDS ) THEN
            IDSUR(IRT)=-IRN
          ENDIF
        ENDDO
      ENDDO
*----
*  Processing finished:
*  print routine closing output header if required
*  and return
*----
      IF(IPLOC .GE. 100) THEN
        WRITE(IOUT,6010) NXS,NZS
        IF(NXS .GT. 0) THEN
          WRITE(IOUT,6011) 'MESHH ='
          WRITE(IOUT,6012) (DAMESS(IX,1),IX=-1,2*NXS)
        ENDIF
        IF(NZS .GT. 0) THEN
          WRITE(IOUT,6011) 'MESHZ ='
          WRITE(IOUT,6012) (DAMESS(IX,3),IX=-1,NZS)
        ENDIF
        WRITE(IOUT,6030) 'after symmetries    '
        WRITE(IOUT,6034) (IDREG(IDV),IDV=1,NREGS)
        WRITE(IOUT,6032) 'after symmetries    '
        WRITE(IOUT,6034) (IDSUR(IDS),IDS=1,NSURS)
        WRITE(IOUT,6001) NAMSBR
      ENDIF
      RETURN
*----
*  Output formats
*----
 6000 FORMAT('(* Output from --',A6,'-- follows ')
 6001 FORMAT('   Output from --',A6,'-- completed *)')
 6002 FORMAT(' Type of geometry = ',I5)
 6010 FORMAT(1X,'DIMENSIONS =',2I10/1X,'ORIGINAL MESH ')
 6011 FORMAT(1X,A7)
 6012 FORMAT(5F20.10)
 6013 FORMAT(5I20)
 6020 FORMAT(1X,'DIMENSIONS =',2I10/1X,'SPLITTED MESH ')
 6030 FORMAT(' Regions ID ',A20)
 6032 FORMAT(' Surfaces ID ',A20)
 6033 FORMAT(' Mixtures ')
 6034 FORMAT(5I15)
 6035 FORMAT('Symmetries =',4I15)
 6036 FORMAT(' Virtual mixtures ')
 9000 FORMAT(' Problem with split in HEXT or HEXTZ geometry'//
     >3F20.10)
      END
