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 --- Dragon/src/LIBND6.f | 165 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 Dragon/src/LIBND6.f (limited to 'Dragon/src/LIBND6.f') diff --git a/Dragon/src/LIBND6.f b/Dragon/src/LIBND6.f new file mode 100644 index 0000000..7baeaf5 --- /dev/null +++ b/Dragon/src/LIBND6.f @@ -0,0 +1,165 @@ +*DECK LIBND6 + SUBROUTINE LIBND6(CFILNA,MAXR,NEL,ITNAM,KPAX,BPAX) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Read depletion data on a NDAS formatted library. +* +*Copyright: +* Copyright (C) 2006 Ecole Polytechnique de Montreal +* +*Author(s): A. Hebert +* +*Parameters: input +* CFILNA NDAS file name. +* MAXR number of reaction types. +* NEL number of isotopes on library. +* +*Parameters: output +* ITNAM reactive isotope names in chain. +* KPAX complete reaction type matrix. +* BPAX complete branching ratio matrix. +* +*Reference: +* Copyright (C) from NDAS Atomic Energy of Canada Limited utility (2006) +* +*----------------------------------------------------------------------- +* + USE FSDF + IMPLICIT NONE +*---- +* Subroutine arguments +*---- + INTEGER MAXR,NEL,ITNAM(3,NEL),KPAX(NEL+MAXR,NEL) + CHARACTER CFILNA*(*) + REAL BPAX(NEL+MAXR,NEL) +*---- +* Local variables +*---- + CHARACTER TEXT8*8,TEXT12*12 + INTEGER IND,J,IERR,HEADER(16),IHEAD(200),ISO,JSO,ISOID,NBCHIL, + > LIBWID +*---- +* INTERNAL PARAMETERS +* CONVE : ENERGY CONVERSION FACTOR FROM JOULES/(MOLES*10**-24) +* TO MEV/NUCLIDE = 1.03643526E+13 +* CONVD : DECAY CONSTANT CONVERSION FACTOR FROM S**(-1) TO +* 10**(-8)*S**(-1) = 1.0+8 +*---- + INTEGER KCAPTU,KDECAY,KFISSP,KN2N + REAL CONVE,CONVD + PARAMETER(KCAPTU=3,KDECAY=1,KFISSP=2,KN2N=4,CONVE=1.03643526E+13, + > CONVD=1.0E+8) + INTEGER NDECAY + DOUBLE PRECISION TOTLAM + EXTERNAL LIBWID + INTEGER, ALLOCATABLE, DIMENSION(:) :: CHILDR,IWISO + REAL, ALLOCATABLE, DIMENSION(:) :: BURNDA +*---- +* Scratch storage allocation +*---- + ALLOCATE(CHILDR(2*NEL),IWISO(NEL)) + ALLOCATE(BURNDA(2*NEL)) +*---- +* Open and probe the NDAS file +*---- + CALL XSDOPN(CFILNA,IERR) + IF(IERR.NE.0) THEN + TEXT12=CFILNA + CALL XABORT('LIBND6: NDAS library '//TEXT12//' cannot be'// + > ' opened') + ENDIF + CALL XSDBLD(6001,HEADER,IERR) + IF(IERR.NE.0) CALL XABORT('LIBND6: XSDBLD could not read library' + > //' parameters') + ISO=0 + DO IND=1,HEADER(1) +* Load nuclide header + CALL XSDISO(7000,6001,IND,IHEAD,IERR) + NBCHIL=IHEAD(1) + IF(NBCHIL.GT.NEL) CALL XABORT('LIBND6: Children overflow') + IF(NBCHIL.NE.0) THEN + ISO=ISO+1 + IF(ISO.GT.NEL) CALL XABORT('LIBND6: NEL overflow') + CALL XSDNAM(IND,IWISO(ISO),TEXT8,IERR) + IF(IERR.NE.0) CALL XABORT('LIBND6: XSDNAM index overflow') + ENDIF + ENDDO + ISO=0 + DO IND=1,HEADER(1) +* Load nuclide header + CALL XSDISO(7000,6001,IND,IHEAD,IERR) + NBCHIL=IHEAD(1) + IF(NBCHIL.NE.0) THEN + ISO=ISO+1 + NDECAY=0 + TOTLAM=0.0D0 + CALL XSDNAM(IND,ISOID,TEXT8,IERR) + READ(TEXT8,'(2A4)') ITNAM(1,ISO),ITNAM(2,ISO) +* Load burnup children data + CALL XSDISO(7000,5002,IND,CHILDR,IERR) +* Load burnup coefficients + CALL XSDISO(7000,5003,IND,BURNDA,IERR) + DO J=1,2*NBCHIL,2 + JSO=LIBWID(NEL,IWISO,CHILDR(J)) + IF(CHILDR(J+1).EQ.1) THEN + IF(JSO.GT.0) THEN + KPAX(JSO,ISO)=KCAPTU + BPAX(JSO,ISO)=BURNDA(J) + KPAX(NEL+KCAPTU,JSO)=1 + ENDIF + KPAX(NEL+KCAPTU,ISO)=1 + ELSE IF(CHILDR(J+1).EQ.2) THEN + NDECAY=NDECAY+1 + TOTLAM=TOTLAM+DBLE(BURNDA(J)) + IF(JSO.GT.0) THEN + KPAX(JSO,ISO)=KDECAY + BPAX(JSO,ISO)=BURNDA(J) + KPAX(NEL+KCAPTU,JSO)=1 + ENDIF + KPAX(NEL+KDECAY,ISO)=1 + ELSE IF(CHILDR(J+1).EQ.3) THEN + IF(JSO.GT.0) THEN + KPAX(JSO,ISO)=KFISSP + BPAX(JSO,ISO)=BURNDA(J) + KPAX(NEL+KFISSP,JSO)=-1 + KPAX(NEL+KCAPTU,JSO)=1 + ENDIF + ELSE IF(CHILDR(J+1).EQ.4) THEN + KPAX(NEL+KFISSP,ISO)=1 + BPAX(NEL+KFISSP,ISO)=BURNDA(J)*CONVE + ELSE IF(CHILDR(J+1).EQ.5) THEN + IF(JSO.GT.0) THEN + KPAX(JSO,ISO)=KN2N + BPAX(JSO,ISO)=BURNDA(J) + KPAX(NEL+KCAPTU,JSO)=1 + ENDIF + KPAX(NEL+KN2N,ISO)=1 + ENDIF + ENDDO + IF(NDECAY .EQ. 1) THEN + BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD + DO JSO=1,NEL + IF(KPAX(JSO,ISO).EQ. KDECAY) THEN + BPAX(JSO,ISO)=1.0 + ENDIF + ENDDO + ELSE IF(NDECAY .GT. 1) THEN + BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD + DO JSO=1,NEL + IF(KPAX(JSO,ISO).EQ. KDECAY) THEN + BPAX(JSO,ISO)=BPAX(JSO,ISO)/REAL(TOTLAM) + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + CALL XSDCL() +*---- +* Scratch storage deallocation +*---- + DEALLOCATE(BURNDA) + DEALLOCATE(IWISO,CHILDR) + RETURN + END -- cgit v1.2.3