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/NCRMAP.f | 174 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 Donjon/src/NCRMAP.f (limited to 'Donjon/src/NCRMAP.f') diff --git a/Donjon/src/NCRMAP.f b/Donjon/src/NCRMAP.f new file mode 100644 index 0000000..3ad7bb6 --- /dev/null +++ b/Donjon/src/NCRMAP.f @@ -0,0 +1,174 @@ +*DECK NCRMAP + SUBROUTINE NCRMAP(IPMAP,NPARM,HPARM,NCH,NB,IBTYP,HNAVAL,IMPX, + 1 BURN0,BURN1,WPAR,LPARM) +* +*----------------------------------------------------------------------- +* +*Purpose: +* recover global parameter values from the fuel-map object. +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal. +* +*Author(s): +* D. Sekki, R. Chambon +* +*Parameters: input +* IPMAP pointer to the fuel-map information. +* NPARM number of expected global parameters to be recovered from +* the fuel-map (burnup not included). +* HPARM names of these global parameters. +* NCH number of reactor channels. +* NB number of fuel bundles per channel. +* IBTYP type of burnup interpolation: +* =0 not provided; =1 time-average; =2 instantaneous; +* =3 derivative with respect to a single exit burnup. +* HNAVAL identification name corresponding to the basic naval- +* coordinate position of a neighbour assembly. +* IMPX printing index (=0 for no print). +* +*Parameters: output +* BURN0 contains either low burnup integration limits or +* instantaneous burnups per fuel bundle. +* BURN1 upper burnup integration limits per fuel bundle. +* WPAR values of the other global parameters in each bundle. +* LPARM existence flag for each expected global parameters. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMAP + INTEGER NPARM,NCH,NB,IBTYP,IMPX + REAL BURN0(NCH,NB),BURN1(NCH,NB),WPAR(NCH,NB,NPARM) + LOGICAL LPARM(NPARM+1) + CHARACTER HPARM(NPARM+1)*(*),HNAVAL*4 +*---- +* LOCAL VARIABLES +*---- + INTEGER, PARAMETER::IOUT=6 + INTEGER, PARAMETER::NSTATE=40 + INTEGER ISTATE(NSTATE) + INTEGER IB, ICH, IICH, ILONG, ITYLCM, ITYPEP, JPARM + REAL VARTMP + CHARACTER HSMG*131 + TYPE(C_PTR) JPMAP,KPMAP +*---- +* ALLOCATABLE ARRAYS +*---- + REAL, ALLOCATABLE, DIMENSION(:,:) :: BURNB + CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HSZONE +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(BURNB(NCH,NB)) +*---- +* TIME-AVERAGE BURNUP +*---- + BURN0(:NCH,:NB)=0.0 + BURN1(:NCH,:NB)=0.0 + WPAR(:NCH,:NB,:NPARM)=0.0 + LPARM(:NPARM+1)=.FALSE. + IF(IBTYP.EQ.0) THEN + CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE) + IBTYP=ISTATE(5) + ENDIF + IF((IBTYP.EQ.0).AND.(HNAVAL.NE.' '))THEN +* USE THE BURNUP OF A NEIGHBOUR ASSEMBLY + IF(ISTATE(13).EQ.0)CALL XABORT('@NCRMAP: MISSING' + 1 //' S-ZONE VALUES IN FUEL MAP.') + ALLOCATE(HSZONE(NCH)) + CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HSZONE) + IICH=0 + DO ICH=1,NCH + IF(HSZONE(ICH).EQ.HNAVAL) THEN + IICH=ICH + GO TO 20 + ENDIF + ENDDO + WRITE(HSMG,'(24H@NCRMAP: UNABLE TO FIND ,A,16H IN RECORD S-ZON, + 1 2HE.)') HNAVAL + CALL XABORT(HSMG) + 20 DEALLOCATE(HSZONE) + CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM) + IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING' + 1 //' BURN-INST VALUES IN FUEL MAP.') + CALL LCMGET(IPMAP,'BURN-INST',BURNB) + DO ICH=1,NCH + DO IB=1,NB + BURN0(ICH,IB)=BURNB(IICH,IB) + ENDDO + ENDDO + ELSE IF((IBTYP.EQ.1).OR.(IBTYP.EQ.3))THEN +* LOW BURNUP LIMITS + CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYLCM) + IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING' + 1 //' BURN0 VALUES IN FUEL MAP.') + CALL LCMGET(IPMAP,'BURN-BEG',BURN0) +* UPPER BURNUP LIMITS + CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYLCM) + IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING' + 1 //' BURN1 VALUES IN FUEL MAP.') + CALL LCMGET(IPMAP,'BURN-END',BURN1) + IF(IMPX.GT.0)WRITE(IOUT,1000) + LPARM(NPARM+1)=.TRUE. +*---- +* INSTANTANEOUS BURNUP +*---- + ELSEIF(IBTYP.EQ.2)THEN + CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM) + IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING' + 1 //' BURN-INST VALUES IN FUEL MAP.') + CALL LCMGET(IPMAP,'BURN-INST',BURNB) + DO ICH=1,NCH + DO IB=1,NB + BURN0(ICH,IB)=BURNB(ICH,IB) + BURN1(ICH,IB)=BURNB(ICH,IB) + ENDDO + ENDDO + IF(IMPX.GT.0)WRITE(IOUT,1001) + LPARM(NPARM+1)=.TRUE. + ELSEIF(IBTYP.NE.0)THEN + CALL XABORT('@NCRMAP: INVALID BURNUP INTERPOLATION OPTION ' + 1 //'IBTYP IN FUEL MAP.') + ENDIF +*---- +* RECOVER OTHER PARAMETERS +*---- + IF(NPARM.GT.0) THEN + JPMAP=LCMGID(IPMAP,'PARAM') + DO 30 JPARM=1,NPARM + KPMAP=LCMGIL(JPMAP,JPARM) + CALL LCMGTC(KPMAP,'PARKEY',12,HPARM(JPARM)) + CALL LCMGET(KPMAP,'P-TYPE',ITYPEP) + LPARM(JPARM)=.TRUE. +* Global parameter + IF(ITYPEP.EQ.1) THEN + CALL LCMLEN(KPMAP,'P-VALUE',ILONG,ITYLCM) + IF(ILONG.NE.1) THEN + WRITE(HSMG,'(37H@NCRMAP: P-VALUE LENGTH OF PARAMETER ,A, + 1 12H IS EQUAL TO,I6,13H (MUST BE 1).)') HPARM(JPARM),ILONG + CALL XABORT(HSMG) + ENDIF + CALL LCMGET(KPMAP,'P-VALUE',VARTMP) + WPAR(:NCH,:NB,JPARM)=VARTMP +* Local parameter + ELSEIF (ITYPEP.EQ.2) THEN + CALL LCMGET(KPMAP,'P-VALUE',WPAR(1,1,JPARM)) + ENDIF + 30 CONTINUE + ENDIF +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(BURNB) + RETURN +* + 1000 FORMAT(/1X,'** PERFORMING THE TIME-AVERAGE', + 1 1X,'INTEGRATION OVER THE FUEL LATTICE **'/) + 1001 FORMAT(/1X,'** PERFORMING THE INSTANTANEOU', + 1'S INTERPOLATION OVER THE FUEL LATTICE **'/) + END -- cgit v1.2.3