*DECK DUTURN
      SUBROUTINE DUTURN(IHEX,TURN,NCEL,TURND,NCELA,CELL)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Provide orientation of cell in am assembly
* with symetry IHEX.
*
*Copyright:
* Copyright (C) 1991 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): M. Ouisloumen
*
*Parameters: input
* IHEX    symetry type.
* NCEL    number of  cells in symetric assembly.
* NCELA   number of cells in unfolded assembly.
* CELL    cell index in symetric assembly.
* TURN    cell orientation in symetric assembly
*
*Parameters: output
* TURND   cell orientation in unfolded assembly.
*
*-----------------------------------------------------------------------
*
      INTEGER TAB(6),CELL(NCELA),TAB6(6),TAB9(6),TURN(NCEL),
     +                     TURND(NCELA),TAB12(6),TABR8(6),
     +                     TABA8(6),TABB8(6)
      LOGICAL LGR8,LGSA,LGSB,LGSA6
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NUM,NTURN,ITAB
      SAVE TAB,TAB6,TAB9,TAB12,TABR8,TABA8,TABB8
      DATA TAB,TAB6,TAB9,TAB12,TABR8,TABA8,TABB8
     +     /1,6,5,4,3,2,2,1,6,5,4,3,3,2,1,6,5,4,3,4,5,6,1,2,4,5,6,1,2,3
     +     ,3,2,1,6,5,4,6,5,4,3,2,1/
*
      IFONC(N,L)= 2+(N-1)*(L+3*(N-2))
      IFCOUR(N)=NINT( (4.+SQRT(1.+4.*FLOAT(N-1)/3.)
     +                 +SQRT(1.+4.*FLOAT(N-2)/3.))*.25)
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(NUM(NCEL),NTURN(NCEL),ITAB(NCEL))
*
      DO 10 I=2,NCEL
         IF(TURN(I).EQ.1.OR.TURN(I).EQ.9) THEN
           ITAB(I)=2
         ELSEIF(TURN(I).EQ.2.OR.TURN(I).EQ.10) THEN
           ITAB(I)=3
         ELSEIF(TURN(I).EQ.3.OR.TURN(I).EQ.11) THEN
           ITAB(I)=4
         ELSEIF(TURN(I).EQ.4.OR.TURN(I).EQ.12) THEN
           ITAB(I)=5
         ELSEIF(TURN(I).EQ.5.OR.TURN(I).EQ.7) THEN
           ITAB(I)=6
         ELSEIF(TURN(I).EQ.6.OR.TURN(I).EQ.8) THEN
           ITAB(I)=1
         ELSE
           CALL XABORT('DUTURN : INVALID ORIENTATION ')
         ENDIF
10    CONTINUE
*
      NCOUR=IFCOUR(NCELA)
      IF(IHEX.EQ.1) THEN
        GOTO 20
      ELSEIF(IHEX.EQ.2.OR.IHEX.EQ.3) THEN
        GOTO 40
      ELSEIF(IHEX.EQ.4) THEN
        GOTO 60
      ELSEIF(IHEX.EQ.5) THEN
        GOTO 80
      ELSEIF(IHEX.GT.5.AND.IHEX.LT.9) THEN
        GOTO 100
      ELSE
        CALL XABORT('DUTURN : INVALID TYPE OF GEOMETRY ')
      ENDIF
*
   20 CONTINUE
*
*       DUPLICATION DE L'ORIENTATION DANS LA SYMETRIE S30
*
      TURND(1)=TURN(1)
