Octopus
propagator_mxll.F90
Go to the documentation of this file.
1!! Copyright (C) 2019 R. Jestaedt, F. Bonafe, H. Appel
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17
18#include "global.h"
19
21 use accel_oct_m
23 use batch_oct_m
24 use comm_oct_m
26 use cube_oct_m
34 use fft_oct_m
36 use grid_oct_m
37 use global_oct_m
41 use index_oct_m
42 use io_oct_m
47 use math_oct_m
50 use mesh_oct_m
55 use mpi_oct_m
57 use output_oct_m
58 use parser_oct_m
63 use space_oct_m
66 use string_oct_m
69
70 implicit none
71
72 private
73 public :: &
92
93 ! The following routines are currently unused, but will be used in the near future.
94 ! In order not to generate warnings about them, we declared them as public
95 public :: &
99
101 logical :: bc_add_ab_region = .false.
102 logical :: bc_zero = .false.
103 logical :: bc_constant = .false.
104 logical :: bc_mirror_pec = .false.
105 logical :: bc_mirror_pmc = .false.
106 logical :: bc_plane_waves = .false.
107 logical :: bc_medium = .false.
108 type(exponential_t) :: te
109 logical :: plane_waves_in_box
110 integer :: tr_etrs_approx
111 end type propagator_mxll_t
112
113 integer, public, parameter :: &
114 RS_TRANS_FORWARD = 1, &
116
117 integer, parameter :: &
118 MXWLL_ETRS_FULL = 0, &
120
121contains
122
123 ! ---------------------------------------------------------
124 subroutine propagator_mxll_init(gr, namespace, st, hm, tr)
125 type(grid_t), intent(in) :: gr
126 type(namespace_t), intent(in) :: namespace
127 type(states_mxll_t), intent(inout) :: st
128 type(hamiltonian_mxll_t), intent(inout) :: hm
129 type(propagator_mxll_t), intent(inout) :: tr
130
131 integer :: idim
132
133 push_sub(propagator_mxll_init)
134
135 call profiling_in("PROPAGATOR_MXLL_INIT")
136
137 do idim = 1, 3
138 select case (hm%bc%bc_type(idim))
139 case (mxll_bc_zero)
140 hm%bc_zero = .true.
141 tr%bc_zero = .true.
142 case (mxll_bc_constant)
143 tr%bc_constant = .true.
144 tr%bc_add_ab_region = .true.
145 hm%bc_constant = .true.
146 hm%bc_add_ab_region = .true.
147 case (mxll_bc_mirror_pec)
148 tr%bc_mirror_pec = .true.
149 hm%bc_mirror_pec = .true.
150 case (mxll_bc_mirror_pmc)
151 tr%bc_mirror_pmc = .true.
152 hm%bc_mirror_pmc = .true.
154 tr%bc_plane_waves = .true.
155 tr%bc_add_ab_region = .true.
156 hm%plane_waves = .true.
157 hm%bc_plane_waves = .true.
158 hm%bc_add_ab_region = .true.
159 end select
160 end do
161
162 if (any(hm%bc%bc_type(1:3) == mxll_bc_constant)) then
163 call td_function_mxll_init(st, namespace, hm)
164 safe_allocate(st%rs_state_const(1:st%dim))
165 st%rs_state_const = m_z0
166 end if
167
168 !%Variable MaxwellTDETRSApprox
169 !%Type integer
170 !%Default no
171 !%Section Maxwell::TD Propagation
172 !%Description
173 !% Whether to perform approximations to the ETRS propagator.
174 !%Option no 0
175 !% No approximations.
176 !%Option const_steps 1
177 !% Use constant current density.
178 !%End
179 call parse_variable(namespace, 'MaxwellTDETRSApprox', mxwll_etrs_full, tr%tr_etrs_approx)
180
181 !%Variable MaxwellPlaneWavesInBox
182 !%Type logical
183 !%Default no
184 !%Section Maxwell
185 !%Description
186 !% Analytic evaluation of the incoming waves inside the box,
187 !% not doing any numerical propagation of Maxwells equations.
188 !%End
189 call parse_variable(namespace, 'MaxwellPlaneWavesInBox', .false., tr%plane_waves_in_box)
190 if (tr%plane_waves_in_box .and. .not. hm%bc%do_plane_waves) then
191 call external_waves_init(hm%bc%plane_wave, namespace)
192 end if
193
194 call messages_print_with_emphasis(namespace=namespace)
196 !tr%te%exp = .true.
197 call exponential_init(tr%te, namespace, full_batch=.true.) ! initialize Maxwell propagator
199 call profiling_out("PROPAGATOR_MXLL_INIT")
202 end subroutine propagator_mxll_init
204 ! ---------------------------------------------------------
205 subroutine mxll_propagation_step(hm, namespace, gr, space, st, tr, rs_stateb, ff_rs_inhom_t1, ff_rs_inhom_t2, time, dt)
206 type(hamiltonian_mxll_t), intent(inout) :: hm
207 type(namespace_t), intent(in) :: namespace
208 type(grid_t), intent(inout) :: gr
209 class(space_t), intent(in) :: space
210 type(states_mxll_t), intent(inout) :: st
211 type(propagator_mxll_t), intent(inout) :: tr
212 type(batch_t), intent(inout) :: rs_stateb
213 complex(real64), contiguous, intent(in) :: ff_rs_inhom_t1(:,:)
214 complex(real64), contiguous, intent(in) :: ff_rs_inhom_t2(:,:)
215 real(real64), intent(in) :: time
216 real(real64), intent(in) :: dt
217
218 integer :: ii, ff_dim, idim, istate, inter_steps
219 real(real64) :: inter_dt, inter_time
220
221
222 logical :: pml_check
223 type(batch_t) :: ff_rs_stateb, ff_rs_state_pmlb
224 type(batch_t) :: ff_rs_inhom_1b, ff_rs_inhom_2b, ff_rs_inhom_meanb
225 complex(real64), allocatable :: rs_state(:, :)
226
227 push_sub(mxll_propagation_step)
228
229 call profiling_in('MXLL_PROPAGATOR_STEP')
230 pml_check = .false.
231
232 if (hm%ma_mx_coupling_apply) then
233 message(1) = "Maxwell-matter coupling not implemented yet"
234 call messages_fatal(1, namespace=namespace)
235 end if
236 safe_allocate(rs_state(gr%np, st%dim))
237
238 if (tr%plane_waves_in_box) then
239 rs_state = m_z0
240 call plane_waves_in_box_calculation(hm%bc, time+dt, gr, gr%der, st, rs_state)
241 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
242 safe_deallocate_a(rs_state)
243 pop_sub(mxll_propagation_step)
244 return
245 end if
246
247 do idim = 1, 3
248 if (hm%bc%bc_ab_type(idim) == option__maxwellabsorbingboundaries__cpml) then
249 pml_check = .true.
250 end if
251 end do
252
253 ! this must be called only once, but can not be placed in init routines because PML parameters need to know about dt
254 if (pml_check .and. .not. hm%bc%pml%parameters_initialized) &
255 call bc_mxll_generate_pml_parameters(hm%bc, space, gr, hm%c_factor, dt)
256
257 ff_dim = hm%dim
258
259 ! intermediate step variables
260 inter_steps = 1
261 inter_dt = m_one / inter_steps * dt
262
263 call zbatch_init(ff_rs_stateb, 1, 1, hm%dim, gr%np_part)
264 if (st%pack_states) call ff_rs_stateb%do_pack(copy=.false.)
265
266 if (pml_check) then
267 call ff_rs_stateb%copy_to(ff_rs_state_pmlb)
268 end if
269
270 ! first step of Maxwell inhomogeneity propagation with constant current density
271 if ((hm%ma_mx_coupling_apply .or. hm%current_density_ext_flag .or. hm%current_density_from_medium) .and. &
272 tr%tr_etrs_approx == mxwll_etrs_const) then
273 call ff_rs_stateb%copy_to(ff_rs_inhom_1b)
274 call ff_rs_stateb%copy_to(ff_rs_inhom_2b)
275 call ff_rs_stateb%copy_to(ff_rs_inhom_meanb)
276
277 do istate = 1, hm%dim
278 call batch_set_state(ff_rs_inhom_meanb, istate, gr%np, ff_rs_inhom_t1(:, istate))
279 call batch_set_state(ff_rs_inhom_2b, istate, gr%np, ff_rs_inhom_t2(:, istate))
280 end do
281 call batch_axpy(gr%np, m_one, ff_rs_inhom_2b, ff_rs_inhom_meanb)
282 call batch_scal(gr%np, m_half, ff_rs_inhom_meanb)
283
284 ! inhomogeneity propagation
285 call ff_rs_inhom_meanb%copy_data_to(gr%np, ff_rs_inhom_1b)
286 call ff_rs_inhom_meanb%copy_data_to(gr%np, ff_rs_inhom_2b)
287
288 call hamiltonian_mxll_update(hm, time=time)
289 hm%cpml_hamiltonian = .false.
290 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_2b, inter_dt)
291
292 ! add term U(time+dt,time)J(time)
293 call batch_axpy(gr%np, m_one, ff_rs_inhom_2b, ff_rs_inhom_1b)
294 call ff_rs_inhom_meanb%copy_data_to(gr%np, ff_rs_inhom_2b)
295 call hamiltonian_mxll_update(hm, time=time)
296 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_2b, inter_dt*m_half)
297 ! add term U(time+dt/2,time)J(time)
298 call batch_axpy(gr%np, m_one, ff_rs_inhom_2b, ff_rs_inhom_1b)
299 call ff_rs_inhom_meanb%copy_data_to(gr%np, ff_rs_inhom_2b)
300 call hamiltonian_mxll_update(hm, time=time)
301 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_2b, -inter_dt*m_half)
302 ! add term U(time,time+dt/2)J(time)
303 call batch_axpy(gr%np, m_one, ff_rs_inhom_2b, ff_rs_inhom_1b)
304 call ff_rs_inhom_2b%end()
305 call ff_rs_inhom_meanb%end()
306 end if
307
308 do ii = 1, inter_steps
309
310 ! intermediate time
311 inter_time = time + inter_dt * (ii-1)
312
313 ! transformation of RS state into 3x3 or 4x4 representation
314 call transform_rs_state_batch(hm, gr, st, rs_stateb, ff_rs_stateb, rs_trans_forward)
315
316 ! RS state propagation
317 call hamiltonian_mxll_update(hm, time=inter_time)
318 if (pml_check) then
319 call pml_propagation_stage_1_batch(hm, gr, st, tr, ff_rs_stateb, ff_rs_state_pmlb)
320 end if
321
322 hm%cpml_hamiltonian = pml_check
323 call tr%te%apply_batch(namespace, gr, hm, ff_rs_stateb, dt)
324 hm%cpml_hamiltonian = .false.
325
326 if (pml_check) then
327 call pml_propagation_stage_2_batch(hm, namespace, gr, st, tr, inter_time, inter_dt, m_zero, ff_rs_state_pmlb, ff_rs_stateb)
328 end if
329
330 !Below we add the contribution from the inhomogeneous terms
331 if ((hm%ma_mx_coupling_apply) .or. hm%current_density_ext_flag .or. hm%current_density_from_medium) then
332 if (tr%tr_etrs_approx == mxwll_etrs_full) then
333 call ff_rs_stateb%copy_to(ff_rs_inhom_1b)
334 call ff_rs_stateb%copy_to(ff_rs_inhom_2b)
335 call ff_rs_stateb%copy_to(ff_rs_inhom_meanb)
336
337 ! Interpolation of the external current
338 do istate = 1, hm%dim
339 call batch_set_state(ff_rs_inhom_meanb, istate, gr%np, ff_rs_inhom_t2(:, istate))
340 call batch_set_state(ff_rs_inhom_1b, istate, gr%np, ff_rs_inhom_t1(:, istate))
341 end do
342 ! store t1 - t2 for the interpolation in mean
343 call batch_axpy(gr%np, -m_one, ff_rs_inhom_1b, ff_rs_inhom_meanb)
344 call ff_rs_inhom_1b%copy_data_to(gr%np, ff_rs_inhom_2b)
345 call batch_axpy(gr%np, ii / real(inter_steps, real64) , ff_rs_inhom_meanb, ff_rs_inhom_2b)
346 call batch_axpy(gr%np, (ii-1) / real(inter_steps, real64) , ff_rs_inhom_meanb, ff_rs_inhom_1b)
347
348 hm%cpml_hamiltonian = .false.
349 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_1b, inter_dt)
350 ! add terms U(time+dt,time)J(time) and J(time+dt)
351 call batch_axpy(gr%np, -m_fourth * inter_dt, ff_rs_inhom_1b, ff_rs_stateb)
352 call batch_axpy(gr%np, -m_fourth * inter_dt, ff_rs_inhom_2b, ff_rs_stateb)
353
354 do istate = 1, hm%dim
355 call batch_set_state(ff_rs_inhom_1b, istate, gr%np, ff_rs_inhom_t1(:, istate))
356 call batch_set_state(ff_rs_inhom_2b, istate, gr%np, ff_rs_inhom_t2(:, istate))
357 end do
358 call batch_axpy(gr%np, m_one, ff_rs_inhom_2b, ff_rs_inhom_1b)
359 call batch_scal(gr%np, m_half, ff_rs_inhom_1b)
360 call ff_rs_inhom_1b%copy_data_to(gr%np, ff_rs_inhom_2b)
361
362 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_1b, inter_dt/m_two)
363 call tr%te%apply_batch(namespace, gr, hm, ff_rs_inhom_2b, -inter_dt/m_two)
364
365 ! add terms U(time+dt/2,time)J(time) and U(time,time+dt/2)J(time+dt)
366 call batch_axpy(gr%np, -m_fourth * inter_dt, ff_rs_inhom_1b, ff_rs_stateb)
367 call batch_axpy(gr%np, -m_fourth * inter_dt, ff_rs_inhom_2b, ff_rs_stateb)
368
369 call ff_rs_inhom_1b%end()
370 call ff_rs_inhom_2b%end()
371 call ff_rs_inhom_meanb%end()
372 else if (tr%tr_etrs_approx == mxwll_etrs_const) then
373 call batch_axpy(gr%np, -m_fourth * inter_dt, ff_rs_inhom_1b, ff_rs_stateb)
374 end if
375 end if
376
377 ! PML convolution function update
378 if (pml_check) then
379 call cpml_conv_function_update(hm, gr, ff_rs_state_pmlb)
380 end if
381
382 ! back transformation of RS state representation
383 call transform_rs_state_batch(hm, gr, st, rs_stateb, ff_rs_stateb, rs_trans_backward)
384
385 if (tr%bc_constant) then
386 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
387 ! Propagation dt with H(inter_time+inter_dt) for constant boundaries
388 if (st%rs_state_const_external) then
389 call spatial_constant_calculation(tr%bc_constant, st, gr, hm, inter_time, inter_dt, m_zero, rs_state)
390 end if
391 call constant_boundaries_calculation(tr%bc_constant, hm%bc, hm, st, rs_state)
392 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
393 end if
394
395 ! Propagation dt with H(inter_time+inter_dt) for PEC mirror boundaries
396 if (any(hm%bc%bc_type == mxll_bc_mirror_pec)) then
397 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
398 call mirror_pec_boundaries_calculation(hm%bc, st, rs_state)
399 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
400 end if
401
402 ! Propagation dt with H(inter_time+inter_dt) for PMC mirror boundaries
403 if (any(hm%bc%bc_type == mxll_bc_mirror_pmc)) then
404 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
405 call mirror_pmc_boundaries_calculation(hm%bc, st, rs_state)
406 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
407 end if
408
409 ! Apply mask absorbing boundaries
410 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__mask)) then
411 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
412 call mask_absorbing_boundaries(namespace, gr, hm, st, tr, inter_time, inter_dt, m_zero, rs_state)
413 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
414 end if
415
416 if (tr%bc_plane_waves) then
417 ! Propagation dt with H(inter_time+inter_dt) for plane waves boundaries
418 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
419 call plane_waves_boundaries_calculation(hm, st, gr, inter_time+inter_dt, m_zero, rs_state)
420 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
421 end if
422
423 end do
424
425 if (tr%tr_etrs_approx == option__maxwelltdetrsapprox__const_steps) then
426 call ff_rs_inhom_1b%end()
427 end if
428
429 call ff_rs_stateb%end()
430
431 if (pml_check) then
432 call ff_rs_state_pmlb%end()
433 end if
434
435 safe_deallocate_a(rs_state)
436
437 call profiling_out('MXLL_PROPAGATOR_STEP')
438
439 pop_sub(mxll_propagation_step)
440 end subroutine mxll_propagation_step
441
442 ! ---------------------------------------------------------
443 subroutine mxll_propagate_leapfrog(hm, namespace, gr, st, tr, time, dt, counter)
444 type(hamiltonian_mxll_t), intent(inout) :: hm
445 type(namespace_t), intent(in) :: namespace
446 type(grid_t), intent(inout) :: gr
447 type(states_mxll_t), intent(inout) :: st
448 type(propagator_mxll_t), intent(inout) :: tr
449 real(real64), intent(in) :: time
450 real(real64), intent(in) :: dt
451 integer, intent(in) :: counter
452
453 type(batch_t) :: rs_state_tmpb
454
455 push_sub_with_profile(mxll_propagate_leapfrog)
456
457 call st%rs_stateb%copy_to(rs_state_tmpb)
458
459 call hamiltonian_mxll_update(hm, time)
460
461 ! do boundaries at the beginning
462 call mxll_apply_boundaries(tr, st, hm, gr, namespace, time, dt, st%rs_stateb)
463
464 ! update PML convolution values
465 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
466 call mxll_update_pml_simple(hm, st%rs_stateb)
467 end if
468
469 ! apply hamiltonian
470 call hamiltonian_mxll_apply_simple(hm, namespace, gr, st%rs_stateb, rs_state_tmpb)
471 call batch_scal(gr%np, -m_zi, rs_state_tmpb)
472
473 ! add inhomogeneous terms
474 call batch_xpay(gr%np, st%inhomogeneousb, m_one, rs_state_tmpb)
475
476 if (counter == 0) then
477 ! for the first step, we do one forward Euler step
478 call batch_xpay(gr%np, st%rs_stateb, dt, rs_state_tmpb)
479 else
480 ! the leapfrog step depends on the previous state
481 call batch_xpay(gr%np, st%rs_state_prevb, m_two*dt, rs_state_tmpb)
482 end if
483
484 ! save the current rs state
485 call st%rs_stateb%copy_data_to(gr%np, st%rs_state_prevb)
486 ! update to new timestep
487 call rs_state_tmpb%copy_data_to(gr%np, st%rs_stateb)
488
489 ! update PML convolution values
490 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
491 call mxll_copy_pml_simple(hm, st%rs_stateb)
492 end if
493
494 call rs_state_tmpb%end()
495
496 pop_sub_with_profile(mxll_propagate_leapfrog)
497 end subroutine mxll_propagate_leapfrog
498
499 ! ---------------------------------------------------------
513 subroutine mxll_propagate_expgauss1(hm, namespace, gr, st, tr, time, dt)
514 type(hamiltonian_mxll_t), intent(inout) :: hm
515 type(namespace_t), intent(in) :: namespace
516 type(grid_t), intent(inout) :: gr
517 type(states_mxll_t), intent(inout) :: st
518 type(propagator_mxll_t), intent(inout) :: tr
519 real(real64), intent(in) :: time
520 real(real64), intent(in) :: dt
521
522 type(batch_t) :: rs_state_tmpb
523
524 push_sub_with_profile(mxll_propagate_expgauss1)
525
526 call st%rs_stateb%copy_to(rs_state_tmpb)
527
528 call hamiltonian_mxll_update(hm, time)
529
530 ! do boundaries at the beginning (should be included in Hamiltonian?)
531 call mxll_apply_boundaries(tr, st, hm, gr, namespace, time, &
532 dt, st%rs_stateb)
533
534 ! update PML convolution values
535 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
536 call mxll_update_pml_simple(hm, st%rs_stateb)
537 end if
539 ! accumulate -i H F_n - J_1 in rs_state_tmpb
540 ! compute H F_n
541 call hm%zapply(namespace, gr, st%rs_stateb, rs_state_tmpb)
542 ! compute -i H F_n
543 call batch_scal(gr%np, -m_zi, rs_state_tmpb)
544 if (hm%current_density_ext_flag .or. hm%current_density_from_medium) then
545 ! set J_1
546 call mxll_set_batch(st%inhomogeneousb, st%rs_current_density_t1, gr%np, st%dim)
547 ! accumulate -J_1 to rs_state_tmpb
548 call batch_axpy(gr%np, -m_one, st%inhomogeneousb, rs_state_tmpb)
549 end if
550 ! compute phi_1
551 call tr%te%apply_phi_batch(namespace, gr, hm, rs_state_tmpb, dt, 1)
552 ! F_{n+1} = F_n + dt * phi_1 (...)
553 call batch_axpy(gr%np, dt, rs_state_tmpb, st%rs_stateb)
554
555 call rs_state_tmpb%end()
556
557 ! update PML convolution values
558 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
559 call mxll_copy_pml_simple(hm, st%rs_stateb)
560 end if
561
562 pop_sub_with_profile(mxll_propagate_expgauss1)
563 end subroutine mxll_propagate_expgauss1
564
565 ! ---------------------------------------------------------
585 subroutine mxll_propagate_expgauss2(hm, namespace, gr, st, tr, time, dt)
586 type(hamiltonian_mxll_t), intent(inout) :: hm
587 type(namespace_t), intent(in) :: namespace
588 type(grid_t), intent(inout) :: gr
589 type(states_mxll_t), intent(inout) :: st
590 type(propagator_mxll_t), intent(inout) :: tr
591 real(real64), intent(in) :: time
592 real(real64), intent(in) :: dt
593
594 type(batch_t) :: rs_state_tmpb
595
596 push_sub_with_profile(mxll_propagate_expgauss2)
597
598 call st%rs_stateb%copy_to(rs_state_tmpb)
599
600 call hamiltonian_mxll_update(hm, time)
601
602 ! do boundaries at the beginning (should be included in Hamiltonian?)
603 call mxll_apply_boundaries(tr, st, hm, gr, namespace, time, &
604 dt, st%rs_stateb)
605
606 ! update PML convolution values
607 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
608 call mxll_update_pml_simple(hm, st%rs_stateb)
609 end if
610
611 ! accumulate -i H F_n - a_1 J_1 - a_2 J_2 in rs_state_tmpb
612 ! compute H F_n
613 call hm%zapply(namespace, gr, st%rs_stateb, rs_state_tmpb)
614 ! compute -i H F_n
615 call batch_scal(gr%np, -m_zi, rs_state_tmpb)
616 if (hm%current_density_ext_flag .or. hm%current_density_from_medium) then
617 ! set J_1
618 call mxll_set_batch(st%inhomogeneousb, st%rs_current_density_t1, gr%np, st%dim)
619 ! accumulate -a_1 J_1 to rs_state_tmpb
620 call batch_axpy(gr%np, -m_half*(m_one+sqrt(m_three)), st%inhomogeneousb, rs_state_tmpb)
621 ! set J_2
622 call mxll_set_batch(st%inhomogeneousb, st%rs_current_density_t2, gr%np, st%dim)
623 ! accumulate -a_2 J_2 to rs_state_tmpb
624 call batch_axpy(gr%np, -m_half*(m_one-sqrt(m_three)), st%inhomogeneousb, rs_state_tmpb)
625 end if
626 ! compute phi_1
627 call tr%te%apply_phi_batch(namespace, gr, hm, rs_state_tmpb, dt, 1)
628 ! accumulate phi_1 term: F_{n+1} = F_n + dt * phi_1 (...)
629 call batch_axpy(gr%np, dt, rs_state_tmpb, st%rs_stateb)
630 if (hm%current_density_ext_flag .or. hm%current_density_from_medium) then
631 call batch_set_zero(rs_state_tmpb)
632 ! set J_1
633 call mxll_set_batch(st%inhomogeneousb, st%rs_current_density_t1, gr%np, st%dim)
634 ! accumulate -b_1 J_1 to rs_state_tmpb
635 call batch_axpy(gr%np, sqrt(m_three), st%inhomogeneousb, rs_state_tmpb)
636 ! set J_2
637 call mxll_set_batch(st%inhomogeneousb, st%rs_current_density_t2, gr%np, st%dim)
638 ! accumulate -b_2 J_2 to rs_state_tmpb
639 call batch_axpy(gr%np, -sqrt(m_three), st%inhomogeneousb, rs_state_tmpb)
640
641 ! compute phi_2
642 call tr%te%apply_phi_batch(namespace, gr, hm, rs_state_tmpb, dt, 2)
643 ! accumulate phi_2 term: F_{n+1} = F_n + dt * phi_2 (...)
644 call batch_axpy(gr%np, dt, rs_state_tmpb, st%rs_stateb)
645 end if
646
647 ! update PML convolution values
648 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__cpml)) then
649 call mxll_copy_pml_simple(hm, st%rs_stateb)
650 end if
651
652 call rs_state_tmpb%end()
653
654 pop_sub_with_profile(mxll_propagate_expgauss2)
655 end subroutine mxll_propagate_expgauss2
656
657 ! ---------------------------------------------------------
658 subroutine set_medium_rs_state(st, gr, hm)
659 type(states_mxll_t), intent(inout) :: st
660 type(grid_t), intent(in) :: gr
661 type(hamiltonian_mxll_t), intent(in) :: hm
662
663 integer :: ip, ip_in, il, idim
664
665 push_sub(set_medium_rs_state)
666
667 assert(allocated(st%ep) .and. allocated(st%mu))
668
669 call profiling_in('SET_MEDIUM_RS_STATE')
670
671 if (hm%calc_medium_box) then
672 do il = 1, size(hm%medium_boxes)
673 assert(.not. hm%medium_boxes(il)%has_mapping)
674 do ip = 1, hm%medium_boxes(il)%points_number
675 if (abs(hm%medium_boxes(il)%c(ip)) <= m_epsilon) cycle
676 st%ep(ip) = hm%medium_boxes(il)%ep(ip)
677 st%mu(ip) = hm%medium_boxes(il)%mu(ip)
678 end do
679 end do
680 end if
681
682 do idim = 1, st%dim
683 if (hm%bc%bc_type(idim) == mxll_bc_medium) then
684 do ip_in = 1, hm%bc%medium(idim)%points_number
685 ip = hm%bc%medium(idim)%points_map(ip_in)
686 st%ep(ip) = hm%bc%medium(idim)%ep(ip_in)
687 st%mu(ip) = hm%bc%medium(idim)%mu(ip_in)
688 end do
689 end if
690 end do
691
692 call profiling_out('SET_MEDIUM_RS_STATE')
693
694 pop_sub(set_medium_rs_state)
695 end subroutine set_medium_rs_state
696
697 ! ---------------------------------------------------------
698 subroutine transform_rs_state_batch(hm, gr, st, rs_stateb, ff_rs_stateb, sign)
699 type(hamiltonian_mxll_t), intent(in) :: hm
700 type(grid_t), intent(in) :: gr
701 type(states_mxll_t), intent(in) :: st
702 type(batch_t), intent(inout) :: rs_stateb
703 type(batch_t), intent(inout) :: ff_rs_stateb
704 integer, intent(in) :: sign
705
706 complex(real64), allocatable :: rs_state(:,:)
707 complex(real64), allocatable :: rs_state_tmp(:,:)
708 integer :: ii, np
709
711
712 call profiling_in('TRANSFORM_RS_STATE')
713
714 assert(sign == rs_trans_forward .or. sign == rs_trans_backward)
715
716 np = gr%np
717 safe_allocate(rs_state(1:gr%np, 1:st%dim))
718
719 if (hm%operator == faraday_ampere_medium) then
720 if (sign == rs_trans_forward) then
721 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
722 ! 3 to 6
723 do ii = 1, 3
724 call batch_set_state(ff_rs_stateb, ii, np, rs_state(:, ii))
725 call batch_set_state(ff_rs_stateb, ii+3, np, conjg(rs_state(:, ii)))
726 end do
727 else
728 ! 6 to 3
729 safe_allocate(rs_state_tmp(1:gr%np, 1:st%dim))
730 do ii = 1, 3
731 call batch_get_state(ff_rs_stateb, ii, np, rs_state(:, ii))
732 call batch_get_state(ff_rs_stateb, ii+3, np, rs_state_tmp(:, ii))
733 rs_state(1:np, ii) = m_half * (rs_state(1:np, ii) + conjg(rs_state_tmp(1:np, ii)))
734 end do
735 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
736 safe_deallocate_a(rs_state_tmp)
737 end if
738 else
739 if (sign == rs_trans_forward) then
740 call rs_stateb%copy_data_to(gr%np, ff_rs_stateb)
741 else
742 call ff_rs_stateb%copy_data_to(gr%np, rs_stateb)
743 end if
744 end if
745 safe_deallocate_a(rs_state)
746
747 call profiling_out('TRANSFORM_RS_STATE')
748
750
751 end subroutine transform_rs_state_batch
752
753 ! ---------------------------------------------------------
754 subroutine transform_rs_densities(hm, mesh, rs_current_density, ff_density, sign)
755 type(hamiltonian_mxll_t), intent(in) :: hm
756 class(mesh_t), intent(in) :: mesh
757 complex(real64), intent(inout) :: rs_current_density(:,:)
758 complex(real64), intent(inout) :: ff_density(:,:)
759 integer, intent(in) :: sign
760
761
762 assert(sign == rs_trans_forward .or. sign == rs_trans_backward)
763 assert(size(rs_current_density, dim=2) == 3)
764
765 push_sub(transform_rs_densities)
766
767 call profiling_in('TRANSFORM_RS_DENSITIES')
768
769 if (hm%operator == faraday_ampere_medium) then
770 if (sign == rs_trans_forward) then
771 call transform_rs_densities_to_6x6_rs_densities_forward(mesh, rs_current_density, ff_density)
772 else
773 call transform_rs_densities_to_6x6_rs_densities_backward(mesh, ff_density, rs_current_density)
774 end if
775 else
776 if (sign == rs_trans_forward) then
777 ff_density(1:mesh%np, 1:3) = rs_current_density(1:mesh%np, 1:3)
778 else
779 rs_current_density(1:mesh%np, 1:3) = ff_density(1:mesh%np, 1:3)
780 end if
781 end if
782
783 call profiling_out('TRANSFORM_RS_DENSITIES')
784
786
787 end subroutine transform_rs_densities
788
789 !----------------------------------------------------------
790 subroutine transform_rs_densities_to_6x6_rs_densities_forward(mesh, rs_current_density, rs_density_6x6)
791 class(mesh_t), intent(in) :: mesh
792 complex(real64), intent(in) :: rs_current_density(:,:)
793 complex(real64), intent(inout) :: rs_density_6x6(:,:)
794
795 integer :: ii
796
797 assert(size(rs_current_density, dim=2) == 3)
798 assert(size(rs_density_6x6, dim=2) == 6)
799
800 ! no push_sub, called to frequently
801 do ii = 1, 3
802 rs_density_6x6(1:mesh%np, ii) = rs_current_density(1:mesh%np, ii)
803 rs_density_6x6(1:mesh%np, ii+3) = rs_current_density(1:mesh%np, ii)
804 end do
805
807
808 !----------------------------------------------------------
809 subroutine transform_rs_densities_to_6x6_rs_densities_backward(mesh, rs_density_6x6, rs_current_density)
810 class(mesh_t), intent(in) :: mesh
811 complex(real64), intent(in) :: rs_density_6x6(:,:)
812 complex(real64), intent(inout) :: rs_current_density(:,:)
813
814 integer :: ii
815
816 assert(size(rs_current_density, dim=2) == 3)
817 assert(size(rs_density_6x6, dim=2) == 6)
818
819 ! no push_sub, called to frequently
820 do ii = 1, 3
821 rs_current_density(1:mesh%np, ii) = m_half * &
822 real(rs_density_6x6(1:mesh%np, ii) + rs_density_6x6(1:mesh%np, ii+3), real64)
823 end do
824
826
827 !----------------------------------------------------------
828 subroutine calculate_matter_longitudinal_field(gr_mxll, st_mxll, hm_mxll, gr_elec, hm_elec, rs_state_matter)
829 type(grid_t), intent(in) :: gr_mxll
830 type(states_mxll_t), intent(in) :: st_mxll
831 type(hamiltonian_mxll_t), intent(in) :: hm_mxll
832 type(grid_t), intent(in) :: gr_elec
833 type(hamiltonian_elec_t), intent(in) :: hm_elec
834 complex(real64), intent(inout) :: rs_state_matter(:,:)
835
836 complex(real64), allocatable :: tmp_pot_mx_gr(:,:), tmp_grad_mx_gr(:,:)
837
838 safe_allocate(tmp_pot_mx_gr(1:gr_mxll%np_part,1))
839 safe_allocate(tmp_grad_mx_gr(1:gr_mxll%np,1:gr_mxll%box%dim))
840 ! this subroutine needs the matter part
841
843
844 tmp_pot_mx_gr(:,:) = m_zero
845 tmp_grad_mx_gr(:,:) = m_zero
846 call zderivatives_grad(gr_mxll%der, tmp_pot_mx_gr(:,1), tmp_grad_mx_gr(:,:), set_bc = .false.)
847 tmp_grad_mx_gr = - tmp_grad_mx_gr
848
849 rs_state_matter = m_z0
850 call build_rs_state(real(tmp_grad_mx_gr(1:gr_mxll%np,:)), aimag(tmp_grad_mx_gr(1:gr_mxll%np,:)), st_mxll%rs_sign, &
851 rs_state_matter(1:gr_mxll%np,:), gr_mxll, st_mxll%ep(1:gr_mxll%np), st_mxll%mu(1:gr_mxll%np), &
852 gr_mxll%np)
853
854 safe_deallocate_a(tmp_pot_mx_gr)
855 safe_deallocate_a(tmp_grad_mx_gr)
856
859
860 !----------------------------------------------------------
861 subroutine get_vector_pot_and_transverse_field(namespace, gr_mxll, hm_mxll, st_mxll, tr_mxll, hm, &
862 poisson_solver, helmholtz, field, transverse_field, vector_potential)
863 type(namespace_t), intent(in) :: namespace
864 type(grid_t), intent(in) :: gr_mxll
865 type(hamiltonian_mxll_t), intent(in) :: hm_mxll
866 type(states_mxll_t), intent(in) :: st_mxll
867 type(propagator_mxll_t), intent(in) :: tr_mxll
868 type(hamiltonian_elec_t), intent(in) :: hm
869 type(poisson_t), intent(in) :: poisson_solver
870 type(helmholtz_decomposition_t), intent(inout) :: helmholtz
871 complex(real64), intent(inout) :: field(:,:)
872 complex(real64), intent(inout) :: transverse_field(:,:)
873 real(real64), intent(inout) :: vector_potential(:,:)
874
875 integer :: np
876 complex(real64), allocatable :: rs_state_plane_waves(:, :)
877
879
880 transverse_field = m_z0
881 vector_potential = m_zero
882
883 np = gr_mxll%np
884
885 if (hm_mxll%ma_mx_coupling) then
886
887 ! check what other transverse field methods are needed
888
889 ! trans_calc_method == OPTION__MAXWELLTRANSFIELDCALCULATIONMETHOD__TRANS_FIELD_POISSON
890 if (tr_mxll%bc_plane_waves .and. hm_mxll%plane_waves_apply) then
891 safe_allocate(rs_state_plane_waves(1:gr_mxll%np, 1:st_mxll%dim))
892 call mxll_get_batch(st_mxll%rs_state_plane_wavesb, rs_state_plane_waves, gr_mxll%np, st_mxll%dim)
893 end if
894
895 ! plane waves subtraction
896 if (tr_mxll%bc_plane_waves .and. hm_mxll%plane_waves_apply) then
897 transverse_field(1:np,:) = field(1:np,:) - rs_state_plane_waves(1:np,:)
898 else
899 transverse_field(1:np,:) = field(1:np,:)
900 end if
901 ! apply helmholtz decomposition for transverse field
902 call helmholtz%get_trans_field(namespace, transverse_field, total_field=field)
903 ! plane waves addition
904 if (tr_mxll%bc_plane_waves .and. hm_mxll%plane_waves_apply) then
905 transverse_field(1:np,:) = transverse_field(1:np,:) + rs_state_plane_waves(1:np,:)
906 safe_deallocate_a(rs_state_plane_waves)
907 end if
908
909 else
910
911 transverse_field(1:np,:) = field
912
913 end if
914
915
917
919
920 ! ---------------------------------------------------------
921 subroutine calculate_vector_potential(namespace, poisson_solver, gr, st, field, vector_potential)
922 type(namespace_t), intent(in) :: namespace
923 type(poisson_t), intent(in) :: poisson_solver
924 type(grid_t), intent(in) :: gr
925 type(states_mxll_t), intent(in) :: st
926 complex(real64), intent(in) :: field(:,:)
927 real(real64), contiguous, intent(inout) :: vector_potential(:,:)
928
929 integer :: idim
930 real(real64), allocatable :: dtmp(:,:)
931
932 safe_allocate(dtmp(1:gr%np_part,1:3))
933
934 dtmp = m_zero
935
936 call get_magnetic_field_state(field, gr, st%rs_sign, vector_potential, st%mu, gr%np_part)
937 dtmp = vector_potential
938 call dderivatives_curl(gr%der, dtmp, vector_potential, set_bc = .false.)
939 do idim=1, st%dim
940 call dpoisson_solve(poisson_solver, namespace, dtmp(:,idim), vector_potential(:,idim), .true.)
941 end do
942 vector_potential = m_one / (m_four * m_pi) * vector_potential
943
944 safe_deallocate_a(dtmp)
945
946 end subroutine calculate_vector_potential
947
948 !----------------------------------------------------------
949 subroutine energy_mxll_calc(gr, st, hm, energy_mxll, rs_field, rs_field_plane_waves)
950 type(grid_t), intent(in) :: gr
951 type(states_mxll_t), intent(in) :: st
952 type(hamiltonian_mxll_t), intent(in) :: hm
953 type(energy_mxll_t), intent(inout) :: energy_mxll
954 complex(real64), intent(in) :: rs_field(:,:)
955 complex(real64), optional, intent(in) :: rs_field_plane_waves(:,:)
957 real(real64), allocatable :: energy_density(:), e_energy_density(:), b_energy_density(:), energy_density_plane_waves(:)
958
959 push_sub(energy_mxll_calc)
960
961 call profiling_in('ENERGY_MXLL_CALC')
962
963 safe_allocate(energy_density(1:gr%np))
964 safe_allocate(e_energy_density(1:gr%np))
965 safe_allocate(b_energy_density(1:gr%np))
966 if (present(rs_field_plane_waves) .and. hm%plane_waves) then
967 safe_allocate(energy_density_plane_waves(1:gr%np))
968 end if
969
970 call energy_density_calc(gr, st, rs_field, energy_density, e_energy_density, &
971 b_energy_density, hm%plane_waves, rs_field_plane_waves, energy_density_plane_waves)
972 energy_mxll%energy = dmf_integrate(gr, energy_density, mask=st%inner_points_mask)
973 energy_mxll%e_energy = dmf_integrate(gr, e_energy_density, mask=st%inner_points_mask)
974 energy_mxll%b_energy = dmf_integrate(gr, b_energy_density, mask=st%inner_points_mask)
975 if (present(rs_field_plane_waves) .and. hm%plane_waves) then
976 energy_mxll%energy_plane_waves = dmf_integrate(gr, energy_density_plane_waves, mask=st%inner_points_mask)
977 else
978 energy_mxll%energy_plane_waves = m_zero
979 end if
980
981 energy_mxll%boundaries = dmf_integrate(gr, energy_density, mask=st%boundary_points_mask)
982
983 safe_deallocate_a(energy_density)
984 safe_deallocate_a(e_energy_density)
985 safe_deallocate_a(b_energy_density)
986 if (present(rs_field_plane_waves) .and. hm%plane_waves) then
987 safe_deallocate_a(energy_density_plane_waves)
988 end if
989
990 call profiling_out('ENERGY_MXLL_CALC')
991
992 pop_sub(energy_mxll_calc)
993 end subroutine energy_mxll_calc
994
995 !----------------------------------------------------------
996 subroutine energy_mxll_calc_batch(gr, st, hm, energy_mxll, rs_fieldb, rs_field_plane_wavesb)
997 type(grid_t), intent(in) :: gr
998 type(states_mxll_t), intent(in) :: st
999 type(hamiltonian_mxll_t), intent(in) :: hm
1000 type(energy_mxll_t), intent(inout) :: energy_mxll
1001 type(batch_t), intent(in) :: rs_fieldb
1002 type(batch_t), intent(in) :: rs_field_plane_wavesb
1003
1004 type(batch_t) :: e_fieldb, b_fieldb, e_field_innerb, b_field_innerb, rs_field_plane_waves_innerb
1005 real(real64) :: tmp(1:st%dim)
1006 complex(real64) :: ztmp(1:st%dim)
1007
1008 push_sub(energy_mxll_calc_batch)
1009
1010 call profiling_in('ENERGY_MXLL_CALC_BATCH')
1011
1012 call dbatch_init(e_fieldb, 1, 1, st%dim, gr%np)
1013 if (st%pack_states) then
1014 call e_fieldb%do_pack(copy=.false.)
1015 end if
1016 call e_fieldb%copy_to(b_fieldb)
1017 call e_fieldb%copy_to(e_field_innerb)
1018 call e_fieldb%copy_to(b_field_innerb)
1019
1020 call batch_split_complex(gr%np, rs_fieldb, e_fieldb, b_fieldb)
1021
1022 ! subtract energy of inner points
1023 call batch_set_zero(e_field_innerb)
1024 call batch_set_zero(b_field_innerb)
1025 if (accel_is_enabled()) then
1026 call batch_copy_with_map(st%inner_points_number, st%buff_inner_points_map, e_fieldb, e_field_innerb)
1027 call batch_copy_with_map(st%inner_points_number, st%buff_inner_points_map, b_fieldb, b_field_innerb)
1028 else
1029 call batch_copy_with_map(st%inner_points_number, st%inner_points_map, e_fieldb, e_field_innerb)
1030 call batch_copy_with_map(st%inner_points_number, st%inner_points_map, b_fieldb, b_field_innerb)
1031 end if
1032 call dmesh_batch_dotp_vector(gr, e_field_innerb, e_field_innerb, tmp)
1033 energy_mxll%e_energy = sum(tmp)
1034 call dmesh_batch_dotp_vector(gr, b_field_innerb, b_field_innerb, tmp)
1035 energy_mxll%b_energy = sum(tmp)
1036 energy_mxll%energy = energy_mxll%e_energy + energy_mxll%b_energy
1037
1038 call dmesh_batch_dotp_vector(gr, e_fieldb, e_fieldb, tmp)
1039 energy_mxll%boundaries = sum(tmp)
1040 call dmesh_batch_dotp_vector(gr, b_fieldb, b_fieldb, tmp)
1041 energy_mxll%boundaries = energy_mxll%boundaries + sum(tmp)
1042 energy_mxll%boundaries = energy_mxll%boundaries - energy_mxll%energy
1043
1044 if (hm%plane_waves) then
1045 call rs_field_plane_wavesb%copy_to(rs_field_plane_waves_innerb)
1046 call batch_set_zero(rs_field_plane_waves_innerb)
1047 if (accel_is_enabled()) then
1048 call batch_copy_with_map(st%inner_points_number, st%buff_inner_points_map, &
1049 rs_field_plane_wavesb, rs_field_plane_waves_innerb)
1050 else
1051 call batch_copy_with_map(st%inner_points_number, st%inner_points_map, &
1052 rs_field_plane_wavesb, rs_field_plane_waves_innerb)
1053 end if
1054 call zmesh_batch_dotp_vector(gr, rs_field_plane_waves_innerb, rs_field_plane_waves_innerb, ztmp)
1055 energy_mxll%energy_plane_waves = sum(real(tmp, real64) )
1056 call rs_field_plane_waves_innerb%end()
1057 else
1058 energy_mxll%energy_plane_waves = m_zero
1059 end if
1060
1061 call e_fieldb%end()
1062 call b_fieldb%end()
1063 call e_field_innerb%end()
1064 call b_field_innerb%end()
1065
1066 call profiling_out('ENERGY_MXLL_CALC_BATCH')
1067
1068 pop_sub(energy_mxll_calc_batch)
1069 end subroutine energy_mxll_calc_batch
1070
1071 ! ---------------------------------------------------------
1072 subroutine mask_absorbing_boundaries(namespace, gr, hm, st, tr, time, dt, time_delay, rs_state)
1073 type(namespace_t), intent(in) :: namespace
1074 type(grid_t), intent(in) :: gr
1075 type(hamiltonian_mxll_t), intent(inout) :: hm
1076 type(states_mxll_t), intent(inout) :: st
1077 type(propagator_mxll_t), intent(inout) :: tr
1078 real(real64), intent(in) :: time
1079 real(real64), intent(in) :: dt
1080 real(real64), intent(in) :: time_delay
1081 complex(real64), intent(inout) :: rs_state(:,:)
1082
1083 integer :: ip, ip_in, idim
1084 logical :: mask_check
1085
1087
1088 call profiling_in('MASK_ABSORBING_BOUNDARIES')
1089 mask_check = .false.
1090
1091 do idim = 1, 3
1092 if (hm%bc%bc_ab_type(idim) == option__maxwellabsorbingboundaries__mask) then
1093 mask_check = .true.
1094 end if
1095 end do
1096
1097 if (mask_check) then
1098 if (tr%bc_plane_waves .and. hm%plane_waves_apply) then
1099 call plane_waves_propagation(hm, tr, namespace, st, gr, time, dt, time_delay)
1100 call mxll_get_batch(st%rs_state_plane_wavesb, st%rs_state_plane_waves, gr%np, st%dim)
1101 rs_state = rs_state - st%rs_state_plane_waves
1102 call maxwell_mask(hm, rs_state)
1103 rs_state = rs_state + st%rs_state_plane_waves
1104 else if (tr%bc_constant .and. hm%spatial_constant_apply) then
1105 !call constant_at_absorbing_boundaries_calculation(st, hm%bc)
1106 call constant_boundaries_calculation(tr%bc_constant, hm%bc, hm, st, rs_state)
1107 do ip_in=1, hm%bc%constant_points_number
1108 ip = hm%bc%constant_points_map(ip_in)
1109 rs_state(ip,:) = rs_state(ip,:) - st%rs_state_const(:)
1110 end do
1111 call maxwell_mask(hm, rs_state)
1112 do ip_in=1, hm%bc%constant_points_number
1113 ip = hm%bc%constant_points_map(ip_in)
1114 rs_state(ip,:) = rs_state(ip,:) + st%rs_state_const(:)
1115 end do
1116 else
1117 call maxwell_mask(hm, rs_state)
1118 end if
1119 end if
1120
1121 call profiling_out('MASK_ABSORBING_BOUNDARIES')
1122
1124 end subroutine mask_absorbing_boundaries
1125
1126 ! ---------------------------------------------------------
1127 subroutine maxwell_mask(hm, rs_state)
1128 type(hamiltonian_mxll_t), intent(in) :: hm
1129 complex(real64), intent(inout) :: rs_state(:,:)
1130
1131 integer :: ip, ip_in, idim
1132
1133 push_sub(maxwell_mask)
1134
1135 call profiling_in('MAXWELL_MASK')
1136
1137 do idim = 1, 3
1138 if (hm%bc%bc_ab_type(idim) == option__maxwellabsorbingboundaries__mask) then
1139 do ip_in = 1, hm%bc%mask_points_number(idim)
1140 ip = hm%bc%mask_points_map(ip_in,idim)
1141 rs_state(ip,:) = rs_state(ip,:) * hm%bc%mask(ip_in,idim)
1142 end do
1143 end if
1144 end do
1145
1146 call profiling_out('MAXWELL_MASK')
1147
1148 pop_sub(maxwell_mask)
1149 end subroutine maxwell_mask
1150
1151 ! ---------------------------------------------------------
1152 subroutine pml_propagation_stage_1_batch(hm, gr, st, tr, ff_rs_stateb, ff_rs_state_pmlb)
1153 type(hamiltonian_mxll_t), intent(inout) :: hm
1154 type(grid_t), intent(in) :: gr
1155 type(states_mxll_t), intent(inout) :: st
1156 type(propagator_mxll_t), intent(inout) :: tr
1157 type(batch_t), intent(in) :: ff_rs_stateb
1158 type(batch_t), intent(inout) :: ff_rs_state_pmlb
1159
1160 integer :: ii
1161 complex(real64), allocatable :: rs_state_constant(:,:)
1162 type(batch_t) :: rs_state_constantb
1163
1165
1166 call profiling_in('PML_PROP_STAGE_1_BATCH')
1168 if (tr%bc_plane_waves .and. hm%plane_waves_apply) then
1169 call transform_rs_state_batch(hm, gr, st, st%rs_state_plane_wavesb, &
1170 ff_rs_state_pmlb, rs_trans_forward)
1171 call batch_xpay(gr%np, ff_rs_stateb, -m_one, ff_rs_state_pmlb)
1172 else if (tr%bc_constant .and. hm%spatial_constant_apply) then
1173 ! this could be optimized: right now we broadcast the constant value
1174 ! to the full mesh to be able to use the batch functions easily.
1175 ! in principle, we would need to do the transform only for one point
1176 ! and then subtract that value from all points of the state
1177 safe_allocate(rs_state_constant(1:gr%np,1:3))
1178 do ii = 1, 3
1179 rs_state_constant(1:gr%np, ii) = st%rs_state_const(ii)
1180 end do
1181 call ff_rs_stateb%copy_to(rs_state_constantb)
1182 call mxll_set_batch(rs_state_constantb, rs_state_constant, gr%np, 3)
1183
1184 call transform_rs_state_batch(hm, gr, st, rs_state_constantb, &
1185 ff_rs_state_pmlb, rs_trans_forward)
1186 call batch_xpay(gr%np, ff_rs_stateb, -m_one, ff_rs_state_pmlb)
1187
1188 call rs_state_constantb%end()
1189
1190 safe_deallocate_a(rs_state_constant)
1191 else
1192 ! this copy should not be needed
1193 call ff_rs_stateb%copy_data_to(gr%np, ff_rs_state_pmlb)
1194 end if
1195
1196 call profiling_out('PML_PROP_STAGE_1_BATCH')
1197
1199 end subroutine pml_propagation_stage_1_batch
1200
1201 ! ---------------------------------------------------------
1202 subroutine pml_propagation_stage_2_batch(hm, namespace, gr, st, tr, time, dt, time_delay, ff_rs_state_pmlb, ff_rs_stateb)
1203 type(hamiltonian_mxll_t), intent(inout) :: hm
1204 type(namespace_t), intent(in) :: namespace
1205 type(grid_t), intent(in) :: gr
1206 type(states_mxll_t), intent(inout) :: st
1207 type(propagator_mxll_t), intent(inout) :: tr
1208 real(real64), intent(in) :: time
1209 real(real64), intent(in) :: dt
1210 real(real64), intent(in) :: time_delay
1211 type(batch_t), intent(inout) :: ff_rs_state_pmlb
1212 type(batch_t), intent(inout) :: ff_rs_stateb
1213
1214 integer :: ii, ff_dim
1215 complex(real64), allocatable :: rs_state_constant(:,:), ff_rs_state_constant(:,:)
1216 type(batch_t) :: ff_rs_state_plane_wavesb, ff_rs_constantb, rs_state_constantb
1217
1219
1220 call profiling_in('PML_PROP_STAGE_2_BATCH')
1221
1222 if (tr%bc_plane_waves .and. hm%plane_waves_apply) then
1223 hm%cpml_hamiltonian = .true.
1224 call tr%te%apply_batch(namespace, gr, hm, ff_rs_state_pmlb, dt)
1225 hm%cpml_hamiltonian = .false.
1226 call plane_waves_propagation(hm, tr, namespace, st, gr, time, dt, time_delay)
1227
1228 call ff_rs_stateb%copy_to(ff_rs_state_plane_wavesb)
1229 call transform_rs_state_batch(hm, gr, st, st%rs_state_plane_wavesb, ff_rs_state_plane_wavesb, rs_trans_forward)
1230
1231 if (ff_rs_stateb%status() == batch_device_packed) then
1232 ! use the map of points stored on the GPU in this case
1233 call batch_add_with_map(hm%bc%plane_wave%points_number, hm%bc%plane_wave%buff_map, &
1234 ff_rs_state_pmlb, ff_rs_state_plane_wavesb, ff_rs_stateb)
1235 else
1236 call batch_add_with_map(hm%bc%plane_wave%points_number, hm%bc%plane_wave%points_map, &
1237 ff_rs_state_pmlb, ff_rs_state_plane_wavesb, ff_rs_stateb)
1238 end if
1239
1240 call ff_rs_state_plane_wavesb%end()
1241
1242 else if (tr%bc_constant .and. hm%spatial_constant_apply) then
1243 hm%cpml_hamiltonian = .true.
1244 call tr%te%apply_batch(namespace, gr, hm, ff_rs_state_pmlb, dt)
1245 hm%cpml_hamiltonian = .false.
1246
1247 call ff_rs_stateb%copy_to(ff_rs_constantb)
1248 ff_dim = ff_rs_stateb%nst_linear
1249 safe_allocate(rs_state_constant(1:gr%np, 1:st%dim))
1250 ! copy the value to the full mesh to be able to use batches
1251 ! this is in principle unneeded, but otherwise we could not use batches...
1252 do ii = 1, st%dim
1253 rs_state_constant(1:gr%np, ii) = st%rs_state_const(ii)
1254 end do
1255 call ff_rs_stateb%copy_to(rs_state_constantb)
1256 call mxll_set_batch(rs_state_constantb, rs_state_constant, gr%np, st%dim)
1257
1258 call transform_rs_state_batch(hm, gr, st, rs_state_constantb, ff_rs_constantb, rs_trans_forward)
1259 if (ff_rs_stateb%status() == batch_device_packed) then
1260 ! use the map of points stored on the GPU in this case
1261 call batch_add_with_map(hm%bc%constant_points_number, hm%bc%buff_constant_points_map, &
1262 ff_rs_state_pmlb, ff_rs_constantb, ff_rs_stateb)
1263 else
1264 call batch_add_with_map(hm%bc%constant_points_number, hm%bc%constant_points_map, &
1265 ff_rs_state_pmlb, ff_rs_constantb, ff_rs_stateb)
1266 end if
1267
1268 call ff_rs_constantb%end()
1269 call rs_state_constantb%end()
1270
1271 safe_deallocate_a(rs_state_constant)
1272 safe_deallocate_a(ff_rs_state_constant)
1273 end if
1274
1275 call profiling_out('PML_PROP_STAGE_2_BATCH')
1276
1278 end subroutine pml_propagation_stage_2_batch
1279
1280 ! ---------------------------------------------------------
1281 subroutine cpml_conv_function_update(hm, gr, ff_rs_state_pmlb)
1282 type(hamiltonian_mxll_t), intent(inout) :: hm
1283 type(grid_t), intent(in) :: gr
1284 type(batch_t), intent(inout) :: ff_rs_state_pmlb
1285
1286
1288
1289 call profiling_in('CPML_CONV_FUNCTION_UPDATE')
1290
1291 call cpml_conv_function_update_via_riemann_silberstein(hm, gr, ff_rs_state_pmlb)
1292
1293 call profiling_out('CPML_CONV_FUNCTION_UPDATE')
1294
1296 end subroutine cpml_conv_function_update
1298 ! ---------------------------------------------------------
1299 subroutine cpml_conv_function_update_via_riemann_silberstein(hm, gr, ff_rs_state_pmlb)
1300 type(hamiltonian_mxll_t), intent(inout) :: hm
1301 type(grid_t), intent(in) :: gr
1302 type(batch_t), intent(inout) :: ff_rs_state_pmlb
1303
1304 integer :: ip, ip_in, np_part, rs_sign
1305 complex(real64) :: pml_a, pml_b, pml_g, grad
1306 integer :: pml_dir, field_dir, ifield, idir
1307 integer, parameter :: field_dirs(3, 2) = reshape([2, 3, 1, 3, 1, 2], [3, 2])
1308 logical :: with_medium
1309 type(batch_t) :: gradb(gr%der%dim)
1310 type(accel_kernel_t), save :: ker_pml
1311 integer :: wgsize
1312
1314
1315 call profiling_in('CPML_CONV_UPDATE_VIA_RS')
1316
1317 assert(hm%dim == 3 .or. hm%dim == 6)
1318
1319 np_part = gr%np_part
1320 rs_sign = hm%rs_sign
1321
1322 call zderivatives_batch_grad(gr%der, ff_rs_state_pmlb, gradb)
1323
1324 with_medium = hm%dim == 6
1325
1326 do pml_dir = 1, hm%st%dim
1327 select case (gradb(pml_dir)%status())
1328 case (batch_not_packed)
1329 do ip_in=1, hm%bc%pml%points_number
1330 ip = hm%bc%pml%points_map(ip_in)
1331 pml_a = hm%bc%pml%a(ip_in,pml_dir)
1332 pml_b = hm%bc%pml%b(ip_in,pml_dir)
1333 do ifield = 1, 2
1334 field_dir = field_dirs(pml_dir, ifield)
1335 grad = gradb(pml_dir)%zff_linear(ip, field_dir)
1336 pml_g = hm%bc%pml%conv_plus(ip_in, pml_dir, field_dir)
1337 hm%bc%pml%conv_plus(ip_in, pml_dir, field_dir) = pml_a * grad + pml_b * pml_g
1338 if (with_medium) then
1339 grad = gradb(pml_dir)%zff_linear(ip, field_dir+3)
1340 pml_g = hm%bc%pml%conv_minus(ip_in, pml_dir, field_dir)
1341 hm%bc%pml%conv_minus(ip_in, pml_dir, field_dir) = pml_a * grad + pml_b * pml_g
1342 end if
1343 end do
1344 end do
1345 case (batch_packed)
1346 do ip_in=1, hm%bc%pml%points_number
1347 ip = hm%bc%pml%points_map(ip_in)
1348 pml_a = hm%bc%pml%a(ip_in,pml_dir)
1349 pml_b = hm%bc%pml%b(ip_in,pml_dir)
1350 do ifield = 1, 2
1351 field_dir = field_dirs(pml_dir, ifield)
1352 grad = gradb(pml_dir)%zff_pack(field_dir, ip)
1353 pml_g = hm%bc%pml%conv_plus(ip_in, pml_dir, field_dir)
1354 hm%bc%pml%conv_plus(ip_in, pml_dir, field_dir) = pml_a * grad + pml_b * pml_g
1355 if (with_medium) then
1356 grad = gradb(pml_dir)%zff_pack(field_dir+3, ip)
1357 pml_g = hm%bc%pml%conv_minus(ip_in, pml_dir, field_dir)
1358 hm%bc%pml%conv_minus(ip_in, pml_dir, field_dir) = pml_a * grad + pml_b * pml_g
1359 end if
1360 end do
1361 end do
1362 case (batch_device_packed)
1363 call accel_kernel_start_call(ker_pml, 'pml.cl', 'pml_update_conv')
1364
1365 if (with_medium) then
1366 call accel_set_kernel_arg(ker_pml, 0, 1_int32)
1367 else
1368 call accel_set_kernel_arg(ker_pml, 0, 0_int32)
1369 end if
1370 call accel_set_kernel_arg(ker_pml, 1, hm%bc%pml%points_number)
1371 call accel_set_kernel_arg(ker_pml, 2, pml_dir-1)
1372 call accel_set_kernel_arg(ker_pml, 3, hm%bc%pml%buff_map)
1373 call accel_set_kernel_arg(ker_pml, 4, gradb(pml_dir)%ff_device)
1374 call accel_set_kernel_arg(ker_pml, 5, log2(int(gradb(pml_dir)%pack_size(1), int32)))
1375 call accel_set_kernel_arg(ker_pml, 6, hm%bc%pml%buff_a)
1376 call accel_set_kernel_arg(ker_pml, 7, hm%bc%pml%buff_b)
1377 call accel_set_kernel_arg(ker_pml, 8, hm%bc%pml%buff_conv_plus)
1378 call accel_set_kernel_arg(ker_pml, 9, hm%bc%pml%buff_conv_minus)
1379
1380 wgsize = accel_max_workgroup_size()
1381 call accel_kernel_run(ker_pml, (/ accel_padded_size(hm%bc%pml%points_number) /), (/ wgsize /))
1382 end select
1383 end do
1384
1385 do idir = 1, gr%der%dim
1386 call gradb(idir)%end()
1387 end do
1388
1389 if (accel_is_enabled()) then
1390 call accel_finish()
1391 end if
1392
1393 call profiling_out('CPML_CONV_UPDATE_VIA_RS')
1397
1398 ! ---------------------------------------------------------
1399 subroutine td_function_mxll_init(st, namespace, hm)
1400 type(states_mxll_t), intent(inout) :: st
1401 type(namespace_t), intent(in) :: namespace
1402 type(hamiltonian_mxll_t), intent(inout) :: hm
1403
1404 type(block_t) :: blk
1405 integer :: il, nlines, idim, ncols, ierr
1406 real(real64) :: e_field(st%dim), b_field(st%dim)
1407 character(len=1024) :: mxf_expression
1408
1409 push_sub(td_function_mxll_init)
1410
1411 call profiling_in('TD_FUNCTION_MXLL_INIT')
1412
1413 !%Variable UserDefinedConstantSpatialMaxwellField
1414 !%Type block
1415 !%Section Maxwell
1416 !%Description
1417 !% Define parameters of spatially constant field.
1418 !%
1419 !% Example:
1420 !%
1421 !% <tt>%UserDefinedConstantSpatialMaxwellFields
1422 !% <br>&nbsp;&nbsp; plane_wave_parser | E_x | E_y | E_z | B_x | B_y | B_z | "tdf_function"
1423 !% <br>%</tt>
1424 !%
1425 !% This block defines three components of E field, three components of B field, and reference to
1426 !% the TD function.
1427 !%
1428 !%End
1429
1430 if (parse_block(namespace, 'UserDefinedConstantSpatialMaxwellField', blk) == 0) then
1431 st%rs_state_const_external = .true.
1432 nlines = parse_block_n(blk)
1433 safe_allocate(st%rs_state_const_td_function(1:nlines))
1434 safe_allocate(st%rs_state_const_amp(1:st%dim, 1:nlines))
1435 ! read all lines
1436 do il = 1, nlines
1437 e_field = m_zero
1438 b_field = m_zero
1439 ! Check that number of columns is five or six.
1440 ncols = parse_block_cols(blk, il - 1)
1441 if (ncols /= 7) then
1442 message(1) = 'Each line in the UserDefinedConstantSpatialMaxwellField block must have'
1443 message(2) = 'seven columns.'
1444 call messages_fatal(2, namespace=namespace)
1445 end if
1446 do idim = 1, st%dim
1447 call parse_block_float( blk, il - 1, idim-1, e_field(idim))
1448 end do
1449 do idim = 1, st%dim
1450 call parse_block_float( blk, il - 1, idim+2, b_field(idim))
1451 end do
1452 call parse_block_string( blk, il - 1, 6, mxf_expression)
1453 call build_rs_vector(e_field, b_field, st%rs_sign, st%rs_state_const_amp(:,il))
1454 call tdf_read(st%rs_state_const_td_function(il), namespace, trim(mxf_expression), ierr)
1455 end do
1456 end if
1457 call parse_block_end(blk)
1458
1459 !%Variable PropagateSpatialMaxwellField
1460 !%Type logical
1461 !%Default yes
1462 !%Section Maxwell::TD Propagation
1463 !%Description
1464 !% Allow for numerical propagation of Maxwells equations of spatially constant field.
1465 !% If set to no, do only analytic evaluation of the field inside the box.
1466 !%End
1467
1468 call parse_variable(namespace, 'PropagateSpatialMaxwellField', .true., hm%spatial_constant_propagate)
1469
1470 call profiling_out('TD_FUNCTION_MXLL_INIT')
1471
1472 pop_sub(td_function_mxll_init)
1473 end subroutine td_function_mxll_init
1474
1475 ! ---------------------------------------------------------
1476 subroutine spatial_constant_calculation(constant_calc, st, gr, hm, time, dt, delay, rs_state, set_initial_state)
1477 logical, intent(in) :: constant_calc
1478 type(states_mxll_t), intent(inout) :: st
1479 type(grid_t), intent(in) :: gr
1480 type(hamiltonian_mxll_t), intent(in) :: hm
1481 real(real64), intent(in) :: time
1482 real(real64), intent(in) :: dt
1483 real(real64), intent(in) :: delay
1484 complex(real64), intent(inout) :: rs_state(:,:)
1485 logical, optional, intent(in) :: set_initial_state
1486
1487 integer :: ip, ic, icn
1488 real(real64) :: tf_old, tf_new
1489 logical :: set_initial_state_
1490
1492
1493 call profiling_in('SPATIAL_CONSTANT_CALCULATION')
1495 set_initial_state_ = .false.
1496 if (present(set_initial_state)) set_initial_state_ = set_initial_state
1497
1498 if (hm%spatial_constant_apply) then
1499 if (constant_calc) then
1500 icn = size(st%rs_state_const_td_function(:))
1501 st%rs_state_const(:) = m_z0
1502 do ic = 1, icn
1503 tf_old = tdf(st%rs_state_const_td_function(ic), time-delay-dt)
1504 tf_new = tdf(st%rs_state_const_td_function(ic), time-delay)
1505 do ip = 1, gr%np
1506 if (set_initial_state_ .or. (.not. hm%spatial_constant_propagate)) then
1507 rs_state(ip,:) = st%rs_state_const_amp(:,ic) * tf_new
1508 else
1509 rs_state(ip,:) = rs_state(ip,:) + st%rs_state_const_amp(:,ic) * (tf_new - tf_old)
1510 end if
1511 end do
1512 st%rs_state_const(:) = st%rs_state_const(:) + st%rs_state_const_amp(:, ic)
1513 end do
1514 st%rs_state_const(:) = st%rs_state_const(:) * tf_new
1515 end if
1516 end if
1517
1518 call profiling_out('SPATIAL_CONSTANT_CALCULATION')
1519
1521 end subroutine spatial_constant_calculation
1522
1523 ! ---------------------------------------------------------
1524 subroutine constant_boundaries_calculation(constant_calc, bc, hm, st, rs_state)
1525 logical, intent(in) :: constant_calc
1526 type(bc_mxll_t), intent(inout) :: bc
1527 type(states_mxll_t), intent(in) :: st
1528 type(hamiltonian_mxll_t), intent(in) :: hm
1529 complex(real64), intent(inout) :: rs_state(:,:)
1530
1531 integer :: ip_in, ip
1532
1534 call profiling_in('CONSTANT_BOUNDARIES_CALC')
1535
1536 if (hm%spatial_constant_apply) then
1537 if (constant_calc) then
1538 do ip_in = 1, bc%constant_points_number
1539 ip = bc%constant_points_map(ip_in)
1540 rs_state(ip,:) = st%rs_state_const(:)
1541 bc%constant_rs_state(ip_in,:) = st%rs_state_const(:)
1542 end do
1543 end if
1544 end if
1545
1546 call profiling_out('CONSTANT_BOUNDARIES_CALC')
1547
1549 end subroutine constant_boundaries_calculation
1550
1551 ! ---------------------------------------------------------
1552 subroutine mirror_pec_boundaries_calculation(bc, st, rs_state)
1553 type(bc_mxll_t), intent(in) :: bc
1554 type(states_mxll_t), intent(in) :: st
1555 complex(real64), intent(inout) :: rs_state(:,:)
1556
1557 integer :: ip, ip_in, idim
1558 real(real64) :: e_field(st%dim), b_field(st%dim)
1559
1561
1562 do idim = 1, 3
1563 if (bc%bc_type(idim) == mxll_bc_mirror_pec) then
1564 do ip_in = 1, bc%mirror_points_number(idim)
1565 ip = bc%mirror_points_map(ip_in, idim)
1566 e_field(:) = m_zero
1567 call get_magnetic_field_vector(rs_state(ip,:), st%rs_sign, b_field(:), st%mu(ip))
1568 call build_rs_vector(e_field(:), b_field(:), st%rs_sign, rs_state(ip,:), st%ep(ip), st%mu(ip))
1569 end do
1570 end if
1571 end do
1572
1575
1576 ! ---------------------------------------------------------
1577 subroutine mirror_pmc_boundaries_calculation(bc, st, rs_state)
1578 type(bc_mxll_t), intent(in) :: bc
1579 type(states_mxll_t), intent(in) :: st
1580 complex(real64), intent(inout) :: rs_state(:,:)
1581
1582 integer :: ip, ip_in, idim
1583 real(real64) :: e_field(st%dim), b_field(st%dim)
1584
1586
1587 do idim = 1, 3
1588 if (bc%bc_type(idim) == mxll_bc_mirror_pmc) then
1589 do ip_in = 1, bc%mirror_points_number(idim)
1590 ip = bc%mirror_points_map(ip_in,idim)
1591 b_field(:) = m_zero
1592 call get_electric_field_vector(rs_state(ip,:), e_field(:), st%ep(ip))
1593 call build_rs_vector(e_field(:), b_field(:), st%rs_sign, rs_state(ip,:), st%ep(ip), st%mu(ip))
1594 end do
1595 end if
1596 end do
1597
1600
1601 ! ---------------------------------------------------------
1602 subroutine plane_waves_boundaries_calculation(hm, st, mesh, time, time_delay, rs_state)
1603 type(hamiltonian_mxll_t), intent(in) :: hm
1604 type(states_mxll_t), intent(in) :: st
1605 class(mesh_t), intent(in) :: mesh
1606 real(real64), intent(in) :: time
1607 real(real64), intent(in) :: time_delay
1608 complex(real64), intent(inout) :: rs_state(:,:)
1609
1610 integer :: ip, ip_in, wn
1611 real(real64) :: x_prop(mesh%box%dim), rr, vv(mesh%box%dim), k_vector(mesh%box%dim)
1612 real(real64) :: k_vector_abs, nn
1613 complex(real64) :: e0(mesh%box%dim)
1614 real(real64) :: e_field(mesh%box%dim), b_field(mesh%box%dim)
1615 complex(real64) :: rs_state_add(mesh%box%dim)
1616 complex(real64) :: mx_func
1617
1620 call profiling_in('PLANE_WAVES_BOUNDARIES_C')
1621
1622 if (hm%plane_waves_apply) then
1623 do wn = 1, hm%bc%plane_wave%number
1624 k_vector(:) = hm%bc%plane_wave%k_vector(1:mesh%box%dim, wn)
1625 k_vector_abs = norm2(k_vector(1:mesh%box%dim))
1626 vv(:) = hm%bc%plane_wave%v_vector(1:mesh%box%dim, wn)
1627 e0(:) = hm%bc%plane_wave%e_field(1:mesh%box%dim, wn)
1628 do ip_in = 1, hm%bc%plane_wave%points_number
1629 ip = hm%bc%plane_wave%points_map(ip_in)
1630 if (wn == 1) rs_state(ip,:) = m_z0
1631 nn = sqrt(st%ep(ip)/p_ep*st%mu(ip)/p_mu)
1632 x_prop(1:mesh%box%dim) = mesh%x(ip,1:mesh%box%dim) - vv(1:mesh%box%dim) * (time - time_delay)
1633 rr = norm2(x_prop(1:mesh%box%dim))
1634 if (hm%bc%plane_wave%modus(wn) == option__maxwellincidentwaves__plane_wave_mx_function) then
1635 ! Temporary variable assigned due to macro line length
1636 mx_func = mxf(hm%bc%plane_wave%mx_function(wn), x_prop(1:mesh%box%dim))
1637 e_field(1:mesh%box%dim) = real(e0(1:mesh%box%dim) * mx_func, real64)
1638 end if
1639 b_field(1:3) = dcross_product(k_vector, e_field) / p_c / k_vector_abs
1640 call build_rs_vector(e_field, b_field, st%rs_sign, rs_state_add, st%ep(ip), st%mu(ip))
1641 rs_state(ip, :) = rs_state(ip, :) + rs_state_add(:)
1642 end do
1643 end do
1644 else
1645 do ip_in = 1, hm%bc%plane_wave%points_number
1646 ip = hm%bc%plane_wave%points_map(ip_in)
1647 rs_state(ip,:) = m_z0
1648 end do
1649 end if
1650
1651 call profiling_out('PLANE_WAVES_BOUNDARIES_C')
1652
1655
1656 ! ---------------------------------------------------------
1657 subroutine plane_waves_propagation(hm, tr, namespace, st, gr, time, dt, time_delay)
1658 type(hamiltonian_mxll_t), intent(inout) :: hm
1659 type(propagator_mxll_t), intent(inout) :: tr
1660 type(namespace_t), intent(in) :: namespace
1661 type(states_mxll_t), intent(inout) :: st
1662 type(grid_t), intent(in) :: gr
1663 real(real64), intent(in) :: time
1664 real(real64), intent(in) :: dt
1665 real(real64), intent(in) :: time_delay
1666
1667 type(batch_t) :: ff_rs_stateb
1668 integer :: ff_dim
1669
1670 push_sub(plane_waves_propagation)
1671
1672 call profiling_in('PLANE_WAVES_PROPAGATION')
1673
1674 ff_dim = hm%dim
1675 call zbatch_init(ff_rs_stateb, 1, 1, hm%dim, gr%np_part)
1676 if (st%pack_states) call ff_rs_stateb%do_pack(copy=.false.)
1677
1678 call transform_rs_state_batch(hm, gr, st, st%rs_state_plane_wavesb, ff_rs_stateb, rs_trans_forward)
1679
1680 ! Time evolution of RS plane waves state without any coupling with H(inter_time)
1681 call hamiltonian_mxll_update(hm, time=time)
1682 hm%cpml_hamiltonian = .false.
1683 call tr%te%apply_batch(namespace, gr, hm, ff_rs_stateb, dt)
1684
1685 call transform_rs_state_batch(hm, gr, st, st%rs_state_plane_wavesb, ff_rs_stateb, rs_trans_backward)
1686 call mxll_get_batch(st%rs_state_plane_wavesb, st%rs_state_plane_waves, gr%np, st%dim)
1687 call plane_waves_boundaries_calculation(hm, st, gr, time+dt, time_delay, st%rs_state_plane_waves)
1688 call mxll_set_batch(st%rs_state_plane_wavesb, st%rs_state_plane_waves, gr%np, st%dim)
1689 call ff_rs_stateb%end()
1690
1691 call profiling_out('PLANE_WAVES_PROPAGATION')
1693 end subroutine plane_waves_propagation
1694
1695 ! ---------------------------------------------------------
1696 subroutine plane_waves_in_box_calculation(bc, time, mesh, der, st, rs_state)
1697 type(bc_mxll_t), intent(inout) :: bc
1698 real(real64), intent(in) :: time
1699 class(mesh_t), intent(in) :: mesh
1700 type(derivatives_t), intent(in) :: der
1701 type(states_mxll_t), intent(in) :: st
1702 complex(real64), intent(inout) :: rs_state(:,:)
1703
1704 real(real64) :: e_field_total(mesh%np,st%dim), b_field_total(mesh%np,st%dim)
1705 complex(real64) :: rs_state_add(mesh%np,st%dim)
1706
1708
1709 call profiling_in('PLANE_WAVES_IN_BOX_CALCULATION')
1710
1711 call external_waves_eval(bc%plane_wave, time, mesh, "E field", e_field_total)
1712 call external_waves_eval(bc%plane_wave, time, mesh, "B field", b_field_total, der=der)
1713
1714 call build_rs_state(e_field_total, b_field_total, st%rs_sign, &
1715 rs_state_add(1:mesh%np,:), mesh, st%ep, st%mu)
1716 rs_state(1:mesh%np,:) = rs_state(1:mesh%np,:) + rs_state_add(1:mesh%np,:)
1717
1718 call profiling_out('PLANE_WAVES_IN_BOX_CALCULATION')
1719
1721 end subroutine plane_waves_in_box_calculation
1722
1723 ! ---------------------------------------------------------
1724 subroutine mxll_apply_boundaries(tr, st, hm, gr, namespace, time, dt, rs_stateb)
1725 type(propagator_mxll_t), intent(inout) :: tr
1726 type(states_mxll_t), intent(inout) :: st
1727 type(hamiltonian_mxll_t),intent(inout) :: hm
1728 type(grid_t), intent(in) :: gr
1729 type(namespace_t), intent(in) :: namespace
1730 real(real64), intent(in) :: time
1731 real(real64), intent(in) :: dt
1732 type(batch_t), intent(inout) :: rs_stateb
1733
1734 complex(real64), allocatable :: rs_state(:, :)
1735
1736 push_sub(mxll_apply_boundaries)
1737
1738 safe_allocate(rs_state(gr%np, st%dim))
1739
1740 if (tr%bc_constant) then
1741 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
1742 ! Propagation dt with H(inter_time+inter_dt) for constant boundaries
1743 if (st%rs_state_const_external) then
1744 call spatial_constant_calculation(tr%bc_constant, st, gr, hm, time, dt, m_zero, rs_state)
1745 end if
1746 call constant_boundaries_calculation(tr%bc_constant, hm%bc, hm, st, rs_state)
1747 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
1748 end if
1749
1750 ! PEC mirror boundaries
1751 if (any(hm%bc%bc_type == mxll_bc_mirror_pec)) then
1752 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
1753 call mirror_pec_boundaries_calculation(hm%bc, st, rs_state)
1754 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
1755 end if
1756
1757 ! PMC mirror boundaries
1758 if (any(hm%bc%bc_type == mxll_bc_mirror_pmc)) then
1759 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
1760 call mirror_pmc_boundaries_calculation(hm%bc, st, rs_state)
1761 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
1762 end if
1763
1764 if (any(hm%bc%bc_ab_type == option__maxwellabsorbingboundaries__mask)) then
1765 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
1766 ! Apply mask absorbing boundaries
1767 call mask_absorbing_boundaries(namespace, gr, hm, st, tr, time, dt, m_zero, rs_state)
1768 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
1769 end if
1770
1771 if (tr%bc_plane_waves) then
1772 call mxll_get_batch(rs_stateb, rs_state, gr%np, st%dim)
1773 ! calculate plane waves boundaries at t
1774 call plane_waves_boundaries_calculation(hm, st, gr, time, m_zero, rs_state)
1775 call mxll_set_batch(rs_stateb, rs_state, gr%np, st%dim)
1776 end if
1777
1778 safe_deallocate_a(rs_state)
1779
1780 pop_sub(mxll_apply_boundaries)
1781 end subroutine mxll_apply_boundaries
1782
1783end module propagator_mxll_oct_m
batchified version of the BLAS axpy routine:
Definition: batch_ops.F90:156
scale a batch by a constant or vector
Definition: batch_ops.F90:164
There are several ways how to call batch_set_state and batch_get_state:
Definition: batch_ops.F90:203
batchified version of
Definition: batch_ops.F90:172
double sqrt(double __x) __attribute__((__nothrow__
subroutine, public accel_kernel_start_call(this, file_name, kernel_name, flags)
Definition: accel.F90:1376
subroutine, public accel_finish()
Definition: accel.F90:985
pure logical function, public accel_is_enabled()
Definition: accel.F90:419
integer pure function, public accel_max_workgroup_size()
Definition: accel.F90:1099
This module implements batches of mesh functions.
Definition: batch.F90:135
integer, parameter, public batch_not_packed
functions are stored in CPU memory, unpacked order
Definition: batch.F90:286
integer, parameter, public batch_device_packed
functions are stored in device memory in packed order
Definition: batch.F90:286
subroutine, public zbatch_init(this, dim, st_start, st_end, np, special, packed)
initialize a TYPE_CMPLX valued batch to given size without providing external memory
Definition: batch.F90:1917
subroutine, public dbatch_init(this, dim, st_start, st_end, np, special, packed)
initialize a TYPE_FLOAT valued batch to given size without providing external memory
Definition: batch.F90:1612
integer, parameter, public batch_packed
functions are stored in CPU memory, in transposed (packed) order
Definition: batch.F90:286
This module implements common operations on batches of mesh functions.
Definition: batch_ops.F90:118
subroutine, public batch_split_complex(np, xx, yy, zz)
extract the real and imaginary parts of a complex batch
Definition: batch_ops.F90:590
subroutine, public batch_set_zero(this, np, async)
fill all mesh functions of the batch with zero
Definition: batch_ops.F90:244
This module implements a calculator for the density and defines related functions.
Definition: density.F90:122
This module calculates the derivatives (gradients, Laplacians, etc.) of a function.
subroutine, public dderivatives_curl(der, ff, op_ff, ghost_update, set_bc)
apply the curl operator to a vector of mesh functions
subroutine, public zderivatives_batch_grad(der, ffb, opffb, ghost_update, set_bc, to_cartesian, factor)
apply the gradient to a batch of mesh functions
subroutine, public zderivatives_grad(der, ff, op_ff, ghost_update, set_bc, to_cartesian)
apply the gradient to a mesh function
subroutine, public energy_density_calc(mesh, st, rs_field, energy_dens, e_energy_dens, b_energy_dens, plane_waves_check, rs_field_plane_waves, energy_dens_plane_waves)
subroutine, public exponential_init(te, namespace, full_batch)
subroutine, public external_waves_eval(external_waves, time, mesh, type_of_field, out_field_total, der)
Calculation of external waves from parsed formula.
subroutine, public external_waves_init(external_waves, namespace)
Here, plane wave is evaluated from analytical formulae on grid.
Fast Fourier Transform module. This module provides a single interface that works with different FFT ...
Definition: fft.F90:120
real(real64), parameter, public m_two
Definition: global.F90:193
real(real64), parameter, public m_zero
Definition: global.F90:191
real(real64), parameter, public m_four
Definition: global.F90:195
real(real64), parameter, public m_pi
some mathematical constants
Definition: global.F90:189
real(real64), parameter, public m_fourth
Definition: global.F90:200
real(real64), parameter, public p_mu
Definition: global.F90:234
real(real64), parameter, public p_ep
Definition: global.F90:233
complex(real64), parameter, public m_z0
Definition: global.F90:201
complex(real64), parameter, public m_zi
Definition: global.F90:205
real(real64), parameter, public m_epsilon
Definition: global.F90:207
real(real64), parameter, public m_half
Definition: global.F90:197
real(real64), parameter, public p_c
Electron gyromagnetic ratio, see Phys. Rev. Lett. 130, 071801 (2023)
Definition: global.F90:229
real(real64), parameter, public m_one
Definition: global.F90:192
real(real64), parameter, public m_three
Definition: global.F90:194
This module implements the underlying real-space grid.
Definition: grid.F90:119
subroutine, public hamiltonian_mxll_apply_simple(hm, namespace, mesh, psib, hpsib, terms, set_bc)
subroutine, public mxll_update_pml_simple(hm, rs_stateb)
integer, parameter, public faraday_ampere_medium
subroutine, public hamiltonian_mxll_update(this, time)
Maxwell Hamiltonian update (here only the time is updated, can maybe be added to another routine)
subroutine, public mxll_copy_pml_simple(hm, rs_stateb)
The Helmholtz decomposition is intended to contain "only mathematical" functions and procedures to co...
This module implements the index, used for the mesh points.
Definition: index.F90:124
Definition: io.F90:116
This module is intended to contain "only mathematical" functions and procedures.
Definition: math.F90:117
pure real(real64) function, dimension(1:3), public dcross_product(a, b)
Definition: math.F90:1942
integer, parameter, public mxll_bc_mirror_pmc
integer, parameter, public mxll_bc_mirror_pec
integer, parameter, public mxll_bc_plane_waves
integer, parameter, public mxll_bc_medium
subroutine, public bc_mxll_generate_pml_parameters(bc, space, gr, c_factor, dt)
integer, parameter, public mxll_bc_constant
integer, parameter, public mxll_bc_zero
This module defines functions over batches of mesh functions.
Definition: mesh_batch.F90:118
subroutine, public zmesh_batch_dotp_vector(mesh, aa, bb, dot, reduce, cproduct)
calculate the vector of dot-products of mesh functions between two batches
subroutine, public dmesh_batch_dotp_vector(mesh, aa, bb, dot, reduce, cproduct)
calculate the vector of dot-products of mesh functions between two batches
Definition: mesh_batch.F90:649
This module defines various routines, operating on mesh functions.
This module defines the meshes, which are used in Octopus.
Definition: mesh.F90:120
subroutine, public messages_print_with_emphasis(msg, iunit, namespace)
Definition: messages.F90:898
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
Definition: messages.F90:162
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
Definition: messages.F90:410
this module contains the output system
Definition: output.F90:117
Some general things and nomenclature:
Definition: par_vec.F90:173
subroutine, public parse_block_string(blk, l, c, res, convert_to_c)
Definition: parser.F90:810
integer function, public parse_block(namespace, name, blk, check_varinfo_)
Definition: parser.F90:615
subroutine, public dpoisson_solve(this, namespace, pot, rho, all_nodes, kernel, reset)
Calculates the Poisson equation. Given the density returns the corresponding potential.
Definition: poisson.F90:871
subroutine, public profiling_out(label)
Increment out counter and sum up difference between entry and exit time.
Definition: profiling.F90:625
subroutine, public profiling_in(label, exclude)
Increment in counter and save entry time.
Definition: profiling.F90:554
subroutine, public transform_rs_densities(hm, mesh, rs_current_density, ff_density, sign)
subroutine, public mirror_pec_boundaries_calculation(bc, st, rs_state)
subroutine td_function_mxll_init(st, namespace, hm)
subroutine, public get_vector_pot_and_transverse_field(namespace, gr_mxll, hm_mxll, st_mxll, tr_mxll, hm, poisson_solver, helmholtz, field, transverse_field, vector_potential)
subroutine, public plane_waves_in_box_calculation(bc, time, mesh, der, st, rs_state)
subroutine, public energy_mxll_calc_batch(gr, st, hm, energy_mxll, rs_fieldb, rs_field_plane_wavesb)
subroutine plane_waves_propagation(hm, tr, namespace, st, gr, time, dt, time_delay)
subroutine cpml_conv_function_update(hm, gr, ff_rs_state_pmlb)
subroutine transform_rs_state_batch(hm, gr, st, rs_stateb, ff_rs_stateb, sign)
subroutine, public mxll_propagate_leapfrog(hm, namespace, gr, st, tr, time, dt, counter)
subroutine, public constant_boundaries_calculation(constant_calc, bc, hm, st, rs_state)
subroutine, public mask_absorbing_boundaries(namespace, gr, hm, st, tr, time, dt, time_delay, rs_state)
subroutine, public calculate_vector_potential(namespace, poisson_solver, gr, st, field, vector_potential)
subroutine pml_propagation_stage_2_batch(hm, namespace, gr, st, tr, time, dt, time_delay, ff_rs_state_pmlb, ff_rs_stateb)
subroutine, public mxll_propagation_step(hm, namespace, gr, space, st, tr, rs_stateb, ff_rs_inhom_t1, ff_rs_inhom_t2, time, dt)
subroutine, public plane_waves_boundaries_calculation(hm, st, mesh, time, time_delay, rs_state)
subroutine, public spatial_constant_calculation(constant_calc, st, gr, hm, time, dt, delay, rs_state, set_initial_state)
subroutine, public set_medium_rs_state(st, gr, hm)
subroutine cpml_conv_function_update_via_riemann_silberstein(hm, gr, ff_rs_state_pmlb)
subroutine maxwell_mask(hm, rs_state)
integer, parameter mxwll_etrs_const
subroutine, public calculate_matter_longitudinal_field(gr_mxll, st_mxll, hm_mxll, gr_elec, hm_elec, rs_state_matter)
subroutine, public mxll_propagate_expgauss1(hm, namespace, gr, st, tr, time, dt)
Exponential propagation scheme with Gauss collocation points, s=1.
subroutine transform_rs_densities_to_6x6_rs_densities_forward(mesh, rs_current_density, rs_density_6x6)
subroutine, public energy_mxll_calc(gr, st, hm, energy_mxll, rs_field, rs_field_plane_waves)
subroutine, public mxll_propagate_expgauss2(hm, namespace, gr, st, tr, time, dt)
Exponential propagation scheme with Gauss collocation points, s=2.
integer, parameter, public rs_trans_backward
subroutine transform_rs_densities_to_6x6_rs_densities_backward(mesh, rs_density_6x6, rs_current_density)
subroutine, public mirror_pmc_boundaries_calculation(bc, st, rs_state)
subroutine, public mxll_apply_boundaries(tr, st, hm, gr, namespace, time, dt, rs_stateb)
subroutine pml_propagation_stage_1_batch(hm, gr, st, tr, ff_rs_stateb, ff_rs_state_pmlb)
subroutine, public propagator_mxll_init(gr, namespace, st, hm, tr)
This module defines the quantity_t class and the IDs for quantities, which can be exposed by a system...
Definition: quantity.F90:140
subroutine, public mxll_set_batch(rs_stateb, rs_state, np, dim, offset)
subroutine, public get_electric_field_vector(rs_state_vector, electric_field_vector, ep_element)
subroutine, public build_rs_vector(e_vector, b_vector, rs_sign, rs_vector, ep_element, mu_element)
subroutine, public mxll_get_batch(rs_stateb, rs_state, np, dim, offset)
subroutine, public build_rs_state(e_field, b_field, rs_sign, rs_state, mesh, ep_field, mu_field, np)
subroutine, public get_magnetic_field_state(rs_state, mesh, rs_sign, magnetic_field, mu_field, np)
subroutine, public get_magnetic_field_vector(rs_state_vector, rs_sign, magnetic_field_vector, mu_element)
subroutine, public tdf_read(f, namespace, function_name, ierr)
This function initializes "f" from the TDFunctions block.
Definition: tdfunction.F90:220
Class defining batches of mesh functions.
Definition: batch.F90:161
class representing derivatives
Description of the grid, containing information on derivatives, stencil, and symmetries.
Definition: grid.F90:171
Describes mesh distribution to nodes.
Definition: mesh.F90:187
int true(void)