ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
delta_combiner.f90
Go to the documentation of this file.
1 MODULE delta_combiner
2 
3 
4 CONTAINS
5 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
6 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
7 
8  !-------------------------------------------------------!
9  ! This routine combines instanteneous changes !
10  ! (DELTAS) from dufferent modules !
11  ! and interpolates them on the COREPROF grid !
12  !-------------------------------------------------------!
13  ! Source: --- !
14  ! Developers: D.Kalupin !
15  ! Kontacts: Denis.Kalupin@efda.org !
16  ! !
17  ! Comments: created for ETS workflow !
18  ! !
19  !-------------------------------------------------------!
20 
21  SUBROUTINE combine_deltas &
22  (coreprof, coredelta1, coredelta2, &
23  coredelta_out, code_parameters)
24 
25  USE allocate_deallocate
26 
27  USE itm_constants
28  USE euitm_routines
29  USE euitm_schemas
30  USE euitm_xml_parser
31  USE deallocate_structures
32  USE interpolate_cpo
33  USE copy_structures
34 
35  IMPLICIT NONE
36 
37 
38  INTEGER, PARAMETER :: num_delta=2
39 
40 
41 ! +++ CPOs
42  TYPE (type_coreprof), POINTER :: coreprof(:)
43 
44  TYPE (type_coredelta), POINTER :: coredelta1(:)
45  TYPE (type_coredelta), POINTER :: coredelta2(:)
46  TYPE (type_coredelta), POINTER :: coredelta_out(:)
47  TYPE (type_coredelta), POINTER :: coredelta_arr(:)
48 
49  TYPE (type_param) :: code_parameters
50 
51 
52 
53 ! +++ Control parameters:
54  REAL (R8), SAVE :: c_psi(num_delta) = 0.0_r8
55  REAL (R8), SAVE :: c_te(num_delta) = 0.0_r8
56  REAL (R8), SAVE :: c_ne(num_delta) = 0.0_r8
57  REAL (R8), SAVE :: c_ti(num_delta) = 0.0_r8
58  REAL (R8), SAVE :: c_ni(num_delta) = 0.0_r8
59  REAL (R8), SAVE :: c_tz(num_delta) = 0.0_r8
60  REAL (R8), SAVE :: c_nz(num_delta) = 0.0_r8
61  REAL (R8), SAVE :: c_vtor(num_delta) = 0.0_r8
62 
63  REAL (R8), ALLOCATABLE :: rho_tor(:)
64 
65 
66 
67  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
68  INTEGER :: nrho, irho !number of radial points (input, determined from COREPROF CPO)
69  INTEGER :: nnucl !number of nuclei species
70  INTEGER :: nion, iion !number of ion species
71  INTEGER :: nimp, iimp !number of impurity species
72  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
73  INTEGER :: nneut, ineut !number of neutrals species
74  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
75  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
76 
77 
78  INTEGER :: inum, ival, iarr
79  INTEGER :: return_status
80 
81 
82 
83 
84 
85  CALL assign_combiner_parameters(code_parameters, return_status)
86 
87  IF (return_status /= 0) THEN
88  WRITE(*,*) 'ERROR: Could not assign delta multipliers.'
89  END IF
90 
91 
92 
93 
94 ! +++ OUTPUT DELTA CPO:
95  nrho = SIZE(coreprof(1)%rho_tor)
96  ALLOCATE (rho_tor(nrho))
97 
98  CALL get_comp_dimensions(coreprof(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
99 
100  CALL allocate_coredelta_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coredelta_out)
101  CALL allocate_coredelta_cpo(num_delta, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coredelta_arr)
102 
103  CALL deallocate_cpo(coredelta_out(1)%compositions)
104  CALL copy_cpo(coreprof(1)%compositions, coredelta_out(1)%compositions)
105 
106 
107  rho_tor = coreprof(1)%rho_tor
108  coredelta_out(1)%VALUES(1)%rho_tor = rho_tor
109 
110  DO inum=1,num_delta
111  coredelta_arr(inum)%VALUES(1)%rho_tor = coredelta_out(1)%VALUES(1)%rho_tor
112  CALL deallocate_cpo(coredelta_arr(inum)%compositions)
113  CALL copy_cpo(coredelta_out(1)%compositions, coredelta_arr(inum)%compositions)
114  END DO
115 
116 
117 ! +++ Interpolate delta profiles on the output grid:
118  CALL interpolate_delta(coredelta1(1), coredelta_arr(1))
119  CALL interpolate_delta(coredelta2(1), coredelta_arr(2))
120 
121 
122 
123 ! +++ Combines deltas:
124  DO inum=1, num_delta
125 ! psi
126  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_psi) .AND. c_psi(inum).NE.0.0_r8) &
127  coredelta_out(1)%VALUES(1)%delta_psi = coredelta_out(1)%VALUES(1)%delta_psi + &
128  coredelta_arr(inum)%VALUES(1)%delta_psi * c_psi(inum)
129 ! ne
130  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_ne) .AND. c_ne(inum).NE.0.0_r8) &
131  coredelta_out(1)%VALUES(1)%delta_ne = coredelta_out(1)%VALUES(1)%delta_ne + &
132  coredelta_arr(inum)%VALUES(1)%delta_ne * c_ne(inum)
133 ! te
134  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_te) .AND. c_te(inum).NE.0.0_r8) &
135  coredelta_out(1)%VALUES(1)%delta_te = coredelta_out(1)%VALUES(1)%delta_te + &
136  coredelta_arr(inum)%VALUES(1)%delta_te * c_te(inum)
137 ! ni
138  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_ni) .AND. c_ni(inum).NE.0.0_r8) &
139  coredelta_out(1)%VALUES(1)%delta_ni = coredelta_out(1)%VALUES(1)%delta_ni + &
140  coredelta_arr(inum)%VALUES(1)%delta_ni * c_ni(inum)
141 ! ti
142  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_ti) .AND. c_ti(inum).NE.0.0_r8) &
143  coredelta_out(1)%VALUES(1)%delta_ti = coredelta_out(1)%VALUES(1)%delta_ti + &
144  coredelta_arr(inum)%VALUES(1)%delta_ti * c_ti(inum)
145 ! vtor
146  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%delta_vtor) .AND. c_vtor(inum).NE.0.0_r8) &
147  coredelta_out(1)%VALUES(1)%delta_vtor = coredelta_out(1)%VALUES(1)%delta_vtor + &
148  coredelta_arr(inum)%VALUES(1)%delta_vtor* c_vtor(inum)
149  DO iimp = 1, nimp
150 ! nz
151  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%IMPURITY(iimp)%delta_nz) .AND. c_nz(inum).NE.0.0_r8) &
152  coredelta_out(1)%VALUES(1)%IMPURITY(iimp)%delta_nz = coredelta_out(1)%VALUES(1)%IMPURITY(iimp)%delta_nz + &
153  coredelta_arr(inum)%VALUES(1)%IMPURITY(iimp)%delta_nz * c_nz(inum)
154 ! tz
155  IF (ASSOCIATED(coredelta_arr(inum)%VALUES(1)%IMPURITY(iimp)%delta_tz) .AND. c_tz(inum).NE.0.0_r8) &
156  coredelta_out(1)%VALUES(1)%IMPURITY(iimp)%delta_tz = coredelta_out(1)%VALUES(1)%IMPURITY(iimp)%delta_tz + &
157  coredelta_arr(inum)%VALUES(1)%IMPURITY(iimp)%delta_tz * c_tz(inum)
158  END DO
159  END DO
160 
161 
162 
163 
164 
165 
166 ! +++ Deallocation of internal variables:
167  IF(ALLOCATED(rho_tor)) DEALLOCATE ( rho_tor )
168  IF(ALLOCATED(nzimp)) DEALLOCATE ( nzimp )
169  IF(ALLOCATED(ncomp)) DEALLOCATE ( ncomp )
170  IF(ALLOCATED(ntype)) DEALLOCATE ( ntype )
171  CALL deallocate_cpo(coredelta_arr)
172 
173 
174 
175 ! +++ ADD IDENTIFIER TO OUTPUT CPO VALUES(1):
176  ALLOCATE (coredelta_out(1)%VALUES(1)%deltaid%id(1))
177  ALLOCATE (coredelta_out(1)%VALUES(1)%deltaid%description(1))
178  coredelta_out(1)%VALUES(1)%deltaid%id = 'combined'
179  coredelta_out(1)%VALUES(1)%deltaid%flag = 4
180  coredelta_out(1)%VALUES(1)%deltaid%description = 'Combined coredelta'
181 
182 
183 
184 
185 ! +++ COPY INDIVIDUAL INPUT DELTAS TO OUTPUT CPO:
186  ALLOCATE (coredelta_arr(num_delta+1))
187  CALL copy_cpo(coredelta_out(1), coredelta_arr(1))
188  CALL copy_cpo(coredelta1(1), coredelta_arr(2))
189  CALL copy_cpo(coredelta2(1), coredelta_arr(3))
190  CALL deallocate_cpo(coredelta_out(1)%VALUES)
191  ALLOCATE (coredelta_out(1)%VALUES(1+SIZE(coredelta1(1)%VALUES)+SIZE(coredelta2(1)%VALUES)))
192 
193 
194  ival = 1
195  DO inum = 1, num_delta+1
196  DO iarr = 1, SIZE(coredelta_arr(inum)%VALUES)
197  CALL copy_cpo(coredelta_arr(inum)%VALUES(iarr), coredelta_out(1)%VALUES(ival))
198  ival = ival + 1
199  END DO
200  END DO
201 
202 
203  CALL deallocate_cpo(coredelta_arr)
204 
205 
206  RETURN
207 
208 
209  CONTAINS
210 
211 
212 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
213 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
214  SUBROUTINE assign_combiner_parameters(codeparameters, return_status)
215 
216  !-------------------------------------------------------!
217  ! This subroutine calls the XML parser for !
218  ! the combiner parameters and assign the !
219  ! resulting values to the corresponding variables !
220  !-------------------------------------------------------!
221  ! Delta: --- !
222  ! Developers: D.Kalupin !
223  ! Kontacts: Denis.Kalupin@efda.org !
224  ! !
225  ! Comments: created for V&V between ETS and !
226  ! ASTRA !
227  ! !
228  !-------------------------------------------------------!
229 
230  USE itm_types
231  USE euitm_schemas
232  USE euitm_xml_parser
233 
234  IMPLICIT NONE
235 
236 
237  TYPE(type_param) :: codeparameters
238  INTEGER(ITM_I4) :: return_status
239 
240  TYPE(tree) :: parameter_list
241  TYPE(element), POINTER :: temp_pointer
242  INTEGER(ITM_I4) :: i, nparm, n_values
243  CHARACTER(len = 132) :: cname
244  CHARACTER(len = 132) :: code_param_name
245  CHARACTER(len = 132) :: parameter_value
246  REAL (R8), SAVE :: value(1) = 0.0_r8
247 
248  INTEGER :: n_data
249 
250  return_status = 0
251 
252  c_psi = 0.0_r8
253  c_te = 0.0_r8
254  c_ne = 0.0_r8
255  c_ti = 0.0_r8
256  c_ni = 0.0_r8
257  c_tz = 0.0_r8
258  c_nz = 0.0_r8
259  c_vtor = 0.0_r8
260 
261 !-- parse xml-string codeparameters%parameters
262  CALL euitm_xml_parse(codeparameters, nparm, parameter_list)
263 
264  temp_pointer => parameter_list%first
265  code_param_name = 'parameters/PSI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
266  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
267  IF (len(trim(parameter_value)).GE.1) THEN
268  CALL scan_str2real(parameter_value, value, n_data)
269  c_psi(1) = value(1)
270  END IF
271  temp_pointer => parameter_list%first
272  code_param_name = 'parameters/PSI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
273  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
274  IF (len(trim(parameter_value)).GE.1) THEN
275  CALL scan_str2real(parameter_value, value, n_data)
276  c_psi(2) = value(1)
277  END IF
278  temp_pointer => parameter_list%first
279  code_param_name = 'parameters/NE/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
280  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
281  IF (len(trim(parameter_value)).GE.1) THEN
282  CALL scan_str2real(parameter_value, value, n_data)
283  c_ne(1) = value(1)
284  END IF
285  temp_pointer => parameter_list%first
286  code_param_name = 'parameters/NE/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
287  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
288  IF (len(trim(parameter_value)).GE.1) THEN
289  CALL scan_str2real(parameter_value, value, n_data)
290  c_ne(2) = value(1)
291  END IF
292  temp_pointer => parameter_list%first
293  code_param_name = 'parameters/TE/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
294  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
295  IF (len(trim(parameter_value)).GE.1) THEN
296  CALL scan_str2real(parameter_value, value, n_data)
297  c_te(1) = value(1)
298  END IF
299  temp_pointer => parameter_list%first
300  code_param_name = 'parameters/TE/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
301  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
302  IF (len(trim(parameter_value)).GE.1) THEN
303  CALL scan_str2real(parameter_value, value, n_data)
304  c_te(2) = value(1)
305  END IF
306  temp_pointer => parameter_list%first
307  code_param_name = 'parameters/NI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
308  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
309  IF (len(trim(parameter_value)).GE.1) THEN
310  CALL scan_str2real(parameter_value, value, n_data)
311  c_ni(1) = value(1)
312  END IF
313  temp_pointer => parameter_list%first
314  code_param_name = 'parameters/NI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
315  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
316  IF (len(trim(parameter_value)).GE.1) THEN
317  CALL scan_str2real(parameter_value, value, n_data)
318  c_ni(2) = value(1)
319  END IF
320  temp_pointer => parameter_list%first
321  code_param_name = 'parameters/TI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
322  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
323  IF (len(trim(parameter_value)).GE.1) THEN
324  CALL scan_str2real(parameter_value, value, n_data)
325  c_ti(1) = value(1)
326  END IF
327  temp_pointer => parameter_list%first
328  code_param_name = 'parameters/TI/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
329  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
330  IF (len(trim(parameter_value)).GE.1) THEN
331  CALL scan_str2real(parameter_value, value, n_data)
332  c_ti(2) = value(1)
333  END IF
334  temp_pointer => parameter_list%first
335  code_param_name = 'parameters/VTOR/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
336  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
337  IF (len(trim(parameter_value)).GE.1) THEN
338  CALL scan_str2real(parameter_value, value, n_data)
339  c_vtor(1) = value(1)
340  END IF
341  temp_pointer => parameter_list%first
342  code_param_name = 'parameters/VTOR/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
343  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
344  IF (len(trim(parameter_value)).GE.1) THEN
345  CALL scan_str2real(parameter_value, value, n_data)
346  c_vtor(2) = value(1)
347  END IF
348  temp_pointer => parameter_list%first
349  code_param_name = 'parameters/NZ/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
350  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
351  IF (len(trim(parameter_value)).GE.1) THEN
352  CALL scan_str2real(parameter_value, value, n_data)
353  c_nz(1) = value(1)
354  END IF
355  temp_pointer => parameter_list%first
356  code_param_name = 'parameters/NZ/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
357  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
358  IF (len(trim(parameter_value)).GE.1) THEN
359  CALL scan_str2real(parameter_value, value, n_data)
360  c_nz(2) = value(1)
361  END IF
362  temp_pointer => parameter_list%first
363  code_param_name = 'parameters/PTZ/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_pellet'
364  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
365  IF (len(trim(parameter_value)).GE.1) THEN
366  CALL scan_str2real(parameter_value, value, n_data)
367  c_tz(1) = value(1)
368  END IF
369  temp_pointer => parameter_list%first
370  code_param_name = 'parameters/TZ/COMBINE_CONTRIBUTIONS_WITH_WEIGHTS/from_sawtooth'
371  CALL find_parameter(code_param_name, parameter_value, temp_pointer)
372  IF (len(trim(parameter_value)).GE.1) THEN
373  CALL scan_str2real(parameter_value, value, n_data)
374  c_tz(2) = value(1)
375  END IF
376 
377 
378 
379 
380 !-- destroy tree
381  CALL destroy_xml_tree(parameter_list)
382 
383 
384  RETURN
385 
386  END SUBROUTINE assign_combiner_parameters
387 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
388 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
389 
390 
391  END SUBROUTINE combine_deltas
392 
393 
394 
395 END MODULE delta_combiner
interpolate_cpo
Definition: interpolate_cpo.f90:1
allocate_deallocate::allocate_coredelta_cpo
subroutine allocate_coredelta_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, COREDELTA)
This routine allocates COREDELTA CPO.
Definition: allocate_deallocate.f90:1121
allocate_deallocate::get_comp_dimensions
subroutine get_comp_dimensions(COMPOSITIONS, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP)
Definition: allocate_deallocate.f90:1845
delta3_combiner::combine_deltas
subroutine combine_deltas(COREPROF, COREDELTA1, COREDELTA2, COREDELTA3, COREDELTA_OUT, code_parameters)
Definition: delta3_combiner.f90:21
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
delta_combiner
Definition: delta_combiner.f90:1
assign_combiner_parameters
subroutine assign_combiner_parameters(codeparameters, return_status)
Definition: delta3_combiner.f90:219