ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
transport_combiner.f90
Go to the documentation of this file.
1 MODULE transport_combiner
2 
3 
4 CONTAINS
5 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
6 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
7 
8 
9  !-------------------------------------------------------!
10  ! This routine combines transport coeffients !
11  ! from different modules and interpolates them !
12  ! on the COREPROF grid !
13  !-------------------------------------------------------!
14  ! Source: --- !
15  ! Developers: D.Kalupin !
16  ! Kontacts: Denis.Kalupin@efda.org !
17  ! !
18  ! Comments: created for V&V between ETS and !
19  ! ASTRA !
20  ! !
21  ! add save attribute for code !
22  ! parameters (performance optimization!
23  ! !
24  !-------------------------------------------------------!
25 
26  SUBROUTINE combine_transport &
27  (coreprof, coretransp, &
28  coretransp1, coretransp2, coretransp3, &
29  coretransp4, coretransp5, coretransp_out,&
30  amix_tr, code_parameters)
31 
32 
33  USE allocate_deallocate
34 
35  USE itm_types
36  USE itm_constants
37  USE euitm_routines
38  USE euitm_schemas
39  USE euitm_xml_parser
40  USE deallocate_structures
41  USE interpolate_cpo
42  USE copy_structures
43 
44  IMPLICIT NONE
45 
46 
47 
48 
49  INTEGER, PARAMETER :: num_transp=5
50 
51 
52 ! +++ CPOs:
53  TYPE (type_coreprof), POINTER :: coreprof(:)
54 
55  TYPE (type_coretransp), POINTER :: coretransp(:)
56 
57  TYPE (type_coretransp), POINTER :: coretransp1(:)
58  TYPE (type_coretransp), POINTER :: coretransp2(:)
59  TYPE (type_coretransp), POINTER :: coretransp3(:)
60  TYPE (type_coretransp), POINTER :: coretransp4(:)
61  TYPE (type_coretransp), POINTER :: coretransp5(:)
62 
63  TYPE (type_coretransp), POINTER :: coretransp_out(:)
64 
65  TYPE (type_coretransp), POINTER :: coretransp_arr(:)
66  TYPE (type_coretransp), POINTER :: coretransp_mix(:)
67 
68  TYPE (type_param) :: code_parameters
69 
70 
71 
72  REAL (R8) :: amix_tr
73 
74  REAL (R8), SAVE :: c_sigma(num_transp) = 0.0_r8
75  REAL (R8), SAVE :: c_ne_diff(num_transp) = 0.0_r8
76  REAL (R8), SAVE :: c_ne_vconv(num_transp) = 0.0_r8
77  REAL (R8), SAVE :: c_ni_diff(num_transp) = 0.0_r8
78  REAL (R8), SAVE :: c_ni_vconv(num_transp) = 0.0_r8
79  REAL (R8), SAVE :: c_te_diff(num_transp) = 0.0_r8
80  REAL (R8), SAVE :: c_te_vconv(num_transp) = 0.0_r8
81  REAL (R8), SAVE :: c_ti_diff(num_transp) = 0.0_r8
82  REAL (R8), SAVE :: c_ti_vconv(num_transp) = 0.0_r8
83  REAL (R8), SAVE :: c_vtor_diff(num_transp) = 0.0_r8
84  REAL (R8), SAVE :: c_vtor_vconv(num_transp) = 0.0_r8
85  REAL (R8), SAVE :: c_nz_diff(num_transp) = 0.0_r8
86  REAL (R8), SAVE :: c_nz_vconv(num_transp) = 0.0_r8
87  REAL (R8), SAVE :: c_tz_diff(num_transp) = 0.0_r8
88  REAL (R8), SAVE :: c_tz_vconv(num_transp) = 0.0_r8
89 
90  INTEGER :: negative_diff = 0
91  INTEGER :: ne_conv = 0
92  INTEGER :: te_conv = 0
93  INTEGER :: ni_conv = 0
94  INTEGER :: ti_conv = 0
95  INTEGER :: vtor_conv = 0
96  INTEGER :: nz_conv = 0
97  INTEGER :: tz_conv = 0
98 
99  REAL (R8), ALLOCATABLE :: rho_tor(:)
100 
101 
102 
103  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
104  INTEGER :: nrho, irho !number of radial points (input, determined from COREPROF CPO)
105  INTEGER :: nnucl !number of nuclei species
106  INTEGER :: nion, iion !number of ion species
107  INTEGER :: nimp, iimp !number of impurity species
108  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
109  INTEGER :: nneut, ineut !number of neutrals species
110  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
111  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
112 
113 
114  INTEGER :: inum, iarr, ival
115  INTEGER :: return_status
116  logical, save :: firstcall=.true.
117 
118 
119 
120 !dy test performance optimization
121 
122  if (firstcall) then
123  firstcall=.false.
124  write(*,*) 'calling assign_combiner_params'
125  CALL assign_combiner_parameters(code_parameters, return_status)
126 
127  IF (return_status /= 0) THEN
128  WRITE(*,*) 'ERROR: Could not assign transport multipliers.'
129  END IF
130  end if
131 
132 ! write(*,*) 'C_sigma', C_sigma
133  write(*,*) 'C_ne_diff', c_ne_diff
134 ! write(*,*) 'C_ni_diff', C_ni_diff
135 ! write(*,*) 'C_nz_diff', C_nz_diff
136 ! write(*,*) 'C_te_diff', C_te_diff
137 ! write(*,*) 'C_ti_diff', C_ti_diff
138 ! write(*,*) 'C_tz_diff', C_tz_diff
139 ! write(*,*) 'C_ne_vconv',C_ne_vconv
140 ! write(*,*) 'C_ni_vconv',C_ni_vconv
141 ! write(*,*) 'C_nz_vconv',C_nz_vconv
142 ! write(*,*) 'C_te_vconv',C_te_vconv
143 ! write(*,*) 'C_ti_vconv',C_ti_vconv
144 ! write(*,*) 'C_tz_vconv',C_tz_vconv
145 
146 !dy end test region
147 
148  CALL deallocate_cpo(coretransp_out)
149 
150 ! +++ OUTPUT TRANSPORT CPO:
151  nrho = SIZE(coreprof(1)%rho_tor)
152  ALLOCATE (rho_tor(nrho))
153 
154  CALL get_comp_dimensions(coreprof(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
155 
156  CALL allocate_coretransp_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coretransp_out)
157  CALL allocate_coretransp_cpo(num_transp, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coretransp_arr)
158 
159  CALL deallocate_cpo(coretransp_out(1)%compositions)
160  CALL copy_cpo(coreprof(1)%compositions, coretransp_out(1)%compositions)
161 
162 
163  rho_tor = coreprof(1)%rho_tor
164  coretransp_out(1)%VALUES(1)%rho_tor = rho_tor
165 
166  DO inum=1,num_transp
167  coretransp_arr(inum)%VALUES(1)%rho_tor = coretransp_out(1)%VALUES(1)%rho_tor
168  CALL deallocate_cpo(coretransp_arr(inum)%compositions)
169  CALL copy_cpo(coretransp_out(1)%compositions, coretransp_arr(inum)%compositions)
170  END DO
171 
172 
173 
174 ! +++ Interpolate transport profiles on the output grid:
175  CALL interpolate_transp(coretransp1(1), coretransp_arr(1), negative_diff)
176  CALL interpolate_transp(coretransp2(1), coretransp_arr(2), negative_diff)
177  CALL interpolate_transp(coretransp3(1), coretransp_arr(3), negative_diff)
178  CALL interpolate_transp(coretransp4(1), coretransp_arr(4), negative_diff)
179  CALL interpolate_transp(coretransp5(1), coretransp_arr(5), negative_diff)
180 
181 
182 
183 
184 ! +++ Combines transport coefficients:
185 
186  DO inum=1, num_transp
187 ! sigma
188  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%sigma) .AND. c_sigma(inum).NE.0.0_r8) &
189  coretransp_out(1)%VALUES(1)%sigma = coretransp_out(1)%VALUES(1)%sigma &
190  + coretransp_arr(inum)%VALUES(1)%sigma &
191  * c_sigma(inum)
192 ! ne
193  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ne_transp%diff_eff) .AND. c_ne_diff(inum).NE.0.0_r8) &
194  coretransp_out(1)%VALUES(1)%ne_transp%diff_eff = coretransp_out(1)%VALUES(1)%ne_transp%diff_eff &
195  + coretransp_arr(inum)%VALUES(1)%ne_transp%diff_eff &
196  * c_ne_diff(inum)
197  IF(ne_conv.EQ.0) THEN
198  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ne_transp%vconv_eff) .AND. c_ne_vconv(inum).NE.0.0_r8) &
199  coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff &
200  + coretransp_arr(inum)%VALUES(1)%ne_transp%vconv_eff &
201  * c_ne_vconv(inum)
202  ELSE IF(ne_conv.EQ.1) THEN
203  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ne_transp%diff_eff) .AND. c_ne_vconv(inum).NE.0.0_r8) &
204  coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff &
205  + coretransp_arr(inum)%VALUES(1)%ne_transp%diff_eff &
206  * c_ne_vconv(inum)
207  END IF
208 ! te
209  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%te_transp%diff_eff) .AND. c_te_diff(inum).NE.0.0_r8) &
210  coretransp_out(1)%VALUES(1)%te_transp%diff_eff = coretransp_out(1)%VALUES(1)%te_transp%diff_eff &
211  + coretransp_arr(inum)%VALUES(1)%te_transp%diff_eff &
212  * c_te_diff(inum)
213  IF(te_conv.EQ.0) THEN
214  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%te_transp%vconv_eff) .AND. c_te_vconv(inum).NE.0.0_r8) &
215  coretransp_out(1)%VALUES(1)%te_transp%vconv_eff = coretransp_out(1)%VALUES(1)%te_transp%vconv_eff &
216  + coretransp_arr(inum)%VALUES(1)%te_transp%vconv_eff &
217  * c_te_vconv(inum)
218  ELSE IF(te_conv.EQ.1) THEN
219  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%te_transp%diff_eff) .AND. c_te_vconv(inum).NE.0.0_r8) &
220  coretransp_out(1)%VALUES(1)%te_transp%vconv_eff = coretransp_out(1)%VALUES(1)%te_transp%vconv_eff &
221  + coretransp_arr(inum)%VALUES(1)%te_transp%diff_eff &
222  * c_te_vconv(inum)
223  END IF
224 ! ni
225  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ni_transp%diff_eff) .AND. c_ni_diff(inum).NE.0.0_r8) &
226  coretransp_out(1)%VALUES(1)%ni_transp%diff_eff = coretransp_out(1)%VALUES(1)%ni_transp%diff_eff &
227  + coretransp_arr(inum)%VALUES(1)%ni_transp%diff_eff &
228  * c_ni_diff(inum)
229  IF(ni_conv.EQ.0) THEN
230  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ni_transp%vconv_eff) .AND. c_ni_vconv(inum).NE.0.0_r8) &
231  coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff &
232  + coretransp_arr(inum)%VALUES(1)%ni_transp%vconv_eff &
233  * c_ni_vconv(inum)
234  ELSE IF(ni_conv.EQ.1) THEN
235  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ni_transp%diff_eff) .AND. c_ni_vconv(inum).NE.0.0_r8) &
236  coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff &
237  + coretransp_arr(inum)%VALUES(1)%ni_transp%diff_eff &
238  * c_ni_vconv(inum)
239  END IF
240 ! ti
241  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ti_transp%diff_eff) .AND. c_ti_diff(inum).NE.0.0_r8) &
242  coretransp_out(1)%VALUES(1)%ti_transp%diff_eff = coretransp_out(1)%VALUES(1)%ti_transp%diff_eff &
243  + coretransp_arr(inum)%VALUES(1)%ti_transp%diff_eff &
244  * c_ti_diff(inum)
245  IF(ti_conv.EQ.0) THEN
246  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ti_transp%vconv_eff) .AND. c_ti_vconv(inum).NE.0.0_r8) &
247  coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff &
248  + coretransp_arr(inum)%VALUES(1)%ti_transp%vconv_eff &
249  * c_ti_vconv(inum)
250  ELSE IF(ti_conv.EQ.1) THEN
251  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%ti_transp%diff_eff) .AND. c_ti_vconv(inum).NE.0.0_r8) &
252  coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff &
253  + coretransp_arr(inum)%VALUES(1)%ti_transp%diff_eff &
254  * c_ti_vconv(inum)
255  END IF
256 ! vtor
257  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%vtor_transp%diff_eff) .AND. c_vtor_diff(inum).NE.0.0_r8) &
258  coretransp_out(1)%VALUES(1)%vtor_transp%diff_eff = coretransp_out(1)%VALUES(1)%vtor_transp%diff_eff &
259  + coretransp_arr(inum)%VALUES(1)%vtor_transp%diff_eff &
260  * c_vtor_diff(inum)
261  IF(vtor_conv.EQ.0) THEN
262  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%vtor_transp%vconv_eff) .AND. c_vtor_vconv(inum).NE.0.0_r8) &
263  coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff = coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff &
264  + coretransp_arr(inum)%VALUES(1)%vtor_transp%vconv_eff &
265  * c_vtor_vconv(inum)
266  ELSE IF(vtor_conv.EQ.1) THEN
267  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%vtor_transp%diff_eff) .AND. c_vtor_vconv(inum).NE.0.0_r8) &
268  coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff = coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff &
269  + coretransp_arr(inum)%VALUES(1)%vtor_transp%diff_eff &
270  * c_vtor_vconv(inum)
271  END IF
272 
273 
274  DO iimp = 1, nimp
275 ! nz
276  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%diff_eff) .AND. c_nz_diff(inum).NE.0.0_r8) &
277  coretransp_out(1)%VALUES(1)%nz_transp(iimp)%diff_eff = coretransp_out(1)%VALUES(1)%nz_transp(iimp)%diff_eff &
278  + coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%diff_eff &
279  * c_nz_diff(inum)
280  IF(nz_conv.EQ.0) THEN
281  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%vconv_eff) .AND. c_nz_vconv(inum).NE.0.0_r8) &
282  coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff = coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff &
283  + coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%vconv_eff &
284  * c_nz_vconv(inum)
285  ELSE IF(nz_conv.EQ.1) THEN
286  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%diff_eff) .AND. c_nz_vconv(inum).NE.0.0_r8) &
287  coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff = coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff &
288  + coretransp_arr(inum)%VALUES(1)%nz_transp(iimp)%diff_eff &
289  * c_nz_vconv(inum)
290  END IF
291 ! tz
292  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%diff_eff) .AND. c_tz_diff(inum).NE.0.0_r8) &
293  coretransp_out(1)%VALUES(1)%tz_transp(iimp)%diff_eff = coretransp_out(1)%VALUES(1)%tz_transp(iimp)%diff_eff &
294  + coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%diff_eff &
295  * c_tz_diff(inum)
296  IF(tz_conv.EQ.0) THEN
297  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%vconv_eff) .AND. c_tz_vconv(inum).NE.0.0_r8) &
298  coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff = coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff &
299  + coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%vconv_eff &
300  * c_tz_vconv(inum)
301  ELSE IF(tz_conv.EQ.1) THEN
302  IF(ASSOCIATED(coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%diff_eff) .AND. c_tz_vconv(inum).NE.0.0_r8) &
303  coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff = coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff &
304  + coretransp_arr(inum)%VALUES(1)%tz_transp(iimp)%diff_eff &
305  * c_tz_vconv(inum)
306  END IF
307  END DO
308 
309  END DO
310 
311 
312 
313 ! +++ MIXING OF TRANSPORT PROFILES:
314  CALL allocate_coretransp_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coretransp_mix)
315  CALL deallocate_cpo(coretransp_mix(1)%VALUES(1)%rho_tor)
316  CALL copy_cpo(coretransp_out(1)%VALUES(1)%rho_tor, coretransp_mix(1)%VALUES(1)%rho_tor)
317  CALL deallocate_cpo(coretransp_mix(1)%compositions)
318  CALL copy_cpo(coretransp_out(1)%compositions, coretransp_mix(1)%compositions)
319  CALL interpolate_transp(coretransp(1), coretransp_mix(1), negative_diff)
320 
321 
322  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%sigma)) &
323  coretransp_out(1)%VALUES(1)%sigma = coretransp_out(1)%VALUES(1)%sigma * amix_tr &
324  + coretransp_mix(1)%VALUES(1)%sigma * (1.0_r8 - amix_tr)
325 ! ni
326  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ni_transp%diff_eff)) &
327  coretransp_out(1)%VALUES(1)%ni_transp%diff_eff = coretransp_out(1)%VALUES(1)%ni_transp%diff_eff * amix_tr &
328  + coretransp_mix(1)%VALUES(1)%ni_transp%diff_eff * (1.0_r8 - amix_tr)
329 
330  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ni_transp%vconv_eff)) &
331  coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ni_transp%vconv_eff * amix_tr &
332  + coretransp_mix(1)%VALUES(1)%ni_transp%vconv_eff * (1.0_r8 - amix_tr)
333 ! ne
334  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ne_transp%diff_eff)) &
335  coretransp_out(1)%VALUES(1)%ne_transp%diff_eff = coretransp_out(1)%VALUES(1)%ne_transp%diff_eff * amix_tr &
336  + coretransp_mix(1)%VALUES(1)%ne_transp%diff_eff * (1.0_r8 - amix_tr)
337  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ne_transp%vconv_eff)) &
338  coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ne_transp%vconv_eff * amix_tr &
339  + coretransp_mix(1)%VALUES(1)%ne_transp%vconv_eff * (1.0_r8 - amix_tr)
340 ! ti
341  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ti_transp%diff_eff)) &
342  coretransp_out(1)%VALUES(1)%ti_transp%diff_eff = coretransp_out(1)%VALUES(1)%ti_transp%diff_eff * amix_tr &
343  + coretransp_mix(1)%VALUES(1)%ti_transp%diff_eff * (1.0_r8 - amix_tr)
344  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%ti_transp%vconv_eff)) &
345  coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff = coretransp_out(1)%VALUES(1)%ti_transp%vconv_eff * amix_tr &
346  + coretransp_mix(1)%VALUES(1)%ti_transp%vconv_eff * (1.0_r8 - amix_tr)
347 ! te
348  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%te_transp%diff_eff)) &
349  coretransp_out(1)%VALUES(1)%te_transp%diff_eff = coretransp_out(1)%VALUES(1)%te_transp%diff_eff * amix_tr &
350  + coretransp_mix(1)%VALUES(1)%te_transp%diff_eff * (1.0_r8 - amix_tr)
351  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%te_transp%vconv_eff)) &
352  coretransp_out(1)%VALUES(1)%te_transp%vconv_eff = coretransp_out(1)%VALUES(1)%te_transp%vconv_eff * amix_tr &
353  + coretransp_mix(1)%VALUES(1)%te_transp%vconv_eff * (1.0_r8 - amix_tr)
354 ! vtor
355  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%vtor_transp%diff_eff)) &
356  coretransp_out(1)%VALUES(1)%vtor_transp%diff_eff = coretransp_out(1)%VALUES(1)%vtor_transp%diff_eff * amix_tr &
357  + coretransp_mix(1)%VALUES(1)%vtor_transp%diff_eff * (1.0_r8 - amix_tr)
358  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%vtor_transp%vconv_eff)) &
359  coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff = coretransp_out(1)%VALUES(1)%vtor_transp%vconv_eff * amix_tr &
360  + coretransp_mix(1)%VALUES(1)%vtor_transp%vconv_eff * (1.0_r8 - amix_tr)
361 
362  DO iimp = 1, nimp
363 ! nz
364  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%nz_transp(iimp)%diff_eff)) &
365  coretransp_out(1)%VALUES(1)%nz_transp(iimp)%diff_eff = coretransp_out(1)%VALUES(1)%nz_transp(iimp)%diff_eff * amix_tr &
366  + coretransp_mix(1)%VALUES(1)%nz_transp(iimp)%diff_eff * (1.0_r8 - amix_tr)
367  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%nz_transp(iimp)%vconv_eff)) &
368  coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff= coretransp_out(1)%VALUES(1)%nz_transp(iimp)%vconv_eff * amix_tr &
369  + coretransp_mix(1)%VALUES(1)%nz_transp(iimp)%vconv_eff * (1.0_r8 - amix_tr)
370 ! tz
371  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%tz_transp(iimp)%diff_eff)) &
372  coretransp_out(1)%VALUES(1)%tz_transp(iimp)%diff_eff = coretransp_out(1)%VALUES(1)%tz_transp(iimp)%diff_eff * amix_tr &
373  + coretransp_mix(1)%VALUES(1)%tz_transp(iimp)%diff_eff * (1.0_r8 - amix_tr)
374  IF(ASSOCIATED(coretransp_mix(1)%VALUES(1)%tz_transp(iimp)%vconv_eff)) &
375  coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff= coretransp_out(1)%VALUES(1)%tz_transp(iimp)%vconv_eff * amix_tr &
376  + coretransp_mix(1)%VALUES(1)%tz_transp(iimp)%vconv_eff * (1.0_r8 - amix_tr)
377  END DO
378 
379 ! +++ Deallocation of internal variables:
380  IF(ALLOCATED(rho_tor)) DEALLOCATE ( rho_tor )
381  IF(ALLOCATED(nzimp)) DEALLOCATE ( nzimp )
382  IF(ALLOCATED(ncomp)) DEALLOCATE ( ncomp )
383  IF(ALLOCATED(ntype)) DEALLOCATE ( ntype )
384  CALL deallocate_cpo(coretransp_arr)
385  CALL deallocate_cpo(coretransp_mix)
386 
387 ! +++ ADD IDENTIFIER TO OUTPUT CPO VALUES(1):
388  ALLOCATE (coretransp_out(1)%VALUES(1)%transportid%id(1))
389  ALLOCATE (coretransp_out(1)%VALUES(1)%transportid%description(1))
390  coretransp_out(1)%VALUES(1)%transportid%id = 'combined'
391  coretransp_out(1)%VALUES(1)%transportid%flag = 12
392  coretransp_out(1)%VALUES(1)%transportid%description = 'Derived from a number of contributions'
393 
394 
395 
396 
397 ! +++ COPY INDIVIDUAL INPUT TRANSPORT CONTRIBUTIONS TO OUTPUT CPO:
398  ALLOCATE (coretransp_arr(6))
399  CALL copy_cpo(coretransp1(1), coretransp_arr(1))
400  CALL copy_cpo(coretransp2(1), coretransp_arr(2))
401  CALL copy_cpo(coretransp3(1), coretransp_arr(3))
402  CALL copy_cpo(coretransp4(1), coretransp_arr(4))
403  CALL copy_cpo(coretransp5(1), coretransp_arr(5))
404 
405  iarr = 1
406  DO inum = 1, num_transp
407  iarr = iarr + SIZE(coretransp_arr(inum)%VALUES)
408  END DO
409  ALLOCATE (coretransp_mix(1))
410  ALLOCATE (coretransp_mix(1)%VALUES(iarr))
411 
412  CALL copy_cpo(coretransp_out(1)%VALUES(1), coretransp_mix(1)%VALUES(1))
413  CALL deallocate_cpo(coretransp_out(1)%VALUES)
414  ALLOCATE (coretransp_out(1)%VALUES(iarr))
415  CALL copy_cpo(coretransp_mix(1)%VALUES(1), coretransp_out(1)%VALUES(1))
416 
417 
418  ival = 2
419  DO inum = 1, num_transp
420  DO iarr = 1, SIZE(coretransp_arr(inum)%VALUES)
421  CALL copy_cpo(coretransp_arr(inum)%VALUES(iarr), coretransp_out(1)%VALUES(ival))
422  IF (.NOT.ASSOCIATED(coretransp_out(1)%VALUES(ival)%transportid%id)) THEN
423  ALLOCATE (coretransp_out(1)%VALUES(ival)%transportid%id(1))
424  coretransp_out(1)%VALUES(ival)%transportid%id = 'unspecified'
425  coretransp_out(1)%VALUES(ival)%transportid%flag = 0
426  IF (.NOT.ASSOCIATED(coretransp_out(1)%VALUES(ival)%transportid%description)) THEN
427  ALLOCATE(coretransp_out(1)%VALUES(ival)%transportid%description(1))
428  coretransp_out(1)%VALUES(ival)%transportid%description = 'Unspecified transport type'
429  END IF
430  END IF
431  ival = ival + 1
432  END DO
433  END DO
434 
435  CALL deallocate_cpo(coretransp_arr)
436  CALL deallocate_cpo(coretransp_mix)
437 
438 
439 
440  RETURN
441 
442 
443  CONTAINS
444 
445 
446 
447 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
448 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
449  SUBROUTINE assign_combiner_parameters(codeparameters, return_status)
450 
451  !-------------------------------------------------------!
452  ! This subroutine calls the XML parser for !
453  ! the combiner parameters and assign the !
454  ! resulting values to the corresponding variables !
455  !-------------------------------------------------------!
456  ! Source: --- !
457  ! Developers: D.Kalupin !
458  ! Kontacts: Denis.Kalupin@efda.org !
459  ! !
460  ! Comments: created for V&V between ETS and !
461  ! ASTRA !
462  ! !
463  !-------------------------------------------------------!
464 
465  USE itm_types
466  USE euitm_schemas
467  USE euitm_xml_parser
468 
469  IMPLICIT NONE
470 
471 
472  TYPE(type_param) :: codeparameters
473  INTEGER(ITM_I4) :: return_status
474  INTEGER(ITM_I4) :: vod
475  INTEGER(ITM_I4) :: nparm
476 
477  CHARACTER(len = 132) :: prefix
478 
479  TYPE(element), POINTER :: temp_pointer
480  TYPE(tree) :: parameter_list
481  CHARACTER(len = 132) :: parameter_value
482  CHARACTER(len = 4) :: parameter_char
483 
484 
485  return_status = 0
486 
487  c_sigma = 0.0_r8
488  c_ne_diff = 0.0_r8
489  c_ne_vconv = 0.0_r8
490  c_ni_diff = 0.0_r8
491  c_ni_vconv = 0.0_r8
492  c_te_diff = 0.0_r8
493  c_te_vconv = 0.0_r8
494  c_ti_diff = 0.0_r8
495  c_ti_vconv = 0.0_r8
496  c_vtor_diff = 0.0_r8
497  c_vtor_vconv = 0.0_r8
498  c_nz_diff = 0.0_r8
499  c_nz_vconv = 0.0_r8
500  c_tz_diff = 0.0_r8
501  c_tz_vconv = 0.0_r8
502 
503  negative_diff = 0
504 
505 
506  prefix = 'parameters/CURRENT/conductivity'
507  CALL assign_multipliers(prefix,codeparameters,return_status, c_sigma, vod)
508  prefix = 'parameters/NE/diffusion'
509  CALL assign_multipliers(prefix,codeparameters,return_status, c_ne_diff, vod)
510  prefix = 'parameters/NE/convective_velocity'
511  ne_conv = 0
512  CALL assign_multipliers(prefix,codeparameters,return_status, c_ne_vconv, ne_conv)
513  prefix = 'parameters/NI/diffusion'
514  CALL assign_multipliers(prefix,codeparameters,return_status, c_ni_diff, vod)
515  prefix = 'parameters/NI/convective_velocity'
516  ni_conv = 0
517  CALL assign_multipliers(prefix,codeparameters,return_status, c_ni_vconv, ni_conv)
518  prefix = 'parameters/NZ/diffusion'
519  CALL assign_multipliers(prefix,codeparameters,return_status, c_nz_diff, vod)
520  prefix = 'parameters/NZ/convective_velocity'
521  nz_conv = 0
522  CALL assign_multipliers(prefix,codeparameters,return_status, c_nz_vconv, nz_conv)
523  prefix = 'parameters/TE/diffusion'
524  CALL assign_multipliers(prefix,codeparameters,return_status, c_te_diff, vod)
525  prefix = 'parameters/TE/convective_velocity'
526  te_conv = 0
527  CALL assign_multipliers(prefix,codeparameters,return_status, c_te_vconv, te_conv)
528  prefix = 'parameters/TI/diffusion'
529  CALL assign_multipliers(prefix,codeparameters,return_status, c_ti_diff, vod)
530  prefix = 'parameters/TI/convective_velocity'
531  ti_conv = 0
532  CALL assign_multipliers(prefix,codeparameters,return_status, c_ti_vconv, ti_conv)
533  prefix = 'parameters/TZ/diffusion'
534  CALL assign_multipliers(prefix,codeparameters,return_status, c_tz_diff, vod)
535  prefix = 'parameters/TZ/convective_velocity'
536  tz_conv = 0
537  CALL assign_multipliers(prefix,codeparameters,return_status, c_tz_vconv, tz_conv)
538  prefix = 'parameters/VTOR/diffusion'
539  CALL assign_multipliers(prefix,codeparameters,return_status, c_vtor_diff, vod)
540  prefix = 'parameters/VTOR/convective_velocity'
541  vtor_conv = 0
542  CALL assign_multipliers(prefix,codeparameters,return_status, c_vtor_vconv, vtor_conv)
543 
544  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
545  temp_pointer => parameter_list%first
546  prefix = 'parameters/CHECKs/remove_negative_diffusion'
547  CALL find_parameter(prefix, parameter_value, temp_pointer)
548  parameter_char = trim(adjustl(parameter_value))
549  IF (parameter_char.EQ."true") negative_diff = 1
550  CALL destroy_xml_tree(parameter_list)
551 
552  RETURN
553 
554  END SUBROUTINE assign_combiner_parameters
555 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
556 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
557 
558 
559 
560 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
561 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
562  SUBROUTINE assign_multipliers(prefix,codeparameters, return_status, multipliers, vod)
563 
564  USE itm_types
565  USE euitm_xml_parser
566 
567  IMPLICIT NONE
568 
569  TYPE(type_param) :: codeparameters
570  INTEGER(ITM_I4) :: return_status
571 
572  CHARACTER(len = 132) :: prefix
573  CHARACTER(len = 132) :: inter_path(3)
574  CHARACTER(len = 132) :: multiplier_path(num_transp)
575  CHARACTER(len = 132) :: parameter_value
576  REAL(R8) :: multipliers(num_transp)
577  REAL(R8) :: value(1)
578 
579  TYPE(element), POINTER :: temp_pointer
580  TYPE(tree) :: parameter_list
581 
582  INTEGER(ITM_I4) :: i_transp, nval, i_int
583  INTEGER(ITM_I4) :: nparm, vod
584 
585  vod = 0
586 
587 !-- parse xml-string codeparameters%parameters
588  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
589 
590  inter_path(1) = trim(adjustl(prefix))//"/Multipliers_for_conductivity_from"
591  inter_path(2) = trim(adjustl(prefix))//"/Multipliers_for_contributions_from"
592  inter_path(3) = trim(adjustl(prefix))//"/V_over_D_ratio_for_contributions_from"
593 
594  DO i_int = 1,3
595  multiplier_path(1) = trim(adjustl(inter_path(i_int)))//"/Data_Base"
596  multiplier_path(2) = trim(adjustl(inter_path(i_int)))//"/Anomalous"
597  multiplier_path(3) = trim(adjustl(inter_path(i_int)))//"/Neoclassical"
598  multiplier_path(4) = trim(adjustl(inter_path(i_int)))//"/Background"
599  multiplier_path(5) = trim(adjustl(inter_path(i_int)))//"/Spitzer"
600 
601  DO i_transp = 1, num_transp
602  temp_pointer => parameter_list%first
603  CALL find_parameter(multiplier_path(i_transp), parameter_value, temp_pointer)
604  IF (len(trim(parameter_value)).GE.1) THEN
605  CALL scan_str2real(parameter_value, value ,nval)
606  multipliers(i_transp) = value(1)
607  END IF
608  END DO
609 
610  IF (i_int.EQ.3.AND.abs(maxval(multipliers)).NE.0.0_r8) vod = 0 ! PIS Fix! Changed from vod = 1 to turn off v/D option whcih otherwise is always called in error
611 
612  END DO
613 
614 
615 
616 
617 !-- destroy tree
618  CALL destroy_xml_tree(parameter_list)
619 
620  RETURN
621 
622  END SUBROUTINE assign_multipliers
623 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
624 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
625 
626 
627  END SUBROUTINE combine_transport
628 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
629 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
630 
631 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
632 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
633 
634 
635 
636 END MODULE transport_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
interpolate_cpo::interpolate_transp
subroutine interpolate_transp(CORETRANSP_IN, CORETRANSP_OUT, NEGATIVE_DIFF)
Definition: interpolate_cpo.f90:321
transport_combiner::combine_transport
subroutine combine_transport(COREPROF, CORETRANSP, CORETRANSP1, CORETRANSP2, CORETRANSP3, CORETRANSP4, CORETRANSP5, CORETRANSP_OUT, AMIX_TR, code_parameters)
Definition: transport_combiner.f90:26
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
transport_combiner
Definition: transport_combiner.f90:1
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
allocate_deallocate::allocate_coretransp_cpo
subroutine allocate_coretransp_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORETRANSP)
This routine allocates CORETRANSP CPO.
Definition: allocate_deallocate.f90:316