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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
*DECK DEVGET
SUBROUTINE DEVGET(JPDEV,NROD,LIMIT,IMODE,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read the specification for a given rod from the input file.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* D. Sekki and A. Hebert
*
*Parameters: input
* JPDEV pointer to LCM list object with device information.
* NROD total number of rods.
* LIMIT full-core limits.
* IMODE type of rod movement.
* IMPX printing index (=0 for no print).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) JPDEV
INTEGER NROD,IMODE,IMPX
REAL LIMIT(6)
*----
* LOCAL VARIABLES
*----
PARAMETER(IOUT=6,MAXPRT=10)
INTEGER DMIX(2,MAXPRT)
REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LEVEL
DOUBLE PRECISION DFLOT
CHARACTER TEXT*12,RNAME*12,AXIS,FROM*2,HSMG*131
TYPE(C_PTR) KPDEV
*----
* ROD INDEX
*----
CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER ROD-ID EXPECTED.')
IF(ID.LE.0) CALL XABORT('@DEVGET: POSITIVE ROD-ID EXPECTED.')
IF(ID.GT.NROD)THEN
WRITE(IOUT,*)'@DEVGET: READ CURRENT ROD-ID #',ID
WRITE(IOUT,*)'@DEVGET: GIVEN TOTAL NUMBER OF RODS:',NROD
CALL XABORT('@DEVGET: WRONG INPUT OF ROD-ID NUMBER. GREATER'
1 //' THAN THE TOTAL NUMBER OF RODS.')
ENDIF
CALL LCMLEL(JPDEV,ID,ILONG,ITYLCM)
IF(ILONG.NE.0) THEN
WRITE(HSMG,'(18H@DEVGET: ROD INDEX,I5,16H ALREADY EXISTS.)') ID
CALL XABORT(HSMG)
ENDIF
IF(IMPX.GT.1) WRITE(IOUT,1000) ID
KPDEV=LCMDIL(JPDEV,ID)
*----
* READ ROD-SPECIFIC DATA
*----
IAXIS=0
NPART=0
ITOP=0
LEVEL=-999.0
SPEED=-999.0
TIME=-999.0
RNAME='NOT_DEFINED'
LENG(1)=MAX(LIMIT(2),LIMIT(4),LIMIT(6))
LENG(2)=MIN(LIMIT(1),LIMIT(3),LIMIT(5))
10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(ITYP.NE.3) CALL XABORT('@DEVGET: CHARECTER NAME EXPECTED.')
IF(TEXT.EQ.'ROD-NAME') THEN
CALL REDGET(ITYP,NITMA,FLOT,RNAME,DFLOT)
IF(ITYP.NE.3)CALL XABORT('@DEVGET: ROD NAME EXPECTED.')
ELSE IF(TEXT.EQ.'LEVEL') THEN
CALL REDGET(ITYP,NITMA,LEVEL,TEXT,DFLOT)
IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL LEVEL EXPECTED.')
IF(LEVEL.GT.1.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE > 1.')
IF(LEVEL.LT.0.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE < 0.')
ELSE IF(TEXT.EQ.'TIME') THEN
CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR TIME EXPECTED.')
IF(TIME.LT.0.0) CALL XABORT('@DEVGET: WRONG TIME VALUE < 0.')
ELSE IF(TEXT.EQ.'SPEED') THEN
CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR SPEED EXPECTED.')
IF(SPEED.LT.0.0) CALL XABORT('@DEVGET: WRONG SPEED VALUE < 0.')
ELSE IF(TEXT.EQ.'AXIS') THEN
CALL REDGET(ITYP,NITMA,FLOT,AXIS,DFLOT)
IF(ITYP.NE.3)CALL XABORT('@DEVGET: AXIS NAME EXPECTED.')
IF(AXIS.EQ.'X') THEN
IAXIS=1
ELSE IF(AXIS.EQ.'Y') THEN
IAXIS=2
ELSE IF(AXIS.EQ.'Z') THEN
IAXIS=3
ELSE
CALL XABORT('@DEVGET: X, Y OR Z EXPECTED FOR AXIS.')
ENDIF
ELSE IF(TEXT.EQ.'FROM') THEN
CALL REDGET(ITYP,NITMA,FLOT,FROM,DFLOT)
IF(FROM.EQ.'H+')THEN
ITOP=1
ELSEIF(FROM.EQ.'H-')THEN
ITOP=-1
ELSE
CALL XABORT('@DEVGET: KEYWORD H+ OR H- EXPECTED.')
ENDIF
ELSE IF(TEXT.EQ.'MAXPOS') THEN
NPART=NPART+1
IF(NPART.GT.MAXPRT) CALL XABORT('@DEVGET: MAXPRT OVERFLOW.')
DO I=1,6
CALL REDGET(ITYP,NITMA,MAXPOS(I,NPART),TEXT,DFLOT)
IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL POSITION EXPECTED.')
ENDDO
IF(MAXPOS(2,NPART).LT.MAXPOS(1,NPART)) THEN
CALL XABORT('@DEVGET: WRONG X ROD COORDINATES: X- > X+')
ELSE IF(MAXPOS(1,NPART).LT.LIMIT(1)) THEN
CALL XABORT('@DEVGET: WRONG X- VALUE.')
ELSE IF(MAXPOS(2,NPART).GT.LIMIT(2)) THEN
CALL XABORT('@DEVGET: WRONG X+ VALUE.')
ELSE IF(MAXPOS(4,NPART).LT.MAXPOS(3,NPART)) THEN
CALL XABORT('@DEVGET: WRONG Y ROD COORDINATES: Y- > Y+')
ELSE IF(MAXPOS(3,NPART).LT.LIMIT(3)) THEN
CALL XABORT('@DEVGET: WRONG Y- VALUE.')
ELSE IF(MAXPOS(4,NPART).GT.LIMIT(4)) THEN
CALL XABORT('@DEVGET: WRONG Y+ VALUE.')
ELSE IF(MAXPOS(6,NPART).LT.MAXPOS(5,NPART)) THEN
CALL XABORT('@DEVGET: WRONG Z ROD COORDINATES: Z- > Z+')
ELSE IF(MAXPOS(5,NPART).LT.LIMIT(5)) THEN
CALL XABORT('@DEVGET: WRONG Z- VALUE.')
ELSE IF(MAXPOS(6,NPART).GT.LIMIT(6)) THEN
CALL XABORT('@DEVGET: WRONG Z+ VALUE.')
ENDIF
IF(IAXIS.EQ.0) THEN
WRITE(HSMG,'(33H@DEVGET: MISSING AXIS DATA IN ROD,I5)') ID
CALL XABORT(HSMG)
ELSE IF(IAXIS.EQ.1) THEN
LENG(1)=MIN(LENG(1),MAXPOS(1,NPART))
LENG(2)=MAX(LENG(2),MAXPOS(2,NPART))
ELSE IF(IAXIS.EQ.2) THEN
LENG(1)=MIN(LENG(1),MAXPOS(3,NPART))
LENG(2)=MAX(LENG(2),MAXPOS(4,NPART))
ELSE IF(IAXIS.EQ.3) THEN
LENG(1)=MIN(LENG(1),MAXPOS(5,NPART))
LENG(2)=MAX(LENG(2),MAXPOS(6,NPART))
ENDIF
*
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(TEXT.NE.'DMIX') THEN
WRITE(HSMG,'(30H@DEVGET: DMIX EXPECTED FOR ROD,I5)') ID
CALL XABORT(HSMG)
ENDIF
DO I=1,2
CALL REDGET(ITYP,DMIX(I,NPART),FLOT,TEXT,DFLOT)
IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER DMIX EXPECTED.')
ENDDO
ELSE IF(TEXT.EQ.'ENDROD') THEN
GO TO 20
ELSE
WRITE(HSMG,'(26H@DEVGET: INVALID KEYWORD (,A,9H) FOR ROD,I5)')
1 TEXT,ID
CALL XABORT(HSMG)
ENDIF
GO TO 10
*----
* VALIDATE ROD POSITION
*----
20 IF(IMPX.GT.1) THEN
DO 25 IPART=1,NPART
WRITE(IOUT,1001) RNAME,IPART,MAXPOS(1,IPART),MAXPOS(3,IPART),
1 MAXPOS(5,IPART),MAXPOS(2,IPART),MAXPOS(4,IPART),MAXPOS(6,IPART)
25 CONTINUE
ENDIF
EPS=1.0E-4*(LENG(2)-LENG(1))
DO 30 IPART=1,NPART-1
IF(IAXIS.EQ.1) THEN
IF((ABS(MAXPOS(1,IPART)-MAXPOS(2,IPART+1)).GT.EPS).AND.
1 (ABS(MAXPOS(2,IPART)-MAXPOS(1,IPART+1)).GT.EPS)) THEN
WRITE(HSMG,1008) IPART,ID
CALL XABORT(HSMG)
ENDIF
ELSE IF(IAXIS.EQ.2) THEN
IF((ABS(MAXPOS(3,IPART)-MAXPOS(4,IPART+1)).GT.EPS).AND.
1 (ABS(MAXPOS(4,IPART)-MAXPOS(3,IPART+1)).GT.EPS)) THEN
WRITE(HSMG,1008) IPART,ID
CALL XABORT(HSMG)
ENDIF
ELSE IF(IAXIS.EQ.3) THEN
IF((ABS(MAXPOS(5,IPART)-MAXPOS(6,IPART+1)).GT.EPS).AND.
1 (ABS(MAXPOS(6,IPART)-MAXPOS(5,IPART+1)).GT.EPS)) THEN
WRITE(HSMG,1008) IPART,ID
CALL XABORT(HSMG)
ENDIF
ENDIF
30 CONTINUE
*----
* SET CURRENT ROD POSITION
*----
IF(NPART.EQ.0) THEN
WRITE(HSMG,'(35H@DEVGET: MISSING MAXPOS DATA IN ROD,I5)') ID
CALL XABORT(HSMG)
ELSE IF(ITOP.EQ.0) THEN
WRITE(HSMG,'(33H@DEVGET: MISSING FROM DATA IN ROD,I5)') ID
CALL XABORT(HSMG)
ENDIF
IF(LEVEL.GE.0.0) THEN
DO 45 IPART=1,NPART
DO 40 I=1,6
RODPOS(I,IPART)=MAXPOS(I,IPART)
40 CONTINUE
45 CONTINUE
IF(IMODE.EQ.1) THEN
* FADING ROD
DELH=LEVEL*(LENG(2)-LENG(1))
ELSE IF(IMODE.EQ.2) THEN
* MOVING ROD
IF(ITOP.EQ.-1) THEN
DELH=LEVEL*(LENG(2)-LIMIT(1))+LIMIT(1)
ELSE IF(ITOP.EQ.1) THEN
DELH=LIMIT(2)-LEVEL*(LIMIT(2)-LENG(1))
ENDIF
DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
IF(IMPX.GT.3) THEN
WRITE(IOUT,*) ' ADJ ',NXSEQ,' LEVEL ',LEVEL*100.,
1 '% OF INSERTION'
WRITE(IOUT,*) ' NEW POSITION (L_sup)= ',DELH
ENDIF
ENDIF
CALL MOVCHK(0,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
ENDIF
*----
* STORE ROD DATA
*----
CALL LCMPUT(KPDEV,'ROD-ID',1,1,ID)
CALL LCMPUT(KPDEV,'ROD-PARTS',1,1,NPART)
CALL LCMPTC(KPDEV,'ROD-NAME',12,RNAME)
CALL LCMPUT(KPDEV,'FROM',1,1,ITOP)
CALL LCMPUT(KPDEV,'AXIS',1,1,IAXIS)
CALL LCMPUT(KPDEV,'LENGTH',2,2,LENG)
IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'LEVEL',1,2,LEVEL)
IF(SPEED.GE.0.0) CALL LCMPUT(KPDEV,'SPEED',1,2,SPEED)
IF(TIME.GE.0.0) CALL LCMPUT(KPDEV,'TIME',1,2,TIME)
IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'MAX-POS',6*NPART,2,MAXPOS)
CALL LCMPUT(KPDEV,'ROD-POS',6*NPART,2,RODPOS)
CALL LCMPUT(KPDEV,'ROD-MIX',2*NPART,1,DMIX)
*
IF(IMPX.GT.1) THEN
DO 50 IPART=1,NPART
WRITE(IOUT,1002) RNAME,IPART,RODPOS(1,IPART),RODPOS(3,IPART),
1 RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),RODPOS(6,IPART)
50 CONTINUE
WRITE(IOUT,1003) LENG(2)-LENG(1),FROM,AXIS
IF(LEVEL.GE.0.0) WRITE(IOUT,1004) LEVEL
IF(SPEED.GE.0.0) WRITE(IOUT,1005) SPEED
IF(TIME.GE.0.0) WRITE(IOUT,1006) TIME
WRITE(IOUT,1007)
ENDIF
RETURN
*
1000 FORMAT(/3X,'DEVGET: =>',2X,'ROD #',I3.3)
1001 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
1 5X,'FULL-INSERTED ROD POSITION :',
2 4X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
3 37X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
1002 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
1 5X,'CURRENT ROD POSITION :',
1 5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
2 32X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
1003 FORMAT(5X,'ROD LENGTH =',F9.4/
1 5X,'INSERTION FROM : ',A2,5X,'MOVEMENT AXIS : ',A1)
1004 FORMAT(5X,'INSERTION LEVEL =',F8.4)
1005 FORMAT(5X,'INSERTION SPEED =',1P,E11.4)
1006 FORMAT(5X,'INSERTION TIME =',1P,E11.4)
1007 FORMAT(5X,80(1H-)/5X,80(1H-))
1008 FORMAT(39H@DEVGET: INCORRECT ROD POSITION IN PART,I5,
1 7H OF ROD,I5)
END
|
