path: root/Donjon/src/SIM.f

*DECK SIM
      SUBROUTINE SIM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* PWR fuelling simulator according to the time-linear model.
*
*Copyright:
* Copyright (C) 2013 Ecole Polytechnique de Montreal
*
*Author(s): 
* A. Hebert, V. Salino
*
*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 SIM: module specification is:
* FMAP [ MLIB ] := SIM: FMAP [ MLIB ] [ POWER ] :: (descsim) ;
* where
*   FMAP : name of a \emph{fmap} object, that will be updated by the SIM: 
*     module. The FMAP object must contain the instantaneous burnups for each 
*     assembly subdivision, a basic naval-coordinate assembly layout and the 
*     weight of each assembly subdivision.
*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) containing 
*     particularized isotope data. If this object also appears on the RHS, it 
*     is open in modification mode and updated. Number densities of isotopes 
*     present in list HISOT. 
*   POWER : name of a \emph{power} object containing the channel and powers of 
*     the assembly subdivisions, previously computed by the FLPOW: module. The 
*     channel and powers of the assembly subdivisions are used by the SIM: 
*     module to compute the new burn-up of each assembly subdivision. If the 
*     powersof the assembly subdivisions are previously specified with the 
*     module RESINI:, you can burn your core without a POWER object.
*   (descsim) : structure describing the input data to the SIM: 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,MAXIAS=30,MAXHHX=30)
      TYPE(C_PTR) IPMAP,IPPOW,JPMAP,KPMAP,LPMAP,MPMAP,IPLIB
      CHARACTER TEXT*12,HSIGN*12,TEXT4*4,HCYCL*12,HOLD*12,HHX(MAXHHX)*1,
     > TEXT4B*4,TEXT1*1,TEXT1B*1,HSMG*131,PNAME*12,ASMB1(MAXIAS)*4,
     > HC1*12,HC2*12
      INTEGER IMPX,IHY(MAXHHX),ISTATE(NSTATE),SIMIND
      DOUBLE PRECISION DFLOT
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFMIX,NAME,ONAME,OFMIX,
     > INFMIX,LL
      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HZONE
      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:,:) :: CYCLE,CYCLE2
      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HFOLLO
      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HCHCLV
      REAL, ALLOCATABLE, DIMENSION(:) :: RFCHAN,BURNUP,OBURNU,FORM,
     > BUNDPOW,BURNINST,PERTMP
      REAL, ALLOCATABLE, DIMENSION(:,:) :: RFOLLO,OFOLLO
