ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
impurity_manipulator2.f90
Go to the documentation of this file.
1 !----------------------------------------------------------
2 !----------------------------------------------------------
3  SUBROUTINE impurity_manipulator2(COREPROF, COREIMPUR_IN, COREIMPUR, code_parameters)
4  !----------------------------------------------------------
5  !-------------------------------------------------------!
6  ! This routine generates analythical profiles !
7  ! for impurity ion densities !
8  ! (No atomic processes are included!!!) !
9  !-------------------------------------------------------!
10  ! Source: --- !
11  ! Developers: D.Kalupin, P. Strand !
12  ! Contacts: Denis.Kalupin@euro-fusion.org, !
13  ! par.strand@chalmers.se !
14  ! !
15  ! Comments: created for the ETS !
16  ! !
17  !-------------------------------------------------------!
18  !----------------------------------------------------------
19 
20 
21  ! +++ Declaration of variables:
22  USE coronal
23  USE ets_plasma
24  USE euitm_schemas
25  USE itm_types
26  USE copy_structures
27  USE manipulator_type
28  USE manipulator_tools
29 
30 
31  IMPLICIT NONE
32 
33  ! +++ CPO derived types:
34  TYPE (type_coreprof), POINTER :: coreprof(:) !input CPO with plasma profiles
35  TYPE (type_coreimpur), POINTER :: coreimpur_in(:) !input CPO with a fully defined species
36  TYPE (type_coreimpur), POINTER :: coreimpur(:) !output CPO with species uploaded from the data base
37 
38 ! +++ configuration parameters:
39  TYPE (type_param) :: code_parameters
40  TYPE (manipulator_param) :: param
41 
42 ! +++ warnings & errors:
43  TYPE (diagnostic) :: diag !diagnostic output
44 
45  INTEGER :: iimp
46 
47  diag%ERROR_MESSAGE = ""
48  diag%IERR = 0
49 
50 
51 !----------------------------------------------------------
52 !Assign manipulator data:
53  CALL assign_code_parameters(code_parameters, param, diag)
54  IF (diag%IERR .LT. 0) goto 112
55 
56 !Set output CPO and Compositions:
57  CALL copy_cpo(coreimpur_in, coreimpur)
58 
59 !Set output Profiles:
60  DO iimp = 1, min(param%NIMP,SIZE(coreimpur(1)%IMPURITY))
61  IF(trim(adjustl(param%PROFILE(iimp))).EQ."constant") THEN
62  coreimpur(1)%IMPURITY(iimp)%nz(:,:) =0.0_r8
63  CALL constant_profiles(iimp, param, coreimpur, diag)
64  IF (diag%IERR .LT. 0) goto 112
65  END IF
66 
67  IF(trim(adjustl(param%PROFILE(iimp))).EQ."derived") THEN
68  coreimpur(1)%IMPURITY(iimp)%nz(:,:) =0.0_r8
69  CALL derive_profiles(iimp, param, coreprof, coreimpur, diag)
70  IF (diag%IERR .LT. 0) goto 112
71  END IF
72 
73  IF(trim(adjustl(param%PROFILE(iimp))).EQ."coronal") THEN
74  coreimpur(1)%IMPURITY(iimp)%nz(:,:) =0.0_r8
75  CALL coronal_profiles(iimp, param, coreprof, coreimpur, diag)
76  IF (diag%IERR .LT. 0) goto 112
77  END IF
78  END DO
79 
80 
81 112 ALLOCATE (coreimpur(1)%codeparam%codename(1))
82  ALLOCATE (coreimpur(1)%codeparam%codeversion(1))
83  ALLOCATE (coreimpur(1)%codeparam%output_diag(1))
84 
85  coreimpur(1)%codeparam%codename = 'IMPURITY MANIPULATOR'
86  coreimpur(1)%codeparam%codeversion = 'IMPURITY MANIPULATOR_4.10b.10'
87  coreimpur(1)%codeparam%output_flag = diag%IERR
88  coreimpur(1)%codeparam%output_diag(1) = "IMPURITY MANIPULATOR: "//trim(adjustl(diag%ERROR_MESSAGE))
89 
90 
91  RETURN
92 
93  CONTAINS
94 !----------------------------------------------------------
95 !----------------------------------------------------------
96  SUBROUTINE assign_code_parameters(code_parameters, PARAM, DIAG)
97 
98  USE euitm_xml_parser
99 
100  IMPLICIT NONE
101 
102  TYPE (manipulator_param) :: param
103  TYPE (diagnostic) :: diag
104 
105  TYPE(type_param) :: code_parameters
106 
107  TYPE(tree) :: parameter_list
108  TYPE(element), POINTER :: temp_pointer
109  INTEGER(ITM_I4) :: nparam
110  CHARACTER(len = 132) :: parameter_value
111  CHARACTER(len = 264) :: code_param_name
112  CHARACTER(len = 6) :: cvalue(10)
113  REAL (R8) :: value(10)
114  INTEGER :: nval
115 
116  INTEGER :: nimp
117  INTEGER :: max_z_imp
118  LOGICAL :: imp_element(3) = .false.
119 
120  INTEGER :: i, iimp, iz
121  INTEGER :: length
122  CHARACTER(len = 132) :: prefix
123 
124  diag%IERR = 0
125  diag%ERROR_MESSAGE = " "
126 
127 !-- parse xml-string codeparameters%parameters
128  CALL euitm_xml_parse(code_parameters, nparam, parameter_list)
129 
130 !-- check the number of impurities and their highest ionization state:
131  nimp = 0
132  max_z_imp = 0
133 
134  temp_pointer => parameter_list%first
135  code_param_name = 'parameters/IMPURITY1/Define_impurity/zn'
136  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
137  IF (len(trim(parameter_value)).GE.1) THEN
138  nimp = nimp + 1
139  imp_element(1) = .true.
140  CALL scan_str2real(parameter_value, value ,nval)
141  max_z_imp = max(max_z_imp, int(value(1)))
142  END IF
143 
144  temp_pointer => parameter_list%first
145  code_param_name = 'parameters/IMPURITY2/Define_impurity/zn'
146  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
147  IF (len(trim(parameter_value)).GE.1) THEN
148  nimp = nimp + 1
149  imp_element(2) = .true.
150  CALL scan_str2real(parameter_value, value ,nval)
151  max_z_imp = max(max_z_imp, int(value(1)))
152  END IF
153 
154  temp_pointer => parameter_list%first
155  code_param_name = 'parameters/IMPURITY3/Define_impurity/zn'
156  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
157  IF (len(trim(parameter_value)).GE.1) THEN
158  nimp = nimp + 1
159  imp_element(3) = .true.
160  CALL scan_str2real(parameter_value, value ,nval)
161  max_z_imp = max(max_z_imp, int(value(1)))
162  END IF
163 
164  IF (nimp.GE.0) THEN
165  CALL allocate_manipulator_param(nimp, max_z_imp, param, diag)
166  ELSE
167  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//" ASSIGN_PARAM: no impurities are defined."
168  diag%IERR = diag%IERR+1
169  RETURN
170  END IF
171 
172 
173 !-- check configuration for each impurity:
174  iimp = 0
175  DO i = 1, 3
176  IF (imp_element(i).EQ. .true.) THEN
177  iimp = iimp + 1
178  WRITE (prefix, "(a19,i1,a17)") "parameters/IMPURITY",i,"/Define_impurity/"
179 ! composition:
180  code_param_name = trim(adjustl(prefix))//"amn"
181  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
182  IF (len(trim(parameter_value)).GE.1) THEN
183  CALL scan_str2real(parameter_value, value ,nval)
184  param%AMN_IMP(iimp) = value(1)
185  END IF
186 
187  code_param_name = trim(adjustl(prefix))//"zn"
188  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
189  IF (len(trim(parameter_value)).GE.1) THEN
190  CALL scan_str2real(parameter_value, value ,nval)
191  param%ZN_IMP(iimp) = value(1)
192  END IF
193 
194 
195 
196 
197  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_radially_constant/Densities"
198  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
199  IF (len(trim(parameter_value)).GE.1) THEN
200  param%PROFILE(iimp) = "constant"
201  param%ISTATE(iimp) = "all"
202  CALL scan_str2real(parameter_value, value ,nval)
203  param%DENS(iimp,:) = value(:)
204  IF (nval.LT.param%ZN_IMP(iimp)) THEN
205  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//" you did not specify densities for all ionization states."
206  diag%IERR = diag%IERR+1
207  END IF
208  END IF
209 
210  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/coronal_distribution/Total_Density"
211  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
212  IF (len(trim(parameter_value)).GE.1) THEN
213  param%PROFILE(iimp) = "coronal"
214  param%ISTATE(iimp) = "all"
215  CALL scan_str2real(parameter_value, value ,nval)
216  param%DENS(iimp,1) = value(1)
217  END IF
218 
219 
220  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_proportional_to_source_profile/Fractions"
221  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
222  IF (len(trim(parameter_value)).GE.1) THEN
223  param%PROFILE(iimp) = "derived"
224  param%ISTATE(iimp) = "all"
225  CALL scan_str2real(parameter_value, value ,nval)
226  param%FRA(iimp,:) = value(:)
227  IF (nval.LT.param%ZN_IMP(iimp)) THEN
228  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//" you did not specify fractions for all ionization states."
229  diag%IERR = diag%IERR+1
230  END IF
231 
232  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/amn"
233  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
234  IF (len(trim(parameter_value)).GE.1) THEN
235  param%PROF_SOURCE(iimp) = "selected_ion"
236  CALL scan_str2real(parameter_value, value ,nval)
237  param%AMN_ION(iimp) = value(1)
238  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/zn"
239  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
240  IF (len(trim(parameter_value)).GE.1) THEN
241  CALL scan_str2real(parameter_value, value ,nval)
242  param%ZN_ION(iimp) = value(1)
243  END IF
244  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/zion"
245  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
246  IF (len(trim(parameter_value)).GE.1) THEN
247  CALL scan_str2real(parameter_value, value ,nval)
248  param%Z_ION(iimp) = value(1)
249  END IF
250  ELSE
251  param%PROF_SOURCE(iimp) = "ions_total"
252  END IF
253 
254  code_param_name = trim(adjustl(prefix))//"ionization_states/all/Profiles/all_proportional_to_source_profile/Source_profile/electrons/NOTE"
255  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
256  IF (len(trim(parameter_value)).GE.1) THEN
257  param%PROF_SOURCE(iimp) = "electrons"
258  END IF
259  END IF
260 
261 
262 
263  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/radially_constant/Density"
264  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
265  IF (len(trim(parameter_value)).GE.1) THEN
266  param%PROFILE(iimp) = "constant"
267  param%ISTATE(iimp) = "fully_stipped"
268  CALL scan_str2real(parameter_value, value ,nval)
269  param%DENS(iimp,1) = value(1)
270  END IF
271 
272  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/proportional_to_source_profile/Fraction"
273  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
274  IF (len(trim(parameter_value)).GE.1) THEN
275  param%PROFILE(iimp) = "derived"
276  param%ISTATE(iimp) = "fully_stipped"
277  CALL scan_str2real(parameter_value, value ,nval)
278  param%FRA(iimp,param%ZN_IMP(iimp)) = value(1)
279 
280  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/amn"
281  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
282  IF (len(trim(parameter_value)).GE.1) THEN
283  param%PROF_SOURCE(iimp) = "selected_ion"
284  CALL scan_str2real(parameter_value, value ,nval)
285  param%AMN_ION(iimp) = value(1)
286  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/zn"
287  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
288  IF (len(trim(parameter_value)).GE.1) THEN
289  CALL scan_str2real(parameter_value, value ,nval)
290  param%ZN_ION(iimp) = value(1)
291  END IF
292  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/proportional_to_source_profile/Source_profile/ions/extrapolate_from/selected_ion/zion"
293  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
294  IF (len(trim(parameter_value)).GE.1) THEN
295  CALL scan_str2real(parameter_value, value ,nval)
296  param%Z_ION(iimp) = value(1)
297  END IF
298  ELSE
299  param%PROF_SOURCE(iimp) = "ions_total"
300  END IF
301 
302  code_param_name = trim(adjustl(prefix))//"ionization_states/fully_stripped_state_only/Profile/proportional_to_source_profile/Source_profile/electrons/NOTE"
303  CALL find_parameter_test(code_param_name, parameter_value, temp_pointer)
304  IF (len(trim(parameter_value)).GE.1) THEN
305  param%PROF_SOURCE(iimp) = "electrons"
306  END IF
307 
308  END IF
309 
310  IF (trim(adjustl(param%ISTATE(iimp))).EQ."all") THEN
311  DO iz=1,int(param%ZN_IMP(iimp))
312  param%Z_IMP(iimp,iz) = iz
313  END DO
314  ELSE IF (trim(adjustl(param%ISTATE(iimp))).EQ."fully_stipped") THEN
315  param%Z_IMP(iimp,1) = int(param%ZN_IMP(iimp))
316  END IF
317 
318 
319  END IF
320  END DO
321 
322 
323  RETURN
324 
325  END SUBROUTINE assign_code_parameters
326 !----------------------------------------------------------
327 !----------------------------------------------------------
328 
329 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
330 !TEST ROUTINES FROM MICHAL: TO BE REMOVED AFTER
331 ! INTEGRATING THEM INTO XMLLIB !!!!
332 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
333 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
334 SUBROUTINE find_parameter_test(mko_str, mko_value, mko_parameters_ptr)
335  use string_manipulation_tools
336  CHARACTER(len=264), INTENT(in) :: mko_str
337  CHARACTER(len=132), INTENT(out) :: mko_value
338  TYPE(element), POINTER :: mko_temp_pointer
339  TYPE(element), POINTER :: mko_found_element
340  TYPE(element), POINTER, INTENT(in) :: mko_parameters_ptr
341  INTEGER :: mko_pos1 = 1, mko_pos2=10000, mko_n = 0, mko_i
342  ! there are few strong assumptions
343  ! 1. we assume that no parameter will be longer than 132
344  ! 2. we assume that the deepth of the tree will be not bigger than 10 levels down
345  CHARACTER(len=264) :: mko_word(30)
346 
347  mko_value = ''
348  mko_word = ''
349  mko_n = 0
350  mko_pos1 = 1
351  mko_pos2 = 10000
352 
353  mko_temp_pointer => mko_parameters_ptr
354 
355  DO
356  mko_pos2 = index(mko_str(mko_pos1:), "/")
357  IF (mko_pos2 == 0) THEN
358  mko_n = mko_n + 1
359  mko_word(mko_n) = mko_str(mko_pos1:)
360  EXIT
361  END IF
362  mko_n = mko_n + 1
363  mko_word(mko_n) = mko_str(mko_pos1:mko_pos1+mko_pos2-2)
364  mko_pos1 = mko_pos2+mko_pos1
365  END DO
366 
367 ! we have the whole tree here, now we have to traverse the elements
368 
369  DO mko_i = 1, mko_n
370  ! at each level, we have to check whether we have correct name
371  CALL find_element_test(mko_temp_pointer, mko_found_element, mko_word(mko_i) )
372  IF(ASSOCIATED(mko_found_element) .EQV. .false.) THEN
373  mko_value = ''
374  RETURN
375  ELSE
376  IF ( mko_i == mko_n) THEN
377  mko_value = char2str(mko_found_element%cvalue)
378  RETURN
379  ELSE
380  mko_temp_pointer => mko_found_element%child
381  END IF
382  END IF
383  END DO
384  mko_value = ''
385 END SUBROUTINE find_parameter_test
386 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
387 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
388 SUBROUTINE find_element_test(mko_ptr_to_element, mko_return_ptr, mko_cname)
389  use string_manipulation_tools
390  CHARACTER(len=264), INTENT(in) :: mko_cname
391  CHARACTER(len=264) :: mko_tmp_cname
392  TYPE(element), POINTER, INTENT(in) :: mko_ptr_to_element
393  TYPE(element), POINTER, INTENT(out) :: mko_return_ptr
394  TYPE(element), POINTER :: mko_tmp_ptr
395 
396  mko_tmp_ptr => mko_ptr_to_element
397 
398  DO WHILE( ASSOCIATED(mko_tmp_ptr) )
399  mko_tmp_cname = char2str(mko_tmp_ptr%cname)
400  IF ( mko_cname .EQ. mko_tmp_cname) THEN
401  mko_return_ptr => mko_tmp_ptr
402  RETURN
403  END IF
404  mko_tmp_ptr => mko_tmp_ptr%sibling
405  END DO
406  mko_return_ptr => mko_tmp_ptr
407  END SUBROUTINE find_element_test
408 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
409 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
410 
411 
412  END SUBROUTINE impurity_manipulator2
413 !----------------------------------------------------------
414 !----------------------------------------------------------
415 
416 
417 
418 
419 
assign_code_parameters
subroutine assign_code_parameters(codeparameters, return_status)
Definition: emeq.f90:671
manipulator_tools
Definition: manipulator_tools.f90:1
find_element_test
subroutine find_element_test(mko_ptr_to_element, mko_return_ptr, mko_cname)
Definition: impurity_manipulator.f90:368
ets_plasma::diagnostic
Definition: ets_plasma.f90:463
manipulator_tools::coronal_profiles
subroutine coronal_profiles(IIMP, PARAM, COREPROF, COREIMPUR, DIAG)
Definition: manipulator_tools.f90:233
impurity_manipulator2
subroutine impurity_manipulator2(COREPROF, COREIMPUR_IN, COREIMPUR, code_parameters)
Definition: impurity_manipulator2.f90:3
manipulator_tools::constant_profiles
subroutine constant_profiles(IIMP, PARAM, COREIMPUR, DIAG)
Definition: manipulator_tools.f90:123
manipulator_tools::derive_profiles
subroutine derive_profiles(IIMP, PARAM, COREPROF, COREIMPUR, DIAG)
Definition: manipulator_tools.f90:162
ets_plasma
The module declares types of variables used in ETS (transport code)
Definition: ets_plasma.f90:8
find_parameter_test
subroutine find_parameter_test(mko_str, mko_value, mko_parameters_ptr)
Definition: impurity_manipulator.f90:314
manipulator_type::manipulator_param
Definition: manipulator_type.f90:21
manipulator_type
Definition: manipulator_type.f90:1
manipulator_type::allocate_manipulator_param
subroutine allocate_manipulator_param(NIMP, MAX_Z_IMP, PARAM, DIAG)
Definition: manipulator_type.f90:51