*DECK LIBNOT
      SUBROUTINE LIBNOT (IPLIB,NGRO,NL,NDIL,NED,NDEL,IMPX,LSCAT,LSIGF,
     1 LADD,DILUT,FLUX,TOTAL,SIGF,SIGS,SCAT,SADD,ZDEL,HVECT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* write the incremental x-s data on a temperature-independant Draglib.
*
*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 internal library (L_LIBRARY signature).
* NGRO    number of energy groups.
* NL      number of Legendre orders required in the calculation
*         (NL=1 or higher).
* NDIL    number of finite dilutions.
* NED     number of extra vector edits.
* NDEL    number of delayed neutron precursor groups.
* IMPX    print flag.
* LSCAT   Legendre flag (=.true. if a given Legendre order of the
*         scattering cross section exists).
* LSIGF   fission flag (=.true. if the isotope can fission).
* LADD    additional xs flag (=.true. if a given additional cross
*         section exists).
* DILUT   dilutions.
* FLUX    weighting flux.
* TOTAL   total cross sections.
* SIGF    nu*fission cross sections.
* SIGS    diffusion cross sections.
* SCAT    scattering transfer matrices (sec,prim,Legendre,dilution).
* SADD    additional cross sections.
* ZDEL    delayed nu-sigf cross sections.
* HVECT   names of the extra vector edits.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIB
      INTEGER NGRO,NL,NDIL,NED,NDEL,IMPX
      REAL DILUT(NDIL+1),FLUX(NGRO,NDIL+1),TOTAL(NGRO,NDIL+1),
     1 SIGF(NGRO,NDIL+1),SIGS(NGRO,NL,NDIL+1),SCAT(NGRO,NGRO,NL,NDIL+1),
     2 SADD(NGRO,NED,NDIL+1),ZDEL(NGRO,NDEL,NDIL+1)
      LOGICAL LSIGF,LSCAT(NL),LADD(NED)
      CHARACTER HVECT(NED)*6
*----
*  LOCAL VARIABLES
*----
      CHARACTER TEXT12*12,CD*4
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO
      REAL, ALLOCATABLE, DIMENSION(:) :: GAS
      REAL, ALLOCATABLE, DIMENSION(:,:) :: GA1
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GA2
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(ITYPRO(NL))
      ALLOCATE(GAS(NGRO),GA1(NGRO,NL),GA2(NGRO,NGRO,NL))
*
      CALL LCMPUT(IPLIB,'DILUTION',NDIL,2,DILUT)
      DO 130 IDIL=1,NDIL
      WRITE (CD,'(I4.4)') IDIL
      CALL LCMSIX(IPLIB,'SUBMAT'//CD,1)
      DO 10 IG1=1,NGRO
   10 GAS(IG1)=FLUX(IG1,IDIL)-1.0
      CALL LCMPUT(IPLIB,'NWT0',NGRO,2,GAS)
      DO 20 IG1=1,NGRO
   20 GAS(IG1)=TOTAL(IG1,IDIL)*FLUX(IG1,IDIL)-TOTAL(IG1,NDIL+1)
      CALL LCMPUT(IPLIB,'NTOT0',NGRO,2,GAS)
      IF(LSIGF) THEN
         DO 30 IG1=1,NGRO
   30    GAS(IG1)=SIGF(IG1,IDIL)*FLUX(IG1,IDIL)-SIGF(IG1,NDIL+1)
         CALL LCMPUT(IPLIB,'NUSIGF',NGRO,2,GAS)
      ENDIF
      INGRO=NL-1
      DO 40 IL=NL-1,0,-1
      IF(.NOT.LSCAT(IL+1)) THEN
         INGRO=INGRO-1
      ELSE
         GO TO 50
      ENDIF
   40 CONTINUE
   50 DO 80 IL=1,INGRO+1
      IF(LSCAT(IL)) THEN
         DO 60 IG1=1,NGRO
         GA1(IG1,IL)=SIGS(IG1,IL,IDIL)*FLUX(IG1,IDIL)-
     1   SIGS(IG1,IL,NDIL+1)
         DO 60 IG2=1,NGRO
   60    GA2(IG1,IG2,IL)=SCAT(IG1,IG2,IL,IDIL)*FLUX(IG2,IDIL)-
     1   SCAT(IG1,IG2,IL,NDIL+1)
      ELSE
         DO 70 IG1=1,NGRO
         GA1(IG1,IL)=0.0
         DO 70 IG2=1,NGRO
   70    GA2(IG1,IG2,IL)=0.0
      ENDIF
   80 CONTINUE
      CALL XDRLGS(IPLIB,1,IMPX,0,INGRO,1,NGRO,GA1,GA2,ITYPRO)
      DO 100 IED=1,NED
      IF(LADD(IED)) THEN
         DO 90 IG1=1,NGRO
   90    GAS(IG1)=SADD(IG1,IED,IDIL)*FLUX(IG1,IDIL)-SADD(IG1,IED,NDIL+1)
         CALL LCMPUT(IPLIB,HVECT(IED),NGRO,2,GAS)
      ENDIF
  100 CONTINUE
      DO 120 IDEL=1,NDEL
      WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
      DO 110 IG1=1,NGRO
  110 GAS(IG1)=ZDEL(IG1,IDEL,IDIL)*FLUX(IG1,IDIL)-ZDEL(IG1,IDEL,NDIL+1)
      CALL LCMPUT(IPLIB,TEXT12,NGRO,2,GAS)
  120 CONTINUE
      CALL LCMSIX(IPLIB,' ',2)
  130 CONTINUE
      IF(IMPX.GT.3) CALL LCMLIB(IPLIB)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(GA2,GA1,GAS)
      DEALLOCATE(ITYPRO)
      RETURN
      END