*
*       DUPLICATION DE LA 2EME COURONE
*
      ITURN=ITAB(2)
      TURND(2)=TURN(2)
      DO 25 I=3,7
         ITURN=ITURN+1
         IF(ITURN.GT.6)ITURN=ITURN-6
         IF(ITURN.EQ.1) THEN
           TURND(I)=8
           IF(TURN(CELL(I)).LE.6)TURND(I)=6
         ELSEIF(ITURN.EQ.2) THEN
           TURND(I)=1
           IF(TURN(CELL(I)).GT.6)TURND(I)=9
         ELSEIF(ITURN.EQ.3) THEN
           TURND(I)=2
           IF(TURN(CELL(I)).GT.6)TURND(I)=10
         ELSEIF(ITURN.EQ.4) THEN
           TURND(I)=3
           IF(TURN(CELL(I)).GT.6)TURND(I)=11
         ELSEIF(ITURN.EQ.5) THEN
           TURND(I)=4
           IF(TURN(CELL(I)).GT.6)TURND(I)=12
         ELSEIF(ITURN.EQ.6) THEN
           TURND(I)=5
           IF(TURN(CELL(I)).GT.6)TURND(I)=7
         ELSE
           CALL XABORT('DUTURN : TURN DUPLICATION ALGORITHME ERROR ')
         ENDIF
   25 CONTINUE
*
*      DUPLICATON DES AUTRES COURONES
*
      JCEL=3
      DO 30 IC=3,NCOUR
         NCS=INT(AINT((REAL(IC)+1.)/2.))
         NCEL1=IFONC(IC,0)
         KCEL=JCEL+NCS-1
         DO 32 IN=JCEL,KCEL
            NTURN(IN)=TURN(IN)
            NUM(IN)=ITAB(IN)
   32    CONTINUE
         LAUX=1
         TURND(NCEL1)=TURN(KCEL)
      DO 35 JROT=0,11
         NCEL2=NCEL1+NCS-1
         IF(MOD(IC,2).EQ.0) THEN
           IF(LAUX.EQ.0) THEN
             NCEL2=NCEL2+1
             LAUX=1
           ELSE
             LAUX=0
           ENDIF
         ENDIF
         IF(JROT.EQ.11)NCEL2=NCEL2-1
         DO 33 J=NCEL1+1,NCEL2
            ITURN=NUM(CELL(J))
            KTURN=JROT+TAB(ITURN)
            IF(KTURN.GT.12) KTURN=KTURN-12
            IF(KTURN.GT.6) KTURN=KTURN-6
            NUM(CELL(J))=KTURN
            IF(KTURN.EQ.1) THEN
              TURND(J)=6
              IF(NTURN(CELL(J)).LE.6)TURND(J)=8
            ELSEIF(KTURN.EQ.2) THEN
              TURND(J)=1
              IF(NTURN(CELL(J)).LE.6)TURND(J)=9
            ELSEIF(KTURN.EQ.3) THEN
              TURND(J)=2
              IF(NTURN(CELL(J)).LE.6)TURND(J)=10
            ELSEIF(KTURN.EQ.4) THEN
              TURND(J)=3
              IF(NTURN(CELL(J)).LE.6)TURND(J)=11
            ELSEIF(KTURN.EQ.5) THEN
              TURND(J)=4
              IF(NTURN(CELL(J)).LE.6)TURND(J)=12
            ELSEIF(KTURN.EQ.6) THEN
              TURND(J)=5
              IF(NTURN(CELL(J)).LE.6)TURND(J)=7
            ELSE
              CALL XABORT('DUTURN : INVALID ORIENTATION 2 ')
            ENDIF
            NTURN(CELL(J))=TURND(J)
   33    CONTINUE
         NCEL1=NCEL2
   35 CONTINUE
      JCEL=KCEL+1
   30 CONTINUE
      GO TO 200
*
   40 CONTINUE
