summaryrefslogtreecommitdiff
path: root/Dragon/src/NXTEGI.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/NXTEGI.f')
-rw-r--r--Dragon/src/NXTEGI.f600
1 files changed, 600 insertions, 0 deletions
diff --git a/Dragon/src/NXTEGI.f b/Dragon/src/NXTEGI.f
new file mode 100644
index 0000000..fc749e1
--- /dev/null
+++ b/Dragon/src/NXTEGI.f
@@ -0,0 +1,600 @@
+*DECK NXTEGI
+ SUBROUTINE NXTEGI(IPGEO ,IPRINT,ITYPG ,MAXMSH,NMIX ,NM ,
+ > MAXMSS,NMS ,NREG ,NREGS ,NSUR ,NSURS ,
+ > MIX ,ISPLT ,DAMESH,
+ > RMESH ,MIXC )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To extract cell or pin geometry information.
+*
+*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
+* IPGEO pointer to the reference geometry data structure.
+* IPRINT intermediate printing level for output.
+* ITYPG geometry type.
+* MAXMSH maximum number of elements in MESH array.
+* NMIX number of elements in MIX array.
+* NM mesh size in all directions ($X$, $Y$, $Z$ and $R$).
+*
+*Parameters: output
+* MAXMSS maximum number of elements in MESH array after split.
+* NMS mesh size in all directions ($X$, $Y$, $Z$ and $R$)
+* after split.
+* NREG number of regions.
+* NREGS number of regions after split.
+* NSUR number of surfaces.
+* NSURS number of surfaces after split.
+* MIX final mixture description for geometry (including HMIX).
+* ISPLT final split desctiption for geometry.
+* DAMESH final mesh description for geometry.
+*
+*Parameters: temporary storage
+* RMESH temporary vector for reading cell mesh array.
+* MIXC temporary mixture for cell rotation (including HMIX).
+*
+*Reference:
+* G. Marleau,
+* New Geometries Processing in DRAGON: The NXT: Module,
+* Report IGE-260, Polytechnique Montreal,
+* Montreal, 2005.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+ IMPLICIT NONE
+*----
+* Subroutine arguments
+*----
+ TYPE(C_PTR) IPGEO
+ INTEGER IPRINT,ITYPG,MAXMSH,NMIX,NM(4),MAXMSS,
+ > NMS(4),NREG,NREGS,NSUR,NSURS
+ INTEGER MIX(NMIX,2),ISPLT(MAXMSH,4)
+ DOUBLE PRECISION DAMESH(-1:MAXMSH,4)
+ REAL RMESH(0:MAXMSH)
+ INTEGER MIXC(NMIX,2,2)
+*----
+* Local parameters
+*----
+ INTEGER IOUT
+ CHARACTER NAMSBR*6
+ PARAMETER (IOUT=6,NAMSBR='NXTEGI')
+ DOUBLE PRECISION DZERO,DONE
+ PARAMETER (DZERO=0.0D0,DONE=1.0D0)
+ DOUBLE PRECISION DSQ3O2
+ PARAMETER (DSQ3O2=0.86602540378444D0)
+*----
+* Local variables
+*----
+ INTEGER IDIR,IR,IX,IY,IZ,IMTN,IMTO
+ INTEGER ILCMLN,ILCMTY,IMRGLN,IMRGTY
+ INTEGER NX,NY,NZ,NR,NRM,NXS,NYS,NZS,NRS,NRMS,
+ > NMREAD(4)
+ CHARACTER NAMREC*12,NAMMRG*12
+ REAL OFFCEN(3)
+ REAL SIDE,SIDET
+ DOUBLE PRECISION DSIDE,DSIDET
+*----
+* Data
+*----
+ CHARACTER CDIR(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
+ NRM=0
+ NRMS=0
+ NX=MAX(1,NM(1))
+ NY=MAX(1,NM(2))
+ NZ=MAX(1,NM(3))
+ NR=MAX(1,NM(4))
+*----
+* Read geometry information
+* 1- Cartesian MESH
+*----
+ IF(ITYPG .EQ. 8 .OR. ITYPG .EQ. 9 .OR.
+ > ITYPG .EQ. 12 .OR. ITYPG .EQ. 13 .OR.
+ > ITYPG .EQ. 26 .OR. ITYPG .EQ. 27) THEN
+*----
+* Hexagons
+*----
+ IDIR=1
+ NAMREC='SIDE '
+ CALL LCMGET(IPGEO,NAMREC,SIDE)
+ DSIDE=DBLE(SIDE)*DSQ3O2
+ IF(ITYPG .EQ. 12 .OR. ITYPG .EQ. 13 .OR.
+ > ITYPG .EQ. 26 .OR. ITYPG .EQ. 27) THEN
+ NAMREC='SIDET '
+ CALL LCMGET(IPGEO,NAMREC,SIDET)
+ DSIDET=DBLE(SIDET)*DSQ3O2
+ DAMESH(0,IDIR)=-DSIDE
+ DAMESH(1,IDIR)=-DSIDET*(NM(1)-1)
+ DO IX=2,2*NM(1)-1
+ DAMESH(IX,IDIR)=DAMESH(IX-1,IDIR)+DSIDET
+ ENDDO
+ DAMESH(2*NM(1),IDIR)=DSIDE
+ ELSE
+ DAMESH(-1,IDIR)=2*DSIDE
+ DAMESH(0,IDIR)=-DSIDE
+ DAMESH(1,IDIR)=DSIDE
+ ENDIF
+ IDIR=2
+ DO IX=-1,2*NM(1)
+ DAMESH(IX,IDIR)=DAMESH(IX,IDIR-1)
+ ENDDO
+ IDIR=3
+ NMREAD(IDIR)=0
+ IF(NM(IDIR) .GT. 0) THEN
+ NAMREC='MESH'//CDIR(IDIR)//' '
+ CALL LCMLEN(IPGEO,NAMREC,NMREAD(IDIR),ILCMTY)
+ IF(NMREAD(IDIR) .EQ. NM(IDIR)+1) THEN
+ CALL LCMGET(IPGEO,NAMREC,RMESH)
+ DO IX=0,NM(IDIR)
+ DAMESH(IX,IDIR)=DBLE(RMESH(IX))
+ ENDDO
+ ISPLT(:NM(IDIR),IDIR)=1
+ ENDIF
+ ELSE
+ DAMESH(0,IDIR)=DZERO
+ IX=1
+ DAMESH(IX,IDIR)=DONE
+ ENDIF
+ ELSE
+*----
+* Parallepiped
+*----
+ DO IDIR=1,3
+ NMREAD(IDIR)=0
+ IF(NM(IDIR) .GT. 0) THEN
+ NAMREC='MESH'//CDIR(IDIR)//' '
+ CALL LCMLEN(IPGEO,NAMREC,NMREAD(IDIR),ILCMTY)
+ IF(NMREAD(IDIR) .EQ. NM(IDIR)+1) THEN
+ CALL LCMGET(IPGEO,NAMREC,RMESH)
+ DO IX=0,NM(IDIR)
+ DAMESH(IX,IDIR)=DBLE(RMESH(IX))
+ ENDDO
+ ISPLT(:NM(IDIR),IDIR)=1
+ ENDIF
+ ELSE
+ DAMESH(0,IDIR)=DZERO
+ IX=1
+ DAMESH(IX,IDIR)=DONE
+ ENDIF
+ ENDDO
+ ENDIF
+*----
+* 2- Read cell OFFCENTER and store in position -1 of DAMESH
+*----
+ OFFCEN(:3)=0.0
+ CALL LCMLEN(IPGEO,'OFFCENTER ',ILCMLN,ILCMTY)
+ IF(ILCMLN .GT. 0)
+ > CALL LCMGET(IPGEO,'OFFCENTER ',OFFCEN)
+ DO IDIR=1,3
+ DAMESH(-1,IDIR)=DBLE(OFFCEN(IDIR))
+ ENDDO
+*----
+* 3- Radial mesh
+*----
+ IDIR=4
+ NMREAD(IDIR)=0
+ NAMREC='RADIUS '
+ CALL LCMLEN(IPGEO,NAMREC,NMREAD(IDIR),ILCMTY)
+ IF(NMREAD(IDIR) .EQ. NM(IDIR)+1) THEN
+ CALL LCMGET(IPGEO,NAMREC,RMESH)
+ DO IX=0,NM(IDIR)
+ DAMESH(IX,IDIR)=DBLE(RMESH(IX))
+ ENDDO
+ ISPLT(:NM(IDIR),IDIR)=1
+ ENDIF
+*----
+* 4- Cartesian, radial and hexagonal split
+*----
+ DO IDIR=1,4
+ IF(NM(IDIR) .GT. 0) THEN
+ NAMREC='SPLIT'//CDIR(IDIR)//' '
+ ISPLT(:NM(IDIR),IDIR)=1
+ CALL LCMLEN(IPGEO,NAMREC,ILCMLN,ILCMTY)
+ IF(ILCMLN .EQ. NM(IDIR))
+ > CALL LCMGET(IPGEO,NAMREC,ISPLT(1,IDIR))
+ NMS(IDIR)=0
+ DO IR=1,NM(IDIR)
+ NMS(IDIR)=NMS(IDIR)+ABS(ISPLT(IR,IDIR))
+ ENDDO
+ ELSE
+ NMS(IDIR)=NM(IDIR)
+ ENDIF
+ ENDDO
+ IF(ITYPG .EQ. 12 .OR. ITYPG .EQ. 13 .OR.
+ > ITYPG .EQ. 26 .OR. ITYPG .EQ. 27) THEN
+ NAMREC='SPLITH '
+ IDIR=1
+ CALL LCMLEN(IPGEO,NAMREC,ILCMLN,ILCMTY)
+ ISPLT(1,IDIR)=1
+ IF(ILCMLN .EQ. NM(IDIR))
+ > CALL LCMGET(IPGEO,NAMREC,ISPLT(1,IDIR))
+ NMS(IDIR)=NM(IDIR)*ABS(ISPLT(1,IDIR))
+ ENDIF
+ NXS=MAX(1,NMS(1))
+ NYS=MAX(1,NMS(2))
+ NZS=MAX(1,NMS(3))
+ NRS=MAX(1,NMS(4))
+ IF(IPRINT .GE. 100) THEN
+ IF(ITYPG .EQ. 8 .OR. ITYPG .EQ. 9 .OR.
+ > ITYPG .EQ. 12 .OR. ITYPG .EQ. 13 .OR.
+ > ITYPG .EQ. 26 .OR. ITYPG .EQ. 27) THEN
+ WRITE(IOUT,6015) ITYPG,NM(1),NMREAD(3),NMIX
+ IF(NM(1) .GT. 0) THEN
+ WRITE(IOUT,6011) 'MESHH ='
+ WRITE(IOUT,6012) (DAMESH(IX,1),IX=-1,2*NM(1))
+ WRITE(IOUT,6011) 'SPLTH ='
+ WRITE(IOUT,6013) (ISPLT(1,1),IX=1,2*NM(1))
+ ENDIF
+ IF(NMREAD(3) .GT. 0) THEN
+ WRITE(IOUT,6011) 'MESHZ ='
+ WRITE(IOUT,6012) (DAMESH(IX,3),IX=-1,NM(3))
+ WRITE(IOUT,6011) 'SPLTZ ='
+ WRITE(IOUT,6013) (ISPLT(IX,3),IX=1,NM(3))
+ ENDIF
+ ELSE
+ WRITE(IOUT,6010) ITYPG,(CDIR(IDIR),NM(IDIR),IDIR=1,4),NMIX
+ DO IDIR=1,3
+ IF(NMREAD(IDIR) .GT. 0) THEN
+ WRITE(IOUT,6011) 'MESH'//CDIR(IDIR)//' ='
+ WRITE(IOUT,6012) (DAMESH(IX,IDIR),IX=-1,NM(IDIR))
+ WRITE(IOUT,6011) 'SPLT'//CDIR(IDIR)//' ='
+ WRITE(IOUT,6013) (ISPLT(IX,IDIR),IX=1,NM(IDIR))
+ ENDIF
+ ENDDO
+ ENDIF
+ IDIR=4
+ IF(NMREAD(IDIR) .GT. 0) THEN
+ WRITE(IOUT,6011) 'RADIUS='
+ WRITE(IOUT,6012) (DAMESH(IX,IDIR),IX=0,NM(IDIR))
+ WRITE(IOUT,6011) 'SPLT'//CDIR(IDIR)//' ='
+ WRITE(IOUT,6013) (ISPLT(IX,IDIR),IX=1,NM(IDIR))
+ ENDIF
+ ENDIF
+*----
+* 5- Get MIX
+*----
+ NAMREC='MIX '
+ CALL LCMLEN(IPGEO,NAMREC,ILCMLN,ILCMTY)
+ IF(ILCMLN .LT. 0 .OR. ILCMLN .GT. NMIX) CALL XABORT(NAMSBR//
+ >': Size of MIX vector is invalid')
+ NAMMRG='HMIX '
+ CALL LCMLEN(IPGEO,NAMMRG,IMRGLN,IMRGTY)
+ IF(IMRGLN .LE. 0 ) THEN
+ NAMMRG=NAMREC
+ ELSE IF(IMRGLN .NE. ILCMLN) THEN
+ NAMMRG=NAMREC
+ WRITE(IOUT,8000) NAMSBR
+ ENDIF
+ IF(ILCMLN .GT. 0) THEN
+ IF (ITYPG .EQ. 3 ) THEN
+*----
+* TUBE
+*----
+ NRM=NR
+ NSUR=NZ
+ NRMS=NRS
+ NSURS=NZS
+ IF(ILCMLN .LT. NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 6 ) THEN
+*----
+* TUBEZ
+*----
+ NRM=NR
+ NSUR=2*(NRM*NX*NY)+NZ
+ NRMS=NRS
+ NSURS=2*(NRMS*NXS*NYS)+NZS
+ IF(ILCMLN .LT. NZ*NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ*NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 5) THEN
+*----
+* CAR2D
+*----
+ NRM=1
+ NSUR=2*(NY+NX)
+ NRMS=1
+ NSURS=2*(NYS+NXS)
+ IF(ILCMLN .LT. NY*NX) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NY*NX
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 7 ) THEN
+*----
+* CAR3D
+*----
+ NRM=1
+ NSUR=2*(NX*NY+NY*NZ+NZ*NX)
+ NRMS=1
+ NSURS=2*(NXS*NYS+NYS*NZS+NZS*NXS)
+ IF(ILCMLN .LT. NZ*NY*NX) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ*NY*NX
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 20) THEN
+*----
+* CARCEL
+*----
+ NRM=NR+1
+ NSUR=2*(NY+NX)
+ NRMS=NRS+1
+ NSURS=2*(NYS+NXS)
+ IF(ILCMLN .LT. NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 23 ) THEN
+*----
+* CARCELZ
+*----
+ NRM=NR+1
+ NSUR=2*(NX*NY*NRM+NY*NZ+NZ*NX)
+ NRMS=NRS+1
+ NSURS=2*(NXS*NYS*NRMS+NYS*NZS+NZS*NXS)
+ IF(ILCMLN .LT. NZ*NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ*NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 10 .OR. ITYPG .EQ. 21) THEN
+*----
+* TUBEX and CARCELX
+*----
+ IF(ITYPG .EQ.21) THEN
+ NRM=NR+1
+ NSUR=2*(NX*NY+NY*NZ*NRM+NZ*NX)
+ NRMS=NRS+1
+ NSURS=2*(NXS*NYS+NYS*NZS*NRMS+NZS*NXS)
+ ELSE
+ NRM=NR
+ NSUR=NX+2*NY*NZ*NRM
+ NRMS=NRS
+ NSURS=NXS+2*NYS*NZS*NRMS
+ ENDIF
+*----
+* For CARCELX reorder mixtures from $(R,Y,Z,X)$ to $(R,X,Y,Z)$
+*----
+ IF(ILCMLN .LT. NZ*NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ*NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIXC(1,1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIXC(1,2,1))
+ IMTN=0
+ DO 20 IZ=1,NZ
+ DO 21 IY=1,NY
+ DO 22 IX=1,NX
+ DO 23 IR=1,NRM
+ IMTN=IMTN+1
+ IMTO=(IX-1)*NY*NZ*NRM
+ > +(IZ-1)*NY*NRM
+ > +(IY-1)*NRM+IR
+ MIX(IMTN,1)=MIXC(IMTO,1,1)
+ MIX(IMTN,2)=MIXC(IMTO,2,1)
+ 23 CONTINUE
+ 22 CONTINUE
+ 21 CONTINUE
+ 20 CONTINUE
+ ELSE IF(ITYPG .EQ. 11 .OR. ITYPG .EQ. 22) THEN
+*----
+* TUBEY and CARCELY
+*----
+ IF(ITYPG .EQ.22) THEN
+ NRM=NR+1
+ NSUR=2*(NX*NY+NY*NZ+NZ*NX*NRM)
+ NRMS=NRS+1
+ NSURS=2*(NXS*NYS+NYS*NZS+NZS*NXS*NRMS)
+ ELSE
+ NRM=NR
+ NSUR=NY+2*NZ*NX*NRM
+ NRMS=NRS
+ NSURS=NYS+2*NZS*NXS*NRMS
+ ENDIF
+*----
+* For CARCELX reorder mixtures from $(R,Z,X,Y)$ to $(R,X,Y,Z)$
+*----
+ IF(ILCMLN .LT. NZ*NY*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ*NY*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIXC(1,1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIXC(1,2,1))
+ IMTN=0
+ DO 30 IZ=1,NZ
+ DO 31 IY=1,NY
+ DO 32 IX=1,NX
+ DO 33 IR=1,NRM
+ IMTN=IMTN+1
+ IMTO=(IY-1)*NZ*NX*NRM
+ > +(IX-1)*NZ*NRM
+ > +(IZ-1)*NRM+IR
+ MIX(IMTN,1)=MIXC(IMTO,1,1)
+ MIX(IMTN,2)=MIXC(IMTO,2,1)
+ 33 CONTINUE
+ 32 CONTINUE
+ 31 CONTINUE
+ 30 CONTINUE
+ ELSE IF(ITYPG .EQ. 8) THEN
+*----
+* HEX
+*----
+ NRM=1
+ NSUR=6
+ NRMS=1
+ NSURS=6
+ IF(ILCMLN .LT. 1) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,1
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 9) THEN
+*----
+* HEXZ
+*----
+ NRM=1
+ NSUR=6*NZ+2
+ NRMS=1
+ NSURS=6*NX+2
+ IF(ILCMLN .LT. NZ) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,NZ
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ ELSE IF(ITYPG .EQ. 12) THEN
+*----
+* HEXT
+*----
+ NRM=1
+ NSUR=6*(2*NX-1)
+ NRMS=1
+ NSURS=6*(2*NXS-1)
+ IF(ILCMLN .LT. 6*NX*NX) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,6*NX*NX
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 13) THEN
+*----
+* HEXTZ
+*----
+ NRM=1
+ NSUR=6*(2*NX-1)*NZ+12*NX*NX
+ NRMS=1
+ NSURS=6*(2*NXS-1)*NZS+12*NXS*NXS
+ IF(ILCMLN .LT. 6*NX*NX*NZ) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,6*NX*NX*NZ
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 26) THEN
+*----
+* HEXTCEL
+*----
+ NRM=NR+1
+ NSUR=6*(2*NX-1)
+ NRMS=NRS+1
+ NSURS=6*(2*NXS-1)
+ IF(ILCMLN .LT. 6*NX*NX*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,6*NX*NX*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE IF(ITYPG .EQ. 27) THEN
+*----
+* HEXTCELZ
+*----
+ NRM=NR+1
+ NSUR=6*(2*NX-1)*NZ+12*NX*NX*NRM
+ NRMS=NRS+1
+ NSURS=6*(2*NXS-1)*NZS+12*NXS*NXS*NRMS
+ IF(ILCMLN .LT. 6*NX*NX*NZ*NRM) THEN
+ WRITE(IOUT,9000) NAMSBR,ILCMLN,6*NX*NX*NZ*NRM
+ CALL XABORT(NAMSBR//
+ > ': Invalid number of mixtures provided')
+ ENDIF
+ CALL LCMGET(IPGEO,NAMREC,MIX(1,1))
+ CALL LCMGET(IPGEO,NAMMRG,MIX(1,2))
+ ELSE
+ CALL XABORT(NAMSBR//
+ > ': Geometry type invalid for cell or pin')
+ ENDIF
+ ENDIF
+ IF(ITYPG .EQ. 12 .OR. ITYPG .EQ. 13 .OR.
+ > ITYPG .EQ. 26 .OR. ITYPG .EQ. 27) THEN
+ NREG=6*NX*NX*NZ*NRM
+ NREGS=6*NXS*NXS*NZS*NRMS
+ MAXMSS=MAX(NRMS,2*(NXS+1),2*(NYS+1),NZS,MAXMSH)+1
+ ELSE
+ NREG=NRM*NX*NY*NZ
+ NREGS=NRMS*NXS*NYS*NZS
+ MAXMSS=MAX(NRMS,NXS,NYS,NZS,MAXMSH)+1
+ ENDIF
+*----
+* Print mesh if required
+*----
+ IF(IPRINT .GE. 100) THEN
+ WRITE(IOUT,6011) 'MIX ='
+ WRITE(IOUT,6013) (MIX(IX,1),IX=1,NMIX)
+ WRITE(IOUT,6011) 'HMIX ='
+ WRITE(IOUT,6013) (MIX(IX,2),IX=1,NMIX)
+ WRITE(IOUT,6001) NAMSBR
+ ENDIF
+*----
+* Processing finished:
+* print routine closing output header if required
+* and return
+*----
+ RETURN
+*----
+* Output formats
+*----
+ 6000 FORMAT('(* Output from --',A6,'-- follows ')
+ 6001 FORMAT(' Output from --',A6,'-- completed *)')
+ 6010 FORMAT(1X,'Geometry type =',I10/
+ > 1X,'Original mesh dimensions ='/
+ > 4(1X,A1,'=',1X,I8)/
+ > 1X,'Number of regions =',i8)
+ 6011 FORMAT(1X,A7)
+ 6012 FORMAT(5F15.9)
+ 6013 FORMAT(5I15)
+ 6015 FORMAT(1X,'Geometry type =',I10/
+ > 1X,'Original hexagonal mesh dimensions =',I10,/
+ > 1X,'Original z mesh dimensions =',I10,/
+ > 1X,'Number of regions =',i8)
+ 8000 FORMAT(' ***** Warning in ',A6,' *****'/
+ > ' HMIX not compatible with MIX '/
+ > ' HMIX mixture are replaced by MIX mixtures' )
+ 9000 FORMAT(' ***** Error in ',A6,' *****'/
+ > ' Number of mixtures provided = ',I10/
+ > ' Number of mixtures required = ',I10)
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 19:38:10 +0000