ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
fill_cpos.f90
Go to the documentation of this file.
1 MODULE fill_cpos
2 
3 
4 CONTAINS
5 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
6 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
7  SUBROUTINE fillcoreprof (COREPROF_DB, COREPROF_GRID, COREFAST_IN, COREPROF_OUT, INTERPOL)
8 
9 ! +++ Declaration of variables:
10  USE itm_types
11  USE itm_constants
12  USE euitm_schemas
13  USE allocate_deallocate
14  USE copy_structures
15  USE deallocate_structures
16  USE interpolate_cpo
17  use, INTRINSIC :: ieee_arithmetic
18 
19 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
20  IMPLICIT NONE
21 
22  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
23  INTEGER :: nrho1, nrho2, nrho_fast
24 ! REAL (R8), ALLOCATABLE :: RHO1(:), RHO2(:)
25  INTEGER :: nnucl
26  INTEGER :: nion, iion
27  INTEGER :: nimp
28  INTEGER, ALLOCATABLE :: nzimp(:)
29  INTEGER :: nneut
30  INTEGER, ALLOCATABLE :: ncomp(:)
31  INTEGER, ALLOCATABLE :: ntype(:)
32  REAL (R8), ALLOCATABLE :: pperpfast(:,:), rho_tor_fast(:), fun1(:)
33 
34  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
35  INTEGER :: irho
36  INTEGER :: nion_fast, iion_fast, ival
37  INTEGER :: inucl, inucl_fast
38 
39 ! +++ CPO derived types:
40  TYPE (type_coreprof), POINTER :: coreprof_grid(:) !input CPO with internal ETS parameters
41  TYPE (type_coreprof), POINTER :: coreprof_out(:) !output CPO with profiles uploaded from the data base
42  TYPE (type_coreprof), POINTER :: coreprof_db(:) !time independent CPO slice
43  TYPE (type_corefast), POINTER :: corefast_in(:) !time independent CPO slice
44  !temporary fix
45  ! we should be able to change these paraemters through codeparameters
46  REAL (R8), parameter :: temperature_floor = 10.0e0_r8 ! [eV] sets ...
47  REAL (R8), parameter :: density_floor = 1.0e6_r8 ! [m-3] sets ...
48 
49 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
50 
51 
52 ! +++ RHO grid:
53  nrho1 = SIZE (coreprof_grid(1)%rho_tor, dim=1)
54  nrho2 = SIZE (coreprof_db(1)%rho_tor, dim=1)
55 
56 
57 ! +++ Allocate output CPO and internal derived types:
58  CALL get_comp_dimensions(coreprof_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
59  CALL copy_cpo(coreprof_grid, coreprof_out)
60 
61 
62 
63  IF (interpol.NE.0) &
64  coreprof_db(1)%rho_tor = coreprof_db(1)%rho_tor &
65  / coreprof_db(1)%rho_tor(nrho2) &
66  * coreprof_out(1)%rho_tor(nrho1)
67 
68 
69 
70 ! +++ Check for Zeff:
71  IF (ASSOCIATED (coreprof_db(1)%profiles1d%zeff%value)) THEN
72  DO irho = 1, nrho2
73  IF (coreprof_db(1)%profiles1d%zeff%value(irho).LT.1.0_r8) &
74  coreprof_db(1)%profiles1d%zeff%value(irho) = 1.0_r8
75  END DO
76  ELSE
77  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
78  WRITE(*,*) ' ZEFF profile not set --> allocated and set to unity'
79  ALLOCATE (coreprof_db(1)%profiles1d%zeff%value(nrho2))
80  coreprof_db(1)%profiles1d%zeff%value(:) = 1.0_r8
81  END IF
82 
83 ! +++ Interpolate profiles:
84  CALL interpolate_prof(coreprof_db(1), coreprof_out(1))
85 
86 
87 ! find and fix potential problems in profiles data (later move this to a general
88 ! subroutine)
89  where(coreprof_out(1)%te%value.lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%te%value)) &
90  coreprof_out(1)%te%value = temperature_floor
91  where(coreprof_out(1)%ne%value.lt.density_floor .or. ieee_is_nan(coreprof_out(1)%ne%value)) &
92  coreprof_out(1)%ne%value = density_floor
93 
94  DO iion = 1, nion
95  where(coreprof_out(1)%ti%value(:, iion).lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%ti%value(:,iion))) &
96  coreprof_out(1)%ti%value(:, iion) = temperature_floor
97  where(coreprof_out(1)%ni%value(:, iion).lt.density_floor .or. ieee_is_nan(coreprof_out(1)%ni%value(:,iion))) &
98  coreprof_out(1)%ni%value(:, iion) = density_floor
99 
100 
101  IF (coreprof_out(1)%ni%boundary%type(iion) .GE. 6) THEN
102  coreprof_out(1)%ni%boundary%value(1,iion) = coreprof_out(1)%ni%value(nrho1,iion)
103  coreprof_out(1)%ni%boundary%value(2,iion) = 0._r8
104  coreprof_out(1)%ni%boundary%value(3,iion) = 0._r8
105 
106  IF (coreprof_out(1)%ni%boundary%type(iion) .EQ. 6) THEN
107  coreprof_out(1)%ni%boundary%type(iion) = 1
108  ELSE
109  coreprof_out(1)%ni%boundary%type(iion) = 0
110  END IF
111 
112  END IF
113  END DO
114 ! JOFE>
115 
116 ! +++ Check for COCOS13:
117 
118 ! for COCOS 13, Ip > 0 ==> Psi decreasing
119  IF ( coreprof_out(1)%globalparam%current_tot * &
120  (coreprof_out(1)%psi%value(nrho1) - coreprof_out(1)%psi%value(1)) .GE.0.0_r8 ) THEN
121  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
122  WRITE(*,*) 'We have a COCOS violation: Ip > 0 ==> Psi decreasing'
123  WRITE(*,*) 'Ip = ', coreprof_out(1)%globalparam%current_tot
124  WRITE(*,*) 'Psi_a - Psi_0 = ', coreprof_out(1)%psi%value(nrho1)-coreprof_out(1)%psi%value(1)
125 ! stop 'COCOS violation'
126  WRITE(*,*) '!!!! Psi is reverted to be compliant with COCOS13'
127  coreprof_out(1)%psi%value = -1.0_r8 * coreprof_out(1)%psi%value
128  WRITE(*,*) ' '
129  ENDIF
130 
131 ! for COCOS 13, q has the opposite sign to the sign of Ip*B0
132  IF ( coreprof_out(1)%profiles1d%q%value(1) * &
133  coreprof_out(1)%globalparam%current_tot * coreprof_out(1)%toroid_field%b0 .GE. 0.0_r8 ) THEN
134  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
135  WRITE(*,*) 'We have a COCOS violation: Ip*B0*q should be < 0'
136  WRITE(*,*) 'Ip = ', coreprof_out(1)%globalparam%current_tot
137  WRITE(*,*) 'B0 = ', coreprof_out(1)%toroid_field%b0
138  WRITE(*,*) 'q0 = ', coreprof_out(1)%profiles1d%q%value(1)
139 ! stop 'COCOS violation'
140  WRITE(*,*) '!!!! q is reverted to be compliant with COCOS13'
141  coreprof_out(1)%profiles1d%q%value = -1.0_r8 * coreprof_out(1)%profiles1d%q%value
142  WRITE(*,*) ' '
143 
144  ENDIF
145 
146 ! Check the direction of current (should coinside with IP)
147  IF ( coreprof_out(1)%globalparam%current_tot * coreprof_out(1)%profiles1d%jtot%value(1) .LE.0.0_r8 ) THEN
148  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
149  WRITE(*,*) 'We have different sign for IP and Jpar'
150  WRITE(*,*) 'Ip_sign = ', sign(1.0_r8, coreprof_out(1)%globalparam%current_tot)
151  WRITE(*,*) 'Jpar_sign = ', sign(1.0_r8, coreprof_out(1)%profiles1d%jtot%value(1))
152 ! stop 'COCOS violation'
153  WRITE(*,*) '!!!! Jpar profile is reverted to be consistent with total current'
154  coreprof_out(1)%profiles1d%jtot%value = -1.0_r8 * coreprof_out(1)%profiles1d%jtot%value
155  WRITE(*,*) ' '
156  ENDIF
157 
158 
159 
160 ! +++ Boundary conditions from input CPO:
161 
162  IF (coreprof_out(1)%psi%boundary%type .GE. 6) THEN
163  coreprof_out(1)%psi%boundary%value(1) = coreprof_out(1)%psi%value(nrho1)
164  coreprof_out(1)%psi%boundary%value(2) = 0._r8
165  coreprof_out(1)%psi%boundary%value(3) = 0._r8
166 
167  IF (coreprof_out(1)%psi%boundary%type .EQ. 6) THEN
168  coreprof_out(1)%psi%boundary%type = 1
169  ELSE
170  coreprof_out(1)%psi%boundary%type = 0
171  END IF
172 
173 
174  END IF
175 
176  IF (coreprof_out(1)%ne%boundary%type .GE. 6) THEN
177  coreprof_out(1)%ne%boundary%value(1) = coreprof_out(1)%ne%value(nrho1)
178  coreprof_out(1)%ne%boundary%value(2) = 0._r8
179  coreprof_out(1)%ne%boundary%value(3) = 0._r8
180 
181  IF (coreprof_out(1)%ne%boundary%type .EQ. 6) THEN
182  coreprof_out(1)%ne%boundary%type = 1
183  ELSE
184  coreprof_out(1)%ne%boundary%type = 0
185  END IF
186 
187  END IF
188 
189  IF (coreprof_out(1)%te%boundary%type .GE. 6) THEN
190  coreprof_out(1)%te%boundary%value(1) = coreprof_out(1)%te%value(nrho1)
191  coreprof_out(1)%te%boundary%value(2) = 0._r8
192  coreprof_out(1)%te%boundary%value(3) = 0._r8
193 
194  IF (coreprof_out(1)%te%boundary%type .EQ. 6) THEN
195  coreprof_out(1)%te%boundary%type = 1
196  ELSE
197  coreprof_out(1)%te%boundary%type = 0
198  END IF
199 
200  END IF
201 
202  DO iion = 1, nion
203  IF (coreprof_out(1)%ni%boundary%type(iion) .GE. 6) THEN
204  coreprof_out(1)%ni%boundary%value(1,iion) = coreprof_out(1)%ni%value(nrho1,iion)
205  coreprof_out(1)%ni%boundary%value(2,iion) = 0._r8
206  coreprof_out(1)%ni%boundary%value(3,iion) = 0._r8
207 
208  IF (coreprof_out(1)%ni%boundary%type(iion) .EQ. 6) THEN
209  coreprof_out(1)%ni%boundary%type(iion) = 1
210  ELSE
211  coreprof_out(1)%ni%boundary%type(iion) = 0
212  END IF
213 
214  END IF
215 
216  IF (coreprof_out(1)%ti%boundary%type(iion) .GE. 6) THEN
217  coreprof_out(1)%ti%boundary%value(1,iion) = coreprof_out(1)%ti%value(nrho1,iion)
218  coreprof_out(1)%ti%boundary%value(2,iion) = 0._r8
219  coreprof_out(1)%ti%boundary%value(3,iion) = 0._r8
220 
221  IF (coreprof_out(1)%ti%boundary%type(iion) .EQ. 6) THEN
222  coreprof_out(1)%ti%boundary%type(iion) = 1
223  ELSE
224  coreprof_out(1)%ti%boundary%type(iion) = 0
225  END IF
226 
227  END IF
228 
229  IF (coreprof_out(1)%vtor%boundary%type(iion) .GE. 6) THEN
230  coreprof_out(1)%vtor%boundary%value(1,iion) = coreprof_out(1)%vtor%value(nrho1,iion)
231  coreprof_out(1)%vtor%boundary%value(2,iion) = 0._r8
232  coreprof_out(1)%vtor%boundary%value(3,iion) = 0._r8
233 
234  IF (coreprof_out(1)%vtor%boundary%type(iion) .EQ. 6) THEN
235  coreprof_out(1)%vtor%boundary%type(iion) = 1
236  ELSE
237  coreprof_out(1)%vtor%boundary%type(iion) = 0
238  END IF
239 
240  END IF
241 
242  END DO
243 
244 
245 
246 ! +++ Initial Pressure:
247  coreprof_out(1)%profiles1d%pe%value = coreprof_out(1)%te%value * coreprof_out(1)%ne%value * itm_ev
248  coreprof_out(1)%profiles1d%pi%value = coreprof_out(1)%ti%value * coreprof_out(1)%ni%value * itm_ev
249  coreprof_out(1)%profiles1d%pi_tot%value = sum(coreprof_out(1)%profiles1d%pi%value, dim=2)
250  coreprof_out(1)%profiles1d%pr_th%value = coreprof_out(1)%profiles1d%pe%value + sum(coreprof_out(1)%profiles1d%pi%value, dim=2)
251 
252 ! fast particle contribution to the pressure
253 ! (we assume corefast_in is already properly initialized)
254  if (ASSOCIATED(corefast_in(1)%values) .and. ASSOCIATED(corefast_in(1)%COMPOSITIONS%IONS) ) THEN
255  IF(ALLOCATED(fun1)) DEALLOCATE (fun1)
256  ALLOCATE(fun1(nrho1))
257  nion_fast = size(corefast_in(1)%COMPOSITIONS%IONS)
258  ALLOCATE (pperpfast(nrho1, nion))
259  pperpfast = 0.0_r8
260  loop_values : DO ival = 1, size(corefast_in(1)%values)
261  IF (ASSOCIATED(corefast_in(1)%values(ival)%rho_tor)) THEN
262  nrho_fast = size(corefast_in(1)%values(ival)%rho_tor)
263  IF(ALLOCATED(rho_tor_fast)) DEALLOCATE (rho_tor_fast)
264  ALLOCATE(rho_tor_fast(nrho_fast))
265  IF (interpol.NE.0) THEN
266  rho_tor_fast = corefast_in(1)%VALUES(ival)%rho_tor &
267  / corefast_in(1)%VALUES(ival)%rho_tor(nrho_fast) &
268  * coreprof_out(1)%rho_tor(nrho1)
269  ELSE
270  rho_tor_fast = corefast_in(1)%values(ival)%rho_tor
271  ENDIF
272  thermal_ions_loop: DO iion = 1, nion
273  inucl = coreprof_out(1)%COMPOSITIONS%IONS(iion)%nucindex
274  fast_ions_loop: DO iion_fast = 1, nion_fast
275  inucl_fast = corefast_in(1)%COMPOSITIONS%IONS(iion_fast)%nucindex
276  IF (.not. (inucl_fast.LE.0 .OR. inucl_fast.GT.SIZE(corefast_in(1)%COMPOSITIONS%NUCLEI))) THEN
277  check_for_ions_consistency: IF &
278  (abs(coreprof_out(1)%COMPOSITIONS%NUCLEI(inucl)%amn - corefast_in(1)%COMPOSITIONS%NUCLEI(inucl_fast)%amn) .LE. 0.25 .AND. &
279  abs(coreprof_out(1)%COMPOSITIONS%NUCLEI(inucl)%zn - corefast_in(1)%COMPOSITIONS%NUCLEI(inucl_fast)%zn ) .LE. 0.25 .AND. &
280  abs(coreprof_out(1)%COMPOSITIONS%IONS(iion)%zion - corefast_in(1)%COMPOSITIONS%IONS(iion_fast)%zion ) .LE. 0.25) THEN
281  IF(ASSOCIATED(corefast_in(1)%VALUES(ival)%pi)) THEN
282  CALL l3interp(corefast_in(1)%VALUES(ival)%pi(:,iion_fast), rho_tor_fast, nrho_fast, &
283  fun1, coreprof_out(1)%rho_tor, nrho1)
284  pperpfast(:, iion) = pperpfast(:, iion) + fun1(:)
285  ENDIF
286  END IF check_for_ions_consistency
287  ENDIF
288  END DO fast_ions_loop
289  END DO thermal_ions_loop
290  ENDIF
291  ENDDO loop_values
292 
293  coreprof_out(1)%profiles1d%pr_perp%value = coreprof_out(1)%profiles1d%pr_th%value + sum(pperpfast, dim=2)
294 
295 
296  IF(ALLOCATED(rho_tor_fast)) DEALLOCATE (rho_tor_fast)
297  IF(ALLOCATED(fun1)) DEALLOCATE (fun1)
298  IF(ALLOCATED(pperpfast)) DEALLOCATE (pperpfast)
299  ENDIF
300 
301 ! +++ Deallocate internal derived types:
302 
303  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
304  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
305  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
306 
307 
308  RETURN
309 
310 
311  END SUBROUTINE fillcoreprof
312 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
313 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
314 
315 
316 
317 
318 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
319 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
320  SUBROUTINE fillcoreprof2 (COREPROF_DB, COREPROF_GRID, COREFAST_IN, COREPROF_OUT, INTERPOL, &
321  integer_params,real_params,output_flag,diagnostic_info)
322 
323 !dy same as fillcoreprof
324 !with possibility to add stretch and cut option
325 !for profiles
326 
327 ! +++ Declaration of variables:
328  USE itm_types
329  USE itm_constants
330  USE euitm_schemas
331  USE allocate_deallocate
332  USE copy_structures
333  USE deallocate_structures
334  USE interpolate_cpo
335  use, INTRINSIC :: ieee_arithmetic
336 
337 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
338  IMPLICIT NONE
339 
340  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
341  INTEGER :: nrho1, nrho2, nrho_fast
342 ! REAL (R8), ALLOCATABLE :: RHO1(:), RHO2(:)
343  INTEGER :: nnucl
344  INTEGER :: nion, iion
345  INTEGER :: nimp
346  INTEGER, ALLOCATABLE :: nzimp(:)
347  INTEGER :: nneut
348  INTEGER, ALLOCATABLE :: ncomp(:)
349  INTEGER, ALLOCATABLE :: ntype(:)
350  REAL (R8), ALLOCATABLE :: pperpfast(:,:), rho_tor_fast(:), fun1(:)
351 
352  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
353  INTEGER :: irho
354  INTEGER :: nion_fast, iion_fast, ival
355  INTEGER :: inucl, inucl_fast
356 
357  integer :: integer_params(1)
358  real*8 :: real_params(2)
359  integer :: stretch_and_cut
360  real*8 ::te_cut,ne_cut
361 
362  integer, intent(out) :: output_flag
363  character(len=*), intent(inout) :: diagnostic_info
364 
365 ! +++ CPO derived types:
366  TYPE (type_coreprof), POINTER :: coreprof_grid(:) !input CPO with internal ETS parameters
367  TYPE (type_coreprof), POINTER :: coreprof_out(:) !output CPO with profiles uploaded from the data base
368  TYPE (type_coreprof), POINTER :: coreprof_db(:) !time independent CPO slice
369  TYPE (type_corefast), POINTER :: corefast_in(:) !time independent CPO slice
370  !temporary fix
371  ! we should be able to change these paraemters through codeparameters
372  REAL (R8), parameter :: temperature_floor = 10.0e0_r8 ! [eV] sets ...
373  REAL (R8), parameter :: density_floor = 1.0e6_r8 ! [m-3] sets ...
374 
375 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
376 
377  real (r8), allocatable,dimension(:) :: prof_tmp_t,rho_tmp_t, prof_tmp_n,rho_tmp_n,prof_out,rho_out
378  real (r8) :: rho_cut_te,rho_cut_ne
379  integer :: nrho_out,cut_cond,nrho_cut_te,nrho_cut_ne
380 
381 
382  stretch_and_cut=integer_params(1)
383  te_cut=real_params(1)
384  ne_cut=real_params(2)
385 
386 ! +++ Allocate output CPO:
387  CALL copy_cpo(coreprof_grid, coreprof_out)
388 
389 ! +++ Validate content of input CPOs:
390  IF (.NOT. ASSOCIATED(coreprof_grid(1)%rho_tor)) THEN
391  output_flag = -1
392  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_GRID(1)%rho_tor not associated'
393  coreprof_out%codeparam%output_flag = output_flag
394  WRITE(*,*)diagnostic_info
395  RETURN
396  END IF
397  IF (.NOT. ASSOCIATED(coreprof_db(1)%rho_tor)) THEN
398  output_flag = -2
399  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_DB(1)%rho_tor not associated'
400  coreprof_out%codeparam%output_flag = output_flag
401  WRITE(*,*)diagnostic_info
402  RETURN
403  END IF
404  IF (.NOT. ASSOCIATED(coreprof_grid(1)%te%value)) THEN
405  output_flag = -3
406  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_DB(1)%te%value not associated'
407  coreprof_out%codeparam%output_flag = output_flag
408  WRITE(*,*)diagnostic_info
409  RETURN
410  END IF
411  IF (.NOT. ASSOCIATED(coreprof_grid(1)%ti%value)) THEN
412  output_flag = -4
413  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_DB(1)%ti%value not associated'
414  coreprof_out%codeparam%output_flag = output_flag
415  WRITE(*,*)diagnostic_info
416  RETURN
417  END IF
418  IF (.NOT. ASSOCIATED(coreprof_grid(1)%ne%value)) THEN
419  output_flag = -5
420  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_DB(1)%ne%value not associated'
421  coreprof_out%codeparam%output_flag = output_flag
422  WRITE(*,*)diagnostic_info
423  RETURN
424  END IF
425  IF (.NOT. ASSOCIATED(coreprof_grid(1)%ni%value)) THEN
426  output_flag = -6
427  diagnostic_info = 'ERROR in FILLCOREPROF2, COREPROF_DB(1)%ni%value not associated'
428  coreprof_out%codeparam%output_flag = output_flag
429  WRITE(*,*)diagnostic_info
430  RETURN
431  END IF
432 
433 ! +++ Input dimensions:
434  nrho1 = SIZE (coreprof_grid(1)%rho_tor, dim=1)
435  nrho2 = SIZE (coreprof_db(1)%rho_tor, dim=1)
436 
437  CALL get_comp_dimensions(coreprof_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
438 
439  IF (interpol.NE.0) &
440  coreprof_db(1)%rho_tor = coreprof_db(1)%rho_tor &
441  / coreprof_db(1)%rho_tor(nrho2) &
442  * coreprof_out(1)%rho_tor(nrho1)
443 
444 
445 
446 ! +++ Check for Zeff:
447  IF (ASSOCIATED (coreprof_db(1)%profiles1d%zeff%value)) THEN
448  DO irho = 1, nrho2
449  IF (coreprof_db(1)%profiles1d%zeff%value(irho).LT.1.0_r8) &
450  coreprof_db(1)%profiles1d%zeff%value(irho) = 1.0_r8
451  END DO
452  ELSE
453  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
454  WRITE(*,*) ' ZEFF profile not set --> allocated and set to unity'
455  ALLOCATE (coreprof_db(1)%profiles1d%zeff%value(nrho2))
456  coreprof_db(1)%profiles1d%zeff%value(:) = 1.0_r8
457  END IF
458 
459 ! +++ Interpolate profiles:
460  CALL interpolate_prof(coreprof_db(1), coreprof_out(1))
461 
462 !dy stretch and cut realization
463 
464  if (stretch_and_cut.eq.1) then
465  write(*,*) 'stretch and cut option is activated, will cut the profiles on rho_tor that correspond to the values', te_cut,ne_cut
466  nrho_out=size(coreprof_out(1)%rho_tor)
467  allocate(prof_out(nrho_out),rho_out(nrho_out))
468  rho_out=coreprof_out(1)%rho_tor/coreprof_out(1)%rho_tor(nrho_out)
469 !cut te
470  cut_cond=0
471  do irho=1, nrho_out
472  if ( (cut_cond.eq.0) .and. (coreprof_out(1)%te%value(irho).le.te_cut)) then
473  rho_cut_te=coreprof_out(1)%rho_tor(irho)
474  nrho_cut_te=irho
475  cut_cond=1
476  write(*,*) 'temperature profiles will be cut at', rho_cut_te
477  end if
478  enddo
479  allocate(prof_tmp_t(nrho_cut_te),rho_tmp_t(nrho_cut_te))
480 !cut ne
481  cut_cond=0
482  do irho=1, nrho_out
483  if ( (cut_cond.eq.0) .and. (coreprof_out(1)%ne%value(irho).le.ne_cut)) then
484  rho_cut_ne=coreprof_out(1)%rho_tor(irho)
485  nrho_cut_ne=irho
486  cut_cond=1
487  write(*,*) 'density profiles will be cut at', rho_cut_ne
488  end if
489  enddo
490  allocate(prof_tmp_n(nrho_cut_ne),rho_tmp_n(nrho_cut_ne))
491 ! modify temperatures
492  if (nrho_cut_te.lt.nrho_out) then
493  rho_tmp_t(:)=rho_out(1:nrho_cut_te)/rho_out(nrho_cut_te)
494 !te
495  prof_tmp_t(:)=coreprof_out(1)%te%value(1:nrho_cut_te)
496  prof_out(:)=0.0
497  call l3interp(prof_tmp_t,rho_tmp_t,nrho_cut_te,prof_out,rho_out,nrho_out)
498  coreprof_out(1)%te%value(:)=prof_out(:)
499 !ti
500  do iion=1,nion
501  prof_tmp_t(:)=coreprof_out(1)%ti%value(1:nrho_cut_te,iion)
502  prof_out(:)=0.0
503  call l3interp(prof_tmp_t,rho_tmp_t,nrho_cut_te,prof_out,rho_out,nrho_out)
504  coreprof_out(1)%ti%value(:,iion)=prof_out(:)
505  enddo
506  else
507  write(*,*) 'temperature profiles are not modified because nrho_cut=nrho', nrho_cut_te,nrho_out
508  end if
509 !modify densities
510  if (nrho_cut_ne.lt.nrho_out) then
511  rho_tmp_n(:)=rho_out(1:nrho_cut_ne)/rho_out(nrho_cut_ne)
512 !ne
513  prof_tmp_n(:)=coreprof_out(1)%ne%value(1:nrho_cut_ne)
514  prof_out(:)=0.0
515  call l3interp(prof_tmp_n,rho_tmp_n,nrho_cut_ne,prof_out,rho_out,nrho_out)
516  coreprof_out(1)%ne%value(:)=prof_out(:)
517 !ni
518  do iion=1,nion
519  prof_tmp_n(:)=coreprof_out(1)%ni%value(1:nrho_cut_ne,iion)
520  prof_out(:)=0.0
521  call l3interp(prof_tmp_n,rho_tmp_n,nrho_cut_ne,prof_out,rho_out,nrho_out)
522  coreprof_out(1)%ni%value(:,iion)=prof_out(:)
523  enddo
524  else
525  write(*,*) 'density profiles are not modified because nrho_cut=nrho', nrho_cut_ne, nrho_out
526  end if
527  deallocate(prof_tmp_t,rho_tmp_t,prof_tmp_n,rho_tmp_n,prof_out,rho_out)
528 
529  end if !stretch_and_cut
530 
531 
532 
533 !dy
534 
535 
536 
537 ! find and fix potential problems in profiles data (later move this to a general
538 ! subroutine)
539  where(coreprof_out(1)%te%value.lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%te%value)) &
540  coreprof_out(1)%te%value = temperature_floor
541  where(coreprof_out(1)%ne%value.lt.density_floor .or. ieee_is_nan(coreprof_out(1)%ne%value)) &
542  coreprof_out(1)%ne%value = density_floor
543 
544  DO iion = 1, nion
545  where(coreprof_out(1)%ti%value(:, iion).lt.temperature_floor .or. ieee_is_nan(coreprof_out(1)%ti%value(:,iion))) &
546  coreprof_out(1)%ti%value(:, iion) = temperature_floor
547  where(coreprof_out(1)%ni%value(:, iion).lt.density_floor .or. ieee_is_nan(coreprof_out(1)%ni%value(:,iion))) &
548  coreprof_out(1)%ni%value(:, iion) = density_floor
549 
550 
551  IF (coreprof_out(1)%ni%boundary%type(iion) .GE. 6) THEN
552  coreprof_out(1)%ni%boundary%value(1,iion) = coreprof_out(1)%ni%value(nrho1,iion)
553  coreprof_out(1)%ni%boundary%value(2,iion) = 0._r8
554  coreprof_out(1)%ni%boundary%value(3,iion) = 0._r8
555 
556  IF (coreprof_out(1)%ni%boundary%type(iion) .EQ. 6) THEN
557  coreprof_out(1)%ni%boundary%type(iion) = 1
558  ELSE
559  coreprof_out(1)%ni%boundary%type(iion) = 0
560  END IF
561 
562  END IF
563  END DO
564 ! JOFE>
565 
566 ! +++ Check for COCOS13:
567 
568 ! for COCOS 13, Ip > 0 ==> Psi decreasing
569  IF ( coreprof_out(1)%globalparam%current_tot * &
570  (coreprof_out(1)%psi%value(nrho1) - coreprof_out(1)%psi%value(1)) .GE.0.0_r8 ) THEN
571  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
572  WRITE(*,*) 'We have a COCOS violation: Ip > 0 ==> Psi decreasing'
573  WRITE(*,*) 'Ip = ', coreprof_out(1)%globalparam%current_tot
574  WRITE(*,*) 'Psi_a - Psi_0 = ', coreprof_out(1)%psi%value(nrho1)-coreprof_out(1)%psi%value(1)
575 ! stop 'COCOS violation'
576  WRITE(*,*) '!!!! Psi is reverted to be compliant with COCOS13'
577  coreprof_out(1)%psi%value = -1.0_r8 * coreprof_out(1)%psi%value
578  WRITE(*,*) ' '
579  ENDIF
580 
581 ! for COCOS 13, q has the opposite sign to the sign of Ip*B0
582  IF ( coreprof_out(1)%profiles1d%q%value(1) * &
583  coreprof_out(1)%globalparam%current_tot * coreprof_out(1)%toroid_field%b0 .GE. 0.0_r8 ) THEN
584  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
585  WRITE(*,*) 'We have a COCOS violation: Ip*B0*q should be < 0'
586  WRITE(*,*) 'Ip = ', coreprof_out(1)%globalparam%current_tot
587  WRITE(*,*) 'B0 = ', coreprof_out(1)%toroid_field%b0
588  WRITE(*,*) 'q0 = ', coreprof_out(1)%profiles1d%q%value(1)
589 ! stop 'COCOS violation'
590  WRITE(*,*) '!!!! q is reverted to be compliant with COCOS13'
591  coreprof_out(1)%profiles1d%q%value = -1.0_r8 * coreprof_out(1)%profiles1d%q%value
592  WRITE(*,*) ' '
593 
594  ENDIF
595 
596 ! Check the direction of current (should coinside with IP)
597  IF ( coreprof_out(1)%globalparam%current_tot * coreprof_out(1)%profiles1d%jtot%value(1) .LE.0.0_r8 ) THEN
598  WRITE(*,*) '!!!! WARNING: input coreprof CPO'
599  WRITE(*,*) 'We have different sign for IP and Jpar'
600  WRITE(*,*) 'Ip_sign = ', sign(1.0_r8, coreprof_out(1)%globalparam%current_tot)
601  WRITE(*,*) 'Jpar_sign = ', sign(1.0_r8, coreprof_out(1)%profiles1d%jtot%value(1))
602 ! stop 'COCOS violation'
603  WRITE(*,*) '!!!! Jpar profile is reverted to be consistent with total current'
604  coreprof_out(1)%profiles1d%jtot%value = -1.0_r8 * coreprof_out(1)%profiles1d%jtot%value
605  WRITE(*,*) ' '
606  ENDIF
607 
608 
609 
610 ! +++ Boundary conditions from input CPO:
611 
612  IF (coreprof_out(1)%psi%boundary%type .GE. 6) THEN
613  coreprof_out(1)%psi%boundary%value(1) = coreprof_out(1)%psi%value(nrho1)
614  coreprof_out(1)%psi%boundary%value(2) = 0._r8
615  coreprof_out(1)%psi%boundary%value(3) = 0._r8
616 
617  IF (coreprof_out(1)%psi%boundary%type .EQ. 6) THEN
618  coreprof_out(1)%psi%boundary%type = 1
619  ELSE
620  coreprof_out(1)%psi%boundary%type = 0
621  END IF
622 
623 
624  END IF
625 
626  IF (coreprof_out(1)%ne%boundary%type .GE. 6) THEN
627  coreprof_out(1)%ne%boundary%value(1) = coreprof_out(1)%ne%value(nrho1)
628  coreprof_out(1)%ne%boundary%value(2) = 0._r8
629  coreprof_out(1)%ne%boundary%value(3) = 0._r8
630 
631  IF (coreprof_out(1)%ne%boundary%type .EQ. 6) THEN
632  coreprof_out(1)%ne%boundary%type = 1
633  ELSE
634  coreprof_out(1)%ne%boundary%type = 0
635  END IF
636 
637  END IF
638 
639  IF (coreprof_out(1)%te%boundary%type .GE. 6) THEN
640  coreprof_out(1)%te%boundary%value(1) = coreprof_out(1)%te%value(nrho1)
641  coreprof_out(1)%te%boundary%value(2) = 0._r8
642  coreprof_out(1)%te%boundary%value(3) = 0._r8
643 
644  IF (coreprof_out(1)%te%boundary%type .EQ. 6) THEN
645  coreprof_out(1)%te%boundary%type = 1
646  ELSE
647  coreprof_out(1)%te%boundary%type = 0
648  END IF
649 
650  END IF
651 
652  DO iion = 1, nion
653  IF (coreprof_out(1)%ni%boundary%type(iion) .GE. 6) THEN
654  coreprof_out(1)%ni%boundary%value(1,iion) = coreprof_out(1)%ni%value(nrho1,iion)
655  coreprof_out(1)%ni%boundary%value(2,iion) = 0._r8
656  coreprof_out(1)%ni%boundary%value(3,iion) = 0._r8
657 
658  IF (coreprof_out(1)%ni%boundary%type(iion) .EQ. 6) THEN
659  coreprof_out(1)%ni%boundary%type(iion) = 1
660  ELSE
661  coreprof_out(1)%ni%boundary%type(iion) = 0
662  END IF
663 
664  END IF
665 
666  IF (coreprof_out(1)%ti%boundary%type(iion) .GE. 6) THEN
667  coreprof_out(1)%ti%boundary%value(1,iion) = coreprof_out(1)%ti%value(nrho1,iion)
668  coreprof_out(1)%ti%boundary%value(2,iion) = 0._r8
669  coreprof_out(1)%ti%boundary%value(3,iion) = 0._r8
670 
671  IF (coreprof_out(1)%ti%boundary%type(iion) .EQ. 6) THEN
672  coreprof_out(1)%ti%boundary%type(iion) = 1
673  ELSE
674  coreprof_out(1)%ti%boundary%type(iion) = 0
675  END IF
676 
677  END IF
678 
679  IF (coreprof_out(1)%vtor%boundary%type(iion) .GE. 6) THEN
680  coreprof_out(1)%vtor%boundary%value(1,iion) = coreprof_out(1)%vtor%value(nrho1,iion)
681  coreprof_out(1)%vtor%boundary%value(2,iion) = 0._r8
682  coreprof_out(1)%vtor%boundary%value(3,iion) = 0._r8
683 
684  IF (coreprof_out(1)%vtor%boundary%type(iion) .EQ. 6) THEN
685  coreprof_out(1)%vtor%boundary%type(iion) = 1
686  ELSE
687  coreprof_out(1)%vtor%boundary%type(iion) = 0
688  END IF
689 
690  END IF
691 
692  END DO
693 
694 
695 
696 ! +++ Initial Pressure:
697  coreprof_out(1)%profiles1d%pe%value = coreprof_out(1)%te%value * coreprof_out(1)%ne%value * itm_ev
698  coreprof_out(1)%profiles1d%pi%value = coreprof_out(1)%ti%value * coreprof_out(1)%ni%value * itm_ev
699  coreprof_out(1)%profiles1d%pi_tot%value = sum(coreprof_out(1)%profiles1d%pi%value, dim=2)
700  coreprof_out(1)%profiles1d%pr_th%value = coreprof_out(1)%profiles1d%pe%value + sum(coreprof_out(1)%profiles1d%pi%value, dim=2)
701 
702 ! fast particle contribution to the pressure
703 ! (we assume corefast_in is already properly initialized)
704  if (ASSOCIATED(corefast_in(1)%values) .and. ASSOCIATED(corefast_in(1)%COMPOSITIONS%IONS) ) THEN
705  IF(ALLOCATED(fun1)) DEALLOCATE (fun1)
706  ALLOCATE(fun1(nrho1))
707  nion_fast = size(corefast_in(1)%COMPOSITIONS%IONS)
708  ALLOCATE (pperpfast(nrho1, nion))
709  pperpfast = 0.0_r8
710  loop_values : DO ival = 1, size(corefast_in(1)%values)
711  IF (ASSOCIATED(corefast_in(1)%values(ival)%rho_tor)) THEN
712  nrho_fast = size(corefast_in(1)%values(ival)%rho_tor)
713  IF(ALLOCATED(rho_tor_fast)) DEALLOCATE (rho_tor_fast)
714  ALLOCATE(rho_tor_fast(nrho_fast))
715  IF (interpol.NE.0) THEN
716  rho_tor_fast = corefast_in(1)%VALUES(ival)%rho_tor &
717  / corefast_in(1)%VALUES(ival)%rho_tor(nrho_fast) &
718  * coreprof_out(1)%rho_tor(nrho1)
719  ELSE
720  rho_tor_fast = corefast_in(1)%values(ival)%rho_tor
721  ENDIF
722  thermal_ions_loop: DO iion = 1, nion
723  inucl = coreprof_out(1)%COMPOSITIONS%IONS(iion)%nucindex
724  fast_ions_loop: DO iion_fast = 1, nion_fast
725  inucl_fast = corefast_in(1)%COMPOSITIONS%IONS(iion_fast)%nucindex
726  IF (.not. (inucl_fast.LE.0 .OR. inucl_fast.GT.SIZE(corefast_in(1)%COMPOSITIONS%NUCLEI))) THEN
727  check_for_ions_consistency: IF &
728  (abs(coreprof_out(1)%COMPOSITIONS%NUCLEI(inucl)%amn - corefast_in(1)%COMPOSITIONS%NUCLEI(inucl_fast)%amn) .LE. 0.25 .AND. &
729  abs(coreprof_out(1)%COMPOSITIONS%NUCLEI(inucl)%zn - corefast_in(1)%COMPOSITIONS%NUCLEI(inucl_fast)%zn ) .LE. 0.25 .AND. &
730  abs(coreprof_out(1)%COMPOSITIONS%IONS(iion)%zion - corefast_in(1)%COMPOSITIONS%IONS(iion_fast)%zion ) .LE. 0.25) THEN
731  IF(ASSOCIATED(corefast_in(1)%VALUES(ival)%pi)) THEN
732  CALL l3interp(corefast_in(1)%VALUES(ival)%pi(:,iion_fast), rho_tor_fast, nrho_fast, &
733  fun1, coreprof_out(1)%rho_tor, nrho1)
734  pperpfast(:, iion) = pperpfast(:, iion) + fun1(:)
735  ENDIF
736  END IF check_for_ions_consistency
737  ENDIF
738  END DO fast_ions_loop
739  END DO thermal_ions_loop
740  ENDIF
741  ENDDO loop_values
742 
743  coreprof_out(1)%profiles1d%pr_perp%value = coreprof_out(1)%profiles1d%pr_th%value + sum(pperpfast, dim=2)
744 
745 
746  IF(ALLOCATED(rho_tor_fast)) DEALLOCATE (rho_tor_fast)
747  IF(ALLOCATED(fun1)) DEALLOCATE (fun1)
748  IF(ALLOCATED(pperpfast)) DEALLOCATE (pperpfast)
749  ENDIF
750 
751 ! +++ Deallocate internal derived types:
752 
753  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
754  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
755  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
756 
757 
758  RETURN
759 
760 
761  END SUBROUTINE fillcoreprof2
762 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
763 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
764 
765 
766 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
767 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
768  SUBROUTINE fillcoretransp (CORETRANSP_DB, CORETRANSP_GRID, CORETRANSP_OUT, INTERPOL)
769 
770 
771 ! +++ Declaration of variables:
772  USE euitm_schemas
773  USE euitm_routines
774  USE allocate_deallocate
775  USE copy_structures
776  USE deallocate_structures
777  USE interpolate_cpo
778  USE itm_types
779 
780  USE ets_plasma
781 
782 
783  IMPLICIT NONE
784 
785  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
786  INTEGER :: nrho1, nrho2
787  INTEGER :: nnucl
788  INTEGER :: nion
789  INTEGER :: nimp
790  INTEGER, ALLOCATABLE :: nzimp(:)
791  INTEGER :: nneut
792  INTEGER, ALLOCATABLE :: ncomp(:)
793  INTEGER, ALLOCATABLE :: ntype(:)
794 
795  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
796  INTEGER :: iimp
797  INTEGER :: ival
798 
799 ! +++ CPO derived types:
800  TYPE (type_coretransp), POINTER :: coretransp_grid(:) !input CPO with internal parameters
801  TYPE (type_coretransp), POINTER :: coretransp_out(:) !output CPO with profiles uploaded from the data base
802  TYPE (type_coretransp), POINTER :: coretransp_db(:) !time independent CPO slice
803  TYPE (type_coretransp), POINTER :: coretransp_tmp(:)
804 
805 
806 
807 
808 
809 ! +++ Allocate and define grid of output CPO:
810  nrho1 = SIZE (coretransp_grid(1)%VALUES(1)%rho_tor, dim=1)
811  CALL get_comp_dimensions(coretransp_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
812  CALL copy_cpo(coretransp_grid, coretransp_out)
813 
814 
815 ! +++ Check if interpolation can be done:
816  IF (.NOT.ASSOCIATED(coretransp_db(1)%VALUES)) goto 10
817  IF (.NOT.ASSOCIATED(coretransp_db(1)%VALUES(1)%rho_tor)) goto 10
818  IF (maxval(coretransp_db(1)%VALUES(1)%rho_tor).LE.0.0_r8) goto 10
819 
820  nrho2 = SIZE (coretransp_db(1)%VALUES(1)%rho_tor)
821  IF (interpol.NE.0) coretransp_db(1)%VALUES(1)%rho_tor = coretransp_db(1)%VALUES(1)%rho_tor &
822  / coretransp_db(1)%VALUES(1)%rho_tor(nrho2) &
823  * coretransp_out(1)%VALUES(1)%rho_tor(nrho1)
824 
825 ! +++ Check for NaN in input shot:
826  IF (SIZE(coretransp_db(1)%VALUES).GT.1) THEN
827  ALLOCATE (coretransp_tmp(1))
828  ALLOCATE (coretransp_tmp(1)%VALUES(1))
829  CALL copy_cpo(coretransp_db(1)%VALUES(1), coretransp_tmp(1)%VALUES(1))
830  CALL deallocate_cpo(coretransp_db(1)%VALUES)
831  ALLOCATE (coretransp_db(1)%VALUES(1))
832  CALL copy_cpo(coretransp_tmp(1)%VALUES(1), coretransp_db(1)%VALUES(1))
833  END IF
834 
835  CALL check_nans_in_coretransp(coretransp_db)
836 
837 
838 ! +++ Interpolate CPO:
839  CALL interpolate_transp(coretransp_db(1), coretransp_out(1), 0)
840 
841 
842 
843 ! +++ Deallocate internal derived types:
844 
845  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
846  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
847  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
848 
849 
850 
851  RETURN
852 
853 
854 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
855  CONTAINS
856  SUBROUTINE check_nans_in_coretransp (CORETRANSP)
857  IMPLICIT NONE
858  INTEGER :: ival
859  TYPE (type_coretransp), POINTER :: coretransp(:)
860 
861  DO ival = 1, SIZE (coretransp(1)%VALUES)
862  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%sigma)) THEN
863  IF (any( isnan(coretransp(1)%VALUES(ival)%sigma))) &
864  coretransp(1)%VALUES(ival)%sigma = 0.0_r8
865  END IF
866  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ne_transp%diff_eff)) THEN
867  IF (any( isnan(coretransp(1)%VALUES(ival)%Ne_transp%diff_eff))) &
868  coretransp(1)%VALUES(ival)%Ne_transp%diff_eff = 0.0_r8
869  END IF
870  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ne_transp%vconv_eff)) THEN
871  IF (any( isnan(coretransp(1)%VALUES(ival)%Ne_transp%vconv_eff))) &
872  coretransp(1)%VALUES(ival)%Ne_transp%vconv_eff = 0.0_r8
873  END IF
874  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Te_transp%diff_eff)) THEN
875  IF (any( isnan(coretransp(1)%VALUES(ival)%Te_transp%diff_eff))) &
876  coretransp(1)%VALUES(ival)%Te_transp%diff_eff = 0.0_r8
877  END IF
878  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Te_transp%vconv_eff)) THEN
879  IF (any( isnan(coretransp(1)%VALUES(ival)%Te_transp%vconv_eff))) &
880  coretransp(1)%VALUES(ival)%Te_transp%vconv_eff = 0.0_r8
881  END IF
882  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ni_transp%diff_eff)) THEN
883  IF (any( isnan(coretransp(1)%VALUES(ival)%Ni_transp%diff_eff))) &
884  coretransp(1)%VALUES(ival)%Ni_transp%diff_eff = 0.0_r8
885  END IF
886  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ni_transp%vconv_eff)) THEN
887  IF (any( isnan(coretransp(1)%VALUES(ival)%Ni_transp%vconv_eff))) &
888  coretransp(1)%VALUES(ival)%Ni_transp%vconv_eff = 0.0_r8
889  END IF
890  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ti_transp%diff_eff)) THEN
891  IF (any( isnan(coretransp(1)%VALUES(ival)%Ti_transp%diff_eff))) &
892  coretransp(1)%VALUES(ival)%Ti_transp%diff_eff = 0.0_r8
893  END IF
894  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Ti_transp%vconv_eff)) THEN
895  IF (any( isnan(coretransp(1)%VALUES(ival)%Ti_transp%vconv_eff))) &
896  coretransp(1)%VALUES(ival)%Ti_transp%vconv_eff = 0.0_r8
897  END IF
898  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Vtor_transp%diff_eff)) THEN
899  IF (any( isnan(coretransp(1)%VALUES(ival)%Vtor_transp%diff_eff))) &
900  coretransp(1)%VALUES(ival)%Vtor_transp%diff_eff = 0.0_r8
901  END IF
902  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Vtor_transp%vconv_eff)) THEN
903  IF (any( isnan(coretransp(1)%VALUES(ival)%Vtor_transp%vconv_eff))) &
904  coretransp(1)%VALUES(ival)%Vtor_transp%vconv_eff = 0.0_r8
905  END IF
906  DO iimp = 1, SIZE (coretransp(1)%VALUES(ival)%Nz_transp, dim=1)
907  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Nz_transp(iimp)%diff_eff)) THEN
908  IF (any( isnan(coretransp(1)%VALUES(ival)%Nz_transp(iimp)%diff_eff)))&
909  coretransp(1)%VALUES(ival)%Nz_transp(iimp)%diff_eff = 0.0_r8
910  END IF
911  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Nz_transp(iimp)%vconv_eff)) THEN
912  IF (any( isnan(coretransp(1)%VALUES(ival)%Nz_transp(iimp)%vconv_eff)))&
913  coretransp(1)%VALUES(ival)%Nz_transp(iimp)%vconv_eff = 0.0_r8
914  END IF
915  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Tz_transp(iimp)%diff_eff)) THEN
916  IF (any( isnan(coretransp(1)%VALUES(ival)%Tz_transp(iimp)%diff_eff)))&
917  coretransp(1)%VALUES(ival)%Tz_transp(iimp)%diff_eff = 0.0_r8
918  END IF
919  IF(ASSOCIATED(coretransp(1)%VALUES(ival)%Tz_transp(iimp)%vconv_eff)) THEN
920  IF (any( isnan(coretransp(1)%VALUES(ival)%Tz_transp(iimp)%vconv_eff)))&
921  coretransp(1)%VALUES(ival)%Tz_transp(iimp)%vconv_eff = 0.0_r8
922  END IF
923  END DO
924  END DO
925 
926  RETURN
927  END SUBROUTINE check_nans_in_coretransp
928 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
929 
930 
931  END SUBROUTINE fillcoretransp
932 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
933 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
934 
935 
936 
937 
938 
939 
940 
941 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
942 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
943  SUBROUTINE fillcoresource (CORESOURCE_DB, CORESOURCE_GRID, CORESOURCE_OUT, INTERPOL)
944 
945 
946 ! +++ Declaration of variables:
947  USE euitm_schemas
948  USE euitm_routines
949  USE allocate_deallocate
950  USE copy_structures
951  USE deallocate_structures
952  USE interpolate_cpo
953 
954  USE ets_plasma
955 
956 
957  IMPLICIT NONE
958 
959  INTEGER :: nrho1, nrho2
960  INTEGER :: nnucl
961  INTEGER :: nion
962  INTEGER :: nimp
963  INTEGER, ALLOCATABLE :: nzimp(:)
964  INTEGER :: nneut
965  INTEGER, ALLOCATABLE :: ncomp(:)
966  INTEGER, ALLOCATABLE :: ntype(:)
967 
968  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
969  INTEGER :: iimp
970  INTEGER :: ival
971 
972 ! +++ CPO derived types:
973  TYPE (type_coresource), POINTER :: coresource_grid(:) !input CPO with internal parameters
974  TYPE (type_coresource), POINTER :: coresource_out(:) !output CPO with profiles uploaded from the data base
975  TYPE (type_coresource), POINTER :: coresource_db(:) !time independent CPO slice
976  TYPE (type_coresource), POINTER :: coresource_tmp(:)
977 
978 
979 
980 
981 
982 ! +++ Allocate and define grid of output CPO:
983  nrho1 = SIZE (coresource_grid(1)%VALUES(1)%rho_tor, dim=1)
984  CALL get_comp_dimensions(coresource_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
985  CALL copy_cpo(coresource_grid, coresource_out)
986 
987 
988 
989 ! +++ Check if interpolation can be done:
990  IF (.NOT.ASSOCIATED(coresource_db(1)%VALUES)) goto 10
991  IF (.NOT.ASSOCIATED(coresource_db(1)%VALUES(1)%rho_tor)) goto 10
992  IF (maxval(coresource_db(1)%VALUES(1)%rho_tor).LE.0.0_r8)goto 10
993  nrho2 = SIZE (coresource_db(1)%VALUES(1)%rho_tor, dim=1)
994 
995  IF (interpol.NE.0) coresource_db(1)%VALUES(1)%rho_tor = coresource_db(1)%VALUES(1)%rho_tor &
996  / coresource_db(1)%VALUES(1)%rho_tor(nrho2) &
997  * coresource_out(1)%VALUES(1)%rho_tor(nrho1)
998 
999 
1000 
1001 ! +++ Check for NaN in input shot:
1002  IF (SIZE(coresource_db(1)%VALUES).GT.1) THEN
1003  ALLOCATE (coresource_tmp(1))
1004  ALLOCATE (coresource_tmp(1)%VALUES(1))
1005  CALL copy_cpo(coresource_db(1)%VALUES(1), coresource_tmp(1)%VALUES(1))
1006  CALL deallocate_cpo(coresource_db(1)%VALUES)
1007  ALLOCATE (coresource_db(1)%VALUES(1))
1008  CALL copy_cpo(coresource_tmp(1)%VALUES(1), coresource_db(1)%VALUES(1))
1009  END IF
1010 
1011  CALL check_nans_in_coresource(coresource_db)
1012 
1013 
1014 ! +++ Interpolate CPO:
1015  CALL interpolate_source(coresource_db(1), coresource_out(1))
1016 
1017 
1018 
1019 
1020 ! +++ Deallocate internal derived types:
1021 
1022  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
1023  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
1024  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
1025 
1026 
1027 
1028  RETURN
1029 
1030 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1031  CONTAINS
1032  SUBROUTINE check_nans_in_coresource (CORESOURCE)
1033  IMPLICIT NONE
1034  INTEGER :: ival
1035  TYPE (type_coresource), POINTER :: coresource(:)
1036 
1037  DO ival = 1, SIZE (coresource(1)%VALUES)
1038  IF(ASSOCIATED(coresource(1)%VALUES(ival)%j)) THEN
1039  IF(any(isnan(coresource(1)%VALUES(ival)%j))) &
1040  coresource(1)%VALUES(ival)%j = 0.0_r8
1041  END IF
1042  IF(ASSOCIATED(coresource(1)%VALUES(ival)%sigma)) THEN
1043  IF(any(isnan(coresource(1)%VALUES(ival)%sigma))) &
1044  coresource(1)%VALUES(ival)%sigma = 0.0_r8
1045  END IF
1046  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Se%exp)) THEN
1047  IF(any(isnan(coresource(1)%VALUES(ival)%Se%exp))) &
1048  coresource(1)%VALUES(ival)%Se%exp = 0.0_r8
1049  END IF
1050  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Se%imp)) THEN
1051  IF(any(isnan(coresource(1)%VALUES(ival)%Se%imp))) &
1052  coresource(1)%VALUES(ival)%Se%imp = 0.0_r8
1053  END IF
1054  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qe%exp)) THEN
1055  IF(any(isnan(coresource(1)%VALUES(ival)%Qe%exp))) &
1056  coresource(1)%VALUES(ival)%Qe%exp = 0.0_r8
1057  END IF
1058  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qe%imp)) THEN
1059  IF(any(isnan(coresource(1)%VALUES(ival)%Qe%imp))) &
1060  coresource(1)%VALUES(ival)%Qe%imp = 0.0_r8
1061  END IF
1062  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Si%exp)) THEN
1063  IF(any(isnan(coresource(1)%VALUES(ival)%Si%exp))) &
1064  coresource(1)%VALUES(ival)%Si%exp = 0.0_r8
1065  END IF
1066  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Si%imp)) THEN
1067  IF(any(isnan(coresource(1)%VALUES(ival)%Si%imp))) &
1068  coresource(1)%VALUES(ival)%Si%imp = 0.0_r8
1069  END IF
1070  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qi%exp)) THEN
1071  IF(any(isnan(coresource(1)%VALUES(ival)%Qi%exp))) &
1072  coresource(1)%VALUES(ival)%Qi%exp = 0.0_r8
1073  END IF
1074  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qi%imp)) THEN
1075  IF(any(isnan(coresource(1)%VALUES(ival)%Qi%imp))) &
1076  coresource(1)%VALUES(ival)%Qi%imp = 0.0_r8
1077  END IF
1078  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Ui%exp)) THEN
1079  IF(any(isnan(coresource(1)%VALUES(ival)%Ui%exp))) &
1080  coresource(1)%VALUES(ival)%Ui%exp = 0.0_r8
1081  END IF
1082  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Ui%imp)) THEN
1083  IF(any(isnan(coresource(1)%VALUES(ival)%Ui%imp))) &
1084  coresource(1)%VALUES(ival)%Ui%imp = 0.0_r8
1085  END IF
1086  DO iimp = 1, SIZE (coresource(1)%VALUES(ival)%Sz, dim=1)
1087  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Sz(iimp)%exp)) THEN
1088  IF(any(isnan(coresource(1)%VALUES(ival)%Sz(iimp)%exp))) &
1089  coresource(1)%VALUES(ival)%Sz(iimp)%exp = 0.0_r8
1090  END IF
1091  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Sz(iimp)%imp)) THEN
1092  IF(any(isnan(coresource(1)%VALUES(ival)%Sz(iimp)%imp))) &
1093  coresource(1)%VALUES(ival)%Sz(iimp)%imp = 0.0_r8
1094  END IF
1095  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qz(iimp)%exp)) THEN
1096  IF(any(isnan(coresource(1)%VALUES(ival)%Qz(iimp)%exp))) &
1097  coresource(1)%VALUES(ival)%Qz(iimp)%exp = 0.0_r8
1098  END IF
1099  IF(ASSOCIATED(coresource(1)%VALUES(ival)%Qz(iimp)%imp)) THEN
1100  IF(any(isnan(coresource(1)%VALUES(ival)%Qz(iimp)%imp))) &
1101  coresource(1)%VALUES(ival)%Qz(iimp)%imp = 0.0_r8
1102  END IF
1103  END DO
1104  END DO
1105 
1106  RETURN
1107 
1108  END SUBROUTINE check_nans_in_coresource
1109 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1110 
1111  END SUBROUTINE fillcoresource
1112 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1113 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1114 
1115 
1116  SUBROUTINE fillcorefast (COREFAST_DB, COREFAST_GRID, COREFAST_OUT, INTERPOL)
1117 
1118 ! +++ Declaration of variables:
1119  USE itm_types
1120  USE itm_constants
1121  USE euitm_schemas
1122  USE allocate_deallocate
1123  USE copy_structures
1124  USE deallocate_structures
1125  USE interpolate_cpo
1126 
1127 
1128 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1129  IMPLICIT NONE
1130 
1131  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
1132  INTEGER :: nrho1, nrho2
1133  INTEGER :: nnucl
1134  INTEGER :: nion, iion
1135  INTEGER :: nimp
1136  INTEGER, ALLOCATABLE :: nzimp(:)
1137  INTEGER :: nneut
1138  INTEGER, ALLOCATABLE :: ncomp(:)
1139  INTEGER, ALLOCATABLE :: ntype(:)
1140 
1141  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
1142  INTEGER :: irho
1143  INTEGER :: ival, nval
1144 
1145 ! +++ CPO derived types:
1146  TYPE (type_corefast), POINTER :: corefast_grid(:) !input CPO with internal ETS parameters
1147  TYPE (type_corefast), POINTER :: corefast_out(:) !output CPO with profiles uploaded from the data base
1148  TYPE (type_corefast), POINTER :: corefast_db(:) !time independent CPO slice
1149 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1150 
1151 
1152 ! +++ Allocate output CPO and internal derived types:
1153  CALL get_comp_dimensions(corefast_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
1154 
1155  CALL copy_cpo(corefast_grid, corefast_out)
1156 ! +++ RHO grid:
1157  nrho1 = SIZE (corefast_grid(1)%values(1)%rho_tor, dim=1)
1158  IF (ASSOCIATED (corefast_db(1)%values)) THEN
1159  nval = size(corefast_db(1)%values)
1160  DO ival=1, nval
1161  IF (ASSOCIATED (corefast_db(1)%values(ival)%rho_tor)) THEN
1162  nrho2 = SIZE (corefast_db(1)%values(ival)%rho_tor, dim=1)
1163  IF (interpol.NE.0) &
1164  corefast_db(1)%values(ival)%rho_tor = corefast_db(1)%values(ival)%rho_tor &
1165  / corefast_db(1)%values(ival)%rho_tor(nrho2) &
1166  * corefast_out(1)%values(1)%rho_tor(nrho1)
1167  ENDIF
1168  END DO
1169 
1170 ! +++ Interpolate profiles:
1171  CALL interpolate_fast(corefast_db(1), corefast_out(1))
1172 
1173 ! Check the direction of beam driven current (not implemented)
1174 !
1175  ELSE
1176  ! add diagnostic output here
1177  ! eg. if input corefast is not valid
1178  CONTINUE
1179  ENDIF
1180 
1181 ! +++ Deallocate internal derived types:
1182 
1183  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
1184  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
1185  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
1186 
1187 
1188  RETURN
1189 
1190 
1191  END SUBROUTINE fillcorefast
1192 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1193 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1194 
1195 
1196 
1197 
1198 
1199 
1200 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1201 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1202  SUBROUTINE fillcoreimpur (COREIMPUR_DB, COREIMPUR_GRID, COREIMPUR_OUT, INTERPOL)
1203 
1204 
1205 ! +++ Declaration of variables:
1206  USE euitm_schemas
1207  USE euitm_routines
1208  USE allocate_deallocate
1209  USE copy_structures
1210  USE deallocate_structures
1211  USE interpolate_cpo
1212 
1213  USE ets_plasma
1214 
1215 
1216  IMPLICIT NONE
1217 
1218  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
1219  INTEGER :: nrho1, nrho2
1220  INTEGER :: nnucl
1221  INTEGER :: nion
1222  INTEGER :: nimp, iimp
1223  INTEGER, ALLOCATABLE :: nzimp(:)
1224  INTEGER :: izimp
1225  INTEGER :: nneut
1226  INTEGER, ALLOCATABLE :: ncomp(:)
1227  INTEGER, ALLOCATABLE :: ntype(:)
1228 
1229  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
1230 
1231 
1232 ! +++ CPO derived types:
1233  TYPE (type_coreimpur), POINTER :: coreimpur_grid(:) !input CPO with internal parameters
1234  TYPE (type_coreimpur), POINTER :: coreimpur_out(:) !output CPO with sources uploaded from the data base
1235  TYPE (type_coreimpur), POINTER :: coreimpur_db(:) !time independent CPO slice
1236 
1237 
1238 
1239 ! +++ Allocate and define grid of output CPO:
1240  nrho1 = SIZE (coreimpur_grid(1)%rho_tor, dim=1)
1241  CALL get_comp_dimensions(coreimpur_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
1242  CALL copy_cpo(coreimpur_grid, coreimpur_out)
1243 
1244 
1245 
1246 ! +++ Check if interpolation can be done:
1247  IF (.NOT.ASSOCIATED(coreimpur_db(1)%rho_tor).OR.nimp.LE.0) goto 10
1248  IF (maxval(coreimpur_db(1)%rho_tor).LE.0.0_r8) goto 10
1249  nrho2 = SIZE (coreimpur_db(1)%rho_tor, dim=1)
1250  IF (interpol.NE.0) &
1251  coreimpur_db(1)%rho_tor = coreimpur_db(1)%rho_tor &
1252  / coreimpur_db(1)%rho_tor(nrho2) &
1253  * coreimpur_out(1)%rho_tor(nrho1)
1254 
1255 
1256 !! +++ Interpolate CPO:
1257  CALL interpolate_impur(coreimpur_db(1), coreimpur_out(1))
1258 
1259 
1260  DO iimp = 1, nimp
1261  DO izimp = 1, nzimp(iimp)
1262  IF (coreimpur_out(1)%IMPURITY(iimp)%boundary%type(izimp) .EQ. 6) THEN
1263  coreimpur_out(1)%IMPURITY(iimp)%boundary%type(izimp) = 1
1264 
1265  coreimpur_out(1)%IMPURITY(iimp)%boundary%value(1,izimp) = coreimpur_out(1)%IMPURITY(iimp)%nz(nrho1,izimp)
1266  coreimpur_out(1)%IMPURITY(iimp)%boundary%value(2,izimp) = 0._r8
1267  coreimpur_out(1)%IMPURITY(iimp)%boundary%value(3,izimp) = 0._r8
1268  END IF
1269  END DO
1270  END DO
1271 
1272 
1273 
1274 
1275 ! +++ Deallocate internal derived types:
1276 
1277  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
1278  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
1279  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
1280 
1281 
1282 
1283 
1284  RETURN
1285 
1286 
1287  END SUBROUTINE fillcoreimpur
1288 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1289 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1290 
1291 
1292 
1293 
1294 
1295 
1296 
1297 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1298 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1299  SUBROUTINE fillcoreneutrals (CORENEUTRALS_DB, CORENEUTRALS_GRID, CORENEUTRALS_OUT, INTERPOL)
1300 
1301 
1302 ! +++ Declaration of variables:
1303  USE euitm_schemas
1304  USE euitm_routines
1305  USE allocate_deallocate
1306  USE copy_structures
1307  USE deallocate_structures
1308  USE interpolate_cpo
1309 
1310  USE ets_plasma
1311 
1312 
1313  IMPLICIT NONE
1314 
1315  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
1316  INTEGER :: nrho1, nrho2
1317  INTEGER :: nnucl
1318  INTEGER :: nion
1319  INTEGER :: nimp
1320  INTEGER, ALLOCATABLE :: nzimp(:)
1321  INTEGER :: nneut
1322  INTEGER, ALLOCATABLE :: ncomp(:)
1323  INTEGER, ALLOCATABLE :: ntype(:)
1324 
1325  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
1326 
1327 
1328 ! +++ CPO derived types:
1329  TYPE (type_coreneutrals), POINTER :: coreneutrals_grid(:) !input CPO with internal parameters
1330  TYPE (type_coreneutrals), POINTER :: coreneutrals_out(:) !output CPO with sources uploaded from the data base
1331  TYPE (type_coreneutrals), POINTER :: coreneutrals_db(:) !time independent CPO slice
1332 
1333 
1334 
1335 ! +++ Allocate and define grid of output CPO:
1336  nrho1 = SIZE (coreneutrals_grid(1)%rho_tor, dim=1)
1337  CALL get_comp_dimensions(coreneutrals_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
1338  CALL copy_cpo(coreneutrals_grid, coreneutrals_out)
1339  coreneutrals_out(1)%rho_tor = coreneutrals_grid(1)%rho_tor
1340  coreneutrals_out(1)%rho_tor_norm = coreneutrals_grid(1)%rho_tor_norm
1341 
1342 
1343 
1344 ! +++ Check if interpolation can be done:
1345  IF (.NOT.ASSOCIATED(coreneutrals_db(1)%rho_tor)) goto 10
1346  IF (maxval(coreneutrals_db(1)%rho_tor).LE.0.0_r8)goto 10
1347  nrho2 = SIZE (coreneutrals_db(1)%rho_tor, dim=1)
1348  IF (interpol.NE.0) &
1349  coreneutrals_db(1)%rho_tor = coreneutrals_db(1)%rho_tor &
1350  / coreneutrals_db(1)%rho_tor(nrho2) &
1351  * coreneutrals_out(1)%rho_tor(nrho1)
1352 
1353 
1354 ! +++ Interpolate CPO:
1355  CALL interpolate_neutrals(coreneutrals_db(1), coreneutrals_out(1))
1356 
1357 
1358 
1359 
1360 ! +++ Deallocate internal derived types:
1361 
1362  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
1363  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
1364  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
1365 
1366 
1367 
1368 
1369  RETURN
1370 
1371 
1372  END SUBROUTINE fillcoreneutrals
1373 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1374 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1375 
1376 
1377 
1378 
1379 
1380 
1381 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1382 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1383  SUBROUTINE fillequilibrium (EQUILIBRIUM_DB, EQUILIBRIUM_GRID, EQUILIBRIUM_OUT, INTERPOL)
1384 
1385 
1386 ! +++ Declaration of variables:
1387  USE euitm_schemas
1388  USE euitm_routines
1389  USE allocate_deallocate
1390  USE copy_structures
1391  USE deallocate_structures
1392  USE ets_plasma
1393  USE itm_types
1394  USE itm_constants
1395 
1396 
1397  IMPLICIT NONE
1398 
1399 
1400 ! +++ CPO derived types:
1401  TYPE (type_equilibrium), POINTER :: equilibrium_grid(:) !input CPO with internal parameters
1402  TYPE (type_equilibrium), POINTER :: equilibrium_out(:) !output CPO with sources uploaded from the data base
1403  TYPE (type_equilibrium), POINTER :: equilibrium_db(:) !time independent CPO slice
1404 
1405 
1406 ! +++ Local derived types:
1407  TYPE (diagnostic) :: diag !diagnostic output
1408 
1409 
1410 ! +++ Internal derived types:
1411  INTEGER :: npsi1 !total number of rho grid on grid and output CPOs
1412  INTEGER :: npsi2 !total number of rho grid from the data base
1413  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
1414 
1415  REAL (R8), ALLOCATABLE :: rho1(:), rho2(:)
1416 
1417 
1418 ! +++ Allocate output CPO and internal derived types:
1419  npsi1 = SIZE (equilibrium_grid(1)%profiles_1d%rho_tor, dim=1)
1420  npsi2 = SIZE (equilibrium_db(1)%profiles_1d%rho_tor, dim=1)
1421 
1422  ALLOCATE ( rho1(npsi1))
1423  ALLOCATE ( rho2(npsi2))
1424 
1425  IF (interpol.EQ.0) THEN
1426  rho1 = equilibrium_grid(1)%profiles_1d%rho_tor
1427  rho2 = equilibrium_db(1)%profiles_1d%rho_tor
1428  ELSE
1429  rho1 = equilibrium_grid(1)%profiles_1d%rho_tor / equilibrium_grid(1)%profiles_1d%rho_tor(npsi1)
1430  rho2 = equilibrium_db(1)%profiles_1d%rho_tor / equilibrium_db(1)%profiles_1d%rho_tor(npsi2)
1431  END IF
1432 
1433 
1434 ! +++ Allocate and define grid of output CPO:
1435  IF(.NOT.ASSOCIATED(equilibrium_out)) ALLOCATE(equilibrium_out(1))
1436  CALL copy_cpo(equilibrium_grid(1), equilibrium_out(1))
1437 
1438 
1439 ! +++ PROFILES_1D:
1440  IF( ASSOCIATED(equilibrium_db(1)%profiles_1d%jparallel) .AND. &
1441  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%jparallel)) THEN
1442  ALLOCATE(equilibrium_out(1)%profiles_1d%jparallel(npsi1))
1443  CALL l3interp(equilibrium_db(1)%profiles_1d%jparallel, rho2, npsi2, &
1444  equilibrium_out(1)%profiles_1d%jparallel, rho1, npsi1)
1445  END IF
1446  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%jphi) .AND. &
1447  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%jphi)) THEN
1448  ALLOCATE(equilibrium_out(1)%profiles_1d%jphi(npsi1))
1449  CALL l3interp(equilibrium_db(1)%profiles_1d%jphi, rho2, npsi2, &
1450  equilibrium_out(1)%profiles_1d%jphi, rho1, npsi1)
1451  END IF
1452  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%q) .AND. &
1453  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%q)) THEN
1454  ALLOCATE(equilibrium_out(1)%profiles_1d%q(npsi1))
1455  CALL l3interp(equilibrium_db(1)%profiles_1d%q, rho2, npsi2, &
1456  equilibrium_out(1)%profiles_1d%q, rho1, npsi1)
1457  END IF
1458  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%pressure) .AND. &
1459  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%pressure)) THEN
1460  ALLOCATE(equilibrium_out(1)%profiles_1d%pressure(npsi1))
1461  CALL l3interp(equilibrium_db(1)%profiles_1d%pressure, rho2, npsi2, &
1462  equilibrium_out(1)%profiles_1d%pressure, rho1, npsi1)
1463  END IF
1464  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%pprime) .AND. &
1465  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%pprime)) THEN
1466  ALLOCATE(equilibrium_out(1)%profiles_1d%pprime(npsi1))
1467  CALL l3interp(equilibrium_db(1)%profiles_1d%pprime, rho2, npsi2, &
1468  equilibrium_out(1)%profiles_1d%pprime, rho1, npsi1)
1469  END IF
1470  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%ffprime) .AND. &
1471  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%ffprime)) THEN
1472  ALLOCATE(equilibrium_out(1)%profiles_1d%ffprime(npsi1))
1473  CALL l3interp(equilibrium_db(1)%profiles_1d%ffprime, rho2, npsi2, &
1474  equilibrium_out(1)%profiles_1d%ffprime, rho1, npsi1)
1475  END IF
1476  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm1) .AND. &
1477  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm1)) THEN
1478  ALLOCATE(equilibrium_out(1)%profiles_1d%gm1(npsi1))
1479  CALL l3interp(equilibrium_db(1)%profiles_1d%gm1, rho2, npsi2, &
1480  equilibrium_out(1)%profiles_1d%gm1, rho1, npsi1)
1481  END IF
1482  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm2) .AND. &
1483  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm2)) THEN
1484  ALLOCATE(equilibrium_out(1)%profiles_1d%gm2(npsi1))
1485  CALL l3interp(equilibrium_db(1)%profiles_1d%gm2, rho2, npsi2, &
1486  equilibrium_out(1)%profiles_1d%gm2, rho1, npsi1)
1487  END IF
1488  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm3) .AND. &
1489  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm3)) THEN
1490  ALLOCATE(equilibrium_out(1)%profiles_1d%gm3(npsi1))
1491  CALL l3interp(equilibrium_db(1)%profiles_1d%gm3, rho2, npsi2, &
1492  equilibrium_out(1)%profiles_1d%gm3, rho1, npsi1)
1493  END IF
1494  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm4) .AND. &
1495  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm4)) THEN
1496  ALLOCATE(equilibrium_out(1)%profiles_1d%gm4(npsi1))
1497  CALL l3interp(equilibrium_db(1)%profiles_1d%gm4, rho2, npsi2, &
1498  equilibrium_out(1)%profiles_1d%gm4, rho1, npsi1)
1499  END IF
1500  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm5) .AND. &
1501  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm5)) THEN
1502  ALLOCATE(equilibrium_out(1)%profiles_1d%gm5(npsi1))
1503  CALL l3interp(equilibrium_db(1)%profiles_1d%gm5, rho2, npsi2, &
1504  equilibrium_out(1)%profiles_1d%gm5, rho1, npsi1)
1505  END IF
1506  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm6) .AND. &
1507  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm6)) THEN
1508  ALLOCATE(equilibrium_out(1)%profiles_1d%gm6(npsi1))
1509  CALL l3interp(equilibrium_db(1)%profiles_1d%gm6, rho2, npsi2, &
1510  equilibrium_out(1)%profiles_1d%gm6, rho1, npsi1)
1511  END IF
1512  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm7) .AND. &
1513  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm7)) THEN
1514  ALLOCATE(equilibrium_out(1)%profiles_1d%gm7(npsi1))
1515  CALL l3interp(equilibrium_db(1)%profiles_1d%gm7, rho2, npsi2, &
1516  equilibrium_out(1)%profiles_1d%gm7, rho1, npsi1)
1517  END IF
1518  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm8) .AND. &
1519  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm8)) THEN
1520  ALLOCATE(equilibrium_out(1)%profiles_1d%gm8(npsi1))
1521  CALL l3interp(equilibrium_db(1)%profiles_1d%gm8, rho2, npsi2, &
1522  equilibrium_out(1)%profiles_1d%gm8, rho1, npsi1)
1523  END IF
1524  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%gm9) .AND. &
1525  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%gm9)) THEN
1526  ALLOCATE(equilibrium_out(1)%profiles_1d%gm9(npsi1))
1527  CALL l3interp(equilibrium_db(1)%profiles_1d%gm9, rho2, npsi2, &
1528  equilibrium_out(1)%profiles_1d%gm9, rho1, npsi1)
1529  END IF
1530  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%F_dia) .AND. &
1531  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%F_dia)) THEN
1532  ALLOCATE(equilibrium_out(1)%profiles_1d%F_dia(npsi1))
1533  CALL l3interp(equilibrium_db(1)%profiles_1d%F_dia, rho2, npsi2, &
1534  equilibrium_out(1)%profiles_1d%F_dia, rho1, npsi1)
1535  END IF
1536  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%volume) .AND. &
1537  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%volume)) THEN
1538  ALLOCATE(equilibrium_out(1)%profiles_1d%volume(npsi1))
1539  CALL l3interp(equilibrium_db(1)%profiles_1d%volume, rho2, npsi2, &
1540  equilibrium_out(1)%profiles_1d%volume, rho1, npsi1)
1541  END IF
1542  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%vprime) .AND. &
1543  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%vprime)) THEN
1544  ALLOCATE(equilibrium_out(1)%profiles_1d%vprime(npsi1))
1545  CALL l3interp(equilibrium_db(1)%profiles_1d%vprime, rho2, npsi2, &
1546  equilibrium_out(1)%profiles_1d%vprime, rho1, npsi1)
1547  END IF
1548  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%area) .AND. &
1549  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%area)) THEN
1550  ALLOCATE(equilibrium_out(1)%profiles_1d%area(npsi1))
1551  CALL l3interp(equilibrium_db(1)%profiles_1d%area, rho2, npsi2, &
1552  equilibrium_out(1)%profiles_1d%area, rho1, npsi1)
1553  END IF
1554  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%aprime) .AND. &
1555  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%aprime)) THEN
1556  ALLOCATE(equilibrium_out(1)%profiles_1d%aprime(npsi1))
1557  CALL l3interp(equilibrium_db(1)%profiles_1d%aprime, rho2, npsi2, &
1558  equilibrium_out(1)%profiles_1d%aprime, rho1, npsi1)
1559  END IF
1560  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%elongation) .AND. &
1561  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%elongation)) THEN
1562  ALLOCATE(equilibrium_out(1)%profiles_1d%elongation(npsi1))
1563  CALL l3interp(equilibrium_db(1)%profiles_1d%elongation, rho2, npsi2, &
1564  equilibrium_out(1)%profiles_1d%elongation, rho1, npsi1)
1565  END IF
1566  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%tria_upper) .AND. &
1567  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%tria_upper)) THEN
1568  ALLOCATE(equilibrium_out(1)%profiles_1d%tria_upper(npsi1))
1569  CALL l3interp(equilibrium_db(1)%profiles_1d%tria_upper, rho2, npsi2, &
1570  equilibrium_out(1)%profiles_1d%tria_upper, rho1, npsi1)
1571  END IF
1572  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%tria_lower) .AND. &
1573  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%tria_lower)) THEN
1574  ALLOCATE(equilibrium_out(1)%profiles_1d%tria_lower(npsi1))
1575  CALL l3interp(equilibrium_db(1)%profiles_1d%tria_lower, rho2, npsi2, &
1576  equilibrium_out(1)%profiles_1d%tria_lower, rho1, npsi1)
1577  END IF
1578  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%r_inboard) .AND. &
1579  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%r_inboard)) THEN
1580  ALLOCATE(equilibrium_out(1)%profiles_1d%r_inboard(npsi1))
1581  CALL l3interp(equilibrium_db(1)%profiles_1d%r_inboard, rho2, npsi2, &
1582  equilibrium_out(1)%profiles_1d%r_inboard, rho1, npsi1)
1583  END IF
1584  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%r_outboard) .AND. &
1585  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%r_outboard)) THEN
1586  ALLOCATE(equilibrium_out(1)%profiles_1d%r_outboard(npsi1))
1587  CALL l3interp(equilibrium_db(1)%profiles_1d%r_outboard, rho2, npsi2, &
1588  equilibrium_out(1)%profiles_1d%r_outboard, rho1, npsi1)
1589  END IF
1590  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%psi) .AND. &
1591  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%psi)) THEN
1592  ALLOCATE(equilibrium_out(1)%profiles_1d%psi(npsi1))
1593  CALL l3interp(equilibrium_db(1)%profiles_1d%psi, rho2, npsi2, &
1594  equilibrium_out(1)%profiles_1d%psi, rho1, npsi1)
1595  END IF
1596  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%phi) .AND. &
1597  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%phi)) THEN
1598  ALLOCATE(equilibrium_out(1)%profiles_1d%phi(npsi1))
1599  CALL l3interp(equilibrium_db(1)%profiles_1d%phi, rho2, npsi2, &
1600  equilibrium_out(1)%profiles_1d%phi, rho1, npsi1)
1601  END IF
1602  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%rho_vol) .AND. &
1603  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%rho_vol)) THEN
1604  ALLOCATE(equilibrium_out(1)%profiles_1d%rho_vol(npsi1))
1605  CALL l3interp(equilibrium_db(1)%profiles_1d%rho_vol, rho2, npsi2, &
1606  equilibrium_out(1)%profiles_1d%rho_vol, rho1, npsi1)
1607  END IF
1608  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%dpsidrho_tor) .AND. &
1609  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%dpsidrho_tor)) THEN
1610  ALLOCATE(equilibrium_out(1)%profiles_1d%dpsidrho_tor(npsi1))
1611  CALL l3interp(equilibrium_db(1)%profiles_1d%dpsidrho_tor, rho2, npsi2, &
1612  equilibrium_out(1)%profiles_1d%dpsidrho_tor, rho1, npsi1)
1613  END IF
1614  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%beta_pol) .AND. &
1615  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%beta_pol)) THEN
1616  ALLOCATE(equilibrium_out(1)%profiles_1d%beta_pol(npsi1))
1617  CALL l3interp(equilibrium_db(1)%profiles_1d%beta_pol, rho2, npsi2, &
1618  equilibrium_out(1)%profiles_1d%beta_pol, rho1, npsi1)
1619  END IF
1620  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%li) .AND. &
1621  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%li)) THEN
1622  ALLOCATE(equilibrium_out(1)%profiles_1d%li(npsi1))
1623  CALL l3interp(equilibrium_db(1)%profiles_1d%li, rho2, npsi2, &
1624  equilibrium_out(1)%profiles_1d%li, rho1, npsi1)
1625  END IF
1626  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%dvdrho) .AND. &
1627  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%dvdrho)) THEN
1628  ALLOCATE(equilibrium_out(1)%profiles_1d%dvdrho(npsi1))
1629  CALL l3interp(equilibrium_db(1)%profiles_1d%dvdrho, rho2, npsi2, &
1630  equilibrium_out(1)%profiles_1d%dvdrho, rho1, npsi1)
1631  END IF
1632  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%surface) .AND. &
1633  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%surface)) THEN
1634  ALLOCATE(equilibrium_out(1)%profiles_1d%surface(npsi1))
1635  CALL l3interp(equilibrium_db(1)%profiles_1d%surface, rho2, npsi2, &
1636  equilibrium_out(1)%profiles_1d%surface, rho1, npsi1)
1637  END IF
1638  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%ftrap) .AND. &
1639  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%ftrap)) THEN
1640  ALLOCATE(equilibrium_out(1)%profiles_1d%ftrap(npsi1))
1641  CALL l3interp(equilibrium_db(1)%profiles_1d%ftrap, rho2, npsi2, &
1642  equilibrium_out(1)%profiles_1d%ftrap, rho1, npsi1)
1643  END IF
1644  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%b_av) .AND. &
1645  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%b_av)) THEN
1646  ALLOCATE(equilibrium_out(1)%profiles_1d%b_av(npsi1))
1647  CALL l3interp(equilibrium_db(1)%profiles_1d%b_av, rho2, npsi2, &
1648  equilibrium_out(1)%profiles_1d%b_av, rho1, npsi1)
1649  END IF
1650  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%b_min) .AND. &
1651  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%b_min)) THEN
1652  ALLOCATE(equilibrium_out(1)%profiles_1d%b_min(npsi1))
1653  CALL l3interp(equilibrium_db(1)%profiles_1d%b_min, rho2, npsi2, &
1654  equilibrium_out(1)%profiles_1d%b_min, rho1, npsi1)
1655  END IF
1656  IF(ASSOCIATED(equilibrium_db(1)%profiles_1d%b_max) .AND. &
1657  .NOT.ASSOCIATED(equilibrium_out(1)%profiles_1d%b_max)) THEN
1658  ALLOCATE(equilibrium_out(1)%profiles_1d%b_max(npsi1))
1659  CALL l3interp(equilibrium_db(1)%profiles_1d%b_max, rho2, npsi2, &
1660  equilibrium_out(1)%profiles_1d%b_max, rho1, npsi1)
1661  END IF
1662 
1663 
1664 ! +++ Check for COCOS13:
1665 ! for COCOS 13, Ip > 0 ==> Psi decreasing
1666  IF ( ASSOCIATED(equilibrium_out(1)%profiles_1d%psi)) THEN
1667  IF (equilibrium_db(1)%global_param%i_plasma * (equilibrium_out(1)%profiles_1d%psi(npsi1) - equilibrium_out(1)%profiles_1d%psi(1)) .GE.0.0_r8 ) THEN
1668  equilibrium_out(1)%profiles_1d%psi = -1.0_r8 * equilibrium_out(1)%profiles_1d%psi
1669  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//"COCOS violation: Ip > 0 ==> Psi decreasing. Psi is reverted to be compliant with COCOS13"
1670  diag%IERR = diag%IERR + 1
1671  ENDIF
1672  ENDIF
1673 
1674 ! for COCOS 13, q has the opposite sign to the sign of Ip*B0
1675  IF ( ASSOCIATED(equilibrium_out(1)%profiles_1d%q)) THEN
1676  IF (equilibrium_out(1)%profiles_1d%q(1) * equilibrium_db(1)%global_param%i_plasma * equilibrium_db(1)%global_param%toroid_field%b0 .GE. 0.0_r8 ) THEN
1677  equilibrium_out(1)%profiles_1d%q = -1.0_r8 * equilibrium_out(1)%profiles_1d%q
1678  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//"COCOS violation: Ip*B0*q should be < 0. q is reverted to be compliant with COCOS13"
1679  diag%IERR = diag%IERR + 1
1680  ENDIF
1681  ENDIF
1682 
1683 ! Check the direction of current (should coinside with IP)
1684  IF ( ASSOCIATED(equilibrium_out(1)%profiles_1d%jparallel)) THEN
1685  IF (equilibrium_db(1)%global_param%i_plasma * equilibrium_out(1)%profiles_1d%jparallel(1) .LE.0.0_r8 ) THEN
1686  equilibrium_out(1)%profiles_1d%jparallel = -1.0_r8 * equilibrium_out(1)%profiles_1d%jparallel
1687  diag%ERROR_MESSAGE = trim(adjustl(diag%ERROR_MESSAGE))//"COCOS violation: different sign for IP and Jpar. Jpar profile is reverted to be consistent with total current"
1688  diag%IERR = diag%IERR + 1
1689  ENDIF
1690  ENDIF
1691 
1692 
1693 
1694 ! +++ Deallocate internal derived types:
1695  DEALLOCATE (rho1)
1696  DEALLOCATE (rho2)
1697 
1698 ! +++ CODEPARAM:
1699  IF(ASSOCIATED(equilibrium_out(1)%codeparam%codename)) &
1700  DEALLOCATE(equilibrium_out(1)%codeparam%codename)
1701  IF(ASSOCIATED(equilibrium_out(1)%codeparam%codeversion)) &
1702  DEALLOCATE(equilibrium_out(1)%codeparam%codeversion)
1703  IF(ASSOCIATED(equilibrium_out(1)%codeparam%output_diag)) &
1704  DEALLOCATE(equilibrium_out(1)%codeparam%output_diag)
1705  ALLOCATE (equilibrium_out(1)%codeparam%codename(1))
1706  ALLOCATE (equilibrium_out(1)%codeparam%codeversion(1))
1707  ALLOCATE (equilibrium_out(1)%codeparam%output_diag(1))
1708 
1709  equilibrium_out(1)%codeparam%codename = 'Fill_EQILIBRIUM'
1710  equilibrium_out(1)%codeparam%codeversion = 'Fill_EQILIBRIUM_4.10b.10'
1711  equilibrium_out(1)%codeparam%output_flag = diag%IERR
1712  equilibrium_out(1)%codeparam%output_diag(1) = "FILL EQUILIBRIUM: "//trim(adjustl(diag%ERROR_MESSAGE))
1713  RETURN
1714 
1715  END SUBROUTINE fillequilibrium
1716 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1717 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1718 
1719 
1720 
1721 
1722 
1723 
1724 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1725 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1726  SUBROUTINE filltoroidfield (TOROIDFIELD, TOROIDFIELD_GRID, TOROIDFIELD_OUT)
1727 
1728 !-------------------------------------------------------!
1729 ! This routine loads geometry quantities from the !
1730 ! EQUILIBRIUM CPO stored in ITM data base. !
1731 ! The settings, like switches or boundary !
1732 ! conditions, are not updated!!! These quantities !
1733 ! are taken from the EQUILIBRIUM_IN. !
1734 !-------------------------------------------------------!
1735 ! Source: --- !
1736 ! Developers: D.Kalupin !
1737 ! Kontacts: D.Kalupin@fz-juelich.de !
1738 ! !
1739 ! Comments: --- !
1740 ! !
1741 !-------------------------------------------------------!
1742 
1743 
1744 ! +++ Declaration of variables:
1745  USE euitm_schemas
1746  USE euitm_routines
1747  USE itm_types
1748  USE copy_structures
1749  USE deallocate_structures
1750 
1751  IMPLICIT NONE
1752 
1753 
1754 ! +++ CPO derived types:
1755  TYPE (type_toroidfield), POINTER :: toroidfield_out(:)
1756  TYPE (type_toroidfield), POINTER :: toroidfield(:)
1757  TYPE (type_toroidfield), POINTER :: toroidfield_grid(:)
1758 
1759 
1760 ! +++ Retrieve CPO from the data base:
1761 
1762 
1763  ALLOCATE (toroidfield_out(1))
1764 
1765  CALL copy_cpo(toroidfield_grid(1), toroidfield_out(1))
1766 
1767 
1768  RETURN
1769 
1770 
1771  END SUBROUTINE filltoroidfield
1772 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1773 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1774 
1775 
1776 
1777 
1778 
1779 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1780 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1781  SUBROUTINE fillneoclassic (NEOCLASSIC_DB, NEOCLASSIC_GRID, NEOCLASSIC_OUT, INTERPOL)
1782 
1783 ! +++ Declaration of variables:
1784  USE itm_types
1785  USE euitm_schemas
1786  USE allocate_deallocate
1787  USE copy_structures
1788  USE deallocate_structures
1789  USE interpolate_cpo
1790 
1791 
1792 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1793  IMPLICIT NONE
1794 
1795  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
1796  INTEGER :: nrho1, nrho2
1797  INTEGER :: nnucl
1798  INTEGER :: nion, iion
1799  INTEGER :: nimp
1800  INTEGER, ALLOCATABLE :: nzimp(:)
1801  INTEGER :: nneut
1802  INTEGER, ALLOCATABLE :: ncomp(:)
1803  INTEGER, ALLOCATABLE :: ntype(:)
1804 
1805  INTEGER :: interpol !interpolation index "0"-based on RHO_TOR; all other - based on RHO_TOR_NORM
1806 
1807 ! +++ CPO derived types:
1808  TYPE (type_neoclassic), POINTER :: neoclassic_grid(:) !input CPO with internal ETS parameters
1809  TYPE (type_neoclassic), POINTER :: neoclassic_out(:) !output CPO with profiles uploaded from the data base
1810  TYPE (type_neoclassic), POINTER :: neoclassic_db(:) !time independent CPO slice
1811 
1812 
1813 
1814 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1815 
1816 
1817 ! +++ RHO grid:
1818  nrho1 = SIZE (neoclassic_grid(1)%rho_tor, dim=1)
1819  nrho2 = SIZE (neoclassic_db(1)%rho_tor, dim=1)
1820 
1821 
1822 ! +++ Allocate output CPO and internal derived types:
1823  CALL get_comp_dimensions(neoclassic_grid(1)%COMPOSITIONS, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp)
1824  CALL copy_cpo(neoclassic_grid, neoclassic_out)
1825 
1826 
1827 
1828 ! +++ Check if interpolation can be done:
1829  IF (.NOT.ASSOCIATED(neoclassic_db(1)%rho_tor)) goto 10
1830  IF (maxval(neoclassic_db(1)%rho_tor).LE.0.0_r8) goto 10
1831 
1832  IF (interpol.NE.0) &
1833  neoclassic_db(1)%rho_tor = neoclassic_db(1)%rho_tor &
1834  / neoclassic_db(1)%rho_tor(nrho2) &
1835  * neoclassic_out(1)%rho_tor(nrho1)
1836 
1837 
1838 
1839 ! +++ Interpolate profiles:
1840  CALL interpolate_neoclassic(neoclassic_db(1), neoclassic_out(1))
1841 
1842 
1843 
1844 
1845 ! +++ Deallocate internal derived types:
1846 
1847  10 IF(ALLOCATED(nzimp)) DEALLOCATE (nzimp)
1848  IF(ALLOCATED(ncomp)) DEALLOCATE (ncomp)
1849  IF(ALLOCATED(ntype)) DEALLOCATE (ntype)
1850 
1851 
1852  RETURN
1853 
1854 
1855  END SUBROUTINE fillneoclassic
1856 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1857 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1858 
1859 
1860 
1861 END MODULE fill_cpos
1862 
1863 
1864 
1865 
1866 
1867 
1868 
1869 
1870 
1871 
interpolate_cpo
Definition: interpolate_cpo.f90:1
fill_cpos
Definition: fill_cpos.f90:1
interpolate_cpo::interpolate_fast
subroutine interpolate_fast(COREFAST_IN, COREFAST_OUT)
Definition: interpolate_cpo.f90:1786
allocate_deallocate::get_comp_dimensions
subroutine get_comp_dimensions(COMPOSITIONS, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP)
Definition: allocate_deallocate.f90:1845
interpolate_cpo::interpolate_prof
subroutine interpolate_prof(COREPROF_IN, COREPROF_OUT)
Definition: interpolate_cpo.f90:694
fill_cpos::fillcoreimpur
subroutine fillcoreimpur(COREIMPUR_DB, COREIMPUR_GRID, COREIMPUR_OUT, INTERPOL)
Definition: fill_cpos.f90:1202
interpolate_cpo::interpolate_transp
subroutine interpolate_transp(CORETRANSP_IN, CORETRANSP_OUT, NEGATIVE_DIFF)
Definition: interpolate_cpo.f90:321
fill_cpos::fillcorefast
subroutine fillcorefast(COREFAST_DB, COREFAST_GRID, COREFAST_OUT, INTERPOL)
Definition: fill_cpos.f90:1116
ets_plasma::diagnostic
Definition: ets_plasma.f90:463
fill_cpos::filltoroidfield
subroutine filltoroidfield(TOROIDFIELD, TOROIDFIELD_GRID, TOROIDFIELD_OUT)
Definition: fill_cpos.f90:1726
fill_cpos::fillcoresource
subroutine fillcoresource(CORESOURCE_DB, CORESOURCE_GRID, CORESOURCE_OUT, INTERPOL)
Definition: fill_cpos.f90:943
l3interp
subroutine l3interp(y_in, x_in, nr_in, y_out, x_out, nr_out)
Definition: l3interp.f90:1
interpolate_cpo::interpolate_neoclassic
subroutine interpolate_neoclassic(NEOCLASSIC_IN, NEOCLASSIC_OUT)
Definition: interpolate_cpo.f90:1263
fill_cpos::fillcoreprof
subroutine fillcoreprof(COREPROF_DB, COREPROF_GRID, COREFAST_IN, COREPROF_OUT, INTERPOL)
Definition: fill_cpos.f90:7
check_nans_in_coresource
subroutine check_nans_in_coresource(CORESOURCE)
Definition: fill_cpos.f90:1032
fill_cpos::fillcoreneutrals
subroutine fillcoreneutrals(CORENEUTRALS_DB, CORENEUTRALS_GRID, CORENEUTRALS_OUT, INTERPOL)
Definition: fill_cpos.f90:1299
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
fill_cpos::fillcoretransp
subroutine fillcoretransp(CORETRANSP_DB, CORETRANSP_GRID, CORETRANSP_OUT, INTERPOL)
Definition: fill_cpos.f90:768
fill_cpos::fillequilibrium
subroutine fillequilibrium(EQUILIBRIUM_DB, EQUILIBRIUM_GRID, EQUILIBRIUM_OUT, INTERPOL)
Definition: fill_cpos.f90:1383
check_nans_in_coretransp
subroutine check_nans_in_coretransp(CORETRANSP)
Definition: fill_cpos.f90:856
fill_cpos::fillcoreprof2
subroutine fillcoreprof2(COREPROF_DB, COREPROF_GRID, COREFAST_IN, COREPROF_OUT, INTERPOL, integer_params, real_params, output_flag, diagnostic_info)
Definition: fill_cpos.f90:320
ets_plasma
The module declares types of variables used in ETS (transport code)
Definition: ets_plasma.f90:8
interpolate_cpo::interpolate_source
subroutine interpolate_source(CORESOURCE_IN, CORESOURCE_OUT)
Definition: interpolate_cpo.f90:25
interpolate_cpo::interpolate_neutrals
subroutine interpolate_neutrals(CORENEUTRALS_IN, CORENEUTRALS_OUT)
Definition: interpolate_cpo.f90:1125
interpolate_cpo::interpolate_impur
subroutine interpolate_impur(COREIMPUR_IN, COREIMPUR_OUT)
Definition: interpolate_cpo.f90:972
fill_cpos::fillneoclassic
subroutine fillneoclassic(NEOCLASSIC_DB, NEOCLASSIC_GRID, NEOCLASSIC_OUT, INTERPOL)
Definition: fill_cpos.f90:1781