Initial commit from Polytechnique Montreal

1 files changed, 171 insertions, 0 deletions

diff --git a/Dragon/src/LIBMIC.f b/Dragon/src/LIBMIC.f
new file mode 100644
index 0000000..74707a1
--- /dev/null
+++ b/Dragon/src/LIBMIC.f
@@ -0,0 +1,171 @@
+*DECK LIBMIC
+      SUBROUTINE LIBMIC (IPLIB,IPMIC,NAMFIL,NGRO,NBISO,ISONAM,ISONRF,
+     1 IPISO,MASKI,IMPX,NGF,NGFR,NDEL,NBESP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Transcription of the useful microscopic cross section data from a
+* microlib to LCM data structures.
+*
+*Copyright:
+* Copyright (C) 2002 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
+* IPLIB   pointer to the lattice microscopic cross section library
+*         (L_LIBRARY signature).
+* IPMIC   pointer to the input microlib (L_LIBRARY signature).
+* NAMFIL  name of the Dragon library file.
+* NGRO    number of energy groups.
+* NBISO   number of isotopes present in the calculation domain.
+* ISONAM  alias name of isotopes.
+* ISONRF  library name of isotopes.
+* IPISO   pointer array towards microlib isotopes in IPLIB.
+* MASKI   isotopic mask. Isotope with index I is processed if
+*         MASKI(I)=.true.
+* IMPX    print flag.
+*
+*Parameters: output
+* NGF     number of fast groups without self-shielding.
+* NGFR    number of fast and resonance groups.
+* NDEL    number of precursor groups for delayed neutrons.
+* NBESP   number of energy-dependent fission spectra.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      PARAMETER(MAXESP=4)
+      CHARACTER*(*) NAMFIL
+      TYPE(C_PTR) IPLIB,IPMIC,IPISO(NBISO)
+      INTEGER NGRO,NBISO,ISONAM(3,NBISO),ISONRF(3,NBISO),IMPX,NGF,NGFR,
+     1 NDEL,NBESP
+      LOGICAL MASKI(NBISO)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSMG*131,HTITLE*80,HNISOR*12,HNAMIS*12
+      PARAMETER (IOUT=6,NOTX=3,NSTATE=40)
+      TYPE(C_PTR) JPLIB,KPLIB,KPMIC
+      INTEGER IESP(MAXESP+1),ISTATE(NSTATE)
+      REAL EESP(MAXESP+1)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITITLE,JSOMIX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JSONAM
+      REAL, ALLOCATABLE, DIMENSION(:) :: DELTA,ENER
+      TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: JPISO
+*----
+*  RECOVER THE GROUP STRUCTURE.
+*----
+      NGF=NGRO+1
+      NGFR=0
+      NDEL=0
+      IF(IMPX.GT.0) WRITE (IOUT,900) NAMFIL
+      CALL LCMLEN(IPMIC,'README',LENGT,ITYLCM)
+      IF((IMPX.GT.0).AND.(LENGT.GT.0)) THEN
+         ALLOCATE(ITITLE(LENGT))
+         CALL LCMGET(IPMIC,'README',ITITLE)
+         WRITE (IOUT,940)
+         I2=0
+         DO 10 J=0,LENGT/20
+         I1=I2+1
+         I2=MIN(I1+19,LENGT)
+         WRITE (HTITLE,'(20A4)') (ITITLE(I),I=I1,I2)
+         WRITE (IOUT,'(1X,A80)') HTITLE
+   10    CONTINUE
+         DEALLOCATE(ITITLE)
+      ENDIF
+      ALLOCATE(DELTA(NGRO),ENER(NGRO+1))
+      CALL LCMLEN(IPMIC,'ENERGY',LENGT,ITYLCM)
+      LENGT=LENGT-1
+      IF(LENGT.NE.NGRO) CALL XABORT('LIBMIC: INVALID GROUP STRUCTURE.')
+      CALL LCMGET(IPMIC,'ENERGY',ENER)
+      CALL LCMLEN(IPMIC,'DELTAU',LENGT,ITYLCM)
+      IF(LENGT.EQ.NGRO) THEN
+         CALL LCMGET(IPMIC,'DELTAU',DELTA)
+      ELSE IF(LENGT.EQ.0) THEN
+         IF(ENER(NGRO+1).EQ.0.0) ENER(NGRO+1)=1.0E-5
+         DO 20 J=1,NGRO
+         DELTA(J)=LOG(ENER(J)/ENER(J+1))
+   20    CONTINUE
+      ENDIF
+      CALL LCMPUT(IPLIB,'ENERGY',NGRO+1,2,ENER)
+      CALL LCMPUT(IPLIB,'DELTAU',NGRO,2,DELTA)
+      DEALLOCATE(ENER,DELTA)
+      CALL LCMLEN(IPMIC,'CHI-LIMITS',NBESP,ITYLCM)
+      IF(NBESP.GT.0) THEN
+         NBESP=NBESP-1
+         IF(NBESP.GT.MAXESP) CALL XABORT('LIBMIC: MAXESP OVERFLOW.')
+         CALL LCMGET(IPMIC,'CHI-LIMITS',IESP)
+         CALL LCMPUT(IPLIB,'CHI-LIMITS',NBESP+1,1,IESP)
+         CALL LCMGET(IPMIC,'CHI-ENERGY',EESP)
+         CALL LCMPUT(IPLIB,'CHI-ENERGY',NBESP+1,2,EESP)
+      ENDIF
+*----
+*  SET THE INPUT LCM MICROLIB ISOTOPEWISE DIRECTORIES.
+*----
+      CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
+      NBML=ISTATE(2)
+      ALLOCATE(JPISO(NBML))
+      CALL LIBIPS(IPMIC,NBML,JPISO)
+*----
+*  READ THROUGH MICROLIB AND ACCUMULATE CROSS SECTIONS.
+*----
+      ALLOCATE(JSONAM(3,NBML),JSOMIX(NBML))
+      CALL LCMGET(IPMIC,'ISOTOPESUSED',JSONAM)
+      CALL LCMGET(IPMIC,'ISOTOPESMIX',JSOMIX)
+      DO 40 IMX=1,NBISO
+      IF(MASKI(IMX)) THEN
+         WRITE(HNAMIS,'(3A4)') (ISONAM(I0,IMX),I0=1,3)
+         WRITE(HNISOR,'(3A4)') (ISONRF(I0,IMX),I0=1,3)
+         KML=0
+         DO IML=1,NBML
+           IF((ISONRF(1,IMX).EQ.JSONAM(1,IML)).AND.
+     1        (ISONRF(2,IMX).EQ.JSONAM(2,IML)).AND.
+     2        (ISONRF(3,IMX).EQ.JSONAM(3,IML))) THEN
+             KML=IML
+             GO TO 30
+           ENDIF
+         ENDDO
+         DO IML=1,NBML
+           IF(ISONRF(1,IMX).EQ.JSONAM(1,IML)) THEN
+             WRITE(IOUT,'(22H POSSIBLE CANDIDATE: '',3A4,1H'')')
+     1       JSONAM(:3,IML)
+           ENDIF
+         ENDDO
+         WRITE (HSMG,910) HNAMIS,HNISOR,NAMFIL
+         CALL XABORT(HSMG)
+   30    KPMIC=JPISO(KML) ! set KML-th isotope
+         KPLIB=IPISO(IMX) ! set IMX-th isotope
+         IF(.NOT.C_ASSOCIATED(KPMIC)) THEN
+           WRITE(HSMG,'(17HLIBMIC: ISOTOPE '',3A4,7H'' (ISO=,I8,
+     1     35H) IS NOT AVAILABLE IN THE MICROLIB.)') (JSONAM(I0,KML),
+     2     I0=1,3),KML
+           CALL XABORT(HSMG)
+         ENDIF
+         IF(.NOT.C_ASSOCIATED(KPLIB)) THEN
+           JPLIB=LCMGID(IPLIB,'ISOTOPESLIST')
+           KPLIB=LCMDIL(JPLIB,IMX)
+           IPISO(IMX)=KPLIB
+         ENDIF
+         CALL LCMEQU(KPMIC,KPLIB) ! KPMIC --> KPLIB
+      ENDIF
+   40 CONTINUE
+      DEALLOCATE(JSOMIX,JSONAM,JPISO)
+      RETURN
+*
+  900 FORMAT(/27H PROCESSING MICROLIB NAMED ,A12,1H.)
+  910 FORMAT(26HLIBMIC: MATERIAL/ISOTOPE ',A12,5H' = ',A12,9H' IS MISS,
+     1 22HING ON MICROLIB NAMED ,A12,1H.)
+  940 FORMAT(/24H X-SECTION LIBRARY INFO:)
+      END