11 #include "sll_assert.h"
12 #include "sll_memory.h"
13 #include "sll_working_precision.h"
35 sll_s_uniform_bsplines_eval_basis
90 sll_real64,
allocatable :: work0(:)
91 sll_real64,
allocatable :: work01(:)
92 sll_real64,
allocatable :: work02(:)
93 sll_real64,
allocatable :: work1(:)
94 sll_real64,
allocatable :: work12(:)
95 sll_real64,
allocatable :: work2(:)
96 sll_real64,
allocatable :: work22(:)
115 logical :: adiabatic_electrons = .false.
170 sll_real64,
intent( in ) :: delta_t
171 sll_real64,
intent( in ) :: field_in(:)
172 sll_real64,
intent( inout ) :: field_out(:)
174 call self%multiply_mass( [2], field_in, self%work2 )
175 call self%multiply_ct( self%work2, self%work1 )
178 call self%multiply_mass_inverse( 1, self%work1, self%work12)
180 field_out = field_out + delta_t*self%work12
189 sll_real64,
intent( in ) :: delta_t
190 sll_real64,
intent( in ) :: field_in(:)
191 sll_real64,
intent( inout ) :: field_out(:)
193 call self%multiply_c( field_in, self%work2 )
195 field_out = field_out - delta_t * self%work2
203 sll_real64,
intent(in) :: delta_t
204 sll_real64,
intent(inout) :: efield(:)
205 sll_real64,
intent(inout) :: bfield(:)
206 sll_real64,
optional :: betar
210 if(
present(betar) )
then
222 call self%multiply_mass( [2], bfield, self%work2 )
223 call self%multiply_ct( self%work2, self%work1 )
225 self%linear_op_schur_eb%sign = -delta_t**2*0.25_f64*factor
226 call self%linear_op_schur_eb%dot( efield, self%work12 )
227 self%work12 = self%work12 + delta_t*factor*self%work1
233 self%linear_op_schur_eb%sign = delta_t**2*0.25_f64
234 call self%linear_solver_schur_eb%set_guess( efield )
235 call self%linear_solver_schur_eb%solve( self%work12, efield)
238 self%work1 = self%work1 + efield
239 call self%compute_B_from_E( delta_t*0.5_f64, self%work1, bfield)
247 sll_real64,
intent( in ) :: field_in(:)
248 sll_real64,
intent( out ) :: field_out(:)
250 call self%poisson_solver%solve( field_in, self%work0 )
252 call self%multiply_g( self%work0, field_out )
253 field_out = -field_out
262 sll_real64,
intent( in ) :: field_in(:)
263 sll_real64,
intent( out ) :: field_out(:)
265 call self%multiply_mass( [1], field_in, self%work1 )
266 call self%multiply_gt( self%work1, field_out )
267 field_out = - field_out
275 sll_real64,
intent( in ) :: current(:)
276 sll_real64,
intent( inout ) :: e(:)
277 sll_int32,
intent( in ),
optional :: component
279 if(
present(component) )
then
280 print*,
'compute_e_from_j_3d_trafo not implemented for single component'
282 call self%multiply_mass_inverse( 1, current, self%work1 )
292 sll_real64,
intent( in ) :: field_in(:)
293 sll_real64,
intent( inout ) :: field_out(:)
294 sll_real64,
intent( out ) :: efield_dofs(:)
296 call self%multiply_mass_inverse( 0, field_in, field_out )
297 call self%multiply_g( field_out, efield_dofs )
298 efield_dofs = -efield_dofs
306 sll_real64,
intent( in ) :: field_in(:)
307 sll_real64,
intent( inout ) :: field_out(:)
308 sll_real64,
intent( out ) :: efield_dofs(:)
310 call self%multiply_gt( field_in, self%work0 )
311 call self%multiply_mass_inverse( 0, self%work0, self%work01 )
312 field_out = field_out + self%work01
314 call self%multiply_g( field_out, efield_dofs )
315 efield_dofs = -efield_dofs
324 sll_int32,
intent( in ) :: form
325 sll_int32,
intent( in ) :: component
326 sll_real64,
intent( out ) :: coefs_dofs(:)
331 sll_int32 :: degree(3)
334 if ( form == 0 )
then
335 call rhs_zeroform( self, self%s_deg_0, func1, coefs_dofs )
336 elseif (form == 1 )
then
337 degree = self%s_deg_0
338 degree(component) = self%s_deg_1(component)
339 call rhs_oneform( self, degree, func1, func2, func3, component, coefs_dofs )
340 elseif( form == 2)
then
341 degree = self%s_deg_1
342 degree(component) = self%s_deg_0(component)
343 call rhs_twoform( self, degree, func1, func2, func3, component, coefs_dofs )
345 print*,
'Wrong form.'
354 sll_int32,
intent( in ) :: deg(3)
356 sll_real64,
intent( out ) :: coefs_dofs(:)
358 sll_int32 :: i1, i2, i3,j1, j2, j3, k1, k2, k3, q(3), index1d
359 sll_real64 :: jacobian, c(3)
360 sll_real64,
allocatable :: xw_gauss_d1(:,:), xw_gauss_d2(:,:), xw_gauss_d3(:,:)
361 sll_real64,
allocatable :: bspl_d1(:,:), bspl_d2(:,:), bspl_d3(:,:)
362 sll_real64 :: scratch(maxval(deg+1))
366 allocate(xw_gauss_d2(2, q(2)))
367 allocate(bspl_d2(q(2), deg(2)+1))
371 call sll_s_uniform_bsplines_eval_basis(deg(2),xw_gauss_d2(1,k2), scratch(1:deg(2)+1))
372 bspl_d2(k2,:) = scratch(1:deg(2)+1)
375 allocate(xw_gauss_d3(2,q(3)))
376 allocate(bspl_d3(q(3), deg(3)+1 ))
380 call sll_s_uniform_bsplines_eval_basis(deg(3),xw_gauss_d3(1,k3), scratch(1:deg(3)+1) )
381 bspl_d3(k3,:) = scratch(1:deg(3)+1)
385 allocate(xw_gauss_d1(2, q(1)))
386 allocate(bspl_d1(q(1), deg(1)+1 ))
389 if( deg(1) == self%s_deg_0(1) )
then
390 spline_pp => self%spline0_pp
391 else if (deg(1) == self%s_deg_1(1))
then
392 spline_pp => self%spline1_pp
394 print*,
"error in compute rhs"
406 do i3 = 1, self%n_cells(3)
407 do i2 = 1, self%n_cells(2)
414 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
417 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
419 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
421 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
422 jacobian = self%map%jacobian( c )
423 coefs_dofs(index1d) = coefs_dofs(index1d) + &
424 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
426 func(self%map%get_x(c) ) * &
429 bspl_d3(k3,j3) * abs(jacobian)
438 do i1 = max(deg(1), 1), min(self%n_cells(1)+1-deg(1), self%n_cells(1))
443 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
446 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
448 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
450 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
451 jacobian = self%map%jacobian( c )
452 coefs_dofs(index1d) = coefs_dofs(index1d) + &
453 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
455 func(self%map%get_x(c) ) * &
458 bspl_d3(k3,j3) * abs(jacobian)
467 do i1 = self%n_cells(1)-deg(1)+2, self%n_cells(1)
472 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
475 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
477 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
479 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
480 jacobian = self%map%jacobian( c )
481 coefs_dofs(index1d) = coefs_dofs(index1d) + &
482 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
484 func( self%map%get_x(c) ) * &
485 sll_f_spline_pp_horner_1d( deg(1), spline_pp%poly_coeffs_boundary_right(:,:,i1-self%n_cells(1)+deg(1)-1), xw_gauss_d1(1,k1), j1)*&
487 bspl_d3(k3,j3) * abs(jacobian)
505 subroutine rhs_oneform( self, deg, func1, func2, func3, component, coefs_dofs )
507 sll_int32,
intent( in ) :: deg(3)
511 sll_int32,
intent( in ) :: component
512 sll_real64,
intent( out ) :: coefs_dofs(:)
514 sll_int32 :: i1, i2, i3,j1, j2, j3, k1, k2, k3, q(3),index1d
515 sll_real64 :: jacobian, jmatrix(3,3), c(3)
516 sll_real64,
allocatable :: xw_gauss_d1(:,:), xw_gauss_d2(:,:), xw_gauss_d3(:,:)
517 sll_real64,
allocatable :: bspl_d1(:,:), bspl_d2(:,:), bspl_d3(:,:)
518 sll_real64 :: scratch(maxval(deg+1))
522 allocate(xw_gauss_d2(2, q(2)))
523 allocate(bspl_d2(q(2), deg(2)+1))
527 call sll_s_uniform_bsplines_eval_basis(deg(2),xw_gauss_d2(1,k2), scratch(1:deg(2)+1))
528 bspl_d2(k2,:) = scratch(1:deg(2)+1)
531 allocate(xw_gauss_d3(2,q(3)))
532 allocate(bspl_d3(q(3), deg(3)+1 ))
536 call sll_s_uniform_bsplines_eval_basis(deg(3),xw_gauss_d3(1,k3), scratch(1:deg(3)+1) )
537 bspl_d3(k3,:) = scratch(1:deg(3)+1)
541 allocate(xw_gauss_d1(2,q(1)))
542 allocate(bspl_d1(q(1), deg(1)+1 ))
545 if( deg(1) == self%s_deg_0(1) )
then
546 spline_pp => self%spline0_pp
547 else if (deg(1) == self%s_deg_1(1))
then
548 spline_pp => self%spline1_pp
550 print*,
"error in compute rhs"
562 do i3 = 1, self%n_cells(3)
563 do i2 = 1, self%n_cells(2)
570 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
573 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
575 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
577 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1-1,f64))
578 jacobian = self%map%jacobian( c )
579 jmatrix = self%map%jacobian_matrix_inverse_transposed( c )
580 coefs_dofs(index1d) = coefs_dofs(index1d) + &
581 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
583 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
584 func2( self%map%get_x(c) )*jmatrix(2,component) + &
585 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
588 bspl_d3(k3,j3)* abs(jacobian)
596 do i1 = max(deg(1), 1), min(self%n_cells(1)+1-deg(1), self%n_cells(1))
601 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
604 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
606 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
608 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1-1,f64))
609 jacobian = self%map%jacobian( c )
610 jmatrix = self%map%jacobian_matrix_inverse_transposed( c )
611 coefs_dofs(index1d) = coefs_dofs(index1d) + &
612 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
614 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
615 func2( self%map%get_x(c) )*jmatrix(2,component) + &
616 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
619 bspl_d3(k3,j3) * abs(jacobian)
627 do i1 = self%n_cells(1)-deg(1)+2, self%n_cells(1)
632 index1d = i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
635 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
637 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
639 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1-1,f64))
640 jacobian = self%map%jacobian( c )
641 jmatrix = self%map%jacobian_matrix_inverse_transposed( c )
642 coefs_dofs(index1d) = coefs_dofs(index1d) + &
643 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
645 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
646 func2( self%map%get_x(c) )*jmatrix(2,component) + &
647 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
648 sll_f_spline_pp_horner_1d( deg(1), spline_pp%poly_coeffs_boundary_right(:,:,i1-self%n_cells(1)+deg(1)-1), xw_gauss_d1(1,k1), j1)*&
650 bspl_d3(k3,j3) *abs(jacobian)
667 subroutine rhs_twoform( self, deg, func1, func2, func3, component, coefs_dofs )
669 sll_int32,
intent( in ) :: deg(3)
673 sll_int32,
intent( in ) :: component
674 sll_real64,
intent( out ) :: coefs_dofs(:)
676 sll_int32 :: i1, i2, i3,j1, j2, j3, k1, k2, k3, q(3), index1d
677 sll_real64 :: jmatrix(3,3), c(3)
678 sll_real64,
allocatable :: xw_gauss_d1(:,:), xw_gauss_d2(:,:), xw_gauss_d3(:,:)
679 sll_real64,
allocatable :: bspl_d1(:,:), bspl_d2(:,:), bspl_d3(:,:)
680 sll_real64 :: scratch(maxval(deg+1))
684 allocate(xw_gauss_d2(2, q(2)))
685 allocate(bspl_d2(q(2), deg(2)+1))
689 call sll_s_uniform_bsplines_eval_basis(deg(2),xw_gauss_d2(1,k2), scratch(1:deg(2)+1))
690 bspl_d2(k2,:) = scratch(1:deg(2)+1)
693 allocate(xw_gauss_d3(2,q(3)))
694 allocate(bspl_d3(q(3), deg(3)+1 ))
698 call sll_s_uniform_bsplines_eval_basis(deg(3),xw_gauss_d3(1,k3), scratch(1:deg(3)+1) )
699 bspl_d3(k3,:) = scratch(1:deg(3)+1)
703 allocate(xw_gauss_d1(2,q(1)))
704 allocate(bspl_d1(q(1), deg(1)+1 ))
707 if( deg(1) == self%s_deg_0(1) )
then
708 spline_pp => self%spline0_pp
709 else if (deg(1) == self%s_deg_1(1))
then
710 spline_pp => self%spline1_pp
712 print*,
"error in compute rhs"
724 do i3 = 1, self%n_cells(3)
725 do i2 = 1, self%n_cells(2)
732 index1d=i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
735 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
737 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
739 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
740 jmatrix=self%map%jacobian_matrix( c )
741 coefs_dofs(index1d) = coefs_dofs(index1d) + &
742 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
744 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
745 func2( self%map%get_x(c) )*jmatrix(2,component) + &
746 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
758 do i1 = max(deg(1), 1), min(self%n_cells(1)+1-deg(1), self%n_cells(1))
763 index1d=i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
766 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
768 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
770 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
771 jmatrix=self%map%jacobian_matrix( c )
772 coefs_dofs(index1d) = coefs_dofs(index1d) + &
773 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
775 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
776 func2( self%map%get_x(c) )*jmatrix(2,component) + &
777 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
789 do i1 = self%n_cells(1)-deg(1)+2, self%n_cells(1)
794 index1d=i1+j1-1+modulo(i2-deg(2)+j2-2,self%n_cells(2))*(self%n_cells(1)+deg(1))+modulo(i3-deg(3)+j3-2,self%n_cells(3))*(self%n_cells(1)+deg(1))*self%n_cells(2)
797 c(3) = self%delta_x(3)*(xw_gauss_d3(1,k3) + real(i3-1,f64))
799 c(2) = self%delta_x(2)*(xw_gauss_d2(1,k2) + real(i2-1,f64))
801 c(1) = self%delta_x(1)*(xw_gauss_d1(1,k1)+ real(i1 - 1,f64))
802 jmatrix=self%map%jacobian_matrix( c )
803 coefs_dofs(index1d) = coefs_dofs(index1d) + &
804 self%volume * xw_gauss_d1(2,k1)* xw_gauss_d2(2,k2)* &
806 ( func1( self%map%get_x(c) )*jmatrix(1,component) + &
807 func2( self%map%get_x(c) )*jmatrix(2,component) + &
808 func3( self%map%get_x(c) )*jmatrix(3,component)) * &
809 sll_f_spline_pp_horner_1d( deg(1), spline_pp%poly_coeffs_boundary_right(:,:,i1-self%n_cells(1)+deg(1)-1), xw_gauss_d1(1,k1), j1)*&
828 sll_int32,
intent( in ) :: form
829 sll_int32,
intent( in ) :: component
830 sll_real64,
intent( out ) :: coefs_dofs(:)
835 if(
present(func2) .and.
present(func3) )
then
840 call sll_s_compute_rhs_trafo( self, 1, 2, self%work1(1+self%n_total1:self%n_total1+self%n_total0), func1, func2, func3 )
841 call sll_s_compute_rhs_trafo( self, 1, 3, self%work1(1+self%n_total1+self%n_total0:self%n_total1+self%n_total0*2), func1, func2, func3 )
842 call self%multiply_mass_inverse( 1, self%work1, coefs_dofs )
846 call sll_s_compute_rhs_trafo( self, 2, 2, self%work2(1+self%n_total0:self%n_total0+self%n_total1), func1, func2, func3 )
847 call sll_s_compute_rhs_trafo( self, 2, 3, self%work2(1+self%n_total0+self%n_total1:self%n_total0+self%n_total1*2), func1, func2, func3 )
848 call self%multiply_mass_inverse( 2, self%work2, coefs_dofs )
850 print*,
'L2projection for', form,
'-form not implemented.'
856 call self%multiply_mass_inverse( 0, self%work0, coefs_dofs )
858 print*,
'l2 projection not for single function or component implemented'
868 sll_real64 :: coefs(:)
870 sll_int32 :: component
881 sll_real64 :: coefs1(:)
882 sll_real64 :: coefs2(:)
884 sll_int32,
optional :: component
888 sll_int32 :: istart, iend
890 if ( form == 0 )
then
891 call self%multiply_mass( [0], coefs2, self%work0 )
892 r = sum(coefs1*self%work0)
893 elseif ( form == 1 )
then
894 if (
present(component))
then
895 if( component == 1)
then
898 else if( component == 2)
then
899 istart = 1+self%n_total1
900 iend = self%n_total1+self%n_total0
901 else if( component == 3)
then
902 istart = 1+self%n_total1+self%n_total0
903 iend = self%n_total1+self%n_total0*2
907 iend=self%n_total1+2*self%n_total0
909 call self%multiply_mass( [1], coefs2, self%work1 )
910 r = sum(coefs1(istart:iend)*self%work1(istart:iend))
911 elseif( form == 2)
then
912 if (
present(component))
then
913 if( component == 1)
then
916 else if( component == 2)
then
917 istart = 1+self%n_total0
918 iend = self%n_total0+self%n_total1
919 else if( component == 3)
then
920 istart = 1+self%n_total0+self%n_total1
921 iend = self%n_total0+self%n_total1*2
925 iend=self%n_total0+2*self%n_total1
927 call self%multiply_mass( [2], coefs2, self%work2 )
928 r = sum(coefs1(istart:iend)*self%work2(istart:iend))
930 print*,
'Wrong form.'
937 subroutine init_3d_trafo( self, domain, n_cells, s_deg_0, boundary, map, mass_tolerance, poisson_tolerance, solver_tolerance, adiabatic_electrons, profile )
939 sll_real64,
intent(in) :: domain(3,2)
940 sll_int32,
intent( in ) :: n_cells(3)
941 sll_int32,
intent( in ) :: s_deg_0(3)
942 sll_int32,
intent( in ) :: boundary(3)
944 sll_real64,
intent(in),
optional :: mass_tolerance
945 sll_real64,
intent(in),
optional :: poisson_tolerance
946 sll_real64,
intent(in),
optional :: solver_tolerance
947 logical,
intent(in),
optional :: adiabatic_electrons
950 sll_int32 :: j, deg1(3), deg2(3)
955 if (
present( mass_tolerance) )
then
956 self%mass_solver_tolerance = mass_tolerance
958 self%mass_solver_tolerance = 1d-12
960 if (
present( poisson_tolerance) )
then
961 self%poisson_solver_tolerance = poisson_tolerance
963 self%poisson_solver_tolerance = 1d-12
965 if (
present( solver_tolerance) )
then
966 self%solver_tolerance = solver_tolerance
968 self%solver_tolerance = 1d-12
971 if(
present( adiabatic_electrons ) )
then
972 self%adiabatic_electrons = adiabatic_electrons
975 if(
present( profile ) )
then
976 self%profile = profile
979 self%n_cells = n_cells
980 self%n_dofs = n_cells
981 self%n_dofs(1) = n_cells(1)+s_deg_0(1)
982 self%n_total = product(n_cells)
983 self%n_total0 = product(self%n_dofs)
984 self%n_total1 = (self%n_dofs(1)-1)*n_cells(2)*n_cells(3)
985 self%delta_x = 1._f64 / real(n_cells,f64)
986 self%s_deg_0 = s_deg_0
987 self%s_deg_1 = s_deg_0 - 1
988 self%volume = product(self%delta_x)
991 allocate( self%spline0_pp )
992 allocate( self%spline1_pp )
997 allocate(self%work0(1:self%n_total0))
998 allocate(self%work01(1:self%n_total0))
999 allocate(self%work02(1:self%n_total0))
1000 allocate(self%work1(1:self%n_total1+2*self%n_total0))
1001 allocate(self%work12(1:self%n_total1+2*self%n_total0))
1002 allocate(self%work2(1:self%n_total0+2*self%n_total1))
1003 allocate(self%work22(1:self%n_total0+2*self%n_total1))
1009 if(self%adiabatic_electrons)
then
1015 deg1(1) = self%s_deg_1(1)
1016 if(deg1(1) == 0 )
then
1022 deg1(1) = self%s_deg_0(1)
1027 deg1(j) = self%s_deg_1(j)
1031 deg1(j) = self%s_deg_0(j)
1032 if(deg1(1) == 0 )
then
1039 if(self%map%flag2d )
then
1042 deg1(1) = self%s_deg_1(1)
1044 deg2(2) = self%s_deg_1(2)
1048 deg1(1) = self%s_deg_0(1)
1050 deg2(2) = self%s_deg_0(2)
1053 if(self%map%flag3d)
then
1056 deg1(2)=self%s_deg_1(2)
1058 deg2(3) = self%s_deg_1(3)
1062 deg1(2) = self%s_deg_0(2)
1064 deg2(3) = self%s_deg_0(3)
1065 if(deg1(1) == 0 .and. deg2(1) == 0)
then
1073 deg1(3)=self%s_deg_1(3)
1075 deg2(1) = self%s_deg_1(1)
1079 deg1(3) = self%s_deg_0(3)
1081 deg2(1) = self%s_deg_0(1)
1087 call self%mass1_operator%create( 3, 3 )
1088 call self%mass2_operator%create( 3, 3 )
1091 call self%mass1_operator%set( j, j, self%mass1(j,j) )
1092 call self%mass2_operator%set( j, j, self%mass2(j,j) )
1094 if(self%map%flag2d)
then
1095 call self%mass1_operator%set( 1, 2, self%mass1(1,2) )
1096 call self%mass1_operator%set( 2, 1, self%mass1(2,1) )
1097 call self%mass2_operator%set( 1, 2, self%mass2(1,2) )
1098 call self%mass2_operator%set( 2, 1, self%mass2(2,1) )
1099 if(self%map%flag3d)
then
1101 call self%mass1_operator%set( j, modulo(j,3)+1, self%mass1(j, modulo(j,3)+1) )
1102 call self%mass1_operator%set( modulo(j,3)+1, j, self%mass1(modulo(j,3)+1, j) )
1103 call self%mass2_operator%set( j, modulo(j,3)+1, self%mass2(j, modulo(j,3)+1) )
1104 call self%mass2_operator%set( modulo(j,3)+1, j, self%mass2(modulo(j,3)+1, j) )
1109 call self%preconditioner_fft%init( self%Lx, n_cells, s_deg_0, .true. )
1111 self%work12 = 1._f64
1112 call self%mass1_operator%dot(self%work12, self%work1)
1113 do j = 1, self%n_dofs(2)*self%n_dofs(3)
1114 self%work1(self%n_total1+1+(j-1)*self%n_dofs(1)) = 1._f64
1115 self%work1(self%n_total1+j*self%n_dofs(1)) = 1._f64
1116 self%work1(self%n_total1+self%n_total0+1+(j-1)*self%n_dofs(1)) = 1._f64
1117 self%work1(self%n_total1+self%n_total0+j*self%n_dofs(1)) = 1._f64
1119 self%work1 = 1._f64/sqrt(self%work1)
1121 self%work22 = 1._f64
1122 call self%mass2_operator%dot(self%work22, self%work2)
1123 do j = 1, self%n_dofs(2)*self%n_dofs(3)
1124 self%work2(1+(j-1)*self%n_dofs(1)) = 1._f64
1125 self%work2(j*self%n_dofs(1)) = 1._f64
1127 self%work2 = 1._f64/sqrt(self%work2)
1129 call self%preconditioner1%create( self%preconditioner_fft%inverse_mass1_3d, self%work1, 2*self%n_total0+self%n_total1 )
1130 call self%preconditioner2%create( self%preconditioner_fft%inverse_mass2_3d, self%work2, 2*self%n_total1+self%n_total0 )
1134 self%work12 = 0._f64
1136 self%work22 = 0._f64
1139 call self%mass0_solver%create( self%mass0 )
1140 call self%mass1_solver%create( self%mass1_operator, self%preconditioner1)
1141 call self%mass2_solver%create( self%mass2_operator, self%preconditioner2)
1142 self%mass0_solver%atol = self%mass_solver_tolerance
1143 self%mass1_solver%atol = self%mass_solver_tolerance/maxval(self%Lx)
1144 self%mass2_solver%atol = self%mass_solver_tolerance/maxval(self%Lx)**2
1151 call self%poisson_matrix%create( self%mass1_operator, self%s_deg_0, self%n_dofs, self%delta_x)
1153 do j= 1, self%n_total0
1154 self%work01 = 0._f64
1155 self%work01(j) = 1._f64
1156 call self%poisson_matrix%dot( self%work01, self%work02 )
1157 if (abs(self%work02(j))< 1d-13)
then
1158 self%work0(j) = 1._f64
1160 self%work0(j) = 1._f64/sqrt(self%work02(j))
1163 self%work0 = 1._f64/sqrt(self%work0)
1164 call self%poisson_preconditioner%create( self%n_dofs, self%s_deg_0, self%delta_x, self%work0 )
1165 call self%poisson_solver%create( self%poisson_matrix, self%poisson_preconditioner )
1166 self%poisson_solver%atol = self%poisson_solver_tolerance
1170 call self%linear_op_schur_eb%create( self%mass1_operator, self%mass2_operator, self%n_dofs, self%delta_x, self%s_deg_0 )
1171 call self%linear_solver_schur_eb%create( self%linear_op_schur_eb, self%preconditioner1 )
1172 self%linear_solver_schur_eb%atol = self%solver_tolerance
1179 sll_real64,
intent(in) :: x(3)
1180 sll_int32,
optional,
intent(in) :: component(:)
1182 profile_m0 = self%map%jacobian( x ) * self%profile%rho_0( x(1) )/ self%profile%T_e( x(1) )
1188 sll_real64,
intent(in) :: x(3)
1189 sll_int32,
optional,
intent(in) :: component(:)
1197 sll_real64,
intent(in) :: x(3)
1198 sll_int32,
optional,
intent(in) :: component(:)
1200 profile_1 = self%map%metric_inverse_single_jacobian( x, component(1), component(1) )
1206 sll_real64,
intent(in) :: x(3)
1207 sll_int32,
optional,
intent(in) :: component(:)
1209 profile_2 = self%map%metric_single_jacobian( x, component(1), component(1) )
1215 sll_real64,
intent(in) :: x(3)
1216 sll_int32,
optional,
intent(in) :: component(:)
1218 profile_m1 = self%map%metric_inverse_single_jacobian( x, component(1), component(2) )
1223 sll_real64,
intent(in) :: x(3)
1224 sll_int32,
optional,
intent(in) :: component(:)
1226 profile_m2 = self%map%metric_single_jacobian( x, component(1), component(2) )
1236 sll_real64,
intent(in) :: domain(3,2)
1237 sll_int32,
intent( in ) :: n_cells(3)
1238 sll_int32,
intent( in ) :: s_deg_0(3)
1239 sll_int32,
intent( in ) :: boundary(3)
1241 character(len=*),
intent(in) :: nml_file
1242 logical,
intent(in),
optional :: adiabatic_electrons
1245 character(len=256) :: file_prefix
1246 sll_int32 :: input_file
1247 sll_int32 :: io_stat, io_stat0, io_stat1, rank, file_id
1248 sll_real64 :: mass_tolerance
1249 sll_real64 :: poisson_tolerance
1250 sll_real64 :: maxwell_tolerance
1252 namelist /output/ file_prefix
1253 namelist /maxwell_solver/ mass_tolerance, poisson_tolerance
1254 namelist /time_solver/ maxwell_tolerance
1259 if(
present( adiabatic_electrons) )
then
1260 self%adiabatic_electrons = adiabatic_electrons
1263 if(
present( profile ) )
then
1264 self%profile = profile
1268 open(newunit = input_file, file=nml_file, status=
'old',iostat=io_stat)
1269 if (io_stat /= 0)
then
1270 if (rank == 0 )
then
1271 print*,
'sll_m_maxwell_3d_trafo: Input file does not exist. Set default tolerance.'
1272 open(newunit=file_id, file=trim(file_prefix)//
'_parameters_used.dat', position =
'append', status=
'old', action=
'write', iostat=io_stat)
1273 write(file_id, *)
'mass solver tolerance:', 1d-12
1274 write(file_id, *)
'poisson solver tolerance:', 1d-12
1277 call self%init( domain, n_cells, s_deg_0, boundary, map )
1279 read(input_file, output,iostat=io_stat0)
1280 read(input_file, maxwell_solver,iostat=io_stat)
1281 read(input_file, time_solver,iostat=io_stat1)
1282 if (io_stat /= 0 .and. io_stat1 /= 0)
then
1283 if (rank == 0 )
then
1284 print*,
'sll_m_maxwell_3d_trafo: Input parameter does not exist. Set default tolerance.'
1285 open(newunit=file_id, file=trim(file_prefix)//
'_parameters_used.dat', position =
'append', status=
'old', action=
'write', iostat=io_stat)
1286 write(file_id, *)
'mass solver tolerance:', 1d-12
1287 write(file_id, *)
'poisson solver tolerance:', 1d-12
1290 call self%init( domain, n_cells, s_deg_0, boundary, map )
1291 else if (io_stat /= 0 .and. io_stat1 == 0)
then
1292 call self%init( domain, n_cells, s_deg_0, boundary, map, solver_tolerance=maxwell_tolerance )
1293 else if (io_stat == 0 .and. io_stat1 /= 0)
then
1294 if (rank == 0 )
then
1295 open(newunit=file_id, file=trim(file_prefix)//
'_parameters_used.dat', position =
'append', status=
'old', action=
'write', iostat=io_stat)
1296 write(file_id, *)
'mass solver tolerance:', mass_tolerance
1297 write(file_id, *)
'poisson solver tolerance:', poisson_tolerance
1300 call self%init( domain, n_cells, s_deg_0, boundary, map, mass_tolerance, poisson_tolerance )
1302 if (rank == 0 )
then
1303 open(newunit=file_id, file=trim(file_prefix)//
'_parameters_used.dat', position =
'append', status=
'old', action=
'write', iostat=io_stat)
1304 write(file_id, *)
'mass solver tolerance:', mass_tolerance
1305 write(file_id, *)
'poisson solver tolerance:', poisson_tolerance
1308 call self%init( domain, n_cells, s_deg_0, boundary, map, mass_tolerance, poisson_tolerance, maxwell_tolerance )
1321 call self%mass0_solver%free()
1322 call self%mass1_solver%free()
1323 call self%mass2_solver%free()
1324 call self%mass1_operator%free()
1325 call self%mass2_operator%free()
1326 call self%poisson_solver%free()
1327 call self%poisson_matrix%free()
1328 call self%linear_solver_schur_eb%free()
1329 call self%linear_op_schur_eb%free()
1334 deallocate( self%work0 )
1335 deallocate( self%work01 )
1336 deallocate( self%work1 )
1337 deallocate( self%work12 )
1338 deallocate( self%work2 )
1339 deallocate( self%work22 )
1348 sll_real64,
intent( in ) :: field_in(:)
1349 sll_real64,
intent( out ) :: field_out(:)
1359 sll_real64,
intent( in ) :: field_in(:)
1360 sll_real64,
intent( out ) :: field_out(:)
1370 sll_real64,
intent( in ) :: field_in(:)
1371 sll_real64,
intent( out ) :: field_out(:)
1381 sll_real64,
intent( in ) :: field_in(:)
1382 sll_real64,
intent( out ) :: field_out(:)
1392 sll_int32,
intent( in ) :: deg(:)
1393 sll_real64,
intent( in ) :: coefs_in(:)
1394 sll_real64,
intent( out ) :: coefs_out(:)
1396 if(
size(deg) == 1 )
then
1397 sll_assert(deg(1)>=0 .and. deg(1)<=2)
1400 call self%mass0%dot( coefs_in, coefs_out )
1402 call self%mass1_operator%dot( coefs_in, coefs_out )
1404 call self%mass2_operator%dot( coefs_in, coefs_out )
1406 print*,
'multiply mass for other form not yet implemented'
1409 else if(
size(deg) == 3 )
then
1419 sll_int32,
intent( in ) :: form
1420 sll_real64,
intent( in ) :: coefs_in(:)
1421 sll_real64,
intent( out ) :: coefs_out(:)
1426 sll_assert(form>=0 .and. form<=2)
1429 call self%mass0_solver%solve( coefs_in, coefs_out )
1430 do j = 1, self%n_dofs(2)*self%n_dofs(3)
1431 coefs_out(1+(j-1)*self%n_dofs(1)) = 0._f64
1432 coefs_out(j*self%n_dofs(1)) = 0._f64
1435 call self%mass1_solver%solve( coefs_in, coefs_out )
1436 do j = 1, self%n_dofs(2)*self%n_dofs(3)
1437 coefs_out(self%n_total1+1+(j-1)*self%n_dofs(1)) = 0._f64
1438 coefs_out(self%n_total1+j*self%n_dofs(1)) = 0._f64
1439 coefs_out(self%n_total1+self%n_total0+1+(j-1)*self%n_dofs(1)) = 0._f64
1440 coefs_out(self%n_total1+self%n_total0+j*self%n_dofs(1)) = 0._f64
1443 call self%mass2_solver%solve( coefs_in, coefs_out )
1444 do j = 1, self%n_dofs(2)*self%n_dofs(3)
1445 coefs_out(1+(j-1)*self%n_dofs(1)) = 0._f64
1446 coefs_out(j*self%n_dofs(1)) = 0._f64
1449 print*,
'multiply inverse mass for other form not yet implemented'
integer(kind=i32) function, public sll_f_get_collective_rank(col)
Determines the rank of the calling process in the communicator.
type(sll_t_collective_t), pointer, public sll_v_world_collective
Control of subset assignment. Processes with the same color are in the same new communicator.
Gauss-Legendre integration.
real(kind=f64) function, dimension(2, 1:npoints), public sll_f_gauss_legendre_points_and_weights(npoints, a, b)
Returns a 2d array of size (2,npoints) containing gauss-legendre points and weights in the interval [...
module for a block linear operator
module for conjugate gradient method in pure form
Low level arbitrary degree splines.
Module interfaces for coordinate transformation.
module for Compressed Sparse Row Matrix (CSR)
Module interface to solve Maxwell's equations in 3D.
Module interface to solve Maxwell's equations with coordinate transformation in 3D.
subroutine sll_s_compute_e_from_b_3d_trafo(self, delta_t, field_in, field_out)
compute E from B using weak Ampere formulation
real(kind=f64) function inner_product_3d_trafo(self, coefs1, coefs2, form, component)
Compute inner product.
subroutine sll_s_compute_rhs_trafo(self, form, component, coefs_dofs, func1, func2, func3)
Compute the FEM right-hand-side for a given function f and periodic splines of given degree Its compo...
subroutine multiply_mass_3d_trafo(self, deg, coefs_in, coefs_out)
Multiply by the mass matrix.
subroutine sll_s_compute_phi_from_j_3d_trafo(self, field_in, field_out, efield_dofs)
Compute phi from j_i integrated over the time interval, delta_t is already included.
subroutine multiply_mass_inverse_3d_trafo(self, form, coefs_in, coefs_out)
Multiply by the inverse mass matrix.
subroutine multiply_gt(self, field_in, field_out)
Multiply by transpose of dicrete gradient matrix.
subroutine sll_s_compute_curl_part_3d_trafo(self, delta_t, efield, bfield, betar)
Solve curl part of Maxwell's equations.
subroutine sll_s_compute_e_from_j_3d_trafo(self, current, E, component)
Compute E_i from j_i integrated over the time interval using weak Ampere formulation,...
subroutine rhs_twoform(self, deg, func1, func2, func3, component, coefs_dofs)
Compute $\int f(F(\xi))\cdot DF(\xi) N_i(\xi) d\xi$ for vector function f, where $N_i$ is the B-splin...
subroutine free_3d_trafo(self)
Finalization.
subroutine multiply_g(self, field_in, field_out)
Multiply by dicrete gradient matrix.
subroutine rhs_oneform(self, deg, func1, func2, func3, component, coefs_dofs)
Compute $\int f(F(\xi))\cdot DF^{-T}(\xi) N_i(\xi) J_F(\xi) d\xi$ for vector function f,...
subroutine sll_s_compute_b_from_e_3d_trafo(self, delta_t, field_in, field_out)
Compute B from E using strong 3D Faraday equation for spline coefficients.
subroutine init_from_file_3d_trafo(self, domain, n_cells, s_deg_0, boundary, map, nml_file, adiabatic_electrons, profile)
Initialization from nml file.
subroutine sll_s_compute_phi_from_rho_3d_trafo(self, field_in, field_out, efield_dofs)
Compute phi from rho_i integrated over the time interval.
subroutine sll_s_compute_rho_from_e_3d_trafo(self, field_in, field_out)
compute rho from e using weak Gauss law ( rho = G^T M_1 e )
subroutine init_3d_trafo(self, domain, n_cells, s_deg_0, boundary, map, mass_tolerance, poisson_tolerance, solver_tolerance, adiabatic_electrons, profile)
Initialization.
subroutine sll_s_compute_e_from_rho_3d_trafo(self, field_in, field_out)
Compute E_i from rho_i integrated over the time interval using weak Poisson's equation ( rho = G^T M_...
subroutine multiply_c(self, field_in, field_out)
Multiply by discrete curl matrix.
subroutine l2projection_3d_trafo(self, form, component, coefs_dofs, func1, func2, func3)
Compute the L2 projection of a given function f on periodic splines of given degree.
subroutine rhs_zeroform(self, deg, func, coefs_dofs)
Compute $\int f(F(\xi)) N_i(\xi) J_F(\xi) d\xi$ for scalar function f, where $N_i$ is the B-spline st...
subroutine multiply_ct(self, field_in, field_out)
Multiply by transpose of discrete curl matrix.
real(kind=f64) function l2norm_squared_3d_trafo(self, coefs, form, component)
Compute square of the L2norm.
Module interface to solve Maxwell's equations with coordinate transformation in 3D The linear systems...
This module is a wrapper around the spline FEM Poisson solver for the uniform grid with periodic boun...
Module interface to solve Maxwell's equations with coordinate transformation in 3D The linear systems...
functions for initial profile of the particle distribution function
Utilites for Maxwell solver's with spline finite elements using sparse matrices.
subroutine, public sll_s_multiply_ct_clamped(n_dofs, delta_x, s_deg_0, field_in, field_out)
Multiply by transpose of discrete curl matrix.
subroutine, public sll_s_spline_fem_mixedmass3d_clamped(n_cells, deg1, deg2, component, matrix, profile, spline1, spline2, n_cells_min, n_cells_max)
Set up 3d clamped mixed mass matrix for specific spline degree and profile function.
subroutine, public sll_s_spline_fem_mass3d_clamped(n_cells, deg, component, matrix, profile, spline, n_cells_min, n_cells_max)
Set up 3d clamped mass matrix for specific spline degrees and profile function.
subroutine, public sll_s_multiply_g_clamped(n_dofs, delta_x, s_deg_0, field_in, field_out)
Multiply by dicrete gradient matrix.
subroutine, public sll_s_multiply_c_clamped(n_dofs, delta_x, s_deg_0, field_in, field_out)
Multiply by discrete curl matrix.
subroutine, public sll_s_multiply_gt_clamped(n_dofs, delta_x, s_deg_0, field_in, field_out)
Multiply by transpose of dicrete gradient matrix.
Utilites for 3D Maxwell solvers with spline finite elements.
subroutine, public sll_s_spline_fem_mass3d(n_cells, deg, component, matrix, profile, n_cells_min, n_cells_max)
Set up 3d mass matrix for specific spline degrees and profile function.
subroutine, public sll_s_spline_fem_mixedmass3d(n_cells, deg1, deg2, component, matrix, profile, n_cells_min, n_cells_max)
Set up 3d mixed mass matrix for specific spline degree and profile function.
subroutine, public sll_s_spline_pp_init_1d(self, degree, n_cells, boundary)
Initialize sll_t_spline_pp_1d object (Set poly_coeffs depending on degree)
subroutine, public sll_s_spline_pp_free_1d(self)
Destructor 1d.
real(kind=f64) function, public sll_f_spline_pp_horner_1d(degree, pp_coeffs, x, index)
Perform a 1d hornerschema on the pp_coeffs at index.
real(kind=f64) function profile_0(x)
real(kind=f64) function profile_m0(x)
real(kind=f64) function profile_1(x)
real(kind=f64) function profile_m2(x, component)
real(kind=f64) function profile_2(x, component)
real(kind=f64) function profile_m1(x, component)
class for a linear operator_block
class for the cg linear solver
type collecting functions for analytical coordinate mapping
arbitrary degree 1d spline