ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
prepare_input_cpos.F90
Go to the documentation of this file.
1 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
2 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
3 PROGRAM prepare_input_cpos
4 
5 !-------------------------------------------------------!
6 ! This routine saves plasma profiles transport !
7 ! coefficients and sources into the CPO based !
8 ! data base !
9 !-------------------------------------------------------!
10 ! Source: --- !
11 ! Developers: D.Kalupin !
12 ! Kontacts: D.Kalupin@fz-juelich.de !
13 ! !
14 ! Comments: changes for impurity !
15 ! !
16 !-------------------------------------------------------!
17 
18 ! +++ Declaration of variables:
19  USE euitm_schemas
20  USE euitm_routines
21  USE allocate_deallocate
22  USE itm_constants
23  USE write_structures
24  USE deallocate_structures
25  USE xml_file_reader
26  USE euitm_xml_parser
27  USE plasma_composition
28  use copy_structures
29 
30  IMPLICIT NONE
31 
32  INTEGER :: nslice=1
33  INTEGER :: nrho=100, irho
34  INTEGER :: nnucl=1, inucl !number of nuclei species
35  INTEGER :: nion=1, iion !number of ion species
36  INTEGER :: nimp=0, iimp !number of impurity species
37  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
38  INTEGER :: izimp
39  INTEGER :: nneut=0, ineut !number of neutrals species
40  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
41  INTEGER :: icomp
42  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
43  INTEGER :: itype
44  INTEGER :: npsi=100 !number of points for equilibrium 1-D arrays
45  INTEGER :: ndim1=100, idim1 !number of points for equilibrium 2-D arrays, first dimension
46  INTEGER :: ndim2=100, idim2 !number of points for equilibrium 2-D arrays, second dimension
47  INTEGER :: npoints !number of points for equilibrium boundary
48  INTEGER :: ncold=1, nthermal=1, nfast=0, nnbi=0
49 
50  REAL (R8), ALLOCATABLE :: amn(:)
51  REAL (R8), ALLOCATABLE :: zn(:)
52  REAL (R8), ALLOCATABLE :: zion(:)
53  REAL (R8), ALLOCATABLE :: amn_imp(:)
54  REAL (R8), ALLOCATABLE :: zn_imp(:)
55  REAL (R8), ALLOCATABLE :: max_z_imp(:)
56 
57  INTEGER :: cold_neutrals=0
58  INTEGER :: thermal_neutrals=0
59  INTEGER :: fast_neutrals=0
60  INTEGER :: nbi_neutrals=0
61 
62  INTEGER :: force_compositions=0
63 
64 
65 
66 ! +++ CPO derived types:
67  TYPE (type_equilibrium), POINTER :: equilibrium(:)
68  TYPE (type_equilibrium), POINTER :: equilibrium_ext(:)
69 !irena compositionc
70  TYPE (type_compositionc),POINTER :: compositionc(:)
71  TYPE (type_compositionc),POINTER :: compositionc_ext(:)
72 !irena compositionc
73  TYPE (type_coreprof), POINTER :: coreprof(:)
74  TYPE (type_coreprof), POINTER :: coreprof_comp(:)
75  TYPE (type_coreprof), POINTER :: coreprof_ext(:)
76  TYPE (type_coretransp), POINTER :: coretransp(:)
77  TYPE (type_coretransp), POINTER :: coretransp_ext(:)
78  TYPE (type_coresource), POINTER :: coresource(:)
79  TYPE (type_coresource), POINTER :: coresource_ext(:)
80  TYPE (type_coreimpur), POINTER :: coreimpur(:)
81  TYPE (type_coreimpur), POINTER :: coreimpur_ext(:)
82  TYPE (type_wall), POINTER :: wall(:)
83  TYPE (type_wall), POINTER :: wall_ext(:)
84  TYPE (type_toroidfield), POINTER :: toroidfield(:)
85  TYPE (type_toroidfield), POINTER :: toroidfield_ext(:)
86 !irena neutrals
87  TYPE (type_coreneutrals),POINTER :: coreneutrals(:)
88  TYPE (type_coreneutrals),POINTER :: coreneutrals_ext(:)
89 !irena neutrals
90 
91 ! +++ Control parameters:
92  INTEGER :: idx !index (internal)
93  INTEGER :: refshot !shot number
94  INTEGER :: refrun !run number
95  INTEGER :: ind, tindex
96 
97  CHARACTER(len=5) :: treename
98  CHARACTER(len=8) :: coreprofpath
99  CHARACTER(len=10) :: coretransppath
100  CHARACTER(len=10) :: coresourcepath
101  CHARACTER(len=9) :: coreimpurpath
102  CHARACTER(len=4) :: wallpath
103  CHARACTER(len=11) :: equilibriumpath
104  CHARACTER(len=11) :: toroidfieldpath
105 
106 !irena
107  CHARACTER(len=12) :: coreneutralspath
108  CHARACTER(len=12) :: compositioncpath
109 !irena
110  CHARACTER(len=256) :: user, machine, ual_version
111 
112  CHARACTER(len=17) :: filename
113 
114 ! +++ Plasma parameters:
115  REAL(R8), ALLOCATABLE :: rho(:)
116  REAL(R8), ALLOCATABLE :: rhonrm(:)
117  REAL(R8) :: rhob
118  REAL(R8) :: rhox, ipt
119  REAL(R8) :: curr, curr_total
120  REAL(R8), ALLOCATABLE :: ne(:)
121  REAL(R8), ALLOCATABLE :: te(:)
122  REAL(R8), ALLOCATABLE :: ni(:,:)
123  REAL(R8), ALLOCATABLE :: zi(:,:)
124  REAL(R8), ALLOCATABLE :: ti(:,:)
125  REAL(R8), ALLOCATABLE :: vtor(:,:)
126  REAL(R8), ALLOCATABLE :: jpar(:), intjpar(:)
127  REAL(R8), ALLOCATABLE :: qsf(:)
128  REAL(R8), ALLOCATABLE :: pr(:)
129  REAL(R8), ALLOCATABLE :: psi(:)
130  REAL(R8), ALLOCATABLE :: fun(:)
131  REAL(R8), ALLOCATABLE :: dvdrho(:)
132  REAL(R8), ALLOCATABLE :: integrated_power(:)
133 
134  LOGICAL :: external_coreprof = .false., external_equilibrium = .false., &
135  external_coresource = .false., external_coretransp = .false., &
136  external_coreimpur = .false., external_toroidfield = .false., &
137  external_coreneutrals = .false., external_compositionc = .false., &
138  external_wall = .false.
139 
140  INTEGER :: iargc
141 
142  REAL (R8) :: theta
143 
144 !!!
145 ! Size of input buffer.
146  INTEGER, PARAMETER :: buflen = 256
147 
148  TYPE (type_param) :: code_parameters
149  INTEGER :: return_status
150 
151  INTEGER :: shot=0, run=0
152  REAL(R8) :: time=0, r0=0, b0=0, a0=0, ip=0, rgeo=0
153  REAL(R8) :: el=0, tr_u=0, tr_l=0
154  CHARACTER(len=BUFLEN) :: rho_f
155  REAL(R8), ALLOCATABLE :: rho_1(:), rho_2(:), rho_3(:), rho_4(:)
156  REAL(R8) :: dummy1, dummy2, x
157  CHARACTER(len=BUFLEN), ALLOCATABLE :: ni_f(:),ti_f(:),vtor_f(:)
158  CHARACTER(len=BUFLEN) :: te_f, jpar_f, qsf_f
159  CHARACTER(len=BUFLEN) :: sigma_f, ne_diff_f(3), ne_conv_f(3)
160  CHARACTER(len=BUFLEN), ALLOCATABLE :: ni_diff_f(:,:), ni_conv_f(:,:)
161  CHARACTER(len=BUFLEN) :: te_diff_f, te_conv_f
162  CHARACTER(len=BUFLEN), ALLOCATABLE :: ti_diff_f(:), ti_conv_f(:)
163  CHARACTER(len=BUFLEN), ALLOCATABLE :: vtor_diff_f(:), vtor_conv_f(:)
164  CHARACTER(len=BUFLEN) :: j_src_f, sigma_src_f, qe_exp_f, qe_imp_f, se_exp_f, se_imp_f
165  CHARACTER(len=BUFLEN), ALLOCATABLE :: qi_exp_f(:), qi_imp_f(:), si_exp_f(:), si_imp_f(:)
166 !irena source for impurity
167  CHARACTER(len=BUFLEN), ALLOCATABLE :: qz_exp_f(:), qz_imp_f(:), sz_exp_f(:), sz_imp_f(:)
168  CHARACTER(len=BUFLEN), ALLOCATABLE :: ui_exp_f(:), ui_imp_f(:)
169 
170  CHARACTER(len=BUFLEN), ALLOCATABLE :: imp_nz_f(:), imp_diff_f(:), imp_conv_f(:)
171 
172  CHARACTER(len=80) :: equilibrium_external='', coreprof_external='', coreneutrals_external='',compositionc_external='',&
173  coretransp_external='',coresource_external='', coreimpur_external='', toroidfield_external='', &
174  tmp_external, wall_external=''
175 
176  CHARACTER(len=80) :: prepare_input_cpos_xml = 'prepare_input_cpos_1.xml'
177 
178 !irena neutrlas
179  INTEGER :: inneut,imax_ntype,imax_comp
180 !irena
181  INTEGER :: shot_in, run_in
182 
183  INTEGER :: i, j
184  LOGICAL :: l_ext_current
185 
186  l_ext_current =.false.
187 
188  IF(iargc().GT.0) THEN
189  CALL getarg(1,prepare_input_cpos_xml)
190  ENDIF
191 
192  CALL fill_param(code_parameters, trim(prepare_input_cpos_xml), '', 'XML/prepare_input_cpos.xsd')
193 
194  CALL assign_code_parameters(code_parameters, return_status, &
195 !
196  nzimp, ncomp, ntype, &
197 !
198  amn, zn, zion, &
199 !
200  amn_imp, zn_imp, max_z_imp, &
201 !
202  npoints)
203 
204 
205  IF(rgeo == 0) rgeo = r0
206 
207  WRITE(*,*) 'EXTERNAL_COREPROF = ', external_coreprof
208  WRITE(*,*) ' NRHO = ', nrho
209  WRITE(*,*) ' NION = ', nion
210  WRITE(*,*) ' NIMP = ', nimp
211  IF(ALLOCATED(nzimp)) &
212  WRITE(*,*) ' NZIMP = ', nzimp
213  WRITE(*,*) ' NDIM1 = ', ndim1
214  WRITE(*,*) ' NDIM2 = ', ndim2
215  WRITE(*,*) ' NPOINTS = ', npoints
216 
217 !irena neutrals
218  WRITE(*,*) ' NNEUT = ', nneut
219  IF(ALLOCATED(ncomp)) &
220  WRITE(*,*) ' NCOMP = ', ncomp
221  IF(ALLOCATED(ntype)) &
222  WRITE(*,*) ' NTYPE = ', ntype
223 !Irena
224  WRITE(*,*) ' SHOT = ', shot
225  WRITE(*,*) ' RUN = ', run
226  WRITE(*,*) ' EL = ', el
227  WRITE(*,*) ' TR_U = ', tr_u
228  WRITE(*,*) ' TR_L = ', tr_l
229  WRITE(*,*) ' AMN = ', amn
230  WRITE(*,*) ' ZN = ', zn
231  WRITE(*,*) ' ZION = ', zion
232  IF(.NOT.external_coreprof) THEN
233  DO iion=1, nion
234  WRITE(*,*) ' NI_F ',iion,' : ',trim(ni_f(iion))
235  ENDDO
236  WRITE(*,*) ' TE_F ', 0, ' : ', trim(te_f)
237  DO iion=1, nion
238  WRITE(*,*) ' TI_F ',iion,' : ',trim(ti_f(iion))
239  ENDDO
240  DO iion=1, nion
241  WRITE(*,*) 'VTOR_F ',iion,' : ',trim(vtor_f(iion))
242  ENDDO
243  ENDIF
244  IF(nimp > 0) THEN
245  WRITE(*,*) ' AMN_IMP = ', amn_imp
246  WRITE(*,*) ' ZN_IMP = ', zn_imp
247  ENDIF
248  WRITE(*,*)
249  WRITE(*,*)
250 
251  refshot = 0
252  refrun = 0
253 
254 #ifdef UAL
255  IF(external_equilibrium) THEN
256  CALL parse_external(equilibrium_external, shot_in, run_in, user, machine, ual_version)
257  treename = 'euitm'
258  equilibriumpath = 'equilibrium'
259  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
260  CALL euitm_get(idx, "equilibrium", equilibrium_ext)
261 !!! DPC HACK
262  WRITE(*,*) '1: input equilibrium B0 ', equilibrium_ext(1)%global_param%toroid_field%b0
263 !! EQUILIBRIUM_EXT(1)%global_param%toroid_field%b0 = ABS(EQUILIBRIUM_EXT(1)%global_param%toroid_field%b0)
264  WRITE(*,*) '2: input equilibrium B0 ', equilibrium_ext(1)%global_param%toroid_field%b0
265 
266  ENDIF
267 
268  IF(external_coreprof) THEN
269  CALL parse_external(coreprof_external, shot_in, run_in, user, machine, ual_version)
270  treename = 'euitm'
271  coreprofpath = 'coreprof'
272  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
273  CALL euitm_get(idx, "coreprof", coreprof_ext)
274  nrho = SIZE (coreprof_ext(1)%rho_tor, dim=1)
275  IF(ASSOCIATED(coreprof_ext(1)%composition%amn)) THEN
276  nion = SIZE (coreprof_ext(1)%compositions%ions)
277  ALLOCATE(zn(nion),amn(nion),zion(nion))
278  zn = coreprof_ext(1)%composition%zn
279  amn = coreprof_ext(1)%composition%amn
280  zion = coreprof_ext(1)%composition%zion
281  ELSE
282  nion = 1
283  WRITE(*,*) 'Assuming 1 one species, D'
284  ALLOCATE(zn(nion),amn(nion),zion(nion))
285  zn = 1
286  amn = 2
287  zion = 1
288  ENDIF
289  ENDIF
290 
291 
292  IF(external_coresource) THEN
293  CALL parse_external(coresource_external, shot_in, run_in, user, machine, ual_version)
294  treename = 'euitm'
295  coresourcepath = 'coresource'
296  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
297  CALL euitm_get(idx, "coresource", coresource_ext)
298  ENDIF
299  IF(external_coretransp) THEN
300  CALL parse_external(coretransp_external, shot_in, run_in, user, machine, ual_version)
301  treename = 'euitm'
302  coretransppath = 'coretransp'
303  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
304  CALL euitm_get(idx, "coretransp", coretransp_ext)
305  ENDIF
306  IF(external_coreimpur) THEN
307  CALL parse_external(coreimpur_external, shot_in, run_in, user, machine, ual_version)
308  treename = 'euitm'
309  coreimpurpath = 'coreimpur'
310  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
311  CALL euitm_get(idx, "coreimpur", coreimpur_ext)
312  ENDIF
313  IF(external_wall) THEN
314  CALL parse_external(wall_external, shot_in, run_in, user, machine, ual_version)
315  treename = 'euitm'
316  wallpath = 'wall'
317  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
318  CALL euitm_get(idx, "wall", wall_ext)
319  ENDIF
320 
321  IF(external_coreneutrals) THEN
322  CALL parse_external(coreneutrals_external, shot_in, run_in, user, machine, ual_version)
323  treename = 'euitm'
324  coreneutralspath = 'coreneutrals'
325  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
326  CALL euitm_get(idx, "coreneutrals", coreneutrals_ext)
327  ENDIF
328 
329  IF(external_compositionc) THEN
330  CALL parse_external(compositionc_external, shot_in, run_in, user, machine, ual_version)
331  treename = 'euitm'
332  compositioncpath = 'compositionc'
333  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
334  CALL euitm_get(idx, "compositionc", compositionc_ext)
335  ENDIF
336 
337  !irena
338 
339  IF(external_toroidfield) THEN
340  CALL parse_external(toroidfield_external, shot_in, run_in, user, machine, ual_version)
341  treename = 'euitm'
342  toroidfieldpath = 'toroidfield'
343  CALL euitm_open_env(treename,shot_in,run_in,idx,trim(user),trim(machine),trim(ual_version))
344  CALL euitm_get(idx, "toroidfield", toroidfield_ext)
345  ENDIF
346 #else
347  IF(external_equilibrium.OR.external_coreprof.OR.external_coresource.OR.external_coretransp.OR. &
348  external_coreimpur.OR.external_toroidfield.OR.external_wall) THEN
349  WRITE(*,*) 'No UAL available at compile time'
350  stop 'No UAL'
351  ENDIF
352 #endif
353 
354  ALLOCATE ( rho(nrho) )
355  ALLOCATE ( rhonrm(nrho) )
356  ALLOCATE ( ne(nrho) )
357  ALLOCATE ( te(nrho) )
358  ALLOCATE ( qsf(nrho) )
359  ALLOCATE ( jpar(nrho) )
360  ALLOCATE ( intjpar(nrho) )
361  ALLOCATE ( ni(nrho,nion) )
362  ALLOCATE ( zi(nrho,nion) )
363  ALLOCATE ( ti(nrho,nion) )
364  ALLOCATE ( vtor(nrho,nion) )
365  ALLOCATE ( pr(nrho) )
366  ALLOCATE ( psi(nrho) )
367  ALLOCATE ( fun(nrho) )
368  ALLOCATE ( dvdrho(nrho) )
369  ALLOCATE ( integrated_power(nrho))
370 
371 
372  npoints = 100
373 
374 
375 ! +++ Allocate output CPO and internal derived types:
376  CALL allocate_coreprof_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coreprof )
377  CALL allocate_coretransp_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coretransp )
378  CALL allocate_coresource_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource )
379  CALL allocate_coreneutrals_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coreneutrals)
380  CALL allocate_coreimpur_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coreimpur )
381  CALL allocate_toroidfield_cpo(nslice, toroidfield )
382  CALL allocate_equilibrium_cpo(nslice, npsi, ndim1, ndim2, npoints, equilibrium )
383  CALL allocate_compositionc_cpo(nslice, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, compositionc)
384 
385 
386  IF(external_coreprof) THEN
387  rhob = coreprof_ext(1)%rho_tor(nrho)
388  ELSE IF (external_equilibrium) THEN
389  rhob = equilibrium_ext(1)%profiles_1d%rho_tor(size(equilibrium_ext(1)%profiles_1d%rho_tor))
390  ELSE
391  rhob = a0
392  ENDIF
393 
394 
395  IF(external_coreprof) THEN
396  rho = coreprof_ext(1)%rho_tor
397  rhonrm = rho/rho(nrho)
398  ELSE
399  ALLOCATE(rho_1(0:10*nrho), rho_2(0:10*nrho), rho_3(0:10*nrho), rho_4(nrho))
400  DO i=0,10*nrho
401  x=1.0d0/(10*nrho)*i
402  rho_1(i) = x
403  ENDDO
404  rho_2 = profile(rho_f, rho_1)
405  rho_3(0)=0
406  DO i=1,10*nrho
407  CALL cubint(10*nrho+1, rho_1, rho_2, 1, i+1, rho_3(i), dummy1)
408  ENDDO
409  rho_3=rho_3/rho_3(10*nrho)
410  rho_4 = (/ (1.0_r8/(nrho-1) * (irho-1), irho=1,nrho) /)
411  CALL l3interp(rho_1, rho_3, 10*nrho+1, rhonrm, rho_4, nrho)
412  DEALLOCATE(rho_1, rho_2, rho_3, rho_4)
413  rho = rhonrm * rhob
414  ENDIF
415  rhox = max(sqrt(el), 1.0_r8)
416 
417  IF(external_coreprof) THEN
418  jpar = coreprof_ext(1)%profiles1d%jtot%value
419  pr = coreprof_ext(1)%profiles1d%pr_perp%value
420  qsf = coreprof_ext(1)%profiles1d%q%value
421  ELSE
422  IF (trim(jpar_f) == '0.0' .AND. (external_equilibrium)) THEN
423  CALL l3interp(equilibrium_ext(1)%profiles_1d%jparallel, equilibrium_ext(1)%profiles_1d%rho_tor, size(equilibrium_ext(1)%profiles_1d%rho_tor), &
424  jpar, rho, nrho)
425  CALL l3interp(equilibrium_ext(1)%profiles_1d%psi, equilibrium_ext(1)%profiles_1d%rho_tor, size(equilibrium_ext(1)%profiles_1d%rho_tor), &
426  psi, rho, nrho)
427  l_ext_current =.true.
428  ELSE
429  jpar = profile(jpar_f,rhonrm) !Jpar [A/m^2]
430  END IF
431 
432  IF (trim(qsf_f) == '0.0'.AND. (external_equilibrium)) THEN
433  CALL l3interp(equilibrium_ext(1)%profiles_1d%q, equilibrium_ext(1)%profiles_1d%rho_tor, size(equilibrium_ext(1)%profiles_1d%rho_tor), &
434  qsf, rho, nrho)
435  ELSE
436  qsf = profile(qsf_f,rhonrm) !q [-]
437  END IF
438 
439  te = profile(te_f,rhonrm) !Te [eV]
440  ne = 0
441  pr = 0
442  DO iion = 1, nion
443  ni(:,iion) = profile(ni_f(iion),rhonrm) !ni [m^-3]
444  ti(:,iion) = profile(ti_f(iion),rhonrm) !Ti [eV]
445  vtor(:,iion) = profile(vtor_f(iion),rhonrm) !Vtor [m/s]
446  ne = ne + ni(:,iion) * zion(iion) !Pr [Pa]
447  pr = pr + ni(:,iion) * ti(:,iion) !ne [m^-3]
448  ENDDO
449 
450  pr = (pr + ne * te) * itm_ev
451 
452 ! +++ Computed parameters:
453 
454  ENDIF
455 
456 !PIS -removed 160721 IPT = IP/EL
457  ipt = ip
458 
459  IF (.NOT. l_ext_current) THEN ! PIS consistent q, jpar and psi from equilibrium
460 
461 7 CONTINUE
462 
463  CALL integral(nrho, rho, jpar, intjpar)
464 
465 !DPC logic changed to avoid dividing by 0
466  rho_loop2: DO irho =1,nrho
467  IF(intjpar(irho).NE.0.e0_r8) THEN
468  qsf(irho) = -rho(irho)**2*b0/r0/1.25e-6_r8/intjpar(irho)
469  ELSE
470  qsf(irho) = 0.0_r8
471  ENDIF
472  IF (qsf(irho).NE.0.e0_r8) THEN
473  fun(irho) = 2.e0_r8*itm_pi*b0/qsf(irho)
474  END IF
475  END DO rho_loop2
476  qsf(1) = qsf(2)
477  fun(1) = fun(2)
478  CALL integral(nrho, rho, fun, psi)
479 
480  fun = jpar*4.e0_r8*itm_pi**2*rho*r0
481  CALL integral_value(nrho, rho, fun, intjpar)
482  curr = intjpar(nrho)/(2.e0_r8*itm_pi*r0)
483 
484  WRITE(6,*) curr
485  IF (dabs(1.0_r8 - curr/ipt) .GE. 1.0e-5_r8) THEN
486  jpar = jpar * ipt / curr
487  goto 7
488  END IF
489 
490  print *, ip / curr
491  WRITE (6,*) 'TOTAL CURRENT NORMALISED TO', curr
492 !PIS IF(EL.NE.1.0_R8) THEN
493  rho=rho * rhox
494 !PIS ENDIF
495  psi = sign(psi, -ip)
496 
497 ENDIF
498 
499  IF (external_equilibrium) THEN
500  CALL l3interp(equilibrium_ext(1)%profiles_1d%dvdrho, equilibrium_ext(1)%profiles_1d%rho_tor, size(equilibrium_ext(1)%profiles_1d%rho_tor), &
501  dvdrho, rho, nrho)
502  END IF
503 ! COREPROF:
504 !==============================================================================================
505 ! +++ Set up profiles of plasma parameters:
506 
507  IF(.NOT.external_coreprof) THEN
508  coreprof(1)%time = time
509  coreprof(1)%datainfo%cocos = 13
510  coreprof(1)%toroid_field%r0 = r0
511  coreprof(1)%toroid_field%b0 = b0
512  coreprof(1)%globalparam%current_tot = ip
513  coreprof(1)%rho_tor = rho
514  coreprof(1)%rho_tor_norm = rhonrm
515  coreprof(1)%profiles1d%jtot%value = jpar
516  coreprof(1)%profiles1d%q%value = qsf
517  coreprof(1)%psi%value = psi
518  coreprof(1)%ne%value = ne
519  coreprof(1)%te%value = te
520  coreprof(1)%ni%value = ni
521  coreprof(1)%ti%value = ti
522  coreprof(1)%vtor%value = vtor
523  coreprof(1)%profiles1d%pr_th%value = pr
524  coreprof(1)%profiles1d%pr_perp%value = pr
525  coreprof(1)%profiles1d%pr_parallel%value = pr
526  coreprof(1)%profiles1d%pe%value = ne*te * itm_ev
527  coreprof(1)%profiles1d%pi%value = ni*ti * itm_ev
528  coreprof(1)%psi%sigma_par%value = 0.0_r8
529 
530 
531 ! +++ Set up boundary conditions:
532  coreprof(1)%psi%boundary%value = 0
533  coreprof(1)%ne%boundary%value = 0
534  coreprof(1)%te%boundary%value = 0
535  coreprof(1)%ni%boundary%value = 0
536  coreprof(1)%ti%boundary%value = 0
537  coreprof(1)%vtor%boundary%value = 0
538 
539  coreprof(1)%psi%boundary%type = 2
540  coreprof(1)%psi%boundary%value(1) = coreprof(1)%globalparam%current_tot
541  coreprof(1)%psi%boundary%rho = rho(nrho)
542 
543  coreprof(1)%ne%boundary%type = 1
544  coreprof(1)%ne%boundary%value(1) = coreprof(1)%ne%value(nrho)
545  coreprof(1)%ne%boundary%rho_tor = rho(nrho)
546 
547  coreprof(1)%te%boundary%type = 1
548  coreprof(1)%te%boundary%value(1) = coreprof(1)%te%value(nrho)
549  coreprof(1)%te%boundary%rho_tor = rho(nrho)
550 
551  DO iion=1,nion
552  coreprof(1)%ni%boundary%type(iion) = 1
553  coreprof(1)%ni%boundary%value(1,iion) = coreprof(1)%ni%value(nrho,iion)
554  coreprof(1)%ni%boundary%rho_tor(iion) = rho(nrho)
555 
556  coreprof(1)%ti%boundary%type(iion) = 1
557  coreprof(1)%ti%boundary%value(1,iion) = coreprof(1)%ti%value(nrho,iion)
558  coreprof(1)%ti%boundary%rho_tor(iion) = rho(nrho)
559 
560  coreprof(1)%vtor%boundary%type(iion) = 1
561  coreprof(1)%vtor%boundary%value(1,iion) = coreprof(1)%vtor%value(nrho,iion)
562  coreprof(1)%vtor%boundary%rho_tor(iion) = rho(nrho)
563  END DO
564 
565 ! COREPROF(1)%composition%zion(:) = ZION(:)
566 ! COREPROF(1)%composition%amn(:) = AMN(:)
567 ! COREPROF(1)%composition%zn(:) = ZN(:)
568 
569  DO irho=1, nrho
570  coreprof(1)%profiles1d%zeff%value(irho) = 0.0_r8
571  DO iion=1, nion
572  coreprof(1)%profiles1d%zeff%value(irho) = coreprof(1)%profiles1d%zeff%value(irho) + &
573  coreprof(1)%compositions%ions(iion)%zion**2 * coreprof(1)%ni%value(irho,iion)
574  ENDDO
575  coreprof(1)%profiles1d%zeff%value(irho) = coreprof(1)%profiles1d%zeff%value(irho) / coreprof(1)%ne%value(irho)
576  ENDDO
577  ELSE
578  IF(.NOT.ASSOCIATED(coreprof_ext(1)%psi%sigma_par%value)) THEN
579  ALLOCATE(coreprof_ext(1)%psi%sigma_par%value(nrho))
580  coreprof_ext(1)%psi%sigma_par%value= 0.0_r8
581  ENDIF
582  ENDIF
583 
584 !==============================================================================================
585 
586 
587 ! CORETRANSP:
588 !==============================================================================================
589 ! +++ Set up profiles of transport coefficients:
590  coretransp(1)%time = time
591  coretransp(1)%datainfo%cocos = 13
592  coretransp(1)%VALUES(1)%rho_tor_norm = rhonrm !rho [-]
593  coretransp(1)%VALUES(1)%rho_tor = rho !rho [m]
594  coretransp(1)%VALUES(1)%sigma = profile(sigma_f,rhonrm) !sigma [1/(Ohm*m)]
595 
596  DO tindex = 1, 3
597  coretransp(1)%VALUES(1)%ne_transp%diff_eff(:,tindex) = profile(ne_diff_f(tindex),rhonrm) !Diff_ne [m^2/s]
598  coretransp(1)%VALUES(1)%ne_transp%vconv_eff(:,tindex) = profile(ne_conv_f(tindex),rhonrm) !Vcon_ne [m/s]
599  DO iion = 1, nion
600  coretransp(1)%VALUES(1)%ni_transp%diff_eff(:,iion,tindex) = profile(ni_diff_f(tindex,iion),rhonrm) !Diff_ni [m^2/s]
601  coretransp(1)%VALUES(1)%ni_transp%vconv_eff(:,iion,tindex) = profile(ni_conv_f(tindex,iion),rhonrm) !Vcon_ni [m/s]
602  ENDDO
603  ENDDO
604 
605  coretransp(1)%VALUES(1)%te_transp%diff_eff(:) = profile(te_diff_f,rhonrm) !Diff_Te [m^2/s]
606  coretransp(1)%VALUES(1)%te_transp%vconv_eff(:) = profile(te_conv_f,rhonrm) !Vcon_Te [m/s]
607 
608  DO iion = 1, nion
609  coretransp(1)%VALUES(1)%ti_transp%diff_eff(:,iion) = profile(ti_diff_f(iion),rhonrm) !Diff_Ti [m^2/s]
610  coretransp(1)%VALUES(1)%ti_transp%vconv_eff(:,iion) = profile(ti_conv_f(iion),rhonrm) !Vcon_Ti [m/s]
611  coretransp(1)%VALUES(1)%vtor_transp%diff_eff(:,iion) = profile(vtor_diff_f(iion),rhonrm) !Diff_Vtor [m^2/s]
612  coretransp(1)%VALUES(1)%vtor_transp%vconv_eff(:,iion) = profile(vtor_conv_f(iion),rhonrm) !Vcon_Vtor [m/s]
613  ENDDO
614 
615  ind=0
616  DO iimp = 1, nimp
617 
618  WRITE(*,*) 'nint(ZN_IMP(IIMP))=',nint(zn_imp(iimp))
619  WRITE(*,*)'NIMP=',nimp
620 
621  DO izimp = 1, nzimp(iimp)
622  ind = ind + 1
623  coretransp(1)%VALUES(1)%nz_transp(iimp)%DIFF_EFF(:,izimp) = profile(imp_diff_f(ind),rhonrm)
624  coretransp(1)%VALUES(1)%nz_transp(iimp)%VCONV_EFF(:,izimp) = profile(imp_conv_f(ind),rhonrm)
625  ENDDO
626  ENDDO
627 
628 !==============================================================================================
629 
630 
631 ! CORESOURCE:
632 !==============================================================================================
633 ! +++ Set up profiles of sources:
634  coresource(1)%time = time
635  coresource(1)%datainfo%cocos = 13
636  coresource(1)%VALUES(1)%rho_tor_norm = rhonrm !rho [-]
637  coresource(1)%VALUES(1)%rho_tor = rho !rho [m]
638  coresource(1)%VALUES(1)%j(:) = profile(j_src_f,rhonrm) !j_ni [A/m^2]
639  coresource(1)%values(1)%sigma = profile(sigma_src_f,rhonrm) !sigma
640  coresource(1)%VALUES(1)%qe%exp(:) = profile(qe_exp_f,rhonrm) !Qe_exp [W/m^3]
641  coresource(1)%VALUES(1)%qe%imp(:) = profile(qe_imp_f,rhonrm) !Qe_imp [1/m^3/s]
642  coresource(1)%VALUES(1)%se%exp(:) = profile(se_exp_f,rhonrm) !Se_exp [1/m^3/s]
643  coresource(1)%VALUES(1)%se%imp(:) = profile(se_imp_f,rhonrm) !Se_imp [1/s]
644  DO iion = 1, nion
645  write(6,*) 'SI_EXP_F ', si_exp_f(iion)
646  coresource(1)%VALUES(1)%si%exp(:,iion) = profile(si_exp_f(iion),rhonrm) !Si_exp [1/m^3/s]
647  coresource(1)%VALUES(1)%si%imp(:,iion) = profile(si_imp_f(iion),rhonrm) !Si_imp [1/s]
648  coresource(1)%VALUES(1)%qi%exp(:,iion) = profile(qi_exp_f(iion),rhonrm) !Qi_exp [W/m^3]
649  coresource(1)%VALUES(1)%qi%imp(:,iion) = profile(qi_imp_f(iion),rhonrm) !Qi_imp [1/m^3/s]
650  coresource(1)%VALUES(1)%ui%exp(:,iion) = profile(ui_exp_f(iion),rhonrm) !Ui_exp [kg/m/s^2]
651  coresource(1)%VALUES(1)%ui%imp(:,iion) = profile(ui_imp_f(iion),rhonrm) !Ui_imp [kg/m^2/s]
652  ENDDO
653 
654 ! part coresource for impurity
655 
656  IF (external_equilibrium) THEN
657  fun(:) = coresource(1)%values(1)%qe%exp(:)*dvdrho(:)
658  DO iion = 1, nion
659  fun(:) = fun(:) + coresource(1)%values(1)%qi%exp(:, iion)*dvdrho(:)
660  END DO
661 
662  CALL integral_value(nrho, rho, fun, integrated_power)
663 
664  write(*,*) 'Total power: ', integrated_power(nrho)
665 
666  END IF
667 
668  DO iimp = 1, nimp
669 
670  WRITE(*,*) 'nint(ZN_IMP(IIMP))=',nint(zn_imp(iimp))
671 
672  DO izimp = 1,nint(zn_imp(iimp))
673 !ir ind=ind+1
674  coresource(1)%VALUES(1)%sz(iimp)%exp(:,izimp) = profile(sz_exp_f(izimp),rhonrm) !Sz_exp [1/m^3/s]
675 ! CORESOURCE(1)%VALUES(1)%sz(IIMP)%imp(:,IZIMP) = profile(SZ_IMP_F(izimp),rhonrm) !Sz_imp [1/s]
676 ! CORESOURCE(1)%VALUES(1)%qz(IIMP)%exp(:,IZIMP) = profile(Qz_EXP_F(izimp),rhonrm) !Qz_exp [W/m^3]
677 ! CORESOURCE(1)%VALUES(1)%qz(IIMP)%imp(:,IZIMP) = profile(Qz_IMP_F(izimp),rhonrm) !Qz_imp [1/m^3/s]
678  ENDDO
679  ENDDO
680  WRITE(*,*)'do tad'
681 
682 !==============================================================================================
683 
684 
685 
686 ! COREIMPUR:
687 !==============================================================================================
688 ! +++ Set up impurity profiles:
689 ! initial to give the value 0
690 
691  coreimpur(1)%time = time
692  coreimpur(1)%datainfo%cocos = 13
693  if(nimp.gt.0) then
694  coreimpur(1)%rho_tor_norm = rhonrm !rho [-]
695  coreimpur(1)%rho_tor = rho !rho [m]
696 ! COREIMPUR(1)%desc_impur%nzimp = ZN_IMP
697 ! COREIMPUR(1)%desc_impur%zn = ZN_IMP
698 ! COREIMPUR(1)%desc_impur%amn = AMN_IMP
699 
700  ind=0
701  DO iimp = 1, nimp
702 
703  WRITE(*,*) 'nint(ZN_IMP(IIMP))=',nint(zn_imp(iimp))
704  WRITE(*,*)'NIMP=',nimp
705 
706  DO izimp = 1, nzimp(iimp)
707  ind = ind + 1
708 ! COREIMPUR(1)%desc_impur%zmin(iimp,izimp) = izimp
709 ! COREIMPUR(1)%desc_impur%zmax(iimp,izimp) = izimp
710  coreimpur(1)%impurity(iimp)%z(:,izimp) = izimp
711  coreimpur(1)%impurity(iimp)%zsq(:,izimp) = izimp**2
712  coreimpur(1)%impurity(iimp)%nz(:,izimp) = profile(imp_nz_f(ind),rhonrm)
713 ! COREIMPUR(1)%impurity(iimp)%TRANSP_COEF%DIFF(:,izimp) = profile(IMP_DIFF_F(ind),rhonrm)
714 ! COREIMPUR(1)%impurity(iimp)%TRANSP_COEF%VCONV(:,izimp) = profile(IMP_CONV_F(ind),rhonrm)
715  coreimpur(1)%impurity(iimp)%BOUNDARY%TYPE(izimp) = 1
716  coreimpur(1)%impurity(iimp)%BOUNDARY%RHO(izimp) = rho(nrho)
717  coreimpur(1)%IMPURITY(iimp)%BOUNDARY%VALUE(1,izimp) = coreimpur(1)%IMPURITY(iimp)%nz(nrho,izimp)
718  ENDDO
719  ENDDO
720  endif
721 
722 
723 !==============================================================================================
724 
725 !irena neutrals
726 ! CORENEUTRALS:
727 !==============================================================================================
728 ! +++ Set up neutrals profiles:
729 ! initial to give the value 0
730  coreneutrals(1)%time = time
731  coreneutrals(1)%datainfo%cocos = 13
732  coreneutrals(1)%rho_tor = rho
733  coreneutrals(1)%rho_tor_norm = rhonrm !rho [-]
734  IF(nneut .GT. 0 ) THEN
735 ! CORENEUTRALS(1)%neutcompo%atomlist(1)%amn = 2.0_R8
736 ! CORENEUTRALS(1)%neutcompo%atomlist(1)%zn = 1.0_R8
737 ! CORENEUTRALS(1)%neutcompo%atomlist(2)%amn = 12.0_R8
738 ! CORENEUTRALS(1)%neutcompo%atomlist(2)%zn = 6.0_R8
739 
740 ! CORENEUTRALS(1)%neutcompo%neutral(1)%neutcomp(1)%nucindex=1
741 ! CORENEUTRALS(1)%neutcompo%neutral(1)%neutcomp(1)%multiplicity=1
742 ! CORENEUTRALS(1)%neutcompo%neutral(1)%type(1)%flag = 1 ! 1=thermal neutral
743 ! CORENEUTRALS(1)%neutcompo%neutral(1)%type(2)%flag = 2 ! 2=fast neutral
744 
745 ! CORENEUTRALS(1)%neutcompo%neutral(2)%neutcomp(1)%nucindex=2
746 ! CORENEUTRALS(1)%neutcompo%neutral(2)%neutcomp(1)%multiplicity=1
747 ! CORENEUTRALS(1)%neutcompo%neutral(2)%type%flag = 1 ! 1=thermal neutral
748 ! CORENEUTRALS(1)%neutcompo%neutral(2)%type%flag = 2 ! 2=fast neutral
749 
750  DO ineut = 1,nneut
751  DO itype=1,ntype(ineut)
752  coreneutrals(1)%profiles(ineut)%neutraltype(itype)%n0%boundary%type =1.
753  coreneutrals(1)%profiles(ineut)%neutraltype(itype)%n0%boundary%rho_tor =rho(nrho)
754  coreneutrals(1)%profiles(ineut)%neutraltype(itype)%t0%boundary%type =1.
755  coreneutrals(1)%profiles(ineut)%neutraltype(itype)%t0%boundary%rho_tor =rho(nrho)
756  END DO
757  END DO
758 
759  coreneutrals(1)%profiles(1)%neutraltype(1)%t0%value(:) = 1.0_r8 !in eV
760  coreneutrals(1)%profiles(1)%neutraltype(2)%t0%value(:) = 100.0_r8 !in eV
761  coreneutrals(1)%profiles(2)%neutraltype(1)%t0%value(:) = 1.0_r8 !in eV
762  coreneutrals(1)%profiles(2)%neutraltype(2)%t0%value(:) = 100.0_r8 !in eV
763 
764 
765 
766  coreneutrals(1)%profiles(1)%neutraltype(1)%n0%value(nrho) = 1.0e+16_r8
767  coreneutrals(1)%profiles(2)%neutraltype(2)%n0%value(nrho) = 0.0_r8
768  coreneutrals(1)%profiles(1)%neutraltype(1)%n0%value(nrho) = 1.0e+3_r8
769  coreneutrals(1)%profiles(2)%neutraltype(2)%n0%value(nrho) = 0.0_r8
770  coreneutrals(1)%profiles(1)%neutraltype(1)%n0%boundary%value(3) = 1.0e+16_r8
771  coreneutrals(1)%profiles(1)%neutraltype(2)%n0%boundary%value(3) = 0.0_r8
772  coreneutrals(1)%profiles(2)%neutraltype(1)%n0%boundary%value(3) = 1.0e+3_r8
773  coreneutrals(1)%profiles(2)%neutraltype(2)%n0%boundary%value(3) = 0.0_r8
774  coreneutrals(1)%profiles(1)%neutraltype(1)%t0%boundary%value(3) = 1._r8
775  coreneutrals(1)%profiles(1)%neutraltype(2)%t0%boundary%value(3) = 100.0_r8
776  coreneutrals(1)%profiles(2)%neutraltype(1)%t0%boundary%value(3) = 1.0_r8
777  coreneutrals(1)%profiles(2)%neutraltype(2)%t0%boundary%value(3) = 100.0_r8
778 
779  END IF
780 
781 !irena
782 ! EQUILIBRIUM:
783 !==============================================================================================
784 ! +++ Set up equilibrium parameters:
785 
786  if(.not.external_equilibrium) then
787  if(npsi .NE. nrho) then
788  write(*,*) ' NPSI != NRHO '
789  stop 'Error: NPSI != NRHO'
790  endif
791  equilibrium(1)%time = time
792  equilibrium(1)%datainfo%cocos = 13
793  equilibrium(1)%global_param%i_plasma = ip
794  equilibrium(1)%global_param%toroid_field%r0 = r0
795  equilibrium(1)%global_param%toroid_field%b0 = b0
796  equilibrium(1)%eqgeometry%geom_axis%r = r0
797  equilibrium(1)%eqgeometry%geom_axis%z = 0.0_r8
798  equilibrium(1)%global_param%mag_axis%position%r = rgeo
799  equilibrium(1)%global_param%mag_axis%position%z = 0.0_r8
800  equilibrium(1)%global_param%mag_axis%bphi = r0*b0/rgeo
801  equilibrium(1)%global_param%mag_axis%q = qsf(1)
802 
803  equilibrium(1)%profiles_1d%rho_tor = rho
804  equilibrium(1)%profiles_1d%q = qsf
805  equilibrium(1)%profiles_1d%pressure = pr
806  equilibrium(1)%profiles_1d%jparallel = jpar
807  equilibrium(1)%eqgeometry%elongation = el
808  equilibrium(1)%eqgeometry%tria_upper = tr_u
809  equilibrium(1)%eqgeometry%tria_lower = tr_l
810  equilibrium(1)%eqgeometry%a_minor = a0
811 
812  equilibrium(1)%profiles_1d%gm1 = 4.e0_r8*itm_pi**2*rho/r0
813  equilibrium(1)%profiles_1d%gm2 = 1.e0_r8/r0**2
814  equilibrium(1)%profiles_1d%gm3 = 1.e0_r8
815  equilibrium(1)%profiles_1d%gm4 = 1.e0_r8/b0**2
816  equilibrium(1)%profiles_1d%gm5 = b0**2
817  equilibrium(1)%profiles_1d%gm6 = 4.e0_r8*itm_pi**2*rho*r0/b0**2
818  equilibrium(1)%profiles_1d%gm7 = 1.e0_r8
819  equilibrium(1)%profiles_1d%volume = 2.e0_r8*itm_pi**2*rho**2*r0
820 !!!DPC-EQ-4.08b-problem
821  equilibrium(1)%profiles_1d%vprime = 4.e0_r8*itm_pi**2*rho*r0
822  equilibrium(1)%profiles_1d%area = itm_pi*rho**2
823  equilibrium(1)%profiles_1d%aprime = 4.e0_r8*itm_pi**2*r0
824  equilibrium(1)%profiles_1d%F_dia = b0*r0
825  equilibrium(1)%profiles_1d%rho_vol = sqrt(equilibrium(1)%profiles_1d%volume/equilibrium(1)%profiles_1d%volume(nrho))
826 
827  equilibrium(1)%profiles_1d%elongation = el
828  equilibrium(1)%profiles_1d%tria_upper = tr_u
829  equilibrium(1)%profiles_1d%tria_lower = tr_l
830  equilibrium(1)%profiles_1d%r_inboard = rgeo - rho/rhox
831  equilibrium(1)%profiles_1d%r_outboard = rgeo + rho/rhox
832 
833  equilibrium(1)%profiles_1d%psi = psi
834  equilibrium(1)%profiles_1d%phi = rho**2 * itm_pi * b0
835 
836  equilibrium(1)%global_param%volume = equilibrium(1)%profiles_1d%volume(nrho)
837  equilibrium(1)%global_param%area = equilibrium(1)%profiles_1d%area(nrho)
838 
839 
840  DO idim2=1, ndim2
841  theta=REAL(idim2-1,r8)/REAL(ndim2,r8)*2.0_r8*itm_pi
842  DO idim1=1, ndim1
843  equilibrium(1)%coord_sys%position%R(idim1, idim2) = rgeo + &
844  rho(nrho)*idim1/ndim1/rhox * (cos(theta)-0.5_r8*(tr_u+tr_l)*(sin(theta))**2)
845  equilibrium(1)%coord_sys%position%Z(idim1, idim2) = rho(nrho)*idim1/ndim1/rhox * el * sin(theta)
846  ENDDO
847  ENDDO
848 
849  DO i = 1, npoints
850  theta=REAL(i-1,r8)/REAL(npoints)*2.0_r8*itm_pi
851  equilibrium(1)%eqgeometry%boundary(1)%r(i) = rgeo + &
852  rho(nrho)/rhox * (cos(theta)-0.5_r8*(tr_u+tr_l)*(sin(theta))**2)
853  equilibrium(1)%eqgeometry%boundary(1)%z(i) = rho(nrho)/rhox * el * sin(theta)
854  ENDDO
855 
856  equilibrium(1)%codeparam%output_flag = 0
857  endif
858 
859 !==============================================================================================
860 
861 
862 
863 
864 ! TOROIDFIELD:
865 !==============================================================================================
866 ! +++ Set up toroidal field:
867  toroidfield(1)%time = time
868  toroidfield(1)%datainfo%cocos = 13
869  toroidfield(1)%r0 = r0
870  toroidfield(1)%current%value = ip
871  toroidfield(1)%bvac_r%value = b0*r0
872 !==============================================================================================
873 
874 
875 
876 
877 
878 
879 
880 
881 
882 !==============================================================================================
883 ! +++ Put plasma compositions:
884  CALL allocate_coreprof_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coreprof_comp)
885  CALL set_plasma_composition(coreprof_comp, &
886  nion, nimp, nneut, &
887  amn, zn, zion, &
888  amn_imp, zn_imp, max_z_imp, &
889  ncomp, ntype, &
890  ncold, nthermal, nfast, nnbi)
891 
892  call deallocate_cpo(coreprof(1)%COMPOSITIONS)
893  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreprof(1)%COMPOSITIONS)
894  call deallocate_cpo(coretransp(1)%COMPOSITIONS)
895  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coretransp(1)%COMPOSITIONS)
896  call deallocate_cpo(coresource(1)%COMPOSITIONS)
897  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coresource(1)%COMPOSITIONS)
898  call deallocate_cpo(coreimpur(1)%COMPOSITIONS)
899  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreimpur(1)%COMPOSITIONS)
900  call deallocate_cpo(coreneutrals(1)%COMPOSITIONS)
901  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreneutrals(1)%COMPOSITIONS)
902  call deallocate_cpo(compositionc(1)%COMPOSITIONS)
903  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, compositionc(1)%COMPOSITIONS)
904 
905 
906  IF (force_compositions.EQ.1) THEN
907 
908  IF(external_coreprof) THEN
909  DO i=1,SIZE(coreprof_ext)
910  call deallocate_cpo(coreprof_ext(i)%COMPOSITIONS)
911  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreprof_ext(i)%COMPOSITIONS)
912  end do
913  end if
914  IF(external_coretransp) then
915  call deallocate_cpo(coretransp_ext(1)%COMPOSITIONS)
916  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coretransp_ext(1)%COMPOSITIONS)
917  endif
918  IF(external_coresource) then
919  call deallocate_cpo(coresource_ext(1)%COMPOSITIONS)
920  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coresource_ext(1)%COMPOSITIONS)
921  endif
922  IF(external_coreimpur) then
923  call deallocate_cpo(coreimpur_ext(1)%COMPOSITIONS)
924  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreimpur_ext(1)%COMPOSITIONS)
925  endif
926  IF(external_coreneutrals) then
927  call deallocate_cpo(coreneutrals_ext(1)%COMPOSITIONS)
928  CALL copy_cpo(coreprof_comp(1)%COMPOSITIONS, coreneutrals_ext(1)%COMPOSITIONS)
929  endif
930 
931 
932  END IF
933 
934 !==============================================================================================
935 
936 
937 ! +++ Define tree_name and CPO_name for the data base:
938  treename = 'euitm'
939  coreprofpath = 'coreprof'
940  coretransppath = 'coretransp'
941  coresourcepath = 'coresource'
942  coreimpurpath = 'coreimpur'
943  wallpath = 'wall'
944 !irena
945  coreneutralspath = 'coreneutrals'
946  compositioncpath = 'compositionc'
947 !irena
948  equilibriumpath = 'equilibrium'
949  toroidfieldpath = 'toroidfield'
950 
951  WRITE(filename,'(''CPO_'',I6.6,''_'',I6.6)') shot, run
952  CALL open_write_file(1, filename)
953  IF(external_coreprof) THEN
954  CALL write_cpo(coreprof_ext(1), 'coreprof')
955  ELSE
956  CALL write_cpo(coreprof(1), 'coreprof')
957  ENDIF
958  IF(external_coretransp) THEN
959  CALL write_cpo(coretransp_ext(1), 'coretransp')
960  ELSE
961  CALL write_cpo(coretransp(1), 'coretransp')
962  ENDIF
963  IF(external_coresource) THEN
964  CALL write_cpo(coresource_ext(1), 'coresource')
965  ELSE
966  CALL write_cpo(coresource(1), 'coresource')
967  ENDIF
968  IF(external_coreimpur) THEN
969  CALL write_cpo(coreimpur_ext(1), 'coreimpur')
970  ELSE
971  CALL write_cpo(coreimpur(1), 'coreimpur')
972  ENDIF
973 !irena
974  IF(external_coreneutrals) THEN
975  CALL write_cpo(coreneutrals_ext(1), 'coreneutrals')
976  ELSE
977  CALL write_cpo(coreneutrals(1), 'coreneutrals')
978  ENDIF
979  IF(external_compositionc) THEN
980  CALL write_cpo(compositionc_ext(1), 'compositionc')
981  ELSE
982  CALL write_cpo(compositionc(1), 'compositionc')
983  ENDIF
984 !irena
985  IF(external_equilibrium) THEN
986  CALL write_cpo(equilibrium_ext(1), 'equilibrium')
987  ELSE
988  CALL write_cpo(equilibrium(1), 'equilibrium')
989  ENDIF
990  IF(external_toroidfield) THEN
991  CALL write_cpo(toroidfield_ext(1), 'toroidfield')
992  ELSE
993  CALL write_cpo(toroidfield(1), 'toroidfield')
994  ENDIF
995  CALL close_write_file
996 
997 ! +++ Write CPOs in the data base:
998 #ifdef UAL
999  WRITE(tmp_external,'(i,''/'',i)') shot, run
1000  WRITE(*,*) tmp_external
1001  CALL parse_external(tmp_external, shot_in, run_in, user, machine, ual_version)
1002  WRITE(*,*) shot_in, run_in, trim(user), trim(machine), trim(ual_version)
1003  treename = 'euitm'
1004  coreprofpath = 'coreprof'
1005  CALL euitm_create_env(treename,shot_in,run_in,refshot,refrun, idx,trim(user),trim(machine),trim(ual_version))
1006 ! CALL EUITM_CREATE (TREENAME, SHOT, RUN, REFSHOT, REFRUN, IDX)
1007  IF(external_coreprof) THEN
1008  CALL euitm_put_non_timed(idx, coreprofpath, coreprof_ext(1) )
1009  CALL euitm_put_slice(idx, coreprofpath, coreprof_ext(1) )
1010  ELSE
1011  CALL euitm_put_non_timed(idx, coreprofpath, coreprof(1) )
1012  CALL euitm_put_slice(idx, coreprofpath, coreprof(1) )
1013 ! call euitm_put (idx, coreprofpath, coreprof )
1014  ENDIF
1015  print *, '==============================================================='
1016  print *, '>>>>>>>>>>>>>> COREPROF FINISHED'
1017  print *, '==============================================================='
1018  print *, ' '
1019  print *, ' '
1020  IF(external_coretransp) THEN
1021  CALL euitm_put_non_timed(idx, coretransppath, coretransp_ext(1))
1022  CALL euitm_put_slice(idx, coretransppath, coretransp_ext(1))
1023  ELSE
1024  CALL euitm_put_non_timed(idx, coretransppath, coretransp(1))
1025  CALL euitm_put_slice(idx, coretransppath, coretransp(1))
1026  ENDIF
1027  print *, '==============================================================='
1028  print *, '>>>>>>>>>>>>>> CORETRANSP FINISHED'
1029  print *, '==============================================================='
1030  print *, ' '
1031  print *, ' '
1032  IF(external_coresource) THEN
1033  CALL euitm_put_non_timed(idx, coresourcepath, coresource_ext(1))
1034  CALL euitm_put_slice(idx, coresourcepath, coresource_ext(1))
1035  ELSE
1036  CALL euitm_put_non_timed(idx, coresourcepath, coresource(1))
1037  CALL euitm_put_slice(idx, coresourcepath, coresource(1))
1038  ENDIF
1039  print *, '==============================================================='
1040  print *, '>>>>>>>>>>>>>> CORESOURCE FINISHED'
1041  print *, '==============================================================='
1042  print *, ' '
1043  print *, ' '
1044  IF(external_coreimpur) THEN
1045  CALL euitm_put_non_timed(idx, coreimpurpath, coreimpur_ext(1))
1046  CALL euitm_put_slice(idx, coreimpurpath, coreimpur_ext(1))
1047  ELSE
1048  CALL euitm_put_non_timed(idx, coreimpurpath, coreimpur(1))
1049  CALL euitm_put_slice(idx, coreimpurpath, coreimpur(1))
1050  ENDIF
1051  print *, '==============================================================='
1052  print *, '>>>>>>>>>>>>>> COREIMPUR FINISHED'
1053  print *, '==============================================================='
1054  !irena
1055  print *, ' '
1056  print *, ' '
1057  IF(external_coreneutrals) THEN
1058  CALL euitm_put_non_timed(idx, coreneutralspath, coreneutrals_ext(1))
1059  CALL euitm_put_slice(idx, coreneutralspath, coreneutrals_ext(1))
1060  ELSE
1061  CALL euitm_put_non_timed(idx, coreneutralspath, coreneutrals(1))
1062  CALL euitm_put_slice(idx, coreneutralspath, coreneutrals(1))
1063  ENDIF
1064  print *, '==============================================================='
1065  print *, '>>>>>>>>>>>>>> CORENEUTRALS FINISHED'
1066  print *, '==============================================================='
1067  !irena
1068  print *, ' '
1069  print *, ' '
1070  IF(external_equilibrium) THEN
1071  CALL euitm_put_non_timed(idx, equilibriumpath, equilibrium_ext(1))
1072  CALL euitm_put_slice(idx, equilibriumpath, equilibrium_ext(1))
1073  ELSE
1074  CALL euitm_put_non_timed(idx, equilibriumpath, equilibrium(1))
1075  CALL euitm_put_slice(idx, equilibriumpath, equilibrium(1))
1076  ENDIF
1077  print *, '==============================================================='
1078  print *, '>>>>>>>>>>>>>> EQUILIBRIUM FINISHED'
1079  print *, '==============================================================='
1080  print *, ' '
1081  print *, ' '
1082  IF(external_toroidfield) THEN
1083  CALL euitm_put_non_timed(idx, toroidfieldpath, toroidfield_ext(1))
1084  CALL euitm_put_slice(idx, toroidfieldpath, toroidfield_ext(1))
1085  ELSE
1086  CALL euitm_put_non_timed(idx, toroidfieldpath, toroidfield(1))
1087  CALL euitm_put_slice(idx, toroidfieldpath, toroidfield(1))
1088  ENDIF
1089  print *, '==============================================================='
1090  print *, '>>>>>>>>>>>>>> TOROIDFIELD FINISHED'
1091  print *, '==============================================================='
1092  print *, ' '
1093  print *, ' '
1094  IF(external_wall) THEN
1095  CALL euitm_put_non_timed(idx, wallpath, wall_ext(1))
1096  CALL euitm_put_slice(idx, wallpath, wall_ext(1))
1097  ELSE
1098 ! CALL EUITM_PUT_NON_TIMED (IDX, WALLPATH, WALL(1))
1099 ! CALL EUITM_PUT_SLICE (IDX, WALLPATH, WALL(1))
1100  ENDIF
1101  print *, '==============================================================='
1102  print *, '>>>>>>>>>>>>>> WALL FINISHED'
1103  print *, '==============================================================='
1104  !irena
1105  print *, ' '
1106  print *, ' '
1107  CALL euitm_close(idx)
1108 #endif
1109 
1110  WRITE(*,*) 'Data written for ',shot, run
1111  WRITE(*,*)
1112  WRITE(*,*)
1113 
1114 ! +++ Deallocate CPOs:
1115  CALL deallocate_cpo(coreprof )
1116  CALL deallocate_cpo(coretransp )
1117  CALL deallocate_cpo(coresource )
1118  CALL deallocate_cpo(coreimpur )
1119 !irena
1120  CALL deallocate_cpo(coreneutrals )
1121  CALL deallocate_cpo(compositionc )
1122 !irena
1123  CALL deallocate_cpo(equilibrium)
1124  CALL deallocate_cpo(toroidfield)
1125 
1126  DEALLOCATE ( rho )
1127  DEALLOCATE ( ne )
1128  DEALLOCATE ( te )
1129  DEALLOCATE ( qsf )
1130  DEALLOCATE ( jpar )
1131  DEALLOCATE ( intjpar )
1132  DEALLOCATE ( ni )
1133  DEALLOCATE ( ti )
1134  DEALLOCATE ( vtor )
1135  DEALLOCATE ( pr )
1136  DEALLOCATE ( psi )
1137  DEALLOCATE ( fun )
1138 
1139 CONTAINS
1140 
1141  FUNCTION profile(function_string, x)
1142 
1143  use fortranparser, only : equationparser
1144 
1145  IMPLICIT NONE
1146 
1147  REAL(R8) :: x(:), profile(1:size(x))
1148  CHARACTER (len=BUFLEN) :: function_string
1149 
1150  type(equationparser) :: function_descriptor
1151  character(len=10) :: variables(1) = ['x']
1152 
1153  INTEGER :: i
1154 
1155  function_descriptor = equationparser(trim(function_string), variables)
1156 ! if(.not.c_associated(function_descriptor)) then
1157 ! write(*,*) 'Invalid function ', trim(function_string)
1158 ! stop
1159 ! endif
1160 
1161  DO i = 1, SIZE(x)
1162  profile(i) = function_descriptor%evaluate([x(i)])
1163  ENDDO
1164 
1165 ! CALL evaluator_destroy(function_descriptor)
1166 
1167  END FUNCTION profile
1168 
1169  SUBROUTINE assign_code_parameters(codeparameters, return_status,&
1170 !
1171  nzimp, ncomp, ntype, &
1172 !
1173  amn, zn, zion, &
1174 !
1175  amn_imp, zn_imp, max_z_imp, &
1176 !
1177  npoints)
1178 
1179  !-----------------------------------------------------------------------
1180  ! calls the XML parser for the code parameters and assign the
1181  ! resulting values to the corresponding variables
1182  !TODO: check an alternative and more elegant solution in Perl
1183  !-----------------------------------------------------------------------
1184 
1185  USE mod_f90_kind
1186 
1187  IMPLICIT NONE
1188 
1189  TYPE (type_param), INTENT(in) :: codeparameters
1190  INTEGER(ikind), INTENT(out) :: return_status
1191 
1192  TYPE(tree) :: parameter_list
1193  TYPE(element), POINTER :: temp_pointer
1194  INTEGER(ikind) :: i, nparm, n_values
1195  INTEGER :: n_data1, n_data2, n_data3
1196  CHARACTER(len = 132) :: cname
1197  CHARACTER (len=256), ALLOCATABLE :: tmp_string(:)
1198  REAL (R8) :: tmp_real(10*100)
1199  INTEGER :: tmp_int(10*100)
1200  INTEGER :: n_data
1201  INTEGER :: lng
1202  INTEGER :: nzimps
1203  INTEGER :: integer_data(1000)
1204  REAL(R8) :: real_data(1000)
1205 
1206  LOGICAL :: l_nion=.false., l_nimp=.false., l_nzimp=.false.
1207 
1208  INTEGER, ALLOCATABLE :: nzimp(:) !number of ionization states for each impurity
1209  INTEGER, ALLOCATABLE :: ncomp(:) !number of components for each neutral
1210  INTEGER, ALLOCATABLE :: ntype(:) !number of types for each neutral
1211  INTEGER :: npoints !number of points
1212 
1213  REAL (R8), ALLOCATABLE :: amn(:)
1214  REAL (R8), ALLOCATABLE :: zn(:)
1215  REAL (R8), ALLOCATABLE :: zion(:)
1216  REAL (R8), ALLOCATABLE :: amn_imp(:)
1217  REAL (R8), ALLOCATABLE :: zn_imp(:)
1218  REAL (R8), ALLOCATABLE :: max_z_imp(:)
1219 
1220 
1221  rho_f = '1.0'
1222  te_f = '0.0'
1223  jpar_f = '0.0'
1224  qsf_f = '0.0'
1225  sigma_f = '0.0'
1226  te_diff_f = '0.0'
1227  te_conv_f = '0.0'
1228  j_src_f = '0.0'
1229  sigma_src_f = '0.0'
1230  qe_exp_f = '0.0'
1231  qe_imp_f = '0.0'
1232  se_exp_f = '0.0'
1233  se_imp_f = '0.0'
1234 
1235  n_data1 = 0
1236  n_data2 = 0
1237  n_data3 = 0
1238 
1239  nzimps = 0
1240 
1241  return_status = 0 ! no error
1242 
1243  !-- parse xml-string codeparameters%parameters
1244 
1245  WRITE(*,*) 'Calling euitm_xml_parse'
1246  CALL euitm_xml_parse(code_parameters, nparm, parameter_list)
1247  WRITE(*,*) 'Called euitm_xml_parse'
1248 
1249  !-- assign variables
1250 
1251  temp_pointer => parameter_list%first
1252 
1253  outer: DO
1254 
1255  IF(l_nion) THEN
1256  ALLOCATE(ni_f(nion)) ; ni_f = '0.0'
1257  ALLOCATE(ti_f(nion)) ; ti_f = '0.0'
1258  ALLOCATE(vtor_f(nion)) ; vtor_f = '0.0'
1259  ALLOCATE(ni_diff_f(3,nion)) ; ni_diff_f = '0.0'
1260  ALLOCATE(ni_conv_f(3,nion)) ; ni_conv_f = '0.0'
1261  ALLOCATE(ti_diff_f(nion)) ; ti_diff_f = '0.0'
1262  ALLOCATE(ti_conv_f(nion)) ; ti_conv_f = '0.0'
1263  ALLOCATE(vtor_diff_f(nion)) ; vtor_diff_f = '0.0'
1264  ALLOCATE(vtor_conv_f(nion)) ; vtor_conv_f = '0.0'
1265  ALLOCATE(qi_exp_f(nion)) ; qi_exp_f = '0.0'
1266  ALLOCATE(qi_imp_f(nion)) ; qi_imp_f = '0.0'
1267  ALLOCATE(si_exp_f(nion)) ; si_exp_f = '0.0'
1268  ALLOCATE(si_imp_f(nion)) ; si_imp_f = '0.0'
1269  ALLOCATE(ui_exp_f(nion)) ; ui_exp_f = '0.0'
1270  ALLOCATE(ui_imp_f(nion)) ; ui_imp_f = '0.0'
1271  l_nion =.false.
1272  ENDIF
1273 
1274  IF(l_nimp.AND.l_nzimp) THEN
1275  IF(nzimps > 0) THEN
1276  ALLOCATE(imp_nz_f(nzimps)) ; imp_nz_f = '0.0'
1277  ALLOCATE(imp_diff_f(nzimps)) ; imp_diff_f = '0.0'
1278  ALLOCATE(imp_conv_f(nzimps)) ; imp_conv_f = '0.0'
1279 
1280  ALLOCATE(qz_exp_f(nzimps)) ; qz_exp_f = '0.0'
1281  ALLOCATE(qz_imp_f(nzimps)) ; qz_imp_f = '0.0'
1282  ALLOCATE(sz_exp_f(nzimps)) ; sz_exp_f = '0.0'
1283  ALLOCATE(sz_imp_f(nzimps)) ; sz_imp_f = '0.0'
1284  ENDIF
1285  l_nimp =.false.
1286  l_nzimp =.false.
1287  ENDIF
1288 
1289 
1290 
1291  cname = char2str(temp_pointer%cname) ! necessary for AIX
1292  SELECT CASE (cname)
1293  CASE ("parameters")
1294  temp_pointer => temp_pointer%child
1295  cycle
1296 
1297 !-- dimensions parameters
1298  CASE ("dimensions")
1299  temp_pointer => temp_pointer%child
1300  cycle
1301  CASE ("nrho")
1302  IF (ALLOCATED(temp_pointer%cvalue)) &
1303  CALL char2num(temp_pointer%cvalue, nrho)
1304  WRITE(*,*) 'NRHO = ', nrho
1305  CASE ("npsi")
1306  IF (ALLOCATED(temp_pointer%cvalue)) &
1307  CALL char2num(temp_pointer%cvalue, npsi)
1308  CASE ("neq_dim1")
1309  IF (ALLOCATED(temp_pointer%cvalue)) &
1310  CALL char2num(temp_pointer%cvalue, ndim1)
1311  CASE ("neq_dim2")
1312  IF (ALLOCATED(temp_pointer%cvalue)) &
1313  CALL char2num(temp_pointer%cvalue, ndim2)
1314  CASE ("neq_max_npoints")
1315  IF (ALLOCATED(temp_pointer%cvalue)) &
1316  CALL char2num(temp_pointer%cvalue, npoints)
1317 
1318 
1319 !-- output parameters
1320  CASE ("output")
1321  temp_pointer => temp_pointer%child
1322  cycle
1323  CASE ("shot")
1324  IF (ALLOCATED(temp_pointer%cvalue)) &
1325  CALL char2num(temp_pointer%cvalue, shot)
1326  CASE ("run")
1327  IF (ALLOCATED(temp_pointer%cvalue)) &
1328  CALL char2num(temp_pointer%cvalue, run)
1329 
1330 
1331 
1332 !-- global parameters
1333  CASE ("global")
1334  temp_pointer => temp_pointer%child
1335  cycle
1336  CASE ("time")
1337  IF (ALLOCATED(temp_pointer%cvalue)) &
1338  CALL char2num(temp_pointer%cvalue, time)
1339  CASE ("R0")
1340  IF (ALLOCATED(temp_pointer%cvalue)) &
1341  CALL char2num(temp_pointer%cvalue, r0)
1342  CASE ("B0")
1343  IF (ALLOCATED(temp_pointer%cvalue)) &
1344  CALL char2num(temp_pointer%cvalue, b0)
1345  CASE ("A0")
1346  IF (ALLOCATED(temp_pointer%cvalue)) &
1347  CALL char2num(temp_pointer%cvalue, a0)
1348  CASE ("Ip")
1349  IF (ALLOCATED(temp_pointer%cvalue)) &
1350  CALL char2num(temp_pointer%cvalue, ip)
1351  CASE ("Rgeo")
1352  IF (ALLOCATED(temp_pointer%cvalue)) &
1353  CALL char2num(temp_pointer%cvalue, rgeo)
1354  CASE ("rho")
1355  IF (ALLOCATED(temp_pointer%cvalue)) &
1356  rho_f = char2str(temp_pointer%cvalue)
1357 
1358 
1359 
1360 !-- compositions
1361  CASE ("compositions")
1362  temp_pointer => temp_pointer%child
1363  cycle
1364 
1365 
1366  CASE ("force_compositions")
1367  IF (ALLOCATED(temp_pointer%cvalue)) &
1368  CALL char2num(temp_pointer%cvalue, force_compositions)
1369 
1370 
1371  CASE ("ions")
1372  temp_pointer => temp_pointer%child
1373  cycle
1374  CASE ("amn")
1375  IF (ALLOCATED(temp_pointer%cvalue)) &
1376  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data1)
1377  ALLOCATE(amn(n_data1))
1378  amn = real_data(1:n_data1)
1379 
1380  CASE ("zn")
1381  IF (ALLOCATED(temp_pointer%cvalue)) &
1382  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data2)
1383  ALLOCATE(zn(n_data2))
1384  zn = real_data(1:n_data2)
1385 
1386  CASE ("zion")
1387  IF (ALLOCATED(temp_pointer%cvalue)) &
1388  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data3)
1389  ALLOCATE(zion(n_data3))
1390  zion = real_data(1:n_data3)
1391 
1392  nion = min(n_data1, n_data2, n_data3)
1393  l_nion=.true.
1394 
1395 
1396  CASE ("impurity")
1397  temp_pointer => temp_pointer%child
1398  cycle
1399  CASE ("amn_imp")
1400  IF (ALLOCATED(temp_pointer%cvalue)) then
1401  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data1)
1402  ALLOCATE(amn_imp(n_data1))
1403  amn_imp = real_data(1:n_data1)
1404  else
1405  n_data1 = 0
1406  endif
1407 
1408  CASE ("zn_imp")
1409  IF (ALLOCATED(temp_pointer%cvalue)) then
1410  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data2)
1411  ALLOCATE(zn_imp(n_data2))
1412  zn_imp = real_data(1:n_data2)
1413  else
1414  n_data2 = 0
1415  endif
1416 
1417  CASE ("max_z_imp")
1418  IF (ALLOCATED(temp_pointer%cvalue)) then
1419  CALL scan_str2real(char2str(temp_pointer%cvalue), real_data, n_data3)
1420  ALLOCATE(max_z_imp(n_data3))
1421  max_z_imp = real_data(1:n_data3)
1422  else
1423  n_data3 = 0
1424  endif
1425 
1426 
1427  nimp = min(n_data1, n_data2, n_data3)
1428  if(nimp.gt.0) then
1429  ALLOCATE (nzimp(nimp))
1430  nzimp = nint(max_z_imp)
1431  l_nimp = .true.
1432  l_nzimp = .true.
1433  nzimps = sum(nzimp) ! need tp specify 1 entity for each impurity charge state
1434  endif
1435 
1436  CASE ("neutrals")
1437  temp_pointer => temp_pointer%child
1438  cycle
1439  CASE ("cold_neutrals")
1440  IF (ALLOCATED(temp_pointer%cvalue)) &
1441  CALL char2num(temp_pointer%cvalue, cold_neutrals)
1442  IF (cold_neutrals.gt.0) cold_neutrals = 1
1443  CASE ("thermal_neutrals")
1444  IF (ALLOCATED(temp_pointer%cvalue)) &
1445  CALL char2num(temp_pointer%cvalue, thermal_neutrals)
1446  IF (thermal_neutrals.gt.0) thermal_neutrals = 1
1447  CASE ("fast_neutrals")
1448  IF (ALLOCATED(temp_pointer%cvalue)) &
1449  CALL char2num(temp_pointer%cvalue, fast_neutrals)
1450  IF (fast_neutrals.gt.0) fast_neutrals = 1
1451  CASE ("NBI_neutrals")
1452  IF (ALLOCATED(temp_pointer%cvalue)) &
1453  CALL char2num(temp_pointer%cvalue, nbi_neutrals)
1454  IF (nbi_neutrals.gt.0) nbi_neutrals = 1
1455 
1456  nnucl = nion + nimp !assummption of all species being different
1457 
1458 
1459  if(cold_neutrals + thermal_neutrals + fast_neutrals + nbi_neutrals .gt. 0) then
1460  nneut = nion + nimp !assummption of all species being different
1461  ALLOCATE (ncomp(nneut))
1462  ALLOCATE (ntype(nneut))
1463  ncomp = 1
1464  ntype = cold_neutrals + thermal_neutrals + fast_neutrals + nbi_neutrals
1465  else
1466  nneut = 0
1467  endif
1468 
1469 !-- equilibrium parameters
1470  CASE ("equilibrium")
1471  temp_pointer => temp_pointer%child
1472  cycle
1473  CASE ("equilibrium_ext")
1474  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1475  equilibrium_external = char2str(temp_pointer%cvalue)
1476  WRITE(*,*) '<<',trim(equilibrium_external),'>>'
1477  external_equilibrium = equilibrium_external /= ''
1478  ENDIF
1479  CASE ("el")
1480  IF (ALLOCATED(temp_pointer%cvalue)) &
1481  CALL char2num(temp_pointer%cvalue, el)
1482  CASE ("tr_u")
1483  IF (ALLOCATED(temp_pointer%cvalue)) &
1484  CALL char2num(temp_pointer%cvalue, tr_u)
1485  CASE ("tr_l")
1486  IF (ALLOCATED(temp_pointer%cvalue)) &
1487  CALL char2num(temp_pointer%cvalue, tr_l)
1488 
1489 !-- coreprof parameters
1490  CASE ("coreprof")
1491  temp_pointer => temp_pointer%child
1492  cycle
1493  CASE ("coreprof_ext")
1494  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1495  coreprof_external = char2str(temp_pointer%cvalue)
1496  WRITE(*,*) '<<',trim(coreprof_external),'>>'
1497  external_coreprof = coreprof_external /= ''
1498  ENDIF
1499 ! ENDIF
1500  CASE ("ni")
1501  lng=nion
1502  IF(.NOT.external_coreprof) THEN
1503  IF (ALLOCATED(temp_pointer%cvalue)) &
1504  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ni_f, lng)
1505  ENDIF
1506  CASE ("ti")
1507  lng=nion
1508  IF(.NOT.external_coreprof) THEN
1509  IF (ALLOCATED(temp_pointer%cvalue)) &
1510  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ti_f, lng)
1511  ENDIF
1512  CASE ("vtor")
1513  lng=nion
1514  IF(.NOT.external_coreprof) THEN
1515  IF (ALLOCATED(temp_pointer%cvalue)) &
1516  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, vtor_f, lng)
1517  ENDIF
1518  CASE ("te")
1519  IF(.NOT.external_coreprof) THEN
1520  IF (ALLOCATED(temp_pointer%cvalue)) &
1521  te_f = char2str(temp_pointer%cvalue)
1522  ENDIF
1523  CASE ("jpar")
1524  IF(.NOT.external_coreprof) THEN
1525  IF (ALLOCATED(temp_pointer%cvalue)) &
1526  jpar_f = char2str(temp_pointer%cvalue)
1527  ENDIF
1528  CASE ("qsf")
1529  IF(.NOT.external_coreprof) THEN
1530  IF (ALLOCATED(temp_pointer%cvalue)) &
1531  qsf_f = char2str(temp_pointer%cvalue)
1532  ENDIF
1533 
1534 !-- coretransp parameters
1535  CASE ("coretransp")
1536  temp_pointer => temp_pointer%child
1537  cycle
1538  CASE ("coretransp_ext")
1539  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1540  coretransp_external = char2str(temp_pointer%cvalue)
1541  WRITE(*,*) '<<',trim(coretransp_external),'>>'
1542  external_coretransp = coretransp_external /= ''
1543  ENDIF
1544  CASE ("sigma")
1545  IF (ALLOCATED(temp_pointer%cvalue)) &
1546  sigma_f = char2str(temp_pointer%cvalue)
1547  CASE ("ne_diff")
1548  lng=3
1549  IF (ALLOCATED(temp_pointer%cvalue)) &
1550  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ne_diff_f, lng)
1551  CASE ("ne_conv")
1552  lng=3
1553  IF (ALLOCATED(temp_pointer%cvalue)) &
1554  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ne_conv_f, lng)
1555  CASE ("ni_diff")
1556  ALLOCATE(tmp_string(3*nion)) ; lng =3*nion
1557  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1558  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1559  ni_diff_f=reshape(tmp_string,shape(ni_diff_f))
1560  ENDIF
1561  DEALLOCATE(tmp_string)
1562  CASE ("ni_conv")
1563  ALLOCATE(tmp_string(3*nion)) ; lng =3*nion
1564  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1565  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1566  ni_conv_f=reshape(tmp_string,shape(ni_conv_f))
1567  ENDIF
1568  DEALLOCATE(tmp_string)
1569  CASE ("te_diff")
1570  IF (ALLOCATED(temp_pointer%cvalue)) &
1571  te_diff_f = char2str(temp_pointer%cvalue)
1572  CASE ("te_conv")
1573  IF (ALLOCATED(temp_pointer%cvalue)) &
1574  te_conv_f = char2str(temp_pointer%cvalue)
1575  CASE ("ti_diff")
1576  lng=nion
1577  IF (ALLOCATED(temp_pointer%cvalue)) &
1578  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ti_diff_f, lng)
1579  CASE ("ti_conv")
1580  lng=nion
1581  IF (ALLOCATED(temp_pointer%cvalue)) &
1582  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ti_conv_f, lng)
1583  CASE ("vtor_diff")
1584  lng=nion
1585  IF (ALLOCATED(temp_pointer%cvalue)) &
1586  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, vtor_diff_f, lng)
1587  CASE ("vtor_conv")
1588  lng=nion
1589  IF (ALLOCATED(temp_pointer%cvalue)) &
1590  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, vtor_conv_f, lng)
1591  CASE ("nz_diff")
1592  IF(nzimps > 0) THEN
1593  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1594  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1595  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1596  imp_diff_f=tmp_string
1597  ENDIF
1598  DEALLOCATE(tmp_string)
1599  ENDIF
1600  CASE ("nz_conv")
1601  IF(nzimps > 0) THEN
1602  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1603  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1604  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1605  imp_conv_f=tmp_string
1606  ENDIF
1607  DEALLOCATE(tmp_string)
1608  ENDIF
1609 
1610 !-- coresource parameters
1611  CASE ("coresource")
1612  temp_pointer => temp_pointer%child
1613  cycle
1614  CASE ("coresource_ext")
1615  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1616  coresource_external = char2str(temp_pointer%cvalue)
1617  WRITE(*,*) '<<',trim(coresource_external),'>>'
1618  external_coresource = coresource_external /= ''
1619  ENDIF
1620  CASE ("j")
1621  IF (ALLOCATED(temp_pointer%cvalue)) &
1622  j_src_f = char2str(temp_pointer%cvalue)
1623  CASE ("sigma_src")
1624  IF (ALLOCATED(temp_pointer%cvalue)) &
1625  sigma_src_f = char2str(temp_pointer%cvalue)
1626  CASE ("qe_exp")
1627  IF (ALLOCATED(temp_pointer%cvalue)) &
1628  qe_exp_f = char2str(temp_pointer%cvalue)
1629  CASE ("qe_imp")
1630  IF (ALLOCATED(temp_pointer%cvalue)) &
1631  qe_imp_f = char2str(temp_pointer%cvalue)
1632  CASE ("se_exp")
1633  IF (ALLOCATED(temp_pointer%cvalue)) &
1634  se_exp_f = char2str(temp_pointer%cvalue)
1635  CASE ("se_imp")
1636  IF (ALLOCATED(temp_pointer%cvalue)) &
1637  se_imp_f = char2str(temp_pointer%cvalue)
1638  CASE ("qi_exp")
1639  lng=nion
1640  IF (ALLOCATED(temp_pointer%cvalue)) &
1641  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, qi_exp_f, lng)
1642  CASE ("qi_imp")
1643  lng=nion
1644  IF (ALLOCATED(temp_pointer%cvalue)) &
1645  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, qi_imp_f, lng)
1646  CASE ("qz_exp")
1647  IF(nzimps > 0) THEN
1648  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1649  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1650  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1651  qz_exp_f=tmp_string
1652  ENDIF
1653  DEALLOCATE(tmp_string)
1654  ENDIF
1655  CASE ("qz_imp")
1656  IF(nzimps > 0) THEN
1657  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1658  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1659  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1660  qz_imp_f=tmp_string
1661  ENDIF
1662  DEALLOCATE(tmp_string)
1663  ENDIF
1664  CASE ("si_exp")
1665  lng=nion
1666  IF (ALLOCATED(temp_pointer%cvalue)) &
1667  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, si_exp_f, lng)
1668  CASE ("si_imp")
1669  lng=nion
1670  IF (ALLOCATED(temp_pointer%cvalue)) &
1671  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, si_imp_f, lng)
1672  CASE ("sz_exp")
1673  IF(nzimps> 0) THEN
1674  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1675  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1676  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1677  sz_exp_f=tmp_string
1678  ENDIF
1679  DEALLOCATE(tmp_string)
1680  ENDIF
1681  CASE ("sz_imp")
1682  IF(nzimps > 0) THEN
1683  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1684  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1685  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1686  sz_imp_f=tmp_string
1687  ENDIF
1688  DEALLOCATE(tmp_string)
1689  ENDIF
1690  CASE ("ui_exp")
1691  lng=nion
1692  IF (ALLOCATED(temp_pointer%cvalue)) &
1693  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ui_exp_f, lng)
1694  CASE ("ui_imp")
1695  lng=nion
1696  IF (ALLOCATED(temp_pointer%cvalue)) &
1697  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, ui_imp_f, lng)
1698 
1699 !-- coreimpur parameters
1700  CASE ("coreimpur")
1701  temp_pointer => temp_pointer%child
1702  cycle
1703  CASE ("coreimpur_ext")
1704  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1705  coreimpur_external = char2str(temp_pointer%cvalue)
1706  WRITE(*,*) '<<',trim(coreimpur_external),'>>'
1707  external_coreimpur = coreimpur_external /= ''
1708  ENDIF
1709  CASE ("nz")
1710  IF(nzimps > 0) THEN
1711  ALLOCATE(tmp_string(nzimps)) ; lng=nzimps
1712  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1713  CALL scan_str2str(char2str(temp_pointer%cvalue), 256, tmp_string, lng)
1714  imp_nz_f=tmp_string
1715  ENDIF
1716  DEALLOCATE(tmp_string)
1717  ENDIF
1718 
1719 !-- wall parameters
1720  CASE ("wall")
1721  temp_pointer => temp_pointer%child
1722  cycle
1723  CASE ("wall_ext")
1724  IF (ALLOCATED(temp_pointer%cvalue)) THEN
1725  wall_external = char2str(temp_pointer%cvalue)
1726  WRITE(*,*) '<<',trim(wall_external),'>>'
1727  external_wall = wall_external /= ''
1728  ENDIF
1729 
1730 !-- default
1731  CASE default
1732  WRITE(*, *) 'ERROR: invalid parameter', cname
1733  return_status = 1
1734  EXIT
1735  END SELECT
1736  DO
1737  IF (ASSOCIATED(temp_pointer%sibling)) THEN
1738  temp_pointer => temp_pointer%sibling
1739  EXIT
1740  END IF
1741  IF (ASSOCIATED(temp_pointer%parent, parameter_list%first )) &
1742  EXIT outer
1743  IF (ASSOCIATED(temp_pointer%parent)) THEN
1744  temp_pointer => temp_pointer%parent
1745  ELSE
1746  WRITE(*, *) 'ERROR: broken list.'
1747  RETURN
1748  END IF
1749  END DO
1750  END DO outer
1751 
1752  !-- destroy tree
1753  CALL destroy_xml_tree(parameter_list)
1754 
1755  RETURN
1756 
1757  END SUBROUTINE assign_code_parameters
1758 
1759  SUBROUTINE parse_external(EXTERNAL, shot, run, user, machine, ual_version)
1760  CHARACTER*(*) EXTERNAL, user, machine, ual_version
1761  INTEGER shot, run
1762 
1763  INTEGER i1, i2, c, slash
1764 
1765 ! format of external is
1766 ! user/machine/ual_version/shot/run OR shot/run
1767 ! fields can be empty
1768 
1769  shot = 0
1770  run = 0
1771  CALL getenv('USER', user)
1772  CALL getenv('DATAVERSION', ual_version)
1773  IF(ual_version.EQ.'') THEN
1774  ual_version = '4.08b'
1775  ENDIF
1776  CALL getenv('TOKAMAKNAME', machine)
1777  IF(machine.EQ.'') THEN
1778  machine = 'test'
1779  ENDIF
1780 
1781  i1=1
1782  i2=len_trim(EXTERNAL)
1783  slash=index(external(i1:i2),'/')
1784  c=0
1785  DO WHILE (slash.NE.0)
1786  c=c+1
1787  i1=i1+slash+1
1788  IF(i1.LE.i2) THEN
1789  slash=index(external(i1:i2),'/')
1790  ELSE
1791  slash=0
1792  ENDIF
1793  ENDDO
1794 
1795  IF(c.EQ.1) THEN
1796  i1=1
1797  slash=index(external(i1:i2),'/')
1798  IF(slash.GT.1) THEN
1799  READ(external(i1:i1+slash-2),*) shot
1800  ELSE
1801  WRITE(*,*) 'shot not specified'
1802  stop
1803  ENDIF
1804  i1=i1+slash
1805  IF(i1.LE.i2) THEN
1806  READ(external(i1:i2),*) run
1807  ELSE
1808  WRITE(*,*) 'run not specified'
1809  stop
1810  ENDIF
1811  ELSE IF(c.EQ.4) THEN
1812  i1=1
1813  slash=index(external(i1:i2),'/')
1814  IF(slash.GT.1) THEN
1815  user = external(i1:i1+slash-2)
1816  ENDIF
1817  i1=i1+slash
1818 
1819  slash=index(external(i1:i2),'/')
1820  IF(slash.GT.1) THEN
1821  machine = external(i1:i1+slash-2)
1822  ENDIF
1823  i1=i1+slash
1824 
1825  slash=index(external(i1:i2),'/')
1826  IF(slash.GT.1) THEN
1827  ual_version = external(i1:i1+slash-2)
1828  ENDIF
1829  i1=i1+slash
1830 
1831  slash=index(external(i1:i2),'/')
1832  IF(slash.GT.1) THEN
1833  READ(external(i1:i1+slash-1),*) shot
1834  ELSE
1835  WRITE(*,*) 'shot not specified'
1836  stop
1837  ENDIF
1838  i1=i1+slash
1839 
1840  IF(i1.LE.i2) THEN
1841  READ(external(i1:i2),*) run
1842  ELSE
1843  WRITE(*,*) 'run not specified'
1844  stop
1845  ENDIF
1846  ELSE
1847  WRITE(*,*) 'Could not parse ', trim(EXTERNAL)
1848  stop
1849  ENDIF
1850 
1851  END SUBROUTINE parse_external
1852 
1853 
1854 END PROGRAM prepare_input_cpos
1855 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1856 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1857 
1858 
1859 
1860 
1861 
1862 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1863 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1864 ! This subroutine calculates integral of function Y(X)*X
1865 ! from X=0
1866 SUBROUTINE integral(N,X,Y,INTYX)
1867 
1868  USE itm_types
1869 
1870  IMPLICIT NONE
1871 
1872  INTEGER :: n ! number of radial points (input)
1873  INTEGER :: i
1874 
1875  REAL (R8) :: x(n), & ! argument array (input)
1876  y(n), & ! function array (input)
1877  intyx(n) ! function integral array (output)
1878 
1879  intyx(1)=y(1)*x(1)**2/2.e0_r8
1880  DO i=2,n
1881  intyx(i)=intyx(i-1)+(y(i-1)*x(i-1)+y(i)*x(i))*(x(i)-x(i-1))/2.e0_r8
1882  END DO
1883 
1884  RETURN
1885 END SUBROUTINE integral
1886 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1887 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1888 
1889 
1890 
1891 
1892 
1893 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1894 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1895 ! This subroutine calculates integral of a function y(x)
1896 ! from X=0
1897 SUBROUTINE integral_value(N,X,Y,INTY)
1898 
1899  USE itm_types
1900 
1901  IMPLICIT NONE
1902 
1903  INTEGER :: n ! number of radial points (input)
1904  INTEGER :: i
1905 
1906  REAL (R8) :: x(n), & ! argument array (input)
1907  y(n), & ! function array (input)
1908  inty(n) ! function integral array (output)
1909 
1910 
1911  DO i=2,n
1912  inty(i)=inty(i-1)+(y(i)+y(i-1))*(x(i)-x(i-1))/2.e0_r8
1913  ENDDO
1914 
1915  RETURN
1916 END SUBROUTINE integral_value
1917 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1918 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1919 
1920 
1921 
1922 
1923 
1924 
assign_code_parameters
subroutine assign_code_parameters(codeparameters, return_status)
Definition: emeq.f90:671
euitm_open_env
subroutine euitm_open_env(name, shot, run, retIdx, user, tokamak, version)
Definition: euitm_dummies.f90:1
allocate_deallocate::allocate_coreimpur_cpo
subroutine allocate_coreimpur_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, COREIMPUR)
This routine allocates COREIMPUR CPO.
Definition: allocate_deallocate.f90:608
fun
subroutine fun(X, F)
Definition: Ev2.f:10
mod_f90_kind
types
Definition: mod_f90_kind.f90:8
allocate_deallocate::allocate_coreprof_cpo
subroutine allocate_coreprof_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, COREPROF)
This routine allocates COREPROF CPO.
Definition: allocate_deallocate.f90:33
plasma_composition
Definition: plasma_composition.f90:1
l3interp
subroutine l3interp(y_in, x_in, nr_in, y_out, x_out, nr_out)
Definition: l3interp.f90:1
allocate_deallocate
This module contains routines for allocation/deallocation if CPOs used in ETS.
Definition: allocate_deallocate.f90:8
allocate_deallocate::allocate_coresource_cpo
subroutine allocate_coresource_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORESOURCE)
This routine allocates CORESOURCE CPO.
Definition: allocate_deallocate.f90:460
allocate_deallocate::allocate_equilibrium_cpo
subroutine allocate_equilibrium_cpo(NSLICE, NPSI, NDIM1, NDIM2, NPOINTS, EQUILIBRIUM)
This routine allocates EQUILIBRIUM CPO.
Definition: allocate_deallocate.f90:1249
profile
real(r8) function, dimension(1:size(x)) profile(function_string, x)
Definition: ets_workflow.F90:1934
plasma_composition::set_plasma_composition
subroutine set_plasma_composition(COREPROF_OUT, NION, NIMP, NNEUT, AMN_ION, ZN_ION, Z_ION, AMN_IMP, ZN_IMP, MAXZ_IMP, NCOMP_IN, NTYPE_IN, NCOLD, NTHERMAL, NFAST, NNBI)
Definition: plasma_composition.f90:6
cubint
subroutine cubint(ntab, xtab, ftab, ia_in, ib_in, result, error)
Definition: cubint.f90:1
allocate_deallocate::allocate_coreneutrals_cpo
subroutine allocate_coreneutrals_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORENEUTRALS)
Definition: allocate_deallocate.f90:971
allocate_deallocate::allocate_compositionc_cpo
subroutine allocate_compositionc_cpo(NSLICE, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, COMPOSITIONC)
Definition: allocate_deallocate.f90:1663
integral_value
subroutine integral_value(N, X, Y, INTY)
Definition: prepare_input_cpos.F90:1897
allocate_deallocate::allocate_toroidfield_cpo
subroutine allocate_toroidfield_cpo(NSLICE, TOROIDFIELD)
This routine allocates TOROIDFIELD CPO.
Definition: allocate_deallocate.f90:1468
integral
subroutine integral(n, h, r, f, int)
Definition: solution2.f90:527
prepare_input_cpos
program prepare_input_cpos
Definition: prepare_input_cpos.F90:3
euitm_close
subroutine euitm_close(idx)
Definition: euitm_dummies.f90:9
allocate_deallocate::allocate_coretransp_cpo
subroutine allocate_coretransp_cpo(NSLICE, NRHO, NNUCL, NION, NIMP, NZIMP, NNEUT, NTYPE, NCOMP, CORETRANSP)
This routine allocates CORETRANSP CPO.
Definition: allocate_deallocate.f90:316
parse_external
subroutine parse_external(EXTERNAL, shot, run, user, machine, ual_version)
Definition: prepare_input_cpos.F90:1759