GEANT321/neutron/xsecn3.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/02 29/03/94  15.41.48  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE XSECN3(KM,KE,RHO,IN,IDICTS,LDICT,ISIGTS,LSIGT,BUF,
  13      +IBUF,TCS,LIM,LAST)
  14 C       THIS ROUTINE CREATES MACROSCOPIC TOTAL CROSS SECTIONS
  15 C       AND THEN MIXES AND THINS THESE CROSS SECTIONS ACCORDING
  16 C       TO THE MIXING TABLE
  17 #include "geant321/minput.inc"
  18 #include "geant321/mconst.inc"
  19 #include "geant321/mpoint.inc"
  20 #include "geant321/mmicab.inc"
  21       DIMENSION BUF(*),IBUF(*),KM(*),KE(*),RHO(*),IN(*),
  22      +IDICTS(NNR,NNUC),LDICT(NNR,NNUC),ISIGTS(*),LSIGT(*),TCS(*)
  23 C       ASSIGN THE INITIAL VALUES
  24 C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
  25 C   (I.E. (BUF(LST) = D(LAST)))
  26 C       LEN EQUALS THE CORE SPACE AVAILABLE
  27       LST=0
  28       LEN=LIM-LAST
  29       TOL = 1.0
  30 C       READ IN TWO CROSS SECTION ARRAYS AND CREATE
  31 C       MACROSCOPIC CROSS SECTIONS
  32       DO 160 J=1,MEDIA
  33          JI=0
  34          K=0
  35 C       READ IN THE FIRST ARRAY
  36          DO 140 IJ=1,NMIX
  37             IF(KM(IJ).NE.J)GO TO 140
  38             JI=JI+1
  39             K=K+1
  40             II=IN(IJ)
  41             TOL = AMIN1(TCS(LFP210+II-1)/5.,TOL)
  42             IF(JI.EQ.2)GO TO 20
  43             LZ=LDICT(1,II)
  44             ISLZ=IDICTS(1,II)+LMOX2
  45             N=LZ
  46             IF(LEN.LT.N)GO TO 180
  47             NP=LZ/2
  48             DO 10 M=1,NP
  49                BUF(LST+2*M-1)=TCS(ISLZ+2*(M-1))
  50                BUF(LST+2*M)=TCS(ISLZ+2*M-1)*RHO(IJ)
  51    10       CONTINUE
  52             GO TO 140
  53    20       CONTINUE
  54 C       READ IN THE SECOND ARRAY
  55             LZ2=LZ+1
  56             LZ1=LZ
  57             LZ=LDICT(1,II)
  58             ISLZ=IDICTS(1,II)+LMOX2
  59             N=2*(LZ+LZ1)
  60             IF(N.GE.LEN)GO TO 180
  61             NP=LZ/2
  62             DO 30 M=1,NP
  63                BUF(LST+LZ1+2*M-1)=TCS(ISLZ+2*(M-1))
  64                BUF(LST+LZ1+2*M)=TCS(ISLZ+2*M-1)*RHO(IJ)
  65    30       CONTINUE
  66             GO TO 40
  67 C       MIX THE TWO ARRAYS
  68    40       K=2
  69             L=2
  70             IF(BUF(LST+1).NE.1.E-5)GO TO 170
  71             IF(BUF(LST+LZ2).NE.1.E-5)GO TO 170
  72             NXSEC=1
  73             BUF(LST+LZ1+LZ+1)=1.E-5
  74             BUF(LST+LZ1+LZ+2)=BUF(LST+2)+BUF(LST+LZ2+1)
  75 C       DETERMINE THE NEXT ENERGY POINT
  76    50       IF(BUF(LST+1+K).EQ.BUF(LST+LZ2+L))GO TO 90
  77             IF(BUF(LST+1+K).LT.BUF(LST+LZ2+L))GO TO 70
  78 C       DETERMINE THE CROSS SECTION AT ENERGY POINT BUF(LST+LZ2+L)
  79             CALL CTERP(BUF(LST+K-1),BUF(LST+K+1),BUF(LST+LZ2+L),
  80      +                BUF(LST+K), BUF(LST+K+2),SIGMA)
  81             NXSEC=NXSEC+1
  82             LP=LZ1+LZ+1+2*(NXSEC-1)
  83             BUF(LST+LP)=BUF(LST+LZ2+L)
  84             BUF(LST+LP+1)=BUF(LST+LZ2+L+1)+SIGMA
  85             L=L+2
  86             IF(L.LT.LZ)GO TO 50
  87 C       ALL THE POINTS IN THE SECOND ARRAY HAVE NOW BEEN USED
  88    60       NXSEC=NXSEC+1
  89             LP=LZ1+LZ+1+2*(NXSEC-1)
  90             BUF(LST+LP)=BUF(LST+1+K)
  91             BUF(LST+LP+1)=BUF(LST+2+K)
  92             K=K+2
  93             IF(K.LT.LZ1)GO TO 60
  94             GO TO 100
  95 C       DETERMINE THE CROSS SECTION AT ENERGY POINT BUF(LST+1+K)
  96    70       CALL CTERP(BUF(LST+LZ2+L-2),BUF(LST+LZ2+L),BUF(LST+1+K),
  97      +      BUF(LST+LZ2+L-1),BUF(LST+LZ2+L+1),SIGMA)
  98             NXSEC=NXSEC+1
  99             LP=LZ1+LZ+1+2*(NXSEC-1)
 100             BUF(LST+LP)=BUF(LST+1+K)
 101             BUF(LST+LP+1)=BUF(LST+K+2)+SIGMA
 102             K=K+2
 103             IF(K.LT.LZ1)GO TO 50
 104 C       ALL THE POINTS IN THE FIRST ARRAY HAVE NOW BEEN USED
 105    80       NXSEC=NXSEC+1
 106             LP=LZ1+LZ+2*NXSEC-1
 107             BUF(LST+LP)=BUF(LST+LZ2+L)
 108             BUF(LST+LP+1)=BUF(LST+LZ2+L+1)
 109             L=L+2
 110             IF(L.LT.LZ)GO TO 80
 111             GO TO 100
 112 C       THE ENERGY POINTS COINCIDE
 113    90       NXSEC=NXSEC+1
 114             LP=LZ1+LZ+1+2*(NXSEC-1)
 115             BUF(LST+LP)=BUF(LST+LZ2+L)
 116             BUF(LST+LP+1)=BUF(LST+2+K)+BUF(LST+LZ2+L+1)
 117             L=L+2
 118             K=K+2
 119             IF((L.LT.LZ).AND.(K.LT.LZ1))GO TO 50
 120             IF((L.GT.LZ).AND.(K.LT.LZ1))GO TO 60
 121             IF((L.LT.LZ).AND.(K.GT.LZ1))GO TO 80
 122 C       FINISHED MIXING NOW THIN
 123   100       L=1
 124             NXSEC2=1
 125             LP=LZ1+LZ
 126             BUF(LST+NXSEC2)=BUF(LST+LP+L)
 127             BUF(LST+NXSEC2+1)=BUF(LST+LP+L+1)
 128             KI=0
 129   110       L=L+2
 130             KI=KI+1
 131 C       CHECK TO SEE IF AT END OF CROSS SECTION ARRAY
 132             L2=L+2
 133             N=2*NXSEC
 134             IF(L2.LT.N)GO TO 120
 135 C       FINISHED THINING
 136             NXSEC2=NXSEC2+1
 137             N=2*(NXSEC2-1)
 138             BUF(LST+1+N)=BUF(LST+LP+L)
 139             BUF(LST+2+N)=BUF(LST+LP+L+1)
 140             LZ=2*NXSEC2
 141             JI=1
 142             GO TO 140
 143   120       DO 130 I=1,KI
 144 C       ESTIMATE THE CROSS SECTION AT KI NODES
 145                CALL CTERP(BUF(LST+LP+L-2*KI),BUF(LST+LP+L2),
 146      +                   BUF(LST+LP+L-2*I+2),BUF(LST+LP+L-2*KI+1),
 147      +                   BUF(LST+LP+L2+1),SIGMA)
 148                ER=ABS(SIGMA-BUF(LST+LP+L-2*I+3))
 149 C       IF ERROR IS WITHIN ALLOWABLE TOLERANCE, CHECK NEXT POINT
 150                ERMAX=BUF(LST+LP+L-2*I+3)*TOL
 151                IF(ER.LE.ERMAX)GO TO 130
 152 C       NOT WITHIN ALLOWABLE TOLERANCE, MUST ADD NODE L-2 TO MESH
 153                IF(L.GT.3.AND.KI.GT.1) L = L - 2
 154                NXSEC2=NXSEC2+1
 155                N=2*(NXSEC2-1)
 156                BUF(LST+1+N)=BUF(LST+LP+L)
 157                BUF(LST+2+N)=BUF(LST+LP+L+1)
 158                KI = 0
 159                GO TO 110
 160   130       CONTINUE
 161 C       ALL KI POINTS ARE WITHIN ALLOWABLE TOLERANCE
 162 C       CHECK THE NEXT POINT
 163             GO TO 110
 164   140    CONTINUE
 165 C       FINISHED WITH MEDIUM J, NOW STORE IN CORE
 166          N=2*NXSEC2
 167          IF(K.EQ.1)N=LZ
 168          LSIGT(J)=N
 169          ISIGTS(J)=LAST+1-LMOX3
 170   150    CONTINUE
 171          LAST=LAST+N
 172          LST=LST+N
 173 C       FINISHED MIXING AND THINING
 174   160 CONTINUE
 175       GO TO 200
 176   170 WRITE(IOUT,10000)BUF(LST+1),BUF(LST+LZ2)
 177 10000 FORMAT(' MICAP: ERROR-BEGINNING ENERGY DOES NOT START AT 1.-5',
 178      +1P2E12.4)
 179       GOTO 190
 180   180 CONTINUE
 181       L=LEN
 182       WRITE(IOUT,10100)L,N
 183 10100 FORMAT(' MICAP: NOT ENOUGH ROOM TO MIX CROSS SECTIONS',/,5X,
 184      +'SPACE AVAILABLE=',I10,/,5X,'SPACE NEEDED=',I10)
 185   190 PRINT '('' CALOR: ERROR in XSECN3 ====> STOP'')'
 186       STOP
 187   200 RETURN
 188       END