diff options
Diffstat (limited to 'Donjon/src/D2PTH.f')
| -rw-r--r-- | Donjon/src/D2PTH.f | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/Donjon/src/D2PTH.f b/Donjon/src/D2PTH.f new file mode 100644 index 0000000..ffb6a46 --- /dev/null +++ b/Donjon/src/D2PTH.f @@ -0,0 +1,268 @@ +*DECK D2PTH + SUBROUTINE D2PTH( IPDAT, IPMIC , IPRINT, NBU, NGP, NBMIX, + > NFISS, NDEL, NVAR, STAIDX,JOBOPT, FLAG) + +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover T/H inveariant data block and store in INFO/TH_DATA/ +* WARNING: These data are extracted only if the corresponding flag is +* set to T in the GENPMAXS_INP/JOBOPT vector. +* NB 1 : The data for T/H are recovered from the reference state, the +* branching calculation not includes the TH informations. +* NB 3 : The Helios format cannot recover the CHID (delay neutron +* fission spectrum), it is fixed to default values even if JOBOPT(6)=T. +* NB 4 : The Helios format cannot recover the Decay Heat Data (DBET and +* DLAM in GenPMAXS), it is fixed to default values even if JOBOPT(14)=T. +* +*Author(s): +* J. Taforeau +* +*Parameters: input +* IPDAT address of the INFO data block +* IPMIC address of the MICROLIB object +* IPPRINT control the printing on screen +* NGP number of energy groups +* NBU number of burnup point in IPSAP +* NVAR number of state parameters in INFO data block +* NDEL number of delaued neutron groups +* NBMIX number of mixtrures in IPSAP +* NFISS number of fissile isotopes +* STAIDX index of state variables +* FLAG End of a bran calculation (=-1: branch for yields calculation) +* +*Parameters: +* IPRINT +* JOBOPT +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPDAT,IPMIC + INTEGER IPRINT,NVAR,NBU, NBMIX,NGP + INTEGER NFISS,NDEL + INTEGER STAIDX(NVAR) + INTEGER FLAG +*---- +* LOCAL VARIABLES +*---- + TYPE(C_PTR) JPMIC,KPMIC,IPTH,KPTH + PARAMETER(NSTATE=40) + INTEGER DSTATE(NSTATE) + INTEGER NDFI,NDFP,MR,MI,MI_REAL,ITYLCM + INTEGER :: I_PF = 0 + INTEGER :: iso = 1 + REAL YLDI,YLDXe,YLDPm + REAL CHI(NFISS,NGP) + REAL OVERV(NGP),BURN(NBU), STATE(NVAR) + REAL FLX(NGP),NUSIGF_D(NDEL,NGP),NUSIGF(NGP) + REAL BETA_D(NDEL,NFISS),LAMBDA_D(NDEL,NFISS) + REAL NUM(NDEL) + REAL :: DEN = 0.0 + CHARACTER*12 ISOTOPES(4) + CHARACTER*1 JOBOPT(16) + CHARACTER*8 NUSID + CHARACTER*3 YLDOPT + REAL YLDFIX(3) + + + REAL, ALLOCATABLE, DIMENSION(:) :: DEPLETE_ENER,DEPLETE_DECA + REAL, ALLOCATABLE, DIMENSION(:) :: FISSIONYIELD + CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPERNAME + CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPESDEPL,PF + + IF(IPRINT > 1) THEN + WRITE(6,*) + WRITE(6,*) "**************************************************" + WRITE(6,*) "* T/H INVARIANT BLOCK *" + WRITE(6,*) "**************************************************" + WRITE(6,*) + ENDIF + + CALL LCMSIX(IPMIC,' ',0) + CALL LCMSIX(IPMIC,'MACROLIB',1) + + IF(JOBOPT(13)=='T') CALL LCMGET(IPMIC,'LAMBDA-D',LAMBDA_D) + + + + JPMIC=LCMGID(IPMIC,'GROUP') + + IF(NBMIX.NE.1) THEN + CALL XABORT('@D2PTH: MORE THAN ONE MIXTURE IN SAPHYB') + ENDIF + IF(NFISS.NE.1) THEN + CALL XABORT('@D2PTH: MORE THAN 1 FISSILE ISOTOPE IN MACROLIB') + ENDIF + + DO IGR=1,NGP + KPMIC=LCMGIL(JPMIC,IGR) + IF(JOBOPT(7)=='T')CALL LCMGET(KPMIC,'OVERV',OVERV(IGR)) + IF(JOBOPT(5)=='T')CALL LCMGET(KPMIC,'CHI',CHI(1:NFISS,IGR)) + IF(JOBOPT(12)=='T') THEN + CALL LCMGET(KPMIC,'NUSIGF',NUSIGF(IGR)) + CALL LCMGET(KPMIC,'FLUX-INTG',FLX(IGR)) + DO ND=1,NDEL + WRITE(NUSID,' (A6, I2.2)') 'NUSIGF', ND + CALL LCMGET(KPMIC,NUSID,NUSIGF_D(ND,IGR)) + ENDDO + ENDIF + ENDDO + + IF(JOBOPT(12)=='T') THEN + DO ND=1,NDEL + + DEN=0. + NUM(ND)=0.0 + DO IGR= 1,NGP + DEN=DEN+NUSIGF(IGR)*FLX(IGR) + NUM(ND)=NUM(ND)+NUSIGF_D(ND,IGR)*FLX(IGR) + ENDDO + BETA_D(ND,NFISS)=NUM(ND)/DEN + ENDDO +! CALL XABORT ('STOP TEST') + ENDIF + IF(JOBOPT(9)=='T') THEN + + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'SAPHYB_INFO',1) + CALL LCMGTC(IPDAT,'YLD_OPT',3,YLDOPT) + + CALL LCMGET(IPDAT,'YLD_FIX',YLDFIX) + + IF ((YLDOPT=='REF').OR.(YLDOPT=='MAN')) THEN + CALL LCMSIX(IPMIC,' ',0) + CALL LCMLEN(IPMIC,'ISOTOPESDENS',MI_REAL,ITYLCM) + CALL LCMLEN(IPMIC,'ISOTOPERNAME',MI,ITYLCM) + ALLOCATE (ISOTOPERNAME(MI)) + CALL LCMGTC(IPMIC,'ISOTOPERNAME',12,MI,ISOTOPERNAME) + CALL LCMLEN(IPMIC,'DEPL-CHAIN',ILONG,ITYLCM) + IF (ILONG.EQ.0) THEN + YLDI=YLDFIX(1) + YLDXe=YLDFIX(2) + YLDPm=YLDFIX(3) + WRITE(6,*)"@D2PTH : NO RECORD DEPL-CHAIN IN SAP/MCO :" + WRITE(6,*)"=> DEFAULT VALUES FOR FISSION YLDS CONSIDERED" + ELSE + CALL LCMSIX(IPMIC,'DEPL-CHAIN',1) + CALL LCMGET(IPMIC,'STATE-VECTOR',DSTATE) + + NDEPL = DSTATE(1) + NDFI = DSTATE(2) + NDFP = DSTATE(3) + MR = DSTATE(8) + + ALLOCATE (FISSIONYIELD(NDFI*NDFP), DEPLETE_ENER(NDEPL*MR)) + ALLOCATE (ISOTOPESDEPL(NDEPL), PF(NDEPL),DEPLETE_DECA(NDEPL)) + CALL LCMGET(IPMIC,'DEPLETE-DECA',DEPLETE_DECA) + CALL LCMGET(IPMIC,'DEPLETE-ENER',DEPLETE_ENER) + CALL LCMGTC(IPMIC,'ISOTOPESDEPL',12,NDEPL,ISOTOPESDEPL) + + IF ((NDFI.EQ.0 ).OR. (NDFP .EQ. 0)) THEN + WRITE(6,*) "@D2PTH : NUMBER OF DIRECT FISSILE ISOTOPES", + 1 " OR FISSION FRAGMENT IS ZERO" + CALL XABORT('=> PLEASE TURN OFF THE LYLD FLAG IN JOB_OPT' + > //' OR USE THE "YLD FIX" OPTION' ) + ENDIF + CALL LCMGET(IPMIC,'FISSIONYIELD',FISSIONYIELD) + + + I_PF=0 + iso=1 + + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'SAPHYB_INFO',1) + CALL LCMGET(IPDAT,'BURN',BURN) + CALL LCMSIX (IPDAT,'ISOTOPES',1) + CALL LCMGTC (IPDAT,'XE135',12,ISOTOPES(1)) + CALL LCMGTC (IPDAT,'SM149',12,ISOTOPES(2)) + CALL LCMGTC (IPDAT,'I135',12,ISOTOPES(3)) + CALL LCMGTC (IPDAT,'PM149',12,ISOTOPES(4)) + + DO iso=1, NDEPL + IF(INDEX(ISOTOPESDEPL(iso), 'MACR')==0) THEN + + I_PF=I_PF+1 + PF(I_PF)=ISOTOPESDEPL(iso) + IF(PF(I_PF)==ISOTOPES(3)) YLDI=FISSIONYIELD(I_PF) + IF(PF(I_PF)==ISOTOPES(1)) YLDXe=FISSIONYIELD(I_PF) + IF(PF(I_PF)==ISOTOPES(4)) YLDPm=FISSIONYIELD(I_PF) + ENDIF + ENDDO + + IF(IPRINT > 1) THEN + WRITE(6,*)"********* STATE VECTOR INFORMATION *************" + WRITE(6,*) + WRITE(6,*)"Number of isotopes (MI) : ",MI + WRITE(6,*)"Number of groups (NGP) : ",NGP + WRITE(6,*)"Number of fissile isotopes (NFISS) : ",NFISS + WRITE(6,*)"Number of delayed neutron groups (NDEL) : ",NDEL + WRITE(6,*)"Number of depleted isotopes (NDEPL) : ",NDEPL + WRITE(6,*)"Number of direct fissile isotopes (NDFI) : ",NDFI + WRITE(6,*)"Number of fission fragments (NDFP) : ",NDFP + WRITE(6,*)"Maximum number of depleting reactions(MR): ",MR + WRITE(6,*) + WRITE(6,*)"**************** ISOTOPE NAME ******************" + WRITE(6,*) + WRITE(6,'(10A12)')ISOTOPERNAME(1:MI_REAL) + WRITE(6,*) + ENDIF + DEALLOCATE (ISOTOPERNAME) + DEALLOCATE (FISSIONYIELD,ISOTOPESDEPL,PF) + DEALLOCATE (DEPLETE_ENER,DEPLETE_DECA) + ENDIF + ELSE IF (YLDOPT=='FIX') THEN + YLDI=YLDFIX(1) + YLDXe=YLDFIX(2) + YLDPm=YLDFIX(3) + ENDIF + ENDIF + + CALL LCMSIX(IPDAT,' ',0) + CALL LCMSIX(IPDAT,'BRANCH_INFO',1) + CALL LCMGET(IPDAT,'STATE',STATE) + CALL LCMSIX(IPDAT,' ',0) + + IF(STAIDX(NVAR)==1) THEN + IPTH=LCMLID(IPDAT,'TH_DATA',NBU) + ELSE + IPTH=LCMGID(IPDAT,'TH_DATA') + ENDIF + + KPTH=LCMDIL(IPTH,STAIDX(NVAR)) + + IF(JOBOPT(13)=='T') THEN + CALL LCMPUT(KPTH,'LAMBDA',NDEL*NFISS,2,LAMBDA_D) + ENDIF + IF(JOBOPT(9)=='T') THEN + IF((YLDOPT.EQ.'FIX').OR.(YLDOPT.EQ.'REF')) THEN + CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm) + CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe) + CALL LCMPUT(KPTH,'YLDI',1,2,YLDI) + ELSE IF ((YLDOPT.EQ.'MAN').AND.(FLAG.EQ.-1)) THEN + CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm) + CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe) + CALL LCMPUT(KPTH,'YLDI',1,2,YLDI) + ENDIF + ENDIF + + IF(JOBOPT(7)=='T')CALL LCMPUT(KPTH,'OVERV',NGP,2,OVERV) + IF(JOBOPT(5)=='T')CALL LCMPUT(KPTH,'CHI',NFISS*NGP,2,CHI) + IF(JOBOPT(12)=='T')CALL LCMPUT(KPTH,'BETA',NDEL*NFISS,2,BETA_D) + IF(IPRINT > 1) THEN + WRITE(6,*) "**************** T/H INFORMATION *****************" + IF(JOBOPT(5)=='T') WRITE(6,*) "CHI(NFISS,NGP) :",CHI + IF(JOBOPT(7)=='T') WRITE(6,*) "OVERV(NGP) :",OVERV + IF(JOBOPT(13)=='T')WRITE(6,*) "LAMBDA(NDEL,NFISS) :",LAMBDA_D + IF(JOBOPT(12)=='T')WRITE(6,*) "BETA(NDEL,NFISS) :",BETA_D + IF(JOBOPT(9)=='T') WRITE(6,*) "PM-149 YIELD :",YLDPm + IF(JOBOPT(9)=='T') WRITE(6,*) "XE-135 YIELD :",YLDXe + IF(JOBOPT(9)=='T') WRITE(6,*) "I-135 YIELD :",YLDI + WRITE(6,*) + ENDIF + + END |