ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
ets_workflow.F90
Go to the documentation of this file.
1 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
26 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
27 PROGRAM ets_workflow
28  !-------------------------------------------------------!
29  ! This program runs the ETS with !
30  ! three moment equilibrium solver, transport !
31  ! coefficients from ETAIGB and NEOWES, souces !
32  ! from NEUTRALS. !
33  !-------------------------------------------------------!
34  ! Source: --- !
35  ! Developers: D.Kalupin !
36  ! Kontacts: D.Kalupin@fz-juelich.de !
37  ! !
38  ! Comments: created for V&V between ETS and !
39  ! ASTRA !
40  ! !
41  !-------------------------------------------------------!
42  USE itm_types
43  USE ets_plasma
44  USE itm_constants
45  USE euitm_routines
46  USE euitm_schemas
47  USE copy_structures
48  USE deallocate_structures
49  USE xml_file_reader
50  USE ets_wrapper_bdseq
51  USE ets_wrapper_emeq_e3m
52 #ifdef GOT_HELENA
53  USE ets_wrapper_helena
54 #endif
55 #ifdef GOT_CHEASE
56  USE ets_wrapper_chease
57 #endif
58  USE ets_wrapper_etaigb
59  USE ets_wrapper_neowes
60  USE gbtransport
61 
62  USE ets_version
63  USE allocate_deallocate
64  USE itm_test_routines_etseq
65  USE ets
66 ! USE TRANSPORT_SOLVER
67  USE equilibrium_input
68  USE convergence_check
69  USE source_combiner
70  USE transport_combiner
71  USE equilibrium_start
72  USE impurity
73  USE neutrals
74  USE equilibrium_augmenter
75  USE size_of_structures
76  USE read_structures
77  USE write_structures
78  USE ets_species_module
79  USE plasma_composition
80  USE ets_start
81  USE fill_cpos
82  USE convert
83  USE gausian_src
84  USE coronal
85  USE spitzer
86  USE synchrotron
87  USE equilibrium_tools
88 
89 !----------------------------------------------------------------------!
90 ! Declaration of variables: !
91 !----------------------------------------------------------------------!
92  IMPLICIT NONE
93 
94 ! +++ Suffixes of CPOs:
95 ! index "_OLD" - previous time step
96 ! index "_ITER" - previous iteration
97 ! index "_NEW" - new time step
98  TYPE (type_equilibrium), POINTER :: equilibrium_old(:) => null(), equilibrium_iter(:) => null(), equilibrium_new(:) => null()
99  TYPE (type_coreprof), POINTER :: coreprof_old(:) => null(), coreprof_iter(:) => null(), coreprof_new(:) => null()
100  TYPE (type_coretransp), POINTER :: coretransp_old(:) => null(), coretransp_iter(:) => null()
101  TYPE (type_coresource), POINTER :: coresource_old(:) => null(), coresource_iter(:) => null()
102  TYPE (type_coreimpur), POINTER :: coreimpur_old(:) => null(), coreimpur_iter(:) => null(), coreimpur_new(:) => null()
103  TYPE (type_corefast), POINTER :: corefast_old(:) => null() , corefast_iter(:) => null()
104  TYPE (type_coreneutrals),POINTER :: coreneutrals_old(:) => null(),coreneutrals_iter(:) => null(),coreneutrals_new(:) => null()
105  TYPE (type_toroidfield), POINTER :: toroidfield_old(:) => null()
106  TYPE (type_neoclassic), POINTER :: neoclassic_old(:) => null(), neoclassic_iter(:) => null()
107 
108 #ifdef CORE_EDGE
109  TYPE (type_edge), POINTER :: edge_new(:)
110  TYPE (type_limiter) :: limiter
111  TYPE (type_param) :: code_parameters_core_edge
112 #endif
113 
114  TYPE (type_coreprof), SAVE, POINTER :: coreprof_db(:) => null()
115  TYPE (type_coretransp), SAVE, POINTER :: coretransp_db(:) => null()
116  TYPE (type_coresource), SAVE, POINTER :: coresource_db(:) => null()
117  TYPE (type_coreimpur), SAVE, POINTER :: coreimpur_db(:) => null()
118  TYPE (type_corefast), SAVE, POINTER :: corefast_db(:) => null()
119  TYPE (type_coreneutrals),SAVE, POINTER :: coreneutrals_db(:) => null()
120  TYPE (type_equilibrium), SAVE, POINTER :: equilibrium_db(:) => null()
121  TYPE (type_toroidfield), SAVE, POINTER :: toroidfield_db(:) => null()
122  TYPE (type_neoclassic), SAVE, POINTER :: neoclassic_db(:) => null()
123 
124  TYPE (type_coretransp), SAVE, POINTER :: coretransp1(:) => null(),coretransp2(:) => null(),coretransp3(:) => null(),coretransp4(:) => null(),coretransp5(:) => null()
125  TYPE (type_coresource), SAVE, POINTER :: coresource1(:) => null(),coresource2(:) => null(),coresource3(:) => null(),coresource4(:) => null(),coresource5(:) => null(),coresource6(:) => null(),coresource7(:) => null()
126 
127  TYPE (type_param) :: code_parameters_ets, code_parameters_transport_combiner, &
128  code_parameters_sources_combiner, code_parameters_ets_workflow, &
129  code_parameters_gausian_sources
130 
131  TYPE (diagnostic) :: diag
132 
133  REAL(R8) :: rhob !effective minor radius
134 
135  INTEGER :: npsi !number of equilibrium points (input)
136  INTEGER :: neq_dim1 !number of equilibrium points (input)
137  INTEGER :: neq_dim2 !number of equilibrium points (input)
138  INTEGER :: max_npoints !number of types for each neutral
139  INTEGER :: neq_max_npoints
140 
141  INTEGER :: nrho !number of radial points (input)
142  INTEGER :: nnucl !number of neutrals species (input)
143  INTEGER :: nion !number of ion species (input)
144  INTEGER :: nimp !number of impurity species (input)
145  INTEGER, ALLOCATABLE, SAVE :: nzimp(:) !number of charge states for each impurity (input)
146 
147  INTEGER :: nneut !number of neutrals species (input)
148  INTEGER, ALLOCATABLE, SAVE :: ncomp(:) !number of components for each neutral
149  INTEGER, ALLOCATABLE, SAVE :: ntype(:) !number of types for each neutral
150 
151  INTEGER :: ntime !number of time points (input)
152  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
153 
154  INTEGER :: irho !current radial knot
155  INTEGER :: iion !current ion type
156  INTEGER :: itime !current time step
157 
158  INTEGER :: nsol !Number of analytical example
159  INTEGER :: solver_type !representation of transport equations
160  INTEGER :: sigma_source !origin of Plasma electrical conductivity
161 
162  REAL(R8) :: convrec !required convergency
163  REAL(R8) :: conv_neut, conv_imp
164  REAL(R8) :: time !time
165  REAL(R8) :: start_time !starting time
166  REAL(R8) :: time_end !end time
167  REAL(R8) :: tau !time step
168  REAL(R8) :: amix !mixing factor
169  INTEGER :: iter !iteration index
170  INTEGER, PARAMETER :: maxiter=1000 !maximum number of convergence iterations
171 
172  REAL (R8), ALLOCATABLE, SAVE :: amn(:)
173  REAL (R8), ALLOCATABLE, SAVE :: zn(:)
174  REAL (R8), ALLOCATABLE, SAVE :: zion(:)
175  REAL (R8), ALLOCATABLE, SAVE :: amn_imp(:)
176  REAL (R8), ALLOCATABLE, SAVE :: zn_imp(:)
177  REAL (R8), ALLOCATABLE, SAVE :: max_z_imp(:)
178 
179  INTEGER :: cold_neutrals
180  INTEGER :: thermal_neutrals
181  INTEGER :: fast_neutrals
182  INTEGER :: nbi_neutrals
183 
184  INTEGER :: psi_bnd_type
185  INTEGER :: te_bnd_type
186  INTEGER :: ne_bnd_type
187  INTEGER, ALLOCATABLE, SAVE :: ni_bnd_type(:)
188  INTEGER, ALLOCATABLE, SAVE :: ti_bnd_type(:)
189  INTEGER, ALLOCATABLE, SAVE :: vtor_bnd_type(:)
190  INTEGER, ALLOCATABLE, SAVE :: nimp_bnd_type(:,:)
191  INTEGER, ALLOCATABLE, SAVE :: n0_bnd_type(:,:)
192  INTEGER, ALLOCATABLE, SAVE :: t0_bnd_type(:,:)
193 
194  REAL (R8) :: psi_bnd_value(3)
195  REAL (R8) :: te_bnd_value(3)
196  REAL (R8) :: ne_bnd_value(3)
197  REAL (R8), ALLOCATABLE, SAVE :: ni_bnd_value(:,:)
198  REAL (R8), ALLOCATABLE, SAVE :: ti_bnd_value(:,:)
199  REAL (R8), ALLOCATABLE, SAVE :: vtor_bnd_value(:,:)
200 
201  REAL (R8), ALLOCATABLE, SAVE :: nimp_bnd_value(:,:,:)
202 
203  REAL (R8), ALLOCATABLE, SAVE :: n0_bnd_value(:,:,:)
204  REAL (R8), ALLOCATABLE, SAVE :: t0_bnd_value(:,:,:)
205 
206 
207  REAL (R8) :: ip
208  REAL (R8) :: geo_ax(3)
209  REAL (R8) :: plasma_ax(3)
210  REAL (R8) :: amin
211  REAL (R8) :: elong, elong_up, elong_low
212  REAL (R8) :: tria_up
213  REAL (R8) :: tria_low
214 
215  INTEGER :: control_integer(4) !integer control parameters
216  REAL (R8) :: control_double(6) !real control parameters
217 
218 !irena
219  REAL (R8) :: control_double_imp(4) !real control parameters for impurity
220  INTEGER :: iimp,isimp,simp
221 !Irena
222 
223  INTEGER :: shot_in, run_in !shot and run numbers
224  INTEGER :: interpol !interpolation index
225  INTEGER :: time_dep_input !if 1, time dependence in input data
226  INTEGER :: ext_equil !0: none, 1: BDSEQ, 2: EMEQ, 3: HELENA
227  INTEGER :: equil_mod !if not zero, equilibrium will be called whent ITIME mod EQUIL_MOD == 0
228  LOGICAL :: do_equil
229  INTEGER :: ext_source !if 2, call combine_source
230  INTEGER :: ext_transport !if 1, call etaigb and neowes; if 2, call combine_transport
231  INTEGER :: shot_out, run_out !shot and run numbers
232  INTEGER :: itime_out !UAL output time step number
233  INTEGER :: iter_inc !ITERATION limit to cause increase in time-step
234  INTEGER :: iter_dec !ITERATION limit to cause decrease in time-step
235  INTEGER :: idx !handle for UAL output
236  INTEGER :: idx2
237 
238  INTEGER :: exp_option !0 means ignore
239  INTEGER :: exp_ncols
240  INTEGER :: prof_flag !Flag for primary current quantity: 1-PSI, 2-Q, 3-JPAR
241  INTEGER :: j0_flag !Flag for negative current density: 0-allowed, >0-cut off
242  INTEGER :: q0_flag !Flag for positive dq/drho: 0-allowed, >0-cut off
243  INTEGER :: eq_source !Flag for initial equilibrium: 0-from input CPO, 1-define from XML parameters
244  INTEGER :: quasi_neut !Quasi neutrality:0-electrons; 1-ions from BC; 2-ions fron charge
245  INTEGER :: icoronal !Coronal flag: "0"-OFF; "1" - replace boundary conditions by coronal; "2" - replace boundary conditions and profiles by coronal
246 
247 
248  REAL (R8) :: add_transport !additional diffusive transport
249  REAL (R8) :: tau_out !time step for profiles output into the data base
250  REAL (R8) :: time_out !time for profiles output into the data base
251  REAL (R8) :: tau_inc !time step increment factor if ITERATIONS < ITER_INC
252  REAL (R8) :: tau_dec !time step decrement factor if ITERATIONS > ITER_DEC
253  REAL (R8) :: tau_min !minimum time step
254  REAL (R8) :: tau_max !maximim time step
255  INTEGER, PARAMETER :: buflen = 256
256  CHARACTER(len=BUFLEN) :: rho_f
257  REAL(R8), ALLOCATABLE :: rho_1(:), rho_2(:), rho_3(:), rho_4(:), rho_5(:)
258  REAL(R8) :: dummy1, dummy2, x
259  REAL (R8), ALLOCATABLE :: rho(:) !rho grid
260  REAL (R8) :: r_in, r_out, r_geo
261  REAL (R8) :: rho_tor_rescale
262 
263  REAL (R8) :: bc_ip_jrlx, bc_ip_wanted, bc_ip_current, bc_ip_tau
264 
265  REAL (R8), POINTER :: evolution_data(:,:) => null()
266  CHARACTER (len=32), POINTER :: evolution_labels(:) => null()
267  CHARACTER (len=32) :: db_in, db_out
268  INTEGER :: augment_equil
269 
270  INTEGER (ITM_I8) :: total_size = 0
271 
272  INTEGER :: i
273 
274  CHARACTER (len=256) :: filename
275  LOGICAL, SAVE :: use_euitm_get, use_euitm_put
276 
277  LOGICAL :: quitexist
278 
279  INTERFACE
280  SUBROUTINE external_transport(EQUILIBRIUM_ITER,COREPROF_ITER,CORETRANSP_ITER,add_transport)
281  USE euitm_schemas
282  USE itm_types
283  TYPE (type_equilibrium), POINTER :: equilibrium_iter(:)
284  TYPE (type_coreprof), POINTER :: coreprof_iter(:)
285  TYPE (type_coretransp), POINTER :: coretransp_iter(:)
286  REAL (R8) :: add_transport
287  END SUBROUTINE external_transport
288 #ifdef CORE_EDGE
289  SUBROUTINE b2mn_ets(coreprof_in, coreimpur_in, coreneutrals_in, &
290  coreprof_out, coreimpur_out, coreneutrals_out, edge_out, &
291  codeparam, end_set)
292  USE euitm_schemas ! IGNORE
293  IMPLICIT NONE
294  TYPE (type_coreprof), POINTER :: coreprof_in(:), coreprof_out(:)
295  TYPE (type_coreimpur), POINTER :: coreimpur_in(:), coreimpur_out(:)
296  TYPE (type_coreneutrals), POINTER :: coreneutrals_in(:), coreneutrals_out(:)
297  TYPE (type_edge), POINTER :: edge_out(:)
298  TYPE (type_param) :: codeparam
299  LOGICAL, OPTIONAL :: end_set
300  END SUBROUTINE b2mn_ets
301 #endif
302  END INTERFACE
303 
304 
305 !----------------------------------------------------------------------!
306 !----------------------------------------------------------------------!
307 !----------------------------------------------------------------------!
308 
309 
310 
311 !----------------------------------------------------------------------!
312 ! Connect xml files !
313 !----------------------------------------------------------------------!
314  CALL fill_param(code_parameters_ets, 'XML/ets.xml', '', 'XML/ets.xsd')
315  CALL fill_param(code_parameters_ets_workflow, 'XML/ets_workflow.xml', '', 'XML/ets_workflow.xsd')
316 #ifdef CORE_EDGE
317  CALL fill_param(code_parameters_core_edge, 'XML/core-edge.xml', '', 'XML/core-edge.xsd')
318 #endif
319 
320 
321 
322 !----------------------------------------------------------------------!
323 ! Read run parameters from xml file !
324 !----------------------------------------------------------------------!
325  CALL process_xml( &
326  npsi, nrho, neq_dim1, neq_dim2, max_npoints, &
327 !
328  nnucl, nion, nimp, nzimp, nneut, ncomp, ntype, &
329 !
330  ntime, nsol, &
331 !
332  amn, zn, zion, amn_imp, zn_imp, max_z_imp, &
333 !
334  cold_neutrals, thermal_neutrals, &
335  fast_neutrals, nbi_neutrals, &
336 !
337  psi_bnd_type, &
338  ne_bnd_type, ni_bnd_type, &
339  te_bnd_type, ti_bnd_type, &
340  vtor_bnd_type, &
341 !
342  nimp_bnd_type, &
343  n0_bnd_type, t0_bnd_type, &
344 !
345  psi_bnd_value, &
346  ne_bnd_value, ni_bnd_value, &
347  te_bnd_value, ti_bnd_value, &
348  vtor_bnd_value, &
349 !
350  nimp_bnd_value, &
351  n0_bnd_value, t0_bnd_value, &
352 !
353  shot_in, run_in, interpol, db_in, &
354  shot_out, run_out, tau_out, db_out, &
355  solver_type, sigma_source, tau, amix, convrec, &
356  start_time, &
357 !
358  ip, geo_ax, plasma_ax, amin, elong, tria_up, tria_low, &
359 !
360  prof_flag, j0_flag, q0_flag, eq_source, &
361  time_dep_input, ext_equil, equil_mod, &
362  ext_source, ext_transport, add_transport, quasi_neut, &
363  tau_inc, tau_dec, iter_inc, iter_dec, &
364  tau_min, tau_max, &
365  exp_option, exp_ncols, &
366  evolution_labels, evolution_data, &
367  augment_equil, rho_f, icoronal, &
368  code_parameters_ets_workflow)
369 
370  elong_up = elong
371  elong_low = elong
372 
373  WRITE(*,*) ' '
374  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
375  WRITE(*,*) '++++ INPUT FROM XML FILE IS RECEIVED ++++ '
376  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
377 
378  !----------------------------------------------------------------------!
379  ! Starting time !
380  !----------------------------------------------------------------------!
381  iter = 0
382  time = start_time
383  time_out = time
384  time_end = start_time + ntime * tau
385 
386 
387  !----------------------------------------------------------------------!
388  ! Upload starting plasms profiles, transport coeffisients, sources !
389  ! and equilibrium from the CPO saved to the data base !
390  !----------------------------------------------------------------------!
391 
392  ALLOCATE (coreprof_db(1))
393  ALLOCATE (coretransp_db(1))
394  ALLOCATE (coresource_db(1))
395  IF(nimp.GT.0) ALLOCATE (coreimpur_db(1))
396  ALLOCATE (corefast_db(1))
397  IF(nneut.GT.0) ALLOCATE (coreneutrals_db(1))
398  ALLOCATE (equilibrium_db(1))
399  ALLOCATE (toroidfield_db(1))
400  ALLOCATE (neoclassic_db(1))
401 
402 #ifdef UAL
403 
404  !----------------------------------------------------------------------!
405  ! Output settings: shot, run, idx !
406  !----------------------------------------------------------------------!
407  IF (shot_in.GT.0.AND.run_in.GE.0) THEN
408  SELECT CASE (db_in)
409  CASE ("mdsplus")
410  WRITE(*,*) 'Opening mdsplus database for ', shot_in, run_in
411  CALL euitm_open('euitm',shot_in, run_in, idx)
412  use_euitm_get = .true.
413  CASE ("hdf5")
414  WRITE(*,*) 'Opening hdf5 database for ', shot_in, run_in
415  CALL euitm_open_hdf5('euitm',shot_in, run_in, idx)
416  use_euitm_get = .true.
417  CASE ("ascii")
418  use_euitm_get = .false.
419  CASE default
420  WRITE(*,*) 'Unexpected database format choice : ',trim(db_in)
421  stop 'Error: unrecognized database format'
422  END SELECT
423  END IF
424 #else
425  use_euitm_get = .false.
426 #endif
427 
428 #ifdef UAL
429  IF(use_euitm_get) THEN
430  WRITE(*,*) 'reading from the database for time = ', time
431  CALL euitm_get_slice(idx, 'coreprof', coreprof_db(1), time, interpol)
432  CALL euitm_get_slice(idx, 'coretransp', coretransp_db(1), time, interpol)
433  CALL euitm_get_slice(idx, 'coresource', coresource_db(1), time, interpol)
434  IF(nimp.GT.0) CALL euitm_get_slice(idx, 'coreimpur', coreimpur_db(1), time, interpol)
435  CALL euitm_get_slice(idx, 'corefast', corefast_db(1), time, interpol)
436  IF(nneut.GT.0) CALL euitm_get_slice(idx, 'coreneutrals', coreneutrals_db(1), time, interpol)
437  CALL euitm_get_slice(idx, 'equilibrium', equilibrium_db(1), time, interpol)
438  CALL euitm_get_slice(idx, 'toroidfield', toroidfield_db(1), time, interpol)
439  CALL euitm_get_slice(idx, 'neoclassic', neoclassic_db(1), time, interpol)
440  CALL euitm_close(idx)
441  ENDIF
442 #endif
443 
444  IF(db_in .EQ. "ascii") THEN
445  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreprof', shot_in, run_in, 0
446  CALL open_read_file(1, trim(filename))
447  CALL read_cpo(coreprof_db(1), 'coreprof')
448  CALL close_read_file
449  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coretransp', shot_in, run_in, 0
450  CALL open_read_file(1, trim(filename))
451  CALL read_cpo(coretransp_db(1), 'coretransp')
452  CALL close_read_file
453  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coresource', shot_in, run_in, 0
454  CALL open_read_file(1, trim(filename))
455  CALL read_cpo(coresource_db(1), 'coresource')
456  CALL close_read_file
457  IF(nimp.GT.0) THEN
458  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreimpur', shot_in, run_in, 0
459  CALL open_read_file(1, trim(filename))
460  CALL read_cpo(coreimpur_db(1), 'coreimpur')
461  CALL close_read_file
462  ENDIF
463  IF(nneut.GT.0) THEN
464  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreneutrals', shot_in, run_in, 0
465  CALL open_read_file(1, trim(filename))
466  CALL read_cpo(coreneutrals_db(1), 'coreneutrals')
467  CALL close_read_file
468  ENDIF
469  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'equilibrium', shot_in, run_in, 0
470  CALL open_read_file(1, trim(filename))
471  CALL read_cpo(equilibrium_db(1), 'equilibrium')
472  CALL close_read_file
473  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'toroidfield', shot_in, run_in, 0
474  CALL open_read_file(1, trim(filename))
475  CALL read_cpo(toroidfield_db(1), 'toroidfield')
476  CALL close_read_file
477 ! write(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'neoclassic', shot_in, run_in, 0
478 ! call open_read_file(1, trim(filename))
479 ! call read_cpo(neoclassic_db(1), 'neoclassic')
480 ! call close_read_file
481  ENDIF
482 
483 
484  IF(eq_source.eq.1) THEN
485 !----------------------------------------------------------------------!
486 ! Calculate rho boundary !
487 !----------------------------------------------------------------------!
488  IF(.NOT.ASSOCIATED(equilibrium_old)) ALLOCATE (equilibrium_old(1))
489  IF(.NOT.ASSOCIATED(equilibrium_new)) ALLOCATE (equilibrium_new(1))
490  equilibrium_old(1)%time = start_time
491  CALL geometry_from_wf_parameters(equilibrium_old, equilibrium_new, &
492  geo_ax, plasma_ax, plasma_ax, &
493  ip, amin, &
494  elong_up, elong_low, &
495  tria_up, tria_low, &
496  npsi, neq_dim1, neq_dim2, max_npoints)
497 
498  CALL deallocate_cpo(equilibrium_old)
499 
500  WRITE(*,*) ' '
501  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
502  WRITE(*,*) '++++ INITIAL RHO_BOUNDARY IS CALCULATED ++++ '
503  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
504 
505  else
506 
507  call copy_cpo(equilibrium_db, equilibrium_new)
508 
509  ENDIF
510 
511 
512 !----------------------------------------------------------------------!
513 ! Output run settings to the screen !
514 !----------------------------------------------------------------------!
515  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
516  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
517  WRITE(*,*) 'Input from ',shot_in, run_in
518  WRITE(*,*) 'Output to ', shot_out, run_out
519  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
520  WRITE(*,*) '+++++++++++++ COMPOSITIONS +++++++++++++++++ '
521  WRITE(*,*) 'nrho =',nrho
522  WRITE(*,*) 'npsi =',npsi
523  WRITE(*,*) 'ndim1=',neq_dim1
524  WRITE(*,*) 'ndim2=',neq_dim2
525  WRITE(*,*) 'max_npoints=',max_npoints
526  WRITE(*,*) 'nnucl=',nnucl
527  WRITE(*,*) 'nion= ',nion
528  WRITE(*,*) 'nimp= ',nimp
529  IF(ALLOCATED(nzimp)) WRITE(*,*) 'nzimp=', nzimp
530  WRITE(*,*) 'nneut=',nneut
531  IF(ALLOCATED(ncomp)) WRITE(*,*) 'ncomp=',ncomp
532  IF(ALLOCATED(ntype)) WRITE(*,*) 'ntype=', ntype
533  IF(ALLOCATED(amn)) WRITE(*,'(a,(100f8.2))') 'amn= ', amn
534  IF(ALLOCATED(zn)) WRITE(*,'(a,(100f8.2))') 'zn= ',zn
535  IF(ALLOCATED(zion)) WRITE(*,'(a,(100f8.2))') 'zion= ', zion
536  IF(ALLOCATED(amn_imp)) WRITE(*,'(a,(100f8.2))') 'amn_imp= ', amn_imp
537  IF(ALLOCATED(zn_imp)) WRITE(*,'(a,(100f8.2))') 'zn_imp= ',zn_imp
538  IF(ALLOCATED(max_z_imp)) WRITE(*,'(a,(100f8.2))') 'max_z_imp= ', max_z_imp
539  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
540  WRITE(*,*) '++++++++++ BOUNDARY CONDITIONS +++++++++++++ '
541  WRITE(*,*) '++++++++++ TYPE VALUE +++++++++++++ '
542  WRITE(*,*) 'PSI =', psi_bnd_type, psi_bnd_value(1)
543  WRITE(*,*) 'NE =', ne_bnd_type, ne_bnd_value(1)
544  WRITE(*,*) 'NI =', ni_bnd_type, ni_bnd_value(1,:)
545  WRITE(*,*) 'TI =', ti_bnd_type, ti_bnd_value(1,:)
546  WRITE(*,*) 'TE =', te_bnd_type, te_bnd_value(1)
547  WRITE(*,*) 'VTOR=', vtor_bnd_type, vtor_bnd_value(1,:)
548  IF(nimp.GT.0) WRITE(*,*) 'NIMP=', nimp_bnd_type, nimp_bnd_value(:,1,:)
549  !IF(nneut.GT.0) WRITE(*,*) 'NNEUT=', N0_BND_TYPE, N0_BND_VALUE(:,1,:)
550  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
551  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
552 
553 
554 
555 
556  !----------------------------------------------------------------------!
557  ! Connect other xml files if necessary !
558  !----------------------------------------------------------------------!
559  IF (ext_transport.EQ.2) &
560  CALL fill_param(code_parameters_transport_combiner, &
561  'XML/transport_combiner.xml', '', 'XML/transport_combiner.xsd')
562 
563  IF (ext_source.EQ.2) &
564  CALL fill_param(code_parameters_sources_combiner, &
565  'XML/source_combiner.xml', '', 'XML/source_combiner.xsd')
566 
567  IF (ext_source.EQ.2) &
568  CALL fill_param(code_parameters_gausian_sources, &
569  'XML/source_dummy.xml', '', 'XML/source_dummy.xsd')
570 
571 
572 
573 
574 
575  !----------------------------------------------------------------------!
576  ! Allocate run composition !
577  !----------------------------------------------------------------------!
578  CALL set_plasma_composition(coreprof_new, &
579  nion, nimp, nneut, &
580  amn, zn, zion, &
581  amn_imp, zn_imp, max_z_imp, &
582  ncomp, ntype, &
583  cold_neutrals, thermal_neutrals,&
584  fast_neutrals, nbi_neutrals)
585 
586  DEALLOCATE(amn, zn, zion)
587  IF(nimp.GT.0) DEALLOCATE(amn_imp, zn_imp, max_z_imp)
588 
589  ets_species%nnucl = nnucl
590  ets_species%nion = nion
591  ets_species%nimp = nimp
592  IF(ALLOCATED(nzimp)) THEN
593  ALLOCATE(ets_species%nzimp(SIZE(nzimp)))
594  ets_species%nzimp = nzimp
595  ENDIF
596  ets_species%nneut = nneut
597  IF(ALLOCATED(ncomp)) THEN
598  ALLOCATE(ets_species%ncomp(SIZE(ncomp)))
599  ets_species%ncomp = ncomp
600  ENDIF
601  IF(ALLOCATED(ntype)) THEN
602  ALLOCATE(ets_species%ntype(SIZE(ntype)))
603  ets_species%ntype = ntype
604  ENDIF
605  WRITE(*,*) ' '
606  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
607  WRITE(*,*) '+++++++ COMPOSITIONS ARE SET UP +++++++++ '
608  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
609 
610 
611 
612 
613  ALLOCATE (rho(nrho))
614 
615 
616  control_integer(1) = solver_type !number of numerical solver
617  control_integer(2) = sigma_source !number of numerical solver
618  control_integer(3) = quasi_neut !
619  control_double(1) = tau !time step
620  control_double(2) = amix !mixing factor for profiles
621  control_double(3) = amix**0.5 !mixing factor for transport coefficients
622  control_double(4) = 1.e0_r8 !actual convergence
623  control_double(5) = convrec !required convergence
624 
625  control_double_imp(1) = 3. !number of numerical solver: 1-solver1;2-solver2; 3-solver3
626  control_double_imp(2) = 1. !number of numerical solver_type:
627  control_double_imp(3) = tau !time step
628  control_double_imp(4) = amix !mixing factor for profiles
629  nnucl = nion + nimp !approximation
630 
631  ! >>> At this stage we have CONTROL_INTEGER and CONTROL_DOUBLE
632  ! filled with parameters from XML
633 
634 
635 
636 
637 
638  !----------------------------------------------------------------------!
639  ! Generate the RHO grid for ETS, allocate working CPOs !
640  !----------------------------------------------------------------------!
641  CALL etsstart &
642 !PARAMETERS & CPOs_IN:
643  (solver_type, equilibrium_new, coreprof_new, &
644 !CPOs_OUT:
645  coreprof_old, coretransp_old, coresource_old, &
646  coreimpur_old, corefast_old, &
647  coreneutrals_old, neoclassic_old, &
648  equilibrium_old, toroidfield_old, &
649 !BOUNDARY_CONDITIONS:
650  psi_bnd_type, ne_bnd_type, ni_bnd_type, &
651  ti_bnd_type, te_bnd_type, vtor_bnd_type, &
652  nimp_bnd_type, n0_bnd_type, t0_bnd_type, &
653 !
654  psi_bnd_value, ne_bnd_value, ni_bnd_value, &
655  ti_bnd_value, te_bnd_value, vtor_bnd_value, &
656  nimp_bnd_value, n0_bnd_value, t0_bnd_value, &
657 !SPACE_RESOLUTION:
658  nrho, npsi, neq_dim1, neq_dim2, max_npoints)
659 
660  CALL deallocate_cpo(equilibrium_new)
661  CALL deallocate_cpo(neoclassic_old)
662 
663  CALL copy_cpo(coreprof_old, coreprof_iter)
664  CALL copy_cpo(equilibrium_old, equilibrium_new)
665  CALL copy_cpo(coretransp_old, coretransp_iter)
666  CALL copy_cpo(corefast_old, corefast_iter)
667  CALL copy_cpo(coresource_old, coresource_iter)
668  IF(nimp.GT.0) THEN
669  CALL copy_cpo(coreimpur_old, coreimpur_iter)
670  CALL copy_cpo(coreimpur_old, coreimpur_new)
671  ENDIF
672  IF(nneut.GT.0) THEN
673  CALL copy_cpo(coreneutrals_old, coreneutrals_iter)
674  CALL copy_cpo(coreneutrals_old, coreneutrals_new)
675  ENDIF
676 
677  WRITE(*,*) ' '
678  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
679  WRITE(*,*) '+++++++ WORKING CPOs ARE ALLOCATED +++++++++ '
680  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
681 
682  WRITE(*,*) ' '
683  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
684  WRITE(*,*) '+++++++ GRIDS ARE SET UP +++++++++ '
685  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
686 
687 
688 
689 
690 
691  !----------------------------------------------------------------------!
692  ! Starting time !
693  !----------------------------------------------------------------------!
694  iter = 0
695  time = start_time
696  time_out = time
697  time_end = start_time + ntime * tau
698 
699 
700 
701 
702  !----------------------------------------------------------------------!
703  ! Code parameters: !
704  !----------------------------------------------------------------------!
705  ALLOCATE (coreprof_old(1)%codeparam%codename(1))
706  ALLOCATE (coreprof_old(1)%codeparam%codeversion(1))
707  ALLOCATE (coreprof_old(1)%codeparam%parameters(SIZE(code_parameters_ets_workflow%parameters)))
708 
709  coreprof_old(1)%codeparam%codename(1) = 'ets_workflow_fortran'
710  coreprof_old(1)%codeparam%codeversion(1) = version
711  coreprof_old(1)%codeparam%parameters = code_parameters_ets_workflow%parameters
712 
713  CALL deallocate_cpo(coreprof_iter(1)%codeparam)
714  CALL copy_cpo(coreprof_old(1)%codeparam, coreprof_iter(1)%codeparam)
715 
716  CALL deallocate_cpo(coreprof_iter)
717  CALL deallocate_cpo(coretransp_iter)
718  CALL deallocate_cpo(coresource_iter)
719  CALL deallocate_cpo(corefast_iter)
720 
721  WRITE(*,*) ' '
722  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
723  CALL fillcorefast(corefast_db, corefast_old, corefast_iter, interpol)
724  WRITE(*,*) '+++++++ COREFAST IS RECEIVED +++++++++ '
725  CALL fillcoreprof(coreprof_db, coreprof_old, corefast_iter, coreprof_iter, interpol)
726  WRITE(*,*) '+++++++ COREPROF IS RECEIVED +++++++++ '
727  CALL fillcoretransp(coretransp_db, coretransp_old, coretransp_iter, interpol)
728  WRITE(*,*) '+++++++ CORETRANSP IS RECEIVED +++++++++ '
729  CALL fillcoresource(coresource_db, coresource_old, coresource_iter, interpol)
730  WRITE(*,*) '+++++++ CORESOURCE IS RECEIVED +++++++++ '
731  IF(nimp .GT. 0) THEN
732  CALL deallocate_cpo(coreimpur_iter)
733  CALL fillcoreimpur(coreimpur_db, coreimpur_old, coreimpur_iter, interpol)
734  WRITE(*,*) '+++++++ COREIMPUR IS RECEIVED +++++++++ '
735  ENDIF
736  IF(nneut > 0) THEN
737  CALL deallocate_cpo(coreneutrals_iter)
738  CALL fillcoreneutrals(coreneutrals_db, coreneutrals_old, coreneutrals_iter, interpol)
739  WRITE(*,*) '+++++++ CORENEUTRALS IS RECEIVED +++++++++ '
740  ENDIF
741  CALL deallocate_cpo(equilibrium_iter)
742 ! if(eq_source.eq.1) then
743  CALL fillequilibrium(equilibrium_db, equilibrium_old, equilibrium_iter, interpol)
744 ! else
745 ! write(*,*) 'Not using the equilibrium specifications from the XML'
746 ! call copy_cpo(EQUILIBRIUM_DB, EQUILIBRIUM_ITER)
747 ! endif
748 
749 ! added by DPC, 2013-05-15, so that the coreprof toroid_field is consistent with that from equilibrium
750  coreprof_iter%toroid_field%b0 = equilibrium_iter%global_param%toroid_field%b0
751  coreprof_iter%toroid_field%r0 = equilibrium_iter%global_param%toroid_field%r0
752 
753  WRITE(*,*) '+++++++ EQUILIBRIUM IS RECEIVED +++++++++ '
754  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
755  WRITE(*,*) ' '
756 
757 
758 
759  CALL deallocate_cpo(equilibrium_old)
760  CALL copy_cpo(equilibrium_iter, equilibrium_old)
761  CALL deallocate_cpo(coreprof_old)
762  CALL copy_cpo(coreprof_iter, coreprof_old)
763  CALL deallocate_cpo(coretransp_old)
764 ! CALL COPY_CPO (CORETRANSP_ITER, CORETRANSP_OLD)
765  CALL deallocate_cpo(coresource_old)
766 ! CALL COPY_CPO (CORESOURCE_ITER, CORESOURCE_OLD)
767  IF(nimp .GT. 0) THEN
768  CALL deallocate_cpo(coreimpur_old)
769  IF(icoronal.GT.0) THEN
770  WRITE(*,*) 'Calling set_coronal with option ', icoronal
771  CALL set_coronal(coreimpur_iter, coreprof_iter, coreimpur_old, interpol, icoronal)
772  CALL deallocate_cpo(coreimpur_iter)
773  CALL copy_cpo(coreimpur_old, coreimpur_iter)
774  ELSE
775  CALL copy_cpo(coreimpur_iter, coreimpur_old)
776  ENDIF
777  ENDIF
778  CALL deallocate_cpo(corefast_old)
779  CALL copy_cpo(corefast_iter, corefast_old)
780  IF(nneut .GT. 0) THEN
781  CALL deallocate_cpo(coreneutrals_old)
782  CALL copy_cpo(coreneutrals_iter, coreneutrals_old)
783  ENDIF
784 
785  WRITE(*,*) ' '
786  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
787  WRITE(*,*) '+++++++ CPOs INPUT DATA ARE READ +++++++++ '
788  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
789 
790 
791 
792  ! >>> At this stage we have COREPROF_OLD, COREPROF_NEW and EQUILIBRIUM_OLD
793  ! filled with equidistant ETS rho-grid and profiles read from ITM data base
794 
795 !----------------------------------------------------------------------!
796 ! make sure we start with a valid equilibrium !
797 ! this also has the advantage of making sure that the same data !
798 ! is written for slice 0 as for the subsequent slices !
799 !----------------------------------------------------------------------!
800  IF (npsi.GT.0) THEN
801 
802 
803 !----------------------------------------------------------------------!
804 ! Provide consistent input for equilibrium: !
805 !----------------------------------------------------------------------!
806  IF(prof_flag.GT.0) THEN
807  !----------------------------------------------------------------------!
808  ! Check consistency between current profiles and equilibrium !
809  !----------------------------------------------------------------------!
810 
811  CALL start_profiles_consistency &
812  (prof_flag, j0_flag, q0_flag, ext_equil, &
813  coreprof_old, equilibrium_old, toroidfield_old, coreprof_iter, equilibrium_iter)
814  CALL deallocate_cpo(equilibrium_old)
815  CALL copy_cpo(equilibrium_iter, equilibrium_old)
816  ELSE
817  IF(exp_option.NE.0) THEN
818  ALLOCATE (neoclassic_iter(1))
819  CALL changeradii(equilibrium_iter, &
820  coreprof_iter, &
821  coretransp_iter, &
822  coresource_iter, &
823  coreimpur_iter, &
824  coreneutrals_iter, &
825  neoclassic_iter)
826  CALL deallocate_cpo(neoclassic_iter)
827  ENDIF
828  CALL deallocate_cpo(equilibrium_old)
829  CALL equil_input(coreprof_iter, toroidfield_old, equilibrium_iter, equilibrium_old)
830  END IF
831  IF (ext_equil.EQ.1) THEN
832  CALL deallocate_cpo(equilibrium_iter)
833  CALL bdseq_wrapper(equilibrium_old, equilibrium_iter)
834 
835  ELSE IF (ext_equil.EQ.2) THEN
836  CALL deallocate_cpo(equilibrium_iter)
837  CALL emeq_e3m_wrapper(equilibrium_old, equilibrium_iter)
838 
839  ELSE IF (ext_equil.EQ.3) THEN
840 #ifdef GOT_HELENA
841  CALL deallocate_cpo(equilibrium_iter)
842  CALL helena_wrapper(equilibrium_old, equilibrium_iter)
843 #else
844  WRITE(*,*) 'No HELENA available at compile time'
845  stop 'No HELENA'
846 #endif
847  ELSE IF (ext_equil.EQ.4) THEN
848 #ifdef GOT_CHEASE
849  CALL deallocate_cpo(equilibrium_iter)
850  CALL chease_wrapper(equilibrium_old, equilibrium_iter)
851 #else
852  WRITE(*,*) 'No CHEASE available at compile time'
853  stop 'No CHEASE'
854 #endif
855  ELSE
856  END IF
857 
858 
859 
860 
861  IF(exp_option.NE.0) THEN
862  ALLOCATE (neoclassic_iter(1))
863  CALL changeradii(equilibrium_iter, &
864  coreprof_iter, &
865  coretransp_iter, &
866  coresource_iter, &
867  coreimpur_iter, &
868  coreneutrals_iter, &
869  neoclassic_iter)
870  CALL deallocate_cpo(neoclassic_iter)
871  ENDIF
872  CALL deallocate_cpo(equilibrium_old)
873  CALL copy_cpo(equilibrium_iter, equilibrium_old)
874 
875  END IF
876 
877  CALL deallocate_cpo(coreprof_old)
878  CALL copy_cpo(coreprof_iter, coreprof_old)
879 
880 !irena
881  IF(nimp .GT. 0) THEN
882  CALL deallocate_cpo(coreimpur_old)
883  CALL copy_cpo(coreimpur_iter,coreimpur_old)
884  CALL deallocate_cpo(coreimpur_new)
885  CALL copy_cpo(coreimpur_iter,coreimpur_new)
886  ENDIF
887 
888 !irena
889 
890  itime=0
891  itime_out = 0
892  CALL write_out(0, coreprof_iter )
893  CALL write_equilibrium(0, equilibrium_iter)
894 !irena
895  IF(nimp .GT. 0) CALL writeoutimpur(0,coreimpur_iter)
896 !irena
897 !irena neutrals
898  IF(nneut > 0) CALL writeoutneutrals(0,coreneutrals_iter)
899 !irena neutrals
900  time_out = time_out+tau_out
901 
902 
903 
904 
905 #ifdef UAL
906 
907  !----------------------------------------------------------------------!
908  ! Output settings: shot, run, idx !
909  !----------------------------------------------------------------------!
910  IF (shot_out.GT.0.AND.run_out.GE.0) THEN
911  SELECT CASE (db_out)
912  CASE ("mdsplus")
913  CALL euitm_create('euitm',shot_out, run_out,0,0,idx)
914  use_euitm_put = .true.
915  CASE ("hdf5")
916  CALL euitm_create_hdf5('euitm',shot_out,run_out,0,0,idx)
917  use_euitm_put = .true.
918  CASE ("ascii")
919  use_euitm_put = .false.
920  CASE default
921  WRITE(*,*) 'Unexpected database format choice : ',trim(db_out)
922  stop 'Error: unrecognized database format'
923  END SELECT
924  END IF
925 #else
926  use_euitm_put = .false.
927 #endif
928 
929  !----------------------------------------------------------------------!
930  ! This is the output via the UAL for the initial state before !
931  ! the first time-step !
932  !----------------------------------------------------------------------!
933  IF (shot_out.GT.0.AND.run_out.GE.0) THEN
934 
935  IF(augment_equil.EQ.1) THEN
936  CALL augment_psi_rz(equilibrium_iter(1))
937  ENDIF
938 
939 #ifdef UAL
940  IF(use_euitm_put) THEN
941 
942  coreprof_iter(1)%time = time
943  WRITE(*,*) 'euitm_put_non_timed: coreprof', coreprof_iter(1)%time, &
944  trim(coreprof_iter(1)%codeparam%codename(1)), &
945  ' ', &
946  trim(coreprof_iter(1)%codeparam%codeversion(1))
947  CALL euitm_put_non_timed(idx,"coreprof",coreprof_iter(1))
948  WRITE(*,*) 'euitm_put_slice: coreprof', coreprof_iter(1)%time
949  CALL euitm_put_slice(idx,"coreprof",coreprof_iter(1))
950 
951  equilibrium_iter(1)%time = time
952  WRITE(*,*) 'euitm_put_non_timed: equilibrium', equilibrium_iter(1)%time
953  CALL euitm_put_non_timed(idx,"equilibrium",equilibrium_iter(1))
954  WRITE(*,*) 'euitm_put_slice: equilibrium', equilibrium_iter(1)%time
955  CALL euitm_put_slice(idx,"equilibrium",equilibrium_iter(1))
956 
957  coretransp_iter(1)%time = time
958  WRITE(*,*) 'euitm_put_non_timed: coretransp', coretransp_iter(1)%time
959  CALL euitm_put_non_timed(idx,"coretransp",coretransp_iter(1))
960  WRITE(*,*) 'euitm_put_slice: coretransp', coretransp_iter(1)%time
961  CALL euitm_put_slice(idx,"coretransp",coretransp_iter(1))
962 
963  coresource_iter(1)%time = time
964  WRITE(*,*) 'euitm_put_non_timed: coresource', coresource_iter(1)%time
965  CALL euitm_put_non_timed(idx,"coresource",coresource_iter(1))
966  WRITE(*,*) 'euitm_put_slice: coresource', coresource_iter(1)%time
967  CALL euitm_put_slice(idx,"coresource",coresource_iter(1))
968 
969  IF(nimp > 0) THEN
970  coreimpur_iter(1)%time = time
971  WRITE(*,*) 'euitm_put_non_timed: coreimpur', coreimpur_iter(1)%time
972  CALL euitm_put_non_timed(idx,"coreimpur",coreimpur_iter(1))
973  WRITE(*,*) 'euitm_put_slice: coreimpur', coreimpur_iter(1)%time
974  CALL euitm_put_slice(idx,"coreimpur",coreimpur_iter(1))
975  ENDIF
976  IF(nneut > 0) THEN
977  coreneutrals_iter(1)%time = time
978  WRITE(*,*) 'euitm_put_non_timed: coreneutrals', coreneutrals_iter(1)%time
979  CALL euitm_put_non_timed(idx,"coreneutrals",coreneutrals_iter(1))
980  WRITE(*,*) 'euitm_put_slice: coreneutrals', coreneutrals_iter(1)%time
981  CALL euitm_put_slice(idx,"coreneutrals",coreneutrals_iter(1))
982  ENDIF
983  toroidfield_old(1)%time = time
984  WRITE(*,*) 'euitm_put_non_timed: toroidfield', toroidfield_old(1)%time
985  CALL euitm_put_non_timed(idx,"toroidfield",toroidfield_old(1))
986  WRITE(*,*) 'euitm_put_slice: toroidfield', toroidfield_old(1)%time
987  CALL euitm_put_slice(idx,"toroidfield",toroidfield_old(1))
988 
989  ENDIF
990 #endif
991 
992  IF(db_out .EQ. "ascii") THEN
993  coreprof_iter(1)%time = time
994  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreprof', shot_out, run_out, itime
995  CALL open_write_file(1, trim(filename))
996  CALL write_cpo(coreprof_iter(1), 'coreprof')
997  CALL close_write_file
998  equilibrium_iter(1)%time = time
999  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'equilibrium', shot_out, run_out, itime
1000  CALL open_write_file(1, trim(filename))
1001  CALL write_cpo(equilibrium_iter(1), 'equilibrium')
1002  CALL close_write_file
1003  coretransp_iter(1)%time = time
1004  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coretransp', shot_out, run_out, itime
1005  CALL open_write_file(1, trim(filename))
1006  CALL write_cpo(coretransp_iter(1), 'coretransp')
1007  CALL close_write_file
1008  coresource_iter(1)%time = time
1009  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coresource', shot_out, run_out, itime
1010  CALL open_write_file(1, trim(filename))
1011  CALL write_cpo(coresource_iter(1), 'coresource')
1012  CALL close_write_file
1013  IF(nimp.GT.0) THEN
1014  coreimpur_iter(1)%time = time
1015  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreimpur', shot_out, run_out, itime
1016  CALL open_write_file(1, trim(filename))
1017  CALL write_cpo(coreimpur_iter(1), 'coreimpur')
1018  CALL close_write_file
1019  ENDIF
1020  IF(nneut.GT.0) THEN
1021  coreneutrals_iter(1)%time = time
1022  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreneutrals', shot_out, run_out, itime
1023  CALL open_write_file(1, trim(filename))
1024  CALL write_cpo(coreneutrals_iter(1), 'coreneutrals')
1025  CALL close_write_file
1026  ENDIF
1027  toroidfield_old(1)%time = time
1028  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'toroidfield', shot_out, run_out, itime
1029  CALL open_write_file(1, trim(filename))
1030  CALL write_cpo(toroidfield_old(1), 'toroidfield')
1031  CALL close_write_file
1032  ENDIF
1033 
1034  WRITE(*,1000) ' AREA ',equilibrium_iter(1)%global_param%area
1035  WRITE(*,1000) ' VOLUME ',equilibrium_iter(1)%global_param%volume
1036  WRITE(*,1000) ' Raxis ',equilibrium_iter(1)%global_param%mag_axis%position%r
1037  WRITE(*,1000) ' Zaxis ',equilibrium_iter(1)%global_param%mag_axis%position%z
1038  WRITE(*,1000) ' Baxis ',equilibrium_iter(1)%global_param%mag_axis%bphi
1039  WRITE(*,1000) ' Rgeo ',equilibrium_iter(1)%eqgeometry%geom_axis%r
1040  WRITE(*,1000) ' Zgeo ',equilibrium_iter(1)%eqgeometry%geom_axis%z
1041  WRITE(*,1000) ' a ',equilibrium_iter(1)%eqgeometry%a_minor
1042  WRITE(*,1000) ' R0 ',equilibrium_iter(1)%global_param%toroid_field%b0
1043  WRITE(*,1000) ' B0 ',equilibrium_iter(1)%global_param%toroid_field%r0
1044 
1045  WRITE(*,*) ' '
1046  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
1047  WRITE(*,*) '+++++++ INITIAL SLICE IS SAVED +++++++++ '
1048  WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++++++++ '
1049 
1050  ENDIF
1051 
1052 !
1053 ! here we are going to call SOLPS to update the ETS boundary conditions
1054 ! note that since this is the first call, the boundary conditions derive
1055 ! from b2.boundary.parameters and not from the passed COREPROF
1056 !
1057 #ifdef CORE_EDGE
1058 #ifdef UAL
1059  CALL euitm_open('euitm',shot_in,0,idx2)
1060  CALL euitm_get(idx2,'limiter',limiter)
1061  IF(use_euitm_put) THEN
1062  CALL euitm_put(idx,'limiter',limiter)
1063  ELSE IF(db_out .EQ. 'ascii') THEN
1064  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''.cpo'')') 'limiter', shot_out, run_out
1065  CALL open_write_file(1, trim(filename))
1066  CALL write_cpo(limiter, 'limiter')
1067  CALL close_write_file
1068  ENDIF
1069  CALL euitm_close(idx2)
1070  CALL deallocate_cpo(limiter)
1071 #endif
1072  WRITE(*,*) 'Core-Edge: Initialization call to SOLPS'
1073  CALL b2mn_ets(coreprof_iter, coreimpur_iter, coreneutrals_iter, &
1074  coreprof_new, coreimpur_new, coreneutrals_new, edge_new, &
1075  code_parameters_core_edge)
1076 #ifdef UAL
1077  IF(use_euitm_put) THEN
1078  edge_new(1)%time = time
1079  WRITE(*,*) 'euitm_put_non_timed: edge', edge_new(1)%time
1080  CALL euitm_put_non_timed(idx,"edge",edge_new(1))
1081  WRITE(*,*) 'euitm_put_slice: edge', edge_new(1)%time
1082  CALL euitm_put_slice(idx,"edge",edge_new(1))
1083  ENDIF
1084 #endif
1085  IF(db_out .EQ. 'ascii') THEN
1086  edge_new(1)%time = time
1087  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'edge', shot_out, run_out, itime
1088  CALL open_write_file(1, trim(filename))
1089  CALL write_cpo(edge_new(1), 'edge')
1090  CALL close_write_file
1091  ENDIF
1092  CALL deallocate_cpo(coreprof_new)
1093  IF(nimp.GT.0) CALL deallocate_cpo(coreimpur_new)
1094  IF(nneut.GT.0) CALL deallocate_cpo(coreneutrals_new)
1095  CALL deallocate_cpo(edge_new)
1096 #else
1097 #endif
1098 
1099 ! dpc
1100  IF (psi_bnd_type .EQ. 2) THEN
1101  bc_ip_tau = 1.0e-3_r8
1102  bc_ip_wanted = psi_bnd_value(1)
1103  bc_ip_current = &
1104  - equilibrium_iter(1)%profiles_1d%dpsidrho_tor(npsi) &
1105  * equilibrium_iter(1)%profiles_1d%vprime(npsi) &
1106  * equilibrium_iter(1)%profiles_1d%dpsidrho_tor(npsi) &
1107  * equilibrium_iter(1)%profiles_1d%gm2(npsi) &
1108  / 4.e0_r8 / itm_pi**2 / itm_mu0
1109  WRITE(*,*) ' bc_ip_wanted = ', bc_ip_wanted
1110  WRITE(*,*) 'bc_ip_current = ', bc_ip_current
1111  WRITE(*,*) ' bc_ip_tau = ', bc_ip_tau
1112  ENDIF
1113 ! cpd
1114 
1115  !----------------------------------------------------------------------!
1116  !----------------------------------------------------------------------!
1117  ! START TIME LOOP !
1118  !----------------------------------------------------------------------!
1119  !----------------------------------------------------------------------!
1120 
1121 time_loop: DO WHILE(time + tau*0.1_r8 .LT. time_end)
1122  itime = itime + 1
1123 
1124  IF(equil_mod.GT.0) THEN
1125  do_equil=mod(itime,equil_mod).EQ.0
1126  ELSE
1127  do_equil=.true.
1128  ENDIF
1129 
1130 !! TIME_LOOP1: DO ITIME = 1,NTIME
1131 
1132  time = time + tau
1133  iter = 0
1134 
1135  WRITE(*,*) ' '
1136  WRITE(*,*) '!=============================================!'
1137  WRITE(*,*) '!=============================================!'
1138  WRITE (6,*)'! TIME=',time
1139  WRITE(*,*) '!=============================================!'
1140  WRITE(*,*) '!=============================================!'
1141  WRITE(*,*) ' '
1142 
1143 
1144 
1145 
1146 
1147  !----------------------------------------------------------------------!
1148  !----------------------------------------------------------------------!
1149  ! START CONVERGENCE LOOP !
1150  !----------------------------------------------------------------------!
1151  !----------------------------------------------------------------------!
1152 10 CONTINUE
1153 
1154  iter = iter + 1
1155  WRITE(*,*) '!=============================================!'
1156  WRITE (6,*)'! iteration=',iter
1157  WRITE(*,*) '!=============================================!'
1158  WRITE(*,*) ''
1159 
1160 
1161  IF(iter.GT.maxiter) THEN
1162  WRITE(*,'(a,i0,a)') 'Maximum number of iterations ( ',maxiter,' ) exceeded'
1163  WRITE(*,'(a,1pg10.3,a,i0)') 'Time = ', time, ' Number of time iterations = ', itime
1164  stop 'Error'
1165  ENDIF
1166 
1167 
1168 
1169 
1170  !----------------------------------------------------------------------!
1171  ! Equilibrium !
1172  !----------------------------------------------------------------------!
1173  WRITE(*,*) '!---------------------------------------------!'
1174  WRITE (6,*)'! EQUILIBRIUM !'
1175  WRITE(*,*) '!---------------------------------------------!'
1176  WRITE(*,*) ''
1177  WRITE(*,*) '========>> START'
1178  ! Provide consistent input for equilibrium:
1179  CALL deallocate_cpo(equilibrium_new)
1180  CALL equil_input(coreprof_iter, toroidfield_old, equilibrium_iter, equilibrium_new)
1181 
1182 ! dpc
1183 ! jrlx=0.99_R8
1184 ! write(*,*) 'jpar/jphi relaxation factor = ', jrlx
1185 ! EQUILIBRIUM_NEW(1)%profiles_1d%jparallel = jrlx * EQUILIBRIUM_ITER(1)%profiles_1d%jparallel + &
1186 ! (1 - jrlx) * EQUILIBRIUM_NEW(1)%profiles_1d%jparallel
1187 ! EQUILIBRIUM_NEW(1)%profiles_1d%jphi = jrlx * EQUILIBRIUM_ITER(1)%profiles_1d%jphi + &
1188 ! (1 - jrlx) * EQUILIBRIUM_NEW(1)%profiles_1d%jphi
1189 ! cpd
1190  CALL deallocate_cpo(equilibrium_iter)
1191 ! WRITE(*,*) ' '
1192 
1193  ! >>> At this stage we have EQUILIBRIUM_NEW filled with current and pressure profiles
1194 
1195  ! Update equilibrium:
1196  IF(npsi.GT.0) THEN
1197  IF(do_equil) THEN
1198  IF(ext_equil.EQ.1) THEN
1199  CALL deallocate_cpo(equilibrium_iter)
1200  CALL bdseq_wrapper(equilibrium_new, equilibrium_iter)
1201  ELSEIF(ext_equil.EQ.2) THEN
1202  CALL deallocate_cpo(equilibrium_iter)
1203  CALL emeq_e3m_wrapper(equilibrium_new, equilibrium_iter)
1204  ELSEIF(ext_equil.EQ.3) THEN
1205 #ifdef GOT_HELENA
1206  CALL deallocate_cpo(equilibrium_iter)
1207  CALL helena_wrapper(equilibrium_new, equilibrium_iter)
1208 #else
1209  WRITE(*,*) 'No HELENA available at compile time'
1210  stop 'No HELENA'
1211 #endif
1212  ELSEIF(ext_equil.EQ.4) THEN
1213 #ifdef GOT_CHEASE
1214  CALL deallocate_cpo(equilibrium_iter)
1215  CALL chease_wrapper(equilibrium_new, equilibrium_iter)
1216 #else
1217  WRITE(*,*) 'No CHEASE available at compile time'
1218  stop 'No CHEASE'
1219 #endif
1220  ELSEIF(ext_equil.EQ.0) THEN
1221  CALL deallocate_cpo(equilibrium_iter)
1222  CALL copy_cpo(equilibrium_new, equilibrium_iter)
1223  ELSE
1224  WRITE(*,*) 'Unknown equilibrium option ', ext_equil
1225  stop 'Unknown EQUILIBRIUM'
1226 
1227  ENDIF
1228  ELSE
1229  WRITE(*,*) 'Re-using equilibrium'
1230  CALL deallocate_cpo(equilibrium_iter)
1231  CALL copy_cpo(equilibrium_new, equilibrium_iter)
1232  ENDIF
1233 
1234  IF(exp_option.NE.0) THEN
1235  IF(.NOT.ASSOCIATED(neoclassic_iter)) &
1236  ALLOCATE (neoclassic_iter(1))
1237  CALL changeradii(equilibrium_iter, &
1238  coreprof_iter, &
1239  coretransp_iter, &
1240  coresource_iter, &
1241  coreimpur_iter, &
1242  coreneutrals_iter, &
1243  neoclassic_iter)
1244  CALL deallocate_cpo(neoclassic_iter)
1245  ENDIF
1246  ELSE
1247  IF(time_dep_input.EQ.1) THEN
1248  ELSE
1249  CALL deallocate_cpo(equilibrium_iter)
1250  CALL copy_cpo(equilibrium_new, equilibrium_iter)
1251  ENDIF
1252  ENDIF
1253 
1254  CALL deallocate_cpo(equilibrium_new)
1255  CALL copy_cpo(equilibrium_iter, equilibrium_new)
1256 
1257 ! dpc
1258 !!$ IF (psi_bnd_type .EQ. 2) THEN
1259 !!$ bc_ip_current = &
1260 !!$ - equilibrium_iter(1)%profiles_1d%dpsidrho_tor(npsi) &
1261 !!$ * equilibrium_iter(1)%profiles_1d%vprime(npsi) &
1262 !!$ * equilibrium_iter(1)%profiles_1d%dpsidrho_tor(npsi) &
1263 !!$ * equilibrium_iter(1)%profiles_1d%gm2(npsi) &
1264 !!$ / 4.e0_R8 / ITM_PI**2 / ITM_MU0
1265 !!$ WRITE(*,*) 'bc_ip_current = ', bc_ip_current
1266 !!$ IF (ITER .EQ. 1) THEN
1267 !!$ bc_ip_jrlx = MAX(0.0_R8, MIN(1.0_R8, time / bc_ip_tau))
1268 !!$ WRITE(*,*) ' bc_ip_jrlx = ', bc_ip_jrlx
1269 !!$ coreprof_iter(1)%psi%boundary%value(1) = (1.0_R8 - bc_ip_jrlx) * bc_ip_current + bc_ip_jrlx * bc_ip_wanted
1270 !!$ ENDIF
1271 !!$ WRITE(*,*) ' bc_ip_target = ', coreprof_iter(1)%psi%boundary%value(1)
1272 !!$ ENDIF
1273 ! cpd
1274 
1275  ! >>> At this stage we have updated geometry stored in EQUILIBRIUM_ITER
1276 
1277 
1278 
1279 
1280 
1281 
1282 
1283  WRITE(*,*) 'END <<========'
1284  !----------------------------------------------------------------------!
1285  ! Transport !
1286  !----------------------------------------------------------------------!
1287  WRITE(*,*) '!---------------------------------------------!'
1288  WRITE (6,*)'! TRANSPORT !'
1289  WRITE(*,*) '!---------------------------------------------!'
1290  WRITE(*,*) ''
1291  WRITE(*,*) '========>> START'
1292 
1293  IF(ext_transport.EQ.1) THEN
1294  CALL external_transport(equilibrium_iter, coreprof_iter, coretransp_iter, add_transport)
1295 
1296 
1297  ELSEIF(ext_transport.EQ.2) THEN
1298  !DATABASE TRANSPORT
1299  WRITE(*,*) ''
1300  WRITE(*,*) '==>> calling DATABASE TRANSPORT'
1301  CALL copy_cpo(coretransp_db, coretransp1)
1302 
1303  !NEOCLASSICAL TRANSPORT
1304  WRITE(*,*) ''
1305  WRITE(*,*) '==>> calling NEOCLASSICAL TRANSPORT'
1306  CALL neowes_wrapper(equilibrium_iter, coreprof_iter, neoclassic_iter)
1307  CALL convert_neoclassic2coretransp(neoclassic_iter, coretransp2)
1308 
1309  !ANOMALOUS TRANSPORT
1310  WRITE(*,*) ''
1311  WRITE(*,*) '==>> calling ANOMALOUS TRANSPORT'
1312  CALL gb_transport(equilibrium_iter, coreprof_iter, coretransp3)
1313 
1314  !NO BACKGROUND TRANSPORT
1315  WRITE(*,*) ''
1316  WRITE(*,*) '==>> calling BACKGROUND TRANSPORT'
1317  CALL allocate_coretransp_cpo(nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coretransp4)
1318  CALL copy_cpo(coreprof_iter(1)%rho_tor, coretransp4(1)%VALUES(1)%rho_tor)
1319  CALL copy_cpo(coreprof_iter(1)%compositions, coretransp4(1)%compositions)
1320 
1321  !SPITZER RESISTIVITY
1322  WRITE(*,*) ''
1323  WRITE(*,*) '==>> calling SPITZER RESISTIVITY'
1324  CALL spitzer_resistivity(coreprof_iter, coretransp5)
1325 
1326 
1327 
1328  IF(ASSOCIATED(coretransp_old)) stop 'associated(CORETRANSP_OLD) 1'
1329  CALL copy_cpo(coretransp_iter, coretransp_old)
1330  CALL deallocate_cpo(coretransp_iter)
1331 
1332 
1333  !COMBINING INDIVIDUAL TRANSPORT COEFFICIENTS INTO SINGLE CORETRANSP CPO
1334  WRITE(*,*) ''
1335  WRITE(*,*) '==>> calling TRANSPORT COMBINER'
1336  CALL combine_transport(coreprof_iter, coretransp_old, &
1337  coretransp1, coretransp2, coretransp3, coretransp4, coretransp5, &
1338  coretransp_iter, &
1339  1._r8, code_parameters_transport_combiner)
1340 
1341 
1342  !DEALOCATING INDIVIDUAL CORETRANSP CPOs
1343  CALL deallocate_cpo(coretransp_old)
1344  CALL deallocate_cpo(coretransp1)
1345  CALL deallocate_cpo(coretransp2)
1346  CALL deallocate_cpo(coretransp3)
1347  CALL deallocate_cpo(coretransp4)
1348  CALL deallocate_cpo(coretransp5)
1349 
1350 
1351 
1352  ELSE
1353  IF(time_dep_input.EQ.1) THEN
1354  CALL deallocate_cpo(coretransp_old)
1355  CALL copy_cpo(coretransp_iter, coretransp_old)
1356  CALL deallocate_cpo(coretransp_old)
1357  ENDIF
1358  ENDIF
1359 
1360  ! >>> At this stage we have updated transport coefficients stored in CORETRANSP_ITER
1361 
1362 
1363 
1364  WRITE(*,*) 'END <<========'
1365 
1366  !----------------------------------------------------------------------!
1367  ! Sources !
1368  !----------------------------------------------------------------------!
1369  ! Update sources:
1370  WRITE(*,*) '!---------------------------------------------!'
1371  WRITE (6,*)'! SOURCES !'
1372  WRITE(*,*) '!---------------------------------------------!'
1373  WRITE(*,*) ''
1374  WRITE(*,*) '========>> START'
1375 
1376  IF(ext_source.EQ.2) THEN
1377 
1378 !!---- DATABASE SOURCE
1379  WRITE(*,*) ''
1380  WRITE(*,*) '==>> calling DATABASE SOURCE'
1381  CALL copy_cpo(coresource_db, coresource1)
1382 
1383 
1384 !!---- GAUSSIAN SOURCES
1385  WRITE(*,*) ''
1386  WRITE(*,*) '==>> calling GAUSSIAN SOURCES'
1387  CALL gausian_sources(coreprof_iter, equilibrium_iter, coresource2, code_parameters_gausian_sources)
1388 
1389 
1390 !!---- SYNCHROTRON SOURCES
1391  WRITE(*,*) ''
1392  WRITE(*,*) '==>> calling SYNCHROTRON RADIATION'
1393  CALL synchrotron_radiation(coreprof_iter, coresource3)
1394 
1395 
1396 !!---- HCD SOURCES (no HCD in fortran version )
1397  WRITE(*,*) ''
1398  WRITE(*,*) '==>> calling HCD SOURCES'
1399  CALL allocate_coresource_cpo &
1400  (nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource4)
1401  CALL deallocate_cpo(coresource4(1)%VALUES(1)%rho_tor)
1402  CALL copy_cpo(coresource_iter(1)%VALUES(1)%rho_tor, coresource4(1)%VALUES(1)%rho_tor)
1403  CALL deallocate_cpo(coresource4(1)%compositions)
1404  CALL copy_cpo(coresource_iter(1)%compositions, coresource4(1)%compositions)
1405 
1406 
1407 !!---- NEUTRALS
1408  WRITE(*,*) ''
1409  WRITE(*,*) '==>> calling NEUTRALS'
1410  IF(ASSOCIATED(coreneutrals_new)) THEN
1411  CALL deallocate_cpo(coreneutrals_new)
1412 ! WRITE(*,*) 'Deallocated CORENEUTRALS_NEW just before call to NEUTRALS_ETS'
1413  ENDIF
1414 
1415  IF(nneut .GT. 0) THEN
1416  CALL neutrals_ets(coreimpur_iter, equilibrium_iter, coreprof_iter, &
1417  coreneutrals_old, coreneutrals_iter, & !NEUTRAL SOURCE
1418  coresource5, coreneutrals_new, &
1419  control_integer, control_double)
1420  CALL check_convergence_neutrals(coreneutrals_iter, coreneutrals_new, conv_neut)
1421  ELSE
1422  CALL allocate_coresource_cpo & !NO NEUTRAL SOURCES
1423  (nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource5)
1424  CALL deallocate_cpo(coresource5(1)%VALUES(1)%rho_tor)
1425  CALL copy_cpo(coresource_iter(1)%VALUES(1)%rho_tor, coresource5(1)%VALUES(1)%rho_tor)
1426  CALL deallocate_cpo(coresource5(1)%compositions)
1427  CALL copy_cpo(coresource_iter(1)%compositions, coresource5(1)%compositions)
1428  END IF
1429 ! irena Split
1430 ! CALL COPY_CPO (CORENEUTRALS_NEW, CORENEUTRALS_ITER)
1431 !!---- IMPURITY
1432  WRITE(*,*) ''
1433  WRITE(*,*) '==>> calling IMPURITY'
1434  IF(ASSOCIATED(coreimpur_new)) THEN
1435  CALL deallocate_cpo(coreimpur_new)
1436 ! WRITE(*,*) 'Deallocated COREIMPUR_NEW just before call to IMPURITY_ETS'
1437  ENDIF
1438 
1439  coretransp_iter(1)%VALUES(1)%nz_transp(1)%diff_eff = 1.0_r8 !!!!!!!!!!!!!!!!!!this is a quick fix for FEM solver
1440 
1441  IF(nimp .GT. 0) THEN
1442  CALL impurity_ets(equilibrium_iter, coreprof_iter, coretransp_iter, &
1443  coreimpur_old, coreimpur_iter, coreneutrals_iter, &
1444  coresource5, coresource6, coreimpur_new, & !IMPURITY SOURCE
1445  control_integer, control_double)
1446  CALL check_convergence_impurities(coreimpur_iter, coreimpur_new, conv_imp)
1447  ELSE
1448  CALL allocate_coresource_cpo & !NO IMPURITY SOURCES
1449  (nslice, nrho, nnucl, nion, nimp, nzimp, nneut, ntype, ncomp, coresource6)
1450  CALL deallocate_cpo(coresource6(1)%VALUES(1)%rho_tor)
1451  CALL copy_cpo(coresource_iter(1)%VALUES(1)%rho_tor, coresource6(1)%VALUES(1)%rho_tor)
1452  CALL deallocate_cpo(coresource6(1)%compositions)
1453  CALL copy_cpo(coresource_iter(1)%compositions, coresource6(1)%compositions)
1454  END IF
1455 
1456 
1457 
1458 !!---- NEOCLASSICAL
1459  WRITE(*,*) ''
1460  WRITE(*,*) '==>> calling NEOCLASSICAL'
1461  CALL convert_neoclassic2coresource(neoclassic_iter, coresource7) !Neoclassical sources
1462 
1463 
1464 
1465 
1466 !!---- COMBINE SOURCES
1467  WRITE(*,*) ''
1468  WRITE(*,*) '==>> calling SOURCE COMBINER'
1469  CALL copy_cpo(coresource_iter, coresource_old)
1470  CALL deallocate_cpo(coresource_iter)
1471 
1472  CALL combine_sources(coreprof_iter, coresource_old, &
1473  coresource1, coresource2, coresource3, &
1474  coresource4, coresource5, coresource6, &
1475  coresource7, &
1476  coresource_iter,1._r8, code_parameters_sources_combiner)
1477 
1478  CALL deallocate_cpo(coresource_old)
1479  CALL deallocate_cpo(coresource1)
1480  CALL deallocate_cpo(coresource2)
1481  CALL deallocate_cpo(coresource3)
1482  CALL deallocate_cpo(coresource4)
1483  CALL deallocate_cpo(coresource5)
1484  CALL deallocate_cpo(coresource6)
1485  CALL deallocate_cpo(coresource7)
1486 
1487  ELSE
1488  IF(time_dep_input.EQ.1) THEN
1489  CALL deallocate_cpo(coresource_old)
1490  CALL copy_cpo(coresource_iter, coresource_old)
1491  CALL deallocate_cpo(coresource_old)
1492  ENDIF
1493  ENDIF
1494 
1495  ! >>> At this stage we have updated profiles of sources stored in CORESOURCE_ITER
1496 
1497 ! CALL ETS_INPUT (EQUILIBRIUM_ITER, COREPROF_ITER)
1498 
1499 
1500  IF(ASSOCIATED(neoclassic_iter)) CALL deallocate_cpo(neoclassic_iter)
1501 
1502 
1503 
1504  WRITE(*,*) 'END <<========'
1505 
1506  !----------------------------------------------------------------------!
1507  ! TRANSPORT EQUATIONS !
1508  !----------------------------------------------------------------------!
1509  ! >>> At this stage:
1510  ! CPOs with the index _OLD contain the information from the previous time step
1511  ! CPOs with the index _ITER contain the information from the previous iteration
1512  ! CONTROL_INTEGER and CONTROL_DOUBLE types contain the controlling parameters
1513  WRITE(*,*) '!---------------------------------------------!'
1514  WRITE(*,*) '! TRANSPORT EQUATIONS !'
1515  WRITE(*,*) '!---------------------------------------------!'
1516  WRITE(*,*) ''
1517  WRITE(*,*) '========>> START'
1518 
1519 ! CALL size_of_cpo (COREPROF_OLD(1),total_size, .FALSE.,'COREPROF_OLD')
1520 ! CALL size_of_cpo (COREPROF_ITER(1),total_size, .FALSE.,'COREPROF_ITER')
1521 ! CALL size_of_cpo (EQUILIBRIUM_OLD(1),total_size, .FALSE.,'EQUILIBRIUM_OLD')
1522 ! CALL size_of_cpo (EQUILIBRIUM_ITER(1),total_size, .FALSE.,'EQUILIBRIUM_ITER')
1523 ! CALL size_of_cpo (CORETRANSP_ITER(1),total_size, .FALSE.,'CORETRANSP_ITER')
1524 ! CALL size_of_cpo (CORESOURCE_ITER(1),total_size, .FALSE.,'CORESOURCE_ITER')
1525 
1526  IF(ASSOCIATED(coreprof_new)) CALL deallocate_cpo(coreprof_new)
1527 
1528 ! IF(nimp .GT. 0) &
1529 ! CALL size_of_cpo(COREIMPUR_ITER(1),total_size, .FALSE.,'COREIMPUR_ITER')
1530 ! IF(NNEUT .GT. 0) &
1531 ! CALL size_of_cpo(CORENEUTRALS_ITER(1),total_size,.FALSE.,'CORENEUTRALS_ITER')
1532  IF(ASSOCIATED(coreprof_new)) THEN
1533  CALL deallocate_cpo(coreprof_new)
1534  WRITE(*,*) 'Deallocated COREPROF_NEW just before call to ITM_ETS'
1535  ENDIF
1536 
1537 
1538  CALL itm_ets(coreprof_old, coreprof_iter, coreprof_new, &
1539  equilibrium_old, equilibrium_iter, &
1540  coretransp_iter, coresource_iter, coreimpur_new, &
1541  control_integer, control_double, code_parameters_ets)
1542 
1543 
1544  WRITE(*,*) 'END <<========'
1545 
1546  !----------------------------------------------------------------------!
1547  ! Convergence !
1548  !----------------------------------------------------------------------!
1549  ! Check the actual convergence
1550  CALL check_convergence(coreprof_iter, coreprof_new, control_double)
1551 
1552  ! >>> At this stage we have updated CONTROL_DOUBLE type
1553  ! COREPROF_ITER contains new plasma profiles copied from COREPROF_NEW
1554 
1555  CALL deallocate_cpo(coreprof_iter)
1556  CALL copy_cpo(coreprof_new, coreprof_iter)
1557  CALL deallocate_cpo(coreprof_new )
1558 
1559  IF(nimp > 0) THEN
1560  CALL deallocate_cpo(coreimpur_iter)
1561  CALL copy_cpo(coreimpur_new, coreimpur_iter)
1562  CALL deallocate_cpo(coreimpur_new )
1563  ENDIF
1564 
1565  IF(nneut > 0) THEN
1566  CALL deallocate_cpo(coreneutrals_iter)
1567  CALL copy_cpo(coreneutrals_new, coreneutrals_iter)
1568  ENDIF
1569 
1570  WRITE(*,'(a,i3,a,e10.3)') 'CONVERGENCE at iteration=',iter, ': ',control_double(4)
1571  WRITE(*,*) '==========================='
1572  WRITE(*,*) ''
1573  WRITE(*,*) ''
1574 
1575  ! Compare the actual and required convergence:
1576  IF (control_double(4).GT.control_double(5)) goto 10
1577 
1578  !----------------------------------------------------------------------!
1579  !----------------------------------------------------------------------!
1580  ! END TIME LOOP !
1581  !----------------------------------------------------------------------!
1582  !----------------------------------------------------------------------!
1583 
1584 
1585  CALL deallocate_cpo(coreprof_old)
1586  CALL copy_cpo(coreprof_iter, coreprof_old)
1587  CALL deallocate_cpo(equilibrium_old)
1588  CALL copy_cpo(equilibrium_iter, equilibrium_old)
1589 
1590  ! >>> At this stage we have COREPROF_OLD and EQUILIBRIUM_OLD
1591  ! updated after iterations on the time step converged
1592 
1593 !irena
1594  IF(nimp > 0) THEN
1595  CALL deallocate_cpo(coreimpur_old)
1596  CALL copy_cpo(coreimpur_iter, coreimpur_old)
1597  ENDIF
1598 !irena
1599  IF(nneut > 0) THEN
1600  CALL deallocate_cpo(coreneutrals_old)
1601  CALL copy_cpo(coreneutrals_iter, coreneutrals_old)
1602  ENDIF
1603  IF (time + tau*0.1_r8 .GE. time_out) THEN
1604 
1605  ! Writes equilibrium profiles for the comparison with ASTRA:
1606 
1607  itime_out = itime_out +1
1608  time_out = time_out + tau_out
1609 
1610  CALL write_out(itime_out, coreprof_iter )
1611  CALL write_equilibrium(itime_out, equilibrium_new)
1612  IF(nimp > 0) CALL writeoutimpur(itime_out, coreimpur_iter)
1613  IF(nneut > 0) CALL writeoutneutrals(itime_out,coreneutrals_iter)
1614 
1615 ! this is the output via the UAL for the results at the end of the time-steps
1616 
1617  IF(shot_out.GT.0.AND.run_out.GE.0) THEN
1618 
1619  IF(augment_equil.EQ.1) THEN
1620  CALL augment_psi_rz(equilibrium_iter(1))
1621  ENDIF
1622 
1623 #ifdef UAL
1624  IF(use_euitm_put) THEN
1625 
1626  coreprof_iter(1)%time=time
1627  WRITE(*,*) 'euitm_put_slice: coreprof', coreprof_iter(1)%time
1628  CALL euitm_put_slice(idx,"coreprof",coreprof_iter(1))
1629 
1630  IF(do_equil) THEN
1631  equilibrium_iter(1)%time=time
1632  WRITE(*,*) 'euitm_put_slice: equilibrium', equilibrium_iter(1)%time
1633  CALL euitm_put_slice(idx,"equilibrium",equilibrium_iter(1))
1634  ENDIF
1635 
1636  coretransp_iter(1)%time=time
1637  WRITE(*,*) 'euitm_put_slice: coretransp', coretransp_iter(1)%time
1638  CALL euitm_put_slice(idx,"coretransp",coretransp_iter(1))
1639 
1640  coresource_iter(1)%time=time
1641  WRITE(*,*) 'euitm_put_slice: coresource', coresource_iter(1)%time
1642  CALL euitm_put_slice(idx,"coresource",coresource_iter(1))
1643 
1644  IF(nimp > 0) THEN
1645  coreimpur_iter(1)%time=time
1646  WRITE(*,*) 'euitm_put_slice: coreimpur', coreimpur_iter(1)%time
1647  CALL euitm_put_slice(idx,"coreimpur",coreimpur_iter(1))
1648  ENDIF
1649 
1650  IF(nneut > 0) THEN
1651  coreneutrals_iter(1)%time=time
1652  WRITE(*,*) 'euitm_put_slice: coreneutrals', coreneutrals_iter(1)%time
1653  CALL euitm_put_slice(idx,"coreneutrals",coreneutrals_iter(1))
1654  ENDIF
1655 
1656  toroidfield_old(1)%time = time
1657  WRITE(*,*) 'euitm_put_slice: toroidfield', toroidfield_old(1)%time
1658  CALL euitm_put_slice(idx,"toroidfield",toroidfield_old(1))
1659 
1660  ENDIF
1661 #endif
1662 
1663  IF(db_out .EQ. "ascii") THEN
1664  coreprof_iter(1)%time = time
1665  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreprof', shot_out, run_out, itime
1666  CALL open_write_file(1, trim(filename))
1667  CALL write_cpo(coreprof_iter(1), 'coreprof')
1668  CALL close_write_file
1669  IF(do_equil) THEN
1670  equilibrium_iter(1)%time = time
1671  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'equilibrium', shot_out, run_out, itime
1672  CALL open_write_file(1, trim(filename))
1673  CALL write_cpo(equilibrium_iter(1), 'equilibrium')
1674  CALL close_write_file
1675  ENDIF
1676  coretransp_iter(1)%time = time
1677  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coretransp', shot_out, run_out, itime
1678  CALL open_write_file(1, trim(filename))
1679  CALL write_cpo(coretransp_iter(1), 'coretransp')
1680  CALL close_write_file
1681  coresource_iter(1)%time = time
1682  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coresource', shot_out, run_out, itime
1683  CALL open_write_file(1, trim(filename))
1684  CALL write_cpo(coresource_iter(1), 'coresource')
1685  CALL close_write_file
1686  IF(nimp.GT.0) THEN
1687  coreimpur_iter(1)%time = time
1688  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreimpur', shot_out, run_out, itime
1689  CALL open_write_file(1, trim(filename))
1690  CALL write_cpo(coreimpur_iter(1), 'coreimpur')
1691  CALL close_write_file
1692  ENDIF
1693  IF(nneut.GT.0) THEN
1694  coreneutrals_iter(1)%time = time
1695  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'coreneutrals', shot_out, run_out, itime
1696  CALL open_write_file(1, trim(filename))
1697  CALL write_cpo(coreneutrals_iter(1), 'coreneutrals')
1698  CALL close_write_file
1699  ENDIF
1700  toroidfield_old(1)%time = time
1701  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'toroidfield', shot_out, run_out, itime
1702  CALL open_write_file(1, trim(filename))
1703  CALL write_cpo(toroidfield_old(1), 'toroidfield')
1704  CALL close_write_file
1705  ENDIF
1706 
1707  ENDIF
1708 
1709  WRITE(*,1000) ' AREA ',equilibrium_iter(1)%global_param%area
1710  WRITE(*,1000) ' VOLUME ',equilibrium_iter(1)%global_param%volume
1711  WRITE(*,1000) ' Raxis ',equilibrium_iter(1)%global_param%mag_axis%position%r
1712  WRITE(*,1000) ' Zaxis ',equilibrium_iter(1)%global_param%mag_axis%position%z
1713  WRITE(*,1000) ' Baxis ',equilibrium_iter(1)%global_param%mag_axis%bphi
1714  WRITE(*,1000) ' Rgeo ',equilibrium_iter(1)%eqgeometry%geom_axis%r
1715  WRITE(*,1000) ' Zgeo ',equilibrium_iter(1)%eqgeometry%geom_axis%z
1716  WRITE(*,1000) ' a ',equilibrium_iter(1)%eqgeometry%a_minor
1717  WRITE(*,1000) ' R0 ',equilibrium_iter(1)%global_param%toroid_field%b0
1718  WRITE(*,1000) ' B0 ',equilibrium_iter(1)%global_param%toroid_field%r0
1719 
1720  END IF
1721 
1722  IF(iter_inc.GT.0 .AND. iter.LT.iter_inc) THEN
1723  IF(tau_inc.GT.1.0_r8) THEN
1724  tau=tau*tau_inc
1725  WRITE(*,*) 'TAU, TAU_MAX ',tau,tau_max
1726  IF(tau_max.GT.0.0_r8) tau=min(tau,tau_max)
1727  WRITE(*,*) 'TAU increased to ',tau
1728  ENDIF
1729  ELSEIF(iter_dec.GT.0 .AND. iter.GT.iter_dec) THEN
1730  IF(tau_dec.GT.0.0_r8.AND.tau_dec.LT.1.0_r8) THEN
1731  tau=tau*tau_dec
1732  WRITE(*,*) 'TAU, TAU_MIN ',tau,tau_min
1733  IF(tau_min.GT.0.0_r8) tau=max(tau,tau_min)
1734  WRITE(*,*) 'TAU decreased to ',tau
1735  ENDIF
1736  ENDIF
1737 
1738  tau=min(tau,time_end-time)
1739  IF(tau.LT.0) THEN
1740  WRITE(*,*) 'ERROR: TAU < 0'
1741  time=ntime*tau-time
1742  ENDIF
1743 
1744  WRITE(*,'(a)') 'Global Diagnostics Start'
1745  WRITE(*,'(a,1p,I10)') 'ITERATIONS ',iter
1746  WRITE(*,'(a,1p,1024(1x,g15.6))') ' Ip ',equilibrium_new(1)%global_param%i_plasma
1747  WRITE(*,'(a,1p,1024(1x,g15.6))') ' Vol ',equilibrium_new(1)%global_param%volume
1748  WRITE(*,'(a,1p,1024(1x,g15.6))') ' Q_e(bnd) ',coreprof_iter(1)%te%flux%flux_dv(nrho)
1749  WRITE(*,'(a,1p,1024(1x,g15.6))') ' G_e(bnd) ',coreprof_iter(1)%ne%flux%flux_dv(nrho)
1750  DO iion = 1,nion
1751  WRITE(*,'(a,1p,a)') ' ION# ', iion
1752  WRITE(*,'(a,1p,1024(1x,g15.6))') ' Q_i(bnd) ',coreprof_iter(1)%ti%flux%flux_dv(nrho,iion)
1753  WRITE(*,'(a,1p,1024(1x,g15.6))') ' G_i(bnd) ',coreprof_iter(1)%ni%flux%flux_dv(nrho,iion)
1754  END DO
1755  WRITE(*,'(a)') 'Global Diagnostics End'
1756 
1757 !
1758 ! here we are going to call SOLPS to update the ETS boundary conditions
1759 !
1760 #ifdef CORE_EDGE
1761  WRITE(*,*) 'Core-Edge: Continuation call to SOLPS'
1762  CALL b2mn_ets(coreprof_old, coreimpur_old, coreneutrals_old, &
1763  coreprof_iter, coreimpur_iter, coreneutrals_iter, edge_new, &
1764  code_parameters_core_edge)
1765 #ifdef UAL
1766  IF(use_euitm_put) THEN
1767  edge_new(1)%time = time
1768  WRITE(*,*) 'euitm_put_slice: edge', edge_new(1)%time
1769  CALL euitm_put_slice(idx,"edge",edge_new(1))
1770  ENDIF
1771 #endif
1772  IF(db_out .EQ. 'ascii') THEN
1773  edge_new(1)%time = time
1774  WRITE(filename,'(a,''_'',I6.6,''_'',I6.6,''_'',I6.6,''.cpo'')') 'edge', shot_out, run_out, itime
1775  CALL open_write_file(1, trim(filename))
1776  CALL write_cpo(edge_new(1), 'edge')
1777  CALL close_write_file
1778  ENDIF
1779 ! call size_of_cpo(EDGE_NEW(1),total_size,.false.,'EDGE_NEW')
1780  CALL deallocate_cpo(edge_new)
1781 #endif
1782 
1783  INQUIRE(file='.quit',exist=quitexist)
1784  IF(quitexist) EXIT time_loop
1785 
1786 !! END DO TIME_LOOP1
1787  END DO time_loop
1788 
1789 #ifdef CORE_EDGE
1790  WRITE(*,*) 'Core-Edge: Finalization call to SOLPS'
1791  CALL b2mn_ets(coreprof_old, coreimpur_old, coreneutrals_old, &
1792  coreprof_iter, coreimpur_iter, coreneutrals_iter, edge_new, &
1793  code_parameters_core_edge, .true.)
1794 #endif
1795 
1796 #ifdef UAL
1797  IF(shot_out.GT.0.AND.run_out.GE.0.AND.db_out.NE.'ascii') THEN
1798  CALL euitm_close(idx)
1799  ENDIF
1800 #endif
1801 
1802 
1803 !!$ WRITE(*,*) ASSOCIATED(COREPROF_OLD),ASSOCIATED(COREPROF_ITER),ASSOCIATED(COREPROF_NEW), &
1804 !!$ ASSOCIATED(EQUILIBRIUM_OLD),ASSOCIATED(EQUILIBRIUM_ITER),ASSOCIATED(EQUILIBRIUM_NEW), &
1805 !!$ ASSOCIATED(CORETRANSP_OLD),ASSOCIATED(CORETRANSP_ITER), &
1806 !!$ ASSOCIATED(CORESOURCE_OLD),ASSOCIATED(CORESOURCE_ITER), &
1807 !!$ ASSOCIATED(COREIMPUR_OLD),ASSOCIATED(COREIMPUR_ITER),&
1808 !!$ ASSOCIATED(CORENEUTRALS_OLD),ASSOCIATED(CORENEUTRALS_ITER)
1809 
1810  CALL deallocate_cpo(coreprof_old )
1811  CALL deallocate_cpo(coreprof_iter)
1812 ! CALL DEALLOCATE_CPO (COREPROF_NEW )
1813 
1814  CALL deallocate_cpo(equilibrium_old )
1815  CALL deallocate_cpo(equilibrium_iter)
1816  CALL deallocate_cpo(equilibrium_new )
1817 
1818 ! CALL DEALLOCATE_CPO (CORETRANSP_OLD )
1819  CALL deallocate_cpo(coretransp_iter)
1820 
1821 ! CALL DEALLOCATE_CPO (CORESOURCE_OLD )
1822  CALL deallocate_cpo(coresource_iter)
1823 
1824  IF(nimp .GT. 0) CALL deallocate_cpo(coreimpur_old )
1825  IF(nimp .GT. 0) CALL deallocate_cpo(coreimpur_iter)
1826 ! CALL DEALLOCATE_CPO (COREIMPUR_NEW)
1827 
1828  IF(nneut > 0) CALL deallocate_cpo(coreneutrals_old )
1829  IF(nneut > 0) CALL deallocate_cpo(coreneutrals_iter)
1830  IF(nneut > 0) CALL deallocate_cpo(coreneutrals_new)
1831 
1832  CALL deallocate_cpo(toroidfield_old )
1833 
1834  IF(ASSOCIATED(evolution_labels)) DEALLOCATE(evolution_labels)
1835  IF(ASSOCIATED(evolution_data)) DEALLOCATE(evolution_data)
1836  CALL deallocate_cpo(code_parameters_ets)
1837  CALL deallocate_cpo(code_parameters_ets_workflow)
1838  CALL deallocate_cpo(code_parameters_transport_combiner)
1839  CALL deallocate_cpo(code_parameters_sources_combiner)
1840 #ifdef CORE_EDGE
1841  CALL deallocate_cpo(code_parameters_core_edge)
1842 #endif
1843 
1844  CALL deallocate_cpo(coreprof_db)
1845  CALL deallocate_cpo(coretransp_db)
1846  CALL deallocate_cpo(coresource_db)
1847  IF(nimp.GT.0) CALL deallocate_cpo(coreimpur_db)
1848  IF(nneut.GT.0) CALL deallocate_cpo(coreneutrals_db)
1849  CALL deallocate_cpo(equilibrium_db)
1850  CALL deallocate_cpo(toroidfield_db)
1851  CALL deallocate_cpo(neoclassic_db)
1852 
1853  IF(ALLOCATED(ets_species%nzimp)) DEALLOCATE(ets_species%nzimp)
1854  IF(ALLOCATED(ets_species%ncomp)) DEALLOCATE(ets_species%ncomp)
1855  IF(ALLOCATED(ets_species%ntype)) DEALLOCATE(ets_species%ntype)
1856  IF(ALLOCATED(nzimp)) DEALLOCATE(nzimp)
1857  IF(ALLOCATED(ncomp)) DEALLOCATE(ncomp)
1858  IF(ALLOCATED(ntype)) DEALLOCATE(ntype)
1859 
1860 
1861  IF(nimp.GT.0) CALL impurity_finish
1862 
1863 
1864  WRITE(*,*) 'Total_size = ', total_size
1865 
1866 
1867 1000 FORMAT(a,1pg20.10)
1868 
1869 CONTAINS
1870 
1871  SUBROUTINE evolution(T, R_in, R_out, El, Tr_l, Tr_U, Ip)
1872 
1873  USE itm_types
1874 
1875  IMPLICIT NONE
1876 
1877 ! input
1878  REAL(R8) :: t
1879 
1880 ! output
1881  REAL(R8) :: r_in, r_out, el, tr_l, tr_u, ip
1882 
1883 ! local
1884  INTEGER, SAVE :: npts = 0, ncol, isrch=1
1885  INTEGER :: ipts, icol
1886  REAL(R8) :: tf
1887 
1888  IF(npts.EQ.0) THEN
1889  ncol=SIZE(evolution_data,1)
1890  npts=SIZE(evolution_data,2)
1891  WRITE(*,*) 'evolution: ncol, npts = ', ncol, npts
1892  ENDIF
1893 
1894  DO WHILE (isrch.LT.npts .AND. t.GT.evolution_data(1,isrch+1))
1895  isrch=isrch+1
1896  ENDDO
1897 
1898  IF(ncol.LT.7) THEN
1899  WRITE(*,*) 'Not enough data in "evolution.exp"'
1900  stop
1901  ENDIF
1902  IF(t.LT.evolution_data(1,isrch).OR.isrch.EQ.npts) THEN
1903  IF(isrch.NE.1) THEN
1904  WRITE(*,*) 'Coding error in evolution, isrch <> 1'
1905  stop
1906  ENDIF
1907  r_in = evolution_data(2,isrch)
1908  r_out = evolution_data(3,isrch)
1909  el = evolution_data(4,isrch)
1910  tr_l = evolution_data(5,isrch)
1911  tr_u = evolution_data(6,isrch)
1912  ip = evolution_data(7,isrch)
1913  ELSE
1914  tf=(t-evolution_data(1,isrch))/(evolution_data(1,isrch+1)-evolution_data(1,isrch))
1915  IF(tf.LT.0.0_r8 .OR. tf.GT.1.0_r8) THEN
1916  WRITE(*,*) 'Coding error in evolution, tf not in [0,1], tf = ',tf
1917  ENDIF
1918  r_in = (1.0_r8-tf)*evolution_data(2,isrch)+tf*evolution_data(2,isrch+1)
1919  r_out = (1.0_r8-tf)*evolution_data(3,isrch)+tf*evolution_data(3,isrch+1)
1920  el = (1.0_r8-tf)*evolution_data(4,isrch)+tf*evolution_data(4,isrch+1)
1921  tr_l = (1.0_r8-tf)*evolution_data(5,isrch)+tf*evolution_data(5,isrch+1)
1922  tr_u = (1.0_r8-tf)*evolution_data(6,isrch)+tf*evolution_data(6,isrch+1)
1923  ip = (1.0_r8-tf)*evolution_data(7,isrch)+tf*evolution_data(7,isrch+1)
1924  ENDIF
1925  WRITE(*,*) evolution_labels(1), t
1926  WRITE(*,*) evolution_labels(2), r_in
1927  WRITE(*,*) evolution_labels(3), r_out
1928  WRITE(*,*) evolution_labels(4), el
1929  WRITE(*,*) evolution_labels(5), tr_l
1930  WRITE(*,*) evolution_labels(6), tr_u
1931  WRITE(*,*) evolution_labels(7), ip
1932  END SUBROUTINE evolution
1933 
1934  FUNCTION profile(function_string, x)
1935 
1936  use fortranparser, only : equationparser
1937 
1938  IMPLICIT NONE
1939 
1940  REAL(R8) :: x(:), profile(1:size(x))
1941  CHARACTER (len=BUFLEN) :: function_string
1942 
1943  type(equationparser) :: function_descriptor
1944  character(len=10) :: variables(1) = ['x']
1945 
1946  INTEGER :: i
1947 
1948  function_descriptor = equationparser(trim(function_string), variables)
1949 ! if(.not.c_associated(function_descriptor)) then
1950 ! write(*,*) 'Invalid function ', trim(function_string)
1951 ! stop
1952 ! endif
1953 
1954  DO i = 1, SIZE(x)
1955  profile(i) = function_descriptor%evaluate([x(i)])
1956  ENDDO
1957 
1958 ! CALL evaluator_destroy(function_descriptor)
1959 
1960  END FUNCTION profile
1961 
1962 END PROGRAM ets_workflow
1963 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1964 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
1965 
1966 SUBROUTINE external_transport(EQUILIBRIUM_ITER,COREPROF_ITER,CORETRANSP_ITER,add_transport)
1967 
1968  USE itm_constants
1969  USE euitm_routines
1970  USE euitm_schemas
1971  USE allocate_deallocate
1972  USE itm_test_routines_etseq
1973  USE ets_wrapper_etaigb
1974  USE ets_wrapper_neowes
1975  USE ets_species_module
1976 
1977  IMPLICIT NONE
1978 
1979  TYPE (type_equilibrium), POINTER :: equilibrium_iter(:)
1980  TYPE (type_coreprof), POINTER :: coreprof_iter(:)
1981  TYPE (type_coretransp), POINTER :: coretransp_iter(:), coretransp_etaigb(:), coretransp_neowes(:)
1982  TYPE (type_neoclassic), POINTER :: neoclassic_neowes(:)
1983  INTEGER, PARAMETER :: nslice = 1 !number of CPO ocurancies in the work flow
1984  INTEGER :: itr, iion, nrho, nion
1985  REAL(R8) :: add_transport
1986 
1987  nrho = SIZE (coreprof_iter(1)%rho_tor, dim=1)
1988 
1989  CALL allocate_coretransp_cpo(nslice, nrho, ets_species%NATM, ets_species%NION, ets_species%NIMP, ets_species%NZIMP, ets_species%NNEUT, ets_species%NTYPE, ets_species%NCOMP, coretransp_neowes )
1990  coretransp_neowes(1)%VALUES(1)%rho_tor(:) = coretransp_iter(1)%VALUES(1)%rho_tor(:)
1991 
1992  CALL etaigb_wrapper(equilibrium_iter,coreprof_iter,coretransp_etaigb)
1993  CALL neowes_wrapper(equilibrium_iter,coreprof_iter,neoclassic_neowes)
1994 
1995 ! map the electron particle transport --- don't do since we don't use
1996 ! do itr=1,3
1997 ! call L3interp( &
1998 ! coretransp_etaigb(1)%values(1)%ne_transp%diff_eff(:,itr),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
1999 ! coretransp_ITER(1)%values(1)%ne_transp%diff_eff(:,itr),coretransp_ITER(1)%values(1)%rho_tor,nrho)
2000 ! call L3interp( &
2001 ! coretransp_etaigb(1)%values(1)%ne_transp%vconv_eff(:,itr),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2002 ! coretransp_ITER(1)%values(1)%ne_transp%vconv_eff(:,itr),coretransp_ITER(1)%values(1)%rho_tor,nrho)
2003 ! enddo
2004 ! coretransp_neowes(1)%values(1)%ne_transp%diff_eff=0.0_R8
2005 ! coretransp_neowes(1)%values(1)%ne_transp%vconv_eff=0.0_R8
2006 ! call L3interp( &
2007 ! neoclassic_neowes(1)%ne_neo%diff_eff(:),neoclassic_neowes(1)%rho_tor,nrho, &
2008 ! coretransp_NEOWES(1)%values(1)%ne_transp%diff_eff(:,3),coretransp_NEOWES(1)%values(1)%rho_tor,nrho)
2009 ! call L3interp( &
2010 ! neoclassic_neowes(1)%ne_neo%vconv_eff(:),neoclassic_neowes(1)%rho_tor,nrho, &
2011 ! coretransp_NEOWES(1)%values(1)%ne_transp%vconv_eff(:,3),coretransp_NEOWES(1)%values(1)%rho_tor,nrho)
2012 ! coretransp_ITER(1)%values(1)%ne_transp%diff_eff = coretransp_ITER(1)%values(1)%ne_transp%diff_eff + coretransp_NEOWES(1)%values(1)%ne_transp%diff_eff
2013 ! coretransp_ITER(1)%values(1)%ne_transp%vconv_eff = coretransp_ITER(1)%values(1)%ne_transp%vconv_eff + coretransp_NEOWES(1)%values(1)%ne_transp%vconv_eff
2014 
2015 ! map the electron heat transport
2016  CALL l3interp( &
2017  coretransp_etaigb(1)%values(1)%te_transp%diff_eff(:),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2018  coretransp_iter(1)%values(1)%te_transp%diff_eff(:),coretransp_iter(1)%values(1)%rho_tor,nrho)
2019  CALL l3interp( &
2020  coretransp_etaigb(1)%values(1)%te_transp%vconv_eff(:),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2021  coretransp_iter(1)%values(1)%te_transp%vconv_eff(:),coretransp_iter(1)%values(1)%rho_tor,nrho)
2022  CALL l3interp( &
2023  neoclassic_neowes(1)%te_neo%diff_eff(:),neoclassic_neowes(1)%rho_tor,nrho, &
2024  coretransp_neowes(1)%values(1)%te_transp%diff_eff(:),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2025  CALL l3interp( &
2026  neoclassic_neowes(1)%te_neo%vconv_eff(:),neoclassic_neowes(1)%rho_tor,nrho, &
2027  coretransp_neowes(1)%values(1)%te_transp%vconv_eff(:),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2028  coretransp_iter(1)%values(1)%te_transp%diff_eff = coretransp_iter(1)%values(1)%te_transp%diff_eff + &
2029  coretransp_neowes(1)%values(1)%te_transp%diff_eff + add_transport
2030  coretransp_iter(1)%values(1)%te_transp%vconv_eff = coretransp_iter(1)%values(1)%te_transp%vconv_eff + &
2031  coretransp_neowes(1)%values(1)%te_transp%vconv_eff
2032 
2033 ! map the ion particle transport
2034  coretransp_neowes(1)%values(1)%ni_transp%diff_eff=0.0_r8
2035  coretransp_neowes(1)%values(1)%ni_transp%vconv_eff=0.0_r8
2036  DO iion=1,ets_species%nion
2037  DO itr=1,3
2038  CALL l3interp( &
2039  coretransp_etaigb(1)%values(1)%ni_transp%diff_eff(:,iion,itr),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2040  coretransp_iter(1)%values(1)%ni_transp%diff_eff(:,iion,itr),coretransp_iter(1)%values(1)%rho_tor,nrho)
2041  CALL l3interp( &
2042  coretransp_etaigb(1)%values(1)%ni_transp%vconv_eff(:,iion,itr),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2043  coretransp_iter(1)%values(1)%ni_transp%vconv_eff(:,iion,itr),coretransp_iter(1)%values(1)%rho_tor,nrho)
2044  ENDDO
2045  CALL l3interp( &
2046  neoclassic_neowes(1)%ni_neo%diff_eff(:,iion),neoclassic_neowes(1)%rho_tor,nrho, &
2047  coretransp_neowes(1)%values(1)%ni_transp%diff_eff(:,iion,3),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2048  CALL l3interp( &
2049  neoclassic_neowes(1)%ni_neo%vconv_eff(:,iion),neoclassic_neowes(1)%rho_tor,nrho, &
2050  coretransp_neowes(1)%values(1)%ni_transp%vconv_eff(:,iion,3),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2051 
2052 ! map the ion heat transport
2053  CALL l3interp( &
2054  coretransp_etaigb(1)%values(1)%ti_transp%diff_eff(:,iion),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2055  coretransp_iter(1)%values(1)%ti_transp%diff_eff(:,iion),coretransp_iter(1)%values(1)%rho_tor,nrho)
2056  CALL l3interp( &
2057  coretransp_etaigb(1)%values(1)%ti_transp%vconv_eff(:,iion),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2058  coretransp_iter(1)%values(1)%ti_transp%vconv_eff(:,iion),coretransp_iter(1)%values(1)%rho_tor,nrho)
2059  CALL l3interp( &
2060  neoclassic_neowes(1)%ti_neo%diff_eff(:,iion),neoclassic_neowes(1)%rho_tor,nrho, &
2061  coretransp_neowes(1)%values(1)%ti_transp%diff_eff(:,iion),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2062  CALL l3interp( &
2063  neoclassic_neowes(1)%ti_neo%vconv_eff(:,iion),neoclassic_neowes(1)%rho_tor,nrho, &
2064  coretransp_neowes(1)%values(1)%ti_transp%vconv_eff(:,iion),coretransp_neowes(1)%values(1)%rho_tor,nrho)
2065 
2066 ! map the vtor transport --- not stored yet
2067 ! call L3interp( &
2068 ! coretransp_etaigb(1)%values(1)%vtor_transp%diff_eff(:,iion),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2069 ! coretransp_ITER(1)%values(1)%vtor_transp%diff_eff(:,iion),coretransp_ITER(1)%values(1)%rho_tor,nrho)
2070 ! call L3interp( &
2071 ! coretransp_etaigb(1)%values(1)%vtor_transp%vconv_eff(:,iion),coretransp_etaigb(1)%values(1)%rho_tor,nrho, &
2072 ! coretransp_ITER(1)%values(1)%vtor_transp%vconv_eff(:,iion),coretransp_ITER(1)%values(1)%rho_tor,nrho)
2073  ENDDO
2074  coretransp_iter(1)%values(1)%ni_transp%diff_eff = coretransp_iter(1)%values(1)%ni_transp%diff_eff + &
2075  coretransp_neowes(1)%values(1)%ni_transp%diff_eff + add_transport
2076  coretransp_iter(1)%values(1)%ni_transp%vconv_eff = coretransp_iter(1)%values(1)%ni_transp%vconv_eff + &
2077  coretransp_neowes(1)%values(1)%ni_transp%vconv_eff
2078  coretransp_iter(1)%values(1)%ti_transp%diff_eff = coretransp_iter(1)%values(1)%ti_transp%diff_eff + &
2079  coretransp_neowes(1)%values(1)%ti_transp%diff_eff + add_transport
2080  coretransp_iter(1)%values(1)%ti_transp%vconv_eff = coretransp_iter(1)%values(1)%ti_transp%vconv_eff + &
2081  coretransp_neowes(1)%values(1)%ti_transp%vconv_eff
2082 
2083 ! map the vtor transport --- for the moment use 2/3 ion heat contributions
2084  coretransp_iter(1)%values(1)%vtor_transp%diff_eff=coretransp_iter(1)%values(1)%ti_transp%diff_eff * 2.0_r8/3.0_r8
2085  coretransp_iter(1)%values(1)%vtor_transp%vconv_eff=coretransp_iter(1)%values(1)%ti_transp%vconv_eff * 2.0_r8/3.0_r8
2086 
2087 ! write(*,*) CORETRANSP_etaigb(1)%values(1)%rho_tor
2088 ! write(*,*) NEOCLASSIC_neowes(1)%rho_tor
2089 ! write(*,*) CORETRANSP_ITER(1)%VALUES(1)%rho_tor
2090 
2091 ! write(*,*) coretransp_etaigb(1)%values(1)%te_transp%diff_eff
2092 ! write(*,*) neoclassic_neowes(1)%te_neo%diff_eff
2093 ! write(*,*) coretransp_ITER(1)%values(1)%te_transp%diff_eff
2094 
2095  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%te_transp%diff_eff ', &
2096  minval(coretransp_etaigb(1)%values(1)%te_transp%diff_eff), &
2097  maxval(coretransp_etaigb(1)%values(1)%te_transp%diff_eff)
2098  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%te_transp%vconv_eff ' &
2099  ,minval( coretransp_etaigb(1)%values(1)%te_transp%vconv_eff), &
2100  maxval( coretransp_etaigb(1)%values(1)%te_transp%vconv_eff)
2101  WRITE(*,*) 'neoclassic_neowes(1)%te_neo%diff_eff ', &
2102  minval(neoclassic_neowes(1)%te_neo%diff_eff), &
2103  maxval(neoclassic_neowes(1)%te_neo%diff_eff)
2104  WRITE(*,*) 'neoclassic_neowes(1)%te_neo%vconv_eff ', &
2105  minval(neoclassic_neowes(1)%te_neo%vconv_eff), &
2106  maxval(neoclassic_neowes(1)%te_neo%vconv_eff)
2107  WRITE(*,*) 'coretransp_ITER(1)%values(1)%te_transp%diff_eff ', &
2108  minval(coretransp_iter(1)%values(1)%te_transp%diff_eff), &
2109  maxval(coretransp_iter(1)%values(1)%te_transp%diff_eff)
2110  WRITE(*,*) 'coretransp_ITER(1)%values(1)%te_transp%vconv_eff ', &
2111  minval(coretransp_iter(1)%values(1)%te_transp%vconv_eff), &
2112  maxval(coretransp_iter(1)%values(1)%te_transp%vconv_eff)
2113  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%ti_transp%diff_eff ', &
2114  minval(coretransp_etaigb(1)%values(1)%ti_transp%diff_eff), &
2115  maxval(coretransp_etaigb(1)%values(1)%ti_transp%diff_eff)
2116  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%ti_transp%vconv_eff ', &
2117  minval( coretransp_etaigb(1)%values(1)%ti_transp%vconv_eff), &
2118  maxval( coretransp_etaigb(1)%values(1)%ti_transp%vconv_eff)
2119  WRITE(*,*) 'neoclassic_neowes(1)%ti_neo%diff_eff ', &
2120  minval(neoclassic_neowes(1)%ti_neo%diff_eff), &
2121  maxval(neoclassic_neowes(1)%ti_neo%diff_eff)
2122  WRITE(*,*) 'neoclassic_neowes(1)%ti_neo%vconv_eff ', &
2123  minval(neoclassic_neowes(1)%ti_neo%vconv_eff), &
2124  maxval(neoclassic_neowes(1)%ti_neo%vconv_eff)
2125  WRITE(*,*) 'coretransp_ITER(1)%values(1)%ti_transp%diff_eff ', &
2126  minval(coretransp_iter(1)%values(1)%ti_transp%diff_eff), &
2127  maxval(coretransp_iter(1)%values(1)%ti_transp%diff_eff)
2128  WRITE(*,*) 'coretransp_ITER(1)%values(1)%ti_transp%vconv_eff ', &
2129  minval(coretransp_iter(1)%values(1)%ti_transp%vconv_eff), &
2130  maxval(coretransp_iter(1)%values(1)%ti_transp%vconv_eff)
2131  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%ni_transp%diff_eff ', &
2132  minval(coretransp_etaigb(1)%values(1)%ni_transp%diff_eff), &
2133  maxval(coretransp_etaigb(1)%values(1)%ni_transp%diff_eff)
2134  WRITE(*,*) 'coretransp_etaigb(1)%values(1)%ni_transp%vconv_eff ', &
2135  minval( coretransp_etaigb(1)%values(1)%ni_transp%vconv_eff), &
2136  maxval( coretransp_etaigb(1)%values(1)%ni_transp%vconv_eff)
2137  WRITE(*,*) 'neoclassic_neowes(1)%ni_neo%diff_eff ', &
2138  minval(neoclassic_neowes(1)%ni_neo%diff_eff), &
2139  maxval(neoclassic_neowes(1)%ni_neo%diff_eff)
2140  WRITE(*,*) 'neoclassic_neowes(1)%ni_neo%vconv_eff ', &
2141  minval(neoclassic_neowes(1)%ni_neo%vconv_eff), &
2142  maxval(neoclassic_neowes(1)%ni_neo%vconv_eff)
2143  WRITE(*,*) 'coretransp_NEOWES(1)%values(1)%ni_transp%diff_eff ', &
2144  minval(coretransp_neowes(1)%values(1)%ni_transp%diff_eff), &
2145  maxval(coretransp_neowes(1)%values(1)%ni_transp%diff_eff)
2146  WRITE(*,*) 'coretransp_NEOWES(1)%values(1)%ni_transp%vconv_eff ', &
2147  minval(coretransp_neowes(1)%values(1)%ni_transp%vconv_eff), &
2148  maxval(coretransp_neowes(1)%values(1)%ni_transp%vconv_eff)
2149  WRITE(*,*) 'coretransp_ITER(1)%values(1)%ni_transp%diff_eff ', &
2150  minval(coretransp_iter(1)%values(1)%ni_transp%diff_eff), &
2151  maxval(coretransp_iter(1)%values(1)%ni_transp%diff_eff)
2152  WRITE(*,*) 'coretransp_ITER(1)%values(1)%ni_transp%vconv_eff ', &
2153  minval(coretransp_iter(1)%values(1)%ni_transp%vconv_eff), &
2154  maxval(coretransp_iter(1)%values(1)%ni_transp%vconv_eff)
2155  WRITE(*,*) 'coretransp_ITER(1)%values(1)%vtor_transp%diff_eff ', &
2156  minval(coretransp_iter(1)%values(1)%vtor_transp%diff_eff), &
2157  maxval(coretransp_iter(1)%values(1)%vtor_transp%diff_eff)
2158  WRITE(*,*) 'coretransp_ITER(1)%values(1)%vtor_transp%vconv_eff ', &
2159  minval(coretransp_iter(1)%values(1)%vtor_transp%vconv_eff), &
2160  maxval(coretransp_iter(1)%values(1)%vtor_transp%vconv_eff)
2161 
2162  CALL euitm_deallocate(coretransp_etaigb)
2163  CALL euitm_deallocate(coretransp_neowes)
2164  CALL euitm_deallocate(neoclassic_neowes)
2165 
2166  RETURN
2167 
2168 END SUBROUTINE external_transport
convergence_check::check_convergence_neutrals
subroutine check_convergence_neutrals(CORENEUTRALS_ITER, CORENEUTRALS_NEW, CONV)
Convergence check neutrals This routine checks the convergence of plasma profiles.
Definition: convergence_check.f90:103
itm_test_routines::process_xml
subroutine process_xml(SOLVER_TYPE, SIGMA_SOURCE, TAU, AMIX, CONVREC, NRHO, NION, NIMP, NZIMP, NTIME, NSOL, PSI_BND_TYPE, NI_BND_TYPE, TI_BND_TYPE, TE_BND_TYPE, VTOR_BND_TYPE, shot_no, run_no, codeparam, database_format)
process the xml version of the input file from codeparam
Definition: itm_test_routines.f90:21
write_equilibrium
subroutine write_equilibrium(path, equilibrium_out)
Definition: write_equilibrium.f90:1
convert::convert_neoclassic2coresource
subroutine convert_neoclassic2coresource(NEOCLASSIC, CORESOURCE)
Definition: convert.f90:906
convert::changeradii
subroutine changeradii(EQUILIBRIUM, COREPROF, CORETRANSP, CORESOURCE, COREIMPUR, CORENEUTRALS, NEOCLASSIC)
Definition: convert.f90:1013
ets_wrapper_helena
wrapper for HELENA
Definition: ets_wrapper_helena.f90:8
equilibrium_input::equil_input
subroutine equil_input(COREPROF_IN, TOROIDFIELD_IN, EQUILIBRIUM_IN, EQUILIBRIUM_OUT)
Definition: equilibrium_input.f90:22
spitzer::spitzer_resistivity
subroutine spitzer_resistivity(COREPROF_IN, CORETRANSP_OUT)
Definition: spitzer.f90:7
itm_test_routines::write_out
subroutine write_out(ITIME, COREPROF_NEW, COREPROF_ANALYTIC)
This subroutine stores the results of computations into files.
Definition: itm_test_routines.f90:431
impurity
IMPURITY.
Definition: impurity.F90:8
convert
Module converts to/from CPOs to ETS types.
Definition: convert.f90:8
convergence_check::check_convergence
subroutine check_convergence(COREPROF_ITER, COREPROF_NEW, CONTROL_DOUBLE)
Convergence check This routine checks the convergence of plasma profiles.
Definition: convergence_check.f90:22
neutrals::writeoutneutrals
subroutine writeoutneutrals(ITIME_OUT, CORENEUTRALS)
Definition: neutrals.F90:1124
equilibrium_augmenter::augment_psi_rz
subroutine augment_psi_rz(equilibrium)
Definition: equilibrium_augmenter.f90:17
ets_start
Definition: ets_start.f90:3
ets::itm_ets
subroutine itm_ets(COREPROF_OLD, COREPROF_ITER, COREPROF_NEW, EQUILIBRIUM_OLD, EQUILIBRIUM_ITER, CORETRANSP, CORESOURCE, COREIMPUR, CONTROL_INTEGER, CONTROL_DOUBLE, code_parameters)
ETS.
Definition: ets.F90:25
fill_cpos
Definition: fill_cpos.f90:1
ets_species_module
Definition: ets_species_module.f90:1
equilibrium_tools::geometry_from_wf_parameters
subroutine geometry_from_wf_parameters(EQUILIBRIUM,EQUILIBRIUM_OUT,
Definition: equilibrium_tools.f90:30
impurity::impurity_ets
subroutine impurity_ets(EQUILIBRIUM_ITER, COREPROF_ITER, CORETRANSP_ITER, COREIMPUR_OLD, COREIMPUR_ITER, CORENEUTRALS_ITER, CORESOURCE_ITER, CORESOURCE_NEW, COREIMPUR_NEW, CONTROL_INTEGER, CONTROL_DOUBLE)
Definition: impurity.F90:16
fill_cpos::fillcoreimpur
subroutine fillcoreimpur(COREIMPUR_DB, COREIMPUR_GRID, COREIMPUR_OUT, INTERPOL)
Definition: fill_cpos.f90:1202
ets_wrapper_chease
wrapper for CHEASE
Definition: ets_wrapper_chease.f90:8
equilibrium_tools
Definition: equilibrium_tools.f90:1
plasma_composition
Definition: plasma_composition.f90:1
gausian_src
Definition: gausian_src.f90:1
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
synchrotron::synchrotron_radiation
subroutine synchrotron_radiation(COREPROF, CORESOURCE)
Definition: synchrotron.f90:9
equilibrium_input
EQUILIBRIUM_INPUT.
Definition: equilibrium_input.f90:13
ets_wrapper_emeq_e3m::emeq_e3m_wrapper
subroutine emeq_e3m_wrapper(EQUILIBRIUM_in, EQUILIBRIUM_out)
Definition: ets_wrapper_emeq_e3m.f90:15
itm_test_routines_etseq
Module provides routines for testing.
Definition: itm_test_routines_etseq.f90:8
ets_wrapper_bdseq
wrapper for BDSEQ
Definition: ets_wrapper_bdseq.f90:8
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
ets
Module provides the interface between (external) CPO and internal ETS derived types.
Definition: ets.F90:8
ets_wrapper_chease::chease_wrapper
subroutine chease_wrapper(euitm_equilibrium_in, euitm_equilibrium_out)
Definition: ets_wrapper_chease.f90:15
fill_cpos::fillcoreprof
subroutine fillcoreprof(COREPROF_DB, COREPROF_GRID, COREFAST_IN, COREPROF_OUT, INTERPOL)
Definition: fill_cpos.f90:7
equilibrium_augmenter
Augment an inverse equilibrium with psi, Br, Bz and Bphi as a function of R and Z.
Definition: equilibrium_augmenter.f90:8
ets_wrapper_helena::helena_wrapper
subroutine helena_wrapper(euitm_equilibrium_in, euitm_equilibrium_out)
Definition: ets_wrapper_helena.f90:15
transport_combiner::combine_transport
subroutine combine_transport(COREPROF, CORETRANSP, CORETRANSP1, CORETRANSP2, CORETRANSP3, CORETRANSP4, CORETRANSP5, CORETRANSP_OUT, AMIX_TR, code_parameters)
Definition: transport_combiner.f90:26
convert::convert_neoclassic2coretransp
subroutine convert_neoclassic2coretransp(NEOCLASSIC, CORETRANSP)
Definition: convert.f90:676
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
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
external_transport
subroutine external_transport(EQUILIBRIUM_ITER, COREPROF_ITER, CORETRANSP_ITER, add_transport)
Definition: ets_workflow.F90:1966
ets_wrapper_emeq_e3m
wrapper for EMEQ
Definition: ets_wrapper_emeq_e3m.f90:8
fill_cpos::fillcoretransp
subroutine fillcoretransp(CORETRANSP_DB, CORETRANSP_GRID, CORETRANSP_OUT, INTERPOL)
Definition: fill_cpos.f90:768
profile
real(r8) function, dimension(1:size(x)) profile(function_string, x)
Definition: ets_workflow.F90:1934
source_combiner
Definition: source_combiner.f90:1
fill_cpos::fillequilibrium
subroutine fillequilibrium(EQUILIBRIUM_DB, EQUILIBRIUM_GRID, EQUILIBRIUM_OUT, INTERPOL)
Definition: fill_cpos.f90:1383
impurity::writeoutimpur
subroutine writeoutimpur(ITIME_OUT, COREIMPUR)
Definition: impurity.F90:977
ets_wrapper_neowes::neowes_wrapper
subroutine neowes_wrapper(eq, coreprof, neoclassic)
Definition: ets_wrapper_neowes.f90:15
transport_combiner
Definition: transport_combiner.f90:1
neutrals::neutrals_ets
subroutine neutrals_ets(COREIMPUR_ITER, EQUILIBRIUM_ITER, COREPROF_ITER, CORENEUTRALS_OLD, CORENEUTRALS_ITER, CORESOURCE_NEW, CORENEUTRALS_NEW, CONTROL_INTEGER, CONTROL_DOUBLE)
Definition: neutrals.F90:12
ets_version
Definition: ets_version.f90:1
ets_start::etsstart
subroutine etsstart
Definition: ets_start.f90:9
equilibrium_start
EQUILIBRIUM_START.
Definition: equilibrium_start.F90:11
ets_wrapper_etaigb
wrapper for ETAIGB
Definition: ets_wrapper_etaigb.f90:8
bdseq_wrapper
program bdseq_wrapper
Definition: wrapper.F90:208
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
ets_plasma
The module declares types of variables used in ETS (transport code)
Definition: ets_plasma.f90:8
coronal::set_coronal
subroutine set_coronal(COREIMPUR_IN, COREPROF_IN, COREIMPUR_OUT, INTERPOL, ICORONAL)
Definition: coronal.f90:6
ets_wrapper_etaigb::etaigb_wrapper
subroutine etaigb_wrapper(eq, coreprof, coretransp)
Definition: ets_wrapper_etaigb.f90:15
evolution
subroutine evolution(T, R_in, R_out, El, Tr_l, Tr_U, Ip)
Definition: ets_workflow.F90:1871
gbtransport::gb_transport
subroutine gb_transport(EQUILIBRIUM, COREPROF, CORETRANSP)
Definition: gbtransport.f90:11
convergence_check::check_convergence_impurities
subroutine check_convergence_impurities(COREIMPUR_ITER, COREIMPUR_NEW, CONV)
Convergence check impurities This routine checks the convergence of plasma profiles.
Definition: convergence_check.f90:176
ets_workflow
program ets_workflow
Framework for testing workflows built around the ETS.
Definition: ets_workflow.F90:27
convergence_check
Module provides the convergence check for the ETS.
Definition: convergence_check.f90:8
ets_wrapper_neowes
wrapper for NEOWES
Definition: ets_wrapper_neowes.f90:8
gausian_src::gausian_sources
subroutine gausian_sources(COREPROF, EQUILIBRIUM, CORESOURCE, code_parameters)
Definition: gausian_src.f90:8
euitm_close
subroutine euitm_close(idx)
Definition: euitm_dummies.f90:9
source_combiner::combine_sources
subroutine combine_sources(COREPROF, CORESOURCE, CORESOURCE1, CORESOURCE2, CORESOURCE3, CORESOURCE4, CORESOURCE5, CORESOURCE6, CORESOURCE7, CORESOURCE_OUT, AMIX_SRC, code_parameters)
Definition: source_combiner.f90:22
equilibrium_start::start_profiles_consistency
subroutine start_profiles_consistency(PROF_FLAG, J0_FLAG, Q0_FLAG, EXT_EQUIL, COREPROF_IN, EQUILIBRIUM_IN, TOROIDFIELD_IN, COREPROF_OUT, EQUILIBRIUM_OUT)
Definition: equilibrium_start.F90:20
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