*
*        DUPLICATION DE L'ORIENTATION DES GEOMETRIES SA60 ET SB60
*
      TURND(1)=TURN(1)
      JCEL=2
      LGSA6=IHEX.EQ.2
      DO 55 IC=2,NCOUR
         NCS=IC
         NCEL1=IFONC(IC,0)
         NCEL10=0
         IF(.NOT.LGSA6) THEN
             NCS=2*NINT(REAL(IC)/2.)-1
             NCEL10=NCEL1
             NCEL1=NCEL1+NINT(REAL(IC+1)/2.)-1
         ENDIF
         KCEL=JCEL+NCS-1
         DO 50 IN=JCEL,KCEL
            NTURN(IN)=TURN(IN)
            NUM(IN)=ITAB(IN)
   50    CONTINUE
         IF(LGSA6) THEN
           TURND(NCEL1)=TURN(KCEL)
         ELSE
           KKK=KCEL-NCEL1+NCEL10-1
           NCFIN=NCEL1
           IF(MOD(IC,2).EQ.0)NCFIN=NCEL1-1
           DO 555 IK=NCEL10,NCFIN
             KKK=KKK+1
             TURND(IK)=TURN(KKK)
  555      CONTINUE
         ENDIF
         DO 54 JROT=0,5
            NCEL2=NCEL1+NCS-1
            IF(JROT.EQ.5) THEN
*              NCEL2=NCEL2-1
               IF(.NOT.LGSA6) THEN
                 NCEL2=NCEL2-NINT(REAL(NCS)/2.)
               ELSE
                 NCEL2=NCEL2-1
               ENDIF
            ENDIF
            DO 52 J=NCEL1,NCEL2
               ITURN=NUM(CELL(J))
               KTURN=0
               IF(LGSA6) THEN
                 KTURN=TAB(ITURN)+4*JROT
               ELSE
                 KTURN=TAB6(ITURN)+2*JROT
               ENDIF
               IF(KTURN.GT.24)KTURN=KTURN-24
               IF(KTURN.GT.12)KTURN=KTURN-12
               IF(KTURN.GT.6) KTURN=KTURN-6
               IF(.NOT.LGSA6) NUM(CELL(J))=KTURN
               ITTD=0
               IF(KTURN.EQ.1) THEN
                  ITTD=6
                  IF(NTURN(CELL(J)).LE.6)ITTD=8
               ELSEIF(KTURN.EQ.2) THEN
                  ITTD=1
                  IF(NTURN(CELL(J)).LE.6)ITTD=9
               ELSEIF(KTURN.EQ.3) THEN
                  ITTD=2
                  IF(NTURN(CELL(J)).LE.6)ITTD=10
               ELSEIF(KTURN.EQ.4) THEN
                  ITTD=3
                  IF(NTURN(CELL(J)).LE.6)ITTD=11
               ELSEIF(KTURN.EQ.5) THEN
                  ITTD=4
                  IF(NTURN(CELL(J)).LE.6)ITTD=12
               ELSEIF(KTURN.EQ.6) THEN
                  ITTD=5
                  IF(NTURN(CELL(J)).LE.6)ITTD=7
               ELSE
                  CALL XABORT('DUTURN : INVALID ORIENTATION 3 ')
               ENDIF
               IF(J.EQ.NCEL1) THEN
                 IF(LGSA6)GOTO 51
                 IF(MOD(IC,2).NE.0) GOTO 51
               ENDIF
               TURND(J)=ITTD
   51          NTURN(CELL(J))=ITTD
   52      CONTINUE
           NCEL1=NCEL2
           IF(.NOT.LGSA6) THEN
             IF(MOD(IC,2).EQ.0)NCEL1=NCEL1+1
           ENDIF
   54    CONTINUE
         JCEL=KCEL+1
   55  CONTINUE
       GO TO 200
*
   60 CONTINUE
