diff options
Diffstat (limited to 'Donjon/src/TINSHU.f')
| -rw-r--r-- | Donjon/src/TINSHU.f | 274 |
1 files changed, 274 insertions, 0 deletions
diff --git a/Donjon/src/TINSHU.f b/Donjon/src/TINSHU.f new file mode 100644 index 0000000..9c31b9b --- /dev/null +++ b/Donjon/src/TINSHU.f @@ -0,0 +1,274 @@ +*DECK TINSHU + SUBROUTINE TINSHU(IPRES,NCH,NK,NX,NY,NZ,NREG,MS,NAMCHA,NAMCH2, + + WINT,MIX,BS,PS,ISFT,IXN,IYN,IPRT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Compute new burnup values per channel after shuffling of two +* channels +* +*Copyright: +* Copyright (C) 2010 Ecole Polytechnique de Montreal +* +*Author(s): +* E. Varin, M. Guyot +* +*Parameters: input/output +* IPRES Adress of the map Linked_List or XSM file. +* NAMCHA Name of the channel to refuel +* NAMCH2 Name of the channel to refuel +* NS Number of bundles inserted +* MIX Fuel map bundle index +* MS Maximum number of power shift +* +*Parameters: +* NCH +* NK +* NX +* NY +* NZ +* NREG +* WINT +* BS +* PS +* ISFT +* IXN +* IYN +* IPRT +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPRES + INTEGER NCH,NK,NX,NY,NZ,NREG,ILONG,ITYP,IX,IY,IPRT, + 1 ICH1,ICH2,ILS,ITYLCM,IS,MAXS,MS + REAL WINT(NCH,NK),BS(NCH,NK,MS),PS(NCH,NK,MS) + CHARACTER XNAM*4,YNAM*4,NAMCHA*4,NAMCH2*4,TEXT4*4,CS*2 + INTEGER MIX(NREG),IXN(NX),IYN(NY),ISFT(NCH,NK) +*---- +* LOCAL VARIABLES +*---- + INTEGER ICH,IEL,I,J,IZ + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ICHMAP + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDEX + REAL, ALLOCATABLE, DIMENSION(:,:) :: POOL + CHARACTER HSMG*131 +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(ICHMAP(NX,NY),INDEX(NCH,NK),POOL(NCH,NK)) +*---- +* RECOVER INFORMATIONS FROM FUEL MAP OBJECT +*---- + DO 1 I=1,NK + DO 2 J=1,NCH + WINT(J,I) = 0.0 + ISFT(J,I) = 0 + POOL(J,I) = 0.0 + DO 3 IS=1,MS + BS(J,I,IS)=0.0 + PS(J,I,IS)=0.0 + 3 CONTINUE + 2 CONTINUE + 1 CONTINUE +*---- +* RECOVER FUEL BURNUPS +*---- + CALL LCMLEN(IPRES,'BURN-INST',ILONG,ITYP) + IF(ILONG.EQ.0) THEN + CALL XABORT('@TINSHU: INITIAL BURNUP REQUIRED') + ENDIF + CALL LCMGET(IPRES,'BURN-INST',WINT(1,1)) +*---- +* RECOVER FUEL INDEX +*---- + CALL LCMLEN(IPRES,'FLMIX',ILONG,ITYP) + IF(ILONG.NE.0) THEN + CALL LCMGET(IPRES,'FLMIX',INDEX) + ELSE + CALL XABORT('@TINSHU: FLMIX ARE REQUIRED') + ENDIF +*---- +* RECOVER SHIFT VECTOR +*---- + MAXS=0 + CALL LCMLEN(IPRES,'ISHIFT',ILS,ITYLCM) + IF(ILS.NE.0) THEN + CALL LCMGET(IPRES,'ISHIFT',ISFT(1,1)) + DO 16 I=1,NK + DO 15 J=1,NCH + MAXS=MAX(MAXS,ISFT(J,I)) + 15 CONTINUE + 16 CONTINUE + ELSE + MAXS=0 + ENDIF + + IF(MAXS.GT.0) THEN + DO 17 IS=1,MAXS + WRITE (CS,'(I2)') IS + CALL LCMGET(IPRES,'BSHIFT'//CS,BS(1,1,IS)) + CALL LCMGET(IPRES,'PSHIFT'//CS,PS(1,1,IS)) + 17 CONTINUE + ENDIF +*---- +* SET THE CHANNEL INDEX MAP +*---- + CALL LCMSIX(IPRES,' ',0) + CALL LCMGET(IPRES,'BMIX',MIX) + ICHMAP(:NX,:NY)=0 + ICH=0 + DO 26 IY=1,NY + DO 25 IX=1,NX + IEL=(IY-1)*NX+IX + DO 23 IZ=1,NZ + IF(MIX((IZ-1)*NX*NY+IEL).NE.0) GO TO 24 + 23 CONTINUE + GO TO 25 + 24 ICH=ICH+1 + ICHMAP(IX,IY)=ICH + 25 CONTINUE + 26 CONTINUE + IF(ICH.NE.NCH) CALL XABORT('@TINSHU: INVALID NUMBER OF CHANNELS') +*---- +* SEARCH FOR CHANNEL NUMBER TO MOVE +*---- + TEXT4 = NAMCHA(2:3) + IX = 0 + IY = 0 + DO 10 I=1,NX + WRITE(XNAM,'(A4)') IXN(I) + IF (XNAM.EQ.TEXT4) THEN + IX = I + GOTO 11 + ENDIF + 10 CONTINUE + WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)') + + NAMCHA + CALL XABORT(HSMG) + 11 TEXT4 = NAMCHA(1:1) + DO 20 I=1,NY + WRITE(YNAM,'(A4)') IYN(I) + IF (YNAM.EQ.TEXT4) THEN + IY = I + GOTO 21 + ENDIF + 20 CONTINUE + WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)') + + NAMCHA + CALL XABORT(HSMG) + + 21 ICH1 = ICHMAP(IX,IY) + IF(ICH1.EQ.0) THEN + WRITE(6,'(13H @TINSHU: IX=,I6,4H IY=,I6)') IX,IY + WRITE(HSMG,'(23H@TINREF: CHANNEL NAMED ,A4,13H HAS NO FUEL.)') + + NAMCHA + CALL XABORT(HSMG) + ENDIF + IF(IPRT.GT.3) THEN + WRITE(6,*) + WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCHA,ICH1 + WRITE(6,*) ' BEFORE ',NAMCHA,(WINT(ICH1,I),I=1,NK) + ENDIF +*---- +* SEARCH FOR CHANNEL NUMBER WHERE TO MOVE +*---- + IF(NAMCH2.NE.'POOL') THEN + TEXT4 = NAMCH2(2:3) + IX = 1 + IY = 1 + DO 30 I=1,NX + WRITE(XNAM,'(A4)') IXN(I) + IF (XNAM.EQ.TEXT4) THEN + IX = I + GOTO 31 + ENDIF + 30 CONTINUE + WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)') + + NAMCHA + CALL XABORT(HSMG) + 31 TEXT4 = NAMCH2(1:1) + DO 40 I=1,NY + WRITE(YNAM,'(A4)') IYN(I) + IF (YNAM.EQ.TEXT4) THEN + IY = I + GOTO 41 + ENDIF + 40 CONTINUE + WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)') + + NAMCHA + CALL XABORT(HSMG) + + 41 ICH2 = ICHMAP(IX,IY) + IF(ICH2.EQ.0) CALL XABORT('@TINSHU: WRONG CHANNEL NAME') + IF(IPRT.GT.3) THEN + WRITE(6,*) + WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCH2,ICH2 + WRITE(6,*) ' BEFORE ',NAMCH2,(WINT(ICH2,I),I=1,NK) + ENDIF +*---- +* SHUFFLING +*---- + DO 50 I=1,NK + IF(WINT(ICH2,I).NE.0.0) THEN + WRITE(6,*) ' BURNUP ',WINT(ICH2,I) + CALL XABORT('@TINSHU: WRONG POSITION TO SHUFFLE, ' + + //'CHANNEL NOT EMPTY') + ENDIF + WINT(ICH2,I) = WINT(ICH1,I) + WINT(ICH1,I) = 0.0 + ISFT(ICH2,I) = ISFT(ICH1,I) + ISFT(ICH1,I) = 0 + INDEX(ICH2,I) = INDEX(ICH1,I) + IF(MAXS.GT.0) THEN + DO 56 IS=1,MAXS + BS(ICH2,I,IS) = BS(ICH1,I,IS) + PS(ICH2,I,IS) = PS(ICH1,I,IS) + BS(ICH1,I,IS) = 0.0 + PS(ICH1,I,IS) = 0.0 + 56 CONTINUE + ENDIF + 50 CONTINUE + IF(IPRT.GT.3) THEN + WRITE(6,*) + WRITE(6,*) ' AFTER ',NAMCH2,(WINT(ICH2,I),I=1,NK) + ENDIF + ELSE + WRITE(6,*) ' CHANNEL TO POOL ' +*---- +* RECOVER DISCHARGED FUEL BURNUPS +*---- + CALL LCMLEN(IPRES,'BURN-POOL',ILONG,ITYP) + IF(ILONG.NE.0) THEN + CALL LCMGET(IPRES,'BURN-POOL',POOL(1,1)) + ENDIF + DO 51 I=1,NK + POOL(ICH1,I) = WINT(ICH1,I) + WINT(ICH1,I) = 0.0 + 51 CONTINUE + CALL LCMPUT(IPRES,'BURN-POOL',NCH*NK,2,POOL(1,1)) + ENDIF + IF(IPRT.GT.3) + + WRITE(6,*) ' AFTER ',NAMCHA,(WINT(ICH1,I),I=1,NK) + CALL LCMSIX(IPRES,' ',0) + CALL LCMPUT(IPRES,'BURN-INST',NCH*NK,2,WINT(1,1)) + CALL LCMPUT(IPRES,'FLMIX',NCH*NK,1,INDEX(1,1)) + CALL LCMPUT(IPRES,'ISHIFT',NCH*NK,1,ISFT(1,1)) + IF(MAXS.GT.0) THEN + DO 53 IS=1,MAXS + WRITE (CS,'(I2)') IS + CALL LCMPUT(IPRES,'BSHIFT'//CS,NCH*NK,2,BS(1,1,IS)) + CALL LCMPUT(IPRES,'PSHIFT'//CS,NCH*NK,2,PS(1,1,IS)) + 53 CONTINUE + ENDIF +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(POOL,INDEX,ICHMAP) + RETURN + END |