Initial commit from Polytechnique Montreal

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