From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Donjon/src/SIM.f | 817 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 817 insertions(+) create mode 100644 Donjon/src/SIM.f (limited to 'Donjon/src/SIM.f') diff --git a/Donjon/src/SIM.f b/Donjon/src/SIM.f new file mode 100644 index 0000000..4bb5e4d --- /dev/null +++ b/Donjon/src/SIM.f @@ -0,0 +1,817 @@ +*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 -- cgit v1.2.3