Initial commit from Polytechnique Montreal

1 files changed, 174 insertions, 0 deletions

diff --git a/Donjon/src/MOVPOS.f b/Donjon/src/MOVPOS.f
new file mode 100644
index 0000000..5c15d6d
--- /dev/null
+++ b/Donjon/src/MOVPOS.f
@@ -0,0 +1,174 @@
+*DECK MOVPOS
+      SUBROUTINE MOVPOS(IPDEV,IMODE,ID,DELT,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read the movement option and displace an individual rod 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).
+* ID     current rod identification number.
+* DELT   time step increment.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER IMODE,ID,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
+*----
+*  RECOVER INFORMATION
+*----
+      JPDEV=LCMGID(IPDEV,'DEV_ROD')
+      KPDEV=LCMGIL(JPDEV,ID)
+*     ROD PARAMETERS
+      CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+      IF(NPART.GT.MAXPRT) CALL XABORT('MOVPOS: MAXPRT OVERFLOW.')
+      CALL LCMGET(KPDEV,'MAX-POS',MAXPOS)
+      CALL LCMLEN(KPDEV,'ROD-POS',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) CALL XABORT('MOVPOS: 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)
+*----
+*  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('@MOVPOS: 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('@MOVPOS: REAL FOR SPEED EXPECTED.')
+        IF(SPEED.LE.0.)CALL XABORT('@MOVPOS: 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('@MOVPOS: REAL FOR DELH EXPECTED.')
+        IF(DELHIN.LE.0.)CALL XABORT('@MOVPOS: 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('@MOVPOS: REAL FOR LEVEL EXPECTED.')
+        IF(LVNEW.GT.1.)CALL XABORT('@MOVPOS: WRONG LEVEL VALUE > 1.')
+        IF(LVNEW.LT.0.)CALL XABORT('@MOVPOS: WRONG LEVEL VALUE < 0.')
+        IOPT=3
+      ELSE
+        WRITE(IOUT,*)'@MOVPOS: WRONG KEYWORD ',TEXT
+        CALL XABORT('@MOVPOS: ROD MOVEMENT OPTION EXPECTED.')
+      ENDIF
+*----
+*  NEW ROD POSITION
+*----
+      IF(IMODE.EQ.1) THEN
+        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
+        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 @MOVPOS: MOVE FROM DELH=,F8.3,3H TO,F8.3)')
+     1  DELH0,DELH
+        CALL XABORT('@MOVPOS: INVALID NEW VALUE OF LEVEL.')
+      ENDIF
+*     PRINT OLD PARAMETERS
+      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
+*     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
+      RETURN
+*
+ 1001 FORMAT(
+     1 /5X,'MOVPOS: PREVIOUS INSERTION LEVEL =',F8.4)
+ 1002 FORMAT(
+     1 /5X,'MOVPOS: 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,'MOVPOS: NEW INSERTION LEVEL =',F8.4)
+      END