1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
*DECK LIBNFI
SUBROUTINE LIBNFI(IPLIB,NGRO,NBISO,NBMIX,NDEL,NESP,IPISO,MIX,
1 MAXNFI,NFISSI,LSAME)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute the maximum number of fissionable isotopes in a mixture.
*
*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 lattice microscopic cross section library
* (L_LIBRARY signature).
* NGRO number of energy groups.
* NBISO number of isotopes present in the calculation domain.
* NBMIX number of mixtures present in the calculation domain.
* NDEL number of delayed precursor groups.
* NESP number of energy-dependent fission spectra.
* IPISO pointer array towards microlib isotopes.
* MIX mixture number of each isotope (can be zero for void).
* MAXNFI second dimension of array INDFIS.
*
*Parameters: output
* NFISSI maximum number of fissionable isotopes in a mixture.
* LSAME fission spectrum mask (=.true. if all the isotopes have the
* same fission spectrum and the same precursor group decay
* constants.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER NGRO,NBISO,NBMIX,NDEL,NESP,MIX(NBISO),MAXNFI,NFISSI
LOGICAL LSAME
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPLIB
INTEGER MAXGRO,NSTATE
PARAMETER (MAXGRO=50,NSTATE=40)
CHARACTER HSMG*131,TEXT12*12
REAL CHI2(MAXGRO),LAM1(MAXGRO),LAM2(MAXGRO)
INTEGER IDATA(NSTATE),ISOT,IBM,IFIS,IGR,ILONG,ITYLCM,IWFIS,JBM,
1 KFIS,LENGT1,LENGT2,LENGTZ
LOGICAL LFISS
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IWRK
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDFIS
REAL, ALLOCATABLE, DIMENSION(:) :: CHI1
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(INDFIS(NBMIX,MAXNFI),CHI1(NGRO))
*
NFISSI=0
CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
LSAME=(NGRO.LE.MAXGRO).AND.(NDEL.LE.MAXGRO)
IF(ILONG.EQ.-1) THEN
CALL LCMSIX(IPLIB,'MACROLIB',1)
CALL LCMGTC(IPLIB,'SIGNATURE',12,TEXT12)
IF(TEXT12.NE.'L_MACROLIB') THEN
CALL XABORT('LIBNFI: INVALID SIGNATURE ON THE MACROLIB.')
ENDIF
CALL LCMGET(IPLIB,'STATE-VECTOR',IDATA)
IF(IDATA(1).NE.NGRO) THEN
WRITE(HSMG,'(38HLIBNFI: EXISTING MACROLIB HAVE NGROUP=,I4,
1 26H NEW MACROLIB HAVE NGROUP=,I4,1H.)') IDATA(1),NGRO
CALL XABORT(HSMG)
ELSE IF(IDATA(2).GT.NBMIX) THEN
WRITE(HSMG,'(37HLIBNFI: EXISTING MACROLIB HAVE NBMIX=,I4,
1 25H NEW MACROLIB HAVE NBMIX=,I4,1H.)') IDATA(2),NBMIX
CALL XABORT(HSMG)
ELSE IF(IDATA(4).GT.NBISO*NESP) THEN
WRITE(HSMG,'(38HLIBNFI: EXISTING MACROLIB HAVE NFISSI=,I4,
1 13H GREATER THAN,I5,1H.)') IDATA(4)/NESP,NBISO
CALL XABORT(HSMG)
ENDIF
NFISSI=IDATA(4)/NESP
LSAME=LSAME.AND.(NFISSI.LE.1)
IF(NFISSI.GT.0) THEN
CALL LCMLEN(IPLIB,'FISSIONINDEX',ILONG,ITYLCM)
IF(ILONG.EQ.0) THEN
* THE NAMES ARE NOT DEFINED.
DO 15 IFIS=1,NFISSI
DO 10 IBM=1,NBMIX
INDFIS(IBM,IFIS)=0
10 CONTINUE
15 CONTINUE
ELSE IF(ILONG.EQ.NFISSI*NBMIX) THEN
CALL LCMGET(IPLIB,'FISSIONINDEX',INDFIS)
ELSE IF(ILONG.LT.NFISSI*NBMIX) THEN
* REORDER THE 'FISSIONINDEX' MATRIX.
ALLOCATE(IWRK(ILONG))
CALL LCMGET(IPLIB,'FISSIONINDEX',IWRK)
DO 31 IFIS=1,NFISSI
DO 20 IBM=1,IDATA(2)
INDFIS(IBM,IFIS)=IWRK((IFIS-1)*IDATA(2)+IBM)
20 CONTINUE
DO 30 IBM=IDATA(2)+1,NBMIX
INDFIS(IBM,IFIS)=0
30 CONTINUE
31 CONTINUE
DEALLOCATE(IWRK)
ELSE
CALL XABORT('LIBNFI: INVALID NUMBER OF MIXTURES.')
ENDIF
ENDIF
CALL LCMSIX(IPLIB,' ',2)
ENDIF
DO 100 ISOT=1,NBISO
IBM=MIX(ISOT)
IF(IBM.GT.0) THEN
JPLIB=IPISO(ISOT)
IF(C_ASSOCIATED(JPLIB)) THEN
CALL LCMLEN(JPLIB,'NUSIGF',ILONG,ITYLCM)
IF(NESP.EQ.1) THEN
CALL LCMLEN(JPLIB,'CHI',LENGTZ,ITYLCM)
ELSE
CALL LCMLEN(JPLIB,'CHI--01',LENGTZ,ITYLCM)
ENDIF
IF((ILONG.GT.0).AND.(LENGTZ.GT.0)) THEN
IF(NESP.EQ.1) THEN
CALL LCMGET(JPLIB,'CHI',CHI1)
ELSE
CALL LCMGET(JPLIB,'CHI--01',CHI1)
ENDIF
LFISS=.FALSE.
DO 35 IGR=1,NGRO
LFISS=LFISS.OR.(CHI1(IGR).GT.0.0)
35 CONTINUE
IF(.NOT.LFISS) GO TO 100
IF(LSAME) THEN
CALL LCMLEN(JPLIB,'LAMBDA-D',LENGT1,ITYLCM)
IF((LENGT1.EQ.NDEL).AND.(NDEL.GT.0)) THEN
CALL LCMGET(JPLIB,'LAMBDA-D',LAM1)
ENDIF
ENDIF
DO 40 IFIS=1,NFISSI
IWFIS=INDFIS(IBM,IFIS)
IF((IWFIS.EQ.ISOT).OR.(IWFIS.EQ.0)) THEN
KFIS=IFIS
GO TO 90
ENDIF
40 CONTINUE
IF(LSAME) THEN
DO 70 IFIS=1,NFISSI
IWFIS=INDFIS(IBM,IFIS)
JPLIB=IPISO(IWFIS)
CALL LCMGET(JPLIB,'CHI',CHI2)
DO 50 IGR=1,NGRO
LSAME=LSAME.AND.(ABS(CHI1(IGR)-CHI2(IGR)).LE.1.0E-3)
50 CONTINUE
CALL LCMLEN(JPLIB,'LAMBDA-D',LENGT2,ITYLCM)
IF((LENGT1.EQ.NDEL).AND.(LENGT2.EQ.NDEL)
1 .AND.(NDEL.GT.0)) THEN
CALL LCMGET(JPLIB,'LAMBDA-D',LAM2)
DO 60 IGR=1,NDEL
LSAME=LSAME.AND.(LAM1(IGR).EQ.LAM2(IGR))
60 CONTINUE
ENDIF
70 CONTINUE
ENDIF
NFISSI=NFISSI+1
IF(NFISSI.GT.MAXNFI) CALL XABORT('LIBNFI: INDFIS OVERFL'
1 //'OW.')
KFIS=NFISSI
DO 80 JBM=1,NBMIX
INDFIS(JBM,KFIS)=0
80 CONTINUE
90 INDFIS(IBM,KFIS)=ISOT
ENDIF
ENDIF
ENDIF
100 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(CHI1,INDFIS)
RETURN
END
|
