diff options
Diffstat (limited to 'Donjon/src/MOVGRP.f')
| -rw-r--r-- | Donjon/src/MOVGRP.f | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/Donjon/src/MOVGRP.f b/Donjon/src/MOVGRP.f new file mode 100644 index 0000000..2722369 --- /dev/null +++ b/Donjon/src/MOVGRP.f @@ -0,0 +1,194 @@ +*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 |