diff options
Diffstat (limited to 'Donjon/src/RESBRN.f')
| -rw-r--r-- | Donjon/src/RESBRN.f | 201 |
1 files changed, 201 insertions, 0 deletions
diff --git a/Donjon/src/RESBRN.f b/Donjon/src/RESBRN.f new file mode 100644 index 0000000..aaedbe1 --- /dev/null +++ b/Donjon/src/RESBRN.f @@ -0,0 +1,201 @@ +*DECK RESBRN + SUBROUTINE RESBRN(IPMAP,NCH,NB,NCOMB,NX,NY,NZ,LRSCH,IMPX) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Initialize the axial shape and compute the first burnup limits per +* bundle for every channel (used for the time-average model). +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal +* +*Author(s): +* D. Sekki, I. Trancart +* +*Parameters: input +* IPMAP pointer to fuel-map information. +* NCH number of reactor channels. +* NB number of fuel bundles per channel. +* 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. +* LRSCH flag for the refuelling scheme of channels: +* =.true. it was read from the input file; +* =.false. otherwise. +* IMPX printing index (=0 for no print). +* +*---------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMAP + INTEGER NCH,NB,NCOMB,NX,NY,NZ,IMPX + LOGICAL LRSCH +*---- +* LOCAL VARIABLES +*---- + PARAMETER(IOUT=6) + INTEGER IVECT(NCOMB,NB),NSCH(NCH),IZONE(NCH),MIX(NX*NY*NZ), + 1 NAMX(NX),NAMY(NY),RSCH(NX,NY),AGLIM,CHR(NB) + REAL BVAL(NCOMB),DELT(NB),B0(NB),B1(NB),SHAP(NCH,NB), + 1 BURN0(NCH,NB),BURN1(NCH,NB) + CHARACTER TEXT*12,CHANY*2,FORM1*14,FORM2*14,SHU*3 + LOGICAL LAXSH +*---- +* RECOVER INFORMATION +*---- + CALL LCMLEN(IPMAP,'REF-SCHEME',LENG1,ITYP) + CALL LCMLEN(IPMAP,'BURN-AVG',LENG2,ITYP) + IF((LENG1.EQ.0).OR.(LENG2.EQ.0))GOTO 100 + CALL LCMLEN(IPMAP,'AX-SHAPE',LENG3,ITYP) + IF(LENG3.EQ.0) THEN +* INITIAL FLAT AXIAL-SHAPE + IF(IMPX.GT.0)WRITE(IOUT,1000) + SHAP(:NCH,:NB)=1.0/NB + CALL LCMPUT(IPMAP,'AX-SHAPE',NCH*NB,2,SHAP) + ELSE + CALL LCMGET(IPMAP,'AX-SHAPE',SHAP) + ENDIF + CALL LCMGET(IPMAP,'REF-VECTOR',IVECT) + CALL LCMGET(IPMAP,'REF-SCHEME',NSCH) + CALL LCMGET(IPMAP,'BURN-AVG',BVAL) + CALL LCMGET(IPMAP,'B-ZONE',IZONE) + CALL LCMGET(IPMAP,'BMIX',MIX) + BURN0(:NCH,:NB)=0.0 + BURN1(:NCH,:NB)=0.0 + LAXSH=.FALSE. + IF(IMPX.GT.2)WRITE(IOUT,1004) +*---- +* COMPUTE FIRST BURNUP LIMITS +*---- + ICH=0 + DO 70 IEL=1,NX*NY + IF(MIX(IEL).EQ.0) GOTO 70 + ICH=ICH+1 + IBSH=ABS(NSCH(ICH)) + SHU=' NO' + DO IB=1,NB + DELT(IB)=IBSH*BVAL(IZONE(ICH))*SHAP(ICH,IB) + B0(IB)=0. + B1(IB)=0. +* Axial Shuffling detection + IF(IVECT(IZONE(ICH),IB).GT.IB)THEN + LAXSH=.TRUE. + SHU='YES' + ENDIF + ENDDO +* Burnup attribution with axial Shuffling + IF(LAXSH)THEN + AGLIM=INT(NB/IBSH)+1 + CHR(:NB)=AGLIM +* Two loops on bundle cycles (IA) and number of bundles (IB) + DO 45 IA=0,AGLIM-1 + DO 40 IB=1,NB +* Index ordering + IF (NSCH(ICH).LT.0) THEN + KK=NB-IB+1 + KV=NB-IVECT(IZONE(ICH),IB)+1 + ELSE + KK=IB + KV=IVECT(IZONE(ICH),IB) + ENDIF +* New fuel + IF(IVECT(IZONE(ICH),IB).EQ.0)THEN + CHR(IB)=0 + B0(KK)=0. + B1(KK)=DELT(KK) + ELSE +* Compute new burnup if previous bundle cycle done + IF(CHR(IVECT(IZONE(ICH),IB)).EQ.(IA-1))THEN + CHR(IB)=IA + B0(KK)=B1(KV) + B1(KK)=DELT(KK)+B1(KV) + ENDIF + ENDIF + 40 CONTINUE + 45 CONTINUE +* Burnup attribution without axial Shuffling +* One loop on number of bundles (IB) + ELSE +* NEGATIVE DIRECTION + IF(NSCH(ICH).LT.0)THEN + DO 50 IB=1,NB + KK=NB-IB+1 + KA=NB-IVECT(IZONE(ICH),IB)+1 + IF(IVECT(IZONE(ICH),IB).LE.0)THEN + B0(KK)=0. + ELSE + B0(KK)=B1(KA) + ENDIF + B1(KK)=B0(KK)+DELT(KK) + 50 CONTINUE +* POSITIVE DIRECTION + ELSE + DO 60 IB=1,NB + IF(IVECT(IZONE(ICH),IB).LE.0)THEN + B0(IB)=0. + ELSE + B0(IB)=B1(IVECT(IZONE(ICH),IB)) + ENDIF + B1(IB)=B0(IB)+DELT(IB) + 60 CONTINUE + ENDIF + ENDIF + DO IB=1,NB + BURN0(ICH,IB)=B0(IB) + BURN1(ICH,IB)=B1(IB) + ENDDO + IF(IMPX.GE.3) THEN +* CHECK BURNUP LIMITS + WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH + WRITE(IOUT,1001)TEXT,NSCH(ICH),IZONE(ICH),SHU + WRITE(IOUT,1002)'B0',(B0(IB),IB=1,NB) + WRITE(IOUT,1002)'B1',(B1(IB),IB=1,NB) + ENDIF +* Reset shuffling for next channel + LAXSH=.FALSE. + 70 CONTINUE + CALL LCMPUT(IPMAP,'BURN-BEG',NB*NCH,2,BURN0) + CALL LCMPUT(IPMAP,'BURN-END',NB*NCH,2,BURN1) + IF((.NOT.LRSCH).OR.(IMPX.LT.2))GOTO 100 +*---- +* PRINT CHANNELS REFUELLING SCHEMES +*---- + WRITE(FORM1,'(A4,I2,A8)')'(A4,',NX,'(A3,1X))' + WRITE(FORM2,'(A4,I2,A8)')'(A2,',NX,'(I3,1X))' + CALL LCMGET(IPMAP,'XNAME',NAMX) + CALL LCMGET(IPMAP,'YNAME',NAMY) + RSCH(:NX,:NY)=0 + WRITE(IOUT,1003) + IEL=0 + ICH=0 + DO 85 J=1,NY + DO 80 I=1,NX + IEL=IEL+1 + IF(MIX(IEL).EQ.0) GOTO 80 + ICH=ICH+1 + RSCH(I,J)=NSCH(ICH) + 80 CONTINUE + 85 CONTINUE + WRITE(IOUT,FORM1)' ',(NAMX(I),I=1,NX) + WRITE(IOUT,*)' ' + DO 90 J=1,NY + WRITE(CHANY,'(A2)') (NAMY(J)) + IF(INDEX(CHANY,'-').EQ.1) GOTO 90 + WRITE(IOUT,FORM2)CHANY,(RSCH(I,J),I=1,NX) + 90 CONTINUE + 100 RETURN +* + 1000 FORMAT(/1X,'INITIALIZING THE FLAT AXIAL POWER-SHAPE'/ + 1 1X,'COMPUTING THE FIRST BURNUP LIMITS PER EACH CHANNEL'/) + 1001 FORMAT(/10X, + 1 A12,10X,'REFUELLING SCHEME:',I3,10X,'ZONE-INDEX:',I3,10X, + 2 'SHUFFLING: ',A3) + 1002 FORMAT(A3,12(F8.1,1X)) + 1003 FORMAT(//20X,'** CHANNELS REFUELLING SCHEMES **'/) + 1004 FORMAT(/20X,'** FIRST BURNUP LIMITS PER EACH CHANNEL **'/) + END |