*DECK TINST
      SUBROUTINE TINST(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* perform computations according to the time-linear model.
*
*Copyright:
* Copyright (C) 2009 Ecole Polytechnique de Montreal
*
*Author(s): B. Toueg, M. Guyot
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): modification type(L_MAP);
*         HENTRY(2): read-only type(L_POWER).
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40,IOUT=6)
      CHARACTER TEXT*12,HSIGN*12,NAMCHA*4,NAMCHA2*4,TEXT12*12
      INTEGER KCHAR(3),IMPX,MSHT,NB,NCH,IMOD,NCOMB,
     +         NF,NX,NY,NZ,MAXS,ITYP,NREG,KREF,I,ISTATE(NSTATE),
     +         LENGT,NS,NSS,NITMA
      DOUBLE PRECISION DFLOT
      LOGICAL LNOTHING,LMIC
      REAL TIME,BURNSTEP,FLOT
      TYPE(C_PTR) IPMAP,IPPOW,IPMIC,IPMIC2,IPMIC3,JPMAP
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDX,NSSV,IXN,IYN,MIX,IVS
      REAL, ALLOCATABLE, DIMENSION(:) :: BUNDPOW,WINT,BS,PS,POW,RFCHAN
*----
*  PARAMETER VALIDATION
*----
      IF((NENTRY.LT.1).AND.(NENTRY.GT.5)) CALL XABORT('@TINST: WRONG '
     +  //'NUMBER OF PARAMETERS')
      IPMAP=C_NULL_PTR
      IPPOW=C_NULL_PTR
      IPMIC=C_NULL_PTR
      IPMIC2=C_NULL_PTR
      IPMIC3=C_NULL_PTR
      IF(JENTRY(1).EQ.0) THEN
        IPMIC=KENTRY(1)
        I=2
        TEXT12=HENTRY(1)
        IF(IENTRY(1).GT.2) CALL XABORT('@TINST: LCM OR XSM OBJECT TYPE'
     +  //' FOR ENTRY='//TEXT12//'.')
      ELSE
        I=1
      ENDIF
      DO IEN=I,NENTRY
        TEXT12=HENTRY(IEN)
        IF(IENTRY(IEN).GT.2) CALL XABORT('@TINST: LCM OR XSM OBJECT TY'
     +  //'PE FOR ENTRY='//TEXT12//'.')
        CALL LCMGET(KENTRY(IEN),'SIGNATURE',KCHAR)
        WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
        IF(HSIGN.EQ.'L_MAP') THEN
          IPMAP=KENTRY(IEN)
          IF(JENTRY(IEN).NE.1) CALL XABORT('@TINST: MODIFICATION MODE '
     +    //'FOR L_MAP EXPECTED')
        ELSEIF(HSIGN.EQ.'L_POWER') THEN
          IPPOW=KENTRY(IEN)
          IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE '
     +    //'FOR L_POWER EXPECTED')
        ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN
          IF(.NOT.C_ASSOCIATED(IPMIC2)) THEN
            IPMIC2=KENTRY(IEN)
            CALL LCMEQU(IPMIC2,IPMIC)
            IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE'
     +      //' FOR SECOND L_LIBRARY EXPECTED')
          ELSE
            IPMIC3=KENTRY(IEN)
            IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE '
     +      //'FOR THIRD L_LIBRARY EXPECTED')
          ENDIF
        ENDIF          
      ENDDO
*----
*  RECOVER INFORMATION
*----
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
      NB=ISTATE(1)
      NCH=ISTATE(2)
      NCOMB=ISTATE(3)
      IMOD=ISTATE(5)
      MAXS=ISTATE(6)
      MSHT=MAXS+1
      NF=ISTATE(7)
      IF(NF.EQ.0) CALL XABORT('@TINST: NO FUEL IN MAP OBJECT.')
*----
*  ONLY TIME INSTANTANEOUS CALCULATIONS IN TINST:
*----
      IF(IMOD.NE.2)
     +    CALL XABORT('@TINST: INST-BURN OPTION '
     + //'SHOULD BE USED IN RESINI.')
      JPMAP=LCMGID(IPMAP,'GEOMAP')
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
      NX=ISTATE(3)
      NY=ISTATE(4)
      NZ=ISTATE(5)
      NREG = ISTATE(6)
*     CHECK EXISTING DATA
      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
        CALL LCMLEN(IPMAP,'BUND-PW',LENGT,ITYP)
        IF(LENGT.EQ.0)CALL XABORT('@TINST: MISSING BUND-PW DATA IN '
     +   //'L_MAP OBJECT.')
      ELSE
        CALL LCMLEN(IPPOW,'POWER-CHAN',LENGT,ITYP)
        IF(LENGT.EQ.0)CALL XABORT('@TINST: MISSING POWER-CHAN DATA I'
     +   //'N L_POWER OBJECT.')
      ENDIF
*----
*  READ INPUT DATA
*----
      IMPX=0
      LNOTHING=.TRUE.
      LMIC=.FALSE.
      TTIME=0.0
      ALLOCATE(RFCHAN(NCH))
      CALL XDRSET(RFCHAN,NCH,0.0)
   2  TIME=0.0
      BURNSTEP=0.0
*     READ KEYWORD
   1  CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@TINST: CHARACTER DATA EXPECTED(1).')
      IF(TEXT.EQ.'EDIT')THEN
*       PRINTING INDEX
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@TINST: INTEGER DATA EXPECTED.')
        IMPX=MAX(0,NITMA)
        GOTO 1
      ELSEIF(TEXT.EQ.'TIME')THEN
*       TIME VALUE
        IF(TIME.NE.0.0)CALL XABORT('@TINST: TIME ALREADY SPECIFIED(1).')
        IF(BURNSTEP.NE.0.0)CALL XABORT('@TINST: BURNSTEP ALREADY //
     +    //SPECIFIED(1).')
        CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@TINST: REAL DATA EXPECTED(1).')
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@TINST: CHARACTER DATA EXPECTED(2).')
        IF(TIME.LT.0.)CALL XABORT('@TINST: EXPECTING REAL > 0 (1).')
        IF(TEXT.EQ.'DAY')THEN
          TIME=TIME
        ELSEIF(TEXT.EQ.'HOUR')THEN
          TIME=TIME/24.
        ELSEIF(TEXT.EQ.'MINUTE')THEN
          TIME=TIME/(24.*60.)
        ELSEIF(TEXT.EQ.'SECOND')THEN
          TIME=TIME/(24.*60.*60.)
        ELSE
          CALL XABORT('@TINST: EXPECTING DAY|HOUR|MINUTE|SECOND.')
        ENDIF
        LNOTHING=.FALSE.
        GOTO 10
      ELSEIF(TEXT.EQ.'BURN-STEP')THEN
*       BURN-STEP
        IF(TIME.NE.0.)CALL XABORT('@TINST: TIME ALREADY SPECIFIED(2).')
        IF(BURNSTEP.NE.0.)CALL XABORT('@TINST: BURNSTEP ALREADY '
     +    //'SPECIFIED(2).')
        CALL REDGET(ITYP,NITMA,BURNSTEP,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@TINST: REAL DATA EXPECTED(2).')
        IF(BURNSTEP.LE.0.)CALL XABORT('@TINST: EXPECTING REAL > 0 (2).')
        LNOTHING=.FALSE.
        GOTO 10
      ELSEIF(TEXT.EQ.'REFUEL')THEN
*      REFUEL
           KREF=1
           LNOTHING=.FALSE.
           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
           IF(ITYP.NE.3)
     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(3).')
           IF(TEXT.EQ.'MICRO') THEN
             LMIC=.TRUE.
             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
           IF(ITYP.NE.3)
     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(4).')
           ENDIF
           IF(TEXT.EQ.'CHAN') THEN
             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
             IF(ITYP.NE.3)
     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(5).')
             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
             IF(ITYP.NE.1)
     +         CALL XABORT('@TINST: INTEGER DATA EXPECTED(2).')
             NS = NITMA
             CALL TINCHA(IPMAP,NCH,IMPX,NAMCHA,TTIME,RFCHAN)
           ELSE
            CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
           ENDIF
       GOTO 20
      ELSEIF(TEXT.EQ.'NEWFUEL')THEN
*      NEWFUEL
           KREF=2
           LNOTHING=.FALSE.
           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
           IF(ITYP.NE.3)
     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(4).')
           IF(TEXT.EQ.'CHAN') THEN
             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
             IF(ITYP.NE.3)
     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(5).')
             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
             IF(ITYP.NE.1)
     +         CALL XABORT('@TINST: INTEGER DATA EXPECTED(3).')
             NS = NITMA
             NSS=ABS(NS)
             ALLOCATE(IDX(NSS))
             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
             IF(ITYP.NE.3)
     +         CALL XABORT('@TINST: CHARACTER DATA EXPECTED(6).')
             IF(TEXT.EQ.'SOME')THEN
                DO 11 I=1,NSS
                 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
                 IF(ITYP.NE.1)
     +             CALL XABORT('@TINST: INTEGER DATA EXPECTED(4).')
                IF (NITMA.GT.NF)
     +             CALL XABORT('@TINST: WRONG NUMBER OF FUEL TYPE. ')
                 IDX(I) = NITMA
 11             CONTINUE
             ELSEIF(TEXT.EQ.'ALL')THEN
                CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
                IF(ITYP.NE.1)
     +             CALL XABORT('@TINST: INTEGER DATA EXPECTED(5).')
                IF (NITMA.GT.NF)
     +             CALL XABORT('@TINST: WRONG NUMBER OF FUEL TYPE. ')
                DO 12 I=1,NSS
                 IDX(I) = NITMA
 12             CONTINUE
             ELSE
               CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
             ENDIF
           ELSE
            CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
           ENDIF
        GOTO 20
*     SHUFFL
      ELSEIF (TEXT.EQ.'SHUFF') THEN
           KREF = 3
           LNOTHING=.FALSE.
           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
           IF(ITYP.NE.3)
     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(7).')
           IF(TEXT.EQ.'CHAN') THEN
             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
             IF(ITYP.NE.3)
     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(8).')
             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
             IF(ITYP.NE.3)
     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(8).')
             IF(TEXT.EQ.'TO') THEN
                CALL REDGET(ITYP,NITMA,FLOT,NAMCHA2,DFLOT)
                IF(ITYP.NE.3)
     +            CALL XABORT('@TINST: CHARACTER DATA EXPECTED(9).')
                IF(IMPX.GT.2)
     +            WRITE(6,*) 'TINST : ACTION ',NAMCHA,' TO ',NAMCHA2
             ELSE
               CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
             ENDIF
           ELSE
             CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
           ENDIF
        GOTO 20
      ELSEIF(TEXT.EQ.';')THEN
        GOTO 30
      ELSE
*       KEYWORD DOES NOT MATCH
        CALL XABORT('@TINST: WRONG KEYWORD: '//TEXT//'.')
      ENDIF
*----
*  PERFORM CALCULATION
*----
   10 ALLOCATE(BUNDPOW(NCH*NB))
      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
        CALL LCMGET(IPMAP,'BUND-PW',BUNDPOW)
      ELSE 
        CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
      ENDIF
      IF(LMIC) CALL XABORT('@TINST: NO MICRO-DEPLETION ')
      TTIME  = TTIME + TIME
      CALL TINSTB(IPMAP,TIME,BURNSTEP,NCH,NB,NF,BUNDPOW,IMPX)
      DEALLOCATE(BUNDPOW)
      GOTO 1
*
   20 CALL LCMSIX(IPMAP,' ',0)
      ALLOCATE(NSSV(NCH))
      CALL LCMLEN(IPMAP,'REF-SCHEME',ILONG,ITYP)
      IF(ILONG.EQ.0) THEN
         DO 25 I=1,NCH
            NSSV(I) = 0
   25    CONTINUE
      ELSEIF(ILONG.NE.NCH) THEN
         CALL XABORT('@TINST: REF-SCHEME HAS NOT THE CORRECT LENGHT')
      ELSE
         CALL LCMGET(IPMAP,'REF-SCHEME',NSSV)
      ENDIF
      CALL LCMSIX(IPMAP,' ',0)
      ALLOCATE(IXN(NX),IYN(NY))
      CALL LCMSIX(IPMAP,' ',0)
      CALL LCMGET(IPMAP,'XNAME',IXN)
      CALL LCMGET(IPMAP,'YNAME',IYN)
      ALLOCATE(WINT(NCH*NB),MIX(NREG),BS(NCH*NB*MSHT),PS(NCH*NB*MSHT),
     1 IVS(NCH*NB*MSHT))
      IF(KREF.EQ.1.OR.KREF.EQ.2) THEN
        IF(KREF.EQ.1) ALLOCATE(IDX(ABS(NS)))
        ALLOCATE(POW(NCH*NB))
        IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
          CALL LCMGET(IPMAP,'BUND-PW',POW)
        ELSE 
          CALL LCMGET(IPPOW,'POWER-BUND',POW)
        ENDIF
        CALL TINREF(IPMAP,IPMIC,IPMIC2,IPMIC3,NCH,NB,NX,NY,NREG,NAMCHA,
     +             NS,MSHT,WINT,MIX,IXN,IYN,BS,PS,IVS,POW,MAXS,NSSV,IDX,
     +             IMPX,KREF,LMIC)
        DEALLOCATE(POW,IDX)
      ELSE
        CALL TINSHU(IPMAP,NCH,NB,NX,NY,NREG,MSHT,NAMCHA,NAMCHA2,
     +     WINT,MIX,BS,PS,IVS,IXN,IYN,IMPX)
      ENDIF
      DEALLOCATE(BS,PS,IVS,MIX)
      DEALLOCATE(WINT)
      DEALLOCATE(NSSV,IXN,IYN)
      MSHT=MAXS+1
      KREF=0
      GOTO 2
*
  30  IF(LNOTHING)CALL XABORT('@TINST: NO OPTION SPECIFIED.')
      CALL LCMSIX(IPMAP,' ',0)
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
      ISTATE(6)=MAXS
      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL LCMPUT(IPMAP,'DEPL-TIME',1,2,TTIME)
      CALL LCMPUT(IPMAP,'REF-CHAN',NCH,2,RFCHAN)
      DEALLOCATE(RFCHAN)
      RETURN
      END
