*DECK LIBSEC
      SUBROUTINE LIBSEC(MAXTRA,LLL,IANNN,NGRO,IX,UUU,DELTA,SIGS,SIG1,
     1 PRI,NLET,STR,DEL,NRSTR,IANIS,ITY,NEXT,NEXU,NEXV,NEXW,III)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute the values of the transfer macroscopic cross section for
* secondary neutrons in group LLL. Component of the APOLIB-1 reader
*
*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
* MAXTRA  available storage for apollo compacted transfer cross sections
* LLL     group number for secondary neutrons
* IANNN   type of transport correction (=-1: transport corrected P0;
*         =0: P0; =1: P1)
* NGRO    number of groups
* IX      number of groups with up-scattering
* UUU     groups limits in lethargy units
* DELTA   groups width in lethargy units
* SIGS    diffusion P0 microscopic cross sections
* SIG1    diffusion P1 microscopic cross sections
* PRI     transfer microscopic cross sections
* DEL     elementary mesh element in lethargy
* NRSTR   number of cross section structures own by the isotope
* IANIS   Legendre order corresponding to each cross section structure
* ITY     type of each cross section structure
* NEXT    length of each cross section structure
* NEXU    information related to each cross section structure
* NEXV    information related to each cross section structure
* NEXW    information related to each cross section structure
* III     offset in vector PRI of each cross section structure
*
*Parameters: output
* NLET    number of down-scattering groups (including group LLL)
* STR     values of the transfer macroscopic cross section:
*          STR(1):     from group LLL;
*          STR(2):     from group LLL-1;
*          STR(LLL):   from group 1;
*          STR(LLL+1): from group NGRO;
*          STR(LLL+2): from group NGRO-1;
*          STR(NGRO):  from group LLL+1
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER MAXTRA,LLL,IANNN,NGRO,IX,NLET,NRSTR,IANIS(80),ITY(80),
     1 NEXT(80),NEXU(80),NEXV(80),NEXW(80),III(80)
      REAL UUU(NGRO),DELTA(NGRO),SIGS(NGRO),SIG1(NGRO),PRI(MAXTRA),
     1 STR(NGRO),DEL
*----
*  LOCAL VARIABLES
*----
      DOUBLE PRECISION DAUX
      LOGICAL SELF
      EQUIVALENCE(AUX1,K12)
*
      NGROIN=NGRO-IX
      IAN=IANNN
      IF(IANNN.EQ.-1)IAN=0
      DO 71 MM=1,NGRO
      STR(MM)=0.0
   71 CONTINUE
      NLET=1
      SELF=.FALSE.
      IF (NRSTR.GT.0) THEN
         DO 250 K=1,NRSTR
         IF (IANIS(K).NE.IAN) GOTO 250
         MML=0
         IF (ITY(K).EQ.1) THEN
*           ELASTIC SLOWING-DOWN MATRIX.
            IF (LLL.GT.NGROIN) GO TO 250
            SELF=.TRUE.
            LDELH=INT(UUU(LLL)/DEL+0.1)
            LARGRL=INT(DELTA(LLL)/DEL+0.1)
            LDELB=LDELH-LARGRL+1
            NP2=NEXT(K)
            IHM=III(K)+NP2-1
            LTES=LDELB-NP2
            ISOTOP=K
            INDICE=1
            DO 210 MM1=1,LLL
            MM=LLL-MM1+1
            MDELH=INT(UUU(MM)/DEL+0.1)
            IF(MDELH.LE.LTES)GOTO 211
            LARGRM=INT(DELTA(MM)/DEL+0.1)
            MDELB=MDELH-LARGRM+1
            MDELB=MAX0(MDELB,LTES+1)
            DAUX=0.0
            LARG=MIN0(LARGRM,LARGRL)
            IF(LARG.GT.4) THEN
               IHAUT=LDELH-MDELB+III(K)
               IHAUT=MIN0(IHAUT,IHM)
               J=0
               INTER2=0
               IF (INDICE.EQ.2) THEN
                  IBAS=LDELB-MDELH+III(K)
                  IBAS=MAX0(IBAS,III(K))
                  LARGLI=IABS(LARGRM-LARGRL)
                  INTER1=IBAS+LARG-2
                  INTER1=MIN0(INTER1,IHAUT)
                  DO 182 I=IBAS,INTER1
                  J=J+1
                  DAUX=DAUX+PRI(I)*FLOAT(J)
  182             CONTINUE
                  INTER1=INTER1+1
                  INTER2=INTER1+LARGLI
                  INTER2=MIN0(IHAUT,INTER2)
                  IF(INTER1.GT.INTER2) GO TO 1004
                  J=LARG
                  DO 183 I=INTER1,INTER2
                  DAUX=DAUX+PRI(I)*FLOAT(LARG)
  183             CONTINUE
               ELSE IF (INDICE.EQ.1) THEN
                  INDICE=2
                  INTER2=III(K)-1
                  J=LARG+1
               ENDIF
               INTER2=INTER2+1
               DO 184 I=INTER2,IHAUT
               J=J-1
               DAUX=DAUX+PRI(I)*FLOAT(J)
  184          CONTINUE
            ELSE
               DO 83 MDEL=MDELB,MDELH
               IBAS=LDELB-MDEL+III(K)
               IHAUT=LDELH-MDEL+III(K)
               IBAS=MAX0(IBAS,III(K))
               IHAUT=MIN0(IHAUT,IHM)
               DO 82 I=IBAS,IHAUT
               DAUX=DAUX+PRI(I)
   82          CONTINUE
   83          CONTINUE
            ENDIF
 1004       STR(MM1)=STR(MM1)+REAL(DAUX*SIGS(MM)*DEL/DELTA(LLL))
  210       CONTINUE
            MM=MM-1
  211       MML=LLL-MM
         ELSE IF (ITY(K).EQ.4) THEN
