diff options
Diffstat (limited to 'Donjon/src/SIMPOS.f')
| -rw-r--r-- | Donjon/src/SIMPOS.f | 149 |
1 files changed, 149 insertions, 0 deletions
diff --git a/Donjon/src/SIMPOS.f b/Donjon/src/SIMPOS.f new file mode 100644 index 0000000..b01d1f0 --- /dev/null +++ b/Donjon/src/SIMPOS.f @@ -0,0 +1,149 @@ +*DECK SIMPOS + SUBROUTINE SIMPOS(LX,LY,NCH,NB,HCYC,HOLD,HHX,IHY,ZONE,INFMIX, + > NIS,CYCLE,NAME,BURNUP,FMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Set the correspondance between assembly indices during refuelling. +* +*Copyright: +* Copyright (C) 2013 Ecole Polytechnique de Montreal +* +*Author(s): +* A. Hebert +* +*Parameters: input/output +* LX number of assemblies along the X axis. +* LY number of assemblies along the Y axis. +* NCH number of assemblies or number of quart-of-assemblies. +* NB number of axial burnup subdivisions in an assembly. +* HCYC name of cycle. +* HOLD name of previous cycle. +* HHX naval battle indices along X axis. +* IHY naval battle indices along Y axis. +* ZONE default assembly or quart-of-assembly names as defined in +* the fuel map. +* INFMIX assembly types as defined in the fuel map. +* NIS number of particularized isotopes. +* CYCLE shuffling matrix for refuelling as provided by the plant +* operator. The name "|" is reserved for empty locations. +* NAME names of each assembly or of each quart-of assembly during +* a refuelling cycle. All quart-of-assembly belonging to the +* same assembly have the same name. +* BURNUP burnups during a refuelling cycle. A value of -999.0 means +* a non-initialized value. +* FMIX assembly mixtures after refuelling. +* RFOLLO number densities of the particularized isotopes after +* refuelling. +* ONAME names of each assembly or of each quart-of assembly during +* a previous refuelling cycle. +* OBURNU burnups during a previous refuelling cycle. +* OFMIX assembly types in a previous refuelling cycle. +* OFOLLO number densities of the particularized isotopes at the end +* of a previous refuelling cycle. +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER LX,LY,NCH,NB,IHY(LY),INFMIX(NCH,NB),NIS,FMIX(NCH,NB), + > OFMIX(NCH,NB) + CHARACTER HCYC*12,HOLD*12,HHX(LX)*1,ZONE(NCH)*4,CYCLE(LX,LY)*4, + > NAME(NCH)*12,ONAME(NCH)*12 + REAL BURNUP(NCH,NB),RFOLLO(NCH,NB,NIS),OBURNU(NCH,NB), + > OFOLLO(NCH,NB,NIS) +*---- +* LOCAL VARIABLES +*---- + CHARACTER TEXT4*4,TEXT1*1,HSMG*131 + CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: ZONE2 +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(ZONE2(NCH)) +* + MAXINF=0 + DO 10 ICH=1,NCH + MAXINF=MAX(MAXINF,MAXVAL(INFMIX(ICH,:NB))) + ZONE2(ICH)=ZONE(ICH) + 10 CONTINUE + DO ICH=1,NCH + TEXT4=ZONE(ICH) + READ(TEXT4,'(A1,I2)') TEXT1,INTG2 + INDX=0 + DO IX=1,LX + IF(TEXT1.EQ.HHX(IX)) INDX=IX + ENDDO + IF(INDX.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDX.') + INDY=0 + DO IY=1,LY + IF(INTG2.EQ.IHY(IY)) INDY=IY + ENDDO + IF(INDY.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDY.') + TEXT4=CYCLE(INDX,INDY) + IF((TEXT4.EQ.'|').OR.(TEXT4.EQ.'-').OR.(TEXT4.EQ.'-|-')) THEN + WRITE(HSMG,'(16H@SIMPOS: CHANNEL,I4,21H REFERS TO LOCATION (, + > I4,1H,,I4,37H) WHICH IS OUTSIDE THE CORE AT CYCLE ,A12,1H.)') + > ICH,INDX,INDY,HCYC + CALL XABORT(HSMG) + ELSE IF(TEXT4.EQ.'SPC') THEN + DO IB=1,NB + BURNUP(ICH,IB)=-999.0 + FMIX(ICH,IB)=INFMIX(ICH,IB) + DO ISO=1,NIS + RFOLLO(ICH,IB,ISO)=0.0 + ENDDO + ENDDO + WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8) + ELSE IF(TEXT4.EQ.'NEW') THEN + DO IB=1,NB + BURNUP(ICH,IB)=0.0 + FMIX(ICH,IB)=INFMIX(ICH,IB) + DO ISO=1,NIS + RFOLLO(ICH,IB,ISO)=0.0 + ENDDO + ENDDO + WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8) + ELSE IF(TEXT4(4:).EQ.'@') THEN + READ(TEXT4,'(I3,1X)') NITMA + IF(NITMA.GT.MAXINF) CALL XABORT('@SIMPOS: MAXINF OVERFLOW.') + DO IB=1,NB + BURNUP(ICH,IB)=0.0 + FMIX(ICH,IB)=INFMIX(ICH,IB) + IF(INFMIX(ICH,IB).NE.0) FMIX(ICH,IB)=NITMA + DO ISO=1,NIS + RFOLLO(ICH,IB,ISO)=0.0 + ENDDO + ENDDO + WRITE(NAME(ICH),'(A3,1H/,A8)') 'NEW',HCYC(:8) + ELSE + IF(HOLD.EQ.' ') CALL XABORT('@SIMPOS: NO PREVIOUS CYCLE.') + IOLD=0 + DO ICH2=1,NCH + IF(ZONE2(ICH2).EQ.TEXT4) THEN + IOLD=ICH2 + ZONE2(ICH2)=' ' + GO TO 20 + ENDIF + ENDDO + WRITE(HSMG,'(33H@SIMPOS: UNABLE TO FIND ASSEMBLY ,A4, + > 25HIN THE FUEL MAP AT CYCLE ,A12,1H.)') TEXT4,HCYC + CALL XABORT(HSMG) + 20 DO IB=1,NB + BURNUP(ICH,IB)=OBURNU(IOLD,IB) + FMIX(ICH,IB)=OFMIX(IOLD,IB) + DO ISO=1,NIS + RFOLLO(ICH,IB,ISO)=OFOLLO(IOLD,IB,ISO) + ENDDO + ENDDO + NAME(ICH)=ONAME(IOLD) + ENDIF + ENDDO +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(ZONE2) + RETURN + END |