From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Donjon/src/HSTUHB.f | 327 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 327 insertions(+) create mode 100644 Donjon/src/HSTUHB.f (limited to 'Donjon/src/HSTUHB.f') diff --git a/Donjon/src/HSTUHB.f b/Donjon/src/HSTUHB.f new file mode 100644 index 0000000..8eb1a62 --- /dev/null +++ b/Donjon/src/HSTUHB.f @@ -0,0 +1,327 @@ +*DECK HSTUHB + SUBROUTINE HSTUHB(IPHST, IPEVO, IPRINT, MAXI, NBBTS, NCHA, + > NBUN, IUPDC, IUPDB, IDCELL, IDFUEL, DENI, + > MAXL, PARAML) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To update the HISTORY data structure using the information +* provided on the BURNUP data structure. +* +*Copyright: +* Copyright (C) 2003 Ecole Polytechnique de Montreal. +* +*Author(s): +* G. Marleau, E. Varin +* +*Parameters: input +* IPHST address of the \dds{history} data structure. +* IPEVO address of the \dds{burnup} data structure. +* IPRINT print level. +* MAXI maximum number of isotopes. +* NBBTS number of depletion steps. +* NCHA number of fuel channels. +* NBUN number of bundles per channel. +* IUPDC number of the channel to analyze. +* IUPDB number of the bundle to analyze. +* IDCELL cell identifier for each fuel bundle in each channel. +* IDFUEL fuel type identifier for each fuel bundle in each channel. +* IPHST pointer to the HISTORY data structure +* IPEVO pointer to the BURNUP data structure. +* IPRINT print level. +* MAXI maximum number of isotopes. +* NBBTS number of depletion steps. +* NCHA number of fuel channels. +* NBUN number of bundles per channels. +* IUPDC channel number to process or update. +* IUPDB bundle number to process or update. +* IDCELL list of cell identifiers. +* IDFUEL list of fuel type identifiers. +* MAXL maximum number of local parameters. +* +*Parameters: work +* PARAML local parameters. +* DENI isotopic concentrations of the isotopes +* on the \dds{burnup} or \dds{history} structure. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPHST,IPEVO + INTEGER IPRINT,MAXI,NBBTS,MAXL + INTEGER NCHA,NBUN,IUPDC,IUPDB + INTEGER IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA) + REAL DENI(0:MAXI) + REAL PARAML(0:MAXL,2) +*---- +* LOCAL PARAMETERS +* CDAY = conversion of days in 10^{8} seconds +*---- + INTEGER IOUT + INTEGER ILCMUP,ILCMDN + CHARACTER NAMSBR*6 + PARAMETER (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUHB') + REAL CDAY,TIMPOW(2) + PARAMETER (CDAY=8.64E-4) +*---- +* LOCAL VARIABLES +*---- + INTEGER ILCMLN,ILCMTY + CHARACTER NAMTIM*12,NAMP*12 + INTEGER IFT,ICT,INEWF,INEWC + INTEGER ITS,ISO,IOK + REAL BITH(3),BITB(3) + REAL FDENC(2),FDENF(2),FDENB(2) + REAL REVOL(5) + INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXIH,MIXIB + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMIH,NAMIB + REAL, ALLOCATABLE, DIMENSION(:) :: DEPLT +*---- +* SCRATCH STORAGE ALLOCATION +* NAMIH name of isotopes on the \dds{history} structure. +* MIXIH mixture number associated with the isotopes +* on the \dds{history} structure. +* NAMIB name of isotopes on the \dds{burnup} structure. +* MIXIB mixture number associated with the isotopes +* on the \dds{burnup} structure. +* DEPLT time associated with each depletion step +* on the \dds{burnup} structure. +*---- + ALLOCATE(NAMIH(3,0:MAXI),MIXIH(0:MAXI),NAMIB(3,0:MAXI), + > MIXIB(0:MAXI),DEPLT(0:NBBTS)) +*---- +* Initialize test flags +* INEWF -> new fuel type flag +* = 0 fuel type does not exists/create it +* = 1 fuel exists but does not contain isotopes +* = 2 fuel type exists and contains isotopes +* INEWC -> new cell type flag +* = 0 cell type does not exists/create it +* = 1 cell type exists but isotopes densities missing +* = 2 cell type exists and contains isotope densities +*---- + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6000) NAMSBR + ENDIF + INEWF=2 + INEWC=2 + DENI(0:MAXI)=0.0 + PARAML(0:MAXL,:2)=0.0 + BITH(:3)=0.0 + BITB(:3)=0.0 + FDENC(:2)=0.0 + FDENF(:2)=0.0 + FDENB(:2)=0.0 +*---- +* Read HISTORY information for cell specified +*---- + IF(IUPDC .GT. 0 .AND. IUPDB .GT. 0) THEN +*---- +* Read isotope names and mixtures on FUEL TYPE +* if available +*---- + IFT=IDFUEL(IUPDB,IUPDC) + WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT + CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY) + IF(ILCMLN .EQ. 0) THEN + INEWF=0 + ELSE + CALL LCMSIX(IPHST,NAMP,ILCMUP) + CALL LCMLEN(IPHST,'ISOTOPESUSED',ILCMLN,ILCMTY) + IF(ILCMLN .GT. 0 .AND. ILCMLN .LT. 3*MAXI*4) THEN + CALL LCMGET(IPHST,'ISOTOPESUSED',NAMIH(1,1)) + CALL LCMGET(IPHST,'ISOTOPESMIX',MIXIH(1)) + CALL LCMGET(IPHST,'FUELDEN-INIT',FDENF) + ELSE + INEWF=1 + ENDIF + CALL LCMSIX(IPHST,NAMP,ILCMDN) + ENDIF + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6001) 'FUEL TYPE',IFT + IF(INEWF .EQ. 2) THEN + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6010) + WRITE(IOUT,6011) + > (NAMIH(1,ISO),NAMIH(2,ISO),NAMIH(3,ISO),ISO=1,MAXI) + WRITE(IOUT,6020) + WRITE(IOUT,6021) + > (MIXIH(ISO),ISO=1,MAXI) + ENDIF + ENDIF + ENDIF +*---- +* Read isotope densities on CELL TYPE +* if available +*---- + ICT=IDCELL(IUPDB,IUPDC) + WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT + CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY) + IF(ILCMLN .EQ. 0) THEN + INEWC=0 + ELSE + CALL LCMSIX(IPHST,NAMP,ILCMUP) + IOK=-1 + CALL HSTGSD(IPHST ,MAXI ,IOK ,DENI ,FDENC ) + INEWC=1 + IF(IOK .EQ. 0) THEN + INEWC=2 + CALL LCMGET(IPHST,'DEPL-PARAM ',BITH) + ENDIF + CALL LCMSIX(IPHST,NAMP,ILCMDN) + ENDIF + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6001) 'CELL TYPE',ICT + IF(INEWF .EQ. 2) THEN + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6100) + WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI) + ENDIF + ENDIF + ENDIF +*---- +* Read isotopes names and mixtures on BURNUP +*---- + CALL LCMGET(IPEVO,'ISOTOPESUSED',NAMIB(1,1)) + CALL LCMGET(IPEVO,'ISOTOPESMIX ',MIXIB(1)) + CALL LCMGET(IPEVO,'FUELDEN-INIT',FDENB) +*---- +* Test for coherence of isotopes names and mixture +* between HISTORY and BURNUP if fuel type contains +* isotopes description +*---- + IF(INEWF .EQ. 2) THEN + DO 100 ISO=1,MAXI + IF(NAMIH(ISO,1) .NE. NAMIB(ISO,1) .OR. + > NAMIH(ISO,2) .NE. NAMIB(ISO,2) .OR. + > NAMIH(ISO,3) .NE. NAMIB(ISO,3) .OR. + > MIXIH(ISO) .NE. MIXIB(ISO) ) THEN + CALL XABORT(NAMSBR// + > ': Isotopes on HISTORY and BURNUP not coherent') + ENDIF + 100 CONTINUE + IF(FDENF(1) .NE. FDENB(1) .OR. + > FDENF(2) .NE. FDENB(2) ) THEN + CALL XABORT(NAMSBR// + > ': Fuel DENSITY on HISTORY and BURNUP not coherent') + ENDIF + ENDIF +*---- +* Read calculation types on BURNUP +*---- + CALL LCMGET(IPEVO,'EVOLUTION-R ',REVOL) + DEPLT(0:NBBTS)=0.0 + CALL LCMGET(IPEVO,'DEPL-TIMES ',DEPLT(1)) +*---- +* Read initial burnup information (FOR FUEL TYPE) +* and save +*---- + ITS=1 + IF(INEWF .NE. 2 ) THEN + BITB(1)=DEPLT(ITS)/CDAY + IF(BITB(1) .EQ. 0.0) THEN + WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS + CALL LCMSIX(IPEVO,NAMTIM,ILCMUP) + CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1)) + CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2)) + CALL LCMSIX(IPEVO,NAMTIM,ILCMDN) + ELSE + CALL XABORT(NAMSBR// + > ': Initial DENSITY on BURNUP required') + ENDIF +*---- +* Save isotopes names and mixtures for FUEL type +*---- + WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT + CALL LCMSIX(IPHST,NAMP,ILCMUP) + CALL LCMPUT(IPHST,'ISOTOPESUSED',3*MAXI,3,NAMIB(1,1)) + CALL LCMPUT(IPHST,'ISOTOPESMIX',MAXI ,1,MIXIB(1)) + CALL LCMPUT(IPHST,'FUELDEN-INIT',2 ,2,FDENB) + CALL LCMPUT(IPHST,'ISOTOPESDENS',MAXI ,2,DENI(1)) + CALL LCMSIX(IPHST,NAMP,ILCMDN) + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6010) + WRITE(IOUT,6011) + > (NAMIB(1,ISO),NAMIB(2,ISO),NAMIB(3,ISO),ISO=1,MAXI) + WRITE(IOUT,6020) + WRITE(IOUT,6021) + > (MIXIB(ISO),ISO=1,MAXI) + ENDIF + ELSE + BITB(1)=DEPLT(ITS)/CDAY + WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS + CALL LCMSIX(IPEVO,NAMTIM,ILCMUP) + CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2)) + CALL LCMSIX(IPEVO,NAMTIM,ILCMDN) +*---- +* Test if initial BURNUP coherent with old history +*---- + IF(INEWC .EQ. 2 ) THEN + IF(BITB(1) .NE. BITH(1) .OR. + > BITB(2) .NE. BITH(2) .OR. + > BITB(3) .NE. BITH(3) ) THEN + WRITE(IOUT,6200) BITH(1) + ENDIF + ENDIF + ENDIF + ITS=NBBTS + BITB(1)=DEPLT(ITS)/CDAY + WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS + CALL LCMSIX(IPEVO,NAMTIM,ILCMUP) + CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1)) + CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2)) + CALL LCMSIX(IPEVO,NAMTIM,ILCMDN) +*---- +* Save power desnity and depletion time in History +* Modif EV 04/11/09 +*---- + WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT + CALL LCMSIX(IPHST,NAMP,ILCMUP) + IOK=-2 + CALL HSTGSL(IPHST ,MAXL ,IOK ,TIMPOW,PARAML(0,1)) + IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0 + IOK=2 + TIMPOW(1)= DEPLT(NBBTS)/CDAY + TIMPOW(2)= REVOL(5) + CALL HSTGSL(IPHST ,MAXL ,IOK ,TIMPOW,PARAML(0,1)) +*---- +* Save last densities on BURNUP +*---- + IOK=2 + CALL HSTGSD(IPHST ,MAXI ,IOK ,DENI ,FDENB ) + CALL LCMPUT(IPHST,'DEPL-PARAM ',3,2,BITB) + CALL LCMSIX(IPHST,NAMP,ILCMDN) + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6101) + WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI) + ENDIF + ENDIF +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(DEPLT,MIXIB,NAMIB,MIXIH,NAMIH) +*---- +* Return +*---- + RETURN +*---- +* FORMAT +*---- + 6000 FORMAT(' ****** OUTPUT FROM ',A6) + 6001 FORMAT(' Contents of ',A9,1X,I8) + 6010 FORMAT(' NAME OF ISOTOPES ') + 6011 FORMAT(10(3A4,2X)) + 6020 FORMAT(' MIXTURE OF ISOTOPES ') + 6021 FORMAT(10(I12,2X)) + 6100 FORMAT(' INITIAL DENSITIES') + 6101 FORMAT(' FINAL DENSITIES') + 6110 FORMAT(1P,10E14.7) + 6200 FORMAT(' Update cell densities with no chronological burnup'/ + + ' Old time ',F6.2,' days should be zero.'/ + + ' Possible errors or restart case') + END -- cgit v1.2.3