From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Dragon/src/MCTGET.f | 234 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 234 insertions(+) create mode 100644 Dragon/src/MCTGET.f (limited to 'Dragon/src/MCTGET.f') diff --git a/Dragon/src/MCTGET.f b/Dragon/src/MCTGET.f new file mode 100644 index 0000000..8395744 --- /dev/null +++ b/Dragon/src/MCTGET.f @@ -0,0 +1,234 @@ +*DECK MCTGET + SUBROUTINE MCTGET(IPOUT,NGRP,NFREG,NBMIX,MATCOD,IPRINT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To read from the input file the MC: module input options. +* +*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): B. Arsenault +* +*Parameters: input +* IPOUT pointer to the MC: data structure. +* NGRP number of energy groups. +* NFREG number of regions. +* NBMIX maximum number of mixtures. +* MATCOD region material. +* +*Parameters: input/output +* IPRINT print parameter. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPOUT + INTEGER NSTATE,NGRP,NFREG,NBMIX,MATCOD(NFREG),IPRINT +*---- +* LOCAL VARIABLES +*---- + PARAMETER (NSTATE=40) + INTEGER ISTATE(NSTATE),INDIC,NITMA,NMERGE,IREGIO,IMATER,NGCOND, + 1 IGROUP,JGROUP + REAL FLOTT + CHARACTER TEXT*12 + DOUBLE PRECISION DFLOTT +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: IMERGE,MIXMER,IGCR +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(IMERGE(NFREG),MIXMER(0:NBMIX),IGCR(NGRP)) +*---- +* READ INPUT +*---- + IPRINT=1 + ISTATE(:NSTATE)=0 + 10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.EQ.10) GO TO 200 + IF(INDIC.NE.3) CALL XABORT('MCTGET: CHARACTER DATA EXPECTED(1)') + IF(TEXT(1:4).EQ.'EDIT') THEN + CALL REDGET(INDIC,IPRINT,FLOTT,TEXT,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTED FOR' + < //' IPRINT') + ELSE IF(TEXT(1:5).EQ.'KCODE') THEN +* READ THE NSRCK PARAMETER + CALL REDGET(INDIC,ISTATE(1),FLOTT,TEXT,DFLOTT) + IF (INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTED FOR' + < //' NSRCK') +* READ THE IKZ PARAMETER + CALL REDGET(INDIC,ISTATE(2),FLOTT,TEXT,DFLOTT) + IF (INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTED FOR' + < //' IKZ') +* READ THE KCT PARAMETER + CALL REDGET(INDIC,ISTATE(3),FLOTT,TEXT,DFLOTT) + IF (INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTED FOR' + < //' KCT') + ELSE IF(TEXT(1:4).EQ.'SEED') THEN +* INPUT A SEED INTEGER + CALL REDGET(INDIC,ISTATE(4),FLOTT,TEXT,DFLOTT) + IF (INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTED FOR' + < //' SEED') + ELSE IF(TEXT(1:3).EQ.'N2N') THEN +* N2N CROSS SECTION RECOVERY FLAG + ISTATE(5)=1 + ELSE IF(TEXT(1:5).EQ.'TALLY') THEN +* DEFINE A TALLY + IF(ISTATE(6).NE.0) CALL XABORT('MCTGET: TALLY EXISTS') + ISTATE(6)=1 + NMERGE=0 + NGCOND=0 + 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + 30 IF(INDIC.NE.3) CALL XABORT('MCTGET: CHARACTER DATA EXPECTED(2)') + IF(TEXT(:4).EQ.'MERG') THEN +*---- +* MERGING DIRECTIVE ANALYSIS +*---- + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.NE.3) CALL XABORT('MCTGET: CHARACTER DATA EXPECTED' + < //'(3)') + IF(TEXT.EQ.'COMP') THEN +*---- +* COMPLETE MERGE +*---- + IMERGE(:NFREG)=1 + NMERGE=1 + GO TO 20 + ELSE IF(TEXT.EQ.'MIX') THEN +*---- +* MERGE BY MIXTURES +*---- + DO 40 IMATER=0,NBMIX + MIXMER(IMATER)=IMATER + 40 CONTINUE + DO 50 IREGIO=1,NFREG + NMERGE=MAX(NMERGE,MATCOD(IREGIO)) + IMERGE(IREGIO)=MIXMER(MATCOD(IREGIO)) + 50 CONTINUE + NMERGE=NBMIX + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.EQ.1) THEN +*---- +* SPECIFY MIXTURES TO BE MERGED +*---- + NMERGE=MAX(0,NITMA) + MIXMER(1)=NITMA + DO 60 IMATER=2,NBMIX + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPEC' + < //'TED FOR IMIXM') + NMERGE=MAX(NMERGE,NITMA) + MIXMER(IMATER)=NITMA + 60 CONTINUE + DO 70 IREGIO=1,NFREG + IMERGE(IREGIO)=MIXMER(MATCOD(IREGIO)) + 70 CONTINUE + ELSE IF(INDIC.EQ.3) THEN +*---- +* ASSOCIATE ONE REGION BY MIXTURE +*---- + GO TO 30 + ELSE + CALL XABORT('MCTGET: READ ERROR - INVALID TYPE READ') + ENDIF + ELSE IF(TEXT.EQ.'REGI') THEN +*---- +* MERGE BY REGIONS +*---- + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPEC' + < //'TED FOR IREGM') + NMERGE=MAX(0,NITMA) + IMERGE(1)=NITMA + DO 80 IREGIO=2,NFREG + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.NE.1) CALL XABORT('MCTGET: INTEGER DATA EXPECTE' + < //'D FOR IREGM') + NMERGE=MAX(NMERGE,NITMA) + IMERGE(IREGIO)=NITMA + 80 CONTINUE + ELSE IF(TEXT.EQ.'NONE') THEN +*---- +* NO MERGING +*---- + NMERGE=NFREG + DO 90 IREGIO=1,NFREG + IMERGE(IREGIO)=IREGIO + 90 CONTINUE + ELSE + CALL XABORT('MCTGET: '//TEXT//' IS AN INVALID KEYWORD(1)') + ENDIF + ELSE IF(TEXT(:4).EQ.'COND') THEN +*---- +* GROUP CONDENSATION DIRECTIVE ANALYSIS +*---- + DO 110 IGROUP=1,NGRP+1 + CALL REDGET(INDIC,NITMA,FLOTT,TEXT,DFLOTT) + IF(INDIC.EQ.3) THEN + IF(IGROUP.EQ.1) THEN + IF(TEXT.EQ.'NONE') THEN + NGCOND=NGRP + DO 100 JGROUP=1,NGRP + IGCR(JGROUP)=JGROUP + 100 CONTINUE + GO TO 20 + ELSE + NGCOND=1 + IGCR(NGCOND)=NGRP + ENDIF + ENDIF + IF(IGCR(NGCOND).NE.NGRP) THEN + NGCOND=NGCOND+1 + IGCR(NGCOND)=NGRP + ENDIF + GO TO 30 + ELSE IF(INDIC.EQ.1) THEN + IF(NITMA.GT.NGRP) NITMA=NGRP + IF(NGCOND.GT.0) THEN + IF(NITMA.GT.IGCR(NGCOND)) THEN + NGCOND=NGCOND+1 + IGCR(NGCOND)=NITMA + ENDIF + ELSE + NGCOND=NGCOND+1 + IGCR(NGCOND)=NITMA + ENDIF + ENDIF + 110 CONTINUE + ELSE IF(TEXT(:4).EQ.'ENDT') THEN + GO TO 120 + ELSE + CALL XABORT('MCTGET: '//TEXT//' IS AN INVALID KEYWORD(2)') + ENDIF + GO TO 20 + 120 CALL LCMPUT(IPOUT,'REF:IMERGE',NFREG,1,IMERGE) + CALL LCMPUT(IPOUT,'REF:IGCOND',NGCOND,1,IGCR) + IF((NMERGE.GT.0).AND.(NGCOND.GT.0)) ISTATE(6)=2 + ISTATE(7)=NMERGE + ISTATE(8)=NGCOND + ELSE IF(TEXT(1:1).EQ.';') THEN + GO TO 200 + ELSE + CALL XABORT('MCTGET: '//TEXT//' IS AN INVALID KEYWORD(3)') + ENDIF + GO TO 10 + 200 ISTATE(9)=NFREG + CALL LCMPUT(IPOUT,'STATE-VECTOR',NSTATE,1,ISTATE) +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(IGCR,MIXMER,IMERGE) + RETURN + END -- cgit v1.2.3