summaryrefslogtreecommitdiff
path: root/Dragon/src/XELMRG.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/XELMRG.f')
-rw-r--r--Dragon/src/XELMRG.f502
1 files changed, 502 insertions, 0 deletions
diff --git a/Dragon/src/XELMRG.f b/Dragon/src/XELMRG.f
new file mode 100644
index 0000000..06134f2
--- /dev/null
+++ b/Dragon/src/XELMRG.f
@@ -0,0 +1,502 @@
+*DECK XELMRG
+ SUBROUTINE XELMRG ( IPRT, NSUR, NVOL, NSBC, NTOTCL, INDEX,
+ > MINDIM, MAXDIM, LCLSYM, LCLTRA, LL1, LL2,
+ > MRGCEL, MATALB, KEYMRG, INCELL, MATRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Construct keymrg according to implicit merging imposed by the
+* boundary conditions.
+*
+*Copyright:
+* Copyright (C) 1990 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): R. Roy
+*
+*Parameters: input
+* IPRT printing level.
+* NSUR number of surfaces.
+* NVOL number of zones.
+* NSBC number of surfaces with independent BC.
+* NTOTCL number of cylindres+3.
+* INDEX numbering of surfaces and zones.
+* MINDIM minimum index values for all axes (rect/cyl).
+* MAXDIM maximum index values for all axes (rect/cyl).
+* LCLSYM symmetry flags (0: no; -1/+1: syme; -2/+2: ssym).
+* LCLTRA translation flags (0: no; -1/+1: tra).
+* LL1 diagonal symmetry (2,3).
+* LL2 diagonal symmetry (1,4).
+* MRGCEL merging cell numbering.
+* MATALB material types.
+*
+*Parameters: input/output
+* KEYMRG initial numbering at input, merged at output.
+* INCELL block numbering at input, merged at output.
+*
+*Parameters: output
+* MATRT reflection/transmission vector.
+*
+*-----------------------------------------------------------------------
+*
+ IMPLICIT NONE
+*
+ INTEGER IPRT, NSUR, NVOL, NSBC, NTOTCL
+ INTEGER LCLSYM(3), LCLTRA(3), IORD(4), INDEX(4,*), KEYMRG(*),
+ > MATALB(*), MINDIM(NTOTCL), MAXDIM(NTOTCL), INCELL(*),
+ > MRGCEL(*), MATRT(-NSUR,2)
+ LOGICAL LL1, LL2
+*
+ LOGICAL SWOK, SWSUR, SWSTOP
+ INTEGER NUM, I, ISUR, ITRA, IVS1, IVS2, ISYM, IORD4, ICC1,
+ > INDEX4, INCR, NO1, NO2, IB1, IB2, NZSU, NZVO, NZABS,
+ > NMBLK, IBLK, NZBLK, IMRG, MINV, MAXV, NVOLM, NSURM,
+ > ICMP1, ICMP2, ITRAC1, NSURC, IP, IR, NVOLC, NMVO
+ CHARACTER*4 CORIEN(-6:0)
+ INTEGER IOUT
+ PARAMETER ( IOUT=6 )
+*
+ DATA CORIEN
+ > / ' Z+ ',' Z- ',' Y+ ',' Y- ',' X+ ',' X- ',' ' /
+*
+ NUM(I)= I + 1 - NSUR
+*
+* INITIALIZE MATRT TO REFLECTION FOR ORIGINAL SURFACES
+ NVOLM=0
+ DO 300 ISUR=1, -NSUR
+ MATRT(ISUR,1)=0
+ MATRT(ISUR,2)=ISUR
+ 300 CONTINUE
+*
+* 0) TREAT TRANSLATION SYMMETRIES *************************************
+ DO 310 ITRA =1,3
+ IF( LCLTRA(ITRA) .EQ. 1) THEN
+ DO 320 IVS1 = NSUR, -1
+ IF( (KEYMRG(NUM(IVS1)) .NE. 0 ) .AND.
+ > (MATRT(-IVS1,2) .EQ. -IVS1) ) THEN
+*
+* LOCATE SURFACE IN X, Y, Z AND R
+ IORD(1)= INDEX(1,NUM(IVS1))
+ IORD(2)= INDEX(2,NUM(IVS1))
+ IORD(3)= INDEX(3,NUM(IVS1))
+ IORD(4)= INDEX(4,NUM(IVS1))
+*
+* LOCATE TRANSLATED SURFACE IN X, Y, Z AND R
+ IF( (IORD(ITRA) .GE. MINDIM(ITRA)) .AND.
+ > (IORD(ITRA) .LT. MAXDIM(ITRA)) ) GO TO 345
+ IORD(ITRA)= (MAXDIM(ITRA)+MINDIM(ITRA))-(IORD(ITRA)+1)
+* INDEX(1,NUM(0))= IORD(1)
+* INDEX(2,NUM(0))= IORD(2)
+* INDEX(3,NUM(0))= IORD(3)
+* INDEX(4,NUM(0))= IORD(4)
+*
+* FOR CYLINDERS, *IORD4* IS ABSOLUTE.
+ IORD4 = IORD(4)
+ IF(IORD(4) .NE. 0 )THEN
+ DO 330 ICC1= NTOTCL, 4, -1
+ IF( IORD(4) .LT. MAXDIM(ICC1) )THEN
+ IORD4 = IORD(4)-MINDIM(ICC1)
+ ENDIF
+ 330 CONTINUE
+ ENDIF
+ DO 340 IVS2=NSUR,-1
+ IF( IORD(1) .EQ. INDEX(1,NUM(IVS2)).AND.
+ > IORD(2) .EQ. INDEX(2,NUM(IVS2)).AND.
+ > IORD(3) .EQ. INDEX(3,NUM(IVS2)) ) THEN
+ INDEX4= INDEX(4,NUM(IVS2))
+ IF( IORD(4).NE.0 )THEN
+ DO 350 ICC1= NTOTCL, 4, -1
+ IF( INDEX(4,NUM(IVS2)).LT.MAXDIM(ICC1) )THEN
+ INDEX4= INDEX(4,NUM(IVS2))-MINDIM(ICC1)
+ ENDIF
+ 350 CONTINUE
+ ENDIF
+*
+* SYMMETRIC SURFACE LOCATED FOR TRANSMISSION BC
+* STORE SURFACES IDENTIFIER IN MATRT AND
+* EXIT TO 345
+ IF( INDEX4.EQ.IORD4) THEN
+ MATRT(-IVS1,2)=-IVS2
+ MATRT(-IVS2,2)=-IVS1
+ GO TO 345
+ ENDIF
+ ENDIF
+ 340 CONTINUE
+ CALL XABORT( 'XELMRG: TRANSLATED SURFACE NO FOUND.' )
+ ENDIF
+ 345 CONTINUE
+ 320 CONTINUE
+ ENDIF
+ 310 CONTINUE
+*
+* 1) TREAT AXIAL SYMMETRIES ******************************************
+ DO 20 ISYM= 1, 3
+ IF( LCLSYM(ISYM).NE.0 )THEN
+ DO 10 IVS1= NSUR, NVOL
+*
+* FOR REGIONS ABSENT FROM FINAL CELL
+* DO NOT BOTHER TO SYMMETRIZE
+ IF( IVS1 .EQ. 0 .OR. KEYMRG(NUM(IVS1)) .EQ. 0) GO TO 10
+ IORD(1)= INDEX(1,NUM(IVS1))
+ IORD(2)= INDEX(2,NUM(IVS1))
+ IORD(3)= INDEX(3,NUM(IVS1))
+ IORD(4)= INDEX(4,NUM(IVS1))
+*
+* 1.1) RECOMPOSE *ISYM* VALUE TO GET THE SYMMETRIC COORDINATE
+ IORD(ISYM)= (MAXDIM(ISYM)+MINDIM(ISYM))-(IORD(ISYM)+1)
+ IF( IVS1.GT.0 )THEN
+ IVS2= NVOL
+ INCR= -1
+ ELSE
+ IVS2= NSUR
+ INCR= +1
+ ENDIF
+* INDEX(1,NUM(0))= IORD(1)
+* INDEX(2,NUM(0))= IORD(2)
+* INDEX(3,NUM(0))= IORD(3)
+* INDEX(4,NUM(0))= IORD(4)
+*
+* 1.2) TO SEARCH FOR THE GOOD CYLINDER, *IORD4* IS ABSOLUTE.
+ IORD4 = IORD(4)
+ IF( IORD(4).NE.0 )THEN
+ DO 110 ICC1= NTOTCL, 4, -1
+ IF( IORD(4).LT.MAXDIM(ICC1) )THEN
+ IORD4 = IORD(4)-MINDIM(ICC1)
+ ENDIF
+ 110 CONTINUE
+ ENDIF
+ 11 CONTINUE
+ IF( IORD(1).EQ.INDEX(1,NUM(IVS2)).AND.
+ > IORD(2).EQ.INDEX(2,NUM(IVS2)).AND.
+ > IORD(3).EQ.INDEX(3,NUM(IVS2)) )THEN
+ INDEX4= INDEX(4,NUM(IVS2))
+ IF( IORD(4).NE.0 )THEN
+ DO 112 ICC1= NTOTCL, 4, -1
+ IF( INDEX(4,NUM(IVS2)).LT.MAXDIM(ICC1) )THEN
+ INDEX4= INDEX(4,NUM(IVS2))-MINDIM(ICC1)
+ ENDIF
+ 112 CONTINUE
+ ENDIF
+ IF( INDEX4.EQ.IORD4) GO TO 12
+ ENDIF
+ IVS2= IVS2 + INCR
+ GO TO 11
+ 12 IF( IVS2.EQ.0 )THEN
+ CALL XABORT( 'XELMRG: RARE AXIAL SYMMETRY PROBLEM.' )
+ ENDIF
+ NO1= KEYMRG(NUM(IVS1))
+ NO2= KEYMRG(NUM(IVS2))
+ IB1= INCELL(NUM(IVS1))
+ IB2= INCELL(NUM(IVS2))
+*
+* 1.3) SELECT THE MAX OR MIN VALUE TO CORRECTLY # ZONES
+ IF( LCLSYM(ISYM).GT.0 )THEN
+ KEYMRG(NUM(IVS1))= MIN(NO1,NO2)
+ KEYMRG(NUM(IVS2))= MIN(NO1,NO2)
+ INCELL(NUM(IVS1))= MIN(IB1,IB2)
+ INCELL(NUM(IVS2))= MIN(IB1,IB2)
+ ELSE
+ KEYMRG(NUM(IVS1))= MAX(NO1,NO2)
+ KEYMRG(NUM(IVS2))= MAX(NO1,NO2)
+ INCELL(NUM(IVS1))= MAX(IB1,IB2)
+ INCELL(NUM(IVS2))= MAX(IB1,IB2)
+ ENDIF
+ 10 CONTINUE
+ ENDIF
+ 20 CONTINUE
+*
+* 2) TREAT DIAGONAL SYMMETRIES ***************************************
+* (SIDE #3)
+* (SIDE #1) GEOM (SIDE #2)
+* (SIDE #4)
+*
+ IF( LL1.OR.LL2 )THEN
+ DO 30 IVS1= NSUR, NVOL
+*
+* FOR REGIONS ABSENT FROM FINAL CELL
+* DO NOT BOTHER TO SYMMETRIZE
+ IF( IVS1 .EQ. 0 .OR. KEYMRG(NUM(IVS1)) .EQ. 0 ) GO TO 30
+*
+* 2.1) FOR (SIDE #1).EQ.(SIDE #4)
+* AND (SIDE #2).EQ.(SIDE #3) *** DIAGONAL SYMMETRY (\) ***
+* NOTE: ***NOT*** ACCEPTED IN DRAGON.
+*** IORD(1)= (MAXDIM(2)+MINDIM(1)) - (INDEX(2,NUM(IVS1))+1)
+*** IORD(2)= (MAXDIM(1)+MINDIM(2)) - (INDEX(1,NUM(IVS1))+1)
+* 2.2) FOR (SIDE #2).EQ.(SIDE #4)
+* AND (SIDE #1).EQ.(SIDE #3) *** DIAGONAL SYMMETRY (/) ***
+ IORD(1)= INDEX(2,NUM(IVS1)) + MINDIM(1) - MINDIM(2)
+ IORD(2)= INDEX(1,NUM(IVS1)) + MINDIM(2) - MINDIM(1)
+ IORD(3)= INDEX(3,NUM(IVS1))
+ IORD(4)= INDEX(4,NUM(IVS1))
+ IF( IVS1.GT.0 )THEN
+ IVS2= NVOL
+ INCR= -1
+ ELSE
+ IVS2= NSUR
+ INCR= +1
+ ENDIF
+* INDEX(1,NUM(0))= IORD(1)
+* INDEX(2,NUM(0))= IORD(2)
+* INDEX(3,NUM(0))= IORD(3)
+* INDEX(4,NUM(0))= IORD(4)
+ IORD4 = IORD(4)
+ IF( IORD(4).NE.0 )THEN
+ DO 33 ICC1= NTOTCL, 4, -1
+ IF( IORD(4).LT.MAXDIM(ICC1) )THEN
+ IORD4 = IORD(4)-MINDIM(ICC1)
+ ENDIF
+ 33 CONTINUE
+ ENDIF
+ 31 CONTINUE
+ IF( IORD(1).EQ.INDEX(1,NUM(IVS2)).AND.
+ > IORD(2).EQ.INDEX(2,NUM(IVS2)).AND.
+ > IORD(3).EQ.INDEX(3,NUM(IVS2)) )THEN
+ INDEX4= INDEX(4,NUM(IVS2))
+ IF( IORD(4).NE.0 )THEN
+ DO 34 ICC1= NTOTCL, 4, -1
+ IF( INDEX(4,NUM(IVS2)).LT.MAXDIM(ICC1) )THEN
+ INDEX4= INDEX(4,NUM(IVS2))-MINDIM(ICC1)
+ ENDIF
+ 34 CONTINUE
+ ENDIF
+ IF( INDEX4.EQ.IORD4) GO TO 32
+ ENDIF
+ IVS2= IVS2 + INCR
+ GO TO 31
+ 32 IF( IVS2.EQ.0 )THEN
+ CALL XABORT( 'XELMRG: RARE DIAGONAL SYMMETRY PROBLEM.' )
+ ENDIF
+ NO1= KEYMRG(NUM(IVS1))
+ NO2= KEYMRG(NUM(IVS2))
+ IB1= INCELL(NUM(IVS1))
+ IB2= INCELL(NUM(IVS2))
+*
+* 2.3) SELECT THE MAX OR MIN VALUE TO CORRECTLY # ZONES
+ IF( LL2 )THEN
+ KEYMRG(NUM(IVS1))= MIN(NO1,NO2)
+ KEYMRG(NUM(IVS2))= MIN(NO1,NO2)
+ INCELL(NUM(IVS1))= MIN(IB1,IB2)
+ INCELL(NUM(IVS2))= MIN(IB1,IB2)
+ ELSE
+ KEYMRG(NUM(IVS1))= MAX(NO1,NO2)
+ KEYMRG(NUM(IVS2))= MAX(NO1,NO2)
+ INCELL(NUM(IVS1))= MAX(IB1,IB2)
+ INCELL(NUM(IVS2))= MAX(IB1,IB2)
+ ENDIF
+ 30 CONTINUE
+ ENDIF
+*
+* 3) NOW, STOCK NEW INCREASING VALUES IN *KEYMRG* AND *INCELL* ********
+ NZSU= 0
+ DO 40 IVS1= -1, NSUR,-1
+ DO 41 IVS2= -1, NSUR, -1
+*
+* 3.1.1) COUNT THE NUMBER OF SURFACES.
+ IF( KEYMRG(NUM(IVS2)).EQ.IVS1 )THEN
+ NZSU= NZSU-1
+ GO TO 40
+ ENDIF
+ 41 CONTINUE
+ 40 CONTINUE
+ NZVO=0
+ DO 42 IVS1= 1, NVOL
+ DO 43 IVS2= 1, NVOL
+*
+* 3.1.2) COUNT THE NUMBER OF VOLUMES.
+ IF( KEYMRG(NUM(IVS2)).EQ.IVS1 )THEN
+ NZVO= NZVO+1
+ GO TO 42
+ ENDIF
+ 43 CONTINUE
+ 42 CONTINUE
+ NZABS= -1
+ DO 50 IVS1= -1, NSUR, -1
+ SWOK= .FALSE.
+ DO 51 IVS2= -1, NSUR, -1
+*
+* 3.2.1) RENUMBER SURFACES.
+ IF( KEYMRG(NUM(IVS2)).EQ.IVS1 )THEN
+ SWOK= .TRUE.
+ KEYMRG(NUM(IVS2))= NZABS
+ ENDIF
+ 51 CONTINUE
+ IF( SWOK )THEN
+ NZABS= NZABS - 1
+ ENDIF
+ 50 CONTINUE
+ IF( NZABS.NE.NZSU-1 )THEN
+ CALL XABORT( 'XELMRG: PROBLEMS TO MERGE SURFACES' )
+ ENDIF
+ KEYMRG(NUM(0))= 0
+ NZABS= 1
+ DO 52 IVS1= 1, NVOL
+ SWOK= .FALSE.
+ DO 53 IVS2= 1, NVOL
+*
+* 3.2.2) RENUMBER VOLUMES.
+ IF( KEYMRG(NUM(IVS2)).EQ.IVS1 )THEN
+ SWOK= .TRUE.
+ KEYMRG(NUM(IVS2))= NZABS
+ ENDIF
+ 53 CONTINUE
+ IF( SWOK )THEN
+ NZABS= NZABS + 1
+ ENDIF
+ 52 CONTINUE
+ IF( NZABS.NE.NZVO+1 )THEN
+ CALL XABORT( 'XELMRG: PROBLEMS TO MERGE VOLUMES' )
+ ENDIF
+ NMBLK= 0
+ DO 60 IVS2= NSUR, NVOL
+*
+* 3.3) COUNT NUMBER OF BLOCKS.
+ IF( KEYMRG(NUM(IVS2)).NE.0 )THEN
+ IBLK=INCELL(NUM(IVS2))
+ IF( IBLK.NE.0 )THEN
+ NMBLK=MAX(NMBLK,IBLK)
+ ENDIF
+ ENDIF
+ 60 CONTINUE
+ NZBLK= 1
+ DO 70 IBLK= 1, NMBLK
+ SWOK= .FALSE.
+ DO 71 IVS2= NSUR, NVOL
+*
+* 3.4) RENUMBER BLOCKS.
+ IF( KEYMRG(NUM(IVS2)).NE.0 )THEN
+ IF( INCELL(NUM(IVS2)).EQ.IBLK )THEN
+ SWOK= .TRUE.
+ INCELL(NUM(IVS2))= NZBLK
+ ENDIF
+ ENDIF
+ 71 CONTINUE
+ IF( SWOK )THEN
+ NZBLK= NZBLK + 1
+ ENDIF
+ 70 CONTINUE
+ NZBLK= NZBLK-1
+ IF( NZBLK .LE. 0 .OR. NZBLK .GT. NMBLK)THEN
+ CALL XABORT( 'XELMRG: PROBLEMS TO MERGE BLOCKS' )
+ ENDIF
+*
+* 3.5) RENUMBER CELL BLOCKS ACCORDING TO THE MERGE INDEX *MRGCEL*
+* *** THIS WILL RENUMBER VOLUMES, BUT NOT SURFACES. ***
+ NMVO = 0
+ NMBLK= 1
+ SWSTOP= .FALSE.
+ DO 290 IMRG= 1, NZBLK
+ SWOK= .FALSE.
+ DO 280 IBLK=1, NZBLK
+ IF( MRGCEL(IBLK).EQ.IMRG )THEN
+ IF( IMRG.NE.NMBLK )
+ > CALL XABORT('XELMRG: INCREASING MERGE #ING REQUIRED')
+ MINV= +100000000
+ MAXV= 0
+ SWSUR=.FALSE.
+ DO 210 IVS1= 1, NVOL
+ IF(KEYMRG(NUM(IVS1)).GT.0) THEN
+ IF( INCELL(NUM(IVS1)).EQ.IBLK )THEN
+ MINV= MIN(MINV,KEYMRG(NUM(IVS1)))
+ MAXV= MAX(MAXV,KEYMRG(NUM(IVS1)))
+ ENDIF
+ ENDIF
+ 210 CONTINUE
+ IF( SWOK )THEN
+ SWSTOP= SWSTOP.OR.(NVOLM.NE.MAXV+1-MINV)
+ ELSE
+ NVOLM = MAXV+1-MINV
+ ENDIF
+ MINV= MINV-NMVO
+ DO 220 IVS1= 1, NVOL
+ IF(KEYMRG(NUM(IVS1)).GT.0) THEN
+ IF( INCELL(NUM(IVS1)).EQ.IBLK )THEN
+ KEYMRG(NUM(IVS1))= KEYMRG(NUM(IVS1))-(MINV-1)
+ ENDIF
+ ENDIF
+ 220 CONTINUE
+ SWOK= .TRUE.
+ ENDIF
+ 280 CONTINUE
+ IF( SWOK )THEN
+ NMVO= NMVO+NVOLM
+ NMBLK= NMBLK+1
+ ENDIF
+ 290 CONTINUE
+ NMBLK= NMBLK-1
+ NSBC=-NZSU
+*
+* 4) RESET *MATRT* FOR MERGED SURFACES INSTEAD OF ORIGINAL SURFACES ***
+ NZSU=0
+ DO 360 IVS1=-1,NSUR,-1
+ ICMP1=KEYMRG(NUM(IVS1))
+ IVS2=-MATRT(-IVS1,2)
+ ICMP2=KEYMRG(NUM(IVS2))
+ IF( (ICMP1 .LT. 0) .AND. (ICMP2 .LT. 0) ) THEN
+ ITRAC1=MATRT(-ICMP1,1)
+ IF(ITRAC1 .EQ. 0) THEN
+ MATRT(-ICMP1,1)=-ICMP2
+ MATRT(-ICMP2,1)=-ICMP1
+ ENDIF
+ ENDIF
+ 360 CONTINUE
+*
+* 5) PRINTING *********************************************************
+ IF( IPRT.GT.2 )THEN
+ NSURC = -1
+ WRITE(IOUT,'(1H )')
+ WRITE(IOUT,'(/40H SURFACE #ING ( BEFORE CELL MERGE ) )')
+ DO 580 IP = 1, (9 - NSUR) / 10
+ NSURM= MAX( NSUR, NSURC-9 )
+ WRITE(IOUT,'(10X,10(A5,I7))')
+ > (' SUR ',-IR,IR= NSURC, NSURM, -1)
+ WRITE(IOUT,'(8H ORIENT ,2X,10A12)')
+ > (CORIEN(MATALB(NUM(IR))),IR=NSURC,NSURM,-1)
+ WRITE(IOUT,'(8H CELL # ,2X,10I12)')
+ > (INCELL(NUM(IR)),IR=NSURC,NSURM,-1)
+ WRITE(IOUT,'(9H MERGE TO ,1X,10(A5,I7))')
+ > (' SUR ',-KEYMRG(NUM(IR)),IR=NSURC,NSURM,-1)
+ WRITE(IOUT,'(1H )')
+ NSURC = NSURC - 10
+ 580 CONTINUE
+ NVOLC= 1
+ WRITE(IOUT,'(1H )')
+ WRITE(IOUT,'( 40H VOLUME #ING ( BEFORE CELL MERGE ) )')
+ DO 590 IP = 1, (9 + NVOL) / 10
+ NVOLM= MIN( NVOL, NVOLC+9 )
+ WRITE(IOUT,'(10X,10(A5,I7))')
+ > (' VOL ',IR,IR=NVOLC,NVOLM, 1)
+ WRITE(IOUT,'(8H CELL # ,2X,10I12)')
+ > (INCELL(NUM(IR)),IR=NVOLC,NVOLM, 1)
+ WRITE(IOUT,'(9H MERGE TO ,1X,10(A5,I7))')
+ > (' VOL ', KEYMRG(NUM(IR)),IR=NVOLC,NVOLM, 1)
+ WRITE(IOUT,'(8H MIX ,2X,10I12)')
+ > (MATALB(NUM(IR)),IR=NVOLC,NVOLM, 1)
+ WRITE(IOUT,'(9H ,1X,10(A5,I7))')
+ > (' CELL',MRGCEL(INCELL(NUM(IR))),IR=NVOLC,NVOLM, 1)
+ WRITE(IOUT,'(1H )')
+ NVOLC = NVOLC + 10
+ 590 CONTINUE
+ WRITE(IOUT,'( 40H BC MATRIX (BEFORE MERGE) )')
+ WRITE(IOUT,'(8(5X,I10,I10))') (IR,MATRT(IR,2),IR=1,-NSUR)
+ WRITE(IOUT,'( 40H BC MATRIX (AFTER MERGE) )')
+ WRITE(IOUT,'(8(5X,I10,I10))') (IR,MATRT(IR,1),IR=1,NSBC)
+ ELSEIF( IPRT.GT.1 )THEN
+ WRITE(IOUT,'(1H )')
+ WRITE(IOUT,'(32H # OF SURFACES AFTER SYMMETRIES: ,I8)') -NZSU
+ WRITE(IOUT,'(32H # OF ZONES AFTER SYMMETRIES: ,I8)') NZVO
+ WRITE(IOUT,'(32H # OF CELLS AFTER SYMMETRIES: ,I8)') NZBLK
+ WRITE(IOUT,'(1H )')
+ WRITE(IOUT,'(32H # OF ZONES AFTER MERGING : ,I8)') NMVO
+ WRITE(IOUT,'(32H # OF CELLS AFTER MERGING : ,I8)') NMBLK
+ WRITE(IOUT,'(1H )')
+ ENDIF
+ IF( SWSTOP )THEN
+ CALL XABORT('XELMRG: MERGE CELL ONLY WITH SAME # OF ZONES')
+ ENDIF
+*
+ RETURN
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 15:37:57 +0000