1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
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
|
