diff options
Diffstat (limited to 'Dragon/src/LIBDI8.f')
| -rw-r--r-- | Dragon/src/LIBDI8.f | 198 |
1 files changed, 198 insertions, 0 deletions
diff --git a/Dragon/src/LIBDI8.f b/Dragon/src/LIBDI8.f new file mode 100644 index 0000000..3f4c767 --- /dev/null +++ b/Dragon/src/LIBDI8.f @@ -0,0 +1,198 @@ +*DECK LIBDI8 + SUBROUTINE LIBDI8 (MAXDIL,NGROUP,NAMFIL,HNISOR,HSHI,NDIL,DILUT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Find the dilutions corresponding to a resonant isotope within a +* library in WIMS-D4 format. +* +*Copyright: +* Copyright (C) 2009 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version +* +*Author(s): A. Hebert +* +*Parameters: input +* MAXDIL maximum number of dilutions. +* NGROUP number of energy groups. +* NAMFIL name of the WIMS-D4 format file. +* HNISOR library name of the isotope. +* HSHI library name of the self-shielding data. +* +*Parameters: output +* NDIL number of finite dilutions. +* DILUT dilutions. +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + CHARACTER NAMFIL*(*),HNISOR*12,HSHI*12 + INTEGER MAXDIL,NGROUP,NDIL + REAL DILUT(MAXDIL) +*---- +* LOCAL VARIABLES +*---- + INTEGER IUTYPE,LRIND,IACTO,IACTC + PARAMETER (IUTYPE=2,LRIND=0,IACTO=2,IACTC=1,LPZ=8,MAXISO=246) + CHARACTER FMT*6,HSMG*131,CWISO(MAXISO)*8 + INTEGER NPZ(LPZ),IWISO(2*MAXISO) + REAL, ALLOCATABLE, DIMENSION(:) :: GAR,SCR +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(GAR(MAXDIL+1)) +*---- +* OPEN WIMS-D4 LIBRARY AND READ GENERAL DIMENSIONING +*---- + IDRES=INDEX(HSHI,'.') + IUNIT=KDROPN(NAMFIL,IACTO,IUTYPE,LRIND) + IF(IUNIT.LE.0) THEN + WRITE (HSMG,'(35HLIBDI8: UNABLE TO OPEN LIBRARY FILE,1X,A16, + 1 8H. IUNIT=,I4,1H.)') NAMFIL,IUNIT + CALL XABORT(HSMG) + ENDIF + READ(IUNIT) (NPZ(II),II=1,LPZ) + IF(NPZ(2).NE.NGROUP) THEN + CALL XABORT('LIBDI8: INVALID NUMBER OF GROUPS') + ENDIF + NEL=NPZ(1) + NGR=NPZ(5) + NW=4*NGR+2*NPZ(3) + ALLOCATE(SCR(NW)) + SCR(:NW)=0.0 +*---- +* READ ISOTOPE ID NUMBER AND CREATE EQUIVALENT ISOTOPE NAME +* SCAN TO ASSOCIATE WIMS ISOTOPE NUMBER WITH DRAGON ISOTOPE NUMBER +*---- + IRISO=0 + IRIND=0 + READ(IUNIT) (IWISO(ITC),ITC=1,NEL) + DO 10 IEL=1,NEL + CWISO(IEL)=' ' + IF (IWISO(IEL).LT.10) THEN + WRITE(CWISO(IEL),'(I1)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.100) THEN + WRITE(CWISO(IEL),'(I2)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.1000) THEN + WRITE(CWISO(IEL),'(I3)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.10000) THEN + WRITE(CWISO(IEL),'(I4)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.100000) THEN + WRITE(CWISO(IEL),'(I5)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.1000000) THEN + WRITE(CWISO(IEL),'(I6)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.10000000) THEN + WRITE(CWISO(IEL),'(I7)') IWISO(IEL) + ELSE IF(IWISO(IEL).LT.100000000) THEN + WRITE(CWISO(IEL),'(I8)') IWISO(IEL) + ENDIF + IF(CWISO(IEL).EQ.HNISOR(1:8)) THEN + IRISO=IEL + IF(IDRES.EQ.0) THEN + IRIND=IWISO(IRISO) + ENDIF + GO TO 20 + ENDIF + 10 CONTINUE + CALL XABORT('LIBDI8: ISOTOPE NOT FOUND ON LIBRARY') + 20 CONTINUE +*---- +* READ GROUP STRUCTURE +*---- + READ(IUNIT) (DUMMY,ITC=1,NGROUP) +*---- +* RECOVER FISSION SPECTRUM +*---- + READ(IUNIT) (DUMMY,ITC=1,NPZ(3)) +*---- +* READ DEPLETION CHAIN +*---- + DO 30 IEL=1,NEL + READ(IUNIT) DUMMY + 30 CONTINUE + READ(IUNIT) DUMMY +*---- +* READ FILE FOR TEMPERATURE DEPENDENT XS +*---- + NRTOT=0 + DO 50 IELRT=1,NEL + READ(IUNIT) IDIEL,AWR,IZ,NFIEL,NTMP,NRIEL + IF(NRIEL.GT.0) NRTOT=NRTOT+NRIEL + IF(IELRT.EQ.IRISO) THEN + READ(IUNIT) (SCR(I),I=1,NW) + ELSE + READ(IUNIT) DUMMY + ENDIF + IF(NFIEL.GT.1) READ(IUNIT) DUMMY + READ(IUNIT) NSCT + IF(NTMP.GT.0) THEN + READ(IUNIT) DUMMY + DO 40 IT=1,NTMP + READ(IUNIT) DUMMY + IF(NFIEL.GT.1) READ(IUNIT) DUMMY + READ(IUNIT) NSCT + 40 CONTINUE + ENDIF + READ(IUNIT) ENDR + 50 CONTINUE +*---- +* IDENTIFY RESONANT ISOTOPE +*---- + IF(IDRES.GT.0) THEN + WRITE(FMT,'(2H(F,I1,3H.1))') IDRES+1 + READ(HSHI,FMT) RIND + ELSE + RIND=FLOAT(IWISO(IRISO)) + ENDIF +*---- +* SCAN OVER RESONANCE SETS+1 AND READ RESONANCE INFO +*---- + DO 90 IGR=1,NGR + DO 70 IRS=1,2*NRTOT+1 + READ(IUNIT) XIDR,M1,M2,(DUMMY,IT=1,M1),(GAR(ID),ID=1,M2), + 1 ((DUMMY,ID=1,M2),IT=1,M1) + IF(M2.GT.MAXDIL) CALL XABORT('LIBDI8: MAXDIL OVERFLOW.') + IF(IDRES.EQ.0) THEN + XRS1=FLOAT(INT((XIDR+0.01)*10.)-INT(XIDR+0.01)*10)/10. + XRS1=ABS(XIDR-XRS1-RIND) + ELSE + XRS1=ABS(XIDR-RIND) + ENDIF + IF(XRS1.LE.0.01) THEN + NDIL=M2-1 + DO 60 ID=1,NDIL + DSIGPL=SCR(IGR)*SCR(NW-NGR+IGR) + IF(GAR(ID)-DSIGPL.GT.0.0) THEN + DILUT(ID)=GAR(ID)-DSIGPL + ELSE + DILUT(ID)=0.0 + ENDIF + 60 CONTINUE + DILUT(M2)=MIN(GAR(M2),1.0E10) + GO TO 100 + ENDIF + IF(XIDR.EQ.0.0) GO TO 80 + 70 CONTINUE + 80 CONTINUE + READ(IUNIT) ENDR + 90 CONTINUE + NDIL=0 + DILUT(1)=1.0E10 + 100 IERR=KDRCLS(IUNIT,IACTC) + IF(IERR.LT.0) THEN + HNISOR=NAMFIL + CALL XABORT('LIBDI8: WIMS-D4 LIBRARY '//HNISOR// + 1 ' CANNOT BE CLOSED.') + ENDIF +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(SCR,GAR) + RETURN + END |