*DECK NXTRTS
      SUBROUTINE NXTRTS(IPRINT,ITYPG ,MAXMSH,NREG  ,ITRN  ,ITST  ,
     >                  ITSYM ,NM    ,MIX   ,ISPLT ,DAMESH,
     >                  NMS   ,MIXR  ,ISPLTR,DAMESR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Rotate heagon with triangles according to reference turn and test,
* if required, that it satisfies intrinsic symmetries.
*
*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
* IPRINT  intermediate printing level for output.
* ITYPG   geometry type.
* MAXMSH  maximum number of elements in MESH array.
* NREG    number of elements in MIX array.
* ITRN    geometry original turn number.
* ITST    flag for testing symmetry.
* ITSYM   flag for symmetries to test.
*
*Parameters: input/output
* NM      mesh size in all directions ($X$, $Y$, $Z$ and $R$)
* MIX     final mixture description for geometry (including HMIX).
* ISPLT   final split desctiption for geometry.
* DAMESH  final mesh description for geometry.
* NMS      mesh size after splitting.
*
*Parameters: temporary storage
* MIXR     mixture description for rotated geometry (including HMIX).
* ISPLTR   split desctiption for rotated geometry.
* DAMESR   mesh description for rotated geometry.
*
*-----------------------------------------------------------------------
*
      IMPLICIT         NONE
*----
*  Subroutine arguments
*----
      INTEGER          IPRINT,ITYPG,MAXMSH,NREG,ITRN,ITST,
     >                 NM(4),ITSYM(4)
      INTEGER          ISPLT(0:MAXMSH-1,4),MIX(0:NREG-1,2)
      DOUBLE PRECISION DAMESH(-1:MAXMSH,4)
      INTEGER          NMS(4),ISPLTR(0:MAXMSH-1,4,2),
     >                 MIXR(0:NREG-1,2,2)
      DOUBLE PRECISION DAMESR(-1:MAXMSH,4,2)
*----
*  Local parameters
*----
      INTEGER          IOUT
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NAMSBR='NXTRTS')
      DOUBLE PRECISION DCUTOF,DZERO,DONE,DTWO
      PARAMETER       (DCUTOF=1.0D-6,DZERO=0.0D0,DONE=1.0D0,DTWO=2.0D0)
*----
*  Functions
*----
      INTEGER          NXTHRS
*----
*  Local variables
*----
      INTEGER          NX,NZ,NRP,NPG,IPG,IG,ICT,ITG,IKT,IX,IZ,IREG,
     >                 ITMI,IDMI,NNZ,NMT,NMTS
      INTEGER          ITM(3,2)
      DOUBLE PRECISION DDD
*----
*  Processing starts:
*  print routine openning output header if required
*  and initialize various parameters.
*----
      IF(IPRINT .GE. 100) THEN
        WRITE(IOUT,6000) NAMSBR
      ENDIF
*----
*  Turn reference geometry (IPG=1)
*  and symmetric geometries (IPG=2,3,4,5)
*----
      NX=NM(1)
      NZ=MAX(NM(3),1)
      NRP=6*NX*NX
      NPG=1
      ITM(1,1)=1
      ITM(1,2)=1
      ITM(2,1)=2
      ITM(2,2)=2
      ITM(3,1)=3
      ITM(3,2)=3
      ICT=0
      NMT=0
      IF(ITST .EQ. 1) NPG=4
      DO IPG=1,NPG
        IF(IPG .EQ. 1) THEN
          IG=1
          ICT=ITRN
          DO IX=0,2*NX
            DAMESR(IX,1,IG)=DAMESH(IX,1)
          ENDDO
          ISPLTR(1,1,IG)=ISPLT(1,1)
          DAMESR(-1,1,IG)=DAMESH(-1,1)
        ELSE
          IG=2
          ITG=IPG-1
          IF(ABS(ITSYM(ITG)) .GE. 1) THEN
