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 --- Trivac/src/KINRD2.f | 210 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 210 insertions(+) create mode 100755 Trivac/src/KINRD2.f (limited to 'Trivac/src/KINRD2.f') diff --git a/Trivac/src/KINRD2.f b/Trivac/src/KINRD2.f new file mode 100755 index 0000000..bff9fe0 --- /dev/null +++ b/Trivac/src/KINRD2.f @@ -0,0 +1,210 @@ +*DECK KINRD2 + SUBROUTINE KINRD2(NEN,KEN,CMODUL) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Read and validate the module options from the input file. +* +*Copyright: +* Copyright (C) 2008 Ecole Polytechnique de Montreal. +* +*Author(s): D. Sekki +* +*Parameters: input/output +* NEN number of LCM objects used in the module. +* KEN addresses of LCM objects: (1) L_KINET; (2) L_MACROLIB; +* (3) L_TRACK; (4) L_SYSTEM; (5) L_MACROLIB. +* CMODUL name of the assembly door ('BIVAC' or 'TRIVAC'). +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NEN + TYPE(C_PTR) KEN(NEN) + CHARACTER CMODUL*12 +*---- +* LOCAL VARIABLES +*---- + PARAMETER(NSTATE=40,IOS=6) + INTEGER ISTATE(NSTATE) + REAL EPSCON(5),POWTOT + CHARACTER TEXT*12,FNAM*40,PNAM*40 + DOUBLE PRECISION DFLOT + LOGICAL ADJ +*---- +* READ THE INPUT DATA +*---- + CALL LCMGET(KEN(1),'STATE-VECTOR',ISTATE) + ITR=ISTATE(1) + IMPX=1 + IMPH=0 + DELT=0.0 + IPICK=0 + IEXP=0 + ADJ=.FALSE. + IF(ITR.EQ.0) THEN + ICL1=3 + ICL2=3 + MAXINR=0 + MAXOUT=200 + NADI=2 + IFL=0 + IPR=0 + EPSINR=1.0E-2 + EPSOUT=1.0E-4 + TTF=9999.0 + TTP=9999.0 + IF(CMODUL.EQ.'TRIVAC') THEN + CALL LCMGET(KEN(3),'STATE-VECTOR',ISTATE) + NADI=ISTATE(33) + ELSE + NADI=2 + ENDIF + ELSE + ICL1=ISTATE(11) + ICL2=ISTATE(12) + MAXINR=ISTATE(14) + MAXOUT=ISTATE(15) + NADI=ISTATE(16) + IFL=ISTATE(17) + IPR=ISTATE(18) + IEXP=ISTATE(19) + ADJ=ISTATE(20).EQ.1 + CALL LCMGET(KEN(1),'EPS-CONVERGE',EPSCON) + EPSINR=EPSCON(1) + EPSOUT=EPSCON(2) + TTF=EPSCON(3) + TTP=EPSCON(4) + ENDIF + 40 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + 50 IF(ITYP.NE.3)CALL XABORT('@KINRD2: CHARACTER DATA EXPECTED(1).') + IF(TEXT.EQ.';')THEN + GOTO 80 + ELSE IF(TEXT.EQ.'PICK') THEN + IPICK=1 + GOTO 80 + ELSEIF(TEXT.EQ.'EDIT') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1)CALL XABORT('@KINRD2: INTEGER FOR EDIT EXPECTED.') + IMPX=MAX(0,NITMA) + IF(IMPX.GT.4) WRITE(IOS,1001) + ELSEIF(TEXT.EQ.'DELTA') THEN + CALL REDGET(ITYP,NITMA,DELT,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD2: REAL FOR DELTA EXPECTED.') + IF(DELT.LT.0.)CALL XABORT('@KINRD2: INVALID VALUE FOR DELTA.') + ELSEIF(TEXT.EQ.'SCHEME') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@KINRD2: CHARACTER DATA EXPECTED(2).') + IF(TEXT.NE.'FLUX')CALL XABORT('@KINRD2: READ KEYWORD '//TEXT// + 1 '. KEYWORD FLUX EXPECTED.') + 55 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@KINRD2: CHARACTER DATA EXPECTED(3).') + IF(TEXT.EQ.'IMPLIC')THEN + FNAM='IMPLICIT EULER METHOD' + IFL=1 + ELSEIF(TEXT.EQ.'CRANK')THEN + FNAM='CRANK-NICHOLSON METHOD' + IFL=2 + ELSEIF(TEXT.EQ.'THETA')THEN + CALL REDGET(ITYP,NITMA,TTF,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD2: REAL THETA EXPECTED(1).') + IF(TTF.LE.0.5)CALL XABORT('@KINRD2: INVALID THETA VALUE(1).') + IF(TTF.GE.1.0)CALL XABORT('@KINRD2: INVALID THETA VALUE(2).') + FNAM='GENERAL THETA METHOD' + IFL=3 + ELSEIF(TEXT.EQ.'TEXP')THEN + IEXP=1 + GO TO 55 + ELSE + CALL XABORT('@KINRD2: INVALID KEYWORD '//TEXT) + ENDIF + ELSEIF(TEXT.EQ.'PREC') THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@KINRD2: CHARACTER DATA EXPECTED(4).') + IF(TEXT.EQ.'IMPLIC')THEN + PNAM='IMPLICIT EULER METHOD' + IPR=1 + ELSEIF(TEXT.EQ.'CRANK')THEN + PNAM='CRANK-NICHOLSON METHOD' + IPR=2 + ELSEIF(TEXT.EQ.'THETA')THEN + CALL REDGET(ITYP,NITMA,TTP,TEXT,DFLOT) + IF(ITYP.NE.2)CALL XABORT('@KINRD2: REAL THETA EXPECTED(2).') + IF(TTP.LE.0.5)CALL XABORT('@KINRD2: INVALID THETA VALUE(3).') + IF(TTP.GE.1.0)CALL XABORT('@KINRD2: INVALID THETA VALUE(4).') + PNAM='GENERAL THETA METHOD' + IPR=3 + ELSEIF(TEXT.EQ.'EXPON')THEN + PNAM='ANALYTICAL INTEGRATION METHOD' + IPR=4 + ELSE + CALL XABORT('@KINRD2: INVALID KEYWORD '//TEXT) + ENDIF + ELSEIF((TEXT.EQ.'VAR1').OR.(TEXT.EQ.'ACCE')) THEN + CALL REDGET(ITYP,ICL1,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1) + 1 CALL XABORT('@KINRD2: INTEGER DATA EXPECTED FOR ICL1.') + CALL REDGET(ITYP,ICL2,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1) + 1 CALL XABORT('@KINRD2: INTEGER DATA EXPECTED FOR ICL2.') + ELSEIF(TEXT.EQ.'ADI') THEN + CALL REDGET(ITYP,NADI,FLOTT,TEXT,DFLOT) + IF(ITYP.NE.1) CALL XABORT('@KINRD2: INTEGER DATA EXPECTED(1).') + GO TO 40 + ELSE IF(TEXT.EQ.'ADJ') THEN + ADJ=.TRUE. + ELSEIF(TEXT.EQ.'EXTE') THEN + 60 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.EQ.1) THEN + MAXOUT=NITMA + ELSE IF(ITYP.EQ.2) THEN + EPSOUT=FLOT + ELSE + GO TO 50 + ENDIF + GO TO 60 + ELSEIF(TEXT.EQ.'THER') THEN + 70 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.EQ.1) THEN + MAXINR=NITMA + ELSE IF(ITYP.EQ.2) THEN + EPSINR=FLOT + ELSE + GO TO 50 + ENDIF + GO TO 70 + ELSEIF(TEXT.EQ.'HIST') THEN + CALL REDGET(ITYP,IMPH,FLOT,TEXT,DFLOT) + IF(ITYP.NE.1) CALL XABORT('@KINRD2: INTEGER DATA EXPECTED(2).') + ELSE + CALL XABORT('@KINRD2: INVALID KEYWORD '//TEXT) + ENDIF + GOTO 40 + 80 IF(IFL.EQ.0) CALL XABORT('@KINRD2: SCHEME DATA MISSING.') + IF(IPR.EQ.0) CALL XABORT('@KINRD2: PREC DATA MISSING.') + IF(IMPX.GT.0) WRITE(IOS,1002) ITR+1 + CALL KINST2(NEN,KEN,CMODUL,TTF,TTP,IFL,IPR,IEXP,DELT,IMPH,ICL1, + 1 ICL2,NADI,ADJ,MAXOUT,EPSOUT,MAXINR,EPSINR,FNAM,PNAM,IMPX,POWTOT) +*---- +* RECOVER THE FINAL POWER AND SAVE IT IN A CLE-2000 VARIABLE +*---- + IF(IPICK.EQ.1) THEN + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(ITYP.NE.-2) CALL XABORT('KINRD2: OUTPUT REAL EXPECTED.') + ITYP=2 + FLOT=POWTOT + CALL REDPUT(ITYP,NITMA,FLOT,TEXT,DFLOT) + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF((ITYP.NE.3).OR.(TEXT.NE.';')) THEN + CALL XABORT('KINRD2: ; CHARACTER EXPECTED.') + ENDIF + ENDIF + RETURN +* + 1001 FORMAT(/1X,'KINRD2: READING DATA FROM INPUT FILE'/) + 1002 FORMAT(1X,'KINRD2: THE INPUT DATA HAVE BEEN READ AT STEP',I5,'.') + END -- cgit v1.2.3