Initial commit from Polytechnique Montreal

1 files changed, 454 insertions, 0 deletions

diff --git a/Donjon/src/TINST.f b/Donjon/src/TINST.f
new file mode 100644
index 0000000..7ee314c
--- /dev/null
+++ b/Donjon/src/TINST.f
@@ -0,0 +1,454 @@
+*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
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The TINST: module specification is:
+* Option 1
+* FMAP := TINST: FMAP [ POWER ] :: (desctinst) ;
+* Option 2  
+* MICLIB3 FMAP := TINST: FMAP MICLIB2 MICLIB :: (desctinst) ;
+* where
+*   FMAP : name of a \emph{fmap} object, that will be updated by the TINST: 
+*     module. The FMAP object must contain the instantaneous burnups for each 
+*     fuel bundle and the weight of each fuel mixture.
+*   POWER : name of a \emph{power} object containing the channel and bundle 
+*     powers, previously computed by the FLPOW: module. The channel and bundle 
+*     powers are used by the TINST: module to compute the new burn-up of each 
+*     bundle. If bundle-powers are previously specified with the module RESINI:,
+*     you can refuel your core without a POWER object.
+*   MICLIB3 : name of a \emph{library} object, that will be created by the 
+*     TINST: module. This \emph{MICROLIB} contains the fuel properties after 
+*     refueling when keyword MICRO is used in (desctinst).
+* 
+*   MICLIB2 : name of a \emph{library} object, that will be read by the TINST: 
+*     module. This must be a fuel-map LIBRARY created either created by the 
+*     NCR: or the EVO: module.
+*   MICLIB : name of a \emph{library} object, that will be read by the TINST: 
+*     module. This \emph{MICROLIB} contains the new fuel properties, that 
+*     should be used for the refueling.
+*   (desctinst) : structure describing the input data to the TINST: module.
+*
+*-----------------------------------------------------------------------
+*
+      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*8,NAMCHA2*8,TEXT12*12
+      INTEGER 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,KPMAP,LPMAP,
+     +            MPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDX,NSSV,IXN,IYN,MIX,IVS
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHN
+      REAL, ALLOCATABLE, DIMENSION(:) :: BUNDPOW,WINT,BS,PS,POW,RFCHAN,
+     + BURNINST
+*----
+*  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 LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
+        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
+*----
+      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)
+      NPARM=ISTATE(8)
+      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')
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(1)
+      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))
+      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.'PICK') THEN
+*       RECOVER THE BURNUP AND SAVE IT IN A CLE-2000 VARIABLE
+        IF(IMPX.GT.2) WRITE(IOUT,40) BURNAVG
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.-2) CALL XABORT('TINST: OUTPUT REAL EXPECTED.')
+        ITYP=2
+        CALL REDPUT(ITYP,NITMA,BURNAVG,TEXT,DFLOT)
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF((ITYP.NE.3).OR.(TEXT.NE.';')) THEN
+          CALL XABORT('TINST: ; CHARACTER EXPECTED.')
+        ENDIF      
+        GOTO 30
+      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
+      ALLOCATE(BURNINST(NCH*NB))
+      CALL TINSTB(IPMAP,TIME,BURNSTEP,NCH,NB,NF,BUNDPOW,BURNAVG,
+     1 BURNINST,IMPX)
+*----
+*  SAVE LOCAL PARAMETERS FOR HISTORICAL FOLLOW-UP
+*----
+      CALL LCMLEN(IPMAP,'_TINST',ILONG,ITYLCM)
+      IF(IMPX.GT.0) WRITE(6,50) ILONG+1,BURNAVG
+      JPMAP=LCMLID(IPMAP,'_TINST',ILONG+1)
+      KPMAP=LCMDIL(JPMAP,ILONG+1)
+      CALL LCMPUT(KPMAP,'TIME',1,2,TTIME)
+      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
+      CALL LCMPUT(KPMAP,'BURN-INST',NCH*NB,2,BURNINST)
+      CALL LCMPUT(KPMAP,'POWER-BUND',NCH*NB,2,BUNDPOW)
+      IF(NPARM.GT.0) THEN
+        LPMAP=LCMGID(IPMAP,'PARAM')
+        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
+        CALL LCMEQU(LPMAP,MPMAP)
+        ISTATE(19)=1
+        CALL LCMPTC(IPMAP,'CYCLE-NAMES',12,'_TINST')
+      ENDIF
+      DEALLOCATE(BURNINST,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)
+      IF(IGEO.EQ.7) THEN
+*       Cartesian geometry.
+        ALLOCATE(IXN(NX),IYN(NY))
+        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,NZ,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,NZ,NREG,MSHT,NAMCHA,NAMCHA2,
+     +       WINT,MIX,BS,PS,IVS,IXN,IYN,IMPX)
+        ENDIF
+        DEALLOCATE(IXN,IYN)
+      ELSE IF(IGEO.EQ.9) THEN
+*       Hexagonal geometry.
+        ALLOCATE(IHN(2,NX))
+        CALL LCMGET(IPMAP,'HNAME',IHN)
+        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 TINREH(IPMAP,IPMIC,IPMIC2,IPMIC3,NCH,NB,NX,NZ,NREG,
+     +               NAMCHA,NS,MSHT,WINT,MIX,IHN,BS,PS,IVS,POW,MAXS,
+     +               NSSV,IDX,IMPX,KREF,LMIC)
+          DEALLOCATE(POW,IDX)
+        ELSE
+          CALL TINSHH(IPMAP,NCH,NB,NX,NZ,NREG,MSHT,NAMCHA,NAMCHA2,
+     +       WINT,MIX,BS,PS,IVS,IHN,IMPX)
+        ENDIF
+        DEALLOCATE(IHN)
+      ELSE
+        CALL XABORT('TINST: GEOMETRY TYPE NOT SUPPORTED')
+      ENDIF
+      DEALLOCATE(BS,PS,IVS,MIX)
+      DEALLOCATE(WINT)
+      DEALLOCATE(NSSV)
+      MSHT=MAXS+1
+      KREF=0
+      GOTO 2
+*
+  30  IF(LNOTHING)CALL XABORT('@TINST: NO OPTION SPECIFIED.')
+      CALL LCMSIX(IPMAP,' ',0)
+      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
+   40 FORMAT(/20H TINST: PICK BURNUP=,1P,E12.4,10H MWd/tonne)
+   50 FORMAT(/38H TINST: STORE INFORMATION IN LIST ITEM,I3,9H OF TINST,
+     + 20H DIRECTORY AT BURNUP,1P,E12.4,8H MW-D/T./)
+      END