*----
*  PARAMETER VALIDATION
*----
      IPMAP=C_NULL_PTR
      IPPOW=C_NULL_PTR
      IPLIB=C_NULL_PTR
      MLIB=-1
      DO IEN=1,NENTRY
        IF(IENTRY(IEN).GT.2) THEN
          WRITE(HSMG,'(12H@SIM: ENTRY ,A12,19H IS NOT OF LCM TYPE)')
     >    HENTRY(IEN)
          CALL XABORT(HSMG)
        ENDIF
        CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
        IF(HSIGN.EQ.'L_MAP') THEN
          IPMAP=KENTRY(IEN)
          IF(JENTRY(IEN).NE.1) CALL XABORT('@SIM: MODIFICATION MODE '
     >    //'FOR L_MAP EXPECTED')
        ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN
          IPLIB=KENTRY(IEN)
          MLIB=JENTRY(IEN)
          IF(MLIB.EQ.0) CALL XABORT('@SIM: READ-ONLY OR MODIFICATION '
     >    //'MODE FOR L_LIBRARY EXPECTED')
        ELSEIF(HSIGN.EQ.'L_POWER') THEN
          IPPOW=KENTRY(IEN)
          IF(JENTRY(IEN).NE.2) CALL XABORT('@SIM: READ-ONLY MODE FOR'
     >    //' L_POWER EXPECTED')
        ELSE
          CALL XABORT('@SIM: UNKNOWN SIGNATURE ('//HSIGN//')')
        ENDIF
      ENDDO
      IF(.NOT.C_ASSOCIATED(IPMAP)) THEN
        CALL XABORT('@SIM: NO FUEL MAP OBJECT FOUND.')
      ENDIF
*----
*  RECOVER INFORMATION
*----
      ISTATE(:NSTATE)=0
      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
      NB=ISTATE(1)
      NCH=ISTATE(2)
      NCOMB=ISTATE(3)
      IMOD=ISTATE(5)
      NF=ISTATE(7)
      NPARM=ISTATE(8)
      NSIMS=ISTATE(13)
      NIS=ISTATE(18)
      NCYCLE=ISTATE(19)
      LX=NSIMS/100
      LY=MOD(NSIMS,100)
      IF(NF.EQ.0)CALL XABORT('@SIM: NO FUEL IN MAP OBJECT.')
      IF(NIS.GT.0) THEN
        ALLOCATE(HFOLLO(NIS))
        CALL LCMGTC(IPMAP,'HFOLLOW',8,NIS,HFOLLO)
      ENDIF
      NTOT=NCH*NB
*----
*  ONLY TIME INSTANTANEOUS CALCULATIONS IN SIM:
*----
      IF(IMOD.NE.2)CALL XABORT('@SIM: INST-BURN OPTION SHOULD BE '
     + //'USED IN RESINI.')
*----
*  READ INPUT DATA
*----
      IMPX=0
      TTIME=0.0
      ALLOCATE(RFCHAN(NCH))
      RFCHAN(:NCH)=0.0
      TIME=0.0
      BURNSTEP=0.0
      HCYCL=' '
      JNDCY=0
*     READ KEYWORD
  10  CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(1).')
      IF(TEXT.EQ.'EDIT')THEN
*       PRINTING INDEX
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(1).')
        IMPX=MAX(0,NITMA)
        IF(IMPX.GT.0) WRITE(6,190) NB,NCH,LX,LY
      ELSEIF(TEXT.EQ.'CYCLE')THEN
        CALL REDGET(ITYP,NITMA,FLOT,HCYCL,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(2).')
        IF(NSIMS.EQ.0)CALL XABORT('@SIM: SIM DATA NOT DEFINED IN RESIN'
     >  //'I: MODULE.')
        ALLOCATE(HZONE(NCH),IFMIX(NTOT),NAME(3*NCH),ONAME(3*NCH),
     >  OFMIX(NTOT))
        ALLOCATE(FORM(NB),BURNUP(NTOT),OBURNU(NTOT),RFOLLO(NTOT,NIS),
     >  OFOLLO(NTOT,NIS),LL(LY))
        BURNUP(:NTOT)=-999.0
        RFOLLO(:NTOT,:NIS)=0.0
        OFOLLO(:NTOT,:NIS)=0.0
        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HZONE)
        TEXT4=HZONE(1)
        READ(TEXT4,'(A1,I2)') TEXT1,INTG2
        L=0
        LL(:LY)=0
        DO K=1,NCH
          TEXT4=HZONE(K)
          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
          IF(TEXT1B.EQ.TEXT1) THEN
            L=L+1
            IF(L.GT.LY)CALL XABORT('@SIM: INCOHERENCE IN BASIC ASSEMB'
     >      //'LY LAYOUT GIVEN IN RESINI: (1).')
            IF(L.GT.MAXHHX)CALL XABORT('@SIM: MAXHHX OVERFLOW(1).')
            IHY(L)=INTG2B
          ENDIF
        ENDDO
        JMAX=0
        DO K=1,NCH
          TEXT4=HZONE(K)
          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
          DO J=1,L
            IF(INTG2B.EQ.IHY(J)) THEN
              LL(J)=LL(J)+1
              IF(LL(J).EQ.LX) JMAX=J
              IF(LL(J).GT.LX)CALL XABORT('@SIM: INCOHERENCE IN BASIC '
     >        //'ASSEMBLY LAYOUT GIVEN IN RESINI: (2).')
            ENDIF
          ENDDO
        ENDDO
        IF(JMAX.EQ.0)CALL XABORT('@SIM: INCOHERENCE IN BASIC ASSEMBLY'
     >  //' LAYOUT GIVEN IN RESINI: (3).')
        L=0
        DO K=1,NCH
          TEXT4=HZONE(K)
          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
            IF(INTG2B.EQ.IHY(JMAX)) THEN
              L=L+1
              IF(L.GT.MAXHHX)CALL XABORT('@SIM: MAXHHX OVERFLOW(2).')
              HHX(L)=TEXT1B
            ENDIF
        ENDDO
        DEALLOCATE(LL)
        HOLD=' '
        INDCY=-1
        BURNCY=-999.0
  30    CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(3).')
  40    IF(TEXT.EQ.'FROM') THEN
          CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(4).')
          GO TO 30
        ELSE IF(TEXT.EQ.'BURN') THEN
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.EQ.1) THEN
            INDCY=NITMA
          ELSE IF(ITYP.EQ.2) THEN
            BURNCY=FLOT
          ELSE
            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
          ENDIF
          GO TO 30
        ELSE IF((TEXT.EQ.'MAP').OR.(TEXT.EQ.'QMAP')) THEN
          CALL LCMLEN(IPMAP,HCYCL,ILONG,ITYLCM)
          IF(ILONG.NE.0) THEN
            WRITE(HSMG,'(12H@SIM: CYCLE ,A12,8H EXISTS.)') HCYCL
            CALL XABORT(HSMG)
          ENDIF
          ALLOCATE(HCHCLV(NCYCLE+1))
          IF(NCYCLE.GT.0) CALL LCMGTC(IPMAP,'CYCLE-NAMES',12,NCYCLE,
     >    HCHCLV)
          HCHCLV(NCYCLE+1)=HCYCL
          NCYCLE=NCYCLE+1
          CALL LCMPTC(IPMAP,'CYCLE-NAMES',12,NCYCLE,HCHCLV)
          DEALLOCATE(HCHCLV)
          ALLOCATE(CYCLE(LX,LY))
          IF(TEXT.EQ.'MAP') THEN
            DO 45 I=1,LX
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(5).')
   45       CONTINUE
            DO 51 J=1,LY
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(2).')
            DO 50 I=1,LX
            CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
            IF(ITYP.EQ.1) THEN
              IF(NITMA.LE.0) CALL XABORT('@SIM: FUEL INDEX .LE.0.')
              IF(NITMA.GT.999) CALL XABORT('@SIM: FUEL INDEX .GT.999.')
              WRITE(CYCLE(I,J),'(I3.3,1H@)') NITMA
            ELSE IF(ITYP.EQ.3) THEN
              CYCLE(I,J)=TEXT4
            ELSE
              CALL XABORT('@SIM: INTEGER/CHARACTER DATA EXPECTED(1).')
            ENDIF
            WRITE(TEXT4B,'(A1,I2.2)') HHX(I),IHY(J)
   50       CONTINUE
   51       CONTINUE
          ELSE IF(TEXT.EQ.'QMAP') THEN
            LXMIN=LX/2+1
            LYMIN=LY/2+1
            DO 55 I=LXMIN,LX
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(7).')
   55       CONTINUE
            DO 61 J=LYMIN,LY
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(3).')
            DO 60 I=LXMIN,LX
            CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
            IF(ITYP.EQ.1) THEN
              IF(NITMA.LE.0) CALL XABORT('@SIM: FUEL INDEX .LE.0.')
              IF(NITMA.GT.999) CALL XABORT('@SIM: FUEL INDEX .GT.999.')
              WRITE(CYCLE(I,J),'(I3.3,1H@)') NITMA
            ELSE IF(ITYP.EQ.3) THEN
              CYCLE(I,J)=TEXT4
            ELSE
              CALL XABORT('@SIM: INTEGER/CHARACTER DATA EXPECTED(2).')
            ENDIF
            WRITE(TEXT4B,'(A1,I2.2)') HHX(I),IHY(J)
   60       CONTINUE
   61       CONTINUE
            CALL SIMQMP(LX,LY,LXMIN,LYMIN,HHX,IHY,CYCLE)
          ENDIF
          IF(IMPX.GE.2) THEN
            ALLOCATE(CYCLE2(LX,LY))
            DO I=1,LX
              DO J=1,LY
                CYCLE2(I,J)=CYCLE(I,J)
                IF(CYCLE2(I,J).EQ.'|')CYCLE2(I,J)=' |'
                IF(CYCLE2(I,J).EQ.'-')CYCLE2(I,J)=' -'
              ENDDO
            ENDDO
            WRITE (6,'(25H SIM: RELOADING PATTERN :)')
            WRITE (6,'(2X,32A4)') (HHX(I),I=1,LX)
            DO J=1,LY
              WRITE (6,'(I3,1X,32(A3,1X))') IHY(J),(CYCLE2(I,J),I=1,LX)
            ENDDO
            DEALLOCATE(CYCLE2)
          ENDIF
          OBURNU(:NTOT)=-999.0
          IF(HOLD.NE.' ') THEN
            JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
            JPMAP=LCMGID(IPMAP,HOLD)
            KPMAP=LCMGIL(JPMAP,JNDCY)
            CALL LCMGET(KPMAP,'NAME',ONAME)
            CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
            CALL LCMGET(KPMAP,'FLMIX',OFMIX)
            IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
*             KPMAP(HOLD) --> IPLIB
              CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,OFMIX,HFOLLO,
     >        OFOLLO)
            ENDIF
          ENDIF
          ALLOCATE(INFMIX(NTOT))
          CALL LCMGET(IPMAP,'FLMIX-INI',INFMIX)
          IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMPOS'
          CALL SIMPOS(LX,LY,NCH,NB,HCYCL,HOLD,HHX,IHY,HZONE,INFMIX,
     >    NIS,CYCLE,NAME,BURNUP,IFMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
          DEALLOCATE(INFMIX)
          JNDCY=1
          JPMAP=LCMLID(IPMAP,HCYCL,1)
          KPMAP=LCMDIL(JPMAP,JNDCY)
          CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
          CALL LCMPTC(KPMAP,'CYCLE',4,LX*LY,CYCLE)
          CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
          CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
          CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
          IF(NIS.GT.0) CALL LCMPUT(KPMAP,'FOLLOW',NTOT*NIS,2,RFOLLO)
          IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
*           KPMAP(HCYCL) --> IPLIB
            CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
          ENDIF
          DEALLOCATE(CYCLE)
          GO TO 30
        ELSE IF(TEXT.EQ.'SPEC') THEN
          JNDCY=1
          JPMAP=LCMGID(IPMAP,HCYCL)
          KPMAP=LCMGIL(JPMAP,JNDCY)
          CALL LCMGET(KPMAP,'NAME',NAME)
          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
          CALL LCMGET(KPMAP,'FLMIX',IFMIX)
          IASMB1=0
          INDCY=-1
          BURNCY=-999.0
   70     CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(9).')
   80     IF(TEXT.EQ.'ENDCYCLE') THEN
            GO TO 120
          ELSE IF((TEXT.EQ.'DIST-AX').OR.(TEXT.EQ.'BURN-STEP')) THEN
            JNDCY=1
            JPMAP=LCMGID(IPMAP,HCYCL)
            KPMAP=LCMGIL(JPMAP,JNDCY)
            CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
            CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
            CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
            GO TO 40
          ELSE IF(TEXT.EQ.'SET') THEN
            BURN=-999.0
            IFUEL=0
            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(10).')
            IF(TEXT.EQ.'AVGB') THEN
              CALL REDGET(ITYP,NITMA,BURN,TEXT,DFLOT)
              IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(3).')
            ELSE IF(TEXT.EQ.'FUEL') THEN
              CALL REDGET(ITYP,IFUEL,FLOT,TEXT,DFLOT)
              IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(4)')
            ELSE
              CALL XABORT('@SIM: AVGB OR FUEL KEYWORD EXPECTED')
            ENDIF
            IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMSET'
            CALL SIMSET(NCH,NB,HCYCL,IASMB1,ASMB1,BURN,IFUEL,HZONE,
     >      NAME,BURNUP,IFMIX)
            IASMB1=0
          ELSE IF(TEXT.EQ.'FROM') THEN
            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
            CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(11).')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(12).')
            IF(TEXT.NE.'AT')CALL XABORT('@SIM: AT KEYWORD EXPECTED')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT4B,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(13).')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(14).')
            IF(TEXT.EQ.'BURN') THEN
              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
              IF(ITYP.EQ.1) THEN
                INDCY=NITMA
              ELSE IF(ITYP.EQ.2) THEN
                BURNCY=FLOT
              ELSE
                CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
              ENDIF
            ELSE
              JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
              JPMAP=LCMGID(IPMAP,HOLD)
              KPMAP=LCMGIL(JPMAP,JNDCY)
              CALL LCMGET(KPMAP,'NAME',ONAME)
              CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
              CALL LCMGET(KPMAP,'FLMIX',OFMIX)
              IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
*               KPMAP(HOLD) --> IPLIB
                CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,OFMIX,HFOLLO,
     >          OFOLLO)
              ENDIF
              IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMCPY'
              CALL SIMCPY(NCH,NB,HCYCL,IASMB1,ASMB1,TEXT4B,HZONE,NIS,
     >        NAME,BURNUP,IFMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
              IASMB1=0
              JNDCY=1
              JPMAP=LCMGID(IPMAP,HCYCL)
              KPMAP=LCMGIL(JPMAP,JNDCY)
              IF(NIS.GT.0) CALL LCMPUT(KPMAP,'FOLLOW',NTOT*NIS,2,RFOLLO)
              IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
*               KPMAP(HCYCL) --> IPLIB
                CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,
     >          RFOLLO)
              ENDIF
              GO TO 80
            ENDIF
          ELSE
            IASMB1=IASMB1+1
            IF(IASMB1.GT.MAXIAS) CALL XABORT('@SIM: MAXIAS OVERFLOW.')
            ASMB1(IASMB1)=TEXT(:4)
          ENDIF
          GO TO 70
        ELSE IF(TEXT.EQ.'DIST-AX') THEN
          IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
          JNDCY=1
          JPMAP=LCMGID(IPMAP,HCYCL)
          KPMAP=LCMGIL(JPMAP,JNDCY)
          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
          IASMB1=0
          INDCY=-1
          BURNCY=-999.0
   90     CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(15).')
  100     IF(TEXT.EQ.'ENDCYCLE') THEN
            GO TO 120
          ELSE IF((TEXT.EQ.'SPEC').OR.(TEXT.EQ.'BURN-STEP')) THEN
            JNDCY=1
            JPMAP=LCMGID(IPMAP,HCYCL)
            KPMAP=LCMGIL(JPMAP,JNDCY)
            CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
            GO TO 40
          ELSE IF(TEXT.EQ.'SET') THEN
            DO IB=1,NB
              CALL REDGET(ITYP,NITMA,FORM(IB),TEXT,DFLOT)
              IF(ITYP.NE.2) CALL XABORT('@SIM: REAL AXN EXPECTED.')
            ENDDO
            IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMDIS'
            CALL SIMDIS(.TRUE.,NCH,NB,HCYCL,IASMB1,ASMB1,FORM,TEXT4B,
     >      HZONE,BURNUP,BURNUP)
            IASMB1=0
          ELSE IF(TEXT.EQ.'FROM') THEN
            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
            CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(16).')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(17).')
            IF(TEXT.NE.'AT')CALL XABORT('@SIM: AT KEYWORD EXPECTED')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT4B,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(18).')
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(19).')
            IF(TEXT.EQ.'BURN') THEN
              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
              IF(ITYP.EQ.1) THEN
                INDCY=NITMA
              ELSE IF(ITYP.EQ.2) THEN
                BURNCY=FLOT
              ELSE
                CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
              ENDIF
            ELSE
              JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
              JPMAP=LCMGID(IPMAP,HOLD)
              KPMAP=LCMGIL(JPMAP,JNDCY)
              CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
              IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMDIS'
              CALL SIMDIS(.FALSE.,NCH,NB,HCYCL,IASMB1,ASMB1,FORM,TEXT4B,
     >        HZONE,BURNUP,OBURNU)
              JNDCY=1
              JPMAP=LCMGID(IPMAP,HCYCL)
              KPMAP=LCMGIL(JPMAP,JNDCY)
              IASMB1=0
              GO TO 100
            ENDIF
          ELSE
            IASMB1=IASMB1+1
            IF(IASMB1.GT.MAXIAS) CALL XABORT('@SIM: MAXIAS OVERFLOW.')
            ASMB1(IASMB1)=TEXT(:4)
          ENDIF
          GO TO 90
        ELSEIF(TEXT.EQ.'ENDCYCLE')THEN
          GO TO 120
        ELSEIF(TEXT.EQ.'TIME')THEN
*         TIME VALUE
          IF(TIME.NE.0.0)CALL XABORT('@SIM: TIME ALREADY SPECIFIED(1).')
          IF(BURNSTEP.NE.0.0)CALL XABORT('@SIM: BURNSTEP ALREADY //
     >    //SPECIFIED(1).')
          CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
          IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(1).')
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(20).')
          IF(TIME.LT.0.)CALL XABORT('@SIM: 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('@SIM: EXPECTING DAY|HOUR|MINUTE|SECOND.')
          ENDIF
          GOTO 130
        ELSEIF(TEXT.EQ.'BURN-STEP')THEN
*         BURN-STEP
          IF(TIME.NE.0.)CALL XABORT('@SIM: TIME ALREADY SPECIFIED(2).')
          IF(BURNSTEP.NE.0.)CALL XABORT('@SIM: BURNSTEP ALREADY '
     >    //'SPECIFIED(2).')
          CALL REDGET(ITYP,NITMA,BURNSTEP,TEXT,DFLOT)
          IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(2).')
          IF(BURNSTEP.LE.0.)CALL XABORT('@SIM: EXPECTING REAL>0 (2).')
          GO TO 130
        ELSE IF(TEXT.EQ.'SET-FOLLOW') THEN
*         Reset the number densities of particularized isotopes
          IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SET-FOLLOW'
          IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
          INDCY=-1
          BURNCY=-999.0
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >    //'(21).')
          IF(TEXT.EQ.'BURN') THEN
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.EQ.1) THEN
              INDCY=NITMA
            ELSE IF(ITYP.EQ.2) THEN
              BURNCY=FLOT
            ELSE
              CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
            ENDIF
            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
     >      //'(22).')
          ENDIF
          JNDCY=SIMIND(IPMAP,IMPX,HCYCL,INDCY,BURNCY)
          JPMAP=LCMGID(IPMAP,HCYCL)
          KPMAP=LCMGIL(JPMAP,JNDCY)
          CALL LCMGET(KPMAP,'NAME',NAME)
          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
          CALL LCMGET(KPMAP,'FLMIX',IFMIX)
          IF(C_ASSOCIATED(IPPOW)) THEN
            ALLOCATE(BUNDPOW(NTOT))
            CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
            CALL LCMPUT(KPMAP,'POWER-BUND',NTOT,2,BUNDPOW)
            DEALLOCATE(BUNDPOW)
          ENDIF
          GO TO 40
        ELSE
          CALL XABORT('@SIM: WRONG KEYWORD: '//TEXT//' (1).')
        ENDIF
      ELSE IF(TEXT.EQ.'COMPARE') THEN
*       Compare two fields of values
        IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
        INDCY1=-1
        BURNCY1=-999.0
        INDCY2=-1
        BURNCY2=-999.0
        IMODE=0
        CALL REDGET(ITYP,NITMA,FLOT,HC1,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(23).')
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(24).')
        IF(TEXT.EQ.'BURN') THEN
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.EQ.1) THEN
            INDCY1=NITMA
          ELSE IF(ITYP.EQ.2) THEN
            BURNCY1=FLOT
          ELSE
            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
          ENDIF
          CALL REDGET(ITYP,NITMA,FLOT,HC2,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(25).')
        ELSE
          HC2=TEXT
        ENDIF
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(26).')
        IF(TEXT.EQ.'BURN') THEN
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.EQ.1) THEN
            INDCY2=NITMA
          ELSE IF(ITYP.EQ.2) THEN
            BURNCY2=FLOT
          ELSE
            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
          ENDIF
          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(27).')
        ENDIF
        IF(TEXT.EQ.'DIST-BURN') THEN
          IMODE=1
        ELSE IF(TEXT.EQ.'DIST-POWR') THEN
          IMODE=2
        ELSE
          CALL XABORT('@SIM: DIST-BURN OR DIST-POWR KEYWORD EXPECTED.')
        ENDIF
        CALL SIMCOM(IPMAP,IMPX,IMODE,NCH,NB,HC1,HC2,INDCY1,INDCY2,
     >  BURNCY1,BURNCY2,ERROR)
        CALL REDGET(ITYP,NITMA,ERROR,TEXT,DFLOT)
        IF(ITYP.NE.-2) CALL XABORT('SIM: OUTPUT REAL EXPECTED')
        ITYP=2
        CALL REDPUT(ITYP,NITMA,ERROR,TEXT,DFLOT)
      ELSE IF(TEXT.EQ.'SET-PARAM') THEN
*       Reset a global parameter
        IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(28).')
        CALL REDGET(ITYP,NITMA,VALUE,TEXT,DFLOT)
        IF(ITYP.NE.2)CALL XABORT('@SIM: REAL VALUE EXPECTED FOR'
     >                         //' pvalue.')
        JPMAP=LCMGID(IPMAP,'PARAM')
        DO IPAR=1,NPARM
          KPMAP=LCMGIL(JPMAP,IPAR)
          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
          CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
          IF(PNAME.EQ.TEXT) THEN
            IF(ITYPE.EQ.1) THEN
              CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE)
              IF(IMPX.GT.0) WRITE(6,200) PNAME,VALUE
            ELSE 
              ALLOCATE(PERTMP(NTOT))
              PERTMP(:NTOT)=VALUE
              CALL LCMPUT(KPMAP,'P-VALUE',NTOT,2,PERTMP)     
              IF(IMPX.GT.0) WRITE(6,201) PNAME,VALUE
              DEALLOCATE(PERTMP)
            ENDIF
            GO TO 10
          ENDIF
        ENDDO
        CALL XABORT('@SIM: GLOBAL OR LOCAL PARAMETER NAME NOT FOUND: '
     >              //TEXT)
      ELSEIF(TEXT.EQ.';')THEN
        GO TO 140
      ELSE
*       KEYWORD DOES NOT MATCH
        CALL XABORT('@SIM: WRONG KEYWORD: '//TEXT//' (2).')
      ENDIF
      GO TO 10
*----
*  COMPUTE THE AVERAGE BURNUP
*----
  120 IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
      BURNAVG=0.0
      DO ICH=1,NCH
        DO IB=1,NB
          IOF=(IB-1)*NCH+ICH
          IF(IFMIX(IOF).EQ.0) CYCLE
          IF(BURNUP(IOF).EQ.-999.0) THEN
            WRITE(HSMG,'(30HSIM: BURNUP NOT SET IN CHANNEL,I4,
     >      11H AND BUNDLE,I4,1H.)') ICH,IB
            CALL XABORT(HSMG)
          ENDIF
          BURNAVG=BURNAVG+BURNUP(IOF)
        ENDDO
      ENDDO
      BURNAVG=BURNAVG/REAL(NTOT)
*----
*  SAVE INFORMATION IN DIRECTORY HCYCL AFTER REFUELLING
*----
      IF(JNDCY.EQ.0) CALL XABORT('@SIM: JNDCY NOT DEFINED.')
      IF(IMPX.GT.0) WRITE(6,220) JNDCY,HCYCL,BURNAVG
      CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
      CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
      CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
      CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
      IF(NPARM.GT.0) THEN
        LPMAP=LCMGID(IPMAP,'PARAM')
        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
        CALL LCMEQU(LPMAP,MPMAP)
      ENDIF
      IF((MLIB.GE.1).AND.(NIS.GT.0)) THEN
*       IPLIB --> KPMAP(HCYCL)
        CALL SIMLIB(IMPX,2,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
      ENDIF
*----
*  SAVE THE INFORMATION IN THE FUELMAP AFTER REFUELLING.
*----
      CALL LCMPUT(IPMAP,'BURN-INST',NTOT,2,BURNUP)
      CALL LCMPUT(IPMAP,'FLMIX',NTOT,1,IFMIX)
      DEALLOCATE(OFOLLO,RFOLLO,OBURNU,BURNUP,FORM)
      DEALLOCATE(OFMIX,ONAME,NAME,IFMIX,HZONE)
      HCYCL=' '
      GO TO 10
*----
*  PERFORM CALCULATION
*----
  130 IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
      ALLOCATE(BUNDPOW(NTOT))
      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
        CALL LCMLEN(IPMAP,'BUND-PW',LENGT,ITYP)
        IF(LENGT.EQ.0)CALL XABORT('@SIM: MISSING BUND-PW DATA IN '
     >  //'L_MAP OBJECT.')
        CALL LCMGET(IPMAP,'BUND-PW',BUNDPOW)
      ELSE 
        CALL LCMLEN(IPPOW,'POWER-CHAN',LENGT,ITYP)
        IF(LENGT.EQ.0)CALL XABORT('@SIM: MISSING POWER-CHAN DATA I'
     >  //'N L_POWER OBJECT.')
        CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
        CALL LCMGET(IPPOW,'K-EFFECTIVE',FKEFF)
      ENDIF
      TTIME=TTIME+TIME
      ALLOCATE(BURNINST(NTOT))
      IF(IMPX.GE.8) THEN
        CALL SIMOUT(IPMAP,IMPX,BURNINST,HZONE,NCH,NB,LX,LY,HHX,IHY,
     >  'BEGIN')
      ENDIF
      CALL TINSTB(IPMAP,TIME,BURNSTEP,NCH,NB,NF,BUNDPOW,BURNAVG,
     > BURNINST,IMPX)
*----
*  SAVE LOCAL PARAMETERS FOR HISTORICAL FOLLOW-UP
*----
      CALL LCMLEN(IPMAP,HCYCL,ILONG,ITYLCM)
      IF(ILONG.EQ.0) THEN
        WRITE(HSMG,'(24HSIM: MISSING CYCLE NAME=,A12)') HCYCL
        CALL XABORT(HSMG)
      ENDIF
      IF(IMPX.GT.0) WRITE(6,220) ILONG+1,HCYCL,BURNAVG
      JPMAP=LCMLID(IPMAP,HCYCL,ILONG+1)
      KPMAP=LCMGIL(JPMAP,1)
      CALL LCMGET(KPMAP,'NAME',NAME)
      CALL LCMGET(KPMAP,'FLMIX',IFMIX)
      KPMAP=LCMDIL(JPMAP,ILONG+1)
      CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
      CALL LCMPUT(KPMAP,'TIME',1,2,TTIME)
      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
      CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNINST)
      CALL LCMPUT(KPMAP,'POWER-BUND',NTOT,2,BUNDPOW)
      CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
      CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
      CALL LCMPUT(IPMAP,'BURN-INST',NTOT,2,BURNINST)
      IF(C_ASSOCIATED(IPPOW)) CALL LCMPUT(KPMAP,'K-EFFECTIVE',1,2,FKEFF)
      IF(NPARM.GT.0) THEN
        LPMAP=LCMGID(IPMAP,'PARAM')
        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
        CALL LCMEQU(LPMAP,MPMAP)
      ENDIF
      IF((MLIB.GE.1).AND.(NIS.GT.0)) THEN
*       IPLIB --> KPMAP(HCYCL)
        CALL SIMLIB(IMPX,2,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
      ENDIF
      CALL SIMOUT(IPMAP,IMPX,BURNINST,HZONE,NCH,NB,LX,LY,HHX,IHY,
     > 'END  ')
      DEALLOCATE(BUNDPOW,BURNINST)
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(29).')
      IF(TEXT.NE.'ENDCYCLE')CALL XABORT('@SIM: ENDCYCLE KEYWORD EXPECT'
     > //'ED.')
      DEALLOCATE(OFOLLO,RFOLLO,OBURNU,BURNUP,FORM)
      DEALLOCATE(OFMIX,ONAME,NAME,IFMIX,HZONE)
      HCYCL=' '
      GOTO 10
*
  140 IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
      CALL LCMSIX(IPMAP,' ',0)
      ISTATE(:NSTATE)=0
      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
      ISTATE(19)=NCYCLE
      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)
      IF(NIS.GT.0) DEALLOCATE(HFOLLO)
      RETURN
*
  190 FORMAT(/38H SIM: NUMBER OF ASSEMBLY SUBDIVISIONS=,I4/
     1 6X,25HNUMBER OF FUEL CHANNELS =,I4/
     2 6X,34HNUMBER OF ASSEMBLIES ALONG X AXIS=,I3/
     3 6X,34HNUMBER OF ASSEMBLIES ALONG Y AXIS=,I3/)
  200 FORMAT(/' SET GLOBAL PARAMETER          ',A,' TO =',1P,E14.6)
  201 FORMAT(/' SET LOCAL PARAMETER (UNIFORM) ',A,' TO =',1P,E14.6)
  210 FORMAT(/20H SIM: PROCESS CYCLE ,A12,16H WITH PROCEDURE ,A,1H.)
  220 FORMAT(/36H SIM: STORE INFORMATION IN LIST ITEM,I3,10H OF CYCLE ,
     > A12,10H AT BURNUP,1P,E14.6,8H MW-D/T./)
      END