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/CREXSI.f | 213 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 213 insertions(+) create mode 100644 Donjon/src/CREXSI.f (limited to 'Donjon/src/CREXSI.f') diff --git a/Donjon/src/CREXSI.f b/Donjon/src/CREXSI.f new file mode 100644 index 0000000..4819bf4 --- /dev/null +++ b/Donjon/src/CREXSI.f @@ -0,0 +1,213 @@ +*DECK CREXSI + SUBROUTINE CREXSI(IPMAP,NENTRY,HENTRY,KENTRY,NMIX,NGRP,NL,ILEAK, + 1 IMPX,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,IJJ,NJJ,SCAT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover and/or interpolate l_compo data. +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal. +* +*Author(s): +* A. Hebert, D. Sekki +* +*Parameters: input +* IPMAP pointer to the fuel-map information. +* NENTRY number of lcm or xsm objects used by the module. +* HENTRY character*12 name of each lcm or xsm objects. +* KENTRY pointers to the lcm or xsm objects. +* NMIX maximum number of material mixtures. +* NGRP number of energy groups. +* NL number of legendre orders (=1 for isotropic scattering). +* ILEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic). +* IMPX printing index (=0 for no print). +* +*Parameters: output +* TOTAL total macroscopic x-sections. +* ZNUG nu*fission macroscopic x-sections. +* SNUGF fission macroscopic x-sections. +* CHI fission spectrum. +* OVERV reciprocal neutron velocities. +* DIFFX x-directed diffusion coefficients. +* DIFFY y-directed diffusion coefficients. +* DIFFZ z-directed diffusion coefficients. +* H h-factors (kappa*fission macroscopic x-sections). +* IJJ profile storage index. +* NJJ profile storage width. +* SCAT scattering macroscopic x-sections. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NENTRY,NMIX,NGRP,NL,ILEAK,IMPX,IJJ(NMIX,NL,NGRP), + 1 NJJ(NMIX,NL,NGRP) + TYPE(C_PTR) IPMAP,KENTRY(NENTRY) + CHARACTER HENTRY(NENTRY)*12 + REAL TOTAL(NMIX,NGRP),ZNUG(NMIX,NGRP),SNUGF(NMIX,NGRP), + 1 CHI(NMIX,NGRP),OVERV(NMIX,NGRP),DIFFX(NMIX,NGRP), + 2 DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),H(NMIX,NGRP), + 3 SCAT(NMIX,NL,NGRP,NGRP) +*---- +* LOCAL VARIABLES +*---- + TYPE(C_PTR) IPCPO,JPCPO,JPMAP,KPMAP + PARAMETER(NSTATE=40,IOUT=6) + CHARACTER TEXT*12,NAMDIR*12,HCOMPO*12,HSMG*131 + INTEGER IPAR(NSTATE),IDATA(NSTATE) + LOGICAL DERIV,UPS,LTAB + DOUBLE PRECISION DFLOT + REAL, ALLOCATABLE, DIMENSION(:) :: YTOTAL,YZNUG,YNUGF,YCHI,YOVERV, + 1 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX + INTEGER, ALLOCATABLE, DIMENSION(:) :: HISO,ITY,FMIX + REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BURNU,BRN0,BRN1 +* + IVARTY=0 + UPS=.FALSE. + LTAB=.FALSE. + DERIV=.FALSE. + NFUEL=0 + MAXEN=NENTRY + IF(C_ASSOCIATED(IPMAP))THEN + CALL LCMGET(IPMAP,'STATE-VECTOR',IDATA) + IF(IDATA(4).NE.NGRP)CALL XABORT('@CREXSI: DIFFERENT NUM' + 1 //'BER OF ENERGY GROUPS IN COMPO AND FUEL MAP.') + NB=IDATA(1) + NCH=IDATA(2) + NFUEL=IDATA(7) + MAXEN=MAXEN-1 + LTAB=.TRUE. + ENDIF +*---- +* READ INTERPOLATION OPTION +*---- + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + DO 200 IEN=2,MAXEN +* KEYWORD COMPO OR TABLE + IF(TEXT.EQ.'COMPO')THEN + IF(C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: ONLY USE ' + 1 //'OF EITHER COMPO OR TABLE OPTION. BOTH OPTIONS ARE ' + 2 //'NOT ALLOWED.') + ELSEIF(TEXT.EQ.'TABLE')THEN + IF(.NOT.C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: MISS' + 1 //'ING FUEL MAP.') + ELSE + CALL XABORT('@CREXSI: KEYWORD COMPO OR TABLE EXPECTED.') + ENDIF +* COMPO NAME + CALL REDGET(ITYP,NITMA,FLOT,HCOMPO,DFLOT) + IF(ITYP.NE.3)CALL XABORT('@CREXSI: COMPO NAME EXPECTED.') + DO JEN=2,MAXEN + IF(HCOMPO.EQ.HENTRY(JEN))THEN + IPCPO=KENTRY(JEN) + IF(IMPX.GT.1)CALL LCMLIB(IPCPO) + GOTO 10 + ENDIF + ENDDO + WRITE(HSMG,'(44HCREXSI: UNABLE TO FIND THE COMPO WITH NAME '', + 1 A12,2H''.)') TEXT + CALL XABORT(HSMG) +*---- +* READ MIX INFO +*---- + 10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(TEXT.NE.'MIX')CALL XABORT('@CREXSI: KEYWORD MIX EXPECTED.') + CALL LCMGET(IPCPO,'STATE-VECTOR',IPAR) + NGRP1=IPAR(2) + NL1=IPAR(4) + NISO=IPAR(3) + IF(NGRP1.NE.NGRP)THEN + WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF GROUPS. IN MACRO, + 1 5HLIB =,I5,11H IN COMPO =,I5)') NGRP,NGRP1 + CALL XABORT(HSMG) + ENDIF + IF(NL1.LT.NL)THEN + WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF LEGENDRE ORDERS., + 1 14H IN MACROLIB =,I5,11H IN COMPO =,I5)') NL,NL1 + CALL XABORT(HSMG) + ENDIF + 20 ALLOCATE(HISO(3*NISO),ITY(NISO),CONC(NISO)) + CALL CREXSR(IPCPO,LTAB,HCOMPO,NMIX,IMPX,NISO,IBM,DERIV,UPS, + 1 NAMDIR,NISO1,HISO,ITY,CONC,NBURN,KBURN,IVARTY, + 2 IBTYP,BURN0,BURN1) + JPCPO=LCMGID(IPCPO,NAMDIR) +*---- +* TABLE-OPTION INTERPOLATION +*---- + IF(LTAB)THEN +* CHECK FUEL MIXTURE + JPMAP=LCMGID(IPMAP,'FUEL') + DO 30 IFUEL=1,NFUEL + KPMAP=LCMGIL(JPMAP,IFUEL) + CALL LCMGET(KPMAP,'MIX',IMIX) + IF(IMIX.EQ.IBM)GOTO 40 + CALL LCMLEN(KPMAP,'MIX-VOID',LENGT,ITYP) + IF(LENGT.EQ.0)GOTO 30 + CALL LCMGET(KPMAP,'MIX-VOID',IMIX) + IF(IMIX.EQ.IBM)GOTO 40 + 30 CONTINUE + WRITE(IOUT,*)'@CREXSI: UNABLE TO FIND FUEL MIXTURE ',IBM + CALL XABORT('@CREXSI: WRONG MIXTURE NUMBER.') +* + 40 ALLOCATE(BURNU(NBURN),BRN0(NCH*NB),BRN1(NCH*NB),FMIX(NCH*NB)) + CALL CRERGR(JPCPO,IPMAP,NISO1,NGRP,NMIX,NL,IBM,IMPX,IBTYP,DERIV, + 1 UPS,NBURN,BURNU,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY, + 2 DIFFZ,H,SCAT,IJJ,NJJ,HISO,ITY,CONC,FMIX,BRN0,BRN1,NCH,NB,IVARTY) + DEALLOCATE(FMIX,BRN1,BRN0,BURNU) + DEALLOCATE(CONC,ITY,HISO) +*---- +* COMPO-OPTION INTERPOLATION +*---- + ELSE + ALLOCATE(YTOTAL(NGRP),YZNUG(NGRP),YNUGF(NGRP),YCHI(NGRP), + 1 YOVERV(NGRP),YDIFX(NGRP),YDIFY(NGRP),YDIFZ(NGRP),YH(NGRP), + 2 YSCAT(NL*NGRP*NGRP),YFLUX(NGRP)) + CALL CREINT(JPCPO,NISO1,DERIV,NBURN,KBURN,BURN0,BURN1,NGRP, + 1 NL,IMPX,HISO,ITY,CONC,ILEAK,YTOTAL,YZNUG,YNUGF,YCHI,YOVERV, + 2 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX,UPS) +* DATA STORAGE. + DO 112 JGR=1,NGRP + TOTAL(IBM,JGR)=YTOTAL(JGR) + ZNUG(IBM,JGR)=YZNUG(JGR) + SNUGF(IBM,JGR)=YNUGF(JGR) + CHI(IBM,JGR)=YCHI(JGR) + OVERV(IBM,JGR)=YOVERV(JGR) + DIFFX(IBM,JGR)=YDIFX(JGR) + DIFFY(IBM,JGR)=YDIFY(JGR) + DIFFZ(IBM,JGR)=YDIFZ(JGR) + H(IBM,JGR)=YH(JGR) + DO 111 IGR=1,NGRP + DO 110 IL=1,NL + SCAT(IBM,IL,IGR,JGR)=YSCAT(NL*((JGR-1)*NGRP+IGR-1)+IL) + 110 CONTINUE + 111 CONTINUE + 112 CONTINUE + DEALLOCATE(YFLUX,YSCAT,YH,YDIFZ,YDIFY,YDIFX,YOVERV,YCHI,YNUGF, + 1 YZNUG,YTOTAL) + DEALLOCATE(CONC,ITY,HISO) +* JGR IS THE SECONDARY GROUP. + DO 135 JGR=1,NGRP + DO 130 IL=1,NL + IGMIN=JGR + IGMAX=JGR + DO IGR=NGRP,1,-1 + IF(SCAT(IBM,IL,IGR,JGR).NE.0.)THEN + IGMIN=MIN(IGMIN,IGR) + IGMAX=MAX(IGMAX,IGR) + ENDIF + ENDDO + IJJ(IBM,IL,JGR)=IGMAX + NJJ(IBM,IL,JGR)=IGMAX-IGMIN+1 + 130 CONTINUE + 135 CONTINUE + ENDIF + CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) + IF(TEXT.EQ.'MIX')GOTO 20 + 200 CONTINUE + IF(TEXT.NE.';') CALL XABORT('@CREXSI: FINAL ; EXPECTED.') + RETURN + END -- cgit v1.2.3