summaryrefslogtreecommitdiff
path: root/Dragon/src/NXTRIS.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/NXTRIS.f')
-rw-r--r--Dragon/src/NXTRIS.f740
1 files changed, 740 insertions, 0 deletions
diff --git a/Dragon/src/NXTRIS.f b/Dragon/src/NXTRIS.f
new file mode 100644
index 0000000..a413b81
--- /dev/null
+++ b/Dragon/src/NXTRIS.f
@@ -0,0 +1,740 @@
+*DECK NXTRIS
+ SUBROUTINE NXTRIS(IPRINT,ITYPG ,MAXMSH,NREG ,ITRN ,ITST ,
+ > ITSYM ,NM ,MIX ,ISPLT ,DAMESH,
+ > NMS ,MIXR ,ISPLTR,DAMESR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Rotate geometry according to reference turn and test, if required,
+* in such a way that it satisfies intrinsic symmetries.
+*
+*Copyright:
+* Copyright (C) 2005 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):
+* G. Marleau
+*
+*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.
+*
+*Reference:
+* G. Marleau,
+* New Geometries Processing in DRAGON: The NXT: Module,
+* Report IGE-260, Polytechnique Montreal,
+* Montreal, 2005.
+*
+*-----------------------------------------------------------------------
+*
+ 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='NXTRIS')
+ DOUBLE PRECISION DCUTOF,DZERO,DONE,DTWO
+ PARAMETER (DCUTOF=1.0D-6,DZERO=0.0D0,DONE=1.0D0,DTWO=2.0D0)
+*----
+* Functions
+*----
+ INTEGER NXTTRS
+*----
+* Local variables
+*----
+ INTEGER NR,NX,NY,NZ,ITM(4,2),NPG,IPG,IG,ICT,ITG,
+ > IDIR,IKT,IDMI,ITMI,IX,IY,IZ,IR,NRP1,NMR,
+ > NMT(4),NMTS(4),NMTMP
+ DOUBLE PRECISION DDD
+*----
+* Data
+*----
+ CHARACTER CDIR(1:4)*1
+ SAVE CDIR
+ DATA CDIR /'X','Y','Z','R'/
+*----
+* 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)
+*----
+ ICT=0
+ NX=NM(1)
+ NY=NM(2)
+ NZ=MAX(NM(3),1)
+ NR=NM(4)
+ NRP1=NR+1
+ NMR=NR
+ IF(ITYPG .EQ. 3 .OR. ITYPG .EQ. 6 .OR.
+ > ITYPG .EQ. 10 .OR. ITYPG .EQ. 11 ) THEN
+ NRP1=NR
+ NMR=NR-1
+ ENDIF
+ ITM(3,1)=3
+ ITM(3,2)=3
+ ITM(4,1)=4
+ ITM(4,2)=4
+ NPG=1
+ IF(ITST .EQ. 1) NPG=5
+ DO IPG=1,NPG
+ IF(IPG .EQ. 1) THEN
+ IG=1
+ ICT=ITRN
+ DO IX=0,NR-1
+ DAMESR(IX,4,IG)=DAMESH(IX,4)
+ ISPLTR(IX,4,IG)=ISPLT(IX,4)
+ ENDDO
+ DAMESR(NR,4,IG)=DAMESH(NR,4)
+ 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
+*----
+* Symmetry in X
+*----
+ ICT=NXTTRS(ITRN,1)
+ ELSE IF(ITG .EQ. 2) THEN
+*----
+* Symmetry in Y
+*----
+ ICT=NXTTRS(ITRN,3)
+ ELSE IF(ITG .EQ. 3) THEN
+*----
+* Symmetry in Z
+*----
+ ICT=NXTTRS(ITRN,-1)
+ ELSE IF(ITG .EQ. 4) THEN
+*----
+* Symmetry in X=Y or X=-Y
+*----
+ IF(ABS(ITSYM(ITG)) .EQ. 1) THEN
+ ICT=NXTTRS(ITRN,2)
+ ELSE
+ ICT=NXTTRS(ITRN,4)
+ ENDIF
+ 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
+ DO IX=0,NR-1
+ DAMESR(IX,4,IG)=DAMESH(IX,4)
+ ISPLTR(IX,4,IG)=ISPLT(IX,4)
+ ENDDO
+ DAMESR(NR,4,IG)=DAMESH(NR,4)
+ IF(IKT .LT. 0) THEN
+ DAMESR(-1,3,IG)=-DAMESH(-1,3)
+ DAMESR(-1,4,IG)=-DAMESH(-1,4)
+ ELSE
+ DAMESR(-1,3,IG)=DAMESH(-1,3)
+ DAMESR(-1,4,IG)=DAMESH(-1,4)
+ ENDIF
+ IF (ABS(IKT) .EQ. 1) THEN
+ ITM(1,IG)=1
+ ITM(2,IG)=2
+ DO 100 IX=0,NX-1
+ DAMESR(IX,1,IG)=DAMESH(IX+1,1)-DAMESH(IX,1)
+ ISPLTR(IX,1,IG)=ISPLT(IX,1)
+ 100 CONTINUE
+ DAMESR(-1,1,IG)=DAMESH(-1,1)
+ DO 110 IY=0,NY-1
+ DAMESR(IY,2,IG)=DAMESH(IY+1,2)-DAMESH(IY,2)
+ ISPLTR(IY,2,IG)=ISPLT(IY,2)
+ 110 CONTINUE
+ DAMESR(-1,2,IG)=DAMESH(-1,2)
+ IF(IKT .LT. 0) THEN
+ DO 120 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*NX*NY*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1
+ DO 121 IY=0,NY-1
+ DO 122 IX=0,NX-1
+ DO 123 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 123 CONTINUE
+ 122 CONTINUE
+ 121 CONTINUE
+ 120 CONTINUE
+ ELSE
+ DO 130 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ ITMI=IZ*NX*NY*NRP1
+ IDMI=ITMI
+ DO 131 IY=0,NY-1
+ DO 132 IX=0,NX-1
+ DO 133 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 133 CONTINUE
+ 132 CONTINUE
+ 131 CONTINUE
+ 130 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 2) THEN
+*----
+* ROTATION OF PI/2
+*----
+ ITM(1,IG)=2
+ ITM(2,IG)=1
+ DO 200 IX=0,NY-1
+ DAMESR(IX,1,IG)=DAMESH(IX+1,2)-DAMESH(IX,2)
+ ISPLTR(IX,1,IG)=ISPLT(IX,2)
+ 200 CONTINUE
+ DAMESR(-1,1,IG)=DAMESH(-1,2)
+ DO 210 IY=0,NX-1
+ DAMESR(IY,2,IG)=DAMESH(NX-IY,1)-DAMESH(NX-IY-1,1)
+ ISPLTR(IY,2,IG)=ISPLT(NX-IY-1,1)
+ 210 CONTINUE
+ DAMESR(-1,2,IG)=-DAMESH(-1,1)
+ IF(IKT .LT. 0) THEN
+ DO 220 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)
+ DO 221 IY=0,NX-1
+ DO 222 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+(NY-IX-1)*NX*NRP1+
+ > IY*NRP1
+ DO 223 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 223 CONTINUE
+ 222 CONTINUE
+ 221 CONTINUE
+ 220 CONTINUE
+ ELSE
+ DO 230 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 231 IY=0,NX-1
+ DO 232 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+IX*NX*NRP1+
+ > (NX-IY-1)*NRP1
+ DO 233 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 233 CONTINUE
+ 232 CONTINUE
+ 231 CONTINUE
+ 230 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 3) THEN
+*----
+* ROTATION OF PI
+*----
+ ITM(1,IG)=1
+ ITM(2,IG)=2
+ DO 300 IX=0,NX-1
+ DAMESR(IX,1,IG)=DAMESH(NX-IX,1)-DAMESH(NX-IX-1,1)
+ ISPLTR(IX,1,IG)=ISPLT(NX-IX-1,1)
+ 300 CONTINUE
+ DAMESR(-1,1,IG)=-DAMESH(-1,1)
+ DO 310 IY=0,NY-1
+ DAMESR(IY,2,IG)=DAMESH(NY-IY,2)-DAMESH(NY-IY-1,2)
+ ISPLTR(IY,2,IG)=ISPLT(NY-IY-1,2)
+ 310 CONTINUE
+ DAMESR(-1,2,IG)=-DAMESH(-1,2)
+ IF(IKT .LT. 0) THEN
+ DO 320 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)
+ DO 321 IY=0,NY-1
+ DO 322 IX=0,NX-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+(NY-IY-1)*NX*NRP1+
+ > (NX-IX-1)*NRP1
+ DO 323 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 323 CONTINUE
+ 322 CONTINUE
+ 321 CONTINUE
+ 320 CONTINUE
+ ELSE
+ DO 330 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 331 IY=0,NY-1
+ DO 332 IX=0,NX-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+(NY-IY-1)*NX*NRP1+
+ > (NX-IX-1)*NRP1
+ DO 333 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 333 CONTINUE
+ 332 CONTINUE
+ 331 CONTINUE
+ 330 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 4) THEN
+*----
+* ROTATION OF 3*PI/2
+*----
+ ITM(1,IG)=2
+ ITM(2,IG)=1
+ DO 400 IX=0,NY-1
+ DAMESR(IX,1,IG)=DAMESH(NY-IX,2)-DAMESH(NY-IX-1,2)
+ ISPLTR(IX,1,IG)=ISPLT(NY-IX-1,2)
+ 400 CONTINUE
+ DAMESR(-1,1,IG)=-DAMESH(-1,2)
+ DO 410 IY=0,NX-1
+ DAMESR(IY,2,IG)=DAMESH(IY+1,1)-DAMESH(IY,1)
+ ISPLTR(IY,2,IG)=ISPLT(IY,1)
+ 410 CONTINUE
+ DAMESR(-1,2,IG)=DAMESH(-1,1)
+ IF(IKT .LT. 0) THEN
+ DO 420 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)
+ DO 421 IY=0,NX-1
+ DO 422 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+(NY-IX-1)*NX*NRP1+
+ > IY*NRP1
+ DO 423 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 423 CONTINUE
+ 422 CONTINUE
+ 421 CONTINUE
+ 420 CONTINUE
+ ELSE
+ DO 430 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 431 IY=0,NX-1
+ DO 432 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+(NY-IX-1)*NX*NRP1+
+ > IY*NRP1
+ DO 433 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 433 CONTINUE
+ 432 CONTINUE
+ 431 CONTINUE
+ 430 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 5) THEN
+*----
+* REFLECTION WITH RESPECT TO AXIS // TO Y
+*----
+ ITM(1,IG)=1
+ ITM(2,IG)=2
+ DO 500 IX=0,NX-1
+ DAMESR(IX,1,IG)=DAMESH(NX-IX,1)-DAMESH(NX-IX-1,1)
+ ISPLTR(IX,1,IG)=ISPLT(NX-IX-1,1)
+ 500 CONTINUE
+ DAMESR(-1,1,IG)=-DAMESH(-1,1)
+ DO 510 IY=0,NY-1
+ DAMESR(IY,2,IG)=DAMESH(IY+1,2)-DAMESH(IY,2)
+ ISPLTR(IY,2,IG)=ISPLT(IY,2)
+ 510 CONTINUE
+ DAMESR(-1,2,IG)=DAMESH(-1,2)
+ IF(IKT .LT. 0) THEN
+ DO 520 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)
+ DO 521 IY=0,NY-1
+ DO 522 IX=0,NX-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+IY*NX*NRP1+
+ > (NX-IX-1)*NRP1
+ DO 523 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 523 CONTINUE
+ 522 CONTINUE
+ 521 CONTINUE
+ 520 CONTINUE
+ ELSE
+ DO 530 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 531 IY=0,NY-1
+ DO 532 IX=0,NX-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+IY*NX*NRP1+
+ > (NX-IX-1)*NRP1
+ DO 533 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 533 CONTINUE
+ 532 CONTINUE
+ 531 CONTINUE
+ 530 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 6) THEN
+*----
+* ROTATION OF PI/2 FOLLOWED BY
+* REFLECTION WITH RESPECT TO AXIS // TO Y
+*----
+ ITM(1,IG)=2
+ ITM(2,IG)=1
+ DO 600 IX=0,NY-1
+ DAMESR(IX,1,IG)=DAMESH(IX+1,2)-DAMESH(IX,2)
+ ISPLTR(IX,1,IG)=ISPLT(IX,2)
+ 600 CONTINUE
+ DAMESR(-1,1,IG)=DAMESH(-1,2)
+ DO 610 IY=0,NX-1
+ DAMESR(IY,2,IG)=DAMESH(IY+1,1)-DAMESH(IY,1)
+ ISPLTR(IY,2,IG)=ISPLT(IY,1)
+ 610 CONTINUE
+ DAMESR(-1,2,IG)=DAMESH(-1,1)
+ IF(IKT .LT. 0) THEN
+ DO 620 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)
+ DO 621 IY=0,NX-1
+ DO 622 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+IX*NX*NRP1+
+ > IY*NRP1
+ DO 623 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 623 CONTINUE
+ 622 CONTINUE
+ 621 CONTINUE
+ 620 CONTINUE
+ ELSE
+ DO 630 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 631 IY=0,NX-1
+ DO 632 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+IX*NX*NRP1+
+ > IY*NRP1
+ DO 633 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 633 CONTINUE
+ 632 CONTINUE
+ 631 CONTINUE
+ 630 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 7) THEN
+*----
+* REFLECTION WITH RESPECT TO AXIS // TO X
+*----
+ ITM(1,IG)=1
+ ITM(2,IG)=2
+ DO 700 IX=0,NX-1
+ DAMESR(IX,1,IG)=DAMESH(IX+1,1)-DAMESH(IX,1)
+ ISPLTR(IX,1,IG)=ISPLT(IX,1)
+ 700 CONTINUE
+ DAMESR(-1,1,IG)=DAMESH(-1,1)
+ DO 710 IY=0,NY-1
+ DAMESR(IY,2,IG)=DAMESH(NY-IY,2)-DAMESH(NY-IY-1,2)
+ ISPLTR(IY,2,IG)=ISPLT(NY-IY-1,2)
+ 710 CONTINUE
+ DAMESR(-1,2,IG)=-DAMESH(-1,2)
+ IF(IKT .LT. 0) THEN
+ DO 720 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)
+ DO 721 IY=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+(NY-IY-1)*NX*NRP1
+ DO 722 IX=0,NX-1
+ DO 723 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 723 CONTINUE
+ 722 CONTINUE
+ 721 CONTINUE
+ 720 CONTINUE
+ ELSE
+ DO 730 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 731 IY=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NX*NRP1
+ IDMI=IZ*NX*NY*NRP1+(NY-IY-1)*NX*NRP1
+ DO 732 IX=0,NX-1
+ DO 733 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 733 CONTINUE
+ 732 CONTINUE
+ 731 CONTINUE
+ 730 CONTINUE
+ ENDIF
+ ELSE IF(ABS(IKT) .EQ. 8) THEN
+*----
+* ROTATION OF PI/2 FOLLOWED BY
+* REFLECTION WITH RESPECT TO AXIS // TO X
+*----
+ ITM(1,IG)=2
+ ITM(2,IG)=1
+ DO 800 IX=0,NY-1
+ DAMESR(IX,1,IG)=DAMESH(NY-IX,2)-DAMESH(NY-IX-1,2)
+ ISPLTR(IX,1,IG)=ISPLT(NY-IX-1,2)
+ 800 CONTINUE
+ DAMESR(-1,1,IG)=-DAMESH(-1,2)
+ DO 810 IY=0,NX-1
+ DAMESR(IY,2,IG)=DAMESH(NX-IY,1)-DAMESH(NX-IY-1,1)
+ ISPLTR(IY,2,IG)=ISPLT(NX-IY-1,1)
+ 810 CONTINUE
+ DAMESR(-1,2,IG)=-DAMESH(-1,1)
+ IF(IKT .LT. 0) THEN
+ DO 820 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)
+ DO 821 IY=0,NX-1
+ DO 822 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=(NZ-IZ-1)*NX*NY*NRP1+(NY-IX-1)*NX*NRP1+
+ > (NX-IY-1)*NRP1
+ DO 823 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 823 CONTINUE
+ 822 CONTINUE
+ 821 CONTINUE
+ 820 CONTINUE
+ ELSE
+ DO 830 IZ=0,NZ-1
+ DAMESR(IZ,3,IG)=DAMESH(IZ+1,3)-DAMESH(IZ,3)
+ ISPLTR(IZ,3,IG)=ISPLT(IZ,3)
+ DO 831 IY=0,NX-1
+ DO 832 IX=0,NY-1
+ ITMI=IZ*NX*NY*NRP1+IY*NY*NRP1+
+ > IX*NRP1
+ IDMI=IZ*NX*NY*NRP1+(NY-IX-1)*NX*NRP1+
+ > (NX-IY-1)*NRP1
+ DO 833 IR=0,NMR
+ MIXR(ITMI,IG,1)=MIX(IDMI,1)
+ MIXR(ITMI,IG,2)=MIX(IDMI,2)
+ ITMI=ITMI+1
+ IDMI=IDMI+1
+ 833 CONTINUE
+ 832 CONTINUE
+ 831 CONTINUE
+ 830 CONTINUE
+ ENDIF
+ ENDIF
+ IF(IPRINT .GE. 100) THEN
+*----
+* Print turned mesh if required
+*----
+ WRITE(IOUT,6010) (NM(ITM(IDIR,IG)),IDIR=1,3),NREG
+ DO IDIR=1,4
+ NMTMP=NM(ITM(IDIR,IG))
+ IF(NMTMP .GT. 0) THEN
+ WRITE(IOUT,6011) 'MESH'//CDIR(IDIR)//' ='
+ WRITE(IOUT,6012) (DAMESR(IX,IDIR,IG),IX=-1,NMTMP)
+ WRITE(IOUT,6011) 'SPLT'//CDIR(IDIR)//' ='
+ WRITE(IOUT,6013) (ISPLTR(IX-1,IDIR,IG),IX=1,NMTMP)
+ ENDIF
+ ENDDO
+ WRITE(IOUT,6011) 'MIX ='
+ WRITE(IOUT,6013) (MIXR(IX,IG,1),IX=0,NREG-1)
+ WRITE(IOUT,6011) 'HMIX ='
+ WRITE(IOUT,6013) (MIXR(IX,IG,2),IX=0,NREG-1)
+ ENDIF
+ IF(IPG .GT. 1) THEN
+*----
+* COMPARE GEOMETRY
+* 1- MESH AND SPLIT IN X, Y AND Z
+* 2- MIXTURES
+* 3- OFFCENTER
+*----
+ DO 900 IDIR=1,3
+ NMTMP=NM(ITM(IDIR,1))
+ IF(NMTMP .NE. NM(ITM(IDIR,2))) CALL XABORT(NAMSBR//
+ > ': Symmetry invalid with this mesh')
+ DO 910 IX=0,NMTMP-1
+ DDD=ABS(DAMESR(IX,IDIR,1)-DAMESR(IX,IDIR,2))
+ IF(DDD .GT. DCUTOF) CALL XABORT(NAMSBR//
+ > ': Symmetry invalid with this mesh')
+ IF(ISPLTR(IX,IDIR,1) .NE. ISPLTR(IX,IDIR,2) )
+ > CALL XABORT(NAMSBR//
+ > ': Symmetry invalid with this split')
+ 910 CONTINUE
+ 900 CONTINUE
+ DO 920 IX=0,NREG-1
+ IF(MIXR(IX,1,1) .NE. MIXR(IX,2,1) ) CALL XABORT(NAMSBR//
+ > ': Symmetry invalid with this mixture')
+ IF(MIXR(IX,1,2) .NE. MIXR(IX,2,2) ) CALL XABORT(NAMSBR//
+ > ': Symmetry invalid with this merging mixture')
+ 920 CONTINUE
+ IF(DAMESR(-1,1,1) .NE. DAMESR(-1,1,2) .OR.
+ > DAMESR(-1,2,1) .NE. DAMESR(-1,2,2) .OR.
+ > 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,NR-1
+ DAMESH(IX,4)=DAMESR(IX,4,IG)
+ ISPLT(IX,4)=ISPLTR(IX,4,IG)
+ ENDDO
+ DAMESH(NR,4)=DAMESR(NR,4,IG)
+ DAMESH(-1,4)=DAMESR(-1,4,IG)
+*----
+* Find splitted mesh dimensions
+*----
+ DO 930 IDIR=1,4
+ NMTMP=NM(ITM(IDIR,1))
+ NMT(IDIR)=NMTMP
+ NMTS(IDIR)=0
+ DO 931 IX=0,NMTMP-1
+ NMTS(IDIR)=NMTS(IDIR)+ABS(ISPLTR(IX,IDIR,1))
+ 931 CONTINUE
+ IF(NMTS(IDIR) .NE. NMS(ITM(IDIR,1))) CALL XABORT(NAMSBR//
+ > ': Global symmetry invalid with this split')
+ 930 CONTINUE
+ ENDIF
+ 1005 CONTINUE
+ ENDDO
+*----
+* Reset final mesh (center+original turn)
+*----
+ DO IDIR=1,3
+ NMTMP=NMT(IDIR)
+ DAMESH(-1:NM(IDIR),IDIR)=DZERO
+ NM(IDIR)=NMTMP
+ DDD=DZERO
+ DO IX=0,NMTMP-1
+ DDD=DDD+DAMESR(IX,IDIR,1)
+ ENDDO
+ DDD=DDD/DTWO
+ DAMESH(-1,IDIR)=DAMESR(-1,IDIR,1)
+ DAMESH(0,IDIR)=-DDD
+ DO IX=1,NMTMP
+ DAMESH(IX,IDIR)=DAMESH(IX-1,IDIR)+DAMESR(IX-1,IDIR,1)
+ ENDDO
+ DO IX=0,NMTMP
+ ISPLT(IX,IDIR)=ISPLTR(IX,IDIR,1)
+ ENDDO
+ ENDDO
+ DO IDIR=1,4
+ NMTMP=NM(IDIR)
+ NMS(IDIR)=0
+ DO IX=0,NMTMP-1
+ NMS(IDIR)=NMS(IDIR)+ABS(ISPLT(IX,IDIR))
+ ENDDO
+ ENDDO
+*----
+* Processing finished:
+* print routine closing output header if required
+* and return
+*----
+ IF(IPRINT .GE. 100) THEN
+ 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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 15:21:00 +0000