*
*             DUPLICATION DE L'ORIENTATION DE LA GEOMETRIE S90
*
      TURND(1)=TURN(1)
      JCEL=2
      DO 75 IC=2,NCOUR
         NCS=IC+INT(AINT(REAL((IC+1)/2)))-1
         NCEL1=IFONC(IC,1)
         KCEL=JCEL+NCS-1
         DO 70 IN=JCEL,KCEL
            NTURN(IN)=TURN(IN)
            NUM(IN)=ITAB(IN)
   70    CONTINUE
         NCEL0=IFONC(IC,0)
         KKK=KCEL-NCEL1+NCEL0
         DO 71 IK=NCEL0,NCEL1
            KKK=KKK+1
            TURND(IK)=TURN(KKK)
   71    CONTINUE
         DO 74 JROT=0,3
            NCEL2=NCEL1+NCS-1
            IF(JROT.EQ.3) NCEL2=NCEL1+INT(AINT(REAL((IC+1)/2)))-2
            DO 72 J=NCEL1,NCEL2
               ITURN=NUM(CELL(J))
               KTURN=TAB9(ITURN)+3*JROT
               IF(KTURN.GT.12)KTURN=KTURN-12
               IF(KTURN.GT.6) KTURN=KTURN-6
               NUM(CELL(J))=KTURN
               IF(KTURN.EQ.1) THEN
                 TURND(J)=6
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=8
               ELSEIF(KTURN.EQ.2) THEN
                 TURND(J)=1
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=9
               ELSEIF(KTURN.EQ.3) THEN
                 TURND(J)=2
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=10
               ELSEIF(KTURN.EQ.4) THEN
                 TURND(J)=3
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=11
               ELSEIF(KTURN.EQ.5) THEN
                 TURND(J)=4
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=12
               ELSEIF(KTURN.EQ.6) THEN
                 TURND(J)=5
                 IF(NTURN(CELL(J)).LE.6)TURND(J)=7
               ELSE
                 CALL XABORT('DUTURN : INVALID ORIENTATION 4 ')
               ENDIF
               NTURN(CELL(J))=TURND(J)
   72       CONTINUE
            NCEL1=NCEL2
            IF(MOD(IC,2).EQ.0) THEN
            IF(JROT.EQ.0.OR.JROT.EQ.2) NCEL1=NCEL1+1
            ENDIF
   74    CONTINUE
         JCEL=KCEL+1
   75 CONTINUE
*
      GO TO 200
*
   80 CONTINUE
*
*        DUPLICATION DE L'ORIENTATION DE LA SYMETRIE R120
*
      TURND(1)=TURN(1)
      JCEL=2
      DO 95 IC=2,NCOUR
         NCS=2*(IC-1)
         NCEL1=IFONC(IC,1)
         NCEL0=IFONC(IC,0)
         KCEL=JCEL+NCS-1
         DO 90 IN=JCEL,KCEL
            NTURN(IN)=TURN(IN)
            NUM(IN)=ITAB(IN)
  90     CONTINUE
         KK=KCEL
         DO 91 I=NCEL1,NCEL0,-1
            TURND(I)=TURN(KK)
            KK=KK-1
  91     CONTINUE
         NCEL1=NCEL1+1
      DO 94 JROT=0,1
         NCEL2=NCEL1+NCS-1
         DO 92 J=NCEL1,NCEL2
            ITURN=NUM(CELL(J))
            KTURN=TAB12(ITURN)
            NUM(CELL(J))=KTURN
            IF(KTURN.EQ.1) THEN
              TURND(J)=6
              IF(NTURN(CELL(J)).GT.6)TURND(J)=8
            ELSEIF(KTURN.EQ.2) THEN
              TURND(J)=1
              IF(NTURN(CELL(J)).GT.6)TURND(J)=9
            ELSEIF(KTURN.EQ.3) THEN
              TURND(J)=2
              IF(NTURN(CELL(J)).GT.6)TURND(J)=10
            ELSEIF(KTURN.EQ.4) THEN
              TURND(J)=3
              IF(NTURN(CELL(J)).GT.6)TURND(J)=11
            ELSEIF(KTURN.EQ.5) THEN
              TURND(J)=4
              IF(NTURN(CELL(J)).GT.6)TURND(J)=12
            ELSEIF(KTURN.EQ.6) THEN
              TURND(J)=5
              IF(NTURN(CELL(J)).GT.6)TURND(J)=7
            ELSE
              CALL XABORT('DUTURN : INVALID ORIENTATION 5 ')
            ENDIF
            NTURN(CELL(J))=TURND(J)
   92    CONTINUE
         NCEL1=NCEL2+1
   94 CONTINUE
      NCC=NCEL2+1
      DO 93 L=KK,JCEL,-1
        TURND(NCC)=TURN(L)
        NCC=NCC+1
   93 CONTINUE
      JCEL=KCEL+1
   95 CONTINUE