*----
*  Symmetry is valid
*  Determine final turn after applying symmetry on
*  current turn
*----
            IF(ITG .EQ. 1) THEN
*----
*  Hexagonal symetry
*----
              ICT=NXTHRS(ITRN,1)
            ELSE IF(ITG .EQ. 3) THEN
*----
*  Symmetry in Z
*----
              ICT=NXTHRS(ITRN,-1)
            ENDIF
          ELSE
*----
*  No need to test the geometry for this
*  intrinsic symmetry.
*----
            GO TO 1005
          ENDIF
        ENDIF
        IF(ICT .GT. 12 ) THEN
          IKT=12-ICT
        ELSE
          IKT=ICT
        ENDIF
        IF(IKT .LT. 0) THEN
          DAMESR(-1,3,IG)=-DAMESH(-1,3)
        ELSE
          DAMESR(-1,3,IG)=DAMESH(-1,3)
        ENDIF
        DO IX=0,2*NX
          DAMESR(IX,1,IG)=DAMESH(IX,1)
        ENDDO
        ISPLTR(1,1,IG)=ISPLT(1,1)
        DAMESR(-1,1,IG)=DAMESH(-1,1)
        IF     (ABS(IKT) .EQ. 1) THEN
          IF(IKT .LT. 0) THEN
            DO IZ=0,NZ-1
              DAMESR(IZ,3,IG)=DAMESH(NZ-IZ,3)-DAMESH(NZ-IZ-1,3)
              ISPLTR(IZ,3,IG)=ISPLT(NZ-IZ-1,3)
              ITMI=IZ*NRP
              IDMI=(NZ-IZ-1)*NRP
              DO IX=0,NX-1
                MIXR(ITMI,IG,1)=MIX(IDMI,1)
                MIXR(ITMI,IG,2)=MIX(IDMI,2)
                ITMI=ITMI+1
                IDMI=IDMI+1
              ENDDO
            ENDDO
          ELSE
            DO IZ=0,NZ-1
              DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
              ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
              ITMI=IZ*NRP
              IDMI=ITMI
              DO IX=0,NRP
                MIXR(ITMI,IG,1)=MIX(IDMI,1)
                MIXR(ITMI,IG,2)=MIX(IDMI,2)
                ITMI=ITMI+1
                IDMI=IDMI+1
             ENDDO
            ENDDO
          ENDIF
        ELSE
          CALL XABORT(NAMSBR//
     >      ': Symmetry not yet programmed')
        ENDIF
        IF(IPRINT .GE. 100) THEN
*----
*  Print turned mesh if required
*----
          WRITE(IOUT,6010) NX,NZ,NREG
          WRITE(IOUT,6011) 'MESHH ='
          WRITE(IOUT,6012) (DAMESR(IX,1,IG),IX=-1,2*NX)
          WRITE(IOUT,6011) 'SPLTH ='
          WRITE(IOUT,6013) ISPLTR(1,1,IG)
          IF(ITYPG .EQ. 13) THEN
            WRITE(IOUT,6011) 'MESHZ ='
            WRITE(IOUT,6012) (DAMESR(IZ,3,IG),IZ=-1,NZ)
            WRITE(IOUT,6011) 'SPLTZ ='
            WRITE(IOUT,6013) (ISPLTR(IZ,3,IG),IZ=-1,NZ)
          ENDIF
          WRITE(IOUT,6011) 'MIX   ='
          WRITE(IOUT,6013) (MIXR(IREG,IG,1),IREG=0,NREG-1)
          WRITE(IOUT,6011) 'HMIX  ='
          WRITE(IOUT,6013) (MIXR(IREG,IG,2),IREG=0,NREG-1)
        ENDIF
        IF(IPG .GT. 1) THEN
