diff options
| author | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
|---|---|---|
| committer | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
| commit | 7dfcc480ba1e19bd3232349fc733caef94034292 (patch) | |
| tree | 03ee104eb8846d5cc1a981d267687a729185d3f3 /Donjon/src/HSTUMH.f | |
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Donjon/src/HSTUMH.f')
| -rw-r--r-- | Donjon/src/HSTUMH.f | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/Donjon/src/HSTUMH.f b/Donjon/src/HSTUMH.f new file mode 100644 index 0000000..e290034 --- /dev/null +++ b/Donjon/src/HSTUMH.f @@ -0,0 +1,95 @@ +*DECK HSTUMH + SUBROUTINE HSTUMH(IPMAP, IPHST, IPRINT, NCHA, NBUN, IDCELL, + > BURNUP ) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To update the MAP data structure using the information +* provided on the HISTORY data structure. +* +*Copyright: +* Copyright (C) 2004 Ecole Polytechnique de Montreal. +* +*Author(s): +* E. Varin +* +*Parameters: input +* IPMAP address of the \dds{map} data structure. +* IPHST address of the \dds{history} data structure. +* IPRINT print level. +* NCHA number of fuel channels. +* NBUN number of bundles per channel. +* IDCELL cell identifier for each fuel bundle in each channel. +* +*Parameters: work +* BURNUP burnup for each fuel bundle in each channel. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPHST,IPMAP + INTEGER IPRINT + INTEGER NCHA,NBUN + INTEGER IDCELL(NBUN,NCHA) + REAL BURNUP(NCHA,NBUN) +*---- +* LOCAL PARAMETERS +*---- + INTEGER IOUT + INTEGER ILCMUP,ILCMDN + CHARACTER NAMSBR*6 + PARAMETER (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUMH') +*---- +* LOCAL VARIABLES +*---- + CHARACTER NAMP*12 + INTEGER ILCMLN,ILCMTY + INTEGER IBT,ICT,ICCT + REAL BITH(3) +*---- +* Read isotope densities on CELL TYPE +* if available +*---- + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6000) NAMSBR + ENDIF + CALL LCMGET(IPMAP,'BURN-DEB',BURNUP) + DO 10 ICT=1,NCHA + DO 20 IBT=1,NBUN + ICCT=IDCELL(IBT,ICT) + WRITE(NAMP,'(A4,I8.8)') 'CELL',ICCT + CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY) + IF(ILCMLN .EQ. 0) THEN + CALL XABORT(' HSTUMH: BAD CELL TYPE') + ELSE + CALL LCMSIX(IPHST,NAMP,ILCMUP) + CALL LCMGET(IPHST,'DEPL-PARAM ',BITH) + CALL LCMSIX(IPHST,NAMP,ILCMDN) + ENDIF + IF(IPRINT .GE. 100) THEN + WRITE(IOUT,6001) 'CELL TYPE',ICCT + WRITE(IOUT,'(A6,1X,F8.3,2X,F8.3)') 'BURNUP', + > BITH(2),BURNUP(ICT,IBT) + ENDIF + BURNUP(ICT,IBT) = BITH(2) + 20 CONTINUE + 10 CONTINUE +*---- +* Store burnup record in MAP data structure +*---- + CALL LCMPUT(IPMAP,'BURN-DEB',NBUN*NCHA,2,BURNUP) +*---- +* Return +*---- + RETURN +*---- +* FORMAT +*---- + 6000 FORMAT(' ****** OUTPUT FROM ',A6) + 6001 FORMAT(' Contents of ',A9,1X,I8) + END |