*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