summaryrefslogtreecommitdiff
path: root/Donjon/src/RESPAR.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/RESPAR.f')
-rw-r--r--Donjon/src/RESPAR.f772
1 files changed, 772 insertions, 0 deletions
diff --git a/Donjon/src/RESPAR.f b/Donjon/src/RESPAR.f
new file mode 100644
index 0000000..e2abcdb
--- /dev/null
+++ b/Donjon/src/RESPAR.f
@@ -0,0 +1,772 @@
+*DECK RESPAR
+ SUBROUTINE RESPAR(IPMAP,NCH,NB,NFUEL,NCOMB,NPARM,NX,NY,NZ,NSTATE,
+ 1 ISTATE,IMPX,NASB,LMAP2,IPMP2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read and store the data related to global and local parameters.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s):
+* D. Sekki, R. Chambon, M. Guyot, V. Descotes, B. Toueg
+*
+*Parameters: input/output
+* IPMAP pointer to fuel-map information.
+* NCH number of reactor channels.
+* NB number of fuel bundles per channel.
+* NFUEL number of fuel types.
+* NCOMB number of combustion zones.
+* NX number of elements along x-axis in fuel map.
+* NY number of elements along y-axis in fuel map.
+* NZ number of elements along z-axis in fuel map.
+* NSTATE maximum number of state-vector records.
+* IMPX printing index (=0 for no print).
+* NASB total number of assembly
+* LMAP2 flag to set if second fuel-map information is used to
+* recover burnup information
+* IPMP2 pointer to the second fuel-map information.
+*
+*Parameters: output
+* ISTATE updated state-vector.
+* NPARM total number of recorded parameters.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ TYPE(C_PTR) IPMAP,IPMP2
+ INTEGER NCH,NB,NFUEL,NCOMB,NPARM,NX,NY,NZ,NSTATE,ISTATE(NSTATE),
+ 1 IMPX
+ LOGICAL LMAP2
+*----
+* LOCAL VARIABLES
+*----
+ PARAMETER(IOUT=6)
+ INTEGER INAME(3),IZONE(NCH),IVECT(NCOMB,NB),NSCH(NCH),
+ 1 IBSH(NCOMB),IPAT(NCOMB),SHPAT(NCOMB),SHDIR(NCOMB),MIX(NX*NY*NZ),
+ 2 FMIX(NCH,NB),IAZ(NCH),ISTAT2(NSTATE),SHREF,DIRREF(NCOMB)
+ REAL VALUE(NCH,NB),POWER(NCH,NB),FPOWER(NB)
+ CHARACTER CVALUE(NCH,NB)*12
+ DOUBLE PRECISION DFLOT
+ CHARACTER TEXT*12,TEXT12*12,PNAME*12,KEYN*12,PNAME2*12
+ LOGICAL LRSCH,LBURN
+ TYPE(C_PTR) JPMAP,KPMAP,ZPMAP,JPMP2,KPMP2
+*----
+* ALLOCATABLE STATEMENTS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: ALCH,NUM,IND,VPAT
+ REAL, ALLOCATABLE, DIMENSION(:) :: DENSMOD,BRN,BASS,VAL2,ZZ,VB
+*----
+* READ INPUT DATA
+*----
+ LRSCH=.FALSE.
+ LBURN=.FALSE.
+ PTOT=0.0
+ CALL LCMGET(IPMAP,'FLMIX',FMIX)
+ 10 CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACT'
+ 1 //'ER DATA EXPECTED ('//TEXT12//').')
+ IF(TEXT12.EQ.';')THEN
+ GOTO 500
+* PRINTING INDEX
+ ELSEIF(TEXT12.EQ.'EDIT')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+ IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER DA'
+ 1 //'TA FOR EDIT EXPECTED.')
+ IMPX=MAX(0,NITMA)
+*----
+* ADD NEW PARAMETER
+*----
+ ELSEIF(TEXT12.EQ.'ADD-PARAM')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(TEXT.NE.'PNAME')CALL XABORT('@RESPAR: KEY'
+ 1 //'WORD PNAME EXPECTED.')
+* READ PARAMETER NAME
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+ 1 //' DATA FOR PARAMETER NAME EXPECTED.')
+ IF(IMPX.GT.0)WRITE(IOUT,1000)TEXT
+ IF(NPARM.GT.0)THEN
+ JPMAP=LCMGID(IPMAP,'PARAM')
+ DO IPAR=1,NPARM
+ KPMAP=LCMGIL(JPMAP,IPAR)
+ CALL LCMGET(KPMAP,'P-NAME',INAME)
+ WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+ IF(PNAME.EQ.TEXT)CALL XABORT('@RESPAR: THE '
+ 1 //'PARAMETER '//TEXT//' ALREADY EXISTS.')
+ ENDDO
+ ENDIF
+ NPARM=NPARM+1
+ JPMAP=LCMLID(IPMAP,'PARAM',NPARM)
+ KPMAP=LCMDIL(JPMAP,NPARM)
+ READ(TEXT,'(3A4)') (INAME(I),I=1,3)
+ CALL LCMPUT(KPMAP,'P-NAME',3,3,INAME)
+* READ PARKEY NAME
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(TEXT.NE.'PARKEY')CALL XABORT('@RESPAR: KEY'
+ 1 //'WORD PARKEY EXPECTED.')
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+ 1 //' DATA FOR PARKEY NAME EXPECTED.')
+ READ(TEXT,'(3A4)') (INAME(I),I=1,3)
+ CALL LCMPUT(KPMAP,'PARKEY',3,3,INAME)
+* READ PARAMETER TYPE
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(TEXT.EQ.'GLOBAL')THEN
+ IPTYP=1
+ ELSEIF(TEXT.EQ.'LOCAL')THEN
+ IPTYP=2
+ ELSE
+ CALL XABORT('@RESPAR: INVALID KEYWORD '//TEXT)
+ ENDIF
+ CALL LCMPUT(KPMAP,'P-TYPE',1,1,IPTYP)
+ ISTATE(8)=NPARM
+*----
+* SET PARAMETER VALUES
+*----
+ ELSEIF(TEXT12.EQ.'SET-PARAM')THEN
+ IF(NPARM.EQ.0)CALL XABORT('@RESPAR: PARAM'
+ 1 //'ETER NOT YET DEFINED NPARM=0')
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACT'
+ 1 //'ER DATA FOR PARAMETER NAME EXPECTED.')
+* RECOVER PARAMETER
+ JPMAP=LCMGID(IPMAP,'PARAM')
+ DO IPAR=1,NPARM
+ KPMAP=LCMGIL(JPMAP,IPAR)
+ CALL LCMGET(KPMAP,'P-NAME',INAME)
+ WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+ IF(PNAME.EQ.TEXT)THEN
+ CALL LCMGET(KPMAP,'P-TYPE',IPTYP)
+ GOTO 30
+ ENDIF
+ ENDDO
+ CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+ 1 //'TER WITH PNAME '//TEXT)
+ 20 IF(IMPX.GT.0)WRITE(IOUT,1001)TEXT
+ 30 IF(IPTYP.EQ.1)THEN
+* GLOBAL PARAMETER
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF((ITYP.EQ.3).AND.(TEXT.EQ.'OLDMAP')) THEN
+ IPTYP=11
+ GOTO 20
+ ENDIF
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+ 1 //' DATA or OLDMAP keyword FOR VALUE EXPECTED.')
+ CALL LCMPUT(KPMAP,'P-VALUE',1,2,FLOT)
+ ELSE
+* LOCAL PARAMETER
+ VALUE(:NCH,:NB)=0.0
+ IF(IPTYP.NE.11) CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(TEXT.EQ.'SAME')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ DO ICH=1,NCH
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) THEN
+ IF(ITYP.EQ.2)VALUE(ICH,IB)=FLOT
+ IF(ITYP.EQ.3)CVALUE(ICH,IB)=TEXT
+ ENDIF
+ ENDDO
+ ENDDO
+*
+ ELSEIF(TEXT.EQ.'CHAN')THEN
+ DO ICH=1,NCH
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+ 1 //' DATA FOR VALUE EXPECTED.')
+ DO 40 IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+ 40 CONTINUE
+ ENDDO
+*
+ ELSEIF(TEXT.EQ.'BUND')THEN
+ DO 55 IB=1,NB
+ DO 50 ICH=1,NCH
+ IF(FMIX(ICH,IB).EQ.0) GO TO 50
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.EQ.2)VALUE(ICH,IB)=FLOT
+ IF(ITYP.EQ.3)CVALUE(ICH,IB)=TEXT
+ 50 CONTINUE
+ 55 CONTINUE
+ ELSEIF(TEXT.EQ.'TIMES')THEN
+! try to find the parameters called DMOD
+ CALL REDGET(ITYP,NITMA,FLOT,KEYN,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+ 1 //' DATA FOR VALUE EXPECTED.')
+ JPMAP=LCMGID(IPMAP,'PARAM')
+ DO IPAR=1,NPARM
+ ZPMAP=LCMGIL(JPMAP,IPAR)
+ CALL LCMGET(ZPMAP,'P-NAME',INAME)
+ WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+ IF(PNAME.EQ.KEYN)THEN
+ CALL LCMGET(ZPMAP,'P-TYPE',IPTYP)
+ GOTO 60
+ ENDIF
+ ENDDO
+ CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+ 1 //'TER WITH PNAME '//KEYN)
+ 60 CONTINUE
+ ALLOCATE(DENSMOD(NCH*NB))
+ CALL LCMGET(ZPMAP,'P-VALUE',DENSMOD)
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3.OR.TEXT.NE.'SAME')CALL XABORT('@RESPAR:'
+ 1 //' KEYWORD SAME EXPECTED.')
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+ DO IB=1,NB
+ DO ICH=1,NCH
+ IF(FMIX(ICH,IB).NE.0) THEN
+ VALUE(ICH,IB)=FLOT*DENSMOD(ICH+(IB-1)*NCH)
+ ENDIF
+ ENDDO
+ ENDDO
+ DEALLOCATE(DENSMOD)
+* R. Chambon - begin
+ ELSEIF(TEXT.EQ.'OLDMAP')THEN
+ IF(.NOT.LMAP2) CALL XABORT('@RESPAR: SECOND'
+ 1 //' L_MAP EXPECTED.')
+ CALL LCMGET(IPMP2,'STATE-VECTOR',ISTAT2)
+ NPARM2=ISTAT2(8)
+ JPMP2=LCMGID(IPMP2,'PARAM')
+ DO IPAR=1,NPARM2
+ KPMP2=LCMGIL(JPMP2,IPAR)
+ CALL LCMGET(KPMP2,'P-NAME',INAME)
+ WRITE(PNAME2,'(3A4)') (INAME(I),I=1,3)
+ IF(PNAME.EQ.PNAME2)THEN
+ GOTO 70
+ ENDIF
+ ENDDO
+ CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+ 1 //'TER WITH PNAME in second L_MAP '//TEXT)
+ 70 CALL LCMLEN(KPMP2,'P-VALUE',NITMA,INDIC)
+ IF(NITMA.EQ.0) CALL XABORT('@RESPAR: Record BURN-INST in '
+ 1 //'SECOND L_MAP EXPECTED.')
+ ALLOCATE(VAL2(NITMA))
+ CALL LCMGET(KPMP2,'P-VALUE',VAL2)
+* global parameter
+ IF(NITMA.EQ.1) THEN
+ VALUE(1,1)=VAL2(1)
+* recovered from previous calculation with the same geometry
+* but not the same initialization part
+* example: homogeneous calculation followed by a pin power
+* reconstruction
+ ELSEIF(NITMA.EQ.NCH*NB) THEN
+ DO ICH=1,NCH
+ DO IB=1,NB
+ I=ICH+(IB-1)*NCH
+ VALUE(ICH,IB)=VAL2(I)
+ ENDDO
+ ENDDO
+* recovered from previous calculation with a different geometry
+* the second geometry must correspond to the assembly geometry
+* of the new geometry
+* examples: homogeneous calculation followed by a heterogeneous
+* calculation
+* homogeneous calculation followed by a pin power
+* calculation
+ ELSEIF(NITMA.EQ.NASB*NB) THEN
+ CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+ DO ICH=1,NCH
+ DO IB=1,NB
+ VALUE(ICH,IB)=VAL2(IAZ(ICH)+(IB-1)*NCH)
+ ENDDO
+ ENDDO
+ ENDIF
+ DEALLOCATE(VAL2)
+* R. Chambon - End
+ ELSEIF(TEXT.EQ.'LEVEL')THEN
+* move a control rod over each channel
+ ITOP=1
+ 75 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER DATA H+, H-,'
+ 1 //'SAME OR CHAN EXPECTED.')
+ IF(TEXT.EQ.'H+')THEN
+* PWR-type moving rod
+ ITOP=1
+ GO TO 75
+ ELSEIF(TEXT.EQ.'H-')THEN
+* BWR-type moving rod
+ ITOP=-1
+ GO TO 75
+ ELSEIF(TEXT.EQ.'SAME') THEN
+ CALL REDGET(ITYP,NITMA,ZLEVEL,TEXT,DFLOT)
+ IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+ ENDIF
+ JPMAP=LCMGID(IPMAP,'GEOMAP')
+ CALL LCMGET(JPMAP,'STATE-VECTOR',ISTAT2)
+ NX=ISTAT2(3)
+ NY=ISTAT2(4)
+ NZ=ISTAT2(5)
+ NEL=ISTAT2(6)
+ IF((ISTAT2(1).EQ.9).AND.(NY.EQ.0)) NY=1
+ ALLOCATE(ZZ(NZ+1),NUM(NEL),IND(NZ),VB(NB))
+ CALL LCMGET(JPMAP,'MESHZ',ZZ)
+ CALL LCMGET(IPMAP,'BMIX',NUM)
+ ICH=0
+ DO 105 IY=1,NY
+ DO 100 IX=1,NX
+ IEL=(IY-1)*NX+IX
+ DO 80 IZ=1,NZ
+ IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 90
+ 80 CONTINUE
+ GO TO 100
+ 90 ICH=ICH+1
+ IF(TEXT.EQ.'CHAN') THEN
+ CALL REDGET(ITYP,NITMA,ZLEVEL,TEXT,DFLOT)
+ IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+ ENDIF
+ IF((ZLEVEL.LT.0.0).OR.(ZLEVEL.GT.1.0)) THEN
+ CALL XABORT('@RESPAR: 0<=LEVEL<=1 EXPECTED.')
+ ENDIF
+ IB=0
+ DO IZ=1,NZ
+ IND(IZ)=0
+ IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) CYCLE
+ IB=IB+1
+ IND(IZ)=IB
+ ENDDO
+ IF(IB.NE.NB) CALL XABORT('@RESPAR: INVALID NUMBER OF BUNDL'
+ 1 //'ES.')
+ CALL RESROD(NB,NZ,ZZ,IND,ZLEVEL,ITOP,VB)
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=VB(IB)
+ ENDDO
+ 100 CONTINUE
+ 105 CONTINUE
+ IF(ICH.NE.NCH) CALL XABORT('@RESPAR: INVALID NUMBER OF CHA'
+ 1 //'NNELS.')
+ DEALLOCATE(VB,IND,NUM,ZZ)
+ ELSE
+ CALL XABORT('@RESPAR: INVALID KEYWORD '//TEXT)
+ ENDIF
+ IF(ITYP.EQ.2)CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,VALUE)
+ IF(ITYP.EQ.3)CALL LCMPTC(KPMAP,'P-VALUE',12,NCH*NB,CVALUE)
+ IF(ITYP.EQ.11)CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE(1,1))
+ ENDIF
+*----
+* CHANNEL REFUELLING SCHEMES
+*----
+ ELSEIF(TEXT12.EQ.'REF-SHIFT')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1002)
+* BUNDLE-SHIFT NUMBERS, BIDIRECTIONAL
+ IBSH(:NCOMB)=0
+ DIRREF(:NCOMB)=-1
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.EQ.1)THEN
+ IF(NITMA.LE.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR:'
+ 1 //' BUNDLE-SHIFT MUST BE POSITIVE AND NON-ZERO NUMBER'
+ 1 //' AND MAX EQUAL TO NUMBER OF FUEL BUNDLES PER CHANNEL')
+ DO 110 ICZ=1,NCOMB
+ IBSH(ICZ)=NITMA
+ 110 CONTINUE
+ ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'COMB'))THEN
+ DO ICZ=1,NCOMB
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER BUNDLE'
+ 1 //'-SHIFT NUMBER PER COMBUSTION-ZONE EXPECTED.')
+ IF(NITMA.LE.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR:'
+ 1 //' BUNDLE-SHIFT MUST BE POSITIVE AND NON-ZERO NUMBER.'
+ 1 //' AND MAX EQUAL TO NUMBER OF FUEL BUNDLES PER CHANNEL')
+ IBSH(ICZ)=NITMA
+ ENDDO
+* I. Trancart begin
+ ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'SHUFF'))THEN
+ IPAT(:NCOMB)=0
+ MPAT=0
+ DO ICZ=1,NCOMB
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER SHUFFLING'
+ 1 //' PATTERN INDEX PER COMBUSTION-ZONE EXPECTED.')
+ IF(NITMA.LE.0.OR.NITMA.GT.NCOMB)CALL XABORT('@RESPAR:'
+ 1 //' SHUFFLING PATTERN INDEX MUST BE POSITIVE AND NON-ZERO '
+ 1 //'NUMBER AND MAX EQUAL TO NUMBER OF COMBUSTION ZONES.')
+ IPAT(ICZ)=NITMA
+ IF(NITMA.GT.MPAT)THEN
+ MPAT=NITMA
+ ENDIF
+ ENDDO
+ IF(IMPX.GT.0)WRITE(IOUT,1010)MPAT
+ ALLOCATE(VPAT(MPAT*NB))
+ SHPAT(:MPAT)=0
+ SHDIR(:MPAT)=0
+ DO ICP=1,MPAT
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER PATTERN'
+ 1 //' EXPECTED ('//TEXT12//'). NOT ENOUGH PATTERN ADDED '
+ 2 //' OR MISSING BUNDLES ON PREVIOUS PATTERN.')
+ IF(TEXT12.NE.'PATTERN')CALL XABORT('@RESPAR: KEYWORD PAT'
+ 1 //'TERN EXPECTED ('//TEXT12//').')
+ SHREF=0
+ DO IREF=1,NB
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+ IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER DATA '
+ 1 //' EXPECTED FOR SHUFFLING.')
+ IF(NITMA.LT.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR: '
+ 1 //' WRONG REFUELLING POSITION FOR BUNDLE SHUFFLING. ')
+ VPAT((ICP-1)*NB+IREF)=NITMA
+ IF(NITMA.EQ.0)THEN
+ SHREF=SHREF+1
+ ENDIF
+ ENDDO
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER DATA '
+ 1 //' EXPECTED FOR COOLANT FLOW.')
+ IF(TEXT12.EQ.'UNIDIR')THEN
+ SHDIR(ICP)=1
+ IF(IMPX.GT.1)WRITE(IOUT,1009)
+ ELSEIF(TEXT12.EQ.'BIDIR')THEN
+ SHDIR(ICP)=-1
+ ELSE
+ CALL XABORT('@RESPAR: UNIDIR OR BIDIR INFORMATION'
+ 1 //' EXPECTED FOR COOLANT FLOW.')
+ ENDIF
+ SHPAT(ICP)=SHREF
+ ENDDO
+ IVECT(:NCOMB,:NB)=0
+ IBSH(:NCOMB)=0
+ DO IB=1,NB
+ DO ICZ=1,NCOMB
+ IVECT(ICZ,IB)=VPAT((IPAT(ICZ)-1)*NB+IB)
+ IBSH(ICZ)=SHPAT(IPAT(ICZ))
+ DIRREF(ICZ)=SHDIR(IPAT(ICZ))
+ ENDDO
+ ENDDO
+ DEALLOCATE(VPAT)
+ GO TO 125
+* I. Trancart end
+ ELSE
+ CALL XABORT('@RESPAR: INVALID INPUT FOR REF-SHIFT.')
+ ENDIF
+* REFUELLING VECTOR
+ IVECT(:NCOMB,:NB)=0
+ DO 120 ICZ=1,NCOMB
+ ISHIFT=IBSH(ICZ)
+ IF(ISHIFT.EQ.NB)GOTO 120
+ NREF=NB-ISHIFT
+ DO IREF=1,NREF
+ IPOS=ISHIFT+IREF
+ IVECT(ICZ,IPOS)=IREF
+ ENDDO
+ 120 CONTINUE
+ 125 CALL LCMPUT(IPMAP,'REF-SHIFT',NCOMB,1,IBSH)
+ CALL LCMPUT(IPMAP,'REF-VECTOR',NCOMB*NB,1,IVECT)
+* CHANNEL REFUELLING SCHEMES
+ CALL LCMGET(IPMAP,'B-ZONE',IZONE)
+ CALL LCMGET(IPMAP,'BMIX',MIX)
+ NSCH(:NCH)=0
+ IEL=0
+ ICH=0
+ DO 135 IY=1,NY
+ DO 130 IX=1,NX
+ IEL=IEL+1
+ IF(MIX(IEL).EQ.0)GOTO 130
+ ICH=ICH+1
+ ISHIFT=IBSH(IZONE(ICH))
+ NSCH(ICH)=((DIRREF(IZONE(ICH)))**(IEL+IY-1))*ISHIFT
+ 130 CONTINUE
+ 135 CONTINUE
+ CALL LCMPUT(IPMAP,'REF-SCHEME',NCH,1,NSCH)
+ LRSCH=.TRUE.
+*----
+* BURNUP INTERPOLATION TYPE
+*----
+ ELSEIF(TEXT12.EQ.'BTYPE')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: BURN'
+ 1 //'UP INTERPOLATION OPTION EXPECTED.')
+ IBTYP=0
+ IF(TEXT.EQ.'TIMAV-BURN')THEN
+ IBTYP=1
+ ELSEIF(TEXT.EQ.'INST-BURN')THEN
+ IBTYP=2
+ ELSE
+ CALL XABORT('@RESPAR: INVALID INPUT FOR BTYPE.')
+ ENDIF
+ ISTATE(5)=IBTYP
+*----
+* AVERAGE EXIT BURNUPS
+*----
+ ELSEIF(TEXT12.EQ.'TIMAV-BVAL')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1003)
+ ALLOCATE(BRN(NCOMB))
+ BRN(:NCOMB)=0.0
+ DO ICZ=1,NCOMB
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(1).')
+ IF(FLOT.LE.0.)CALL XABORT('@RESPAR: INVALID'
+ 1 //' DATA FOR AVERAGE BURNUP VALUE =0.')
+ BRN(ICZ)=FLOT
+ ENDDO
+ CALL LCMPUT(IPMAP,'BURN-AVG',NCOMB,2,BRN)
+ DEALLOCATE(BRN)
+ LBURN=.TRUE.
+*----
+* INSTANTANEOUS BURNUPS
+*----
+ ELSEIF(TEXT12.EQ.'INST-BVAL')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1004)
+ VALUE(:NCH,:NB)=0.0
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWORD'
+ 1 //' SAME|CHAN|BUND EXPECTED (1).')
+ IF(TEXT.EQ.'BUND')THEN
+ DO IB=1,NB
+ DO ICH=1,NCH
+ IF(FMIX(ICH,IB).NE.0) THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR BURNUP VALUE <0.')
+ VALUE(ICH,IB)=FLOT
+ ENDIF
+ ENDDO
+ ENDDO
+ ELSEIF(TEXT.EQ.'CHAN')THEN
+ DO ICH=1,NCH
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR BURNUP VALUE <0.')
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+ ENDDO
+ ENDDO
+ ELSEIF(TEXT.EQ.'ASBL')THEN
+ IF(NASB.EQ.0)CALL XABORT('@RESPAR: ASSEMBLY'
+ 1 //' NOT DEFINED.')
+ ALLOCATE(BASS(NASB))
+ DO IASS=1,NASB
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR BURNUP VALUE <0.')
+ BASS(IASS)=FLOT
+ ENDDO
+ CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+ DO ICH=1,NCH
+ DO IB=1,NB
+ VALUE(ICH,IB)=BASS(IAZ(ICH))
+ ENDDO
+ ENDDO
+ DEALLOCATE(BASS)
+ ELSEIF(TEXT.EQ.'SAME')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR BURNUP VALUE <0.')
+ DO ICH=1,NCH
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+ ENDDO
+ ENDDO
+* R. Chambon - begin
+ ELSEIF(TEXT.EQ.'OLDMAP')THEN
+ IF(.NOT.LMAP2) CALL XABORT('@RESPAR: SECOND'
+ 1 //' L_MAP EXPECTED.')
+ CALL LCMLEN(IPMP2,'BURN-INST',NITMA,INDIC)
+ IF(NITMA.EQ.0) CALL XABORT('@RESPAR: Record BURN-INST in '
+ 1 //'SECOND L_MAP EXPECTED.')
+ ALLOCATE(VAL2(NITMA))
+ CALL LCMGET(IPMP2,'BURN-INST',VAL2)
+* recovered from previous calculation with the same geometry but
+* not the same initialization part
+* example: homogeneous calculation followed by a pin power
+* reconstruction
+ IF(NITMA.EQ.NCH*NB) THEN
+ DO ICH=1,NCH
+ DO IB=1,NB
+ I=ICH+(IB-1)*NCH
+ VALUE(ICH,IB)=VAL2(I)
+ ENDDO
+ ENDDO
+* recovered from previous calculation with a different geometry
+* the second geometry must correspond to the assembly geometry
+* of the new geometry
+* examples: homogeneous calculation followed by a heterogeneous
+* calculation
+* homogeneous calculation followed by a pin power
+* calculation
+ ELSEIF(NITMA.EQ.NASB*NB) THEN
+ CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+ DO ICH=1,NCH
+ DO IB=1,NB
+ VALUE(ICH,IB)=VAL2(IAZ(ICH)+(IB-1)*NCH)
+ ENDDO
+ ENDDO
+ ENDIF
+ DEALLOCATE(VAL2)
+* R. Chambon - End
+ ELSEIF(TEXT.EQ.'SMOOTH')THEN
+* EACH 'BURN-INST' WILL HAVE THE SAME BURNUP AS THEIR FIRST INDEX IN 'FLMIX'
+ CALL LCMGET(IPMAP,'BURN-INST',VALUE)
+ DO ICH=1,NCH
+ DO IB=1,NB
+ JBKEEP=0
+ DO JCH=1,NCH
+ DO JB=1,NB
+* FIRST INDEX OF FMIX(ICH,IB) IS AT JCH,JB
+ JBKEEP=JB
+ IF(FMIX(ICH,IB).EQ.FMIX(JCH,JB)) GOTO 140
+ ENDDO
+ ENDDO
+ CALL XABORT('@RESPAR: ASSERTION ERROR (NO FIRST INDEX)')
+ 140 VALUE(ICH,IB)=VALUE(JCH,JBKEEP)
+ ENDDO
+ ENDDO
+ ELSE
+ CALL XABORT('@RESPAR: KEYWORD'
+ 1 //' SAME|CHAN|BUND|ASBL|OLDMAP|SMOOTH EXPECTED (2).')
+ ENDIF
+ CALL LCMPUT(IPMAP,'BURN-INST',NCH*NB,2,VALUE)
+*----
+* BUNDLE POWERS IN KW
+*----
+ ELSEIF(TEXT12.EQ.'BUNDLE-POW')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1006)
+ POWER(:NCH,:NB)=0.0
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWORD'
+ 1 //' BUND|CHAN|SAME EXPECTED (3).')
+ IF(TEXT.EQ.'BUND')THEN
+ DO IB=1,NB
+ DO ICH=1,NCH
+ IF(FMIX(ICH,IB).NE.0) THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR POWER VALUE EXPECTED(1).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR POWER VALUE <0.')
+ POWER(ICH,IB)=FLOT
+ ENDIF
+ ENDDO
+ ENDDO
+ ELSEIF(TEXT.EQ.'CHAN')THEN
+ DO ICH=1,NCH
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR POWER VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR POWER VALUE <0.')
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) POWER(ICH,IB)=FLOT
+ ENDDO
+ ENDDO
+ ELSEIF(TEXT.EQ.'SAME')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR BURNUP VALUE EXPECTED(2).')
+ IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR POWER VALUE <0.')
+ DO ICH=1,NCH
+ DO IB=1,NB
+ IF(FMIX(ICH,IB).NE.0) POWER(ICH,IB)=FLOT
+ ENDDO
+ ENDDO
+ ELSE
+ CALL XABORT('@RESPAR: KEYWORD SAME|CHAN|BUND EXPECTED (4).')
+ ENDIF
+ CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWER)
+ PTOT=0.0
+ DO ICH=1,NCH
+ DO IB=1,NB
+ PTOT=PTOT+POWER(ICH,IB)
+ ENDDO
+ ENDDO
+ PTOT=PTOT/1.0E3
+ CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT)
+*----
+* AXIAL POWERS FORM FACTORS
+*----
+ ELSEIF(TEXT12.EQ.'AXIAL-PFORM')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1007)
+ IF(PTOT.EQ.0.0)CALL XABORT('@RESPAR: FULL REACTOR POWER NOT S'
+ 1 //'ET.')
+ FPOWER(:NB)=0.0
+ DO IB=1,NB
+ CALL REDGET(ITYP,NITMA,FPOWER(IB),TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA FOR POWERS FOR'
+ 1 //'M FACTORS VALUE EXPECTED.')
+ IF(FPOWER(IB).LT.0.)CALL XABORT('@RESPAR: INVALID DATA FOR '
+ 1 //'POWERS FORM FACTORS VALUE <0.')
+ ENDDO
+ CALL LCMPUT(IPMAP,'AXIAL-FPW',NB,2,FPOWER)
+ DSUM=0.0
+ DO IB=1,NB
+ DSUM=DSUM+FPOWER(IB)
+ ENDDO
+ DO ICH=1,NCH
+ DO IB=1,NB
+ POWER(ICH,IB)=FPOWER(IB)*PTOT*1.0E3/(DSUM*REAL(NCH))
+ ENDDO
+ ENDDO
+ CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWER)
+*----
+* FULL REACTOR POWER IN MW
+*----
+ ELSEIF(TEXT12.EQ.'REACTOR-POW')THEN
+ IF(IMPX.GT.0)WRITE(IOUT,1008)
+ CALL REDGET(ITYP,NITMA,PTOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+ 1 //' FOR FULL REACTOR POWER VALUE EXPECTED.')
+ IF(PTOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+ 1 //'TA FOR FULL REACTOR POWER VALUE <0.')
+ CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT)
+*----
+* FUEL-TYPE DATA
+*----
+ ELSEIF(TEXT12.EQ.'FUEL')THEN
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWO'
+ 1 //'RD FOR FUEL-TYPE PARAMETER EXPECTED.')
+ IF((TEXT.NE.'WEIGHT').AND.(TEXT.NE.'ENRICH').AND.
+ 1 (TEXT.NE.'POISON'))CALL XABORT('@RESPAR: INVAL'
+ 2 //'ID INPUT FOR FUEL.')
+ IF(IMPX.GT.0)WRITE(IOUT,1005)TEXT
+ JPMAP=LCMLID(IPMAP,'FUEL',NFUEL)
+ DO IFUEL=1,NFUEL
+ CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+ IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+ 1 //' DATA PER EACH FUEL-TYPE EXPECTED.')
+ KPMAP=LCMDIL(JPMAP,IFUEL)
+ CALL LCMPUT(KPMAP,TEXT,1,2,FLOT)
+ IF(IMPX.GT.0)CALL LCMLIB(KPMAP)
+ ENDDO
+ ELSEIF(TEXT12.EQ.'CELL')THEN
+ ALLOCATE(ALCH(NCH))
+ DO 150 I=1,NCH
+ CALL REDGET(INDIC,ALCH(I),FLOTT,TEXT12,DFLOT)
+ IF(INDIC.NE.1) CALL XABORT('@RESPAR: INTEGER DATA EXPECTED.')
+ 150 CONTINUE
+ CALL RESCEL(IPMAP,NCH,NB,ALCH)
+ DEALLOCATE(ALCH)
+ ISTATE(5)=2
+ ELSE
+ CALL XABORT('@RESPAR: WRONG KEYWORD '//TEXT12)
+ ENDIF
+ GOTO 10
+ 500 IF(LRSCH.OR.LBURN)CALL RESBRN(IPMAP,NCH,NB,NCOMB,
+ 1 NX,NY,NZ,LRSCH,IMPX)
+ RETURN
+*
+ 1000 FORMAT(/1X,'INPUT OF NEW PARAMETER: ',A12)
+ 1001 FORMAT(/1X,'READING VALUES FOR PARAMETER: ',A12)
+ 1002 FORMAT(/1X,'READING INPUT FOR REF-SHIFT')
+ 1003 FORMAT(/1X,'READING AVERAGE EXIT BURNUPS')
+ 1004 FORMAT(/1X,'READING INSTANTANEOUS BURNUPS')
+ 1005 FORMAT(/1X,'READING DATA FOR FUEL-TYPE PARAMETER: ',A12)
+ 1006 FORMAT(/1X,'READING BUNDLE POWERS IN KW')
+ 1007 FORMAT(/1X,'READING BUNDLE POWERS FORM FACTORS')
+ 1008 FORMAT(/1X,'READING FULL REACTOR POWER IN MW')
+ 1009 FORMAT(/5X,'UNIDIRECTIONAL REFUELLING FOR PATTERN: ',I3)
+ 1010 FORMAT(/5X,'READING SHUFFLING PATTERNS: ',I3)
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 16:55:36 +0000