*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