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
|
*DECK LIBCON
SUBROUTINE LIBCON(IPLIB,IMX,NBISO,ISOMIX,DENISO,DENMIX,IN)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Convert weight percent to atomic density.
*
*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): G. Marleau
*
*Parameters: input
* IPLIB pointer to the internal library.
* IMX mixture index to process.
* NBISO number of isotopes present in the calculation domain.
* ISOMIX mix number of each isotope.
* IN type of conversion:
* =1 conversion of wgt% to nb atoms with denmix;
* =2 conversion of nb atoms to wgt% and denmix.
*
*Parameters: input/output
* DENISO number density (if IN=1) or weight percent (if IN=2) for
* isotopes present in mixture IMX on input. On optput,
* number density.
* DENMIX mixture density g*cm**(-3) (if IN=2).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB
INTEGER IMX,NBISO,ISOMIX(NBISO),IN
REAL DENISO(NBISO),DENMIX
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) KPLIB
DOUBLE PRECISION XDRCST,AVCON
TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO
*----
* INTERNAL PARAMETERS
*----
PARAMETER (IOUT=6)
*------
* COMPUTE NUMBER DENSITIES FOR ISOTOPES
*------
AVCON=1.0D-24*XDRCST('Avogadro','N/moles')
> /XDRCST('Neutron mass','amu')
IF(IN.EQ.1) THEN
IF(DENMIX.EQ.-1.0) CALL XABORT('LIBCON: DENMIX NOT DEFINED')
TWPC=0.0
DO 120 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.IMX) TWPC=DENISO(ISO)+TWPC
120 CONTINUE
IF(TWPC.EQ.0.0) THEN
IF(DENMIX.EQ.0.0) THEN
RETURN
ELSE
CALL XABORT('LIBCON: A MIXTURE OF DENSITY > 0.0 '//
> 'HAS ALL ITS ISOTOPIC WEIGHT PERCENT = 0.0')
ENDIF
ENDIF
WMIX=DENMIX*REAL(AVCON)/TWPC
IF(NBISO.GT.0) THEN
ALLOCATE(IPISO(NBISO))
CALL LIBIPS(IPLIB,NBISO,IPISO)
DO 130 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.IMX) THEN
KPLIB=IPISO(ISO) ! set ISO-th isotope
CALL LCMGET(KPLIB,'AWR',AWRISO)
IF(AWRISO.GT.0.0) THEN
DENISO(ISO)=DENISO(ISO)*WMIX/AWRISO
ELSE
DENISO(ISO)=0.0
ENDIF
ENDIF
130 CONTINUE
DEALLOCATE(IPISO)
ENDIF
ELSE IF(IN.EQ.2) THEN
CALL LCMLEN(IPLIB,'ISOTOPESUSED',ILONG,ITYLCM)
*------
* COMPUTE MIXTURE DENSITIES AND ISOTOPIC WEIGHT PERCENTS
* (NORMALIZED TO 100.)
*------
DENMIX=0.0
IF((NBISO.GT.0).AND.(NBISO.LE.ILONG/3)) THEN
ALLOCATE(IPISO(NBISO))
CALL LIBIPS(IPLIB,NBISO,IPISO)
DO 220 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.IMX) THEN
KPLIB=IPISO(ISO) ! set ISO-th isotope
CALL LCMGET(KPLIB,'AWR',AWRISO)
DENISO(ISO)=DENISO(ISO)*AWRISO/REAL(AVCON)
DENMIX=DENMIX+DENISO(ISO)
ENDIF
220 CONTINUE
DEALLOCATE(IPISO)
ENDIF
IF(DENMIX.NE.0.0) THEN
DO 230 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.IMX)
> DENISO(ISO)=100.*DENISO(ISO)/DENMIX
230 CONTINUE
ENDIF
ELSE
CALL XABORT('LIBCON: INVALID *IN* VALUE')
ENDIF
RETURN
END
|
