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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
*DECK READBH
SUBROUTINE READBH (MAXPTS,IPGEOM,IR,IR2,NREG,NREG2,MAT,VOL,NG,
1 NSMAX,MICRO,NS,IBI,RS,FRACT,VOLK,IMPX,IDIL,MIXGR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover the input data for the double heterogeneity option (Bihet).
*
*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
* MAXPTS allocated storage for arrays of dimension NREG.
* IPGEOM pointer to the geometry LCM object (L_GEOM signature).
* IR2 number of ordinary and composite mixtures (a mixture that
* include a micro structure).
* NREG2 number of volumes in the macro geometry.
* NG number of different kind of micro structures. A kind of
* micro structure is characterized by the radius of its
* tubes or shells. All the micro volumes of the same kind
* should own the same nuclear properties in a given volume
* of the macro geometry.
* NSMAX maximum number of volumes (tubes or shells) in each kind
* of micro structure).
* IBI type of composite mixture in each volume of the macro
* geometry. If IBI(IKK) is greater than IR, the volume IKK
* contains a micro structure.
* IMPX print flag (equal to zero for no print).
*
*Parameters: input/output
* VOL volumes of the macro geometry on input and
* volumes of the composite geometry at output.
*
*Parameters: output
* IR number of ordinary mixtures.
* NREG number of volumes in the composite geometry.
* MAT index-number of the mixture type assigned to each volume
* of the composite geometry.
* MICRO type of micro volumes: =3 cylinder; =4 sphere.
* NS number of tubes or shells in each kind of micro structure.
* RS radius of the micro volumes.
* FRACT volumic fractions of each type of micro volumes in each
* ordinary or composite mixture.
* VOLK volumic fractions of the tubes or shells in the micro volumes.
* IDIL elementary mixture indices in the diluent of the composite
* mixtures.
* MIXGR elementary mixture indices in the micro structures.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPGEOM
INTEGER MAXPTS,IR,IR2,NREG,NREG2,MAT(MAXPTS),NG,NSMAX,MICRO,
1 NS(NG),IBI(NREG2),IMPX,IDIL(IR2),MIXGR(NSMAX,NG,IR2)
REAL VOL(MAXPTS),RS(NSMAX+1,NG),FRACT(NG,IR2),VOLK(NG,NSMAX)
*----
* LOCAL VARIABLES
*----
PARAMETER(NSTATE=40)
CHARACTER GEONAM*12,HSMG*131,TEXT12*12
LOGICAL EMPTY,LCM
INTEGER ISTATE(NSTATE)
INTEGER, ALLOCATABLE, DIMENSION(:) :: MILIEU
REAL, ALLOCATABLE, DIMENSION(:) :: FTEMP
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(MILIEU(IR2))
ALLOCATE(FTEMP(IR2))
*
IDIL(:IR2)=0
MIXGR(:NSMAX,:NG,:IR2)=0
CALL LCMINF(IPGEOM,GEONAM,TEXT12,EMPTY,ILONG,LCM)
CALL LCMGET(IPGEOM,'STATE-VECTOR',ISTATE)
NMILG=ISTATE(3)
MICRO=ISTATE(5)
IF(NMILG.GT.IR2) CALL XABORT('READBH: INVALID VALUE FOR IR2.')
CALL LCMGET(IPGEOM,'NS',NS)
CALL LCMGET(IPGEOM,'RS',RS)
CALL LCMGET(IPGEOM,'FRACT',FRACT)
CALL LCMGET(IPGEOM,'MILIE',MILIEU)
CALL LCMGET(IPGEOM,'MIXDIL',IDIL)
CALL LCMGET(IPGEOM,'MIXGR',MIXGR)
*
DO 30 J=1,NG
FACT=RS(NS(J)+1,J)**(MICRO-1)
W=0.0
DO 20 K=1,NS(J)
ZZZ=RS(K+1,J)**(MICRO-1)/FACT
VOLK(J,K)=ZZZ-W
W=ZZZ
20 CONTINUE
30 CONTINUE
*
IND1=IR2
DO 40 I=1,NMILG
IF(MILIEU(I).GT.IR2) THEN
WRITE (HSMG,390) MILIEU(I),IR2
CALL XABORT(HSMG)
ENDIF
IND1=MIN(IND1,MILIEU(I))
40 CONTINUE
*----
* SET-UP THE NEW VOLUMES
*----
NREG=NREG2
DO 90 IKK=1,NREG2
MAT(IKK)=IBI(IKK)
IF(IBI(IKK).GE.IND1) THEN
IND=0
DO 50 I=1,NMILG
IF(MILIEU(I).EQ.IBI(IKK)) IND=I
50 CONTINUE
IF(IND.EQ.0) THEN
WRITE(HSMG,'(29HREADBH: A COMPOSITE MIXTURE (,I5,7H) IS NO,
1 10HT DEFINED.)') IBI(IKK)
CALL XABORT(HSMG)
ENDIF
DILF=1.0
DO 60 J=1,NG
DILF=DILF-FRACT(J,IND)
60 CONTINUE
VHET=VOL(IKK)
MAT(IKK)=IDIL(IND)
VOL(IKK)=VHET*DILF
DO 80 J=1,NG
FRT=FRACT(J,IND)
IF(FRT.GT.0.00001) THEN
FACT=RS(NS(J)+1,J)**(MICRO-1)
W=0.0
DO 70 K=1,NS(J)
ZZZ=RS(K+1,J)**(MICRO-1)/FACT
NREG=NREG+1
MAT(NREG)=MIXGR(K,J,IND)
VOL(NREG)=VHET*FRT*(ZZZ-W)
W=ZZZ
70 CONTINUE
ENDIF
80 CONTINUE
ENDIF
90 CONTINUE
IF(NREG.GT.MAXPTS) CALL XABORT('READBH: MAXPTS IS TOO SMALL.')
IR=0
DO 100 I=1,NREG
IR=MAX(IR,MAT(I))
100 CONTINUE
IF(IR+1.GT.IR2) CALL XABORT('READBH: INVALID MIX NUMBERS.')
DO IND=1,IR2-IR
IF(IDIL(IND).EQ.0) THEN
WRITE(HSMG,'(15HREADBH: MIXTURE,I5,22H IS NOT USED IN THE GE,
1 7HOMETRY.)') IR+IND-1
CALL XABORT(HSMG)
ENDIF
ENDDO
DO 135 J=1,NG
DO 110 IND=1,NMILG
FTEMP(IND)=FRACT(J,IND)
110 CONTINUE
DO 120 IND=1,IR2
FRACT(J,IND)=0.0
120 CONTINUE
DO 130 IND=1,NMILG
FRACT(J,MILIEU(IND))=FTEMP(IND)
130 CONTINUE
135 CONTINUE
*
IF(IMPX.GE.1) THEN
WRITE (6,300) GEONAM
IF(MICRO.EQ.3) THEN
WRITE (6,'(44H THE MICRO STRUCTURE IS MADE OF TUBES OR CYL,
1 7HINDERS./)')
ELSE IF(MICRO.EQ.4) THEN
WRITE (6,'(44H THE MICRO STRUCTURE IS MADE OF SPHERES OR S,
1 16HPHERICAL SHELLS./)')
ENDIF
WRITE (6,360) NREG2,NG,NSMAX
WRITE (6,370) IR+1,IR2
DO 140 J=1,NG
WRITE (6,310) J
WRITE (6,320) (RS(K,J),K=1,NS(J)+1)
WRITE (6,330)
WRITE (6,320) (FRACT(J,IBI(IKK)),IKK=1,NREG2)
140 CONTINUE
WRITE (6,'(///)')
WRITE (6,400) NREG,MAXPTS,IR
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(FTEMP)
DEALLOCATE(MILIEU)
RETURN
*
300 FORMAT (///50H BIHET: INTRODUCTION OF A MICRO STRUCTURE IN THE M,
1 26HACRO GEOMETRY LOCATED IN ',A12,2H'./)
310 FORMAT (//23H MICRO STRUCTURE NUMBER,I4//20H RADIUS OF THE MICRO,
1 17H TUBES OR SHELLS:)
320 FORMAT (1X,1P,10E12.5)
330 FORMAT (/53H VOLUMIC CONCENTRATIONS OF THE MICRO STRUCTURE IN EAC,
1 31HH VOLUME OF THE MACRO GEOMETRY:)
360 FORMAT (/42H NUMBER OF VOLUMES IN THE MACRO GEOMETRY =,I6/
1 38H NUMBER OF KINDS OF MICRO STRUCTURES =,I6/
2 49H MAXIMUM NUMBER OF VOLUMES IN A MICRO STRUCTURE =,I6/)
370 FORMAT (/51H THE INDEX-NUMBERS OF THE MIXTURES WITH A MICRO STR,
1 21HUCTURE VARIES BETWEEN,I6,4H AND,I6,1H.)
390 FORMAT (34HREADBH: THE INPUT MIXTURE NUMBER (,I6,12H) IS GREATER,
1 10H THAN IR (,I6,2H ))
400 FORMAT (/20H NUMBER OF VOLUMES =,I6,5X,22HAVAILABLE STORAGE: MAX,
1 5HPTS =,I6/21H NUMBER OF MIXTURES =,I6/)
END
|
