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