*DECK DUO006
      SUBROUTINE DUO006(IPLIB,IPRINT,NISOT,NGRP,HREAC,RHS,FLUX,AFLUX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* processing one of the two microlibs and return the RHS matrix for
* the single reaction HREAC.
*
*Copyright:
* Copyright (C) 2013 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   microlib
* IPRINT  print parameter
* NISOT   number of isotopes
* NGRP    number of energy groups
* HREAC   character*8 reaction name of the reaction to process
*
*Parameters: output
* RHS     macroscopic cross-section matrix
* FLUX    integrated direct flux
* AFLUX   integrated adjoint flux
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIB
      INTEGER IPRINT,NISOT,NGRP
      CHARACTER HREAC*8
      REAL RHS(NGRP,NGRP,NISOT),FLUX(NGRP,NISOT),AFLUX(NGRP,NISOT)
*----
*  LOCAL VARIABLES
*----
      CHARACTER TEXT12*12,HSMG*131
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHUSED
      REAL, ALLOCATABLE, DIMENSION(:) :: DENS,VOL,VECTOR,CHI,SIGS
      REAL, ALLOCATABLE, DIMENSION(:,:) :: SCAT
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(IHUSED(3,NISOT))
      ALLOCATE(DENS(NISOT),VOL(NISOT),VECTOR(NGRP),SCAT(NGRP,NGRP),
     > CHI(NGRP))
*----
*  COMPUTE THE RHS AND LHS MATRICES
*----
      CALL LCMGET(IPLIB,'ISOTOPESUSED',IHUSED)
      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS)
      CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL)
      CALL LCMGET(IPLIB,'K-EFFECTIVE',ZKEFF)
      IF(IPRINT.GT.4) WRITE(6,'(35H DUO006: EFFECTIVE MULTIPLICATION F,
     > 6HACTOR=,1P,E12.5)') ZKEFF
      CALL XDRSET(RHS,NGRP*NGRP*NISOT,0.0)
      DO ISOT=1,NISOT
        WRITE(TEXT12,'(3A4)') (IHUSED(I0,ISOT),I0=1,3)
        IF(IPRINT.GT.4) WRITE(6,'(29H DUO006: PROCESSING ISOTOPE '',
     >  A12,2H''.)') TEXT12
        CALL LCMSIX(IPLIB,TEXT12,1)
        CALL LCMGET(IPLIB,'NWT0',FLUX(1,ISOT))
        CALL LCMLEN(IPLIB,'NWAT0',ILON,ITYLCM)
        IF(ILON.NE.0) THEN
          CALL LCMGET(IPLIB,'NWAT0',AFLUX(1,ISOT))
        ELSE
          CALL XDRSET(AFLUX(1,ISOT),NGRP,1.0)
        ENDIF
        DO IGR=1,NGRP
          FLUX(IGR,ISOT)=FLUX(IGR,ISOT)*VOL(ISOT)
          AFLUX(IGR,ISOT)=AFLUX(IGR,ISOT)*VOL(ISOT)
        ENDDO
        CALL LCMLEN(IPLIB,HREAC,ILONG,ITYLCM)
        IF(ILONG.EQ.0) THEN
          CALL LCMSIX(IPLIB,' ',2)
          CYCLE
        ENDIF
        IF(HREAC.EQ.'SCAT00') THEN
          ALLOCATE(SIGS(NGRP))
          CALL XDRLGS(IPLIB,-1,IPRINT,0,0,1,NGRP,SIGS,SCAT,ITYPRO)
          DEALLOCATE(SIGS)
          CALL LCMGET(IPLIB,'NWT0',VECTOR)
          DO IGR=1,NGRP
            DO JGR=1,NGRP
              RHS(JGR,IGR,ISOT)=RHS(JGR,IGR,ISOT)-DENS(ISOT)*
     >        SCAT(JGR,IGR)
            ENDDO
            RHS(IGR,IGR,ISOT)=RHS(IGR,IGR,ISOT)+DENS(ISOT)*VECTOR(IGR)
          ENDDO
        ELSE IF((HREAC.EQ.'NUSIGF').OR.(HREAC.EQ.'CHI')) THEN
          CALL LCMGET(IPLIB,'NUSIGF',VECTOR)
          CALL LCMGET(IPLIB,'CHI',CHI)
          DO IGR=1,NGRP
            DO JGR=1,NGRP
              RHS(JGR,IGR,ISOT)=RHS(JGR,IGR,ISOT)-DENS(ISOT)*CHI(JGR)*
     >        VECTOR(IGR)/ZKEFF
            ENDDO
          ENDDO
        ELSE IF(HREAC(:3).EQ.'NWT') THEN
          WRITE(HSMG,'(8HDUO006: ,A8,25H IS A FORBIDDEN REACTION.)')
     >    HREAC
          CALL XABORT(HSMG)
        ELSE
          CALL LCMGET(IPLIB,HREAC,VECTOR)
          DO IGR=1,NGRP
            RHS(IGR,IGR,ISOT)=RHS(IGR,IGR,ISOT)+DENS(ISOT)*VECTOR(IGR)
          ENDDO
        ENDIF
        CALL LCMSIX(IPLIB,' ',2)
      ENDDO
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(CHI,SCAT,VECTOR,VOL,DENS)
      DEALLOCATE(IHUSED)
      RETURN
      END
