summaryrefslogtreecommitdiff
path: root/Dragon/src/MCT.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/MCT.f')
-rw-r--r--Dragon/src/MCT.f202
1 files changed, 202 insertions, 0 deletions
diff --git a/Dragon/src/MCT.f b/Dragon/src/MCT.f
new file mode 100644
index 0000000..0681972
--- /dev/null
+++ b/Dragon/src/MCT.f
@@ -0,0 +1,202 @@
+*DECK MCT
+ SUBROUTINE MCT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Monte-Carlo method based on NXT geometry analysis.
+*
+*Copyright:
+* Copyright (C) 2008 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. Le Tellier and B. Arsenault
+*
+*Parameters: input/output
+* NENTRY number of LCM objects or files used by the operator.
+* HENTRY name of each LCM object or file:
+* HENTRY(1) creation type(L_MC);
+* HENTRY(2) read-only or modification type(L_TRACK);
+* HENTRY(3) read-only type(L_LIBRARY) or type(L_MACROLIB).
+* IENTRY type of each LCM object or file:
+* =1 LCM memory object; =2 XSM file; =3 sequential binary file;
+* =4 sequential ascii file.
+* JENTRY access of each LCM object or file:
+* =0 the LCM object or file is created;
+* =1 the LCM object or file is open for modifications;
+* =2 the LCM object or file is open in read-only mode.
+* KENTRY LCM object address or file unit number.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+ IMPLICIT NONE
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+ TYPE(C_PTR) KENTRY(NENTRY)
+ CHARACTER HENTRY(NENTRY)*12
+*----
+* LOCAL VARIABLES
+*----
+ TYPE(C_PTR) IPOUT,IPTRK,IPLIB
+ INTEGER NSTATE,IOUT,ITC,NSRCK,IKZ,KCT,NGRP,NFREG,NBMIX,NMIX,
+ 1 NFM,NL,NDEL,NED,ISEED,IPRINT,NBSCO,NMERGE,NGCOND
+ PARAMETER (NSTATE=40,IOUT=6)
+ INTEGER ISTATE(NSTATE),GSTATE(NSTATE)
+ DOUBLE PRECISION XYZL(2,3),KEFF,REKEFF
+ CHARACTER NAMREC*12,HSIGN*12
+ LOGICAL MODIF,LN2N
+*----
+* ALLOCATABLE ARRAYS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: INMIX,NAMEAD
+ REAL, ALLOCATABLE, DIMENSION(:) :: XST,XSS,XSSNN,XNUFI,XCHI,XSN2N,
+ < XSN3N,XSEDI
+*----
+* PARAMETER VALIDATION
+*----
+ IF(NENTRY.NE.3) CALL XABORT('MCT: THREE PARAMETERS EXPECTED.')
+* output table in creation or modification mode
+ IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))
+ 1 CALL XABORT('MCT: LCM OBJECT EXPECTED AT LHS (1).')
+ IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1))
+ 1 CALL XABORT('MCT: ENTRY IN CREATION '//
+ 2 'OR MODIFICATION MODE EXPECTED.')
+ IPOUT=KENTRY(1)
+ MODIF=(JENTRY(1).EQ.1)
+* tracking table in read-only mode
+ IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))
+ 1 CALL XABORT('MCT: LCM OBJECT EXPECTED AT LHS (2).')
+ IF((JENTRY(2).NE.1).AND.(JENTRY(2).NE.2)) CALL XABORT('MCT: ENTR'
+ 1 //'Y IN READ-ONLY OR MODIFICATION MODE EXPECTED.')
+ IPTRK=KENTRY(2)
+ CALL LCMGTC(IPTRK,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.NE.'L_TRACK') THEN
+ NAMREC=HENTRY(2)
+ CALL XABORT('MCT: INVALID SIGNATURE FOR '//NAMREC)
+ ENDIF
+* xs library in read-only mode
+ IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))
+ 1 CALL XABORT('MCT: LCM OBJECT EXPECTED AT LHS (3).')
+ IF(JENTRY(3).NE.2)
+ 1 CALL XABORT('MCT: ENTRY IN READ-ONLY MODE EXPECTED (2).')
+ IPLIB=KENTRY(3)
+ CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.EQ.'L_LIBRARY') THEN
+ CALL LCMSIX(IPLIB,'MACROLIB',1)
+ CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.NE.'L_MACROLIB') THEN
+ NAMREC=HENTRY(3)
+ CALL XABORT('MCT: INVALID SIGNATURE FOR '//NAMREC)
+ ENDIF
+ ELSE IF(HSIGN.NE.'L_MACROLIB') THEN
+ NAMREC=HENTRY(3)
+ CALL XABORT('MCT: INVALID SIGNATURE FOR '//NAMREC)
+ ENDIF
+*----
+* INITIALIZE OUTPUT TABLE
+*----
+ IF(MODIF) THEN
+ CALL LCMGTC(IPOUT,'SIGNATURE',12,HSIGN)
+ IF(HSIGN.NE.'L_MC') THEN
+ NAMREC=HENTRY(1)
+ CALL XABORT('MCT: INVALID SIGNATURE FOR '//NAMREC)
+ ENDIF
+ CALL LCMGET(IPOUT,'STATE-VECTOR',ISTATE)
+ ELSE
+ HSIGN='L_MC'
+ CALL LCMPTC(IPOUT,'SIGNATURE',12,HSIGN)
+ ISTATE(:NSTATE)=0
+ ENDIF
+*----
+* READ INPUT PARAMETERS
+*----
+ GSTATE(:NSTATE)=0
+ CALL LCMGET(IPLIB,'STATE-VECTOR',GSTATE)
+ NGRP = GSTATE(1)
+ GSTATE(:NSTATE)=0
+ CALL LCMGET(IPTRK,'STATE-VECTOR',GSTATE)
+ NFREG= GSTATE(1)
+ NBMIX= GSTATE(4)
+ ALLOCATE(INMIX(NFREG))
+ CALL LCMGET(IPTRK,'MATCOD',INMIX)
+ CALL MCTGET(IPOUT,NGRP,NFREG,NBMIX,INMIX,IPRINT)
+ DEALLOCATE(INMIX)
+ CALL LCMGET(IPOUT,'STATE-VECTOR',ISTATE)
+ ISEED=ISTATE(4)
+ LN2N=(ISTATE(5).EQ.1)
+*----
+* VALIDATE THE OPTIONS SPECIFIED FOR THE KCODE CARD
+*----
+ IF ((ISTATE(1).GT.0).AND.
+ < (ISTATE(2).GT.0).AND.
+ < (ISTATE(3).GT.0).AND.
+ < (ISTATE(2).LE.ISTATE(3))) THEN
+ NSRCK=ISTATE(1)
+ IKZ =ISTATE(2)
+ KCT =ISTATE(3)
+ ELSE
+ CALL XABORT('MCT: INVALID PARAMETERS SPECIFIED FOR KCODE CARD')
+ ENDIF
+*----
+* RECOVER MACROSCOPIC CROSS SECTIONS.
+*----
+ GSTATE(:NSTATE)=0
+ CALL LCMGET(IPLIB,'STATE-VECTOR',GSTATE)
+ NGRP = GSTATE(1)
+ NMIX = GSTATE(2)
+ NL = GSTATE(3)
+ NFM = GSTATE(4)
+ NED = GSTATE(5)
+ NDEL = GSTATE(7)
+ ALLOCATE(NAMEAD(2*NED))
+ IF(NED.GT.0) CALL LCMGET(IPLIB,'ADDXSNAME-P0',NAMEAD)
+ ALLOCATE(XST(NMIX*NGRP),XSS(NMIX*NGRP*NL),
+ > XSSNN(NGRP*NGRP*NMIX*NL),XNUFI(NFM*NMIX*NGRP*(1+NDEL)),
+ > XCHI(NFM*NMIX*NGRP*(1+NDEL)),XSN2N(NMIX*NGRP),XSN3N(NMIX*NGRP),
+ > XSEDI(NMIX*NGRP*NED))
+ CALL MCTLIB(IPLIB,NMIX,NGRP,NL,NFM,NDEL,NED,NAMEAD,LN2N,
+ < XST,XSS,XSSNN,XNUFI,XCHI,XSN2N,XSN3N,XSEDI)
+*----
+* POWER ITERATION WITH THE MONTE-CARLO METHOD IN 1D/2D/3D CARTESIAN
+* GEOMETRY.
+*----
+ GSTATE(:NSTATE)=0
+ CALL LCMGET(IPOUT,'STATE-VECTOR',GSTATE)
+ NMERGE=GSTATE(7)
+ NGCOND=GSTATE(8)
+ NBSCO=5+NGCOND*NL+2*NFM*(1+NDEL)+NED
+ CALL MCTFLX(IPTRK,IPOUT,IPRINT,NMIX,NGRP,NL,NFM,NDEL,NED,
+ < NAMEAD,XST,XSS,XSSNN,XNUFI,XCHI,XSN2N,XSN3N,
+ < XSEDI,NSRCK,IKZ,KCT,ISEED,XYZL,NBSCO,NMERGE,
+ < NGCOND,KEFF,REKEFF)
+*
+ DEALLOCATE(XSEDI,XSN3N,XSN2N,XCHI,XNUFI,XSSNN,XSS,XST,NAMEAD)
+*----
+* RESET LIBRARY ON ROOT LEVEL
+*----
+ CALL LCMSIX(IPLIB,' ',0)
+*----
+* SAVE KEFF INFORMATION ON MC OBJECT
+*----
+ CALL LCMPUT(IPOUT,'K-EFFECTIVE',1,2,REAL(KEFF))
+ CALL LCMPUT(IPOUT,'K-EFFECTI-SD',1,2,REAL(REKEFF))
+ IF(IPRINT.GT.0) WRITE(6,100) (ISTATE(ITC),ITC=1,9)
+ RETURN
+*
+ 100 FORMAT(/8H OPTIONS/8H -------/
+ 1 7H NSRCK ,I8,34H (NUMBER OF HISTORIES PER CYCLE)/
+ 2 7H IKZ ,I8,29H (NUMBER OF CYCLES TO SKIP)/
+ 3 7H KCT ,I8,27H (TOTAL NUMBER OF CYCLES)/
+ 4 7H ISEED ,I8,45H (INITIAL SEED FOR RANDOM NUMBER GENERATOR)/
+ 5 7H IN2N ,I8,24H (N2N PROCESSING FLAG)/
+ 6 7H ITALLY,I8,20H (TYPE OF TALLIES)/
+ 7 7H NMERGE,I8,44H (NUMBER OF HOMOGENIZED MIXTURES IN TALLY)/
+ 8 7H NGCOND,I8,40H (NUMBER OF CONDENSED GROUPS IN TALLY)/
+ 9 7H NREG ,I8,34H (NUMBER OF REGIONS IN GEOMETRY))
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:33:35 +0000