*           STANDARD GALOCHE.
            IF (LLL.GT.NGROIN) GO TO 250
            SELF=.TRUE.
            NEX1=NEXU(K)
            NEX2=NEXV(K)
            NEX3=NEXW(K)
            IF(LLL.GT.(NEX2+NEX3)) GO TO 801
            IPR=III(K)-1+(LLL*(LLL-1))/2
            DO 802 I=1,LLL
            IPR=IPR+1
            STR(I)=STR(I)+PRI(IPR)
  802       CONTINUE
            MML=LLL
            GO TO 240
  801       IF(LLL.GT.NEX1) GO TO 803
            IPR=III(K)-1+LLL*(NEX2+NEX3)-((NEX2+NEX3)*(NEX2+NEX3+1))/2
            DO 804 I=1,NEX2
            IPR=IPR+1
            STR(I)=STR(I)+PRI(IPR)
  804       CONTINUE
            LN3=LLL-NEX3+1
            DO 807 I=LN3,LLL
            IPR=IPR+1
            STR(I)=STR(I)+PRI(IPR)
  807       CONTINUE
            MML=LLL
            GO TO 240
  803       IF(NEX2.EQ.0) GO TO 250
            IPR=III(K)-1+NEX1*NEX3-((NEX2+NEX3)*(NEX2+NEX3-1))/2+
     1      (LLL-1)*NEX2
            DO 813 I=1,NEX2
            IPR=IPR+1
            STR(I)=STR(I)+PRI(IPR)
  813       CONTINUE
            MML=NEX2
         ELSE IF (ITY(K).EQ.7) THEN
*           THERMAL TRANSFER MATRIX.
            IF (LLL.LE.NGROIN) GO TO 250
            SELF=.TRUE.
            IPR=III(K)-1+(NGRO-LLL)*IX
            DO 5003 MM=1,LLL-NGROIN
            STR(MM)=STR(MM)+PRI(IPR+MM+NGRO-LLL)
 5003       CONTINUE
            DO 5004 MM=1,NGRO-LLL
            STR(MM+LLL)=STR(MM+LLL)+PRI(IPR+MM)
 5004       CONTINUE
            MML=LLL-NGROIN
         ELSE IF (ITY(K).EQ.8) THEN
*           RECTANGLE SLOWING-DOWN MATRIX.
            IF(LLL.LT.NEXU(K))GO TO 250
            IF(LLL.GT.NEXV(K))GO TO 250
            IPR=III(K)-1+(LLL-NEXU(K))*NEXW(K)
            LN1=LLL-NEXU(K)+2
            DO 355 I=LN1,LN1+NEXW(K)-1
            IPR=IPR+1
            STR(I)=STR(I)+PRI(IPR)
  355       CONTINUE
            MML=NEXW(K)+LLL-NEXU(K)+1
         ELSE IF (ITY(K).EQ.9) THEN
*           GREULING-GOERTZEL SLOWING DOWN MATRIX.
            NEX1=NEXU(K)
            NEX3=NEXW(K)
            IF ((LLL.LT.NEX1).OR.(LLL.GT.NEX3)) GO TO 250
            SELF=.TRUE.
            NEX2=NEXV(K)
            NEX4=NEXT(K)/3
            MML=LLL-NEX1+1
            IPR=NEX3-LLL+III(K)-1
            J=IPR+1+NEX4
            DAUX=PRI(J)
            J=IPR+1+2*NEX4
            IF(LLL.GT.NEX2) THEN
               LN1=LLL-NEX2+1
            ELSE
               LN1=1
               STR(1)=STR(1)+PRI(J)
            ENDIF
            J=IPR+LN1-1
            DO 360 MM=LN1,MML
            J=J+1
            STR(MM)=STR(MM)+REAL(PRI(J)*DAUX)
  360       CONTINUE
         ENDIF
  240    NLET=MAX0(NLET,MML)
  250    CONTINUE
      ENDIF
      IF ((.NOT.SELF).AND.(IAN.EQ.0)) THEN
         STR(1)=STR(1)+SIGS(LLL)
      ELSE IF ((.NOT.SELF).AND.(IAN.EQ.1)) THEN
         STR(1)=STR(1)+3.0*SIG1(LLL)
      ENDIF
      IF (IANNN.EQ.-1) THEN
         STR(1)=STR(1)-SIG1(LLL)
      ENDIF
      RETURN
      END
