*DECK MOVGRP SUBROUTINE MOVGRP(IPDEV,IMODE,IGRP,NDGR,DELT,IMPX) * *----------------------------------------------------------------------- * *Purpose: * Move a group of rod-devices to a new position in the reactor core. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal. * *Author(s): * D. Sekki * *Parameters: input * IPDEV pointer to device information. * IMODE type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type * movement). * IGRP current group number. * DELT time step increment. * IMPX printing index (=0 for no print). * *Parameters: output * NDGR number of rods in the current group. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPDEV INTEGER IMODE,IGRP,NDGR,IMPX REAL DELT *---- * LOCAL VARIABLES *---- PARAMETER(IOUT=6,MAXPRT=10) REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LVOLD,LVNEW, 1 LIMIT(6) CHARACTER TEXT*12 DOUBLE PRECISION DFLOT TYPE(C_PTR) JPDEV,KPDEV INTEGER, ALLOCATABLE, DIMENSION(:) :: IDEV *---- * READ MOVEMENT DIRECTION *---- MOVE=0 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) IF(TEXT.EQ.'INSR')THEN MOVE=1 ELSEIF(TEXT.EQ.'EXTR')THEN MOVE=-1 ELSE CALL XABORT('@MOVGRP: KEYWORD INSR OR EXTR EXPECTED.') ENDIF *---- * READ MOVEMENT OPTION *---- LVNEW=0. IOPT=0 DELHIN=0.0 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) IF(TEXT.EQ.'SPEED') THEN CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT) IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR SPEED EXPECTED.') IF(SPEED.LE.0.)CALL XABORT('@MOVGRP: SPEED VALUE MUST BE > 0.') IOPT=1 ELSEIF(TEXT.EQ.'DELH') THEN CALL REDGET(ITYP,NITMA,DELHIN,TEXT,DFLOT) IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR DELH EXPECTED.') IF(DELHIN.LE.0.)CALL XABORT('@MOVGRP: DELH VALUE MUST BE > 0.') IOPT=2 ELSEIF(TEXT.EQ.'LEVEL') THEN CALL REDGET(ITYP,NITMA,LVNEW,TEXT,DFLOT) IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR LEVEL EXPECTED.') IF(LVNEW.GT.1.)CALL XABORT('@MOVGRP: WRONG LEVEL VALUE > 1.') IF(LVNEW.LT.0.)CALL XABORT('@MOVGRP: WRONG LEVEL VALUE < 0.') IOPT=3 ELSE WRITE(IOUT,*)'@MOVGRP: WRONG KEYWORD : ',TEXT CALL XABORT('@MOVGRP: ROD MOVEMENT OPTION EXPECTED.') ENDIF *---- * RECOVER GROUP INFORMATION *---- JPDEV=LCMGID(IPDEV,'ROD_GROUP') KPDEV=LCMGIL(JPDEV,IGRP) * GROUP DATA CALL LCMGET(KPDEV,'NUM-ROD',NDGR) ALLOCATE(IDEV(NDGR)) IDEV(:NDGR)=0 CALL LCMGET(KPDEV,'ROD-ID',IDEV) *---- * MOVE ROD-DEVICES *---- DO I=1,NDGR ID=IDEV(I) * ROD PARAMETERS JPDEV=LCMGID(IPDEV,'DEV_ROD') KPDEV=LCMGIL(JPDEV,ID) CALL LCMGET(KPDEV,'ROD-PARTS',NPART) IF(NPART.GT.MAXPRT) CALL XABORT('MOVGRP: MAXPRT OVERFLOW.') CALL LCMGET(KPDEV,'MAX-POS',MAXPOS) CALL LCMLEN(KPDEV,'ROD-POS',ILONG,ITYLCM) IF(ILONG.EQ.0) CALL XABORT('MOVGRP: UNDEFINED ROD POSITION.') CALL LCMGET(KPDEV,'ROD-POS',RODPOS) CALL LCMGET(KPDEV,'LENGTH',LENG) CALL LCMGET(KPDEV,'LEVEL',LVOLD) CALL LCMGET(KPDEV,'AXIS',IAXIS) CALL LCMGET(KPDEV,'FROM',ITOP) * PRINT OLD PARAMETERS IF(IMPX.GT.1) WRITE(IOUT,1000) ID IF(IMPX.GT.2) THEN WRITE(IOUT,1001) LVOLD DO 10 IPART=1,NPART WRITE(IOUT,1002) IPART,RODPOS(1,IPART),RODPOS(3,IPART), 1 RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART), 2 RODPOS(6,IPART) 10 CONTINUE ENDIF * UPDATE POSITION IF(IMODE.EQ.1) THEN * FADING ROD DELH0=LVOLD*(LENG(2)-LENG(1)) IF(IOPT.EQ.1)THEN DELH=MIN(DELH0+MOVE*SPEED*DELT,LENG(2)-LENG(1)) ELSE IF(IOPT.EQ.2)THEN DELH=MIN(DELH0+MOVE*DELHIN,LENG(2)-LENG(1)) ELSE IF(IOPT.EQ.3)THEN DELH=LVNEW*(LENG(2)-LENG(1)) ENDIF LVNEW=DELH/(LENG(2)-LENG(1)) ELSE IF(IMODE.EQ.2) THEN * MOVING ROD CALL LCMGET(IPDEV,'CORE-LIMITS',LIMIT) IF(ITOP.EQ.-1) THEN DELH0=LVOLD*(LENG(2)-LIMIT(1))+LIMIT(1) IF(IOPT.EQ.1)THEN DELH=DELH0+MOVE*SPEED*DELT ELSE IF(IOPT.EQ.2)THEN DELH=DELH0+MOVE*DELHIN ELSE IF(IOPT.EQ.3)THEN DELH=LVNEW*(LENG(2)-LIMIT(1))+LIMIT(1) ENDIF DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH)) LVNEW=(DELH-LIMIT(1))/(LENG(2)-LIMIT(1)) ELSE IF(ITOP.EQ.1) THEN DELH0=LIMIT(2)-LVOLD*(LIMIT(2)-LENG(1)) IF(IOPT.EQ.1)THEN DELH=DELH0-MOVE*SPEED*DELT ELSE IF(IOPT.EQ.2)THEN DELH=DELH0-MOVE*DELHIN ELSE IF(IOPT.EQ.3)THEN DELH=LIMIT(2)-LVNEW*(LIMIT(2)-LENG(1)) ENDIF DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH)) LVNEW=(LIMIT(2)-DELH)/(LIMIT(2)-LENG(1)) ENDIF IF(IMPX.GT.3) THEN WRITE(IOUT,*) ' ADJ ',NXSEQ,' LEVEL ',LVNEW*100., 1 '% OF INSERTION' WRITE(IOUT,*) ' NEW POSITION (L_sup)= ',DELH ENDIF ENDIF IF((LVNEW.LT.0.0).OR.(LVNEW.GT.1.0)) THEN WRITE(IOUT,'(/25H @MOVGRP: MOVE FROM DELH=,F8.3,3H TO,F8.3)') 1 DELH0,DELH CALL XABORT('@MOVGRP: INVALID NEW VALUE OF LEVEL.') ENDIF * SET NEW POSITION CALL LCMGET(KPDEV,'MAX-POS',RODPOS) CALL MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS) * STORE NEW PARAMETERS CALL LCMPUT(KPDEV,'ROD-POS',6,2,RODPOS) CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW) * PRINT UPDATED LEVEL IF(IMPX.GT.1) WRITE(IOUT,1003) LVNEW * PROCEED NEXT ROD ENDDO DEALLOCATE(IDEV) RETURN * 1000 FORMAT(/5X,' MOVGRP: => MOVING ROD #',I3.3) 1001 FORMAT( 1 /5X,'MOVGRP:PREVIOUS INSERTION LEVEL =',F8.4) 1002 FORMAT( 1 /5X,'MOVGRP:PART =',I5/ 2 5X,'PREVIOUS ROD POSITION :'/ 3 5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/ 4 5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4) 1003 FORMAT( 1 /5X,'MOVGRP:NEW INSERTION LEVEL =',F8.4) END