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 --- Donjon/src/LZCDRV.f | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 Donjon/src/LZCDRV.f (limited to 'Donjon/src/LZCDRV.f') diff --git a/Donjon/src/LZCDRV.f b/Donjon/src/LZCDRV.f new file mode 100644 index 0000000..4f71429 --- /dev/null +++ b/Donjon/src/LZCDRV.f @@ -0,0 +1,161 @@ +*DECK LZCDRV + SUBROUTINE LZCDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT,LNEW) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Read specifications for the liquid zone controllers from input file. +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal. +* +*Author(s): +* D. Sekki +* +*Parameters: input/output +* IPDEV pointer to device information. +* IPMTX pointer to matex information. +* IGEO index related to the reactor geometry. +* NMIX old maximum number of material mixtures. +* NTOT old total number of all mixtures. +* LIMIT core limiting coordinates. +* LNEW flag with respect to device object: +* =.true. in create mode; =.false. in modification mode. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPDEV,IPMTX + INTEGER NMIX,NTOT + REAL LIMIT(6) + LOGICAL LNEW +*---- +* LOCAL VARIABLES +*---- + PARAMETER(NSTATE=40,IOUT=6) + CHARACTER TEXT*12 + INTEGER ISTATE(NSTATE) + DOUBLE PRECISION DFLOT + TYPE(C_PTR) JPDEV,KPDEV + INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,MAT +*---- +* READ INPUT DATA +*---- + IMPX=1 + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(1).') + IF(TEXT.NE.'EDIT')GOTO 10 +* PRINTING INDEX + CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER FOR EDIT EXPECTED.') + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(2).') + 10 IF(TEXT.NE.'NUM-LZC')CALL XABORT('@LZCDRV: KEYWORD NUM-LZC EXP' + 1 //'ECTED.') +* TOTAL NUMBER OF LZC + CALL REDGET(ITYP,NLZC,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER TOTAL NUMBER OF LZC' + 1 //' EXPECTED.') + IF(NLZC.LT.1)CALL XABORT('@LZCDRV: WRONG TOTAL NUMBER OF LZC <1') +* + NTOT2=NTOT+NLZC*4 + ALLOCATE(MIX(NTOT2),MAT(NTOT)) + MIX(:NTOT2)=0 + MAT(:NTOT)=0 + CALL LCMGET(IPMTX,'MAT',MAT) + DO 20 I=1,NTOT + MIX(I)=MAT(I) + 20 CONTINUE + DEALLOCATE(MAT) +*---- +* READ OPTION +*---- + IF(IMPX.GT.0)WRITE(IOUT,1000)NLZC + JPDEV=LCMLID(IPDEV,'DEV_LZC',NLZC) + K=0 + 30 K=K+1 + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(TEXT.EQ.'LZC')THEN + CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER ID NUM' + 1 //'BER FOR THE CURRENT LZC EXPECTED.') + IF(ID.NE.K)THEN + WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID + WRITE(IOUT,*)'@LZCDRV: EXPECTED LZC-ID #',K + CALL XABORT('@LZCDRV: WRONG INPUT OF ID NUMBER.') + ENDIF + IF(ID.GT.NLZC)THEN + WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID + WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC:',NLZC + CALL XABORT('@LZCDRV: WRONG INPUT OF LZC-ID NUMBER. GRE' + 1 //'ATER THAN THE TOTAL NUMBER OF LZC.') + ENDIF + ELSEIF((TEXT.EQ.'CREATE').OR.(TEXT.EQ.';'))THEN + GOTO 40 + ELSE + WRITE(IOUT,*)'@LZCDRV: INVALID KEYWORD ',TEXT + CALL XABORT('@LZCDRV: KEYWORD OR ; EXPECTED.') + ENDIF + IF(IMPX.GT.1)WRITE(IOUT,1001)ID + KPDEV=LCMDIL(JPDEV,ID) +* READ INDIVIDUAL LZC DATA + CALL LZCGET(KPDEV,NTOT,NMIX,NTOT2,MIX,ID,LIMIT,IMPX) + GOTO 30 + 40 IF(ID.NE.NLZC)THEN + WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC ',NLZC + WRITE(IOUT,*)'@LZCDRV: READ ONLY THE NUMBER OF LZC ',ID + CALL XABORT('@LZCDRV: WRONG INPUT OF LZC DEVICES.') + ENDIF + IF(IMPX.GT.0)WRITE(IOUT,1002)ID + IF(TEXT.EQ.';')GOTO 50 + LGRP=0 +* TOTAL NUMBER OF LZC-GROUPS + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(TEXT.NE.'LZC-GR')CALL XABORT('@LZCDRV: KEYWORD LZC-GR EX' + 1 //'PECTED.') + CALL REDGET(ITYP,LGRP,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER NUMBER OF LZC-GR' + 1 //'OUPS EXPECTED.') + IF(LGRP.LT.1)CALL XABORT('@LZCDRV: WRONG NUMBER OF GROUPS <1') +* CREATE LZC-GROUPS + CALL LZCDGD(IPDEV,NLZC,LGRP,IMPX) +*---- +* STATE-VECTORS +*---- + 50 ISTATE(:NSTATE)=0 + IF(LNEW)THEN + ISTATE(1)=IGEO + ISTATE(4)=NLZC + ISTATE(5)=LGRP + ELSE +* UPDATE DEVICE + CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE) + ISTATE(4)=NLZC + ISTATE(5)=LGRP + ENDIF + CALL LCMPUT(IPDEV,'STATE-VECTOR',NSTATE,1,ISTATE) + IF(IMPX.GT.1)CALL LCMLIB(IPDEV) +* UPDATE MATEX + ISTATE(:NSTATE)=0 + CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE) + ISTATE(2)=NMIX+NLZC*4 + ISTATE(5)=NTOT2 + CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE) + CALL LCMPUT(IPMTX,'MAT',NTOT2,1,MIX) + DEALLOCATE(MIX) + IF(IMPX.EQ.99)THEN +* CHECK NEW COMPUTED VALUES + WRITE(IOUT,*)'OLD VALUES: NMIX=',NMIX,' NTOT=',NTOT + WRITE(IOUT,*)'NEW VALUES: NMIX=',ISTATE(2),' NTOT=',ISTATE(5) + ENDIF + IF(IMPX.GT.5)CALL LCMLIB(IPMTX) + RETURN +* + 1000 FORMAT(/1X,'GIVEN TOTAL NUMBER OF LIQUID ZONE CONTROL', + 1 'LERS: ',I2//1X,'** READING INPUT DATA FOR LZC **') + 1001 FORMAT(/6X,'=>',2X,'LZC #',I2.2) + 1002 FORMAT(/1X,35('-')/1X,'READ TOTAL NUMBER OF LZC: ',I2) + END -- cgit v1.2.3