Initialize the simulation.
subroutine init()
!---------------------------------------------------------------------------------------------------------------------------------
!< Initialize the simulation.
!---------------------------------------------------------------------------------------------------------------------------------
integer(I_P) :: i !< Space counter.
real(R_P) :: x_L !< Left abscissa of local image.
!---------------------------------------------------------------------------------------------------------------------------------
!---------------------------------------------------------------------------------------------------------------------------------
#ifdef CAF
! CAF images comunications
sync all
if (me/=1) then
Ni = Ni[1]
steps_max = steps_max[1]
results = results[1]
plots = plots[1]
time_serie = time_serie[1]
verbose = verbose[1]
endif
#endif
! init simulation
if (mod(Ni, we)/=0) error stop 'error: the number of cells Ni must be a multiple of the number of CAF images used!'
Ni_image = Ni / we
allocate(x(1:Ni_image))
allocate(initial_state(1:Np, 1:Ni_image))
Dx = 1._R_P / Ni
! Sod's problem
cp0(1) = 1040._R_P
cv0(1) = 743._R_P
if (we==1) then
BC_L = 'TRA'
BC_R = 'TRA'
else
if (me==1) then
BC_L = 'TRA'
BC_R = 'CON-'//trim(strz(2, me+1))
elseif (me==we) then
BC_L = 'CON-'//trim(strz(2, me-1))
BC_R = 'TRA'
else
BC_L = 'CON-'//trim(strz(2, me-1))
BC_R = 'CON-'//trim(strz(2, me+1))
endif
endif
if (me>1) then
x_L = Ni_image * Dx * (me - 1)
else
x_L = 0._R_P
endif
do i=1, Ni_image
x(i) = x_L + Dx * i - 0.5_R_P * Dx
if (x(i)<=0.5_R_P) then
initial_state(:, i) = [1._R_P, & ! rho(s)
0._R_P, & ! u
1._R_P, & ! p
1._R_P, & ! sum(rho(s))
cp0/cv0] ! gamma = cp/cv
else
initial_state(:, i) = [0.125_R_P, & ! rho(s)
0._R_P, & ! u
0.1_R_P, & ! p
0.125_R_P, & ! sum(rho(s))
cp0/cv0] ! gamma = cp/cv
endif
enddo
if (verbose) then
print '(A)', id//'image '//trim(str(.true., me))//' of '//trim(str(.true., we))
print '(A)', id//'Number of total cells: '//trim(str(.true., Ni))
print '(A)', id//'Number of time steps: '//trim(str(.true., steps_max))
print '(A)', id//'Save final results: '//trim(str(results))
print '(A)', id//'Save plots of results: '//trim(str(plots))
print '(A)', id//'Save time serie of results: '//trim(str(time_serie))
print '(A)', id//'Left BC: '//BC_L
print '(A)', id//'Right BC: '//BC_R
print '(A)', id//'Space resolution: '//trim(str(.true., Dx))
print '(A)', id//'X(1) X(N): '//trim(str(.true., x(1)))//' '//trim(str(.true., x(Ni_image)))
print '(A)', id//'Density value: '//trim(str(n=initial_state(1, 1)))//' '//trim(str(n=initial_state(1, Ni_image)))
endif
! initialize integrator and domain
call rk_integrator%init(stages=rk_stages)
call domain%init(Ni=Ni_image, Ns=Ns, Dx=Dx, BC_L=BC_L, BC_R=BC_R, initial_state=initial_state, cp0=cp0, cv0=cv0, &
me=me, we=we, ord=ord)
#ifdef CAF
allocate(Dt(1:we)[*])
#else
allocate(Dt(1:we))
#endif
! initialize time serie file
call save_time_serie(title='FOODIE test: 1D Euler equations integration, explicit TVD Runge-Kutta'// &
trim(str(.true., rk_stages))//' stages', &
filename='euler_1D_caf_integration-tvdrk-'//&
trim(str(.true., rk_stages))//'-image-'//&
trim(strz(3, me))//&
'-time_serie.dat', &
t=t)
! initialize time variables
t = 0._R_P
Dt = 0._R_P
return
!---------------------------------------------------------------------------------------------------------------------------------
endsubroutine init