*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
      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,DELH,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR DELH EXPECTED.')
        IF(DELH.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))
      CALL XDISET(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,'LENG',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*DELH,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*DELH
            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*DELH
            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
