*DECK NCRMAC
      SUBROUTINE NCRMAC(MAXNIS,IPMAC,IPCPO,IACCS,NMIL,NMIX,NGRP,IMPX,
     1 NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LRES,B2)
*
*-----------------------------------------------------------------------
*
*Purpose:
* build the macrolib by scanning the NCAL elementary calculations and
* weighting them with TERP factors.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert
*
*Parameters: input
* MAXNIS  maximum value of NISO(I) in user data.
* IPMAC   address of the output macrolib LCM object.
* IPCPO   address of the multicompo object.
* IACCS   =0 macrolib is created; =1 ... is updated.
* NMIL    number of material mixtures in the compo.
* NMIX    maximum number of material mixtures in the macrolib.
* NGRP    number of energy groups.
* IMPX    print parameter (equal to zero for no print).
* NCAL    number of elementary calculations in the compo.
* TERP    interpolation factors.
* NISO    number of user-selected isotopes.
* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
* HISO    name of the user-selected isotopes.
* CONC    user-defined number density of the user-selected isotopes. A
*         value of -99.99 is set to indicate that the compo value is
*         used.
* MIXC    mixture index in the compo corresponding to each macrolib
*         mixture. Equal to zero if a macrolib mixture is not updated.
* LRES    =.true. if the interpolation is done without updating isotopic 
*         densities
* B2      buckling
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      PARAMETER (MAX1D=40,MAX2D=20,MAXNL=5,MAXNFI=50)
      TYPE(C_PTR) IPMAC,IPCPO
      INTEGER MAXNIS,IACCS,NMIL,NMIX,NGRP,IMPX,NCAL,NISO(NMIX),
     1 HISO(2,NMIX,MAXNIS),MIXC(NMIX)
      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
      LOGICAL LISO(NMIX),LRES
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,IOUT=6,MAXED=30,MAXRES=MAX1D-10)
      INTEGER ISTATE(NSTATE)
      REAL TMPDAY(3)
      LOGICAL LWT0,LWT1,LUSER,LMAKE1(MAX1D),LMAKE2(MAX2D),LFAST
      CHARACTER TEXT8*8,TEXT12*12,HHISO*8,CM*2,HMAK1(MAX1D)*12,
     1 HMAK2(MAX2D)*12,HVECT(MAXED)*8
      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO,IPTMP,JPTMP,KPTMP,JPMAC,
     1 KPMAC
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,ISOMI
      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,XVOLM,WORK1,WORK2,ENERGY
      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUX
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1
      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKL
      INTEGER, POINTER, DIMENSION(:) :: ISONA
      REAL, POINTER, DIMENSION(:) :: DENIS,FLOT,NWT
      TYPE(C_PTR) ISONA_PTR,DENIS_PTR,FLOT_PTR,NWT_PTR
      DATA HMAK1 / 'FLUX-INTG','NTOT0','OVERV','DIFF','DIFFX','DIFFY',
     1             'DIFFZ','FLUX-INTG-P1','NTOT1','H-FACTOR',MAXRES*' '/
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX))
      ALLOCATE(FLUX(NGRP,2),GAR1(NMIX,NGRP,MAX1D),
     1 GAR2(NMIX,MAXNFI,NGRP,MAX2D),GAR3(NMIX,NGRP,NGRP,MAXNL),
     2 GAR4(NMIX*NGRP))
*----
*  OVERALL MULTICOMPO MIXTURE LOOP
*----
      JPCPO=LCMGID(IPCPO,'MIXTURES')
      DO 500 IBMOLD=1,NMIL
      IF(IMPX.GT.0) WRITE(IOUT,'(/33H NCRMAC: PROCESS MULTICOMPO MIXTU,
     1 2HRE,I5)') IBMOLD
      KPCPO=LCMGIL(JPCPO,IBMOLD)
      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
