*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