*DECK DEVGET
      SUBROUTINE DEVGET(JPDEV,NROD,LIMIT,IMODE,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read the specification for a given rod from the input file.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): 
* D. Sekki and A. Hebert
*
*Parameters: input
* JPDEV  pointer to LCM list object with device information.
* NROD   total number of rods.
* LIMIT  full-core limits.
* IMODE  type of rod movement.
* IMPX   printing index (=0 for no print).
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) JPDEV
      INTEGER NROD,IMODE,IMPX
      REAL LIMIT(6)
*----
*  LOCAL VARIABLES
*----
      PARAMETER(IOUT=6,MAXPRT=10)
      INTEGER DMIX(2,MAXPRT)
      REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LEVEL
      DOUBLE PRECISION DFLOT
      CHARACTER TEXT*12,RNAME*12,AXIS,FROM*2,HSMG*131
      TYPE(C_PTR) KPDEV
*----
*  ROD INDEX
*----
      CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER ROD-ID EXPECTED.')
      IF(ID.LE.0) CALL XABORT('@DEVGET: POSITIVE ROD-ID EXPECTED.')
      IF(ID.GT.NROD)THEN
        WRITE(IOUT,*)'@DEVGET: READ CURRENT ROD-ID #',ID
        WRITE(IOUT,*)'@DEVGET: GIVEN TOTAL NUMBER OF RODS:',NROD
        CALL XABORT('@DEVGET: WRONG INPUT OF ROD-ID NUMBER. GREATER'
     1   //' THAN THE TOTAL NUMBER OF RODS.')
      ENDIF
      CALL LCMLEL(JPDEV,ID,ILONG,ITYLCM)
      IF(ILONG.NE.0) THEN
        WRITE(HSMG,'(18H@DEVGET: ROD INDEX,I5,16H ALREADY EXISTS.)') ID
        CALL XABORT(HSMG)
      ENDIF
      IF(IMPX.GT.1) WRITE(IOUT,1000) ID
      KPDEV=LCMDIL(JPDEV,ID)
*----
*  READ ROD-SPECIFIC DATA
*----
      IAXIS=0
      NPART=0
      ITOP=0
      LEVEL=-999.0
      SPEED=-999.0
      TIME=-999.0
      RNAME='NOT_DEFINED'
      LENG(1)=MAX(LIMIT(2),LIMIT(4),LIMIT(6))
      LENG(2)=MIN(LIMIT(1),LIMIT(3),LIMIT(5))
   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)  CALL XABORT('@DEVGET: CHARECTER NAME EXPECTED.')
      IF(TEXT.EQ.'ROD-NAME') THEN
        CALL REDGET(ITYP,NITMA,FLOT,RNAME,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@DEVGET: ROD NAME EXPECTED.')
      ELSE IF(TEXT.EQ.'LEVEL') THEN
        CALL REDGET(ITYP,NITMA,LEVEL,TEXT,DFLOT)
        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL LEVEL EXPECTED.')
        IF(LEVEL.GT.1.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE > 1.')
        IF(LEVEL.LT.0.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE < 0.')
      ELSE IF(TEXT.EQ.'TIME') THEN
        CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR TIME EXPECTED.')
        IF(TIME.LT.0.0) CALL XABORT('@DEVGET: WRONG TIME VALUE < 0.')
      ELSE IF(TEXT.EQ.'SPEED') THEN
        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR SPEED EXPECTED.')
        IF(SPEED.LT.0.0) CALL XABORT('@DEVGET: WRONG SPEED VALUE < 0.')
      ELSE IF(TEXT.EQ.'AXIS') THEN
        CALL REDGET(ITYP,NITMA,FLOT,AXIS,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@DEVGET: AXIS NAME EXPECTED.')
        IF(AXIS.EQ.'X') THEN
          IAXIS=1
        ELSE IF(AXIS.EQ.'Y') THEN
          IAXIS=2
        ELSE IF(AXIS.EQ.'Z') THEN
          IAXIS=3
        ELSE
          CALL XABORT('@DEVGET: X, Y OR Z EXPECTED FOR AXIS.')
        ENDIF
      ELSE IF(TEXT.EQ.'FROM') THEN
        CALL REDGET(ITYP,NITMA,FLOT,FROM,DFLOT)
        IF(FROM.EQ.'H+')THEN
          ITOP=1
        ELSEIF(FROM.EQ.'H-')THEN
          ITOP=-1
        ELSE
          CALL XABORT('@DEVGET: KEYWORD H+ OR H- EXPECTED.')
        ENDIF
      ELSE IF(TEXT.EQ.'MAXPOS') THEN
        NPART=NPART+1
        IF(NPART.GT.MAXPRT) CALL XABORT('@DEVGET: MAXPRT OVERFLOW.')
        DO I=1,6
          CALL REDGET(ITYP,NITMA,MAXPOS(I,NPART),TEXT,DFLOT)
          IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL POSITION EXPECTED.')
        ENDDO
        IF(MAXPOS(2,NPART).LT.MAXPOS(1,NPART)) THEN
          CALL XABORT('@DEVGET: WRONG X ROD COORDINATES: X- > X+')
        ELSE IF(MAXPOS(1,NPART).LT.LIMIT(1)) THEN
          CALL XABORT('@DEVGET: WRONG X- VALUE.')
        ELSE IF(MAXPOS(2,NPART).GT.LIMIT(2)) THEN
          CALL XABORT('@DEVGET: WRONG X+ VALUE.')
        ELSE IF(MAXPOS(4,NPART).LT.MAXPOS(3,NPART)) THEN
          CALL XABORT('@DEVGET: WRONG Y ROD COORDINATES: Y- > Y+')
        ELSE IF(MAXPOS(3,NPART).LT.LIMIT(3)) THEN
          CALL XABORT('@DEVGET: WRONG Y- VALUE.')
        ELSE IF(MAXPOS(4,NPART).GT.LIMIT(4)) THEN
          CALL XABORT('@DEVGET: WRONG Y+ VALUE.')
        ELSE IF(MAXPOS(6,NPART).LT.MAXPOS(5,NPART)) THEN
          CALL XABORT('@DEVGET: WRONG Z ROD COORDINATES: Z- > Z+')
        ELSE IF(MAXPOS(5,NPART).LT.LIMIT(5)) THEN
          CALL XABORT('@DEVGET: WRONG Z- VALUE.')
        ELSE IF(MAXPOS(6,NPART).GT.LIMIT(6)) THEN
          CALL XABORT('@DEVGET: WRONG Z+ VALUE.')
        ENDIF
        IF(IAXIS.EQ.0) THEN
          WRITE(HSMG,'(33H@DEVGET: MISSING AXIS DATA IN ROD,I5)') ID
          CALL XABORT(HSMG)
        ELSE IF(IAXIS.EQ.1) THEN
          LENG(1)=MIN(LENG(1),MAXPOS(1,NPART))
          LENG(2)=MAX(LENG(2),MAXPOS(2,NPART))
        ELSE IF(IAXIS.EQ.2) THEN
          LENG(1)=MIN(LENG(1),MAXPOS(3,NPART))
          LENG(2)=MAX(LENG(2),MAXPOS(4,NPART))
        ELSE IF(IAXIS.EQ.3) THEN
          LENG(1)=MIN(LENG(1),MAXPOS(5,NPART))
          LENG(2)=MAX(LENG(2),MAXPOS(6,NPART))
        ENDIF
*
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(TEXT.NE.'DMIX') THEN
          WRITE(HSMG,'(30H@DEVGET: DMIX EXPECTED FOR ROD,I5)') ID
          CALL XABORT(HSMG)
        ENDIF
        DO I=1,2
          CALL REDGET(ITYP,DMIX(I,NPART),FLOT,TEXT,DFLOT)
          IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER DMIX EXPECTED.')
        ENDDO
      ELSE IF(TEXT.EQ.'ENDROD') THEN
        GO TO 20
      ELSE
        WRITE(HSMG,'(26H@DEVGET: INVALID KEYWORD (,A,9H) FOR ROD,I5)')
     1  TEXT,ID
        CALL XABORT(HSMG)
      ENDIF
      GO TO 10
*----
*  VALIDATE ROD POSITION
*----
   20 IF(IMPX.GT.1) THEN
        DO 25 IPART=1,NPART
        WRITE(IOUT,1001) RNAME,IPART,MAXPOS(1,IPART),MAXPOS(3,IPART),
     1  MAXPOS(5,IPART),MAXPOS(2,IPART),MAXPOS(4,IPART),MAXPOS(6,IPART)
   25   CONTINUE
      ENDIF
      EPS=1.0E-4*(LENG(2)-LENG(1))
      DO 30 IPART=1,NPART-1
      IF(IAXIS.EQ.1) THEN
        IF((ABS(MAXPOS(1,IPART)-MAXPOS(2,IPART+1)).GT.EPS).AND.
     1     (ABS(MAXPOS(2,IPART)-MAXPOS(1,IPART+1)).GT.EPS)) THEN
          WRITE(HSMG,1008) IPART,ID
          CALL XABORT(HSMG)
        ENDIF
      ELSE IF(IAXIS.EQ.2) THEN
        IF((ABS(MAXPOS(3,IPART)-MAXPOS(4,IPART+1)).GT.EPS).AND.
     1     (ABS(MAXPOS(4,IPART)-MAXPOS(3,IPART+1)).GT.EPS)) THEN
          WRITE(HSMG,1008) IPART,ID
          CALL XABORT(HSMG)
        ENDIF
      ELSE IF(IAXIS.EQ.3) THEN
        IF((ABS(MAXPOS(5,IPART)-MAXPOS(6,IPART+1)).GT.EPS).AND.
     1     (ABS(MAXPOS(6,IPART)-MAXPOS(5,IPART+1)).GT.EPS)) THEN
          WRITE(HSMG,1008) IPART,ID
          CALL XABORT(HSMG)
        ENDIF
      ENDIF
   30 CONTINUE
*----
*  SET CURRENT ROD POSITION
*----
      IF(NPART.EQ.0) THEN
        WRITE(HSMG,'(35H@DEVGET: MISSING MAXPOS DATA IN ROD,I5)') ID
        CALL XABORT(HSMG)
      ELSE IF(ITOP.EQ.0) THEN
        WRITE(HSMG,'(33H@DEVGET: MISSING FROM DATA IN ROD,I5)') ID
        CALL XABORT(HSMG)
      ENDIF
      IF(LEVEL.GE.0.0) THEN
        DO 45 IPART=1,NPART
        DO 40 I=1,6
        RODPOS(I,IPART)=MAXPOS(I,IPART)
   40   CONTINUE
   45   CONTINUE
        IF(IMODE.EQ.1) THEN
*         FADING ROD
          DELH=LEVEL*(LENG(2)-LENG(1))
        ELSE IF(IMODE.EQ.2) THEN
*         MOVING ROD
          IF(ITOP.EQ.-1) THEN
            DELH=LEVEL*(LENG(2)-LIMIT(1))+LIMIT(1)
          ELSE IF(ITOP.EQ.1) THEN
            DELH=LIMIT(2)-LEVEL*(LIMIT(2)-LENG(1))
          ENDIF
          DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
          IF(IMPX.GT.3) THEN
            WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LEVEL*100.,
     1                    '% OF INSERTION'
            WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
          ENDIF
        ENDIF
        CALL MOVCHK(0,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
      ENDIF
*----
*  STORE ROD DATA
*----
      CALL LCMPUT(KPDEV,'ROD-ID',1,1,ID)
      CALL LCMPUT(KPDEV,'ROD-PARTS',1,1,NPART)
      CALL LCMPTC(KPDEV,'ROD-NAME',12,1,RNAME)
      CALL LCMPUT(KPDEV,'FROM',1,1,ITOP)
      CALL LCMPUT(KPDEV,'AXIS',1,1,IAXIS)
      CALL LCMPUT(KPDEV,'LENGTH',2,2,LENG)
      IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'LEVEL',1,2,LEVEL)
      IF(SPEED.GE.0.0) CALL LCMPUT(KPDEV,'SPEED',1,2,SPEED)
      IF(TIME.GE.0.0) CALL LCMPUT(KPDEV,'TIME',1,2,TIME)
      IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'MAX-POS',6*NPART,2,MAXPOS)
      CALL LCMPUT(KPDEV,'ROD-POS',6*NPART,2,RODPOS)
      CALL LCMPUT(KPDEV,'ROD-MIX',2*NPART,1,DMIX)
*
      IF(IMPX.GT.1) THEN
        DO 50 IPART=1,NPART
        WRITE(IOUT,1002) RNAME,IPART,RODPOS(1,IPART),RODPOS(3,IPART),
     1  RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),RODPOS(6,IPART)
   50   CONTINUE
        WRITE(IOUT,1003) LENG(2)-LENG(1),FROM,AXIS
        IF(LEVEL.GE.0.0) WRITE(IOUT,1004) LEVEL
        IF(SPEED.GE.0.0) WRITE(IOUT,1005) SPEED
        IF(TIME.GE.0.0) WRITE(IOUT,1006) TIME
        WRITE(IOUT,1007)
      ENDIF
      RETURN
*
 1000 FORMAT(/3X,'DEVGET: =>',2X,'ROD #',I3.3)
 1001 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
     1   5X,'FULL-INSERTED ROD POSITION :',
     2   4X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
     3  37X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
 1002 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
     1   5X,'CURRENT ROD POSITION :',
     1   5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
     2  32X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
 1003 FORMAT(5X,'ROD LENGTH =',F9.4/
     1  5X,'INSERTION FROM : ',A2,5X,'MOVEMENT AXIS : ',A1)
 1004 FORMAT(5X,'INSERTION LEVEL =',F8.4)
 1005 FORMAT(5X,'INSERTION SPEED =',1X,1P,E10.4)
 1006 FORMAT(5X,'INSERTION TIME  =',1X,1P,E10.4)
 1007 FORMAT(5X,80(1H-)/5X,80(1H-))
 1008 FORMAT(39H@DEVGET: INCORRECT ROD POSITION IN PART,I5,
     1 7H OF ROD,I5)
      END
