ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
impurity.F90
Go to the documentation of this file.
1 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
7 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
8 MODULE impurity
9 
10 CONTAINS
11 
12 
13 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
14 ! + + + + + + + + + + + + IMPURITY + + + + + + + + + + + + + +
15 
16  SUBROUTINE impurity_ets (EQUILIBRIUM_ITER, COREPROF_ITER, CORETRANSP_ITER, &
17  coreimpur_old, coreimpur_iter, coreneutrals_iter, &
18  coresource_iter, coresource_new, coreimpur_new, &
19  control_integer, control_double)
20 
21 
22 
23 
24 !-------------------------------------------------------!
25 ! This routine calculate impurity density for !
26 ! different impurity !
27 !-------------------------------------------------------!
28 ! Source: --- !
29 ! Developers: I.M.Ivanova-Stanik !
30 ! Kontacts: irena@ifpilm.waw.pl !
31 ! !
32 ! Comments: might change after the ITM !
33 ! data stucture is finalized !
34 ! !
35 !-------------------------------------------------------!
36 
37 
38  USE euitm_schemas
39  USE itm_types
40  USE copy_structures
41  USE deallocate_structures
42  USE neutrals
43  USE allocate_deallocate
44  USE itm_constants
45 
46 #ifdef GOT_AMNSPROTO
47  USE amns_types
48  USE amns_module
49  USE euitm_routines
50 #endif
51 
52 
53  IMPLICIT NONE
54 
55 ! +++ CPO derived types:
56  TYPE (type_equilibrium), POINTER :: equilibrium_iter(:) !input CPO with geometry quantities from previous iterration
57  TYPE (type_coreprof), POINTER :: coreprof_iter(:)
58  TYPE (type_coretransp), POINTER :: coretransp_iter(:)
59  TYPE (type_coreimpur), POINTER :: coreimpur_old(:) !input CPO with impurities
60  TYPE (type_coreimpur), POINTER :: coreimpur_iter(:) !input CPO with impurities
61  TYPE (type_coreimpur), POINTER :: coreimpur_new(:) !input CPO with impurities
62  TYPE (type_coreneutrals),POINTER :: coreneutrals_iter(:) !input CPO with neutrals
63  TYPE (type_coresource), POINTER :: coresource_iter(:) !input CPO impurity radiation
64  TYPE (type_coresource), POINTER :: coresource_new(:) !input CPO impurity radiation
65 
66 
67 
68 ! +++ Dimensions:
69  INTEGER :: neq !number of radial points (input, determined from EQUILIBRIUM CPO)
70  INTEGER :: nrho !number of radial points (input, determined from COREPROF CPO)
71  INTEGER :: nnucl !number of ion species (input, determined from COREPROF CPO)
72  INTEGER :: nion !number of ion species (input, determined from COREPROF CPO)
73  INTEGER :: nimp !number of impurity species (input, determined from COREIMPUR CPO)
74  INTEGER, ALLOCATABLE :: nzimp(:)
75  INTEGER, ALLOCATABLE :: nz_bnd_type(:) !boundary condition, type, one impurity
76  INTEGER :: nneut !number of neutrals species (input)
77  INTEGER, ALLOCATABLE :: ntype(:) !number of impurity ionization states (input)
78  INTEGER, ALLOCATABLE :: ncomp(:) !max_number of distinct atoms enter the composition-"1" wich is neutral
79  INTEGER, PARAMETER :: nocur = 1 !number of CPO ocurancies in the work flow
80  INTEGER :: nrho_tr
81  INTEGER :: nrho_sr
82 
83 ! +++ Indexes:
84  INTEGER :: irho, iimp, izimp !index of impurity component, number of considered impurity components (max ionization state)
85  INTEGER :: ineut, itype, icomp !number of neutrals species (input)
86  INTEGER :: max_nzimp
87  INTEGER :: nzimp2
88 !27.10.2017
89  INTEGER :: iion
90 
91  REAL (R8) :: b0, b0prime !magnetic field from current time step, [T], previous time steps, [T], time derivative, [T/s]
92  REAL (R8) :: r0
93  REAL (R8), ALLOCATABLE :: rho(:) !toroidal flux coordinate,not normalise,[m] [m]
94  REAL (R8), ALLOCATABLE :: vol(:) !V, [m^3]
95  REAL (R8), ALLOCATABLE :: vpr(:) !V', [m^2]
96  REAL (R8), ALLOCATABLE :: vprm(:) !V' (at previous time step), [m^2]
97  REAL (R8), ALLOCATABLE :: g3(:)
98  REAL (R8), ALLOCATABLE :: ne(:) !electron density [m^-3]
99  REAL (R8), ALLOCATABLE :: te(:) !electron temperature
100  REAL (R8), ALLOCATABLE :: dnz1(:,:) !density gradient, [m^-4]
101  REAL (R8), ALLOCATABLE :: flux(:,:) !ion flux, [1/s]
102  REAL (R8), ALLOCATABLE :: flux_inter(:,:) !ion flux, [1/s]
103  REAL (R8), ALLOCATABLE :: nz1(:,:) !one impurity density
104  REAL (R8), ALLOCATABLE :: nzm1(:,:) !old one impurity density
105 ! 26.10.1017 IS
106  REAL (R8), ALLOCATABLE :: tti(:) !ion temperature
107 
108  REAL (R8), ALLOCATABLE :: diff(:,:) !diffusion coefficient for different ionisation, [m^2/s]
109  REAL (R8), ALLOCATABLE :: vcon(:,:) !pinch velocity for different ionisation [m/s]
110  REAL (R8), ALLOCATABLE :: imp_radiation(:,:) !impurity radiation
111  REAL (R8), ALLOCATABLE :: nzsource(:,:) !value of the source term,[m^-3.s^-1]
112  REAL (R8), ALLOCATABLE :: nz_bnd(:,:) !boundary condition, value, one impurity[depends on NZ_BND_TYPE]
113  REAL (R8), ALLOCATABLE :: aneut(:)
114 
115 ! part for radiation
116  REAL (R8), ALLOCATABLE :: lin_rad1(:,:) !profile of lineradiation for one impurity
117  REAL (R8), ALLOCATABLE :: brem_rad1(:,:) !profile of bremst. for one impurity
118  REAL (R8), ALLOCATABLE :: lin_rad(:) !profile of lineradiation for whole impurity
119  REAL (R8), ALLOCATABLE :: brem_rad(:) !profile of bremst. for whole impurity
120  REAL (R8), ALLOCATABLE :: jon_en1(:,:) !profile of jonisation energy for one impurity
121  REAL (R8), ALLOCATABLE :: jon_en(:) !profile of jonisation energy for wholeimpurity
122  REAL (R8), ALLOCATABLE :: rec_los1(:,:) !profile of recombination losses for one impurity
123  REAL (R8), ALLOCATABLE :: rec_los(:) !profile of recombination losses for wholeimpurity
124  REAL (R8), ALLOCATABLE :: qrad(:)
125  REAL (R8), ALLOCATABLE :: se_exp(:)
126 
127  REAL (R8), ALLOCATABLE :: fun(:)
128  REAL (R8), ALLOCATABLE :: fun_in(:)
129  REAL (R8), ALLOCATABLE :: fun_out(:)
130 
131  INTEGER, INTENT(IN) :: control_integer(2) !integer control parameters
132  REAL (R8), INTENT(IN) :: control_double(5) !real control parameters
133 
134  REAL (R8) :: time
135  LOGICAL, SAVE :: first = .true.
136 
137  REAL (R8), ALLOCATABLE ::r_lin_int(:)
138  REAL (R8), ALLOCATABLE ::r_lin_int1(:,:)
139  REAL (R8), ALLOCATABLE ::r_brem_int(:)
140  REAL (R8), ALLOCATABLE ::r_brem_int1(:,:)
141  REAL (R8), ALLOCATABLE ::r_sum_int(:)
142  REAL (R8), ALLOCATABLE ::r_sum_int1(:,:)
143  REAL (R8), ALLOCATABLE ::e_jon_int(:)
144  REAL (R8), ALLOCATABLE ::e_jon_int1(:,:)
145  REAL (R8), ALLOCATABLE ::e_rec_int(:)
146  REAL (R8), ALLOCATABLE ::e_rec_int1(:,:)
147  REAL (R8), ALLOCATABLE ::e_sum_int(:)
148  REAL (R8), ALLOCATABLE ::e_sum_int1(:,:)
149  REAL (R8), ALLOCATABLE ::sum_lin_int(:)
150  REAL (R8), ALLOCATABLE ::sum_brem_int(:)
151  REAL (R8), ALLOCATABLE ::sum_rad_int(:)
152  REAL (R8), ALLOCATABLE ::sum_jon_int(:)
153  REAL (R8), ALLOCATABLE ::sum_rec_int(:)
154  REAL (R8), ALLOCATABLE ::sum_los_int(:)
155 
156 
157 ! +++ Atomic data:
158 #ifdef GOT_AMNSPROTO
159  TYPE (amns_handle_type), SAVE :: amns
160  TYPE (amns_handle_rx_type), ALLOCATABLE, SAVE :: &
161  amns_ei(:,:), amns_eip(:,:),amns_rc(:,:), amns_lr(:,:), amns_br(:,:)
162  TYPE (amns_version_type) :: amns_database
163  TYPE (amns_reaction_type) :: ei_rx, eip_rx, rc_rx, lr_rx, br_rx
164  TYPE (amns_reactants_type) :: species
165  TYPE (amns_query_type) :: query
166  TYPE (amns_answer_type) :: answer
167  TYPE (amns_set_type) :: set
168 ! DPC added for testing
169  type (amns_version_type) :: version
170  REAL (R8) :: zn_imp, am_imp
171 #endif
172  CHARACTER (len=80) :: format
173 
174 
175  WRITE (*,*) ' '
176  WRITE (*,*) '===========> IMPURITY started'
177 
178 
179 ! +++ Set dimensions:
180  neq = SIZE (equilibrium_iter(1)%profiles_1d%rho_tor )
181  nrho = SIZE (coreimpur_iter(1)%rho_tor)
182 
183  CALL get_comp_dimensions(coreimpur_old(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
184 
185  max_nzimp = maxval(nzimp)
186 
187 
188 
189 
190 ! +++ Allocate output CPOs:
191 ! IF(.NOT.ASSOCIATED(COREIMPUR_NEW))
192  ALLOCATE (coreimpur_new(1))
193  CALL copy_cpo(coreimpur_iter(1), coreimpur_new(1))
194 
195 
196 ! IF(ASSOCIATED(CORESOURCE_NEW)) DEALLOCATE(CORESOURCE_NEW)
197  CALL allocate_coresource_cpo(nocur, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource_new )
198  CALL deallocate_cpo(coresource_new(1)%COMPOSITIONS)
199  CALL copy_cpo(coreimpur_iter(1)%COMPOSITIONS, coresource_new(1)%COMPOSITIONS)
200 
201  coreimpur_new(1)%datainfo%cocos = 13
202  coresource_new(1)%datainfo%cocos = 13
203 
204  coreimpur_new(1)%time = coreprof_iter(1)%time
205  coresource_new(1)%time = coreprof_iter(1)%time
206 
207  coreimpur_new(1)%rho_tor = coreprof_iter(1)%rho_tor
208  coresource_new(1)%VALUES(1)%rho_tor = coreprof_iter(1)%rho_tor
209 
210  coreimpur_new(1)%rho_tor_norm = coreprof_iter(1)%rho_tor/coreprof_iter(1)%rho_tor(nrho)
211  coresource_new(1)%VALUES(1)%rho_tor_norm = coreprof_iter(1)%rho_tor/coreprof_iter(1)%rho_tor(nrho)
212 
213 
214  coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile = 0.0_r8
215  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile = 0.0_r8
216  coreimpur_new(1)%diagnosticsum%radiation%sum%profile = 0.0_r8
217  coreimpur_new(1)%diagnosticsum%energy%ionization%profile = 0.0_r8
218  coreimpur_new(1)%diagnosticsum%energy%recombin%profile = 0.0_r8
219  coreimpur_new(1)%diagnosticsum%energy%sum%profile = 0.0_r8
220 
221 
222 ! +++ Load AMNS data:
223  IF(first) THEN
224 !#ifdef GOT_AMNSPROTO
225  WRITE(*,*) 'ITM AMNSPROTO data used (via UAL)'
226  ALLOCATE(amns_ei(0:max_nzimp, nimp), amns_rc(0:max_nzimp, nimp), &
227  amns_eip(0:max_nzimp,nimp), amns_lr(0:max_nzimp, nimp), &
228  amns_br(0:max_nzimp, nimp))
229 ! version added for testing
230 ! version%backend='ascii'
231  CALL itm_amns_setup(amns, version)
232  query%string = 'version'
233  CALL itm_amns_query(amns,query,answer)
234  WRITE(*,*) 'AMNS data base version = ',trim(answer%string)
235  ei_rx%string = 'EI'
236  eip_rx%string = 'EIP'
237  rc_rx%string = 'RC'
238  lr_rx%string = 'LR'
239  br_rx%string = 'BR'
240  FORMAT = '(''ZN = '',f5.2,'', IS = '',i2,'', RX = '',a,'', SRC = '',a)'
241  query%string = 'source'
242 
243  DO iimp=1, nimp
244 
245  zn_imp = coreimpur_old(1)%compositions%nuclei(coreimpur_old(1)%compositions%IMPURITIES(iimp)%nucindex)%zn
246  am_imp = coreimpur_old(1)%compositions%nuclei(coreimpur_old(1)%compositions%IMPURITIES(iimp)%nucindex)%amn
247  am_imp = 0
248  DO izimp=0, nzimp(iimp)-1
249 ! EI
250  allocate(species%components(4))
251  species%components = &
252  (/ amns_reactant_type(zn_imp, izimp, am_imp, 0), &
253  amns_reactant_type(0, -1, 0, 0), &
254  amns_reactant_type(zn_imp, izimp+1, am_imp, 1), &
255  amns_reactant_type(0, -1, 0, 1) &
256  /)
257  CALL itm_amns_setup_table(amns, ei_rx, species, amns_ei(izimp, iimp))
258  deallocate(species%components)
259 ! CALL ITM_AMNS_QUERY_TABLE(amns_ei(izimp, iimp), query,answer)
260 ! WRITE(*,FORMAT) species%components(1)%ZN, izimp, TRIM(ei_rx%string), TRIM(answer%string)
261 ! LR
262  allocate(species%components(2))
263  species%components = &
264  (/ amns_reactant_type(zn_imp, izimp, am_imp, 0), &
265  amns_reactant_type(zn_imp, izimp, am_imp, 1) &
266  /)
267  CALL itm_amns_setup_table(amns, lr_rx, species, amns_lr(izimp, iimp))
268  deallocate(species%components)
269 ! CALL ITM_AMNS_QUERY_TABLE(amns_lr(izimp, iimp), query,answer)
270 ! !WRITE(*,FORMAT) species%components(1)%ZN, izimp, TRIM(lr_rx%string), TRIM(answer%string)
271  ENDDO
272  DO izimp=1, nzimp(iimp)
273 ! RC
274  allocate(species%components(4))
275  species%components = &
276  (/ amns_reactant_type(zn_imp, izimp, am_imp, 0), &
277  amns_reactant_type(0, -1, 0, 0), &
278  amns_reactant_type(zn_imp, izimp-1, am_imp, 1), &
279  amns_reactant_type(0, -1, 0, 1) &
280  /)
281  CALL itm_amns_setup_table(amns, rc_rx, species, amns_rc(izimp, iimp))
282  deallocate(species%components)
283 ! CALL ITM_AMNS_QUERY_TABLE(amns_rc(izimp, iimp), query,answer)
284 ! WRITE(*,FORMAT) species%components(1)%ZN, izimp, TRIM(rc_rx%string), TRIM(answer%string)
285 ! BR
286  allocate(species%components(2))
287  species%components = &
288  (/ amns_reactant_type(zn_imp, izimp, am_imp, 0), &
289  amns_reactant_type(zn_imp, izimp, am_imp, 1) &
290  /)
291  CALL itm_amns_setup_table(amns, br_rx, species, amns_br(izimp, iimp))
292  deallocate(species%components)
293 ! CALL ITM_AMNS_QUERY_TABLE(amns_br(izimp, iimp), query,answer)
294 ! WRITE(*,FORMAT) species%components(1)%ZN, izimp, TRIM(br_rx%string), TRIM(answer%string)
295  ENDDO
296  DO izimp=0,nzimp(iimp)
297  !new for potential
298  allocate(species%components(2))
299  species%components = &
300  (/ amns_reactant_type(zn_imp, izimp, am_imp, 0), &
301  amns_reactant_type(zn_imp, izimp, am_imp, 1) &
302  /)
303  CALL itm_amns_setup_table(amns, eip_rx, species, amns_eip(izimp, iimp))
304  deallocate(species%components)
305 ! CALL ITM_AMNS_QUERY_TABLE(amns_eip(izimp, iimp), query,answer)
306 ! WRITE(*,FORMAT) species%components(1)%ZN, IZIMP, TRIM(eip_rx%string),TRIM(answer%string)
307  ENDDO
308  ENDDO
309 !#else
310  WRITE(*,*) 'Roman Zagorski AMNS data used'
311 !#endif
312  first=.false.
313  ENDIF
314 
315 
316 
317 
318 ! +++ Allocate local variables:
319  ALLOCATE (rho(nrho))
320  ALLOCATE (vol(nrho))
321  ALLOCATE (vpr(nrho))
322  ALLOCATE (vprm(nrho))
323  ALLOCATE (g3(nrho))
324  ALLOCATE (ne(nrho))
325  ALLOCATE (te(nrho))
326  ALLOCATE (fun_out(nrho))
327  ALLOCATE (qrad(nrho))
328 
329 ! for radiation
330  ALLOCATE (lin_rad(nrho))
331  ALLOCATE (brem_rad(nrho))
332  ALLOCATE (jon_en(nrho))
333  ALLOCATE (rec_los(nrho))
334  ALLOCATE (r_lin_int(nrho))
335  ALLOCATE (r_brem_int(nrho))
336  ALLOCATE (r_sum_int(nrho))
337  ALLOCATE (e_jon_int(nrho))
338  ALLOCATE (e_rec_int(nrho))
339  ALLOCATE (e_sum_int(nrho))
340  ALLOCATE (sum_lin_int(nrho))
341  ALLOCATE (sum_brem_int(nrho))
342  ALLOCATE (sum_rad_int(nrho))
343  ALLOCATE (sum_jon_int(nrho))
344  ALLOCATE (sum_rec_int(nrho))
345  ALLOCATE (sum_los_int(nrho))
346  ALLOCATE (se_exp(nrho))
347  ALLOCATE (fun(nrho))
348 ! 27.10.2017 IS
349  ALLOCATE (tti(nrho))
350 
351 ! +++ Copy data to local variables:
352  b0 = coreprof_iter(1)%toroid_field%b0
353  r0 = coreprof_iter(1)%toroid_field%r0
354  ne = coreprof_iter(1)%ne%value
355  te = coreprof_iter(1)%te%value
356  rho = coreprof_iter(1)%rho_tor
357  b0prime = 0.0_r8
358  qrad = 0.0_r8
359  se_exp = 0.0_r8
360  tti = 0.0_r8
361 !27.10.2017
362  DO irho = 1, nrho
363  DO iion = 1, nion
364  tti(irho)= tti(irho)+coreprof_iter(1)%TI%VALUE(irho,iion)
365  ENDDO
366  ENDDO
367 
368 
369 ! for radiation
370 
371 
372  CALL l3interp(equilibrium_iter(1)%profiles_1d%volume, equilibrium_iter(1)%profiles_1d%rho_tor, neq, &
373  vol, rho, nrho)
374  CALL l3deriv(equilibrium_iter(1)%profiles_1d%volume, equilibrium_iter(1)%profiles_1d%rho_tor, neq, &
375  vpr, rho, nrho)
376  CALL l3deriv(equilibrium_iter(1)%profiles_1d%volume, equilibrium_iter(1)%profiles_1d%rho_tor, neq, &
377  vprm, rho, nrho)
378  CALL l3interp(equilibrium_iter(1)%profiles_1d%gm3, equilibrium_iter(1)%profiles_1d%rho_tor, neq, &
379  g3, rho, nrho)
380 
381 
382 
383 ! +++ Set up dimensions:
384  DO iimp=1, nimp
385  nzimp2 = nzimp(iimp)+2
386 
387  ALLOCATE (aneut(nneut))
388  ALLOCATE (nz1(nrho,nzimp2))
389  ALLOCATE (nzm1(nrho,nzimp2))
390  ALLOCATE (diff(nrho,nzimp2))
391  ALLOCATE (vcon(nrho,nzimp2))
392  ALLOCATE (dnz1(nrho,nzimp2))
393  ALLOCATE (flux(nrho,nzimp2))
394  ALLOCATE (flux_inter(nrho,nzimp2))
395  ALLOCATE (imp_radiation(nrho,nzimp2))
396  ALLOCATE (nz_bnd(3,nzimp2))
397  ALLOCATE (nz_bnd_type(nzimp2))
398  ALLOCATE (nzsource(nrho,nzimp2))
399 
400 ! for radiation
401  ALLOCATE (lin_rad1(nrho,nzimp2))
402  ALLOCATE (brem_rad1(nrho,nzimp2))
403  ALLOCATE (jon_en1(nrho,nzimp2))
404  ALLOCATE (rec_los1(nrho,nzimp2))
405  ALLOCATE (r_lin_int1(nrho,nzimp2))
406  ALLOCATE (r_brem_int1(nrho,nzimp2))
407  ALLOCATE (r_sum_int1(nrho,nzimp2))
408  ALLOCATE (e_jon_int1(nrho,nzimp2))
409  ALLOCATE (e_rec_int1(nrho,nzimp2))
410  ALLOCATE (e_sum_int1(nrho,nzimp2))
411 
412  aneut = 0.0_r8
413  nz1 = 0.0_r8
414  nzm1 = 0.0_r8
415  diff = 0.0_r8
416  vcon = 0.0_r8
417  dnz1 = 0.0_r8
418  flux = 0.0_r8
419  flux_inter = 0.0_r8
420  imp_radiation = 0.0_r8
421  nz_bnd = 0.0_r8
422  nz_bnd_type = 0
423  nzsource = 0.0_r8
424 
425 !for radiation
426 
427 
428  ALLOCATE (fun_in(SIZE(coreimpur_iter(1)%rho_tor)))
429  nrho_tr = SIZE(coretransp_iter(1)%VALUES(1)%rho_tor)
430  nrho_sr = SIZE(coresource_iter(1)%VALUES(1)%rho_tor)
431 
432 
433  DO izimp=1,nzimp(iimp)
434 
435 
436  fun_in = coreimpur_iter(1)%IMPURITY(iimp)%NZ(:,izimp)
437  CALL l3interp(fun_in, coreimpur_iter(1)%rho_tor, nrho, fun_out, rho, nrho)
438  nz1(:,izimp+1) = fun_out
439  fun_in = coreimpur_old(1)%IMPURITY(iimp)%NZ(:,izimp)
440  CALL l3interp(fun_in, coreimpur_iter(1)%rho_tor, nrho, fun_out, rho, nrho)
441  nzm1(:,izimp+1) = fun_out
442  CALL l3interp(coretransp_iter(1)%VALUES(1)%nz_transp(iimp)%diff_eff(:,izimp), coretransp_iter(1)%VALUES(1)%rho_tor, nrho_tr, fun_out, rho, nrho)
443  diff(:,izimp+1) = fun_out
444  CALL l3interp(coretransp_iter(1)%VALUES(1)%nz_transp(iimp)%vconv_eff(:,izimp), coretransp_iter(1)%VALUES(1)%rho_tor, nrho_tr, fun_out, rho, nrho)
445  vcon(:,izimp+1) = fun_out
446  CALL l3interp(coresource_iter(1)%VALUES(1)%sz(iimp)%exp(:,izimp), coresource_iter(1)%VALUES(1)%rho_tor, nrho_sr, fun_out, rho, nrho)
447 
448  nzsource(:,izimp+1) = fun_out
449  nz_bnd(1,izimp+1) = coreimpur_iter(1)%IMPURITY(iimp)%BOUNDARY%VALUE(1,izimp)
450  nz_bnd_type(izimp+1)= coreimpur_iter(1)%IMPURITY(iimp)%BOUNDARY%TYPE(izimp)
451  END DO
452 
453  DEALLOCATE (fun_in)
454 
455 
456  lin_rad1 = 0.0_r8
457  brem_rad1 = 0.0_r8
458  jon_en1 = 0.0_r8
459  rec_los1 = 0.0_r8
460 
461 
462 ! +++ connectin with neutrals
463 
464  IF(nneut.GT.0) THEN
465 
466  ALLOCATE (fun_in(SIZE(coreneutrals_iter(1)%rho_tor)))
467 
468  DO ineut=1,nneut
469  aneut(ineut) = coreimpur_iter(1)%compositions%nuclei(coreimpur_old(1)%compositions%neutralscomp(ineut)%neutcomp(1)%nucindex)%amn
470 
471  IF (coreimpur_iter(1)%compositions%nuclei(coreimpur_old(1)%compositions%IMPURITIES(iimp)%nucindex)%amn.EQ. &
472  aneut(ineut)) THEN
473 
474  DO itype = 1, ntype(ineut)
475  fun_in = coreneutrals_iter(1)%PROFILES(ineut)%NEUTRALTYPE(itype)%n0%value
476  CALL l3interp(fun_in, coreneutrals_iter(1)%rho_tor, SIZE(coreneutrals_iter(1)%rho_tor), fun_out, rho, nrho)
477  nz1(:,1) = nz1(:,1) + fun_out(:)
478  END DO
479 
480  nzm1(:,1) = nz1(:,1)
481 
482  ENDIF
483 
484  END DO
485 
486  DEALLOCATE (fun_in)
487 
488  ENDIF
489 
490 
491 
492 
493 #ifdef GOT_AMNSPROTO
494  CALL impurity_one(te, ne, nz1, nzm1, vpr, vprm, r0, b0, b0prime, diff, flux, flux_inter, rho, &
495  vcon, nrho, nzimp2, nzsource, nz_bnd, nz_bnd_type, &
496  control_double, control_integer, g3, imp_radiation, se_exp, max_nzimp, &
497  amns_ei(:,iimp), amns_rc(:,iimp), amns_lr(:,iimp), amns_br(:,iimp), &
498  amns_eip(:,iimp), lin_rad1,brem_rad1,jon_en1,rec_los1)
499 
500 
501 #else
502  CALL impurity_one(te, ne, nz1, nzm1, vpr, vprm, r0, b0, b0prime, diff, flux, flux_inter, rho, &
503  vcon, nrho, nzimp2, nzsource, nz_bnd, nz_bnd_type, &
504  control_double, control_integer, g3, imp_radiation, se_exp, max_nzimp)
505 #endif
506  write(*,*) 'after impurity one', 'NZIMP(IIMP)=' ,nzimp(iimp)
507 ! pause
508 
509  DO irho=1,nrho
510  lin_rad(irho) = 0.0_r8
511  brem_rad(irho) = 0.0_r8
512  jon_en(irho) = 0.0_r8
513  rec_los(irho) = 0.0_r8
514  ENDDO
515 
516  DO izimp = 1,nzimp(iimp)
517  IF (nz1(nrho,izimp+1).LE.1.0d-200) nz1(nrho,izimp+1) = 0._r8
518  ENDDO
519 
520 
521  DO irho=1,nrho
522  DO izimp=1,nzimp(iimp)
523  qrad(irho) = qrad(irho) + imp_radiation(irho,izimp+1)
524  coreimpur_new(1)%IMPURITY(iimp)%NZ(irho,izimp) = nz1(irho,izimp+1)
525  coreimpur_new(1)%IMPURITY(iimp)%transp_coef%diff(irho,izimp) = diff(irho,izimp+1)
526  coreimpur_new(1)%IMPURITY(iimp)%transp_coef%vconv(irho,izimp) = vcon(irho,izimp+1)
527  coreimpur_new(1)%IMPURITY(iimp)%flux%flux_dv(irho,izimp) = flux(irho,izimp+1)
528  coreimpur_new(1)%IMPURITY(iimp)%flux%flux_interp(irho,izimp) = flux_inter(irho,izimp+1)
529  coreimpur_new(1)%IMPURITY(iimp)%z(irho,izimp) = izimp
530  coreimpur_new(1)%IMPURITY(iimp)%zsq(irho,izimp) = izimp**2
531 !27.10.2017 IS
532  coreimpur_new(1)%IMPURITY(iimp)%TZ(irho,izimp) = tti(irho)/nion
533 
534 
535 
536 ! for radiation for one impurity - PROFILE
537 
538  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%line_rad%profile(irho,izimp) = lin_rad1(irho,izimp+1)
539  coreimpur_new(1)%IMPURITY(iimp)%diagnostic%radiation%brem_radrec%profile(irho,izimp) = brem_rad1(irho,izimp+1)
540  coreimpur_new(1)%IMPURITY(iimp)%diagnostic%radiation%sum%profile(irho,izimp) = lin_rad1(irho,izimp+1)+ brem_rad1(irho,izimp+1)
541  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%ionization%profile(irho,izimp) = itm_ev*jon_en1(irho,izimp+1)
542  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%recombin%profile(irho,izimp) = itm_ev*rec_los1(irho,izimp+1)
543  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%sum%profile(irho,izimp) = itm_ev*(rec_los1(irho,izimp+1)+jon_en1(irho,izimp+1))
544 
545 
546  fun =vpr*(lin_rad1(irho,izimp+1)+ brem_rad1(irho,izimp+1))
547  CALL integr2(nrho,rho,fun,fun_out)
548  coreimpur_new(1)%IMPURITY(iimp)%diagnostic%radiation%sum%integral(:,izimp) = fun_out(:)
549 
550 
551  lin_rad(irho) = lin_rad(irho) + lin_rad1(irho,izimp+1)
552  brem_rad(irho) = brem_rad(irho) + brem_rad1(irho,izimp+1)
553  jon_en(irho) = jon_en(irho) + jon_en1(irho,izimp+1)
554  rec_los(irho) = rec_los(irho) + rec_los1(irho,izimp+1)
555 
556  END DO
557  END DO
558 
559  r_lin_int1 = 0.0_r8
560  r_brem_int1 = 0.0_r8
561  r_sum_int1 = 0.0_r8
562  e_jon_int1 = 0.0_r8
563  e_rec_int1 = 0.0_r8
564  e_sum_int1 = 0.0_r8
565 
566 
567 ! for radiation on impurity- INTEGRAL
568 !******************* for line radiation for one impurity for one ionisations state*************
569  DO izimp=1,nzimp(iimp)
570  r_lin_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%line_rad%profile(1,izimp)
571 
572  DO irho=2,nrho
573  r_lin_int1(irho,izimp)=r_lin_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
574  (coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%line_rad%profile(irho,izimp)+ &
575  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%line_rad%profile(irho-1,izimp))
576  ENDDO
577  DO irho=1,nrho
578  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%line_rad%integral(irho,izimp) = r_lin_int1(irho,izimp)
579  ENDDO
580  ENDDO
581 
582 !******************* for bremstahlung+Recombination*************
583  DO izimp=1,nzimp(iimp)
584  r_brem_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%BREM_RADREC%profile(1,izimp)
585 
586  DO irho=2,nrho
587  r_brem_int1(irho,izimp)=r_brem_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
588  (coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%BREM_RADREC%profile(irho,izimp)+ &
589  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%BREM_RADREC%profile(irho-1,izimp))
590  ENDDO
591  DO irho=1,nrho
592  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%BREM_RADREC%integral(irho,izimp) = r_brem_int1(irho,izimp)
593  ENDDO
594  ENDDO
595 
596 !******************* for sum lin+Brem+rec for one impurity,one ion.state*************
597  DO izimp=1,nzimp(iimp)
598  r_sum_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%SUM%profile(1,izimp)
599 
600  DO irho=2,nrho
601  r_sum_int1(irho,izimp)=r_sum_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
602  (coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%SUM%profile(irho,izimp)+ &
603  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%SUM%profile(irho-1,izimp))
604  ENDDO
605  DO irho=1,nrho
606  coreimpur_new(1)%impurity(iimp)%diagnostic%radiation%SUM%integral(irho,izimp) = r_sum_int1(irho,izimp)
607  ENDDO
608  ENDDO
609 
610 !******************* for jonisation losses for one impurity,one ion.state*************
611  DO izimp=1,nzimp(iimp)
612  e_jon_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%energy%ionization%profile(1,izimp)
613 
614  DO irho=2,nrho
615  e_jon_int1(irho,izimp)=e_jon_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
616  (coreimpur_new(1)%impurity(iimp)%diagnostic%energy%ionization%profile(irho,izimp)+ &
617  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%ionization%profile(irho-1,izimp))
618  ENDDO
619  DO irho=1,nrho
620  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%ionization%integral(irho,izimp) = e_jon_int1(irho,izimp)
621  ENDDO
622  ENDDO
623 
624 !******************* for recombination losses for one impurity,one ion.state*************
625  DO izimp=1,nzimp(iimp)
626  e_rec_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%energy%recombin%profile(1,izimp)
627 
628  DO irho=2,nrho
629  e_rec_int1(irho,izimp)=e_rec_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
630  (coreimpur_new(1)%impurity(iimp)%diagnostic%energy%recombin%profile(irho,izimp)+ &
631  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%recombin%profile(irho-1,izimp))
632  ENDDO
633  DO irho=1,nrho
634  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%recombin%integral(irho,izimp) = e_rec_int1(irho,izimp)
635  ENDDO
636  ENDDO
637 
638 !******************* for sum losses for one impurity,one ion.state*************
639  DO izimp=1,nzimp(iimp)
640  e_sum_int1(1,izimp)=rho(1)*coreimpur_new(1)%impurity(iimp)%diagnostic%energy%sum%profile(1,izimp)
641 
642  DO irho=2,nrho
643  e_sum_int1(irho,izimp)=e_sum_int1(irho-1,izimp) + (vol(irho)-vol(irho-1))*0.5_r8 * &
644  (coreimpur_new(1)%impurity(iimp)%diagnostic%energy%sum%profile(irho,izimp)+ &
645  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%sum%profile(irho-1,izimp))
646  ENDDO
647  DO irho=1,nrho
648  coreimpur_new(1)%impurity(iimp)%diagnostic%energy%sum%integral(irho,izimp) = e_sum_int1(irho,izimp)
649  ENDDO
650  ENDDO
651 
652 ! for radiation
653  DO irho=1,nrho
654  coreimpur_new(1)%DIAGNOSTIC%RADIATION%LINE_RAD%PROFILE(irho,iimp) = lin_rad(irho)
655  coreimpur_new(1)%DIAGNOSTIC%RADIATION%BREM_RADREC%PROFILE(irho,iimp) = brem_rad(irho)
656  coreimpur_new(1)%DIAGNOSTIC%RADIATION%SUM%PROFILE(irho,iimp) = lin_rad(irho) + brem_rad(irho)
657  coreimpur_new(1)%diagnostic%energy%ionization%profile(irho,iimp) = itm_ev*jon_en(irho)
658  coreimpur_new(1)%diagnostic%energy%recombin%profile(irho,iimp) = itm_ev*rec_los(irho)
659  coreimpur_new(1)%diagnostic%energy%sum%profile(irho,iimp) = itm_ev*(rec_los(irho) + jon_en(irho))
660  ENDDO
661 
662 
663  r_lin_int = 0.0_r8
664  r_brem_int = 0.0_r8
665  r_sum_int = 0.0_r8
666  e_jon_int = 0.0_r8
667  e_rec_int = 0.0_r8
668  e_sum_int = 0.0_r8
669 
670 ! for radiation on impurity- INTEGRAL
671 !******************* for line radiation for one impurity *************
672 
673  r_lin_int(1)=rho(1)*coreimpur_new(1)%diagnostic%radiation%line_rad%profile(1,iimp)
674 
675  DO irho=2,nrho
676  r_lin_int(irho)=r_lin_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
677  (coreimpur_new(1)%diagnostic%radiation%line_rad%profile(irho,iimp)+ &
678  coreimpur_new(1)%diagnostic%radiation%line_rad%profile(irho-1,iimp))
679  ENDDO
680  DO irho=1,nrho
681  coreimpur_new(1)%diagnostic%radiation%line_rad%integral(irho,iimp) = r_lin_int(irho)
682  ENDDO
683 !******************* for bremstahlung+Recombination*************
684  r_brem_int(1)=rho(1)*coreimpur_new(1)%diagnostic%radiation%BREM_RADREC%profile(1,iimp)
685 
686  DO irho=2,nrho
687  r_brem_int(irho)=r_brem_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
688  (coreimpur_new(1)%diagnostic%radiation%BREM_RADREC%profile(irho,iimp)+ &
689  coreimpur_new(1)%diagnostic%radiation%BREM_RADREC%profile(irho-1,iimp))
690  ENDDO
691  DO irho=1,nrho
692  coreimpur_new(1)%diagnostic%radiation%BREM_RADREC%integral(irho,iimp) = r_brem_int(irho)
693  ENDDO
694 
695 !******************* for SUM*************
696  r_sum_int(1)=rho(1)*coreimpur_new(1)%diagnostic%radiation%SUM%profile(1,iimp)
697 
698  DO irho=2,nrho
699  r_sum_int(irho)=r_sum_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
700  (coreimpur_new(1)%diagnostic%radiation%SUM%profile(irho,iimp) + &
701  coreimpur_new(1)%diagnostic%radiation%SUM%profile(irho-1,iimp))
702  ENDDO
703  DO irho=1,nrho
704  coreimpur_new(1)%diagnostic%radiation%SUM%integral(irho,iimp) = r_sum_int(irho)
705  ENDDO
706 
707 !******************* for jonisation losses*************
708  e_jon_int(1)=rho(1)*coreimpur_new(1)%diagnostic%energy%ionization%profile(1,iimp)
709 
710  DO irho=2,nrho
711  e_jon_int(irho)=e_jon_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
712  (coreimpur_new(1)%diagnostic%energy%ionization%profile(irho,iimp) + &
713  coreimpur_new(1)%diagnostic%energy%ionization%profile(irho-1,iimp))
714  ENDDO
715  DO irho=1,nrho
716  coreimpur_new(1)%diagnostic%energy%ionization%integral(irho,iimp) = e_jon_int(irho)
717  ENDDO
718 
719 !******************* for recombination losses*************
720  e_rec_int(1)=rho(1)*coreimpur_new(1)%diagnostic%energy%recombin%profile(1,iimp)
721 
722  DO irho=2,nrho
723  e_rec_int(irho)=e_rec_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
724  (coreimpur_new(1)%diagnostic%energy%recombin%profile(irho,iimp) + &
725  coreimpur_new(1)%diagnostic%energy%recombin%profile(irho-1,iimp))
726  ENDDO
727  DO irho=1,nrho
728  coreimpur_new(1)%diagnostic%energy%recombin%integral(irho,iimp) = e_rec_int(irho)
729  ENDDO
730 
731 !******************* for sum losses*************
732  e_sum_int(1)=rho(1)*coreimpur_new(1)%diagnostic%energy%SUM%profile(1,iimp)
733 
734  DO irho=2,nrho
735  e_sum_int(irho)=e_sum_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
736  (coreimpur_new(1)%diagnostic%energy%sum%profile(irho,iimp) + &
737  coreimpur_new(1)%diagnostic%energy%sum%profile(irho-1,iimp))
738  ENDDO
739  DO irho=1,nrho
740  coreimpur_new(1)%diagnostic%energy%sum%integral(irho,iimp) = e_sum_int(irho)
741  ENDDO
742 
743 !********* ######## diagnosticsum ######## ******************
744 
745 
746  DO irho=1,nrho
747  coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile(irho) = &
748  coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile(irho) + &
749  coreimpur_new(1)%DIAGNOSTIC%RADIATION%LINE_RAD%PROFILE(irho,iimp)
750 
751  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile(irho) = &
752  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile(irho) + &
753  coreimpur_new(1)%DIAGNOSTIC%RADIATION%brem_radrec%PROFILE(irho,iimp)
754 
755  coreimpur_new(1)%diagnosticsum%radiation%sum%profile(irho) = &
756  coreimpur_new(1)%diagnosticsum%radiation%SUM%profile(irho) + &
757  coreimpur_new(1)%DIAGNOSTIC%RADIATION%LINE_RAD%PROFILE(irho,iimp) + &
758  coreimpur_new(1)%DIAGNOSTIC%RADIATION%brem_radrec%PROFILE(irho,iimp)
759 
760  coreimpur_new(1)%diagnosticsum%energy%ionization%profile(irho) = &
761  coreimpur_new(1)%diagnosticsum%energy%ionization%profile(irho) + &
762  coreimpur_new(1)%diagnostic%energy%ionization%profile(irho,iimp)
763 
764  coreimpur_new(1)%diagnosticsum%energy%recombin%profile(irho) = &
765  coreimpur_new(1)%diagnosticsum%energy%recombin%profile(irho) + &
766  coreimpur_new(1)%diagnostic%energy%recombin%profile(irho,iimp)
767 
768  coreimpur_new(1)%diagnosticsum%energy%sum%profile(irho) = &
769  coreimpur_new(1)%diagnosticsum%energy%sum%profile(irho) + &
770  coreimpur_new(1)%diagnostic%energy%ionization%profile(irho,iimp) + &
771  coreimpur_new(1)%diagnostic%energy%recombin%profile(irho,iimp)
772  ENDDO
773 
774  sum_lin_int = 0.0_r8
775  sum_brem_int = 0.0_r8
776  sum_rad_int = 0.0_r8
777  sum_jon_int = 0.0_r8
778  sum_rec_int = 0.0_r8
779  sum_los_int = 0.0_r8
780 
781  sum_lin_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile(1)
782  sum_brem_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile(1)
783  sum_rad_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%radiation%sum%profile(1)
784  sum_jon_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%energy%ionization%profile(1)
785  sum_rec_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%energy%recombin%profile(1)
786  sum_los_int(1) = rho(1)*coreimpur_new(1)%diagnosticsum%energy%sum%profile(1)
787 
788  DO irho=2,nrho
789  sum_lin_int(irho) = sum_lin_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
790  (coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile(irho) + &
791  coreimpur_new(1)%diagnosticsum%radiation%line_rad%profile(irho-1))
792  sum_brem_int(irho)= sum_brem_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
793  (coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile(irho) + &
794  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%profile(irho-1))
795  sum_rad_int(irho) = sum_rad_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
796  (coreimpur_new(1)%diagnosticsum%radiation%sum%profile(irho) + &
797  coreimpur_new(1)%diagnosticsum%radiation%sum%profile(irho-1))
798 
799  sum_jon_int(irho) = sum_jon_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
800  (coreimpur_new(1)%diagnosticsum%energy%ionization%profile(irho) + &
801  coreimpur_new(1)%diagnosticsum%energy%ionization%profile(irho-1))
802 
803  sum_rec_int(irho) = sum_rec_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
804  (coreimpur_new(1)%diagnosticsum%energy%recombin%profile(irho) + &
805  coreimpur_new(1)%diagnosticsum%energy%recombin%profile(irho-1))
806  sum_los_int(irho) = sum_los_int(irho-1) + (vol(irho)-vol(irho-1))*0.5_r8 * &
807  (coreimpur_new(1)%diagnosticsum%energy%sum%profile(irho) + &
808  coreimpur_new(1)%diagnosticsum%energy%sum%profile(irho-1))
809 
810  ENDDO
811 
812 
813  DO irho=1,nrho
814  coreimpur_new(1)%diagnosticsum%radiation%line_rad%integral(irho) = &
815  coreimpur_new(1)%diagnosticsum%radiation%line_rad%integral(irho) + sum_lin_int(irho)
816  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%integral(irho) = &
817  coreimpur_new(1)%diagnosticsum%radiation%brem_radrec%integral(irho) + sum_brem_int(irho)
818  coreimpur_new(1)%diagnosticsum%radiation%sum%integral(irho) = &
819  coreimpur_new(1)%diagnosticsum%radiation%sum%integral(irho) + sum_rad_int(irho)
820 
821  coreimpur_new(1)%diagnosticsum%energy%ionization%integral(irho) = &
822  coreimpur_new(1)%diagnosticsum%energy%ionization%integral(irho) + sum_jon_int(irho)
823  coreimpur_new(1)%diagnosticsum%energy%recombin%integral(irho) = &
824  coreimpur_new(1)%diagnosticsum%energy%recombin%integral(irho) + sum_rec_int(irho)
825  coreimpur_new(1)%diagnosticsum%energy%sum%integral(irho) = &
826  coreimpur_new(1)%diagnosticsum%energy%sum%integral(irho) + sum_los_int(irho)
827  ENDDO
828 
829  coresource_new(1)%VALUES(1)%se%exp = se_exp
830  coresource_new(1)%VALUES(1)%qe%exp = - qrad
831  coresource_new(1)%VALUES(1)%rho_tor = rho
832  coresource_new(1)%VALUES(1)%rho_tor_norm = rho/rho(nrho)
833 
834 
835 
836  DEALLOCATE (aneut)
837  DEALLOCATE (nz1)
838  DEALLOCATE (nzm1)
839  DEALLOCATE (diff)
840  DEALLOCATE (vcon)
841  DEALLOCATE (dnz1)
842  DEALLOCATE (flux)
843  DEALLOCATE (flux_inter)
844  DEALLOCATE (imp_radiation)
845  DEALLOCATE (nz_bnd)
846  DEALLOCATE (nz_bnd_type)
847  DEALLOCATE (nzsource)
848 ! for radiation
849  DEALLOCATE (lin_rad1)
850  DEALLOCATE (brem_rad1)
851  DEALLOCATE (r_lin_int1)
852  DEALLOCATE (r_brem_int1)
853  DEALLOCATE (r_sum_int1)
854  DEALLOCATE (e_jon_int1)
855  DEALLOCATE (e_rec_int1)
856  DEALLOCATE (e_sum_int1)
857  DEALLOCATE (jon_en1)
858  DEALLOCATE (rec_los1)
859 
860  WRITE(*,*)'END OF IMPURITY',iimp
861 
862  END DO
863 
864  DEALLOCATE (lin_rad)
865  DEALLOCATE (brem_rad)
866  DEALLOCATE (jon_en)
867  DEALLOCATE (rec_los)
868  DEALLOCATE (r_lin_int)
869  DEALLOCATE (r_brem_int)
870  DEALLOCATE (r_sum_int)
871  DEALLOCATE (e_jon_int)
872  DEALLOCATE (e_rec_int)
873  DEALLOCATE (e_sum_int)
874  DEALLOCATE (sum_lin_int)
875  DEALLOCATE (sum_brem_int)
876  DEALLOCATE (sum_rad_int)
877  DEALLOCATE (sum_jon_int)
878  DEALLOCATE (sum_rec_int)
879  DEALLOCATE (sum_los_int)
880 !27.10.2017
881  DEALLOCATE (tti)
882 
883 
884 
885 
886  DEALLOCATE (rho)
887  DEALLOCATE (vol)
888  DEALLOCATE (vpr)
889  DEALLOCATE (vprm)
890  DEALLOCATE (g3)
891  DEALLOCATE (ne)
892  DEALLOCATE (te)
893  DEALLOCATE (fun_out)
894  DEALLOCATE (qrad)
895  DEALLOCATE (se_exp)
896  DEALLOCATE (fun)
897  DEALLOCATE (nzimp)
898  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
899 
900  ALLOCATE (coresource_new(1)%VALUES(1)%sourceid%id(1))
901  ALLOCATE (coresource_new(1)%VALUES(1)%sourceid%description(1))
902  coresource_new(1)%VALUES(1)%sourceid%id = 'impurity'
903  coresource_new(1)%VALUES(1)%sourceid%flag = 29
904  coresource_new(1)%VALUES(1)%sourceid%description = 'Impurity source'
905 
906 
907  WRITE (*,*) 'IMPURITY finished <==========='
908  WRITE (*,*) ' '
909 
910 
911  RETURN
912 
913  entry impurity_finish
914 
915  DO iimp = 1, SIZE(amns_ei, dim=2)
916  DO izimp = 0, SIZE(amns_ei, dim=1)-1
917 ! if(allocated(amns_ei(izimp, iimp))) then
918  CALL itm_amns_finish_table(amns_ei(izimp, iimp))
919 ! endif
920  ENDDO
921  ENDDO
922  DO iimp = 1, SIZE(amns_rc, dim=2)
923  DO izimp = 0, SIZE(amns_rc, dim=1)-1
924 ! if(allocated(amns_rc(izimp, iimp))) then
925  CALL itm_amns_finish_table(amns_rc(izimp, iimp))
926 ! endif
927  ENDDO
928  ENDDO
929  DO iimp = 1, SIZE(amns_eip, dim=2)
930  DO izimp = 0, SIZE(amns_eip, dim=1)-1
931 ! if(allocated(amns_eip(izimp, iimp))) then
932  CALL itm_amns_finish_table(amns_eip(izimp, iimp))
933 ! endif
934  ENDDO
935  ENDDO
936  DO iimp = 1, SIZE(amns_lr, dim=2)
937  DO izimp = 0, SIZE(amns_lr, dim=1)-1
938 ! if(allocated(amns_lr(izimp, iimp))) then
939  CALL itm_amns_finish_table(amns_lr(izimp, iimp))
940 ! endif
941  ENDDO
942  ENDDO
943  DO iimp = 1, SIZE(amns_br, dim=2)
944  DO izimp = 0, SIZE(amns_br, dim=1)-1
945 ! if(allocated(amns_br(izimp, iimp))) then
946  CALL itm_amns_finish_table(amns_br(izimp, iimp))
947 ! endif
948  ENDDO
949  ENDDO
950  !WRITE(*,*) 'Calling ITM_AMNS_FINISH'
951  CALL itm_amns_finish(amns)
952  !WRITE(*,*) 'deallocating amns_ei'
953  DEALLOCATE(amns_ei)
954  !WRITE(*,*) 'deallocating amns_rc'
955  DEALLOCATE(amns_rc)
956  !WRITE(*,*) 'deallocating amns_eip'
957  DEALLOCATE(amns_eip)
958  !WRITE(*,*) 'deallocating amns_lr'
959  DEALLOCATE(amns_lr)
960  !WRITE(*,*) 'deallocating amns_br'
961  DEALLOCATE(amns_br)
962  !WRITE(*,*) 'returning'
963 
964 
965 
966  RETURN
967 
968  END SUBROUTINE impurity_ets
969 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
970 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
971 
972 
973 
974 
975 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
976 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
977  SUBROUTINE writeoutimpur (ITIME_OUT,COREIMPUR)
978 
979 
980  USE euitm_schemas
981  USE itm_types
982  IMPLICIT NONE
983 
984  TYPE (type_coreimpur), POINTER :: coreimpur(:)
985 
986 ! +++ Internal parameters:
987  INTEGER :: nrho
988  INTEGER :: nimp
989  INTEGER, ALLOCATABLE :: nzimp(:)
990  integer :: itime_out
991  integer :: iimp
992  integer :: irho,izimp
993 
994  REAL (R8), ALLOCATABLE :: rho(:)
995 
996  CHARACTER (33) :: filename
997 
998 
999  nrho = SIZE (coreimpur(1)%rho_tor)
1000  nimp = SIZE (coreimpur(1)%IMPURITY)
1001  ALLOCATE (nzimp(nimp))
1002  DO iimp = 1, nimp
1003  nzimp(iimp) = SIZE (coreimpur(1)%IMPURITY(iimp)%nz, dim=2)
1004  END DO
1005 
1006 
1007  ALLOCATE (rho(nrho))
1008  rho = coreimpur(1)%RHO_TOR
1009 
1010  DO iimp=1,nimp
1011  WRITE(filename,'(a,i1.1,a,i7.7,a)') 'eq_ets_data/OUTIM',iimp,'/IMP',itime_out,'.DAT'
1012  OPEN (unit=20, file=filename)
1013  loop_irho: DO irho = 1, nrho
1014  WRITE (20,'(101(1x,e14.7))') rho(irho), (coreimpur(1)%IMPURITY(iimp)%nz(irho,izimp), izimp=1,nzimp(iimp)), &
1015  (coreimpur(1)%impurity(iimp)%diagnostic%radiation%line_rad%profile(irho,izimp), izimp=1,nzimp(iimp)),&
1016  (coreimpur(1)%impurity(iimp)%diagnostic%radiation%line_rad%integral(irho,izimp), izimp=1,nzimp(iimp))
1017 
1018 
1019  END DO loop_irho
1020  CLOSE (20)
1021  END DO
1022 
1023  DEALLOCATE (rho)
1024 
1025  RETURN
1026  END SUBROUTINE writeoutimpur
1027 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1028 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1029 
1030 
1031 
1032 SUBROUTINE integr2(N,X,Y,INTY) !AF 11.Oct.2011 - assumes that Y is zero f0r X.eq.0, just as INTEGR does too...
1033 !-------------------------------------------------------!
1034 ! This subroutine calculates integral of function !
1035 ! Y(X) from X=0 until X=X(N) !
1036 !-------------------------------------------------------!
1037 
1038  use itm_types
1039 
1040  IMPLICIT NONE
1041 
1042  INTEGER :: n ! number of radial points (input)
1043  INTEGER :: i
1044 
1045  REAL (R8) :: x(n), & ! argument array (input)
1046  y(n), & ! function array (input)
1047  inty(n) ! function integral array (output)
1048 
1049  inty(1)=y(1)*x(1)/2.e0_r8
1050  DO i=2,n
1051  inty(i)=inty(i-1)+(y(i-1)+y(i))*(x(i)-x(i-1))/2.e0_r8
1052  END DO
1053 
1054  RETURN
1055 
1056 END SUBROUTINE integr2
1057 
1058 
1059 
1060 END MODULE impurity
1061 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1062 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
l3deriv
subroutine l3deriv(y_in, x_in, nr_in, dydx_out, x_out, nr_out)
Definition: l3interp.f90:59
impurity
IMPURITY.
Definition: impurity.F90:8
fun
subroutine fun(X, F)
Definition: Ev2.f:10
allocate_deallocate::get_comp_dimensions
subroutine get_comp_dimensions(COMPOSITIONS, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP)
Definition: allocate_deallocate.f90:1845
impurity::impurity_ets
subroutine impurity_ets(EQUILIBRIUM_ITER, COREPROF_ITER, CORETRANSP_ITER, COREIMPUR_OLD, COREIMPUR_ITER, CORENEUTRALS_ITER, CORESOURCE_ITER, CORESOURCE_NEW, COREIMPUR_NEW, CONTROL_INTEGER, CONTROL_DOUBLE)
Definition: impurity.F90:16
integr2
subroutine integr2(N, X, Y, INTY)
Definition: main_plasma.f90:3944
flux
subroutine flux(psitok, rk, zk, nk)
Definition: EQ1_m.f:786
impurity_one
subroutine impurity_one(TE, NE, NZ1, NZM1, VPR, VPRM, R0, BT, BTPRIME, DIFF, FLUX, FLUX_INTER, rho, VCONV, NRHO, SIMP2, NSOURCE, NZ_BND, NZ_BND_TYPE, control_double, CONTROL_INTEGER, G1, IMP_RADIATION, SE_EXP, max_nzimp)
Definition: impurity_one.F90:11
l3interp
subroutine l3interp(y_in, x_in, nr_in, y_out, x_out, nr_out)
Definition: l3interp.f90:1
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
allocate_deallocate::allocate_coresource_cpo
subroutine allocate_coresource_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORESOURCE)
This routine allocates CORESOURCE CPO.
Definition: allocate_deallocate.f90:460
impurity::writeoutimpur
subroutine writeoutimpur(ITIME_OUT, COREIMPUR)
Definition: impurity.F90:977