*----
*  COMPARE GEOMETRY
*  1- MESH AND SPLIT IN Z
*  2- MIXTURES
*  3- OFFCENTER
*----
          NNZ=NM(ITM(3,1))
          IF(NNZ .NE. NM(ITM(3,2))) CALL XABORT(NAMSBR//
     >      ': Symmetry invalid with this mesh')
          DO IZ=0,NNZ-1
            DDD=ABS(DAMESR(IZ,3,1)-DAMESR(IZ,3,2))
            IF(DDD .GT. DCUTOF) CALL XABORT(NAMSBR//
     >      ': Symmetry invalid with this mesh')
            IF(ISPLTR(IZ,3,1) .NE. ISPLTR(IZ,3,2) )
     >      CALL XABORT(NAMSBR//
     >      ': Symmetry invalid with this split')
          ENDDO
          DO IREG=0,NREG-1
            IF(MIXR(IREG,1,1) .NE. MIXR(IREG,2,1)) CALL XABORT(NAMSBR//
     >      ': Symmetry invalid with this mixtures')
            IF(MIXR(IREG,1,2) .NE. MIXR(IREG,2,2)) CALL XABORT(NAMSBR//
     >      ': Symmetry invalid with this merging mixtures')
          ENDDO
          IF(DAMESR(-1,3,1) .NE. DAMESR(-1,3,2)) CALL XABORT(NAMSBR//
     >    ': Symmetry invalid with this off center')
        ELSE
*----
*  Reset reference geometry for turn
*----
          DO IX=0,2*NX
            DAMESH(IX,1)=DAMESR(IX,1,IG)
          ENDDO
          ISPLT(1,1)=ISPLTR(1,1,IG)
          DAMESH(-1,1)=DAMESR(-1,1,IG)
          NNZ=NM(ITM(3,1))
          NMT=NNZ
          NMTS=0
          DO IZ=0,NNZ-1
            NMTS=NMTS+ABS(ISPLTR(IZ,3,1))
          ENDDO
          IF(NMTS .NE. NMS(ITM(3,1))) CALL XABORT(NAMSBR//
     >       ': Global symmetry invalid with this split')
        ENDIF
 1005   CONTINUE
      ENDDO
*----
*  Reset final mesh (center+original turn)
*----
      NZ=NMT
      CALL XDDSET(DAMESH(-1,3),NM(3)+2,DZERO)
      NM(3)=NZ
      DDD=DZERO
      DO IZ=0,NZ-1
        DDD=DDD+DAMESR(IZ,3,1)
      ENDDO
      DDD=DDD/DTWO
      DAMESH(-1,3)=DAMESR(-1,3,1)
      DAMESH(0,3)=-DDD
      DO IZ=1,NZ
        DAMESH(IZ,3)=DAMESH(IZ-1,3)+DAMESR(IZ-1,3,1)
      ENDDO
      DO IZ=0,NZ
        ISPLT(IZ,3)=ISPLTR(IZ,3,1)
      ENDDO
      NMS(3)=0
      DO IZ=0,NZ-1
        NMS(3)=NMS(3)+ABS(ISPLT(IZ,3))
      ENDDO
*----
*  Processing finished:
*  print routine closing output header if required
*  and return
*----
      IF(IPRINT .GE. 100) THEN
        WRITE(IOUT,6010) NX,NZ,NREG
        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(ITYPG .EQ. 13) 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
        WRITE(IOUT,6011) 'MIX   ='
        WRITE(IOUT,6013) (MIX(IREG,1),IREG=0,NREG-1)
        WRITE(IOUT,6011) 'HMIX  ='
        WRITE(IOUT,6013) (MIX(IREG,2),IREG=0,NREG-1)
        WRITE(IOUT,6001) NAMSBR
      ENDIF
*----
*  FORMATS
*----
*----
*  Output formats
*----
 6000 FORMAT('(* Output from --',A6,'-- follows ')
 6001 FORMAT('   Output from --',A6,'-- completed *)')
 6010 FORMAT(1X,' DIMENSIONS =',5I10/1X,' ORIGINAL MESH ')
 6011 FORMAT(1X,A7)
 6012 FORMAT(5F15.9)
 6013 FORMAT(5I15)
      END
