ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
fc2k_equilibrium2coreprof.f90
Go to the documentation of this file.
1 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
2 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
3  SUBROUTINE equilibrium2coreprof (EQUILIBRIUM, COREPROF, &
4  code_parameters)
5  !-------------------------------------------------------!
6  ! This routine updates profiles and boundary !
7  ! conditions in coreprof from most recent !
8  ! equilibrium uptained from FBE code. !
9  !-------------------------------------------------------!
10  ! Source: --- !
11  ! Developers: D.Kalupin !
12  ! Contacts: Denis.Kalupin@euro-fusion.org !
13  ! !
14  ! Comments: created for ETS - FBE coupling !
15  ! !
16  !-------------------------------------------------------!
17 
18 ! +++ Declaration of variables:
19  USE euitm_schemas
20  USE itm_constants
21 
22  IMPLICIT NONE
23 
24 ! +++ CPO derived types:
25  TYPE (type_equilibrium), POINTER :: equilibrium(:) !input CPO
26  TYPE (type_coreprof), POINTER :: coreprof(:) !input/output CPO
27 
28 ! +++ XML code parameters:
29  TYPE (type_param) :: code_parameters
30  INTEGER :: return_status
31 
32 ! +++ Local control parameters:
33  LOGICAL :: active_mode
34  LOGICAL :: update_profiles
35  INTEGER :: bc_type
36 
37  INTEGER :: nrho, npsi
38  REAL(R8) :: ip_star
39 
40 ! +++ Initial control settings:
41  active_mode = .false.
42  update_profiles = .false.
43  bc_type = 0
44 
45 
46  CALL assign_code_parameters(code_parameters, return_status)
47 
48  update_quantities_from_equilibrium: IF (active_mode) THEN
49  nrho = SIZE(coreprof(1)%rho_tor)
50  npsi = SIZE(equilibrium(1)%profiles_1d%psi)
51 
52  !correct RHO
53  coreprof(1)%rho_tor = coreprof(1)%rho_tor_norm * equilibrium(1)%profiles_1d%rho_tor(npsi)
54 
55  !calculate IP*
56  ip_star = equilibrium(1)%global_param%i_plasma * (1.0_r8 + &
57  (coreprof(1)%psi%value(nrho)-equilibrium(1)%profiles_1d%psi(npsi)) / &
58  (equilibrium(1)%profiles_1d%psi(1)-equilibrium(1)%profiles_1d%psi(npsi)))
59 
60  !correct PSI
61  CALL l3interp(equilibrium(1)%profiles_1d%psi, equilibrium(1)%profiles_1d%rho_tor, npsi, &
62  coreprof(1)%psi%value, coreprof(1)%rho_tor, nrho)
63 
64  update_other_profiles: IF (update_profiles) THEN
65  !correct Q
66  CALL l3interp(equilibrium(1)%profiles_1d%q, equilibrium(1)%profiles_1d%rho_tor, npsi, &
67  coreprof(1)%profiles1d%q%value, coreprof(1)%rho_tor, nrho)
68  !correct Curr_Par
69  CALL l3interp(equilibrium(1)%profiles_1d%jparallel, equilibrium(1)%profiles_1d%rho_tor, npsi, &
70  coreprof(1)%profiles1d%jtot%value, coreprof(1)%rho_tor, nrho)
71 
72  coreprof(1)%globalparam%current_tot = ip_star
73  coreprof(1)%globalparam%current_bnd = ip_star
74 
75 
76  END IF update_other_profiles
77 
78  update_boundary_conditions_fixed_psi: IF (bc_type.EQ.1) THEN
79  coreprof(1)%psi%boundary%type = 1
80  coreprof(1)%psi%boundary%value(1) = equilibrium(1)%profiles_1d%psi(npsi)
81  coreprof(1)%psi%boundary%value(2) = 0.0_r8
82  coreprof(1)%psi%boundary%value(3) = 0.0_r8
83 
84  END IF update_boundary_conditions_fixed_psi
85 
86  update_boundary_conditions_total_current: IF (bc_type.EQ.2) THEN
87  coreprof(1)%psi%boundary%type = 2
88  coreprof(1)%psi%boundary%value(1) = ip_star
89  coreprof(1)%psi%boundary%value(2) = 0.0_r8
90  coreprof(1)%psi%boundary%value(3) = 0.0_r8
91  END IF update_boundary_conditions_total_current
92 
93  update_boundary_conditions_loop_voltage: IF (bc_type.EQ.3) THEN
94  WRITE(*,*) "NOT ACTIVE PLACE HOLDER"
95  END IF update_boundary_conditions_loop_voltage
96 
97  update_boundary_conditions_generic: IF (bc_type.EQ.4) THEN
98  WRITE(*,*) "NOT ACTIVE PLACE HOLDER"
99  END IF update_boundary_conditions_generic
100 
101  END IF update_quantities_from_equilibrium
102 
103  RETURN
104 
105  CONTAINS
106 
107 
108 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
109 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
110  SUBROUTINE assign_code_parameters(codeparameters, return_status)
111 
112  !-------------------------------------------------------!
113  ! This subroutine calls the XML parser for !
114  ! the combiner parameters and assign the !
115  ! resulting values to the corresponding variables !
116  !-------------------------------------------------------!
117  ! Source: --- !
118  ! Developers: D.Kalupin !
119  ! Kontacts: Denis.Kalupin@efda.org !
120  ! !
121  ! Comments: created for V&V between ETS and !
122  ! ASTRA !
123  ! !
124  !-------------------------------------------------------!
125 
126  USE itm_types
127  USE euitm_schemas
128  USE euitm_xml_parser
129 
130  IMPLICIT NONE
131 
132 
133  TYPE(type_param) :: codeparameters
134  INTEGER(ITM_I4) :: return_status
135 
136  CHARACTER(len = 132) :: parameter_name
137  CHARACTER(len = 132) :: parameter_value
138  TYPE(element), POINTER :: temp_pointer
139  TYPE(tree) :: parameter_list
140  INTEGER(ITM_I4) :: nparam
141 
142 
143  return_status = 0
144 
145 ! parse xml-string codeparameters%parameters
146  CALL euitm_xml_parse(codeparameters, nparam, parameter_list)
147 
148  parameter_value = ''
149  parameter_name = 'parameters/ACTIVE/ACTIVE_MODE'
150  temp_pointer => parameter_list%first
151  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
152  IF (len(trim(parameter_value)).GT.0) THEN
153  active_mode = .true.
154  END IF
155 
156 
157  parameter_value = ''
158  parameter_name = 'parameters/ACTIVE/IMPORT_PROFILES/IMPORT'
159  temp_pointer => parameter_list%first
160  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
161  IF (len(trim(parameter_value)).GE.3) &
162  CALL char2bool(str2char(parameter_value), update_profiles)
163 
164 
165  parameter_value = ''
166  parameter_name = 'parameters/ACTIVE/IMPORT_BOUNDARY_CONDITIONS/YES/CHOOSE_BC_TYPE/fixed_PSI/BC_psi'
167  temp_pointer => parameter_list%first
168  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
169  IF (len(trim(parameter_value)).GT.0) THEN
170  bc_type = 1
171  END IF
172 
173  parameter_value = ''
174  parameter_name = 'parameters/ACTIVE/IMPORT_BOUNDARY_CONDITIONS/YES/CHOOSE_BC_TYPE/Total_Current/BC_current'
175  temp_pointer => parameter_list%first
176  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
177  IF (len(trim(parameter_value)).GT.0) THEN
178  bc_type = 2
179  END IF
180 
181  parameter_value = ''
182  parameter_name = 'parameters/ACTIVE/IMPORT_BOUNDARY_CONDITIONS/YES/CHOOSE_BC_TYPE/Loop_Voltage/BC_voltage'
183  temp_pointer => parameter_list%first
184  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
185  IF (len(trim(parameter_value)).GT.0) THEN
186  bc_type = 3
187  END IF
188 
189  parameter_value = ''
190  parameter_name = 'parameters/ACTIVE/IMPORT_BOUNDARY_CONDITIONS/YES/CHOOSE_BC_TYPE/Generic/BC_generic'
191  temp_pointer => parameter_list%first
192  CALL find_parameter(parameter_name, parameter_value, temp_pointer)
193  IF (len(trim(parameter_value)).GT.0) THEN
194  bc_type = 4
195  END IF
196 
197 
198  RETURN
199 
200  END SUBROUTINE assign_code_parameters
201 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
202 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
203 
204 
205 
206  END SUBROUTINE equilibrium2coreprof
207 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
208 ! + + + + + + + + + + + + + + + + + + + + + + + + + + + +
209 
210 
211 
assign_code_parameters
subroutine assign_code_parameters(codeparameters, return_status)
Definition: emeq.f90:671
equilibrium2coreprof
subroutine equilibrium2coreprof(EQUILIBRIUM, COREPROF, code_parameters)
Definition: fc2k_equilibrium2coreprof.f90:3
l3interp
subroutine l3interp(y_in, x_in, nr_in, y_out, x_out, nr_out)
Definition: l3interp.f90:1