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
|
!
!-----------------------------------------------------------------------
!
!Purpose:
! Fortran-2003 bindings for the NDAS C API.
!
!Copyright:
! Copyright (C) 2012 Atomic Energy of Canada Limited and Ecole
! Polytechnique de Montreal.
!
!Author(s): A. Hebert
!
!-----------------------------------------------------------------------
!
module FSDF
private
public :: XSDOPN, XSDNAM, XSDBLD, XSDISO, XSDTHE, XSDRES, XSDTAB, XSDCL
interface XSDBLD
module procedure XSDBLD_I1, XSDBLD_R1
end interface
interface XSDISO
module procedure XSDISO_I1, XSDISO_R1
end interface
contains
subroutine XSDOPN(namfil, ierr)
! open the NDAS file
use, intrinsic :: iso_c_binding
use LCMAUX
character(len=*) :: namfil
integer ierr
character(kind=c_char), dimension(73) :: name73
interface
subroutine xsdopn_c(namp, ierr) bind(c)
use, intrinsic :: iso_c_binding
character(kind=c_char), dimension(*) :: namp
integer(c_int) :: ierr
end subroutine xsdopn_c
end interface
call STRCUT(name73, namfil)
call xsdopn_c(name73, ierr)
end subroutine XSDOPN
!
subroutine XSDNAM(iset, numericId, isonam, ierr)
! recover an isotope name from NDAS file
use LCMAUX
use, intrinsic :: iso_c_binding
integer iset,numericId, ierr
character(len=*) :: isonam
character(kind=c_char), dimension(73) :: name73
interface
subroutine xsdnam_c(iset, numericId, namp, ierr) bind(c)
use, intrinsic :: iso_c_binding
character(kind=c_char), dimension(*) :: namp
integer(c_int) :: iset,numericId,ierr
end subroutine xsdnam_c
end interface
call xsdnam_c(iset, numericId, name73, ierr)
call STRFIL(isonam, name73)
end subroutine XSDNAM
!
subroutine XSDBLD_I1(item, where, ierr)
! recover a header or integer record from NDAS file
use, intrinsic :: iso_c_binding
type(c_ptr) :: pt_where
integer item,ierr
integer, target, dimension(*) :: where
integer, pointer :: where_p
interface
subroutine xsdbld_c(item, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) :: item, ierr
type(c_ptr), value :: where
end subroutine xsdbld_c
end interface
where_p => where(1)
pt_where=c_loc(where_p)
call xsdbld_c(item, pt_where, ierr)
end subroutine XSDBLD_I1
!
subroutine XSDBLD_R1(item, where, ierr)
! recover a header or real record from NDAS file
use, intrinsic :: iso_c_binding
type(c_ptr) :: pt_where
integer item,ierr
real, target, dimension(*) :: where
real, pointer :: where_p
interface
subroutine xsdbld_c(item, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) :: item, ierr
type(c_ptr), value :: where
end subroutine xsdbld_c
end interface
where_p => where(1)
pt_where=c_loc(where_p)
call xsdbld_c(item, pt_where, ierr)
end subroutine XSDBLD_R1
!
subroutine XSDISO_I1(groupRange, item, nuclideIndex, where, ierr)
! recover an integer header for an isotope
use, intrinsic :: iso_c_binding
type(c_ptr) :: pt_where
integer groupRange, item, nuclideIndex, ierr
integer, target, dimension(*) :: where
integer, pointer :: where_p
interface
subroutine xsdiso_c(groupRange, item, nuclideIndex, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) groupRange, item, nuclideIndex, ierr
type(c_ptr), value :: where
end subroutine xsdiso_c
end interface
where_p => where(1)
pt_where=c_loc(where_p)
call xsdiso_c(groupRange, item, nuclideIndex, pt_where, ierr)
end subroutine XSDISO_I1
!
subroutine XSDISO_R1(groupRange, item, nuclideIndex, where, ierr)
! recover a real header for an isotope
use, intrinsic :: iso_c_binding
type(c_ptr) :: pt_where
integer groupRange, item, nuclideIndex, ierr
real, target, dimension(*) :: where
real, pointer :: where_p
interface
subroutine xsdiso_c(groupRange, item, nuclideIndex, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) groupRange, item, nuclideIndex, ierr
type(c_ptr), value :: where
end subroutine xsdiso_c
end interface
where_p => where(1)
pt_where=c_loc(where_p)
call xsdiso_c(groupRange, item, nuclideIndex, pt_where, ierr)
end subroutine XSDISO_R1
!
subroutine XSDTHE(groupRange, item, nuclideIndex, index, where, ierr)
! recover a cross-section array
use, intrinsic :: iso_c_binding
integer groupRange, item, nuclideIndex, index, ierr
real, dimension(*) :: where
interface
subroutine xsdthe_c(groupRange, item, nuclideIndex, index, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) groupRange, item, nuclideIndex, index, ierr
real(c_float), dimension(*) :: where
end subroutine xsdthe_c
end interface
call xsdthe_c(groupRange, item, nuclideIndex, index, where, ierr)
end subroutine XSDTHE
!
subroutine XSDRES(nuclideIndex, where, ierr)
! recover a resonance information array
use, intrinsic :: iso_c_binding
integer nuclideIndex, ierr
integer, dimension(*) :: where
interface
subroutine xsdres_c(nuclideIndex, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) nuclideIndex, ierr
integer(c_int), dimension(*) :: where
end subroutine xsdres_c
end interface
call xsdres_c(nuclideIndex, where, ierr)
end subroutine XSDRES
!
subroutine XSDTAB(item, nuclideIndex, resGroup, where, ierr)
! recover a resonance cross-section array
use, intrinsic :: iso_c_binding
integer item, nuclideIndex, resGroup, ierr
real, dimension(*) :: where
interface
subroutine xsdtab_c(item, nuclideIndex, resGroup, where, ierr) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int) item, nuclideIndex, resGroup, ierr
real(c_float), dimension(*) :: where
end subroutine xsdtab_c
end interface
call xsdtab_c(item, nuclideIndex, resGroup, where, ierr)
end subroutine XSDTAB
!
subroutine XSDCL()
! close the NDAS file
interface
subroutine xsdcl_c() bind(c)
end subroutine xsdcl_c
end interface
call xsdcl_c()
end subroutine XSDCL
end module FSDF
|