*
      GO TO 200
*
  100 CONTINUE
*
*         DUPLICATION DE L'ORIENTATION DES SYMETRIES R180,SA180 ET SB180
*
      TURND(1)=TURN(1)
      LGR8=.FALSE.
      LGSA=.FALSE.
      LGSB=.FALSE.
      IF(IHEX.EQ.6) THEN
        LGR8=.TRUE.
      ELSEIF(IHEX.EQ.7) THEN
        LGSA=.TRUE.
      ELSEIF(IHEX.EQ.8) THEN
        LGSB=.TRUE.
      ENDIF
      JCEL=2
      DO 115 IC=2,NCOUR
         NCEL1=IFONC(IC,1)
         NCEL10=NCEL1
         NCEL0=IFONC(IC,0)
         NCS=0
         IF(LGR8) THEN
           NCS=3*(IC-1)
           NCEL1=NCEL1+1
         ELSEIF(LGSA) THEN
           NCS=3*IC-2
         ELSEIF(LGSB) THEN
           NCC=INT(AINT(REAL(IC+1)/2.))-1
           NCS=2*IC-1+2*NCC
           NCEL1=NCEL1+IC+NCC
           NCEL10=NCEL1-1
         ENDIF
         KCEL=JCEL+NCS-1
         DO 110 IN=JCEL,KCEL
            NTURN(IN)=TURN(IN)
            NUM(IN)=ITAB(IN)
  110    CONTINUE
         NCEL2=NCEL1+NCS-1
         IF(LGSB) THEN
           IF(MOD(IC,2).NE.0)NCEL2=NCEL2-2
         ENDIF
         KK=KCEL
         DO 111 IZ=NCEL10,NCEL0,-1
           TURND(IZ)=TURN(KK)
           KK=KK-1
  111    CONTINUE
         LL=NCEL2
         DO 112 IZ=JCEL,KK
           LL=LL+1
           TURND(LL)=TURN(IZ)
  112    CONTINUE
         DO 102 J=NCEL1,NCEL2
            ITURN=NUM(CELL(J))
            KTURN=0
            IF(LGR8) THEN
              KTURN=TABR8(ITURN)
            ELSEIF(LGSA) THEN
              KTURN=TABA8(ITURN)
            ELSEIF(LGSB) THEN
              KTURN=TABB8(ITURN)
            ENDIF
            IF(KTURN.EQ.1) THEN
              TURND(J)=6
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=8
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=8
              ENDIF
            ELSEIF(KTURN.EQ.2) THEN
              TURND(J)=1
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=9
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=9
              ENDIF
            ELSEIF(KTURN.EQ.3) THEN
              TURND(J)=2
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=10
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=10
              ENDIF
            ELSEIF(KTURN.EQ.4) THEN
              TURND(J)=3
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=11
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=11
              ENDIF
            ELSEIF(KTURN.EQ.5) THEN
              TURND(J)=4
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=12
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=12
              ENDIF
            ELSEIF(KTURN.EQ.6) THEN
              TURND(J)=5
              IF(LGR8) THEN
                IF(NTURN(CELL(J)).GT.6) TURND(J)=7
              ELSE
                IF(NTURN(CELL(J)).LE.6) TURND(J)=7
              ENDIF
            ELSE
              CALL XABORT('DUTURN : INVALID ORIENTATION 6 ')
            ENDIF
  102    CONTINUE
         JCEL=KCEL+1
  115 CONTINUE
*----
*  SCRATCH STORAGE DEALLOCATION
*----
  200 DEALLOCATE(ITAB,NTURN,NUM)
      RETURN
      END
