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
|
*DECK INFDRA
SUBROUTINE INFDRA(CFILNA,IPRINT,NBISO,HNAMIS,AWRISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To recover mass for isotopes of DRAGON libraries.
*
*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
* CFILNA DRAGLIB file name.
* IPRINT print flag.
* NBISO number of isotopes.
* HNAMIS isotope names.
*
*Parameters: output
* AWRISO isotope weights.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
INTEGER IPRINT,NBISO
CHARACTER CFILNA*64,HNAMIS(NBISO)*8
REAL AWRISO(NBISO)
C----
C FUNCTIONS
C----
DOUBLE PRECISION XDRCST
C----
C DRAGON LIBRARY PARAMETERS
C----
TYPE(C_PTR) IPDRL
INTEGER IOUT,ISO,LENGT,ITYLCM
PARAMETER (IOUT=6)
CHARACTER NAMLOC*12,HSMG*131
REAL CONVM
*----
* For INFDRA, file name is limited to 12 characters
* because of the requirements for compatibility with
* LINKED_LIST
*----
NAMLOC=CFILNA(1:12)
C----
C TEST IF FILE NAME EXISTS
C----
CONVM=REAL(XDRCST('Neutron mass','amu'))
IF(NAMLOC.EQ.' ' )THEN
CALL XABORT('INFDRA: DRAGON LIBRARY HAS NOT BEEN SET')
ENDIF
C----
C OPEN FILE AND READ INFORMATION DATA RECORDS
C----
CALL LCMOP(IPDRL,NAMLOC,2,2,0)
DO 100 ISO=1,NBISO
CALL LCMLEN(IPDRL,HNAMIS(ISO),LENGT,ITYLCM)
IF(LENGT.EQ.0) THEN
CALL LCMLIB(IPDRL)
WRITE(HSMG,9000) HNAMIS(ISO),CFILNA
CALL XABORT(HSMG)
ENDIF
CALL LCMSIX(IPDRL,HNAMIS(ISO),1)
CALL LCMGET(IPDRL,'AWR',AWRISO(ISO))
AWRISO(ISO)=AWRISO(ISO)*CONVM
IF(IPRINT.GE.100) THEN
WRITE(IOUT,6000) HNAMIS(ISO),AWRISO(ISO)
ENDIF
CALL LCMSIX(IPDRL,' ',2)
100 CONTINUE
C----
C CLOSE FILE
C----
CALL LCMCL(IPDRL,1)
C----
C RETURN
C----
RETURN
C----
C PRINT FORMAT
C----
6000 FORMAT(' DRAGON ISOTOPE =',A8,
> ' HAS ATOMIC WEIGHT RATIO = ',F12.5)
C----
C ABORT FORMAT
C----
9000 FORMAT('INFDRA: MATERIAL/ISOTOPE ',A8,
> ' IS MISING ON DRAGON LIBRARY FILE ',A64)
END
|
