ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
interpolate_cpo.f90
Go to the documentation of this file.
1 MODULE interpolate_cpo
2 !-------------------------------------------------------!
3 ! !
4 ! This module contains routines for !
5 ! interpolation of CPOs used in ETS !
6 ! !
7 !-------------------------------------------------------!
8 ! !
9 ! Source: --- !
10 ! Developers: D.Kalupin !
11 ! Kontacts: D.Kalupin@fz-juelich.de !
12 ! !
13 ! Comments: --- !
14 ! !
15 !-------------------------------------------------------!
16 
17 CONTAINS
18 
19 
20 
21 
22 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
23 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
24 
25  SUBROUTINE interpolate_source(CORESOURCE_IN, CORESOURCE_OUT)
26 
27  USE euitm_schemas
28  USE itm_types
29  USE allocate_deallocate
30 
31  IMPLICIT NONE
32 
33  TYPE (type_coresource) :: coresource_in
34  TYPE (type_coresource) :: coresource_out
35 
36  INTEGER :: nval1, nval2
37  INTEGER :: ival
38  INTEGER :: nrho1, nrho2
39  INTEGER :: nnucl1,inucl1
40  INTEGER :: nnucl2,inucl2
41  INTEGER :: nion1, iion1
42  INTEGER :: nion2, iion2
43  INTEGER :: nimp1, iimp1
44  INTEGER :: nimp2, iimp2
45  INTEGER, ALLOCATABLE :: nzimp1(:)
46  INTEGER, ALLOCATABLE :: nzimp2(:)
47  INTEGER :: izimp1,izimp2
48  INTEGER :: nneut1,ineut1
49  INTEGER :: nneut2,ineut2
50  INTEGER, ALLOCATABLE :: ncomp1(:)
51  INTEGER, ALLOCATABLE :: ncomp2(:)
52  INTEGER, ALLOCATABLE :: ntype1(:)
53  INTEGER, ALLOCATABLE :: ntype2(:)
54 
55  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
56  REAL (R8), ALLOCATABLE :: fun(:)
57  REAL (R8) :: zmin1, zmin2
58  REAL (R8) :: zmax1, zmax2
59 !==============================================
60 
61  nval1 = 1
62  nval2 = SIZE(coresource_in%VALUES)
63 
64 
65  nrho1 = SIZE(coresource_out%VALUES(1)%rho_tor)
66 
67  ALLOCATE (fun(nrho1))
68  ALLOCATE (rho1(nrho1))
69 
70  rho1 = coresource_out%VALUES(1)%rho_tor
71 
72  CALL get_comp_dimensions(coresource_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
73  CALL get_comp_dimensions(coresource_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
74 
75  IF(.NOT.ASSOCIATED(coresource_in%VALUES)) goto 10
76 
77 
78 
79 ! +++ Nullify initial profiles:
80  coresource_out%VALUES(1)%j = 0.0_r8
81  coresource_out%VALUES(1)%sigma = 0.0_r8
82  coresource_out%VALUES(1)%Se%exp = 0.0_r8
83  coresource_out%VALUES(1)%Se%imp = 0.0_r8
84  coresource_out%VALUES(1)%Qe%exp = 0.0_r8
85  coresource_out%VALUES(1)%Qe%imp = 0.0_r8
86  coresource_out%VALUES(1)%Si%exp = 0.0_r8
87  coresource_out%VALUES(1)%Si%imp = 0.0_r8
88  coresource_out%VALUES(1)%Qi%exp = 0.0_r8
89  coresource_out%VALUES(1)%Qi%imp = 0.0_r8
90  coresource_out%VALUES(1)%Ui%exp = 0.0_r8
91  coresource_out%VALUES(1)%Ui%imp = 0.0_r8
92  DO iimp1 = 1, nimp1
93  coresource_out%VALUES(1)%Sz(iimp1)%exp = 0.0_r8
94  coresource_out%VALUES(1)%Sz(iimp1)%imp = 0.0_r8
95  coresource_out%VALUES(1)%Qz(iimp1)%exp = 0.0_r8
96  coresource_out%VALUES(1)%Qz(iimp1)%imp = 0.0_r8
97  END DO
98 
99 
100 
101 
102 ! +++ Check information saved to different VALUES:
103  loop_on_values: DO ival = 1, nval2
104  nrho2 = SIZE(coresource_in%VALUES(1)%rho_tor)
105  ALLOCATE (rho2(nrho2))
106  rho2 = coresource_in%VALUES(ival)%rho_tor
107 
108 
109 
110 
111 ! j
112  fun(:) = 0.0_r8
113  IF(ASSOCIATED(coresource_in%VALUES(ival)%j)) THEN
114  CALL l3interp(coresource_in%VALUES(ival)%j, rho2, nrho2, &
115  fun, rho1, nrho1)
116  coresource_out%VALUES(1)%j = coresource_out%VALUES(1)%j + fun
117  END IF
118 
119 ! sigma
120  fun(:) = 0.0_r8
121  IF(ASSOCIATED(coresource_in%VALUES(ival)%sigma)) THEN
122  CALL l3interp(coresource_in%VALUES(ival)%sigma, rho2, nrho2, &
123  fun, rho1, nrho1)
124  coresource_out%VALUES(1)%sigma = coresource_out%VALUES(1)%sigma + fun
125  END IF
126 
127 ! Se
128  fun(:) = 0.0_r8
129  IF(ASSOCIATED(coresource_in%VALUES(ival)%Se%exp)) THEN
130  CALL l3interp(coresource_in%VALUES(ival)%Se%exp, rho2, nrho2, &
131  fun, rho1, nrho1)
132  coresource_out%VALUES(1)%Se%exp = coresource_out%VALUES(1)%Se%exp + fun
133  END IF
134 
135  fun(:) = 0.0_r8
136  IF(ASSOCIATED(coresource_in%VALUES(ival)%Se%imp)) THEN
137  CALL l3interp(coresource_in%VALUES(ival)%Se%imp, rho2, nrho2, &
138  fun, rho1, nrho1)
139  coresource_out%VALUES(1)%Se%imp = coresource_out%VALUES(1)%Se%imp + fun
140  END IF
141 
142 ! Qe
143  fun(:) = 0.0_r8
144  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qe%exp)) THEN
145  CALL l3interp(coresource_in%VALUES(ival)%Qe%exp, rho2, nrho2, &
146  fun, rho1, nrho1)
147  coresource_out%VALUES(1)%Qe%exp = coresource_out%VALUES(1)%Qe%exp + fun
148  END IF
149 
150  fun(:) = 0.0_r8
151  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qe%imp)) THEN
152  CALL l3interp(coresource_in%VALUES(ival)%Qe%imp, rho2, nrho2, &
153  fun, rho1, nrho1)
154  coresource_out%VALUES(1)%Qe%imp = coresource_out%VALUES(1)%Qe%imp + fun
155  END IF
156 
157 
158 
159 ! +++ IONS
160  output_ions_loop: DO iion1 = 1, nion1
161  inucl1 = coresource_out%COMPOSITIONS%IONS(iion1)%nucindex
162  input_ions_loop: DO iion2 = 1, nion2
163  inucl2 = coresource_in%COMPOSITIONS%IONS(iion2)%nucindex
164 
165  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coresource_in%COMPOSITIONS%NUCLEI)) goto 5
166 
167  check_for_ions_consistency: IF &
168  (abs(coresource_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coresource_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
169  abs(coresource_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coresource_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
170  abs(coresource_out%COMPOSITIONS%IONS(iion1)%zion - coresource_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
171 
172 
173 ! Si
174  fun(:) = 0.0_r8
175  IF(ASSOCIATED(coresource_in%VALUES(ival)%Si%exp)) THEN
176  CALL l3interp(coresource_in%VALUES(ival)%Si%exp(:,iion2), rho2, nrho2, &
177  fun, rho1, nrho1)
178  coresource_out%VALUES(1)%Si%exp(:,iion1) = coresource_out%VALUES(1)%Si%exp(:,iion1) + fun
179  END IF
180  fun(:) = 0.0_r8
181  IF(ASSOCIATED(coresource_in%VALUES(ival)%Si%imp)) THEN
182  CALL l3interp(coresource_in%VALUES(ival)%Si%imp(:,iion2), rho2, nrho2, &
183  fun, rho1, nrho1)
184  coresource_out%VALUES(1)%Si%imp(:,iion1) = coresource_out%VALUES(1)%Si%imp(:,iion1) + fun
185  END IF
186 
187 ! Qi
188  fun(:) = 0.0_r8
189  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qi%exp)) THEN
190  CALL l3interp(coresource_in%VALUES(ival)%Qi%exp(:,iion2), rho2, nrho2, &
191  fun, rho1, nrho1)
192  coresource_out%VALUES(1)%Qi%exp(:,iion1) = coresource_out%VALUES(1)%Qi%exp(:,iion1) + fun
193  END IF
194  fun(:) = 0.0_r8
195  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qi%imp)) THEN
196  CALL l3interp(coresource_in%VALUES(ival)%Qi%imp(:,iion2), rho2, nrho2, &
197  fun, rho1, nrho1)
198  coresource_out%VALUES(1)%Qi%imp(:,iion1) = coresource_out%VALUES(1)%Qi%imp(:,iion1) + fun
199  END IF
200 
201 ! Ui
202  fun(:) = 0.0_r8
203  IF(ASSOCIATED(coresource_in%VALUES(ival)%Ui%exp)) THEN
204  CALL l3interp(coresource_in%VALUES(ival)%Ui%exp(:,iion2), rho2, nrho2, &
205  fun, rho1, nrho1)
206  coresource_out%VALUES(1)%Ui%exp(:,iion1) = coresource_out%VALUES(1)%Ui%exp(:,iion1) + fun
207  END IF
208  fun(:) = 0.0_r8
209  IF(ASSOCIATED(coresource_in%VALUES(ival)%Ui%imp)) THEN
210  CALL l3interp(coresource_in%VALUES(ival)%Ui%imp(:,iion2), rho2, nrho2, &
211  fun, rho1, nrho1)
212  coresource_out%VALUES(1)%Ui%imp(:,iion1) = coresource_out%VALUES(1)%Ui%imp(:,iion1) + fun
213  END IF
214 
215  END IF check_for_ions_consistency
216 
217 5 CONTINUE
218 
219  END DO input_ions_loop
220  END DO output_ions_loop
221 
222 
223 
224 ! +++ IMPURITY
225  IF (nimp1*nimp2.LE.0) goto 8
226  output_impurity_loop: DO iimp1 = 1, nimp1
227  inucl1 = coresource_out%COMPOSITIONS%IMPURITIES(iimp1)%nucindex
228 
229  input_impurity_loop: DO iimp2 = 1, nimp2
230  inucl2 = coresource_in%COMPOSITIONS%IMPURITIES(iimp2)%nucindex
231 
232  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coresource_in%COMPOSITIONS%NUCLEI)) goto 7
233 
234  check_for_nuclei_consistency: IF &
235  (abs(coresource_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coresource_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
236  abs(coresource_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coresource_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 ) THEN
237 
238  output_ionization_state: DO izimp1 = 1, nzimp1(iimp1)
239  input_ionization_state: DO izimp2 = 1, nzimp2(iimp2)
240 
241  zmin1 = coresource_out%COMPOSITIONS%IMPURITIES(iimp1)%zmin(izimp1)
242  zmax1 = coresource_out%COMPOSITIONS%IMPURITIES(iimp1)%zmax(izimp1)
243  zmin2 = coresource_in%COMPOSITIONS%IMPURITIES(iimp2)%zmin(izimp2)
244  zmax2 = coresource_in%COMPOSITIONS%IMPURITIES(iimp2)%zmax(izimp2)
245 
246  check_for_ionization_state_consistency: IF &
247  (abs((zmax1+zmin1)/2.0 - (zmax2+zmin2)/2.0).LE. 0.25) THEN
248 ! Sz
249  IF(ASSOCIATED(coresource_in%VALUES(ival)%Sz).AND.iimp2.LE.SIZE(coresource_in%VALUES(ival)%Sz)) THEN
250  fun(:) = 0.0_r8
251  IF(ASSOCIATED(coresource_in%VALUES(ival)%Sz(iimp2)%exp)) THEN
252  CALL l3interp(coresource_in%VALUES(ival)%Sz(iimp2)%exp(:,izimp2), rho2, nrho2, &
253  fun, rho1, nrho1)
254  coresource_out%VALUES(1)%Sz(iimp1)%exp(:,izimp1) = coresource_out%VALUES(1)%Sz(iimp1)%exp(:,izimp1) + fun
255  END IF
256  fun(:) = 0.0_r8
257  IF(ASSOCIATED(coresource_in%VALUES(ival)%Sz(iimp2)%imp)) THEN
258  CALL l3interp(coresource_in%VALUES(ival)%Sz(iimp2)%imp(:,izimp2), rho2, nrho2, &
259  fun, rho1, nrho1)
260  coresource_out%VALUES(1)%Sz(iimp1)%imp(:,izimp1) = coresource_out%VALUES(1)%Sz(iimp1)%imp(:,izimp1) + fun
261  END IF
262  END IF
263 ! Qz
264  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qz).AND.iimp2.LE.SIZE(coresource_in%VALUES(ival)%Qz)) THEN
265  fun(:) = 0.0_r8
266  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qz(iimp2)%exp)) THEN
267  CALL l3interp(coresource_in%VALUES(ival)%Qz(iimp2)%exp(:,izimp2), rho2, nrho2, &
268  fun, rho1, nrho1)
269  coresource_out%VALUES(1)%Qz(iimp1)%exp(:,izimp1) = coresource_out%VALUES(1)%Qz(iimp1)%exp(:,izimp1) + fun
270  END IF
271  fun(:) = 0.0_r8
272  IF(ASSOCIATED(coresource_in%VALUES(ival)%Qz(iimp2)%imp)) THEN
273  CALL l3interp(coresource_in%VALUES(ival)%Qz(iimp2)%imp(:,izimp2), rho2, nrho2, &
274  fun, rho1, nrho1)
275  coresource_out%VALUES(1)%Qz(iimp1)%imp(:,izimp1) = coresource_out%VALUES(1)%Qz(iimp1)%imp(:,izimp1) + fun
276  END IF
277  END IF
278 
279  END IF check_for_ionization_state_consistency
280 
281  END DO input_ionization_state
282  END DO output_ionization_state
283 
284  END IF check_for_nuclei_consistency
285 
286 7 CONTINUE
287 
288  ENDDO input_impurity_loop
289  ENDDO output_impurity_loop
290 
291 8 IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
292 
293  END DO loop_on_values
294 
295 
296 
297 ! +++ Deallocate local variables:
298  IF(ALLOCATED (nzimp1)) DEALLOCATE (nzimp1)
299  IF(ALLOCATED (ncomp1)) DEALLOCATE (ncomp1)
300  IF(ALLOCATED (ntype1)) DEALLOCATE (ntype1)
301  IF(ALLOCATED (nzimp2)) DEALLOCATE (nzimp2)
302  IF(ALLOCATED (ncomp2)) DEALLOCATE (ncomp2)
303  IF(ALLOCATED (ntype2)) DEALLOCATE (ntype2)
304  IF(ALLOCATED (rho1)) DEALLOCATE (rho1)
305  IF(ALLOCATED (fun)) DEALLOCATE (fun)
306 
307 
308 10 RETURN
309 
310  END SUBROUTINE interpolate_source
311 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
312 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
313 
314 
315 
316 
317 
318 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
319 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
320 
321  SUBROUTINE interpolate_transp(CORETRANSP_IN, CORETRANSP_OUT, NEGATIVE_DIFF)
322 
323  USE euitm_schemas
324  USE itm_types
325  USE allocate_deallocate
326 
327  IMPLICIT NONE
328 
329  TYPE (type_coretransp) :: coretransp_in
330  TYPE (type_coretransp) :: coretransp_out
331 
332  INTEGER :: nval2, ival
333  INTEGER :: nrho1, nrho2
334  INTEGER :: irho1, irho2
335  INTEGER :: nnucl1,inucl1
336  INTEGER :: nnucl2,inucl2
337  INTEGER :: nion1, iion1
338  INTEGER :: nion2, iion2
339  INTEGER :: nimp1, iimp1
340  INTEGER :: nimp2, iimp2
341  INTEGER, ALLOCATABLE :: nzimp1(:)
342  INTEGER, ALLOCATABLE :: nzimp2(:)
343  INTEGER :: izimp1,izimp2
344  INTEGER :: nneut1,ineut1
345  INTEGER :: nneut2,ineut2
346  INTEGER, ALLOCATABLE :: ncomp1(:)
347  INTEGER, ALLOCATABLE :: ncomp2(:)
348  INTEGER, ALLOCATABLE :: ntype1(:)
349  INTEGER, ALLOCATABLE :: ntype2(:)
350 
351  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
352  REAL (R8), ALLOCATABLE :: fun(:)
353  REAL (R8) :: zmin1, zmin2
354  REAL (R8) :: zmax1, zmax2
355 
356  INTEGER :: negative_diff
357  INTEGER :: icon
358 !==============================================
359 
360  nval2 = SIZE(coretransp_in%VALUES)
361 
362 
363  nrho1 = SIZE(coretransp_out%VALUES(1)%rho_tor)
364 
365  ALLOCATE (fun(nrho1))
366  ALLOCATE (rho1(nrho1))
367 
368  rho1 = coretransp_out%VALUES(1)%rho_tor
369 
370  CALL get_comp_dimensions(coretransp_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
371  CALL get_comp_dimensions(coretransp_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
372 
373  IF(.NOT.ASSOCIATED(coretransp_in%VALUES)) goto 10
374 
375 
376 ! +++ Nullify initial profiles:
377  coretransp_out%VALUES(1)%sigma = 0.0_r8
378  coretransp_out%VALUES(1)%Ne_transp%diff_eff = 0.0_r8
379  coretransp_out%VALUES(1)%Ne_transp%vconv_eff = 0.0_r8
380  coretransp_out%VALUES(1)%Te_transp%diff_eff = 0.0_r8
381  coretransp_out%VALUES(1)%Te_transp%vconv_eff = 0.0_r8
382  coretransp_out%VALUES(1)%ni_transp%diff_eff = 0.0_r8
383  coretransp_out%VALUES(1)%ni_transp%vconv_eff = 0.0_r8
384  coretransp_out%VALUES(1)%Ti_transp%diff_eff = 0.0_r8
385  coretransp_out%VALUES(1)%Ti_transp%vconv_eff = 0.0_r8
386  coretransp_out%VALUES(1)%Vtor_transp%diff_eff = 0.0_r8
387  coretransp_out%VALUES(1)%Vtor_transp%vconv_eff = 0.0_r8
388  DO iimp1 = 1, nimp1
389  coretransp_out%VALUES(1)%Nz_transp(iimp1)%diff_eff = 0.0_r8
390  coretransp_out%VALUES(1)%Nz_transp(iimp1)%vconv_eff = 0.0_r8
391  coretransp_out%VALUES(1)%Tz_transp(iimp1)%diff_eff = 0.0_r8
392  coretransp_out%VALUES(1)%Tz_transp(iimp1)%vconv_eff = 0.0_r8
393  END DO
394 
395 
396 
397 
398 
399 
400 ! +++ Check information saved to different VALUES:
401  loop_on_values: DO ival = 1, nval2
402  nrho2 = SIZE(coretransp_in%VALUES(1)%rho_tor)
403  ALLOCATE (rho2(nrho2))
404  rho2 = coretransp_in%VALUES(ival)%rho_tor
405 
406 
407 ! sigma
408  fun(:) = 0.0_r8
409  IF(ASSOCIATED(coretransp_in%VALUES(ival)%sigma)) &
410  CALL l3interp(coretransp_in%VALUES(ival)%sigma, rho2, nrho2, &
411  fun, rho1, nrho1)
412  coretransp_out%VALUES(1)%sigma = fun
413 
414 ! Ne
415  fun(:) = 0.0_r8
416  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Ne_transp%diff_eff)) THEN
417  DO icon = 1,3
418  CALL l3interp(coretransp_in%VALUES(ival)%Ne_transp%diff_eff(:,icon), rho2, nrho2, &
419  fun, rho1, nrho1)
420  coretransp_out%VALUES(1)%Ne_transp%diff_eff(:,icon) = fun
421  END DO
422  END IF
423  fun(:) = 0.0_r8
424  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Ne_transp%vconv_eff)) THEN
425  DO icon = 1,3
426  CALL l3interp(coretransp_in%VALUES(ival)%Ne_transp%vconv_eff(:,icon), rho2, nrho2, &
427  fun, rho1, nrho1)
428  coretransp_out%VALUES(1)%Ne_transp%vconv_eff(:,icon) = fun
429  END DO
430  END IF
431 
432 ! Te
433  fun(:) = 0.0_r8
434  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Te_transp%diff_eff)) THEN
435  CALL l3interp(coretransp_in%VALUES(ival)%Te_transp%diff_eff, rho2, nrho2, &
436  fun, rho1, nrho1)
437  coretransp_out%VALUES(1)%Te_transp%diff_eff = fun
438  END IF
439  fun(:) = 0.0_r8
440  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Te_transp%vconv_eff)) THEN
441  CALL l3interp(coretransp_in%VALUES(ival)%Te_transp%vconv_eff, rho2, nrho2, &
442  fun, rho1, nrho1)
443  coretransp_out%VALUES(1)%Te_transp%vconv_eff = fun
444  END IF
445 
446 
447 
448 
449 ! +++ IONS
450  output_ions_loop: DO iion1 = 1, nion1
451  inucl1 = coretransp_out%COMPOSITIONS%IONS(iion1)%nucindex
452 
453  input_ions_loop: DO iion2 = 1, nion2
454  inucl2 = coretransp_in%COMPOSITIONS%IONS(iion2)%nucindex
455 
456  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coretransp_in%COMPOSITIONS%NUCLEI)) goto 5
457 
458  check_for_ions_consistency: IF &
459  (abs(coretransp_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coretransp_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
460  abs(coretransp_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coretransp_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
461  abs(coretransp_out%COMPOSITIONS%IONS(iion1)%zion - coretransp_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
462 ! Ni
463  fun(:) = 0.0_r8
464  IF(ASSOCIATED(coretransp_in%VALUES(ival)%ni_transp%diff_eff)) THEN
465  DO icon = 1,3
466  CALL l3interp(coretransp_in%VALUES(ival)%ni_transp%diff_eff(:,iion2,icon), rho2, nrho2, &
467  fun, rho1, nrho1)
468  coretransp_out%VALUES(1)%ni_transp%diff_eff(:,iion1,icon) = fun
469  END DO
470  END IF
471  fun(:) = 0.0_r8
472  IF(ASSOCIATED(coretransp_in%VALUES(ival)%ni_transp%vconv_eff)) THEN
473  DO icon = 1,3
474  CALL l3interp(coretransp_in%VALUES(ival)%ni_transp%vconv_eff(:,iion2,icon), rho2, nrho2, &
475  fun, rho1, nrho1)
476  coretransp_out%VALUES(1)%ni_transp%vconv_eff(:,iion1,icon) = fun
477  END DO
478  END IF
479 
480 ! Ti
481  fun(:) = 0.0_r8
482  IF(ASSOCIATED(coretransp_in%VALUES(ival)%ti_transp%diff_eff)) THEN
483  CALL l3interp(coretransp_in%VALUES(ival)%ti_transp%diff_eff(:,iion2), rho2, nrho2, &
484  fun, rho1, nrho1)
485  coretransp_out%VALUES(1)%ti_transp%diff_eff(:,iion1) = fun
486  END IF
487  fun(:) = 0.0_r8
488  IF(ASSOCIATED(coretransp_in%VALUES(ival)%ti_transp%vconv_eff)) THEN
489  CALL l3interp(coretransp_in%VALUES(ival)%ti_transp%vconv_eff(:,iion2), rho2, nrho2, &
490  fun, rho1, nrho1)
491  coretransp_out%VALUES(1)%ti_transp%vconv_eff(:,iion1) = fun
492  END IF
493 
494 ! Vtor
495  fun(:) = 0.0_r8
496  IF(ASSOCIATED(coretransp_in%VALUES(ival)%vtor_transp%diff_eff)) THEN
497  CALL l3interp(coretransp_in%VALUES(ival)%vtor_transp%diff_eff(:,iion2), rho2, nrho2, &
498  fun, rho1, nrho1)
499  coretransp_out%VALUES(1)%vtor_transp%diff_eff(:,iion1) = fun
500  END IF
501  fun(:) = 0.0_r8
502  IF(ASSOCIATED(coretransp_in%VALUES(ival)%vtor_transp%vconv_eff)) THEN
503  CALL l3interp(coretransp_in%VALUES(ival)%vtor_transp%vconv_eff(:,iion2), rho2, nrho2, &
504  fun, rho1, nrho1)
505  coretransp_out%VALUES(1)%vtor_transp%vconv_eff(:,iion1) = fun
506  END IF
507 
508 
509  END IF check_for_ions_consistency
510 
511 5 CONTINUE
512 
513  END DO input_ions_loop
514  END DO output_ions_loop
515 
516 
517 
518 
519 ! +++ IMPURITY
520  IF (nimp1*nimp2.LE.0) goto 8
521  output_impurity_loop: DO iimp1 = 1, nimp1
522  inucl1 = coretransp_out%COMPOSITIONS%IMPURITIES(iimp1)%nucindex
523 
524  input_impurity_loop: DO iimp2 = 1, nimp2
525  inucl2 = coretransp_in%COMPOSITIONS%IMPURITIES(iimp2)%nucindex
526 
527  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coretransp_in%COMPOSITIONS%NUCLEI)) goto 7
528 
529  check_for_impurity_consistency: IF &
530  (abs(coretransp_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coretransp_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
531  abs(coretransp_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coretransp_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 ) THEN
532 
533  output_ionization_state: DO izimp1 = 1, nzimp1(iimp1)
534  input_ionization_state: DO izimp2 = 1, nzimp2(iimp2)
535 
536  zmin1 = coretransp_out%COMPOSITIONS%IMPURITIES(iimp1)%zmin(izimp1)
537  zmax1 = coretransp_out%COMPOSITIONS%IMPURITIES(iimp1)%zmax(izimp1)
538  zmin2 = coretransp_in%COMPOSITIONS%IMPURITIES(iimp2)%zmin(izimp2)
539  zmax2 = coretransp_in%COMPOSITIONS%IMPURITIES(iimp2)%zmax(izimp2)
540 
541  check_for_ionization_state_consistency: IF &
542  (abs((zmax1+zmin1)/2.0 - (zmax2+zmin2)/2.0).LE. 0.25) THEN
543 ! nz
544  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Nz_transp).AND.iimp2.LE.SIZE(coretransp_in%VALUES(ival)%Nz_transp)) THEN
545  fun(:) = 0.0_r8
546  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Nz_transp(iimp2)%diff_eff)) THEN
547  CALL l3interp(coretransp_in%VALUES(ival)%Nz_transp(iimp2)%diff_eff(:,izimp2), rho2, nrho2, &
548  fun, rho1, nrho1)
549  coretransp_out%VALUES(1)%Nz_transp(iimp1)%diff_eff(:,izimp1) = fun
550  END IF
551  fun(:) = 0.0_r8
552  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Nz_transp(iimp2)%vconv_eff)) THEN
553  CALL l3interp(coretransp_in%VALUES(ival)%Nz_transp(iimp2)%vconv_eff(:,izimp2), rho2, nrho2, &
554  fun, rho1, nrho1)
555  coretransp_out%VALUES(1)%Nz_transp(iimp1)%vconv_eff(:,izimp1) = fun
556  END IF
557  END IF
558 ! Tz
559  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Tz_transp).AND.iimp2.LE.SIZE(coretransp_in%VALUES(ival)%Tz_transp)) THEN
560  fun(:) = 0.0_r8
561  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Tz_transp(iimp2)%diff_eff)) THEN
562  CALL l3interp(coretransp_in%VALUES(ival)%Tz_transp(iimp2)%diff_eff(:,izimp2), rho2, nrho2, &
563  fun, rho1, nrho1)
564  coretransp_out%VALUES(1)%Tz_transp(iimp1)%diff_eff(:,izimp1) = fun
565  END IF
566  fun(:) = 0.0_r8
567  IF(ASSOCIATED(coretransp_in%VALUES(ival)%Tz_transp(iimp2)%vconv_eff)) THEN
568  CALL l3interp(coretransp_in%VALUES(ival)%Tz_transp(iimp2)%vconv_eff(:,izimp2), rho2, nrho2, &
569  fun, rho1, nrho1)
570  coretransp_out%VALUES(1)%Tz_transp(iimp1)%vconv_eff(:,izimp1) = fun
571  END IF
572  END IF
573  END IF check_for_ionization_state_consistency
574 
575  END DO input_ionization_state
576  END DO output_ionization_state
577 
578  END IF check_for_impurity_consistency
579 
580  7 CONTINUE
581 
582  END DO input_impurity_loop
583  END DO output_impurity_loop
584 
585 
586  8 IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
587 
588  END DO loop_on_values
589 
590 
591 
592 
593 ! +++ Cut negative diffusion off:
594  IF (negative_diff.NE.0) THEN
595 
596  IF(ASSOCIATED(coretransp_out%VALUES(1)%ni_transp%diff_eff)) THEN
597  DO irho1=1,nrho1
598  DO icon=1,3
599  DO iion1=1,nion1
600  IF (coretransp_out%VALUES(1)%ni_transp%diff_eff(irho1,iion1,icon).LT.0.0_r8) &
601  coretransp_out%VALUES(1)%ni_transp%diff_eff(irho1,iion1,icon) = 0.0_r8
602  ENDDO
603  ENDDO
604  ENDDO
605  END IF
606 
607  IF(ASSOCIATED(coretransp_out%VALUES(1)%ne_transp%diff_eff)) THEN
608  DO irho1=1,nrho1
609  DO icon=1,3
610  IF (coretransp_out%VALUES(1)%ne_transp%diff_eff(irho1,icon).LT.0.0_r8) &
611  coretransp_out%VALUES(1)%ne_transp%diff_eff(irho1,icon) = 0.0_r8
612  ENDDO
613  ENDDO
614  END IF
615 
616  IF(ASSOCIATED(coretransp_out%VALUES(1)%ti_transp%diff_eff)) THEN
617  DO irho1=1,nrho1
618  DO iion1=1,nion1
619  IF (coretransp_out%VALUES(1)%ti_transp%diff_eff(irho1,iion1).LT.0.0_r8) &
620  coretransp_out%VALUES(1)%ti_transp%diff_eff(irho1,iion1) = 0.0_r8
621  ENDDO
622  ENDDO
623  END IF
624 
625  IF(ASSOCIATED(coretransp_out%VALUES(1)%te_transp%diff_eff)) THEN
626  DO irho1=1,nrho1
627  IF (coretransp_out%VALUES(1)%te_transp%diff_eff(irho1).LT.0.0_r8) &
628  coretransp_out%VALUES(1)%te_transp%diff_eff(irho1) = 0.0_r8
629  ENDDO
630  END IF
631 
632  IF(ASSOCIATED(coretransp_out%VALUES(1)%vtor_transp%diff_eff)) THEN
633  DO irho1=1,nrho1
634  DO iion1=1,nion1
635  IF (coretransp_out%VALUES(1)%vtor_transp%diff_eff(irho1,iion1).LT.0.0_r8) &
636  coretransp_out%VALUES(1)%vtor_transp%diff_eff(irho1,iion1) = 0.0_r8
637  ENDDO
638  ENDDO
639  END IF
640 
641  DO iimp1 = 1, nimp1
642  IF(ASSOCIATED(coretransp_out%VALUES(1)%Nz_transp)) THEN
643  IF (ASSOCIATED(coretransp_out%VALUES(1)%Nz_transp(iimp1)%diff_eff)) THEN
644  DO irho1=1,nrho1
645  DO izimp1=1,nzimp1(iimp1)
646  IF (coretransp_out%VALUES(1)%Nz_transp(iimp1)%diff_eff(irho1,izimp1).LT.0.0_r8) &
647  coretransp_out%VALUES(1)%Nz_transp(iimp1)%diff_eff(irho1,izimp1) = 0.0_r8
648  ENDDO
649  ENDDO
650  ENDIF
651  END IF
652 
653  IF(ASSOCIATED(coretransp_out%VALUES(1)%Tz_transp)) THEN
654  IF (ASSOCIATED(coretransp_out%VALUES(1)%Tz_transp(iimp1)%diff_eff)) THEN
655  DO irho1=1,nrho1
656  DO izimp1=1,nzimp1(iimp1)
657  IF (coretransp_out%VALUES(1)%Tz_transp(iimp1)%diff_eff(irho1,izimp1).LT.0.0_r8) &
658  coretransp_out%VALUES(1)%Tz_transp(iimp1)%diff_eff(irho1,izimp1) = 0.0_r8
659  ENDDO
660  ENDDO
661  ENDIF
662  END IF
663  ENDDO
664 
665  END IF
666 
667 
668 
669  IF(ALLOCATED (nzimp1)) DEALLOCATE (nzimp1)
670  IF(ALLOCATED (ncomp1)) DEALLOCATE (ncomp1)
671  IF(ALLOCATED (ntype1)) DEALLOCATE (ntype1)
672  IF(ALLOCATED (nzimp2)) DEALLOCATE (nzimp2)
673  IF(ALLOCATED (ncomp2)) DEALLOCATE (ncomp2)
674  IF(ALLOCATED (ntype2)) DEALLOCATE (ntype2)
675  IF(ALLOCATED (rho1)) DEALLOCATE (rho1)
676  IF(ALLOCATED (fun)) DEALLOCATE (fun)
677 
678 
679 
680 
681  10 RETURN
682 
683  END SUBROUTINE interpolate_transp
684 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
685 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
686 
687 
688 
689 
690 
691 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
692 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
693 
694  SUBROUTINE interpolate_prof(COREPROF_IN, COREPROF_OUT)
695 
696  USE euitm_schemas
697  USE itm_types
698  USE allocate_deallocate
699 
700  IMPLICIT NONE
701 
702  TYPE (type_coreprof) :: coreprof_in
703  TYPE (type_coreprof) :: coreprof_out
704 
705  INTEGER :: nrho1, nrho2
706  INTEGER :: irho1, irho2
707  INTEGER :: nnucl1,inucl1
708  INTEGER :: nnucl2,inucl2
709  INTEGER :: nion1, iion1
710  INTEGER :: nion2, iion2
711  INTEGER :: nimp1, iimp1
712  INTEGER :: nimp2, iimp2
713  INTEGER, ALLOCATABLE :: nzimp1(:)
714  INTEGER, ALLOCATABLE :: nzimp2(:)
715  INTEGER :: izimp1,izimp2
716  INTEGER :: nneut1,ineut1
717  INTEGER :: nneut2,ineut2
718  INTEGER, ALLOCATABLE :: ncomp1(:)
719  INTEGER, ALLOCATABLE :: ncomp2(:)
720  INTEGER, ALLOCATABLE :: ntype1(:)
721  INTEGER, ALLOCATABLE :: ntype2(:)
722 
723  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:),rho3(:)
724  REAL (R8) :: zmin1, zmin2
725  REAL (R8) :: zmax1, zmax2
726 
727  INTEGER :: negative_diff
728  INTEGER :: icon
729 
730 ! +++ Profile derivatives !AF 25.Apr.2016
731  INTEGER, PARAMETER :: calculate_derivatives_here = 1 !this is a temporarily solution to facilitate disabling the calculation of the derivatives from the !AF 25.Apr.2016
732  !input profiles, which finally should not be hardcoded here but controlled by the worlflow instead !AF 25.Apr.2016
733  REAL (R8), ALLOCATABLE :: y(:), dy(:) !AF 25.Apr.2016
734 
735 !==============================================
736 
737 
738 
739  nrho1 = SIZE(coreprof_out%rho_tor)
740  nrho2 = SIZE(coreprof_in%rho_tor)
741 
742  ALLOCATE (rho1(nrho1))
743  ALLOCATE (rho2(nrho2))
744  ALLOCATE (rho3(nrho1)) !to be used for derivative calculations
745 
746  ALLOCATE (y(nrho1)) !AF - 25.Apr.2016
747  ALLOCATE (dy(nrho1)) !AF - 25.Apr.2016
748 !dy interpolate on rhho_tor^2 to force zero derivative at edges
749  rho1 = coreprof_out%rho_tor*coreprof_out%rho_tor
750  rho2 = coreprof_in%rho_tor*coreprof_in%rho_tor
751  rho3 = coreprof_out%rho_tor
752 
753  CALL get_comp_dimensions(coreprof_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
754  CALL get_comp_dimensions(coreprof_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
755 
756 
757 
758 
759 ! +++ Initial values
760  coreprof_out%psi%value = 0.0_r8
761  coreprof_out%psi%ddrho = 0.0_r8 !AF - 25.Apr.2016
762  coreprof_out%ne%value = 0.0_r8
763  coreprof_out%ne%ddrho = 0.0_r8 !AF - 25.Apr.2016
764  coreprof_out%ne%flux%flux_dv = 0.0_r8
765  coreprof_out%te%value = 0.0_r8
766  coreprof_out%te%ddrho = 0.0_r8 !AF - 25.Apr.2016
767  coreprof_out%te%flux%flux_dv = 0.0_r8
768  coreprof_out%ni%value = 0.0_r8
769  coreprof_out%ni%ddrho = 0.0_r8 !AF - 25.Apr.2016
770  coreprof_out%ni%flux%flux_dv = 0.0_r8
771  coreprof_out%ti%value = 0.0_r8
772  coreprof_out%ti%ddrho = 0.0_r8 !AF - 25.Apr.2016
773  coreprof_out%ti%flux%flux_dv = 0.0_r8
774  coreprof_out%profiles1d%wtor%value = 0.0_r8
775  coreprof_out%vtor%value = 0.0_r8
776  coreprof_out%vtor%ddrho = 0.0_r8 !AF - 25.Apr.2016
777  coreprof_out%vtor%flux%flux_dv = 0.0_r8
778  coreprof_out%profiles1d%q%value = 0.0_r8
779  coreprof_out%profiles1d%zeff%value = 1.0_r8
780  coreprof_out%profiles1d%jtot%value = 0.0_r8
781  coreprof_out%profiles1d%jphi%value = 0.0_r8
782  coreprof_out%profiles1d%bpol%value = 0.0_r8
783  coreprof_out%profiles1d%eparallel%value = 0.0_r8
784  coreprof_out%psi%sigma_par%value = 0.0_r8
785 
786 
787 
788 
789 
790 ! +++ 1-D profiles
791  IF (ASSOCIATED(coreprof_in%psi%value)) &
792  CALL l3interp(coreprof_in%psi%value, rho2, nrho2, &
793  coreprof_out%psi%value, rho1, nrho1)
794  IF (ASSOCIATED(coreprof_in%psi%ddrho)) &
795  CALL l3interp(coreprof_in%psi%ddrho, rho2, nrho2, &
796  coreprof_out%psi%ddrho, rho1, nrho1)
797  IF (ASSOCIATED(coreprof_in%psi%sigma_par%value)) &
798  CALL l3interp(coreprof_in%psi%sigma_par%value, rho2, nrho2, &
799  coreprof_out%psi%sigma_par%value, rho1, nrho1)
800  IF (ASSOCIATED(coreprof_in%ne%value)) &
801  CALL l3interp(coreprof_in%ne%value, rho2, nrho2, &
802  coreprof_out%ne%value, rho1, nrho1)
803  IF (ASSOCIATED(coreprof_in%ne%ddrho)) &
804  CALL l3interp(coreprof_in%ne%ddrho, rho2, nrho2, &
805  coreprof_out%ne%ddrho, rho1, nrho1)
806  IF (ASSOCIATED(coreprof_in%ne%flux%flux_dv)) &
807  CALL l3interp(coreprof_in%ne%flux%flux_dv, rho2, nrho2, &
808  coreprof_out%ne%flux%flux_dv, rho1, nrho1)
809  IF (ASSOCIATED(coreprof_in%te%value)) &
810  CALL l3interp(coreprof_in%te%value, rho2, nrho2, &
811  coreprof_out%te%value, rho1, nrho1)
812  IF (ASSOCIATED(coreprof_in%te%ddrho)) &
813  CALL l3interp(coreprof_in%te%ddrho, rho2, nrho2, &
814  coreprof_out%te%ddrho, rho1, nrho1)
815  IF (ASSOCIATED(coreprof_in%te%flux%flux_dv)) &
816  CALL l3interp(coreprof_in%te%flux%flux_dv, rho2, nrho2, &
817  coreprof_out%te%flux%flux_dv, rho1, nrho1)
818 
819  IF (ASSOCIATED(coreprof_in%profiles1d%q%value)) &
820  CALL l3interp(coreprof_in%profiles1d%q%value, rho2, nrho2, &
821  coreprof_out%profiles1d%q%value, rho1, nrho1)
822  IF (ASSOCIATED(coreprof_in%profiles1d%zeff%value)) &
823  CALL l3interp(coreprof_in%profiles1d%zeff%value, rho2, nrho2, &
824  coreprof_out%profiles1d%zeff%value, rho1, nrho1)
825  IF (ASSOCIATED(coreprof_in%profiles1d%jtot%value)) &
826  CALL l3interp(coreprof_in%profiles1d%jtot%value, rho2, nrho2, &
827  coreprof_out%profiles1d%jtot%value, rho1, nrho1)
828  IF (ASSOCIATED(coreprof_in%profiles1d%jni%value)) &
829  CALL l3interp(coreprof_in%profiles1d%jni%value, rho2, nrho2, &
830  coreprof_out%profiles1d%jni%value, rho1, nrho1)
831  IF (ASSOCIATED(coreprof_in%profiles1d%joh%value)) &
832  CALL l3interp(coreprof_in%profiles1d%joh%value, rho2, nrho2, &
833  coreprof_out%profiles1d%joh%value, rho1, nrho1)
834  IF (ASSOCIATED(coreprof_in%profiles1d%vloop%value)) &
835  CALL l3interp(coreprof_in%profiles1d%vloop%value, rho2, nrho2, &
836  coreprof_out%profiles1d%vloop%value, rho1, nrho1)
837  IF (ASSOCIATED(coreprof_in%profiles1d%jphi%value)) &
838  CALL l3interp(coreprof_in%profiles1d%jphi%value, rho2, nrho2, &
839  coreprof_out%profiles1d%jphi%value, rho1, nrho1)
840  IF (ASSOCIATED(coreprof_in%profiles1d%pe%value)) &
841  CALL l3interp(coreprof_in%profiles1d%pe%value, rho2, nrho2, &
842  coreprof_out%profiles1d%pe%value, rho1, nrho1)
843  IF (ASSOCIATED(coreprof_in%profiles1d%pi_tot%value)) &
844  CALL l3interp(coreprof_in%profiles1d%pi_tot%value, rho2, nrho2, &
845  coreprof_out%profiles1d%pi_tot%value, rho1, nrho1)
846  IF (ASSOCIATED(coreprof_in%profiles1d%bpol%value)) &
847  CALL l3interp(coreprof_in%profiles1d%bpol%value, rho2, nrho2, &
848  coreprof_out%profiles1d%bpol%value, rho1, nrho1)
849  IF (ASSOCIATED(coreprof_in%profiles1d%eparallel%value)) &
850  CALL l3interp(coreprof_in%profiles1d%eparallel%value, rho2, nrho2, &
851  coreprof_out%profiles1d%eparallel%value, rho1, nrho1)
852 
853 
854 ! +++ IONS
855  output_ions_loop: DO iion1 = 1, nion1
856  inucl1 = coreprof_out%COMPOSITIONS%IONS(iion1)%nucindex
857  input_ions_loop: DO iion2 = 1, nion2
858  inucl2 = coreprof_in%COMPOSITIONS%IONS(iion2)%nucindex
859 
860  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coreprof_in%COMPOSITIONS%NUCLEI)) goto 5
861 
862  check_for_ions_consistency: IF &
863  (abs(coreprof_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coreprof_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
864  abs(coreprof_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coreprof_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
865  abs(coreprof_out%COMPOSITIONS%IONS(iion1)%zion - coreprof_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
866 ! Ni
867  IF (ASSOCIATED(coreprof_in%ni%value)) &
868  CALL l3interp(coreprof_in%ni%value(:,iion2), rho2, nrho2, &
869  coreprof_out%ni%value(:,iion1), rho1, nrho1)
870  IF (ASSOCIATED(coreprof_in%ni%ddrho)) &
871  CALL l3interp(coreprof_in%ni%ddrho(:,iion2), rho2, nrho2, &
872  coreprof_out%ni%ddrho(:,iion1), rho1, nrho1)
873  IF (ASSOCIATED(coreprof_in%ni%flux%flux_dv)) &
874  CALL l3interp(coreprof_in%ni%flux%flux_dv(:,iion2), rho2, nrho2, &
875  coreprof_out%ni%flux%flux_dv(:,iion1), rho1, nrho1)
876 ! Ti
877  IF (ASSOCIATED(coreprof_in%ti%value)) &
878  CALL l3interp(coreprof_in%ti%value(:,iion2), rho2, nrho2, &
879  coreprof_out%ti%value(:,iion1), rho1, nrho1)
880  IF (ASSOCIATED(coreprof_in%ti%ddrho)) &
881  CALL l3interp(coreprof_in%ti%ddrho(:,iion2), rho2, nrho2, &
882  coreprof_out%ti%ddrho(:,iion1), rho1, nrho1)
883  IF (ASSOCIATED(coreprof_in%ti%flux%flux_dv)) &
884  CALL l3interp(coreprof_in%ti%flux%flux_dv(:,iion2), rho2, nrho2, &
885  coreprof_out%ti%flux%flux_dv(:,iion1), rho1, nrho1)
886 ! Pi
887  IF (ASSOCIATED(coreprof_in%profiles1d%pi%value)) &
888  CALL l3interp(coreprof_in%profiles1d%pi%value(:,iion2), rho2, nrho2, &
889  coreprof_out%profiles1d%pi%value(:,iion1), rho1, nrho1)
890 ! Vtor
891  IF (ASSOCIATED(coreprof_in%vtor%value)) &
892  CALL l3interp(coreprof_in%vtor%value(:,iion2), rho2, nrho2, &
893  coreprof_out%vtor%value(:,iion1), rho1, nrho1)
894  IF (ASSOCIATED(coreprof_in%vtor%ddrho)) &
895  CALL l3interp(coreprof_in%vtor%ddrho(:,iion2), rho2, nrho2, &
896  coreprof_out%vtor%ddrho(:,iion1), rho1, nrho1)
897  IF (ASSOCIATED(coreprof_in%vtor%flux%flux_dv)) &
898  CALL l3interp(coreprof_in%vtor%flux%flux_dv(:,iion2), rho2, nrho2, &
899  coreprof_out%vtor%flux%flux_dv(:,iion1), rho1, nrho1)
900 ! Wtor
901  IF (ASSOCIATED(coreprof_in%profiles1d%wtor%value)) &
902  CALL l3interp(coreprof_in%profiles1d%wtor%value(:,iion2), rho2, nrho2, &
903  coreprof_out%profiles1d%wtor%value(:,iion1), rho1, nrho1)
904 
905 
906  END IF check_for_ions_consistency
907 
908  5 CONTINUE
909 
910  END DO input_ions_loop
911  END DO output_ions_loop
912 
913 
914  !AF - 25.Apr.2016
915 
916  IF (calculate_derivatives_here.EQ.1) THEN
917 !dy add rho1 for derivative calculation
918  !RHO1 = COREPROF_OUT%rho_tor
919  y = coreprof_out%ne%value
920  CALL derivn_start(nrho1,rho1,y,dy)
921  coreprof_out%ne%ddrho = dy*2.0*rho3
922 
923  y = coreprof_out%te%value
924  CALL derivn_start(nrho1,rho1,y,dy)
925  coreprof_out%te%ddrho = dy*2.0*rho3
926 
927  DO iion1 = 1, nion1
928 
929  y = coreprof_out%ni%value(:,iion1)
930  CALL derivn_start(nrho1,rho1,y,dy)
931  coreprof_out%ni%ddrho(:,iion1) = dy*2.0*rho3
932 
933  y = coreprof_out%ti%value(:,iion1)
934  CALL derivn_start(nrho1,rho1,y,dy)
935  coreprof_out%ti%ddrho(:,iion1) = dy*2.0*rho3
936 
937  END DO
938 
939  END IF
940 
941  !AF - 25.Apr.2016 - End
942 
943 
944  IF(ALLOCATED (nzimp1)) DEALLOCATE (nzimp1)
945  IF(ALLOCATED (ncomp1)) DEALLOCATE (ncomp1)
946  IF(ALLOCATED (ntype1)) DEALLOCATE (ntype1)
947  IF(ALLOCATED (nzimp2)) DEALLOCATE (nzimp2)
948  IF(ALLOCATED (ncomp2)) DEALLOCATE (ncomp2)
949  IF(ALLOCATED (ntype2)) DEALLOCATE (ntype2)
950  IF(ALLOCATED (rho1)) DEALLOCATE (rho1)
951  IF(ALLOCATED (rho2)) DEALLOCATE (rho2)
952  IF(ALLOCATED (rho3)) DEALLOCATE (rho3)
953 
954 
955  IF(ALLOCATED (y)) DEALLOCATE (y) !AF - 25.Apr.2016
956  IF(ALLOCATED (dy)) DEALLOCATE (dy) !AF - 25.Apr.2016
957 
958 
959  RETURN
960 
961  END SUBROUTINE interpolate_prof
962 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
963 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
964 
965 
966 
967 
968 
969 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
970 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
971 
972  SUBROUTINE interpolate_impur(COREIMPUR_IN, COREIMPUR_OUT)
973 
974  USE euitm_schemas
975  USE itm_types
976  USE allocate_deallocate
977 
978  IMPLICIT NONE
979 
980  TYPE (type_coreimpur) :: coreimpur_in
981  TYPE (type_coreimpur) :: coreimpur_out
982 
983  INTEGER :: nrho1, nrho2
984  INTEGER :: irho1, irho2
985  INTEGER :: nnucl1,inucl1
986  INTEGER :: nnucl2,inucl2
987  INTEGER :: nion1, iion1
988  INTEGER :: nion2, iion2
989  INTEGER :: nimp1, iimp1
990  INTEGER :: nimp2, iimp2
991  INTEGER, ALLOCATABLE :: nzimp1(:)
992  INTEGER, ALLOCATABLE :: nzimp2(:)
993  INTEGER :: izimp1,izimp2
994  INTEGER :: nneut1,ineut1
995  INTEGER :: nneut2,ineut2
996  INTEGER, ALLOCATABLE :: ncomp1(:)
997  INTEGER, ALLOCATABLE :: ncomp2(:)
998  INTEGER, ALLOCATABLE :: ntype1(:)
999  INTEGER, ALLOCATABLE :: ntype2(:)
1000 
1001  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1002  REAL (R8) :: zmin1, zmin2
1003  REAL (R8) :: zmax1, zmax2
1004 
1005 !==============================================
1006 
1007 
1008 
1009  nrho1 = SIZE(coreimpur_out%rho_tor)
1010  nrho2 = SIZE(coreimpur_in%rho_tor)
1011 
1012  ALLOCATE (rho1(nrho1))
1013  ALLOCATE (rho2(nrho2))
1014 
1015  rho1 = coreimpur_out%rho_tor
1016  rho2 = coreimpur_in%rho_tor
1017 
1018  CALL get_comp_dimensions(coreimpur_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
1019  CALL get_comp_dimensions(coreimpur_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
1020 
1021 
1022 
1023 ! +++ IMPURITY
1024  IF (nimp1*nimp2.LE.0) goto 8
1025  output_impurity_loop: DO iimp1 = 1, nimp1
1026  inucl1 = coreimpur_out%COMPOSITIONS%IMPURITIES(iimp1)%nucindex
1027 
1028 
1029  coreimpur_out%IMPURITY(iimp1)%nz = 0.0_r8
1030  coreimpur_out%IMPURITY(iimp1)%flux%flux_dv = 0.0_r8
1031 
1032  input_impurity_loop: DO iimp2 = 1, nimp2
1033  inucl2 = coreimpur_in%COMPOSITIONS%IMPURITIES(iimp2)%nucindex
1034 
1035  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coreimpur_in%COMPOSITIONS%NUCLEI)) goto 7
1036 
1037  check_impurity_consistency: IF &
1038  (abs(coreimpur_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coreimpur_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1039  abs(coreimpur_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coreimpur_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 ) THEN
1040 
1041  output_ionzation_state: DO izimp1 = 1, nzimp1(iimp1)
1042  input_ionzation_state: DO izimp2 = 1, nzimp2(iimp2)
1043 
1044  zmin1 = coreimpur_out%COMPOSITIONS%IMPURITIES(iimp1)%zmin(izimp1)
1045  zmax1 = coreimpur_out%COMPOSITIONS%IMPURITIES(iimp1)%zmax(izimp1)
1046  zmin2 = coreimpur_in%COMPOSITIONS%IMPURITIES(iimp2)%zmin(izimp2)
1047  zmax2 = coreimpur_in%COMPOSITIONS%IMPURITIES(iimp2)%zmax(izimp2)
1048 
1049  check_ionzation_state_consistency: if&
1050  (abs((zmax1+zmin1)/2.0 - (zmax2+zmin2)/2.0).LE. 0.25) THEN
1051 ! nz
1052  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%nz)) &
1053  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%nz(:,izimp2), rho2, nrho2, &
1054  coreimpur_out%IMPURITY(iimp1)%nz(:,izimp1), rho1, nrho1)
1055  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%flux%flux_dv)) &
1056  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%flux%flux_dv(:,izimp2), rho2, nrho2, &
1057  coreimpur_out%IMPURITY(iimp1)%flux%flux_dv(:,izimp1), rho1, nrho1)
1058 ! tz
1059  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%tz)) &
1060  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%tz(:,izimp2), rho2, nrho2, &
1061  coreimpur_out%IMPURITY(iimp1)%tz(:,izimp1), rho1, nrho1)
1062 ! z
1063  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%z)) &
1064  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%z(:,izimp2), rho2, nrho2, &
1065  coreimpur_out%IMPURITY(iimp1)%z(:,izimp1), rho1, nrho1)
1066 ! zsq
1067  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%zsq)) &
1068  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%zsq(:,izimp2), rho2, nrho2, &
1069  coreimpur_out%IMPURITY(iimp1)%zsq(:,izimp1), rho1, nrho1)
1070 ! radiation
1071  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%line_rad%profile)) &
1072  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%line_rad%profile(:,izimp2), rho2, nrho2, &
1073  coreimpur_out%IMPURITY(iimp1)%diagnostic%radiation%line_rad%profile(:,izimp1), rho1, nrho1)
1074  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%brem_radrec%profile)) &
1075  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%brem_radrec%profile(:,izimp2), rho2, nrho2, &
1076  coreimpur_out%IMPURITY(iimp1)%diagnostic%radiation%brem_radrec%profile(:,izimp1), rho1, nrho1)
1077  IF(ASSOCIATED(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%sum%profile)) &
1078  CALL l3interp(coreimpur_in%IMPURITY(iimp2)%diagnostic%radiation%sum%profile(:,izimp2), rho2, nrho2, &
1079  coreimpur_out%IMPURITY(iimp1)%diagnostic%radiation%sum%profile(:,izimp1), rho1, nrho1)
1080  END IF check_ionzation_state_consistency
1081 
1082  END DO input_ionzation_state
1083  END DO output_ionzation_state
1084 
1085  ENDIF check_impurity_consistency
1086 
1087 7 CONTINUE
1088 
1089  END DO input_impurity_loop
1090  END DO output_impurity_loop
1091 
1092 
1093 
1094 
1095 
1096 
1097 
1098 
1099 8 IF(ALLOCATED(nzimp1)) DEALLOCATE (nzimp1)
1100  IF(ALLOCATED(ncomp1)) DEALLOCATE (ncomp1)
1101  IF(ALLOCATED(ntype1)) DEALLOCATE (ntype1)
1102  IF(ALLOCATED(nzimp2)) DEALLOCATE (nzimp2)
1103  IF(ALLOCATED(ncomp2)) DEALLOCATE (ncomp2)
1104  IF(ALLOCATED(ntype2)) DEALLOCATE (ntype2)
1105 
1106  IF(ALLOCATED(rho1)) DEALLOCATE (rho1)
1107  IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
1108 
1109 
1110 
1111  RETURN
1112 
1113  END SUBROUTINE interpolate_impur
1114 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1115 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1116 
1117 
1118 
1119 
1120 
1121 
1122 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1123 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1124 
1125  SUBROUTINE interpolate_neutrals(CORENEUTRALS_IN, CORENEUTRALS_OUT)
1126 
1127  USE euitm_schemas
1128  USE itm_types
1129  USE allocate_deallocate
1130 
1131  IMPLICIT NONE
1132 
1133  TYPE (type_coreneutrals) :: coreneutrals_in
1134  TYPE (type_coreneutrals) :: coreneutrals_out
1135 
1136  INTEGER :: nrho1, nrho2
1137  INTEGER :: irho1, irho2
1138  INTEGER :: nnucl1,inucl1
1139  INTEGER :: nnucl2,inucl2
1140  INTEGER :: nion1
1141  INTEGER :: nion2
1142  INTEGER :: nimp1
1143  INTEGER :: nimp2
1144  INTEGER, ALLOCATABLE :: nzimp1(:)
1145  INTEGER, ALLOCATABLE :: nzimp2(:)
1146  INTEGER :: nneut1,ineut1
1147  INTEGER :: nneut2,ineut2
1148  INTEGER, ALLOCATABLE :: ncomp1(:)
1149  INTEGER, ALLOCATABLE :: ncomp2(:)
1150  INTEGER, ALLOCATABLE :: ntype1(:)
1151  INTEGER, ALLOCATABLE :: ntype2(:)
1152  INTEGER :: itype1,icomp1
1153  INTEGER :: itype2,icomp2
1154 
1155  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1156 
1157 !==============================================
1158 
1159 
1160 
1161  nrho1 = SIZE(coreneutrals_out%rho_tor)
1162  nrho2 = SIZE(coreneutrals_in%rho_tor)
1163 
1164  ALLOCATE (rho1(nrho1))
1165  ALLOCATE (rho2(nrho2))
1166 
1167  rho1 = coreneutrals_out%rho_tor
1168  rho2 = coreneutrals_in%rho_tor
1169 
1170  CALL get_comp_dimensions(coreneutrals_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
1171  CALL get_comp_dimensions(coreneutrals_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
1172 
1173 
1174 
1175 
1176 ! +++ NEUTRALS
1177 
1178  DO ineut1 = 1, nneut1
1179  DO icomp1 = 1, ncomp1(ineut1)
1180  inucl1 = coreneutrals_out%COMPOSITIONS%NEUTRALSCOMP(ineut1)%NEUTCOMP(icomp1)%nucindex
1181 
1182  DO ineut2 = 1, nneut2
1183  DO icomp2 = 1, ncomp2(ineut2)
1184  inucl2 = coreneutrals_in%COMPOSITIONS%NEUTRALSCOMP(ineut2)%NEUTCOMP(icomp2)%nucindex
1185 
1186  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coreneutrals_in%COMPOSITIONS%NUCLEI)) goto 7
1187 
1188 
1189  IF (abs(coreneutrals_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coreneutrals_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1190  abs(coreneutrals_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coreneutrals_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
1191  (coreneutrals_out%COMPOSITIONS%NEUTRALSCOMP(ineut1)%NEUTCOMP(icomp1)%multiplicity .EQ. &
1192  coreneutrals_in%COMPOSITIONS%NEUTRALSCOMP(ineut2)%NEUTCOMP(icomp2)%multiplicity) ) THEN
1193 
1194  DO itype1 = 1, ntype1(ineut1)
1195  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%n0%value(:) = 0.0_r8
1196  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%t0%value(:) = 0.0_r8
1197  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%toroidal%value(:) = 0.0_r8
1198  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%poloidal%value(:) = 0.0_r8
1199  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%radial%value(:) = 0.0_r8
1200 
1201 
1202  DO itype2 = 1, ntype2(ineut2)
1203 
1204  IF (coreneutrals_in%COMPOSITIONS%NEUTRALSCOMP(ineut2)%TYPE(itype2)%flag .EQ. &
1205  coreneutrals_out%COMPOSITIONS%NEUTRALSCOMP(ineut1)%TYPE(itype1)%flag ) THEN
1206 
1207  CALL l3interp(coreneutrals_in%PROFILES(ineut2)%neutraltype(itype2)%n0%value(:), rho2, nrho2,&
1208  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%n0%value(:), rho1, nrho1)
1209 
1210  CALL l3interp(coreneutrals_in%PROFILES(ineut2)%neutraltype(itype2)%t0%value(:), rho2, nrho2,&
1211  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%t0%value(:), rho1, nrho1)
1212 
1213  CALL l3interp(coreneutrals_in%PROFILES(ineut2)%neutraltype(itype2)%v0%toroidal%value(:), rho2, nrho2,&
1214  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%toroidal%value(:), rho1, nrho1)
1215 
1216  CALL l3interp(coreneutrals_in%PROFILES(ineut2)%neutraltype(itype2)%v0%poloidal%value(:), rho2, nrho2,&
1217  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%poloidal%value(:), rho1, nrho1)
1218 
1219  CALL l3interp(coreneutrals_in%PROFILES(ineut2)%neutraltype(itype2)%v0%radial%value(:), rho2, nrho2,&
1220  coreneutrals_out%PROFILES(ineut1)%neutraltype(itype1)%v0%radial%value(:), rho1, nrho1)
1221 
1222  END IF
1223  END DO
1224  END DO
1225 
1226  END IF
1227 
1228  7 CONTINUE
1229 
1230  END DO
1231  END DO
1232  END DO
1233  END DO
1234 
1235 
1236 
1237 
1238  IF(ALLOCATED(nzimp1)) DEALLOCATE (nzimp1)
1239  IF(ALLOCATED(ncomp1)) DEALLOCATE (ncomp1)
1240  IF(ALLOCATED(ntype1)) DEALLOCATE (ntype1)
1241  IF(ALLOCATED(nzimp2)) DEALLOCATE (nzimp2)
1242  IF(ALLOCATED(ncomp2)) DEALLOCATE (ncomp2)
1243  IF(ALLOCATED(ntype2)) DEALLOCATE (ntype2)
1244  IF(ALLOCATED(rho1)) DEALLOCATE (rho1)
1245  IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
1246 
1247 
1248 
1249  RETURN
1250 
1251  END SUBROUTINE interpolate_neutrals
1252 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1253 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1254 
1255 
1256 
1257 
1258 
1259 
1260 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1261 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1262 
1263  SUBROUTINE interpolate_neoclassic(NEOCLASSIC_IN, NEOCLASSIC_OUT)
1264 
1265  USE euitm_schemas
1266  USE itm_types
1267  USE allocate_deallocate
1268 
1269  IMPLICIT NONE
1270 
1271  TYPE (type_neoclassic) :: neoclassic_in
1272  TYPE (type_neoclassic) :: neoclassic_out
1273 
1274  INTEGER :: nrho1, nrho2
1275  INTEGER :: irho1, irho2
1276  INTEGER :: nnucl1,inucl1
1277  INTEGER :: nnucl2,inucl2
1278  INTEGER :: nion1, iion1
1279  INTEGER :: nion2, iion2
1280  INTEGER :: nimp1, iimp1
1281  INTEGER :: nimp2, iimp2
1282  INTEGER, ALLOCATABLE :: nzimp1(:)
1283  INTEGER, ALLOCATABLE :: nzimp2(:)
1284  INTEGER :: izimp1,izimp2
1285  INTEGER :: nneut1,ineut1
1286  INTEGER :: nneut2,ineut2
1287  INTEGER, ALLOCATABLE :: ncomp1(:)
1288  INTEGER, ALLOCATABLE :: ncomp2(:)
1289  INTEGER, ALLOCATABLE :: ntype1(:)
1290  INTEGER, ALLOCATABLE :: ntype2(:)
1291 
1292  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1293  REAL (R8) :: zmin1, zmin2
1294  REAL (R8) :: zmax1, zmax2
1295 
1296 !==============================================
1297 
1298 
1299 
1300  nrho1 = SIZE(neoclassic_out%rho_tor)
1301  nrho2 = SIZE(neoclassic_in%rho_tor)
1302 
1303  ALLOCATE (rho1(nrho1))
1304  ALLOCATE (rho2(nrho2))
1305 
1306  rho1 = neoclassic_out%rho_tor
1307  rho2 = neoclassic_in%rho_tor
1308 
1309  CALL get_comp_dimensions(neoclassic_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
1310  CALL get_comp_dimensions(neoclassic_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
1311 
1312 
1313 
1314 ! +++ Nullify initial profiles
1315  neoclassic_out%sigma = 0.0_r8
1316  neoclassic_out%jboot = 0.0_r8
1317  neoclassic_out%er = 0.0_r8
1318  neoclassic_out%vpol = 0.0_r8
1319  neoclassic_out%Ne_neo%diff_eff = 0.0_r8
1320  neoclassic_out%Ne_neo%vconv_eff = 0.0_r8
1321  neoclassic_out%Te_neo%diff_eff = 0.0_r8
1322  neoclassic_out%Te_neo%vconv_eff = 0.0_r8
1323  neoclassic_out%Mtor_neo%diff_eff = 0.0_r8
1324  neoclassic_out%Mtor_neo%vconv_eff = 0.0_r8
1325 
1326 
1327 
1328 ! sigma
1329  IF(ASSOCIATED(neoclassic_in%sigma)) &
1330  CALL l3interp(neoclassic_in%sigma, rho2, nrho2, &
1331  neoclassic_out%sigma, rho1, nrho1)
1332 
1333 ! jboot
1334  IF(ASSOCIATED(neoclassic_in%jboot)) &
1335  CALL l3interp(neoclassic_in%jboot, rho2, nrho2, &
1336  neoclassic_out%jboot, rho1, nrho1)
1337 
1338 ! er
1339  IF(ASSOCIATED(neoclassic_in%er)) &
1340  CALL l3interp(neoclassic_in%er, rho2, nrho2, &
1341  neoclassic_out%er, rho1, nrho1)
1342 
1343 ! vpol
1344  IF(ASSOCIATED(neoclassic_in%vpol)) &
1345  CALL l3interp(neoclassic_in%vpol, rho2, nrho2, &
1346  neoclassic_out%vpol, rho1, nrho1)
1347 
1348 ! Ne
1349  IF(ASSOCIATED(neoclassic_in%Ne_neo%diff_eff)) &
1350  CALL l3interp(neoclassic_in%Ne_neo%diff_eff, rho2, nrho2, &
1351  neoclassic_out%Ne_neo%diff_eff, rho1, nrho1)
1352  IF(ASSOCIATED(neoclassic_in%Ne_neo%vconv_eff)) &
1353  CALL l3interp(neoclassic_in%Ne_neo%vconv_eff, rho2, nrho2, &
1354  neoclassic_out%Ne_neo%vconv_eff, rho1, nrho1)
1355 
1356 ! Te
1357  IF(ASSOCIATED(neoclassic_in%Te_neo%diff_eff)) &
1358  CALL l3interp(neoclassic_in%Te_neo%diff_eff, rho2, nrho2, &
1359  neoclassic_out%Te_neo%diff_eff, rho1, nrho1)
1360  IF(ASSOCIATED(neoclassic_in%Te_neo%vconv_eff)) &
1361  CALL l3interp(neoclassic_in%Te_neo%vconv_eff, rho2, nrho2, &
1362  neoclassic_out%Te_neo%vconv_eff, rho1, nrho1)
1363 ! Mtor
1364  IF(ASSOCIATED(neoclassic_in%mtor_neo%diff_eff)) &
1365  CALL l3interp(neoclassic_in%mtor_neo%diff_eff, rho2, nrho2, &
1366  neoclassic_out%mtor_neo%diff_eff, rho1, nrho1)
1367  IF(ASSOCIATED(neoclassic_in%mtor_neo%vconv_eff)) &
1368  CALL l3interp(neoclassic_in%mtor_neo%vconv_eff, rho2, nrho2, &
1369  neoclassic_out%mtor_neo%vconv_eff, rho1, nrho1)
1370 
1371 
1372 
1373 ! +++ IONS
1374  neoclassic_out%ni_neo%diff_eff = 0.0_r8
1375  neoclassic_out%ni_neo%vconv_eff = 0.0_r8
1376  neoclassic_out%Ti_neo%diff_eff = 0.0_r8
1377  neoclassic_out%Ti_neo%vconv_eff = 0.0_r8
1378 
1379 
1380 
1381  output_ion_loop: DO iion1 = 1, nion1
1382  inucl1 = neoclassic_out%COMPOSITIONS%IONS(iion1)%nucindex
1383  input_ion_loop: DO iion2 = 1, nion2
1384  inucl2 = neoclassic_in%COMPOSITIONS%IONS(iion2)%nucindex
1385 
1386  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(neoclassic_in%COMPOSITIONS%NUCLEI)) goto 5
1387 
1388  check_for_ions_consistency: IF &
1389  (abs(neoclassic_out%COMPOSITIONS%NUCLEI(inucl1)%amn - neoclassic_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1390  abs(neoclassic_out%COMPOSITIONS%NUCLEI(inucl1)%zn - neoclassic_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
1391  abs(neoclassic_out%COMPOSITIONS%IONS(iion1)%zion - neoclassic_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
1392 ! Ni
1393  IF(ASSOCIATED(neoclassic_in%ni_neo%diff_eff)) &
1394  CALL l3interp(neoclassic_in%ni_neo%diff_eff(:,iion2), rho2, nrho2, &
1395  neoclassic_out%ni_neo%diff_eff(:,iion1), rho1, nrho1)
1396  IF(ASSOCIATED(neoclassic_in%ni_neo%vconv_eff)) &
1397  CALL l3interp(neoclassic_in%ni_neo%vconv_eff(:,iion2), rho2, nrho2, &
1398  neoclassic_out%ni_neo%vconv_eff(:,iion1), rho1, nrho1)
1399 
1400 ! Ti
1401  IF(ASSOCIATED(neoclassic_in%ti_neo%diff_eff)) &
1402  CALL l3interp(neoclassic_in%ti_neo%diff_eff(:,iion2), rho2, nrho2, &
1403  neoclassic_out%ti_neo%diff_eff(:,iion1), rho1, nrho1)
1404  IF(ASSOCIATED(neoclassic_in%ti_neo%vconv_eff)) &
1405  CALL l3interp(neoclassic_in%ti_neo%vconv_eff(:,iion2), rho2, nrho2, &
1406  neoclassic_out%ti_neo%vconv_eff(:,iion1), rho1, nrho1)
1407 
1408  END IF check_for_ions_consistency
1409 
1410  5 CONTINUE
1411 
1412  END DO input_ion_loop
1413  END DO output_ion_loop
1414 
1415 
1416 
1417 
1418 ! +++ IMPURITY
1419  IF (nimp1*nimp2.LE.0) goto 8
1420  output_impurity_loop: DO iimp1 = 1, nimp1
1421  inucl1 = neoclassic_out%COMPOSITIONS%IMPURITIES(iimp1)%nucindex
1422 
1423  neoclassic_out%Nz_neo(iimp1)%diff_eff = 0.0_r8
1424  neoclassic_out%Nz_neo(iimp1)%vconv_eff = 0.0_r8
1425  neoclassic_out%Tz_neo(iimp1)%diff_eff = 0.0_r8
1426  neoclassic_out%Tz_neo(iimp1)%vconv_eff = 0.0_r8
1427 
1428  input_impurity_loop: DO iimp2 = 1, nimp2
1429  inucl2 = neoclassic_in%COMPOSITIONS%IMPURITIES(iimp2)%nucindex
1430 
1431  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(neoclassic_in%COMPOSITIONS%NUCLEI)) goto 7
1432 
1433  check_for_impurity_consistency: IF &
1434  (abs(neoclassic_out%COMPOSITIONS%NUCLEI(inucl1)%amn - neoclassic_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1435  abs(neoclassic_out%COMPOSITIONS%NUCLEI(inucl1)%zn - neoclassic_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 ) THEN
1436 
1437  output_ionization_states: DO izimp1 = 1, nzimp1(iimp1)
1438  input_ionization_states: DO izimp2 = 1, nzimp2(iimp2)
1439 
1440  zmin1 = neoclassic_out%COMPOSITIONS%IMPURITIES(iimp1)%zmin(izimp1)
1441  zmax1 = neoclassic_out%COMPOSITIONS%IMPURITIES(iimp1)%zmax(izimp1)
1442  zmin2 = neoclassic_in%COMPOSITIONS%IMPURITIES(iimp2)%zmin(izimp2)
1443  zmax2 = neoclassic_in%COMPOSITIONS%IMPURITIES(iimp2)%zmax(izimp2)
1444 
1445  IF(abs((zmax1+zmin1)/2.0 - (zmax2+zmin2)/2.0).LE. 0.25) THEN
1446 ! nz
1447  IF(ASSOCIATED(neoclassic_in%Nz_neo)) THEN
1448  IF(ASSOCIATED(neoclassic_in%Nz_neo(iimp2)%diff_eff)) &
1449  CALL l3interp(neoclassic_in%Nz_neo(iimp2)%diff_eff(:,izimp2), rho2, nrho2, &
1450  neoclassic_out%Nz_neo(iimp1)%diff_eff(:,izimp1), rho1, nrho1)
1451  IF(ASSOCIATED(neoclassic_in%Nz_neo(iimp2)%vconv_eff)) &
1452  CALL l3interp(neoclassic_in%Nz_neo(iimp2)%vconv_eff(:,izimp2), rho2, nrho2, &
1453  neoclassic_out%Nz_neo(iimp1)%vconv_eff(:,izimp1), rho1, nrho1)
1454  END IF
1455 ! Tz
1456  IF(ASSOCIATED(neoclassic_in%Tz_neo)) THEN
1457  IF(ASSOCIATED(neoclassic_in%Tz_neo(iimp2)%diff_eff)) &
1458  CALL l3interp(neoclassic_in%Tz_neo(iimp2)%diff_eff(:,izimp2), rho2, nrho2, &
1459  neoclassic_out%Tz_neo(iimp1)%diff_eff(:,izimp1), rho1, nrho1)
1460  IF(ASSOCIATED(neoclassic_in%Tz_neo(iimp2)%vconv_eff)) &
1461  CALL l3interp(neoclassic_in%Tz_neo(iimp2)%vconv_eff(:,izimp2), rho2, nrho2, &
1462  neoclassic_out%Tz_neo(iimp1)%vconv_eff(:,izimp1), rho1, nrho1)
1463  END IF
1464  ENDIF
1465 
1466  END DO input_ionization_states
1467  END DO output_ionization_states
1468 
1469  END IF check_for_impurity_consistency
1470 
1471  7 CONTINUE
1472 
1473  END DO input_impurity_loop
1474  END DO output_impurity_loop
1475 
1476 
1477 
1478 
1479 
1480  8 IF(ALLOCATED(nzimp1)) DEALLOCATE (nzimp1)
1481  IF(ALLOCATED(ncomp1)) DEALLOCATE (ncomp1)
1482  IF(ALLOCATED(ntype1)) DEALLOCATE (ntype1)
1483  IF(ALLOCATED(nzimp2)) DEALLOCATE (nzimp2)
1484  IF(ALLOCATED(ncomp2)) DEALLOCATE (ncomp2)
1485  IF(ALLOCATED(ntype2)) DEALLOCATE (ntype2)
1486  IF(ALLOCATED(rho1)) DEALLOCATE (rho1)
1487  IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
1488 
1489 
1490 
1491  RETURN
1492 
1493  END SUBROUTINE interpolate_neoclassic
1494 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1495 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1496 
1497 
1498 !AF - 25.Apr.2016 - to get the profile derivatives at the start of the run by derivating the profiles (and ignoring derivatives in the input run if they exist)
1499 
1500 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1509 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1510 
1511 SUBROUTINE derivn_start(N,X,Y,DY1)
1512 
1513 !-------------------------------------------------------!
1514 ! These subroutines calculate first and second !
1515 ! derivatives, DY1 and DY2, of function Y respect !
1516 ! to argument X !
1517 !-------------------------------------------------------!
1518 
1519  use itm_types
1520  IMPLICIT NONE
1521 
1522  INTEGER :: n ! number of radial points (input)
1523  INTEGER :: i
1524 
1525  REAL (R8) :: x(n), & ! argument array (input)
1526  y(n), & ! function array (input)
1527  dy1(n) ! function derivative array (output)
1528  REAL (R8) :: h(n),dy2(n)
1529 
1530  REAL (R8) :: ddy !AF 6.Oct.2011
1531 
1532  DO i=1,n-1
1533  h(i)=x(i+1)-x(i)
1534  END DO
1535 
1536  DO i=2,n-1
1537  dy1(i)=((y(i+1)-y(i))*h(i-1)/h(i)+(y(i)-y(i-1))*h(i)/h(i-1)) &
1538  /(h(i)+h(i-1))
1539 ! DY2(I)=2.e0_R8*((Y(I-1)-Y(I))/H(I-1)+(Y(I+1)-Y(I))/H(I)) & !AF 6.Oct.2011
1540 ! /(H(I)+H(I-1))
1541  END DO
1542 
1543 ! DY1(1)=DY1(2)-DY2(2)*H(1) !AF 6.Oct.2011
1544 ! DY1(N)=DY1(N-1)+DY2(N-1)*H(N-1) !AF 6.Oct.2011
1545 
1546  ddy = 2.e0_r8*((y(1)-y(2))/h(1)+(y(3)-y(2))/h(2))/(h(2)+h(1))
1547  dy1(1) = dy1(2)-ddy*h(1)
1548  ddy = 2.e0_r8*((y(n-2)-y(n-1))/h(n-2)+(y(n)-y(n-1))/h(n-1))/(h(n-1)+h(n-2))
1549  dy1(n) = dy1(n-1)+ddy*h(n-1)
1550 
1551  RETURN
1552 END SUBROUTINE derivn_start
1553 
1554 
1555 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1556 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1557 
1558  SUBROUTINE interpolate_delta(COREDELTA_IN, COREDELTA_OUT)
1559 
1560  USE euitm_schemas
1561  USE itm_types
1562  USE allocate_deallocate
1563 
1564  IMPLICIT NONE
1565 
1566  TYPE (type_coredelta) :: coredelta_in
1567  TYPE (type_coredelta) :: coredelta_out
1568 
1569  INTEGER :: nval1, nval2
1570  INTEGER :: ival
1571  INTEGER :: nrho1, nrho2
1572  INTEGER :: irho1, irho2
1573  INTEGER :: nnucl1,inucl1
1574  INTEGER :: nnucl2,inucl2
1575  INTEGER :: nion1, iion1
1576  INTEGER :: nion2, iion2
1577  INTEGER :: nimp1, iimp1
1578  INTEGER :: nimp2, iimp2
1579  INTEGER, ALLOCATABLE :: nzimp1(:)
1580  INTEGER, ALLOCATABLE :: nzimp2(:)
1581  INTEGER :: izimp1,izimp2
1582  INTEGER :: nneut1,ineut1
1583  INTEGER :: nneut2,ineut2
1584  INTEGER, ALLOCATABLE :: ncomp1(:)
1585  INTEGER, ALLOCATABLE :: ncomp2(:)
1586  INTEGER, ALLOCATABLE :: ntype1(:)
1587  INTEGER, ALLOCATABLE :: ntype2(:)
1588 
1589  REAL (R8), ALLOCATABLE :: fun(:)
1590  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1591  REAL (R8) :: zmin1, zmin2
1592  REAL (R8) :: zmax1, zmax2
1593 !==============================================
1594 
1595  nval1 = 1
1596  nval2 = SIZE(coredelta_in%VALUES)
1597 
1598 
1599  nrho1 = SIZE(coredelta_out%VALUES(1)%rho_tor)
1600 
1601  ALLOCATE (fun(nrho1))
1602  ALLOCATE (rho1(nrho1))
1603 
1604  rho1 = coredelta_out%VALUES(1)%rho_tor
1605 
1606  CALL get_comp_dimensions(coredelta_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
1607  CALL get_comp_dimensions(coredelta_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
1608 
1609  IF(.NOT.ASSOCIATED(coredelta_in%VALUES)) goto 10
1610 
1611 
1612 ! +++ Nulify initial profiles:
1613  coredelta_out%VALUES(1)%delta_psi = 0.0_r8
1614  coredelta_out%VALUES(1)%delta_te = 0.0_r8
1615  coredelta_out%VALUES(1)%delta_ti = 0.0_r8
1616  coredelta_out%VALUES(1)%delta_ne = 0.0_r8
1617  coredelta_out%VALUES(1)%delta_ni = 0.0_r8
1618  coredelta_out%VALUES(1)%delta_vtor = 0.0_r8
1619  IF (nimp1.GE.1) THEN
1620  DO iimp1 = 1, nimp1
1621  coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_nz = 0.0_r8
1622  coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_tz = 0.0_r8
1623  END DO
1624  END IF
1625 
1626 ! +++ Check information saved to different VALUES:
1627  loop_on_values: DO ival = 1, nval2
1628  nrho2 = SIZE(coredelta_in%VALUES(ival)%rho_tor)
1629  ALLOCATE (rho2(nrho2))
1630  rho2 = coredelta_in%VALUES(ival)%rho_tor
1631 
1632 
1633 
1634 ! psi
1635  fun(:) = 0.0_r8
1636  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_psi)) THEN
1637  CALL l3interp(coredelta_in%VALUES(ival)%delta_psi, rho2, nrho2, &
1638  fun, rho1, nrho1)
1639  coredelta_out%VALUES(1)%delta_psi = coredelta_out%VALUES(1)%delta_psi + fun
1640  END IF
1641 
1642 ! Te
1643  fun(:) = 0.0_r8
1644  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_te)) THEN
1645  CALL l3interp(coredelta_in%VALUES(ival)%delta_te, rho2, nrho2, &
1646  fun, rho1, nrho1)
1647  coredelta_out%VALUES(1)%delta_te = coredelta_out%VALUES(1)%delta_te + fun
1648  END IF
1649 
1650 ! Ne
1651  fun(:) = 0.0_r8
1652  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_ne)) THEN
1653  CALL l3interp(coredelta_in%VALUES(ival)%delta_ne, rho2, nrho2, &
1654  fun, rho1, nrho1)
1655  coredelta_out%VALUES(1)%delta_ne = coredelta_out%VALUES(1)%delta_ne + fun
1656  END IF
1657 
1658 
1659 
1660 ! +++ IONS
1661  output_ion_loop: DO iion1 = 1, nion1
1662  inucl1 = coredelta_out%COMPOSITIONS%IONS(iion1)%nucindex
1663  input_ion_loop:DO iion2 = 1, nion2
1664  inucl2 = coredelta_in%COMPOSITIONS%IONS(iion2)%nucindex
1665 
1666  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coredelta_in%COMPOSITIONS%NUCLEI)) goto 5
1667 
1668  check_for_ions_consistency: IF &
1669  (abs(coredelta_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coredelta_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1670  abs(coredelta_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coredelta_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
1671  abs(coredelta_out%COMPOSITIONS%IONS(iion1)%zion - coredelta_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
1672 ! Ni
1673  fun(:) = 0.0_r8
1674  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_ni)) THEN
1675  CALL l3interp(coredelta_in%VALUES(ival)%delta_ni(:,iion2), rho2, nrho2, &
1676  fun, rho1, nrho1)
1677  coredelta_out%VALUES(1)%delta_ni(:,iion1) = coredelta_out%VALUES(1)%delta_ni(:,iion1) + fun
1678  END IF
1679 
1680 ! Ti
1681  fun(:) = 0.0_r8
1682  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_ti)) THEN
1683  CALL l3interp(coredelta_in%VALUES(ival)%delta_ti(:,iion2), rho2, nrho2, &
1684  fun, rho1, nrho1)
1685  coredelta_out%VALUES(1)%delta_ti(:,iion1) = coredelta_out%VALUES(1)%delta_ti(:,iion1) + fun
1686  END IF
1687 ! Vtor
1688  fun(:) = 0.0_r8
1689  IF(ASSOCIATED(coredelta_in%VALUES(ival)%delta_vtor)) THEN
1690  CALL l3interp(coredelta_in%VALUES(ival)%delta_vtor(:,iion2),rho2, nrho2, &
1691  fun, rho1, nrho1)
1692  coredelta_out%VALUES(1)%delta_vtor(:,iion1) = coredelta_out%VALUES(1)%delta_vtor(:,iion1) + fun
1693  END IF
1694  END IF check_for_ions_consistency
1695 
1696 
1697 5 CONTINUE
1698 
1699  END DO input_ion_loop
1700  END DO output_ion_loop
1701 
1702 
1703 
1704 
1705 ! IMPURITY:
1706  IF (nimp1*nimp2.LE.0) goto 8
1707  output_impurity_loop: DO iimp1 = 1, nimp1
1708  inucl1 = coredelta_out%COMPOSITIONS%IMPURITIES(iimp1)%nucindex
1709 
1710  input_impurity_loop: DO iimp2 = 1, nimp2
1711  inucl2 = coredelta_in%COMPOSITIONS%IMPURITIES(iimp2)%nucindex
1712 
1713  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(coredelta_in%COMPOSITIONS%NUCLEI)) goto 7
1714 
1715  check_for_impurity_consistency: IF &
1716  (abs(coredelta_out%COMPOSITIONS%NUCLEI(inucl1)%amn - coredelta_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1717  abs(coredelta_out%COMPOSITIONS%NUCLEI(inucl1)%zn - coredelta_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 ) THEN
1718 
1719  output_ionization_states: DO izimp1 = 1, nzimp1(iimp1)
1720  input_ionization_states: DO izimp2 = 1, nzimp2(iimp2)
1721 
1722  zmin1 = coredelta_out%COMPOSITIONS%IMPURITIES(iimp1)%zmin(izimp1)
1723  zmax1 = coredelta_out%COMPOSITIONS%IMPURITIES(iimp1)%zmax(izimp1)
1724  zmin2 = coredelta_in%COMPOSITIONS%IMPURITIES(iimp2)%zmin(izimp2)
1725  zmax2 = coredelta_in%COMPOSITIONS%IMPURITIES(iimp2)%zmax(izimp2)
1726 
1727  IF(abs((zmax1+zmin1)/2.0 - (zmax2+zmin2)/2.0).LE. 0.25) THEN
1728  IF(ASSOCIATED(coredelta_in%VALUES(ival)%IMPURITY)) THEN
1729 ! nz
1730  fun(:) = 0.0_r8
1731  IF(ASSOCIATED(coredelta_in%VALUES(ival)%IMPURITY(iimp2)%delta_nz)) THEN
1732  CALL l3interp(coredelta_in%VALUES(ival)%IMPURITY(iimp2)%delta_nz(:,izimp2), rho2, nrho2, &
1733  fun, rho1, nrho1)
1734  coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_nz(:,izimp1) = coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_nz(:,izimp1) + fun
1735  END IF
1736 ! tz
1737  fun(:) = 0.0_r8
1738  IF(ASSOCIATED(coredelta_in%VALUES(ival)%IMPURITY(iimp2)%delta_tz)) THEN
1739  CALL l3interp(coredelta_in%VALUES(ival)%IMPURITY(iimp2)%delta_tz(:,izimp2), rho2, nrho2, &
1740  fun, rho1, nrho1)
1741  coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_tz(:,izimp1) = coredelta_out%VALUES(1)%IMPURITY(iimp1)%delta_tz(:,izimp1) + fun
1742  END IF
1743  END IF
1744  END IF
1745 
1746  END DO input_ionization_states
1747  END DO output_ionization_states
1748 
1749  END IF check_for_impurity_consistency
1750 
1751 7 CONTINUE
1752 
1753  END DO input_impurity_loop
1754  END DO output_impurity_loop
1755 
1756 8 IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
1757 
1758  ENDDO loop_on_values
1759 
1760 
1761 
1762 
1763 ! +++ Deallocate internal variables:
1764  IF(ALLOCATED(nzimp1)) DEALLOCATE (nzimp1)
1765  IF(ALLOCATED(ncomp1)) DEALLOCATE (ncomp1)
1766  IF(ALLOCATED(ntype1)) DEALLOCATE (ntype1)
1767  IF(ALLOCATED(nzimp2)) DEALLOCATE (nzimp2)
1768  IF(ALLOCATED(ncomp2)) DEALLOCATE (ncomp2)
1769  IF(ALLOCATED(ntype2)) DEALLOCATE (ntype2)
1770  IF(ALLOCATED(rho1)) DEALLOCATE (rho1)
1771  IF(ALLOCATED(fun)) DEALLOCATE (fun)
1772 
1773 
1774 
1775 
1776  10 RETURN
1777 
1778  END SUBROUTINE interpolate_delta
1779 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1780 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1781 
1782 
1783 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1784 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1785 
1786  SUBROUTINE interpolate_fast(COREFAST_IN, COREFAST_OUT)
1787 
1788  USE euitm_schemas
1789  USE itm_types
1790  USE allocate_deallocate
1791 
1792  IMPLICIT NONE
1793 
1794  TYPE (type_corefast) :: corefast_in
1795  TYPE (type_corefast) :: corefast_out
1796 
1797  INTEGER :: nval2, ival
1798  INTEGER :: nrho1, nrho2
1799  INTEGER :: irho1, irho2
1800  INTEGER :: nnucl1,inucl1
1801  INTEGER :: nnucl2,inucl2
1802  INTEGER :: nion1, iion1
1803  INTEGER :: nion2, iion2
1804  INTEGER :: nimp1, iimp1
1805  INTEGER :: nimp2, iimp2
1806  INTEGER, ALLOCATABLE :: nzimp1(:)
1807  INTEGER, ALLOCATABLE :: nzimp2(:)
1808  INTEGER :: izimp1,izimp2
1809  INTEGER :: nneut1,ineut1
1810  INTEGER :: nneut2,ineut2
1811  INTEGER, ALLOCATABLE :: ncomp1(:)
1812  INTEGER, ALLOCATABLE :: ncomp2(:)
1813  INTEGER, ALLOCATABLE :: ntype1(:)
1814  INTEGER, ALLOCATABLE :: ntype2(:)
1815 
1816  REAL (R8), ALLOCATABLE :: fun(:)
1817  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1818  REAL (R8) :: zmin1, zmin2
1819  REAL (R8) :: zmax1, zmax2
1820 
1821 ! INTEGER :: NEGATIVE_DIFF
1822 ! INTEGER :: ICON
1823 
1824  nval2 = SIZE(corefast_in%VALUES)
1825 
1826  nrho1 = SIZE(corefast_out%VALUES(1)%rho_tor)
1827 
1828  ALLOCATE (fun(nrho1))
1829  ALLOCATE (rho1(nrho1))
1830 
1831  rho1 = corefast_out%VALUES(1)%rho_tor
1832 
1833  CALL get_comp_dimensions(corefast_out%COMPOSITIONS, nnucl1, nion1, nimp1, nzimp1, nneut1, ntype1, ncomp1)
1834  CALL get_comp_dimensions(corefast_in%COMPOSITIONS, nnucl2, nion2, nimp2, nzimp2, nneut2, ntype2, ncomp2)
1835 
1836 !jofe improve this, we shouldn't use GOTOs
1837  IF(.NOT.ASSOCIATED(corefast_in%VALUES)) goto 10
1838 
1839 ! +++ Nullify initial profiles:
1840  corefast_out%values(1)%psi(:) = 0.0_r8
1841  corefast_out%values(1)%volume(:) = 0.0_r8
1842  corefast_out%values(1)%area(:) = 0.0_r8
1843  corefast_out%values(1)%j(:) = 0.0_r8
1844  corefast_out%values(1)%sigma(:) = 0.0_r8
1845  corefast_out%values(1)%ni(:,:) = 0.0_r8
1846  corefast_out%values(1)%ne(:) = 0.0_r8
1847  corefast_out%values(1)%nz(:,:) = 0.0_r8
1848  corefast_out%values(1)%pi(:,:) = 0.0_r8
1849  corefast_out%values(1)%pe(:) = 0.0_r8
1850  corefast_out%values(1)%pz(:,:) = 0.0_r8
1851  corefast_out%values(1)%pi_para(:,:) = 0.0_r8
1852  corefast_out%values(1)%pe_para(:) = 0.0_r8
1853  corefast_out%values(1)%pz_para(:,:) = 0.0_r8
1854  corefast_out%values(1)%ui(:,:) = 0.0_r8
1855  corefast_out%values(1)%uz(:,:) = 0.0_r8
1856 
1857 
1858 ! +++ Check information saved to different VALUES:
1859  loop_on_values: DO ival = 1, nval2
1860  nrho2 = SIZE(corefast_in%VALUES(ival)%rho_tor)
1861  ALLOCATE (rho2(nrho2))
1862  rho2 = corefast_in%VALUES(ival)%rho_tor
1863 
1864 ! +++ 1-D profiles.
1865  IF (ival .EQ. 1) THEN
1866  IF (ASSOCIATED(corefast_in%values(ival)%psi)) &
1867  CALL l3interp(corefast_in%values(ival)%psi, rho2, nrho2, &
1868  corefast_out%values(1)%psi, rho1, nrho1)
1869 
1870  IF (ASSOCIATED(corefast_in%values(ival)%volume)) &
1871  CALL l3interp(corefast_in%values(ival)%volume, rho2, nrho2, &
1872  corefast_out%values(1)%volume, rho1, nrho1)
1873 
1874  IF (ASSOCIATED(corefast_in%values(ival)%area)) &
1875  CALL l3interp(corefast_in%values(ival)%area, rho2, nrho2, &
1876  corefast_out%values(1)%area, rho1, nrho1)
1877  ENDIF
1878 
1879 
1880  IF (ASSOCIATED(corefast_in%values(ival)%j)) THEN
1881  CALL l3interp(corefast_in%values(ival)%j, rho2, nrho2, &
1882  fun, rho1, nrho1)
1883  corefast_out%values(1)%j = corefast_out%values(1)%j + fun
1884  ENDIF
1885 
1886  IF (ASSOCIATED(corefast_in%values(ival)%sigma)) THEN
1887  CALL l3interp(corefast_in%values(ival)%sigma, rho2, nrho2, &
1888  fun, rho1, nrho1)
1889  corefast_out%values(1)%sigma = corefast_out%values(1)%sigma + fun
1890  ENDIF
1891 
1892  IF (ASSOCIATED(corefast_in%values(ival)%ne)) THEN
1893  CALL l3interp(corefast_in%values(ival)%ne, rho2, nrho2, &
1894  fun, rho1, nrho1)
1895  corefast_out%values(1)%ne = corefast_out%values(1)%ne + fun
1896  ENDIF
1897 
1898  IF (ASSOCIATED(corefast_in%values(ival)%pe)) THEN
1899  CALL l3interp(corefast_in%values(ival)%pe, rho2, nrho2, &
1900  fun, rho1, nrho1)
1901  corefast_out%values(1)%pe = corefast_out%values(1)%pe + fun
1902  ENDIF
1903 
1904  IF (ASSOCIATED(corefast_in%values(ival)%pe_para)) THEN
1905  CALL l3interp(corefast_in%values(ival)%pe_para, rho2, nrho2, &
1906  fun, rho1, nrho1)
1907  corefast_out%values(1)%pe_para = corefast_out%values(1)%pe_para + fun
1908  ENDIF
1909 
1910 
1911 ! +++ IONS
1912  output_ions_loop: DO iion1 = 1, nion1
1913  inucl1 = corefast_out%COMPOSITIONS%IONS(iion1)%nucindex
1914  input_ions_loop: DO iion2 = 1, nion2
1915  inucl2 = corefast_in%COMPOSITIONS%IONS(iion2)%nucindex
1916 
1917  IF (inucl2.LE.0 .OR. inucl2.GT.SIZE(corefast_in%COMPOSITIONS%NUCLEI)) goto 5
1918 
1919  check_for_ions_consistency: IF &
1920  (abs(corefast_out%COMPOSITIONS%NUCLEI(inucl1)%amn - corefast_in%COMPOSITIONS%NUCLEI(inucl2)%amn) .LE. 0.25 .AND. &
1921  abs(corefast_out%COMPOSITIONS%NUCLEI(inucl1)%zn - corefast_in%COMPOSITIONS%NUCLEI(inucl2)%zn ) .LE. 0.25 .AND. &
1922  abs(corefast_out%COMPOSITIONS%IONS(iion1)%zion - corefast_in%COMPOSITIONS%IONS(iion2)%zion ) .LE. 0.25) THEN
1923 ! Ni
1924  IF (ASSOCIATED(corefast_in%values(ival)%ni)) THEN
1925  CALL l3interp(corefast_in%values(ival)%ni(:,iion2), rho2, nrho2, &
1926  fun, rho1, nrho1)
1927  corefast_out%values(1)%ni(:,iion1) = corefast_out%values(1)%ni(:,iion1) + fun
1928  ENDIF
1929 ! Pi
1930  IF (ASSOCIATED(corefast_in%values(ival)%pi)) THEN
1931  CALL l3interp(corefast_in%values(ival)%pi(:,iion2), rho2, nrho2, &
1932  fun, rho1, nrho1)
1933  corefast_out%values(1)%pi(:,iion1) = corefast_out%values(1)%pi(:,iion1) + fun
1934  ENDIF
1935 ! Pi_para
1936  IF (ASSOCIATED(corefast_in%values(ival)%pi_para)) THEN
1937  CALL l3interp(corefast_in%values(ival)%pi_para(:,iion2), rho2, nrho2, &
1938  fun, rho1, nrho1)
1939  corefast_out%values(1)%pi_para(:,iion1) = corefast_out%values(1)%pi_para(:,iion1) + fun
1940  ENDIF
1941 ! Ui
1942  IF (ASSOCIATED(corefast_in%values(ival)%ui)) THEN
1943  call l3interp(corefast_in%values(ival)%ui(:,iion2), rho2, nrho2, &
1944  fun, rho1, nrho1)
1945  corefast_out%values(1)%ui(:,iion1) = corefast_out%values(1)%ui(:,iion1) + fun
1946  ENDIF
1947 
1948  END IF check_for_ions_consistency
1949 
1950  5 CONTINUE
1951 
1952  END DO input_ions_loop
1953  END DO output_ions_loop
1954 
1955 8 IF(ALLOCATED(rho2)) DEALLOCATE (rho2)
1956 
1957  END DO loop_on_values
1958 
1959 ! +++ Inpurities
1960 !
1961 ! to be done!
1962 
1963 10 IF(ALLOCATED (nzimp1)) DEALLOCATE (nzimp1)
1964  IF(ALLOCATED (ncomp1)) DEALLOCATE (ncomp1)
1965  IF(ALLOCATED (ntype1)) DEALLOCATE (ntype1)
1966  IF(ALLOCATED (nzimp2)) DEALLOCATE (nzimp2)
1967  IF(ALLOCATED (ncomp2)) DEALLOCATE (ncomp2)
1968  IF(ALLOCATED (ntype2)) DEALLOCATE (ntype2)
1969  IF(ALLOCATED (rho1)) DEALLOCATE (rho1)
1970  IF(ALLOCATED (rho2)) DEALLOCATE (rho2)
1971 
1972 
1973  RETURN
1974 
1975 
1976  END SUBROUTINE interpolate_fast
1977 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1978 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1979 
1980 
1981 
1982 
1983 
1984 
1985 
1986 
1987 
1988  END MODULE interpolate_cpo
1989 
interpolate_cpo
Definition: interpolate_cpo.f90:1
fun
subroutine fun(X, F)
Definition: Ev2.f:10
interpolate_cpo::interpolate_fast
subroutine interpolate_fast(COREFAST_IN, COREFAST_OUT)
Definition: interpolate_cpo.f90:1786
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_prof
subroutine interpolate_prof(COREPROF_IN, COREPROF_OUT)
Definition: interpolate_cpo.f90:694
interpolate_cpo::interpolate_transp
subroutine interpolate_transp(CORETRANSP_IN, CORETRANSP_OUT, NEGATIVE_DIFF)
Definition: interpolate_cpo.f90:321
l3interp
subroutine l3interp(y_in, x_in, nr_in, y_out, x_out, nr_out)
Definition: l3interp.f90:1
interpolate_cpo::interpolate_neoclassic
subroutine interpolate_neoclassic(NEOCLASSIC_IN, NEOCLASSIC_OUT)
Definition: interpolate_cpo.f90:1263
interpolate_cpo::interpolate_delta
subroutine interpolate_delta(COREDELTA_IN, COREDELTA_OUT)
Definition: interpolate_cpo.f90:1558
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
interpolate_cpo::derivn_start
subroutine derivn_start(N, X, Y, DY1)
These subroutines calculate first and second derivatives, DY1 and DY2, of function Y respect to argum...
Definition: interpolate_cpo.f90:1511
interpolate_cpo::interpolate_source
subroutine interpolate_source(CORESOURCE_IN, CORESOURCE_OUT)
Definition: interpolate_cpo.f90:25
interpolate_cpo::interpolate_neutrals
subroutine interpolate_neutrals(CORENEUTRALS_IN, CORENEUTRALS_OUT)
Definition: interpolate_cpo.f90:1125
interpolate_cpo::interpolate_impur
subroutine interpolate_impur(COREIMPUR_IN, COREIMPUR_OUT)
Definition: interpolate_cpo.f90:972