ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
source_combiner.f90
Go to the documentation of this file.
1 MODULE source_combiner
2 
3 
4 CONTAINS
5 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
6 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
7 
8  !-------------------------------------------------------!
9  ! This routine combines sources !
10  ! from dufferent modules and interpolates them !
11  ! on the COREPROF grid !
12  !-------------------------------------------------------!
13  ! Source: --- !
14  ! Developers: D.Kalupin !
15  ! Kontacts: Denis.Kalupin@efda.org !
16  ! !
17  ! Comments: created for V&V between ETS and !
18  ! ASTRA !
19  ! !
20  !-------------------------------------------------------!
21 
22  SUBROUTINE combine_sources &
23  (coreprof, coresource, &
24  coresource1, coresource2, coresource3, &
25  coresource4, coresource5, coresource6, &
26  coresource7, &
27  coresource_out, amix_src, code_parameters)
28 
29  USE allocate_deallocate
30 
31  USE itm_constants
32  USE euitm_routines
33  USE euitm_schemas
34  USE euitm_xml_parser
35  USE deallocate_structures
36  USE interpolate_cpo
37  USE copy_structures
38 
39  IMPLICIT NONE
40 
41 
42  INTEGER, PARAMETER :: num_source=7
43 
44 
45 ! +++ CPOs
46  TYPE (type_coreprof), POINTER :: coreprof(:)
47  TYPE (type_coresource), POINTER :: coresource(:)
48 
49  TYPE (type_coresource), POINTER :: coresource1(:)
50  TYPE (type_coresource), POINTER :: coresource2(:)
51  TYPE (type_coresource), POINTER :: coresource3(:)
52  TYPE (type_coresource), POINTER :: coresource4(:)
53  TYPE (type_coresource), POINTER :: coresource5(:)
54  TYPE (type_coresource), POINTER :: coresource6(:)
55  TYPE (type_coresource), POINTER :: coresource7(:)
56  TYPE (type_coresource), POINTER :: coresource_out(:)
57  TYPE (type_coresource), POINTER :: coresource_arr(:)
58  TYPE (type_coresource), POINTER :: coresource_mix(:)
59 
60  TYPE (type_param) :: code_parameters
61 
62 
63 
64 ! +++ Control parameters:
65  REAL (R8) :: amix_src
66 
67  REAL (R8), SAVE :: c_j_exp(num_source) = 0.0_r8
68  REAL (R8), SAVE :: c_sigma(num_source) = 0.0_r8
69  REAL (R8), SAVE :: c_se_exp(num_source) = 0.0_r8
70  REAL (R8), SAVE :: c_se_imp(num_source) = 0.0_r8
71  REAL (R8), SAVE :: c_si_exp(num_source) = 0.0_r8
72  REAL (R8), SAVE :: c_si_imp(num_source) = 0.0_r8
73  REAL (R8), SAVE :: c_sz_exp(num_source) = 0.0_r8
74  REAL (R8), SAVE :: c_sz_imp(num_source) = 0.0_r8
75  REAL (R8), SAVE :: c_qe_exp(num_source) = 0.0_r8
76  REAL (R8), SAVE :: c_qe_imp(num_source) = 0.0_r8
77  REAL (R8), SAVE :: c_qi_exp(num_source) = 0.0_r8
78  REAL (R8), SAVE :: c_qi_imp(num_source) = 0.0_r8
79  REAL (R8), SAVE :: c_qz_exp(num_source) = 0.0_r8
80  REAL (R8), SAVE :: c_qz_imp(num_source) = 0.0_r8
81  REAL (R8), SAVE :: c_ui_exp(num_source) = 0.0_r8
82  REAL (R8), SAVE :: c_ui_imp(num_source) = 0.0_r8
83 
84  REAL (R8), ALLOCATABLE :: rho_tor(:)
85 
86 
87 
88  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
89  INTEGER :: nrho, irho !number of radial points (input, determined from COREPROF CPO)
90  INTEGER :: nnucl !number of nuclei species
91  INTEGER :: nion, iion !number of ion species
92  INTEGER :: nimp, iimp !number of impurity species
93  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
94  INTEGER :: nneut, ineut !number of neutrals species
95  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
96  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
97 
98 
99  INTEGER :: inum, ival, iarr
100  INTEGER :: return_status
101 
102 
103 
104 
105 
106  CALL assign_combiner_parameters(code_parameters, return_status)
107 
108 
109  IF (return_status /= 0) THEN
110  WRITE(*,*) 'ERROR: Could not assign source multipliers.'
111  END IF
112 
113 
114 
115 
116 ! +++ OUTPUT SOURCE CPO:
117  nrho = SIZE(coreprof(1)%rho_tor)
118  ALLOCATE (rho_tor(nrho))
119 
120  CALL get_comp_dimensions(coreprof(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
121 
122  CALL allocate_coresource_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource_out)
123  CALL allocate_coresource_cpo(num_source, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource_arr)
124 
125  CALL deallocate_cpo(coresource_out(1)%compositions)
126  CALL copy_cpo(coreprof(1)%compositions, coresource_out(1)%compositions)
127 
128 
129  rho_tor = coreprof(1)%rho_tor
130  coresource_out(1)%VALUES(1)%rho_tor = rho_tor
131 
132  DO inum=1,num_source
133  coresource_arr(inum)%VALUES(1)%rho_tor = coresource_out(1)%VALUES(1)%rho_tor
134  CALL deallocate_cpo(coresource_arr(inum)%compositions)
135  CALL copy_cpo(coresource_out(1)%compositions, coresource_arr(inum)%compositions)
136  END DO
137 
138 
139 ! +++ Interpolate source profiles on the output grid:
140  CALL interpolate_source(coresource1(1), coresource_arr(1))
141  CALL interpolate_source(coresource2(1), coresource_arr(2))
142  CALL interpolate_source(coresource3(1), coresource_arr(3))
143  CALL interpolate_source(coresource4(1), coresource_arr(4))
144  CALL interpolate_source(coresource5(1), coresource_arr(5))
145  CALL interpolate_source(coresource6(1), coresource_arr(6))
146  CALL interpolate_source(coresource7(1), coresource_arr(7))
147 
148 
149 
150 ! +++ Combines sources:
151  DO inum=1, num_source
152 ! j
153  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%j) .AND. c_j_exp(inum).NE.0.0_r8) &
154  coresource_out(1)%VALUES(1)%j = coresource_out(1)%VALUES(1)%j + &
155  coresource_arr(inum)%VALUES(1)%j * c_j_exp(inum)
156 
157 ! sigma
158  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%sigma) .AND. c_sigma(inum).NE.0.0_r8) &
159  coresource_out(1)%VALUES(1)%sigma = coresource_out(1)%VALUES(1)%sigma + &
160  c_sigma(inum) * coresource_arr(inum)%VALUES(1)%sigma
161 
162 ! Se
163  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Se%exp) .AND. c_se_exp(inum).NE.0.0_r8) &
164  coresource_out(1)%VALUES(1)%Se%exp = coresource_out(1)%VALUES(1)%Se%exp + &
165  c_se_exp(inum) * coresource_arr(inum)%VALUES(1)%Se%exp
166  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Se%imp) .AND. c_se_imp(inum).NE.0.0_r8) &
167  coresource_out(1)%VALUES(1)%Se%imp = coresource_out(1)%VALUES(1)%Se%imp + &
168  c_se_imp(inum) * coresource_arr(inum)%VALUES(1)%Se%imp
169 ! Qe
170  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qe%exp) .AND. c_qe_exp(inum).NE.0.0_r8) &
171  coresource_out(1)%VALUES(1)%Qe%exp = coresource_out(1)%VALUES(1)%Qe%exp + &
172  c_qe_exp(inum) * coresource_arr(inum)%VALUES(1)%Qe%exp
173  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qe%imp) .AND. c_qe_imp(inum).NE.0.0_r8) &
174  coresource_out(1)%VALUES(1)%Qe%imp = coresource_out(1)%VALUES(1)%Qe%imp + &
175  c_qe_imp(inum) * coresource_arr(inum)%VALUES(1)%Qe%imp
176 
177 
178 ! Si
179  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Si%exp) .AND. c_si_exp(inum).NE.0.0_r8) &
180  coresource_out(1)%VALUES(1)%Si%exp = coresource_out(1)%VALUES(1)%Si%exp + &
181  c_si_exp(inum) * coresource_arr(inum)%VALUES(1)%Si%exp
182  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Si%imp) .AND. c_si_imp(inum).NE.0.0_r8) &
183  coresource_out(1)%VALUES(1)%Si%imp = coresource_out(1)%VALUES(1)%Si%imp + &
184  c_si_imp(inum) * coresource_arr(inum)%VALUES(1)%Si%imp
185 
186 ! Qi
187  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qi%exp) .AND. c_qi_exp(inum).NE.0.0_r8) &
188  coresource_out(1)%VALUES(1)%Qi%exp = coresource_out(1)%VALUES(1)%Qi%exp + &
189  c_qi_exp(inum) * coresource_arr(inum)%VALUES(1)%Qi%exp
190  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qi%imp) .AND. c_qi_imp(inum).NE.0.0_r8) &
191  coresource_out(1)%VALUES(1)%Qi%imp = coresource_out(1)%VALUES(1)%Qi%imp + &
192  c_qi_imp(inum) * coresource_arr(inum)%VALUES(1)%Qi%imp
193 
194 ! Ui
195  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Ui%exp) .AND. c_ui_exp(inum).NE.0.0_r8) &
196  coresource_out(1)%VALUES(1)%Ui%exp = coresource_out(1)%VALUES(1)%Ui%exp + &
197  c_ui_exp(inum) * coresource_arr(inum)%VALUES(1)%Ui%exp
198  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Ui%imp) .AND. c_ui_imp(inum).NE.0.0_r8) &
199  coresource_out(1)%VALUES(1)%Ui%imp = coresource_out(1)%VALUES(1)%Ui%imp + &
200  c_ui_imp(inum) * coresource_arr(inum)%VALUES(1)%Ui%imp
201 
202 
203 ! Sz
204  DO iimp = 1, nimp
205  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Sz(iimp)%exp) .AND. c_sz_exp(inum).NE.0.0_r8) &
206  coresource_out(1)%VALUES(1)%Sz(iimp)%exp = coresource_out(1)%VALUES(1)%Sz(iimp)%exp + &
207  c_sz_exp(inum) * coresource_arr(inum)%VALUES(1)%Sz(iimp)%exp
208  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Sz(iimp)%imp) .AND. c_sz_imp(inum).NE.0.0_r8) &
209  coresource_out(1)%VALUES(1)%Sz(iimp)%imp = coresource_out(1)%VALUES(1)%Sz(iimp)%imp + &
210  c_sz_imp(inum) * coresource_arr(inum)%VALUES(1)%Sz(iimp)%imp
211 ! Qz
212  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qz(iimp)%exp) .AND. c_qz_exp(inum).NE.0.0_r8) &
213  coresource_out(1)%VALUES(1)%Qz(iimp)%exp = coresource_out(1)%VALUES(1)%Qz(iimp)%exp + &
214  c_qz_exp(inum) * coresource_arr(inum)%VALUES(1)%Qz(iimp)%exp
215  IF (ASSOCIATED(coresource_arr(inum)%VALUES(1)%Qz(iimp)%imp) .AND. c_qz_imp(inum).NE.0.0_r8) &
216  coresource_out(1)%VALUES(1)%Qz(iimp)%imp = coresource_out(1)%VALUES(1)%Qz(iimp)%imp + &
217  c_qz_imp(inum) * coresource_arr(inum)%VALUES(1)%Qz(iimp)%imp
218  END DO
219 
220  END DO
221 
222 
223 
224 ! +++ MIXING OF SOURCE PROFILES:
225  CALL allocate_coresource_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource_mix)
226  CALL deallocate_cpo(coresource_mix(1)%VALUES(1)%rho_tor)
227  CALL copy_cpo(coresource_out(1)%VALUES(1)%rho_tor, coresource_mix(1)%VALUES(1)%rho_tor)
228  CALL deallocate_cpo(coresource_mix(1)%compositions)
229  CALL copy_cpo(coresource_out(1)%compositions, coresource_mix(1)%compositions)
230  CALL interpolate_source(coresource(1), coresource_mix(1))
231 
232 ! J
233  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%j)) &
234  coresource_out(1)%VALUES(1)%j = coresource_out(1)%VALUES(1)%j * amix_src + &
235  coresource_mix(1)%VALUES(1)%J * (1.0_r8 - amix_src)
236 
237 ! sigma
238  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%sigma)) &
239  coresource_out(1)%VALUES(1)%sigma = coresource_out(1)%VALUES(1)%sigma * amix_src + &
240  coresource_mix(1)%VALUES(1)%sigma * (1.0_r8 - amix_src)
241 
242 ! Si
243  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Si%exp)) &
244  coresource_out(1)%VALUES(1)%Si%exp = coresource_out(1)%VALUES(1)%Si%exp * amix_src + &
245  coresource_mix(1)%VALUES(1)%Si%exp * (1.0_r8 - amix_src)
246  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Si%imp)) &
247  coresource_out(1)%VALUES(1)%Si%imp = coresource_out(1)%VALUES(1)%Si%imp * amix_src + &
248  coresource_mix(1)%VALUES(1)%Si%imp * (1.0_r8 - amix_src)
249 ! Se
250  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Se%exp)) &
251  coresource_out(1)%VALUES(1)%Se%exp = coresource_out(1)%VALUES(1)%Se%exp * amix_src + &
252  coresource_mix(1)%VALUES(1)%Se%exp * (1.0_r8 - amix_src)
253  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Se%imp)) &
254  coresource_out(1)%VALUES(1)%Se%imp = coresource_out(1)%VALUES(1)%Se%imp * amix_src + &
255  coresource_mix(1)%VALUES(1)%Se%imp * (1.0_r8 - amix_src)
256 ! Qi
257  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qi%exp)) &
258  coresource_out(1)%VALUES(1)%Qi%exp = coresource_out(1)%VALUES(1)%Qi%exp * amix_src + &
259  coresource_mix(1)%VALUES(1)%Qi%exp * (1.0_r8 - amix_src)
260  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qi%imp)) &
261  coresource_out(1)%VALUES(1)%Qi%imp = coresource_out(1)%VALUES(1)%Qi%imp * amix_src + &
262  coresource_mix(1)%VALUES(1)%Qi%imp * (1.0_r8 - amix_src)
263 ! Qe
264  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qe%exp)) &
265  coresource_out(1)%VALUES(1)%Qe%exp = coresource_out(1)%VALUES(1)%Qe%exp * amix_src + &
266  coresource_mix(1)%VALUES(1)%Qe%exp * (1.0_r8 - amix_src)
267  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qe%imp)) &
268  coresource_out(1)%VALUES(1)%Qe%imp = coresource_out(1)%VALUES(1)%Qe%imp * amix_src + &
269  coresource_mix(1)%VALUES(1)%Qe%imp * (1.0_r8 - amix_src)
270 ! Ui
271  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Ui%exp)) &
272  coresource_out(1)%VALUES(1)%Ui%exp = coresource_out(1)%VALUES(1)%Ui%exp * amix_src + &
273  coresource_mix(1)%VALUES(1)%Ui%exp * (1.0_r8 - amix_src)
274  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Ui%imp)) &
275  coresource_out(1)%VALUES(1)%Ui%imp = coresource_out(1)%VALUES(1)%Ui%imp * amix_src + &
276  coresource_mix(1)%VALUES(1)%Ui%imp * (1.0_r8 - amix_src)
277 
278 ! Sz
279  DO iimp = 1, nimp
280  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Sz(iimp)%exp)) &
281  coresource_out(1)%VALUES(1)%Sz(iimp)%exp = coresource_out(1)%VALUES(1)%Sz(iimp)%exp * amix_src + &
282  coresource_mix(1)%VALUES(1)%Sz(iimp)%exp * (1.0_r8 - amix_src)
283  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Sz(iimp)%imp)) &
284  coresource_out(1)%VALUES(1)%Sz(iimp)%imp = coresource_out(1)%VALUES(1)%Sz(iimp)%imp * amix_src + &
285  coresource_mix(1)%VALUES(1)%Sz(iimp)%imp * (1.0_r8 - amix_src)
286 
287 ! Qz
288  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qz(iimp)%exp)) &
289  coresource_out(1)%VALUES(1)%Qz(iimp)%exp = coresource_out(1)%VALUES(1)%Qz(iimp)%exp * amix_src + &
290  coresource_mix(1)%VALUES(1)%Qz(iimp)%exp * (1.0_r8 - amix_src)
291  IF (ASSOCIATED(coresource_mix(1)%VALUES(1)%Qz(iimp)%imp)) &
292  coresource_out(1)%VALUES(1)%Qz(iimp)%imp = coresource_out(1)%VALUES(1)%Qz(iimp)%imp * amix_src + &
293  coresource_mix(1)%VALUES(1)%Qz(iimp)%imp * (1.0_r8 - amix_src)
294  END DO
295 
296 
297 
298 ! +++ Deallocation of internal variables:
299  IF(ALLOCATED(rho_tor)) DEALLOCATE ( rho_tor )
300  IF(ALLOCATED(nzimp)) DEALLOCATE ( nzimp )
301  IF(ALLOCATED(ncomp)) DEALLOCATE ( ncomp )
302  IF(ALLOCATED(ntype)) DEALLOCATE ( ntype )
303  CALL deallocate_cpo(coresource_arr)
304  CALL deallocate_cpo(coresource_mix)
305 
306 
307 
308 ! +++ ADD IDENTIFIER TO OUTPUT CPO VALUES(1):
309  ALLOCATE (coresource_out(1)%VALUES(1)%sourceid%id(1))
310  ALLOCATE (coresource_out(1)%VALUES(1)%sourceid%description(1))
311  coresource_out(1)%VALUES(1)%sourceid%id = 'combined'
312  coresource_out(1)%VALUES(1)%sourceid%flag = 30
313  coresource_out(1)%VALUES(1)%sourceid%description = 'Combined source'
314 
315 
316 
317 
318 ! +++ COPY INDIVIDUAL INPUT SOURCES TO OUTPUT CPO:
319  ALLOCATE (coresource_arr(num_source))
320  CALL copy_cpo(coresource1(1), coresource_arr(1))
321  CALL copy_cpo(coresource2(1), coresource_arr(2))
322  CALL copy_cpo(coresource3(1), coresource_arr(3))
323  CALL copy_cpo(coresource4(1), coresource_arr(4))
324  CALL copy_cpo(coresource5(1), coresource_arr(5))
325  CALL copy_cpo(coresource6(1), coresource_arr(6))
326  CALL copy_cpo(coresource7(1), coresource_arr(7))
327 
328  iarr = 1
329  DO inum = 1, num_source
330  iarr = iarr + SIZE(coresource_arr(inum)%VALUES)
331  END DO
332  ALLOCATE (coresource_mix(1))
333  ALLOCATE (coresource_mix(1)%VALUES(iarr))
334 
335  CALL copy_cpo(coresource_out(1)%VALUES(1), coresource_mix(1)%VALUES(1))
336  CALL deallocate_cpo(coresource_out(1)%VALUES)
337  ALLOCATE (coresource_out(1)%VALUES(iarr))
338  CALL copy_cpo(coresource_mix(1)%VALUES(1), coresource_out(1)%VALUES(1))
339 
340 
341  ival = 2
342  DO inum = 1, num_source
343  DO iarr = 1, SIZE(coresource_arr(inum)%VALUES)
344  CALL copy_cpo(coresource_arr(inum)%VALUES(iarr), coresource_out(1)%VALUES(ival))
345  IF (.NOT.ASSOCIATED(coresource_out(1)%VALUES(ival)%sourceid%id)) THEN
346  ALLOCATE (coresource_out(1)%VALUES(ival)%sourceid%id(1))
347  coresource_out(1)%VALUES(ival)%sourceid%id = 'unspecified'
348  coresource_out(1)%VALUES(ival)%sourceid%flag = 0
349  IF (.NOT.ASSOCIATED(coresource_out(1)%VALUES(ival)%sourceid%description)) THEN
350  ALLOCATE(coresource_out(1)%VALUES(ival)%sourceid%description(1))
351  coresource_out(1)%VALUES(ival)%sourceid%description = 'Unspecified source type'
352  END IF
353  END IF
354  ival = ival + 1
355  END DO
356  END DO
357 
358  CALL deallocate_cpo(coresource_arr)
359  CALL deallocate_cpo(coresource_mix)
360 
361  RETURN
362 
363 
364  CONTAINS
365 
366 
367 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
368 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
369  SUBROUTINE assign_combiner_parameters(codeparameters, return_status)
370 
371  !-------------------------------------------------------!
372  ! This subroutine calls the XML parser for !
373  ! the combiner parameters and assign the !
374  ! resulting values to the corresponding variables !
375  !-------------------------------------------------------!
376  ! Source: --- !
377  ! Developers: D.Kalupin !
378  ! Kontacts: Denis.Kalupin@efda.org !
379  ! !
380  ! Comments: created for V&V between ETS and !
381  ! ASTRA !
382  ! !
383  !-------------------------------------------------------!
384 
385  USE itm_types
386  USE euitm_schemas
387  USE euitm_xml_parser
388 
389  IMPLICIT NONE
390 
391 
392  TYPE(type_param) :: codeparameters
393  INTEGER(ITM_I4) :: return_status
394 
395  CHARACTER(len = 132) :: prefix
396 
397 
398  return_status = 0
399 
400  c_j_exp = 0.0_r8
401  c_sigma = 0.0_r8
402  c_se_exp = 0.0_r8
403  c_se_imp = 0.0_r8
404  c_si_exp = 0.0_r8
405  c_si_imp = 0.0_r8
406  c_sz_exp = 0.0_r8
407  c_sz_imp = 0.0_r8
408  c_qe_exp = 0.0_r8
409  c_qe_imp = 0.0_r8
410  c_qi_exp = 0.0_r8
411  c_qi_imp = 0.0_r8
412  c_qz_exp = 0.0_r8
413  c_qz_imp = 0.0_r8
414  c_ui_exp = 0.0_r8
415  c_ui_imp = 0.0_r8
416 
417 
418  prefix = 'parameters/CURRENT/jni'
419  CALL assign_multipliers(prefix,codeparameters,return_status, c_j_exp)
420  prefix = 'parameters/CURRENT/conductivity'
421  CALL assign_multipliers(prefix,codeparameters,return_status, c_sigma)
422  prefix = 'parameters/NE/explicit_source'
423  CALL assign_multipliers(prefix,codeparameters,return_status, c_se_exp)
424  prefix = 'parameters/NE/implicit_source'
425  CALL assign_multipliers(prefix,codeparameters,return_status, c_se_imp)
426  prefix = 'parameters/NI/explicit_source'
427  CALL assign_multipliers(prefix,codeparameters,return_status, c_si_exp)
428  prefix = 'parameters/NI/implicit_source'
429  CALL assign_multipliers(prefix,codeparameters,return_status, c_si_imp)
430  prefix = 'parameters/NZ/explicit_source'
431  CALL assign_multipliers(prefix,codeparameters,return_status, c_sz_exp)
432  prefix = 'parameters/NZ/implicit_source'
433  CALL assign_multipliers(prefix,codeparameters,return_status, c_sz_imp)
434  prefix = 'parameters/TE/explicit_source'
435  CALL assign_multipliers(prefix,codeparameters,return_status, c_qe_exp)
436  prefix = 'parameters/TE/implicit_source'
437  CALL assign_multipliers(prefix,codeparameters,return_status, c_qe_imp)
438  prefix = 'parameters/TI/explicit_source'
439  CALL assign_multipliers(prefix,codeparameters,return_status, c_qi_exp)
440  prefix = 'parameters/TI/implicit_source'
441  CALL assign_multipliers(prefix,codeparameters,return_status, c_qi_imp)
442  prefix = 'parameters/TZ/explicit_source'
443  CALL assign_multipliers(prefix,codeparameters,return_status, c_qz_exp)
444  prefix = 'parameters/TZ/implicit_source'
445  CALL assign_multipliers(prefix,codeparameters,return_status, c_qz_imp)
446  prefix = 'parameters/VTOR/explicit_source'
447  CALL assign_multipliers(prefix,codeparameters,return_status, c_ui_exp)
448  prefix = 'parameters/VTOR/implicit_source'
449  CALL assign_multipliers(prefix,codeparameters,return_status, c_ui_imp)
450 
451 
452  RETURN
453 
454  END SUBROUTINE assign_combiner_parameters
455 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
456 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
457 
458 
459 
460 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
461 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
462  SUBROUTINE assign_multipliers(prefix,codeparameters, return_status, multipliers)
463 
464  USE itm_types
465  USE euitm_xml_parser
466 
467  IMPLICIT NONE
468 
469  TYPE(type_param) :: codeparameters
470  INTEGER(ITM_I4) :: return_status
471 
472  CHARACTER(len = 132) :: prefix
473  CHARACTER(len = 132) :: multiplier_path(num_source)
474  CHARACTER(len = 132) :: parameter_value
475  REAL(R8) :: multipliers(num_source)
476  REAL(R8) :: value(1)
477 
478  TYPE(element), POINTER :: temp_pointer
479  TYPE(tree) :: parameter_list
480 
481  INTEGER(ITM_I4) :: i_src, nval
482  INTEGER(ITM_I4) :: nparm
483 
484  multiplier_path(1) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Data_Base"
485  multiplier_path(2) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Gaussian"
486  multiplier_path(3) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Synchrotron"
487  multiplier_path(4) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/HCD"
488  multiplier_path(5) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Neutrals"
489  multiplier_path(6) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Impurity"
490  multiplier_path(7) = trim(adjustl(prefix))//"/from_input_CPOs/Multipliers_for_contributions_from/Neoclassical"
491 
492 !-- parse xml-string codeparameters%parameters
493  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
494 
495  DO i_src = 1, num_source
496  temp_pointer => parameter_list%first
497  CALL find_parameter(multiplier_path(i_src), parameter_value, temp_pointer)
498  IF (len(trim(parameter_value)).GE.1) THEN
499  CALL scan_str2real(parameter_value, value ,nval)
500  multipliers(i_src) = value(1)
501  END IF
502  END DO
503 
504 !-- destroy tree
505  CALL destroy_xml_tree(parameter_list)
506 
507  RETURN
508 
509  END SUBROUTINE assign_multipliers
510 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
511 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
512 
513 
514 
515  END SUBROUTINE combine_sources
516 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
517 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
518 
519 
520 
521 END MODULE source_combiner
interpolate_cpo
Definition: interpolate_cpo.f90:1
allocate_deallocate::get_comp_dimensions
subroutine get_comp_dimensions(COMPOSITIONS, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP)
Definition: allocate_deallocate.f90:1845
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
allocate_deallocate::allocate_coresource_cpo
subroutine allocate_coresource_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORESOURCE)
This routine allocates CORESOURCE CPO.
Definition: allocate_deallocate.f90:460
source_combiner
Definition: source_combiner.f90:1
interpolate_cpo::interpolate_source
subroutine interpolate_source(CORESOURCE_IN, CORESOURCE_OUT)
Definition: interpolate_cpo.f90:25
assign_combiner_parameters
subroutine assign_combiner_parameters(codeparameters, return_status)
Definition: delta3_combiner.f90:219
assign_multipliers
subroutine assign_multipliers(prefix, codeparameters, return_status, multipliers)
Definition: source_combiner.f90:462
source_combiner::combine_sources
subroutine combine_sources(COREPROF, CORESOURCE, CORESOURCE1, CORESOURCE2, CORESOURCE3, CORESOURCE4, CORESOURCE5, CORESOURCE6, CORESOURCE7, CORESOURCE_OUT, AMIX_SRC, code_parameters)
Definition: source_combiner.f90:22