GEANT321/neutron/xsecn1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:22:00  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE XSECN1(NII,KE,IN,ICOM,IREC,IUNIT,LNUMB,IND,
  13      +                  BUF,IBUF,INEL)
  14 C       THIS ROUTINE READS THE SECOND RECORD ON INPUT
  15 C       I/O UNIT (MICROS)  (I.E. THE B CONTROL BLOCK)
  16 #include "geant321/minput.inc"
  17 #include "geant321/mmicap.inc"
  18 #include "geant321/mconst.inc"
  19       DIMENSION BUF(*),IBUF(*),ICOM(*),KE(*),IREC(*),IND(*),IN(*)
  20       DIMENSION INEL(*),LNUMB(*),IUNIT(*)
  21       INTEGER NII
  22 C       READ THE B CONTROL BLOCK OFF INPUT I/O UNIT
  23       LT = LTEMP
  24       LZ = 1
  25       IU = 1
  26    10 CONTINUE
  27         NU = IQ(LT+NTUNIT)
  28         NIJ = IQ(LT+NTMPNI)
  29         LZZ=3*NIJ
  30         READ(NU,'((8I10))')(IBUF(I),I=LZ,LZZ+LZ)
  31 C       INITIALIZE IND ARRAY AND IREC ARRAY TO ZERO
  32         DO 20 I=IU,IU+NIJ-1
  33           IUNIT(I) = NU
  34    20   CONTINUE
  35         IU = IU+NIJ
  36         LZ = LZ + LZZ
  37         LT = LQ(LT)
  38       IF(LT.GT.0) GOTO 10
  39       DO 30 I=1,NII
  40          INEL(I)=0
  41          IREC(I)=0
  42    30 CONTINUE
  43       DO 40 I=1,NMIX
  44    40 IND(I)=0
  45       II=0
  46       JI=0
  47    50 II=II+1
  48 CZ      IF(II.GT.NII)GO TO 90
  49       IF(3*II.GT.LZ)GO TO 90
  50       NEL=IBUF(3*II-2)
  51       INEL(II)=NEL
  52       DO 60 IJ=1,NMIX
  53 C correct element AND the correct unit ?
  54          IF(NEL.EQ.KE(IJ)) GO TO 70
  55    60 CONTINUE
  56       IREC(II)=0
  57       GO TO 50
  58    70 I=IN(IJ)
  59 C       ICOM RELATES THE ISOTOPE NUMBER TO THE DICTIONARY NUMBER
  60       IF(ICOM(I).GT.0) IREC(ICOM(I)) = 0
  61       ICOM(I)=II
  62 C total length of x-section data in words
  63       LNUMB(I)  = IBUF(3*II)
  64       IREC(II)  = IBUF(3*II-1)
  65 C       SET INDICATORS
  66       DO 80  I=IJ,NMIX
  67          IF(NEL.NE.KE(I))GO TO 80
  68          IND(I)=1
  69          JI=JI+1
  70    80 CONTINUE
  71       GO TO 50
  72    90 RETURN
  73       END