*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