*----
*  MACROLIB INITIALIZATION
*----
      IF(IACCS.EQ.0) THEN
         MPCPO=LCMGIL(LPCPO,NCAL)
         CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
         IF(ISTATE(1).NE.1) THEN
            CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(1).')
         ELSE IF(ISTATE(3).NE.NGRP) THEN
            CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(1).')
         ENDIF
         NL=ISTATE(4)
         NF=0
         ITRAN=ISTATE(5)
         NED=ISTATE(13)
         NDEL=ISTATE(19)
         IF(NED.GT.MAXED) CALL XABORT('NCRMAC: MAXED OVERFLOW(1).')
         ALLOCATE(ENERGY(NGRP+1))
         IF(NED.GT.0) CALL LCMGTC(MPCPO,'ADDXSNAME-P0',8,NED,HVECT)
         CALL LCMGET(MPCPO,'ENERGY',ENERGY)
         TEXT12='L_MACROLIB'
         CALL LCMPTC(IPMAC,'SIGNATURE',12,1,TEXT12)
         CALL XDISET(ISTATE,NSTATE,0)
         ISTATE(1)=NGRP
         ISTATE(2)=NMIX
         ISTATE(3)=NL
         ISTATE(5)=NED
         ISTATE(6)=ITRAN
         ISTATE(7)=NDEL
         CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
         CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,ENERGY)
         IF(NED.GT.0) CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
         DEALLOCATE(ENERGY)
      ELSE
         CALL LCMGTC(IPMAC,'SIGNATURE',12,1,TEXT12)
         IF(TEXT12.NE.'L_MACROLIB') THEN
          CALL XABORT('NCRMAC: SIGNATURE IS '//TEXT12//'. L_MACROLIB E'
     1    //'XPECTED.')
         ENDIF
         CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
         IF(ISTATE(1).NE.NGRP) THEN
            CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(2).')
         ELSE IF(ISTATE(2).NE.NMIX) THEN
            CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(2).')
         ENDIF
         NL=ISTATE(3)
         NF=ISTATE(4)
         NED=ISTATE(5)
         NDEL=ISTATE(7)
         IF(NED.GT.MAXED) CALL XABORT('NCRMAC: MAXED OVERFLOW(2).')
         IF(NED.GT.0) CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
      ENDIF
      N1D=10+NED+NL
      N2D=2*(NDEL+1)
      IF(NL.GT.MAXNL) CALL XABORT('NCRMAC: MAXNL OVERFLOW.')
      IF(N1D.GT.MAX1D) CALL XABORT('NCRMAC: MAX1D OVERFLOW.')
      IF(N2D.GT.MAX2D) CALL XABORT('NCRMAC: MAX2D OVERFLOW.')
      CALL XDLSET(LMAKE1,N1D,.FALSE.)
      CALL XDLSET(LMAKE2,N2D,.FALSE.)
      CALL XDRSET(GAR1,NMIX*NGRP*N1D,0.0)
      CALL XDRSET(GAR2,NMIX*MAXNFI*NGRP*N2D,0.0)
      CALL XDRSET(GAR3,NMIX*NGRP*NGRP*NL,0.0)
      DO 20 IED=1,NED
   20 HMAK1(10+IED)=HVECT(IED)
      DO 30 IL=1,NL
      WRITE(CM,'(I2.2)') IL-1
   30 HMAK1(10+NED+IL)='SIGS'//CM
      HMAK2(1)='NUSIGF'
      HMAK2(2)='CHI'
      DO 40 IDEL=1,NDEL
      WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
      HMAK2(2+2*(IDEL-1)+1)=TEXT8
      WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
      HMAK2(2+2*(IDEL-1)+2)=TEXT8
   40 CONTINUE
*----
*  READ EXISTING MACROLIB INFORMATION
*----
      ALLOCATE(XVOLM(NMIX))
      CALL XDRSET(XVOLM,NMIX,0.0)
      IF(IACCS.NE.0) THEN
        CALL LCMGET(IPMAC,'VOLUME',XVOLM)
        JPMAC=LCMGID(IPMAC,'GROUP')
        DO 80 IGR=1,NGRP
        KPMAC=LCMGIL(JPMAC,IGR)
        DO 60 I1D=1,N1D
        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
        IF(ILONG.NE.0) THEN
          LMAKE1(I1D)=.TRUE.
          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
          DO 50 IBM=1,NMIX
          IF((I1D.GE.4).AND.(I1D.LE.7)) THEN
            GAR1(IBM,IGR,I1D)=1.0/GAR1(IBM,IGR,I1D)
          ENDIF
          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=0.0
   50     CONTINUE
        ENDIF
   60   CONTINUE
        DO 65 I2D=1,N2D
        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
        IF(ILONG.NE.0) THEN
          LMAKE2(I2D)=.TRUE.
          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
          DO 64 I=1,NF
          DO 64 IBM=1,NMIX
          IF(MIXC(IBM).EQ.IBMOLD) GAR2(IBM,I,IGR,I2D)=0.0
   64     CONTINUE
        ENDIF
   65   CONTINUE
        DO 80 IL=1,NL
        WRITE(CM,'(I2.2)') IL-1
        ILONG=1
        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
        IF(ILONG.NE.0) THEN
          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
          DO 70 IBM=1,NMIX
          IPOSDE=IPOS(IBM)
          DO 70 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
          IF(MIXC(IBM).EQ.IBMOLD) GAR3(IBM,JGR,IGR,IL)=0.0
   70     IPOSDE=IPOSDE+1
        ENDIF
   80   CONTINUE
      ENDIF
*----
*  OVERALL ELEMENTARY CALCULATION LOOP
*----
      LFAST=.TRUE.
      DO 85 IBM=1,NMIX
   85 LFAST=LFAST.AND.((MIXC(IBM).NE.IBMOLD).OR.(NISO(IBM).EQ.0))
      DO 210 ICAL=1,NCAL
      MPCPO=LCMGIL(LPCPO,ICAL)
      IPTMP=C_NULL_PTR
      DO 200 IBM=1,NMIX
      WEIGHT=TERP(ICAL,IBM)
      IF((MIXC(IBM).NE.IBMOLD).OR.(WEIGHT.EQ.0.0)) GO TO 200
*----
*  PRODUCE AN ELEMENTARY MACROLIB (IF IPTMP=0)
*----
      IF(.NOT.C_ASSOCIATED(IPTMP)) THEN
        CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
        CALL LCMEQU(MPCPO,IPTMP)
        IF(IMPX.GT.0) THEN
          WRITE(IOUT,'(33H NCRMAC: COMPO ACCESS FOR MIXTURE,I6,5H AND ,
     1    11HCALCULATION,I5,9H. WEIGHT=,1P,E12.4)') IBM,ICAL,WEIGHT
          IF(IMPX.GT.50) CALL LCMLIB(IPTMP)
        ENDIF
        CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
        NBISO=ISTATE(2)
        IF(ISTATE(1).NE.1) CALL XABORT('NCRMAC: INVALID NUMBER OF MATE'
     1  //'RIAL MIXTURES IN THE COMPO.')
        IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRMAC: INVALID NUMBER OF E'
     1  //'NERGY GROUPS IN THE COMPO.')
        ALLOCATE(MASKL(NGRP))
        CALL XDLSET(MASKL,NGRP,.TRUE.)
        CALL LCMGPD(IPTMP,'ISOTOPESUSED',ISONA_PTR)
        CALL LCMGPD(IPTMP,'ISOTOPESDENS',DENIS_PTR)
        CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
        CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
        IF(.NOT.LRES) THEN
          DO 110 ISO=1,NBISO
          WRITE(TEXT8,'(2A4)') (ISONA(3*(ISO-1)+I0),I0=1,2)
          KSO1=0
          DO 90 KSO=1,NISO(IBM) ! user-selected isotope
          WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
          IF(TEXT8.EQ.HHISO) THEN
            KSO1=KSO
            GO TO 100
          ENDIF
   90     CONTINUE
          IF(.NOT.LISO(IBM)) THEN
            DENIS(ISO)=0.0
            GO TO 110
          ENDIF
  100     LUSER=.FALSE.
          IF(KSO1.GT.0) LUSER=(CONC(IBM,KSO1).NE.-99.99)
          IF(LUSER) DENIS(ISO)=CONC(IBM,KSO1)
  110     CONTINUE
        ENDIF
        MAXMIX=1
        ITSTMP=0
        TMPDAY(1)=0.0
        TMPDAY(2)=0.0
        TMPDAY(3)=0.0
        ALLOCATE(ISOMI(NBISO))
        CALL XDISET(ISOMI,NBISO,1)
        CALL LIBMIX(IPTMP,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,
     1              .TRUE.,MASKL,ITSTMP,TMPDAY)
        CALL LCMPPD(IPTMP,'ISOTOPESDENS',NBISO,2,DENIS_PTR)
        DEALLOCATE(ISOMI,MASKL)
*----
*  RECOVER THE INTEGRATED FLUX
*----
        CALL LCMLEN(IPTMP,'MIXTURESVOL',ILONG,ITYLCM)
        IF(ILONG.EQ.0) GO TO 165
        CALL LCMGET(IPTMP,'MIXTURESVOL',VOLMIX)
        XVOLM(IBM)=VOLMIX
        LWT0=.FALSE.
        LWT1=.FALSE.
        CALL XDRSET(FLUX,NGRP*2,0.0)
        DO 150 ISOT=1,NBISO
        WRITE(TEXT12,'(3A4)') (ISONA(3*(ISOT-1)+I0),I0=1,3)
        CALL LCMLEN(IPTMP,TEXT12,ILONG,ITYLCM)
        IF(ILONG.NE.0) THEN
          CALL LCMSIX(IPTMP,TEXT12,1)
          CALL LCMLEN(IPTMP,'NWT0',ILONG,ITYLCM)
          IF(ILONG.EQ.NGRP) THEN
            LWT0=.TRUE.
            CALL LCMGPD(IPTMP,'NWT0',NWT_PTR)
            CALL C_F_POINTER(NWT_PTR,NWT,(/ NGRP /))
            DO 130 IGR=1,NGRP
  130       FLUX(IGR,1)=NWT(IGR)*VOLMIX
          ENDIF
          CALL LCMLEN(IPTMP,'NWT1',ILONG,ITYLCM)
          IF(ILONG.EQ.NGRP) THEN
            LWT1=.TRUE.
            CALL LCMGPD(IPTMP,'NWT1',NWT_PTR)
            CALL C_F_POINTER(NWT_PTR,NWT,(/ NGRP /))
            DO 140 IGR=1,NGRP
  140       FLUX(IGR,2)=NWT(IGR)*VOLMIX
          ENDIF
          CALL LCMSIX(IPTMP,' ',2)
        ENDIF
  150   CONTINUE
        CALL LCMSIX(IPTMP,'MACROLIB',1)
        JPTMP=LCMGID(IPTMP,'GROUP')
        DO 160 IGR=1,NGRP
        KPTMP=LCMGIL(JPTMP,IGR)
        IF(LWT0) CALL LCMPUT(KPTMP,'FLUX-INTG',1,2,FLUX(IGR,1))
        IF(LWT1) CALL LCMPUT(KPTMP,'FLUX-INTG-P1',1,2,FLUX(IGR,2))
  160   CONTINUE
        CALL LCMSIX(IPTMP,' ',2)
      ENDIF
*----
*  PERFORM INTERPOLATION
*----
  165 CALL LCMSIX(IPTMP,'MACROLIB',1)
      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
      IF(NF.EQ.0) NF=ISTATE(4)
      IF(NF.GT.MAXNFI) CALL XABORT('NCRMAC: MAXNFI OVERFLOW.')
      IF(ISTATE(1).NE.NGRP) THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
      ELSE IF(ISTATE(2).NE.1)THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(3).')
      ELSE IF(ISTATE(3).NE.NL) THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF LEGENDRE ORDERS(3).')
      ELSE IF((ISTATE(4).NE.0).AND.(ISTATE(4).NE.NF)) THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF FISSILE ISOTOPES(3).')
      ELSE IF(ISTATE(5).NE.NED) THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF EDIT REACTIONS(3).')
      ELSE IF(ISTATE(7).NE.NDEL) THEN
         CALL XABORT('NCRMAC: INVALID NUMBER OF PRECURSOR GROUPS(3).')
      ENDIF
      JPTMP=LCMGID(IPTMP,'GROUP')
      DO 190 IGR=1,NGRP
      KPTMP=LCMGIL(JPTMP,IGR)
      DO 170 I1D=1,N1D
      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
      IF(ILONG.NE.0) THEN
        IF(ILONG.NE.1) CALL XABORT('NCRMAC: FLOTVA OVERFLOW.')
        LMAKE1(I1D)=.TRUE.
        CALL LCMGET(KPTMP,HMAK1(I1D),FLOTVA)
        IF((I1D.GE.4).AND.(I1D.LE.7)) FLOTVA=1.0/FLOTVA
        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
      ENDIF
  170 CONTINUE
      IF(ISTATE(4).GT.0) THEN
        DO 175 I2D=1,N2D
        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
        IF(ILONG.NE.0) THEN
          IF(ILONG.NE.NF) CALL XABORT('NCRMAC: FLOT OVERFLOW.')
          LMAKE2(I2D)=.TRUE.
          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
          DO 174 I=1,NF
  174     GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(I)
        ENDIF
  175   CONTINUE
      ENDIF
      DO 190 IL=1,NL
      WRITE(CM,'(I2.2)') IL-1
      ILONG=1
      IF(IL.GT.1) CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
      IF(ILONG.NE.0) THEN
        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4)
        CALL LCMGET(KPTMP,'NJJS'//CM,NJJ)
        CALL LCMGET(KPTMP,'IJJS'//CM,IJJ)
        CALL LCMGET(KPTMP,'IPOS'//CM,IPOS)
        IPOSDE=IPOS(1)
        DO 180 JGR=IJJ(1),IJJ(1)-NJJ(1)+1,-1
        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4(IPOSDE)
  180   IPOSDE=IPOSDE+1
      ENDIF
  190 CONTINUE
      CALL LCMSIX(IPTMP,' ',2)
      IF(.NOT.LFAST) CALL LCMCL(IPTMP,2)
  200 CONTINUE
      IF(C_ASSOCIATED(IPTMP)) CALL LCMCL(IPTMP,2)
  210 CONTINUE
*----
*  WRITE INTERPOLATED MACROLIB INFORMATION
*----
      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,XVOLM)
      DEALLOCATE(XVOLM)
      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
      DO 360 IGR=1,NGRP
      KPMAC=LCMDIL(JPMAC,IGR)
      DO 320 I1D=1,N1D
      IF(LMAKE1(I1D)) THEN
        IF((I1D.GE.4).AND.(I1D.LE.7)) THEN
          DO 310 IBM=1,NMIX
  310     GAR1(IBM,IGR,I1D)=1.0/GAR1(IBM,IGR,I1D)
        ENDIF
        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
      ENDIF
  320 CONTINUE
      DO 325 I2D=1,N2D
      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
      ENDIF
  325 CONTINUE
      DO 360 IL=1,NL
      WRITE(CM,'(I2.2)') IL-1
      IPOSDE=0
      DO 350 IBM=1,NMIX
      IPOS(IBM)=IPOSDE+1
      IGMIN=IGR
      IGMAX=IGR
      DO 330 JGR=1,NGRP
      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
        IGMIN=MIN(IGMIN,JGR)
        IGMAX=MAX(IGMAX,JGR)
      ENDIF
  330 CONTINUE
      IJJ(IBM)=IGMAX
      NJJ(IBM)=IGMAX-IGMIN+1
      DO 340 JGR=IGMAX,IGMIN,-1
      IPOSDE=IPOSDE+1
  340 GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
  350 CONTINUE
      IF(IPOSDE.GT.0) THEN
        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
      ENDIF
  360 CONTINUE
      IACCS=1
*----
*  UPDATE STATE-VECTOR
*----
      CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
      ISTATE(4)=MAX(ISTATE(4),NF)
      IF(LMAKE1(4)) ISTATE(9)=1
      IF(LMAKE1(5)) ISTATE(9)=2
      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
*----
*  END OF OVERALL MULTICOMPO MIXTURE LOOP
*----
  500 CONTINUE
*----
*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
*----
      IF(B2.NE.0.0) THEN
        JPMAC=LCMGID(IPMAC,'GROUP')
        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
        DO 520 IGR=1,NGRP
          KPMAC=LCMGIL(JPMAC,IGR)
          CALL LCMGET(KPMAC,'NTOT0',WORK1)
          CALL LCMGET(KPMAC,'DIFF',WORK2)
          DO 510 IBM=1,NMIX
            IF(MIXC(IBM).NE.0) 
     1       WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
  510     CONTINUE
          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
  520   CONTINUE
        DEALLOCATE(WORK2,WORK1)
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(GAR4,GAR3,GAR2,GAR1,FLUX)
      DEALLOCATE(IPOS,NJJ,IJJ)
      RETURN
      END
