diff --git a/examples/MAST_drop/GNUmakefile b/examples/MAST_drop/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/MAST_drop/GNUmakefile +++ b/examples/MAST_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/advection/GNUmakefile b/examples/advection/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/advection/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/advection/README b/examples/advection/README new file mode 100644 index 000000000..fb7412417 --- /dev/null +++ b/examples/advection/README @@ -0,0 +1,2 @@ +standard advection test case advecting different shapes over a periodic domain +to evaluate accuracy and diffusion diff --git a/examples/advection/input b/examples/advection/input new file mode 100644 index 000000000..267b7e036 --- /dev/null +++ b/examples/advection/input @@ -0,0 +1,24 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 128 +Ly : 1.0 +ny : 128 +Lz : 1.0 +nz : 1 +Periodic : true + +# Initialization +Shapes : c + +# Direction +Advection direction : 1 1 0 + +# Time integration +Max cfl number : 0.5 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/shock_particle/src/Make.package b/examples/advection/src/Make.package similarity index 100% rename from examples/shock_particle/src/Make.package rename to examples/advection/src/Make.package diff --git a/examples/advection/src/geometry.f90 b/examples/advection/src/geometry.f90 new file mode 100644 index 000000000..2520b1f66 --- /dev/null +++ b/examples/advection/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + logical :: periodic + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + call param_read('Periodic', periodic) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=periodic, & + & yper=periodic, zper=periodic) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 new file mode 100644 index 000000000..8354723c7 --- /dev/null +++ b/examples/advection/src/simulation.f90 @@ -0,0 +1,313 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hyperbolic, only: SUPERBEE + use muscl_class, only: muscl + use hyperbolic_advection, only: make_advec_muscl + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> simulation monitor file + type(monitor) :: mfile, cflfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> circles and donuts shape + ! TODO fill between zero and one on boundaries + subroutine init_donut(iR, oR, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: iR, oR + real(WP), dimension(3) :: c, x + real(WP) :: r2 + integer :: i, j, k + + U(:,:,:) = 0.0_WP + + c = 0.5 * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmin_, cfg%kmax_ + x(3) = cfg%zm(k) + do j = cfg%jmin_, cfg%jmax_ + x(2) = cfg%ym(j) + do i = cfg%imin_, cfg%imax_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (iR**2 .lt. r2 .and. r2 .lt. oR**2) U(i,j,k) = 1.0_WP + end do + end do + end do + + end subroutine init_donut + + !> bar so we can test 1d behavior + subroutine init_bar(xmin, xmax, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: xmin, xmax + integer :: i + + U(:,:,:) = 0.0_WP + + do i = cfg%imin_, cfg%imax_ + if (xmin .lt. cfg%xm(i) .and. cfg%xm(i) .lt. xmax) then + U(i,:,:) = 1.0_WP + end if + end do + + end subroutine + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use string, only: str_medium + use messager, only: die + implicit none + + integer :: numfields + character, dimension(:), allocatable :: fields + + ! read shapes + read_shapes: block + character(len=str_medium) :: fieldbuffer + integer :: i, j + + call param_read('Shapes', fieldbuffer) + fieldbuffer = adjustl(fieldbuffer) + + ! check for duplicates + do i = 1, str_medium + if (fieldbuffer(i:i) .ne. ' ') then + do j = i+1, str_medium + if (fieldbuffer(i:i) .eq. fieldbuffer(j:j)) then + call die("field name '" // fieldbuffer(i:i) // "' appears twice") + end if + end do + end if + end do + + ! count valid fields and warn user + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + case ('d') ! donut + numfields = numfields + 1 + case ('b') ! bar + numfields = numfields + 1 + case (' ') ! skip spaces + case default + write(*, *) "unrecognized shape: '", fieldbuffer(i:i), "'" + end select + end do + if (numfields .eq. 0) call die("must advect at least one shape") + + ! read fields into array + allocate(fields(numfields)) + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + fields(numfields) = 'c' + case ('d') ! donut + numfields = numfields + 1 + fields(numfields) = 'd' + case ('b') ! bar + numfields = numfields + 1 + fields(numfields) = 'b' + case default + end select + end do + + end block read_shapes + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + real(WP), dimension(3) :: vel + real(WP) :: traversal_length + + ! read velocity direction, find velocity + call param_read('Advection direction', vel, 'Advec dir') + traversal_length = sqrt(sum(vel**2)) * cfg%xL + vel = vel * traversal_length + + ! call constructor + fs = make_advec_muscl(cfg, numfields, SUPERBEE, vel) + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + integer :: i + real(WP), dimension(:,:,:), pointer :: fieldptr + + do i = 1, numfields + fieldptr => fs%Uc(i,:,:,:) + select case (fields(i)) + case ('c') ! circle + call init_donut(0.0_WP, 0.375_WP * cfg%xL, fieldptr) + case ('d') ! donut + call init_donut(0.250_WP * cfg%xL, 0.375_WP * cfg%xL, fieldptr) + case ('b') ! bar + call init_bar(0.333_WP * cfg%xL, 0.666_WP * cfg%xL, fieldptr) + end select + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + integer :: i + character(len=4) :: istr + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg, name='AdvectionTest') + + ! Create event for Ensight output + ens_evt=event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + do i = 1, numfields + ptr1 => fs%Uc(i,:,:,:) + write(istr,'(I2.2)') i + call ens_out%add_scalar('U'//istr, ptr1) + end do + + ptr1 => fs%params(1,:,:,:) + ptr2 => fs%params(2,:,:,:) + ptr3 => fs%params(3,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + character(len=str_short) :: fieldname + integer :: i + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + do i = 1, numfields + write(fieldname,'("[",a,"]min")') fields(i) + real_ptr => fs%Umin(i) + call mfile%add_column(real_ptr, fieldname) + write(fieldname,'("[",a,"]max")') fields(i) + real_ptr => fs%Umax(i) + call mfile%add_column(real_ptr, fieldname) + end do + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/advection_rusanov/GNUmakefile b/examples/advection_rusanov/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/advection_rusanov/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/advection_rusanov/README b/examples/advection_rusanov/README new file mode 100644 index 000000000..fb7412417 --- /dev/null +++ b/examples/advection_rusanov/README @@ -0,0 +1,2 @@ +standard advection test case advecting different shapes over a periodic domain +to evaluate accuracy and diffusion diff --git a/examples/advection_rusanov/input b/examples/advection_rusanov/input new file mode 100644 index 000000000..267b7e036 --- /dev/null +++ b/examples/advection_rusanov/input @@ -0,0 +1,24 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 128 +Ly : 1.0 +ny : 128 +Lz : 1.0 +nz : 1 +Periodic : true + +# Initialization +Shapes : c + +# Direction +Advection direction : 1 1 0 + +# Time integration +Max cfl number : 0.5 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/advection_rusanov/src/Make.package b/examples/advection_rusanov/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/advection_rusanov/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/advection_rusanov/src/geometry.f90 b/examples/advection_rusanov/src/geometry.f90 new file mode 100644 index 000000000..b38098e36 --- /dev/null +++ b/examples/advection_rusanov/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + logical :: periodic + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + call param_read('Periodic', periodic) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=1, x=x, y=x, z=x, xper=periodic, & + & yper=periodic, zper=periodic) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/advection_rusanov/src/simulation.f90 b/examples/advection_rusanov/src/simulation.f90 new file mode 100644 index 000000000..914359064 --- /dev/null +++ b/examples/advection_rusanov/src/simulation.f90 @@ -0,0 +1,310 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use rusanov_class, only: rusanov + use hyperbolic_advection, only: make_advec_rusanov + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + type(rusanov), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> simulation monitor file + type(monitor) :: mfile, cflfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> circles and donuts shape + ! TODO fill between zero and one on boundaries + subroutine init_donut(iR, oR, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: iR, oR + real(WP), dimension(3) :: c, x + real(WP) :: r2 + integer :: i, j, k + + U(:,:,:) = 0.0_WP + + c = 0.5 * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmin_, cfg%kmax_ + x(3) = cfg%zm(k) + do j = cfg%jmin_, cfg%jmax_ + x(2) = cfg%ym(j) + do i = cfg%imin_, cfg%imax_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (iR**2 .lt. r2 .and. r2 .lt. oR**2) U(i,j,k) = 1.0_WP + end do + end do + end do + + end subroutine init_donut + + !> bar so we can test 1d behavior + subroutine init_bar(xmin, xmax, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: xmin, xmax + integer :: i + + U(:,:,:) = 0.0_WP + + do i = cfg%imin_, cfg%imax_ + if (xmin .lt. cfg%xm(i) .and. cfg%xm(i) .lt. xmax) then + U(i,:,:) = 1.0_WP + end if + end do + + end subroutine + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use string, only: str_medium + use messager, only: die + implicit none + + integer :: numfields + character, dimension(:), allocatable :: fields + + ! read shapes + read_shapes: block + character(len=str_medium) :: fieldbuffer + integer :: i, j + + call param_read('Shapes', fieldbuffer) + fieldbuffer = adjustl(fieldbuffer) + + ! check for duplicates + do i = 1, str_medium + if (fieldbuffer(i:i) .ne. ' ') then + do j = i+1, str_medium + if (fieldbuffer(i:i) .eq. fieldbuffer(j:j)) then + call die("field name '" // fieldbuffer(i:i) // "' appears twice") + end if + end do + end if + end do + + ! count valid fields and warn user + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + case ('d') ! donut + numfields = numfields + 1 + case ('b') ! bar + numfields = numfields + 1 + case (' ') ! skip spaces + case default + write(*, *) "unrecognized shape: '", fieldbuffer(i:i), "'" + end select + end do + if (numfields .eq. 0) call die("must advect at least one shape") + + ! read fields into array + allocate(fields(numfields)) + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + fields(numfields) = 'c' + case ('d') ! donut + numfields = numfields + 1 + fields(numfields) = 'd' + case ('b') ! bar + numfields = numfields + 1 + fields(numfields) = 'b' + case default + end select + end do + + end block read_shapes + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + real(WP), dimension(3) :: vel + real(WP) :: traversal_length + + ! read velocity direction, find velocity + call param_read('Advection direction', vel, 'Advec dir') + traversal_length = sqrt(sum(vel**2)) * cfg%xL + vel = vel * traversal_length + + ! call constructor + fs = make_advec_rusanov(cfg, numfields, vel) + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + integer :: i + real(WP), dimension(:,:,:), pointer :: fieldptr + + do i = 1, numfields + fieldptr => fs%Uc(i,:,:,:) + select case (fields(i)) + case ('c') ! circle + call init_donut(0.0_WP, 0.375_WP * cfg%xL, fieldptr) + case ('d') ! donut + call init_donut(0.250_WP * cfg%xL, 0.375_WP * cfg%xL, fieldptr) + case ('b') ! bar + call init_bar(0.333_WP * cfg%xL, 0.666_WP * cfg%xL, fieldptr) + end select + end do + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + integer :: i + character(len=4) :: istr + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg, name='AdvectionTest') + + ! Create event for Ensight output + ens_evt=event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + do i = 1, numfields + ptr1 => fs%Uc(i,:,:,:) + write(istr,'(I2.2)') i + call ens_out%add_scalar('U'//istr, ptr1) + end do + + ptr1 => fs%params(1,:,:,:) + ptr2 => fs%params(2,:,:,:) + ptr3 => fs%params(3,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + character(len=str_short) :: fieldname + integer :: i + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + do i = 1, numfields + write(fieldname,'("[",a,"]min")') fields(i) + real_ptr => fs%Umin(i) + call mfile%add_column(real_ptr, fieldname) + write(fieldname,'("[",a,"]max")') fields(i) + real_ptr => fs%Umax(i) + call mfile%add_column(real_ptr, fieldname) + end do + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/bctester/GNUmakefile b/examples/bctester/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/bctester/GNUmakefile +++ b/examples/bctester/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/GNUmakefile b/examples/boat/GNUmakefile index b4a53ee9b..b83ed2464 100644 --- a/examples/boat/GNUmakefile +++ b/examples/boat/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/src/lpt_class.f90 b/examples/boat/src/lpt_class.f90 index 7654753f6..3982109a9 100644 --- a/examples/boat/src/lpt_class.f90 +++ b/examples/boat/src/lpt_class.f90 @@ -752,7 +752,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -765,7 +765,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/examples/bus/GNUmakefile b/examples/bus/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/bus/GNUmakefile +++ b/examples/bus/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile index 0060c5000..fc48c5afb 100644 --- a/examples/channel/GNUmakefile +++ b/examples/channel/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/collision/GNUmakefile b/examples/collision/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/collision/GNUmakefile +++ b/examples/collision/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/compil_test/GNUmakefile b/examples/compil_test/GNUmakefile index 9ad19ecfc..8e0aca067 100644 --- a/examples/compil_test/GNUmakefile +++ b/examples/compil_test/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/coupler_tester/GNUmakefile b/examples/coupler_tester/GNUmakefile index 2ad327124..e83454a63 100644 --- a/examples/coupler_tester/GNUmakefile +++ b/examples/coupler_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/detonation/GNUmakefile b/examples/detonation/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/detonation/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/detonation/README b/examples/detonation/README new file mode 100644 index 000000000..8718d3d32 --- /dev/null +++ b/examples/detonation/README @@ -0,0 +1 @@ +a spherical detonation based off the Sod problem diff --git a/examples/detonation/input_openbcs b/examples/detonation/input_openbcs new file mode 100644 index 000000000..9a7ce3168 --- /dev/null +++ b/examples/detonation/input_openbcs @@ -0,0 +1,26 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 + +# Reflect? +Reflect : false + +# Initialization +Initial diameter : 0.2 +Initial x velocity : 0.4 +Initial x position : 0.5 +Initial pressure multiplier : 12.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/detonation/input_reflect b/examples/detonation/input_reflect new file mode 100644 index 000000000..3c266f879 --- /dev/null +++ b/examples/detonation/input_reflect @@ -0,0 +1,26 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 + +# Reflect? +Reflect : true + +# Initialization +Initial diameter : 0.16 +Initial x velocity : 0.0 +Initial x position : 0.8 +Initial pressure multiplier : 12.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/detonation/src/Make.package b/examples/detonation/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/detonation/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/detonation/src/geometry.f90 b/examples/detonation/src/geometry.f90 new file mode 100644 index 000000000..637b9e1c0 --- /dev/null +++ b/examples/detonation/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 new file mode 100644 index 000000000..e00dab230 --- /dev/null +++ b/examples/detonation/src/simulation.f90 @@ -0,0 +1,368 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES, WALL_REFLECT + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Flow solver and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + character(len=str_medium) :: ens_out_name + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(1:5,i,j,k)) + phys_out(6,i,j,k) = sqrt(sum(phys_out(2:4,i,j,k)**2) / (DIATOMIC_GAMMA * phys_out(5,i,j,k) / phys_out(1,i,j,k))) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + function side_locator_z_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.lt.pg%kmin) loc = .true. + end function side_locator_z_l + function side_locator_z_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.gt.pg%kmax) loc = .true. + end function side_locator_z_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver + create_and_initialize_flow_solver: block + logical :: reflect + + call param_read('Reflect', reflect) + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + if (reflect) then + call fs%add_bcond(name='reflxr' , type=WALL_REFLECT, & + & locator=side_locator_x_r, dir='xr') + ens_out_name = 'SodSphereReflect' + else + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + ens_out_name = 'SodSphereOpen' + end if + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + call fs%add_bcond(name='openzl' , type=NO_WAVES, & + & locator=side_locator_z_l, dir='zl') + call fs%add_bcond(name='openzr' , type=NO_WAVES, & + & locator=side_locator_z_r, dir='zr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP) :: r2, oR, initxpos, initxvel, initpmul + real(WP), dimension(3) :: x, c + real(WP), dimension(5) :: insvalphys, outvalphys, insval, outval + integer :: i, j, k + + call param_read('Initial diameter', oR) + call param_read('Initial x position', initxpos, 'Initial x pos', 0.5_WP * cfg%xL) + call param_read('Initial x velocity', initxvel, 'Initial x vel', 0.0_WP) + call param_read('Initial pressure multiplier', initpmul, 'Initial p mul', 1.0_WP) + + oR = 0.5_WP * oR + + insvalphys = SOD_PHYS_L + outvalphys = SOD_PHYS_R + insvalphys(2) = insvalphys(2) + initxvel + outvalphys(2) = outvalphys(2) + initxvel + insvalphys(5) = insvalphys(5) * initpmul + + call euler_tocons(DIATOMIC_GAMMA, insvalphys, insval) + call euler_tocons(DIATOMIC_GAMMA, outvalphys, outval) + + c = 0.5_WP * (/ 2 * initxpos, cfg%yL, cfg%zL /) + + do k = cfg%kmino_, cfg%kmaxo_ + x(3) = cfg%zm(k) + do j = cfg%jmino_, cfg%jmaxo_ + x(2) = cfg%ym(j) + do i = cfg%imino_, cfg%imaxo_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (r2 .lt. oR**2) then + fs%Uc(:,i,j,k) = insval + else + fs%Uc(:,i,j,k) = outval + end if + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name=ens_out_name) + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:) + ptr2 => phys_out(3,:,:,:) + ptr3 => phys_out(4,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + ptr1 => phys_out(6,:,:,:) + call ens_out%add_scalar('Ma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/drop_breakup/GNUmakefile b/examples/drop_breakup/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/drop_breakup/GNUmakefile +++ b/examples/drop_breakup/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/drop_breakup/src/simulation.f90 b/examples/drop_breakup/src/simulation.f90 index 922c9bda5..9d8162c79 100644 --- a/examples/drop_breakup/src/simulation.f90 +++ b/examples/drop_breakup/src/simulation.f90 @@ -814,7 +814,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =diam !< Assign diameter to account for full volume lp%p(np)%pos =[cc%meta_structures_list(m)%x,cc%meta_structures_list(m)%y,cc%meta_structures_list(m)%z] !< Place the drop at the liquid barycenter lp%p(np)%vel =[cc%meta_structures_list(m)%u,cc%meta_structures_list(m)%v,cc%meta_structures_list(m)%w] !< Assign mean structure velocity as drop velocity diff --git a/examples/falling_drop/GNUmakefile b/examples/falling_drop/GNUmakefile index 3fb87f2d8..466227c85 100644 --- a/examples/falling_drop/GNUmakefile +++ b/examples/falling_drop/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/falling_drop/input b/examples/falling_drop/input index 10e5ce8f2..3b84920aa 100644 --- a/examples/falling_drop/input +++ b/examples/falling_drop/input @@ -1,25 +1,24 @@ # Parallelization -Partition : 1 1 4 +Partition : 1 1 8 # Mesh definition -Lx : 0.01 -Ly : 1 -Lz : 1 +Lx : 0.001 +Ly : 0.1 +Lz : 0.1 nx : 1 ny : 100 nz : 100 # Fluid properties -Gravity : 0 -1 0 +Gravity : 0 -9.81 0 Liquid dynamic viscosity : 1.137e-3 Gas dynamic viscosity : 1.780e-5 Liquid density : 1000 Gas density : 1.226 Surface tension coefficient : 0.0728 -Static contact angle : 70 # Time integration -Max timestep size : 1e-2 +Max timestep size : 1e-3 Max cfl number : 0.9 Max time : 5 @@ -32,4 +31,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 1e-1 \ No newline at end of file +Ensight output period : 1e-2 \ No newline at end of file diff --git a/examples/falling_drop/src/geometry.f90 b/examples/falling_drop/src/geometry.f90 index f24872289..e69f237a9 100644 --- a/examples/falling_drop/src/geometry.f90 +++ b/examples/falling_drop/src/geometry.f90 @@ -1,76 +1,74 @@ !> Various definitions and tools for initializing NGA2 config module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - - contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) - - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx - end do - do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly - end do - do k=1,nz+1 - z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='FallingDrop') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - ! Read in partition - call param_read('Partition',partition,short='p') - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - end block create_cfg - - - ! Create masks for this config - create_walls: block - ! Put walls all around - cfg%VF=0.0_WP - cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP - call cfg%sync(cfg%VF) - end block create_walls - - - end subroutine geometry_init - - - end module geometry \ No newline at end of file + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='FallingDrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry \ No newline at end of file diff --git a/examples/falling_drop/src/simulation.f90 b/examples/falling_drop/src/simulation.f90 index 0749084da..ba8ca3c82 100644 --- a/examples/falling_drop/src/simulation.f90 +++ b/examples/falling_drop/src/simulation.f90 @@ -2,6 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg + use hypre_str_class, only: hypre_str use tpns_class, only: tpns use vfs_class, only: vfs use timetracker_class, only: timetracker @@ -11,7 +12,9 @@ module simulation implicit none private - !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker + type(hypre_str), public :: ps + type(hypre_str), public :: vs type(tpns), public :: fs type(vfs), public :: vf type(timetracker), public :: time @@ -33,16 +36,16 @@ module simulation real(WP), dimension(3) :: center real(WP) :: radius,depth - contains - - - !> Function that defines a level set function for a falling drop problem +contains + + + !> Function that defines a level set function for a falling drop problem function levelset_falling_drop(xyz,t) result(G) - implicit none - real(WP), dimension(3),intent(in) :: xyz - real(WP), intent(in) :: t - real(WP) :: G - ! Create the droplet + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet G=radius-sqrt(sum((xyz-center)**2)) ! Add the pool G=max(G,depth-xyz(2)) @@ -51,175 +54,175 @@ end function levelset_falling_drop !> Initialization of problem solver subroutine simulation_init - use param, only: param_read - implicit none - - - ! Allocate work arrays + use param, only: param_read + implicit none + + + ! Allocate work arrays allocate_work_arrays: block - allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize time tracker with 2 subiterations + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Initialize our VOF solver and field + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: lvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver - vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') - ! Initialize to a droplet and a pool - center=[0.0_WP,0.5_WP,0.0_WP] - radius=0.1_WP - depth =0.2_WP - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - ! Call adaptive refinement code to get volume and barycenters recursively - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) - vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) - if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then - vf%Lbary(:,i,j,k)=v_cent - vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) - else - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end if + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.05_WP,0.0_WP] + radius=0.01_WP + depth =0.02_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do end do - end do - end do - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a two-phase flow solver without bconds + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg,pcg_pfmg - use mathtools, only: Pi - ! Create flow solver - fs=tpns(cfg=cfg,name='Two-phase NS') - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l) - call param_read('Gas dynamic viscosity',fs%visc_g) - ! Assign constant density to each phase - call param_read('Liquid density',fs%rho_l) - call param_read('Gas density',fs%rho_g) - ! Read in surface tension coefficient - call param_read('Surface tension coefficient',fs%sigma) - call param_read('Static contact angle',fs%contact_angle) - fs%contact_angle=fs%contact_angle*Pi/180.0_WP - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=gmres_amg) - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Calculate cell-centered velocities and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() end block create_and_initialize_flow_solver ! Add Ensight output create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='FallingDrop') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VOF',vf%VF) - call ens_out%add_scalar('curvature',vf%curv) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight ! Create a monitor file create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call vf%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLst,'STension CFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() end block create_monitor @@ -228,114 +231,114 @@ end subroutine simulation_init !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase subroutine simulation_run - implicit none - - ! Perform time integration + implicit none + + ! Perform time integration do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old VOF - vf%VFold=vf%VF - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Apply time-varying Dirichlet conditions - ! This is where time-dpt Dirichlet would be enforced - - ! Prepare old staggered density (at n) - call fs%get_olddensity(vf=vf) - - ! VOF solver step - call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) - - ! Prepare new staggered viscosity (at n+1) - call fs%get_viscosity(vf=vf) - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Preliminary mass and momentum transport step at the interface - call fs%prepare_advection_upwind(dt=time%dt) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU - resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV - resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply other boundary conditions - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%update_laplacian() - call fs%correct_mfr() - call fs%get_div() - call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho_U - fs%V=fs%V-time%dt*resV/fs%rho_V - fs%W=fs%W-time%dt*resW/fs%rho_W - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call vf%get_max() - call mfile%write() - call cflfile%write() - - end do - + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + end subroutine simulation_run !> Finalize the NGA2 simulation subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors + implicit none + + ! Get rid of all objects - need destructors ! monitor ! ensight ! bcond @@ -347,7 +350,4 @@ subroutine simulation_final end subroutine simulation_final - - - - end module simulation \ No newline at end of file +end module simulation \ No newline at end of file diff --git a/examples/film/GNUmakefile b/examples/film/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/film/GNUmakefile +++ b/examples/film/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/filmKH/GNUmakefile b/examples/filmKH/GNUmakefile index 0a43fee0f..c4825c881 100644 --- a/examples/filmKH/GNUmakefile +++ b/examples/filmKH/GNUmakefile @@ -23,9 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/filmRT/GNUmakefile b/examples/filmRT/GNUmakefile index 0fa3aaa03..258639eff 100644 --- a/examples/filmRT/GNUmakefile +++ b/examples/filmRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/GNUmakefile b/examples/fluidized_bed/GNUmakefile index 669bb01a2..663465958 100644 --- a/examples/fluidized_bed/GNUmakefile +++ b/examples/fluidized_bed/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 424988008..f506dfbd8 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 2 1 1 +Partition : 8 1 1 # Mesh definition Lx : .0256 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 6d882be9c..c0491e429 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -3,6 +3,8 @@ module simulation use precision, only: WP use geometry, only: cfg use lpt_class, only: lpt + use hypre_uns_class, only: hypre_uns + use hypre_str_class, only: hypre_str use lowmach_class, only: lowmach use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -12,7 +14,9 @@ module simulation implicit none private - !> Get an LPT solver, a lowmach solver, and corresponding time tracker + !> Get an LPT solver, a lowmach solver, and corresponding time tracker, plus a couple of linear solvers + type(hypre_uns), public :: ps + type(hypre_str), public :: vs type(lowmach), public :: fs type(lpt), public :: lp type(timetracker), public :: time @@ -96,14 +100,14 @@ subroutine simulation_init ! Create a low Mach flow solver with bconds create_flow_solver: block - use ils_class, only: pcg_pfmg,gmres_amg - use lowmach_class, only: dirichlet,clipped_neumann + use hypre_uns_class, only: gmres_amg + use hypre_str_class, only: pcg_pfmg + use lowmach_class, only: dirichlet,clipped_neumann ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) - ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity @@ -111,13 +115,15 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + ps=hypre_uns(cfg=cfg,name='Pressure',method=gmres_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=gmres_amg,implicit_ils=pcg_pfmg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_flow_solver @@ -286,8 +292,9 @@ subroutine simulation_init ! Create monitor filea create_monitor: block ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + real(WP) :: cfl + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -356,6 +363,7 @@ subroutine simulation_run use mathtools, only: twoPi use parallel, only: parallel_time implicit none + real(WP) :: cfl ! Perform time integration do while (.not.time%done()) @@ -364,8 +372,8 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f61dc7ef2..52dbd4c18 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -5,6 +5,7 @@ NGA_HOME ?= ../.. PRECISION = DOUBLE USE_MPI = TRUE USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE PROFILE = FALSE @@ -22,10 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/rgrawe/NGA2hypre -FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/input b/examples/hit/input index 0c376b4a8..7646043ff 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -14,19 +14,12 @@ Eddy turnover time : 0.1 # Particle properties Particle density : 0.018 Particle diameter : 1 -Number of particles : 100000 +Number of particles : 0!100000 # Time integration Max timestep size : 1e-3 Max cfl number : 0.9 -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - # Ensight output Ensight output period : 0.01 + diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index c906814b1..be6cbba4e 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,8 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg - use pfft3d_class, only: pfft3d - use hypre_str_class, only: hypre_str + use fourier3d_class, only: fourier3d use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +14,7 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - !type(pfft3d), public :: ps - type(hypre_str), public :: ps + type(fourier3d), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -80,11 +78,7 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=pfft3d(cfg=cfg,name='Pressure') - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -185,7 +179,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,nvec=0,name='lpt') call lp%update_partmesh(pmesh) end block create_pmesh @@ -316,9 +310,9 @@ subroutine simulation_run end do call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) ! Calculate mean velocity - call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%fluid_vol ! Add forcing term resU=resU+time%dt*KE0/KE*(fs%U-meanU)/(2.0_WP*tau_eddy) resV=resV+time%dt*KE0/KE*(fs%V-meanV)/(2.0_WP*tau_eddy) diff --git a/examples/shock_particle/GNUmakefile b/examples/ib_drop/GNUmakefile similarity index 78% rename from examples/shock_particle/GNUmakefile rename to examples/ib_drop/GNUmakefile index 676358efc..14a82a163 100644 --- a/examples/shock_particle/GNUmakefile +++ b/examples/ib_drop/GNUmakefile @@ -22,16 +22,13 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre -IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := core two_phase particles data solver config grid libraries +Bdirs := two_phase immersed core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/ib_drop/README b/examples/ib_drop/README new file mode 100644 index 000000000..40018fe6e --- /dev/null +++ b/examples/ib_drop/README @@ -0,0 +1 @@ +This is a direct forcing IBM case that tests the interaction between IB and the two-phase flow solvers. It simulates a drop impacting a bumpy cylinder. diff --git a/examples/ib_drop/input b/examples/ib_drop/input new file mode 100644 index 000000000..1710ec8eb --- /dev/null +++ b/examples/ib_drop/input @@ -0,0 +1,41 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Lx : 0.1 +Ly : 0.1 +Lz : 0.000390625 +nx : 256 +ny : 256 +nz : 1 + +# IBM properties +Number of markers : 200 +Cylinder diameter : 0.01 +Cylinder position : 0.03 +Perturbation amp : 0.0005 +Perturbation freq : 6 + +# Fluid properties +Gravity : 0 -9.81 0 +Liquid dynamic viscosity : 1.137e-3 +Gas dynamic viscosity : 1.780e-5 +Liquid density : 1000 +Gas density : 1.226 +Surface tension coefficient : 0.0728 + +# Time integration +Max timestep size : 5e-4 +Max cfl number : 0.9 +Max time : 5 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 5e-3 \ No newline at end of file diff --git a/examples/ib_drop/src/Make.package b/examples/ib_drop/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_drop/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_drop/src/geometry.f90 b/examples/ib_drop/src/geometry.f90 new file mode 100644 index 000000000..c4d9ee6bd --- /dev/null +++ b/examples/ib_drop/src/geometry.f90 @@ -0,0 +1,70 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='ib_drop') + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_drop/src/simulation.f90 b/examples/ib_drop/src/simulation.f90 new file mode 100644 index 000000000..f5c61ecf3 --- /dev/null +++ b/examples/ib_drop/src/simulation.f90 @@ -0,0 +1,486 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use df_class, only: dfibm + use vfs_class, only: vfs + use tpns_class, only: tpns + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, a vfs and tpns solver, and corresponding time tracker + type(vfs), public :: vf + type(tpns), public :: fs + type(dfibm), public :: df + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP), dimension(3) :: center + real(WP) :: radius + +contains + + + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=radius-sqrt(sum((xyz-center)**2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.06_WP,0.0_WP] + radius=0.01_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: gmres_amg,pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi,arctan + integer :: i,j,k,np + real(WP) :: Dcyl,Ycyl,amp,freq,theta,r + + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + + ! Read cylinder properties + call param_read('Number of markers',np) + call param_read('Cylinder diameter',Dcyl) + call param_read('Cylinder position',Ycyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =1 + df%p(i)%vel=0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm=df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(2)=df%p(i)%pos(2)+Ycyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)-Ycyl) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%G(i,j,k)=sqrt((df%cfg%xm(i))**2+(df%cfg%ym(j)-Ycyl)**2)-r + end do + end do + end do + call df%cfg%sync(df%G) + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%min_meshsize + end if + + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ib_drop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('markers',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('GIB',df%G) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + ! Get IB source terms + resU=vf%VF*fs%rho_l+(1.0_WP-vf%VF)*fs%rho_g + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) + ! Interpolate to the staggered cells and synchronize + resU=0.0_WP; resV=0.0_WP; resW=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=sum(fs%itpr_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + resV(i,j,k)=sum(fs%itpr_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + resW(i,j,k)=sum(fs%itpr_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + ! Increment velocity field + fs%U=fs%U+resU + fs%V=fs%V+resV + fs%W=fs%W+resW + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 246977240..bdb62cb2b 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -6,6 +6,8 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -22,14 +24,13 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := constant_density core data solver config grid libraries +Bdirs := subgrid constant_density core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 79891db38..3a98424db 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -4,30 +4,30 @@ Partition : 8 1 1 # Mesh definition Pipe diameter : 1 Pipe length : 4 -nx : 256 -ny : 96 -nz : 96 +nx : 256 +ny : 64 +nz : 64 # Pipe properties -Bulk velocity : 1 -Fluctuation amp : 0.2 +Bulk velocity : 1 +Fluctuation amp : 0.2 # Time integration -Max timestep size : 0.008 -Max cfl number : 0.9 -Max time : 1000 +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 # Fluid properties -Dynamic viscosity : 0.001 -Density : 1 +Dynamic viscosity : 2e-4 +Density : 1 # Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 +Pressure tolerance : 1e-4 +Pressure iteration : 100 # Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 +Implicit tolerance : 1e-4 +Implicit iteration : 100 # Ensight output Ensight output period : 1 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 27a956cad..e9cd3b5cc 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -8,8 +8,12 @@ module geometry !> Single config type(config), public :: cfg - public :: geometry_init + !> Pipe diameter + real(WP), public :: D + public :: geometry_init,get_VF + + contains @@ -25,7 +29,7 @@ subroutine geometry_init create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,D,dx + real(WP) :: Lx,Ly,Lz,dx real(WP), dimension(:), allocatable :: x,y,z ! Read in grid definition @@ -34,7 +38,7 @@ subroutine geometry_init call param_read('ny',ny); allocate(y(ny+1)) call param_read('nx',nx); allocate(x(nx+1)) call param_read('nz',nz); allocate(z(nz+1)) - + dx=Lx/real(nx,WP) no=6 if (ny.gt.1) then @@ -47,7 +51,7 @@ subroutine geometry_init else Lz=dx end if - + ! Create simple rectilinear grid do i=1,nx+1 x(i)=real(i-1,WP)/real(nx,WP)*Lx @@ -63,7 +67,7 @@ subroutine geometry_init grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') end block create_grid - + ! Create a config from that grid on our entire group create_cfg: block @@ -81,11 +85,51 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=1.0_WP + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() end block create_walls end subroutine geometry_init -end module geometry + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U','u') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V','v') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W','w') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry \ No newline at end of file diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 56c68aa1b..c767cf64b 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,363 +1,383 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use hypre_str_class, only: hypre_str - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(timetracker), public :: time - - !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP), dimension(:,:,:), allocatable :: G,VF - real(WP) :: Ubulk,Umean,Dpipe - + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use fourier3d_class, only: fourier3d + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + !type(hypre_str), public :: ps + type(fourier3d), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + contains - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create an incompressible flow solver without bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg - real(WP) :: visc - ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our velocity field - initialize_velocity: block - use mathtools, only: twoPi - use random, only: random_uniform - integer :: i,j,k - real(WP) :: amp - ! Initial fields - call param_read('Pipe diameter',Dpipe) - call param_read('Bulk velocity',Ubulk); Umean=Ubulk - call param_read('Fluctuation amp',amp,default=0.0_WP) - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! For faster transition - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=Ubulk*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) - fs%V(i,j,k)=Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) - fs%U(i,j,k)=fs%U(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) - fs%V(i,j,k)=fs%V(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do end do end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - ! Compute cell-centered velocity - call fs%interp_vel(Ui,Vi,Wi) - ! Compute divergence - call fs%get_div() - end block initialize_velocity - - - ! Initialize IBM fields - initialize_ibm: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do end do end do - end do - call fs%cfg%sync(VF) - call fs%cfg%sync(G) - end block initialize_ibm - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='pipe') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',VF) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(Umean,'Umean') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - - ! Add body forcing - forcing: block - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - integer :: i,j,k,ierr - real(WP) :: myU,myUvol,Uvol,VFx - myU=0.0_WP; myUvol=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) - myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx - end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + !ps%maxlevel=14 + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) end do end do - call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myU ,Umean,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=Umean/Uvol - resU=resU+Ubulk-Umean - end block forcing - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - VFx =get_VF(i,j,k,'U') - VFy =get_VF(i,j,k,'V') - VFz =get_VF(i,j,k,'W') - fs%U(i,j,k)=VFx*fs%U(i,j,k) - fs%V(i,j,k)=VFy*fs%V(i,j,k) - fs%W(i,j,k)=VFz*fs%W(i,j,k) - end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) end do end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - call fs%cfg%sync(VF) - end block ibm_correction - - ! Apply other boundary conditions on the resulting fields - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho - - ! Increment sub-iteration counter - time%it=time%it+1 - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call mfile%write() - call cflfile%write() - - end do - - end subroutine simulation_run - - - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - case('V') - delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r - case('W') - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r - case default - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + end module simulation diff --git a/examples/ib_tester/GNUmakefile b/examples/ib_tester/GNUmakefile index ca4484e85..5b291856a 100644 --- a/examples/ib_tester/GNUmakefile +++ b/examples/ib_tester/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_tester/src/simulation.f90 b/examples/ib_tester/src/simulation.f90 index 8d25a4951..31d4aebd2 100644 --- a/examples/ib_tester/src/simulation.f90 +++ b/examples/ib_tester/src/simulation.f90 @@ -107,12 +107,12 @@ subroutine simulation_init ! Allocate work arrays allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays diff --git a/examples/imbibition/GNUmakefile b/examples/imbibition/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/imbibition/GNUmakefile +++ b/examples/imbibition/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/internal_bc/GNUmakefile b/examples/internal_bc/GNUmakefile index 6f90a907b..68f202cd3 100644 --- a/examples/internal_bc/GNUmakefile +++ b/examples/internal_bc/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/levitating_drop/GNUmakefile b/examples/levitating_drop/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/levitating_drop/GNUmakefile +++ b/examples/levitating_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ljsc/GNUmakefile b/examples/ljsc/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/ljsc/GNUmakefile +++ b/examples/ljsc/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphaseKH/GNUmakefile b/examples/multiphaseKH/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseKH/GNUmakefile +++ b/examples/multiphaseKH/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphaseRT/GNUmakefile b/examples/multiphaseRT/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseRT/GNUmakefile +++ b/examples/multiphaseRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphase_pipe/GNUmakefile b/examples/multiphase_pipe/GNUmakefile new file mode 100644 index 000000000..b92867b7c --- /dev/null +++ b/examples/multiphase_pipe/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := subgrid constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/multiphase_pipe/README b/examples/multiphase_pipe/README new file mode 100644 index 000000000..ba28b9a69 --- /dev/null +++ b/examples/multiphase_pipe/README @@ -0,0 +1,2 @@ +Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: +Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. diff --git a/examples/multiphase_pipe/input b/examples/multiphase_pipe/input new file mode 100644 index 000000000..3a98424db --- /dev/null +++ b/examples/multiphase_pipe/input @@ -0,0 +1,33 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Pipe diameter : 1 +Pipe length : 4 +nx : 256 +ny : 64 +nz : 64 + +# Pipe properties +Bulk velocity : 1 +Fluctuation amp : 0.2 + +# Time integration +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : 2e-4 +Density : 1 + +# Pressure solver +Pressure tolerance : 1e-4 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-4 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 diff --git a/examples/multiphase_pipe/src/Make.package b/examples/multiphase_pipe/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/multiphase_pipe/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/multiphase_pipe/src/geometry.f90 b/examples/multiphase_pipe/src/geometry.f90 new file mode 100644 index 000000000..9f2df8dae --- /dev/null +++ b/examples/multiphase_pipe/src/geometry.f90 @@ -0,0 +1,136 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init,get_VF + + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + use pgrid_class, only: p3dfft_decomp + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U','u') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V','v') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W','w') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry \ No newline at end of file diff --git a/examples/multiphase_pipe/src/simulation.f90 b/examples/multiphase_pipe/src/simulation.f90 new file mode 100644 index 000000000..052f8051d --- /dev/null +++ b/examples/multiphase_pipe/src/simulation.f90 @@ -0,0 +1,380 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + +contains + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=14 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + +end module simulation diff --git a/examples/muscl_reflect_test/GNUmakefile b/examples/muscl_reflect_test/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/muscl_reflect_test/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/muscl_reflect_test/README b/examples/muscl_reflect_test/README new file mode 100644 index 000000000..07c52460b --- /dev/null +++ b/examples/muscl_reflect_test/README @@ -0,0 +1,2 @@ +The 'detonation' example, but with an initial velocity toward a reflecting +wall. diff --git a/examples/muscl_reflect_test/input b/examples/muscl_reflect_test/input new file mode 100644 index 000000000..f146e101b --- /dev/null +++ b/examples/muscl_reflect_test/input @@ -0,0 +1,22 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 +Periodic : false + +# Initialization +Initial diameter : 0.2 +Initial x velocity : 0.5 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/muscl_reflect_test/src/Make.package b/examples/muscl_reflect_test/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/muscl_reflect_test/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/muscl_reflect_test/src/geometry.f90 b/examples/muscl_reflect_test/src/geometry.f90 new file mode 100644 index 000000000..c27998de1 --- /dev/null +++ b/examples/muscl_reflect_test/src/geometry.f90 @@ -0,0 +1,82 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + logical :: periodic + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + call param_read('Periodic', periodic) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=periodic, & + & yper=periodic, zper=periodic) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/muscl_reflect_test/src/simulation.f90 b/examples/muscl_reflect_test/src/simulation.f90 new file mode 100644 index 000000000..e1c266b80 --- /dev/null +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -0,0 +1,350 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(:,i,j,k)) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + function side_locator_z_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.lt.pg%kmin) loc = .true. + end function side_locator_z_l + function side_locator_z_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.gt.pg%kmax) loc = .true. + end function side_locator_z_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use string, only: str_medium + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + call fs%add_bcond(name='openzl' , type=NO_WAVES, & + & locator=side_locator_z_l, dir='zl') + call fs%add_bcond(name='openzr' , type=NO_WAVES, & + & locator=side_locator_z_r, dir='zr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP) :: r2, oR, initxvel + real(WP), dimension(3) :: x, c + real(WP), dimension(5) :: insvalphys, outvalphys, insval, outval + integer :: i, j, k + + call param_read('Initial diameter', oR) + oR = 0.5_WP * oR + + call param_read('Initial x velocity', initxvel, 'Initial x velocity', 0.0_WP) + + insvalphys = SOD_PHYS_L + outvalphys = SOD_PHYS_R + insvalphys(2) = insvalphys(2) + initxvel + outvalphys(2) = outvalphys(2) + initxvel + call euler_tocons(DIATOMIC_GAMMA, insvalphys, insval) + call euler_tocons(DIATOMIC_GAMMA, outvalphys, outval) + + c = 0.5_WP * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmino_, cfg%kmaxo_ + x(3) = cfg%zm(k) + do j = cfg%jmino_, cfg%jmaxo_ + x(2) = cfg%ym(j) + do i = cfg%imino_, cfg%imaxo_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (r2 .lt. oR**2) then + fs%Uc(:,i,j,k) = insval + else + fs%Uc(:,i,j,k) = outval + end if + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(5,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name='SodSphereTest') + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:) + ptr2 => phys_out(3,:,:,:) + ptr3 => phys_out(4,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/nozzle_2grids/GNUmakefile b/examples/nozzle_2grids/GNUmakefile index 86fde1a2e..f77956a50 100644 --- a/examples/nozzle_2grids/GNUmakefile +++ b/examples/nozzle_2grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/GNUmakefile b/examples/nozzle_2phase/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/nozzle_2phase/GNUmakefile +++ b/examples/nozzle_2phase/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/src/simulation.f90 b/examples/nozzle_2phase/src/simulation.f90 index 8c3c96138..1333c4b95 100644 --- a/examples/nozzle_2phase/src/simulation.f90 +++ b/examples/nozzle_2phase/src/simulation.f90 @@ -852,7 +852,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =(6.0_WP*Vd/pi)**(1.0_WP/3.0_WP) !< Assign diameter from model above lp%p(np)%pos =vf%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp%p(np)%vel =fs%cfg%get_velocity(pos=lp%p(np)%pos,i0=i,j0=j,k0=k,U=fs%U,V=fs%V,W=fs%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_3grids/GNUmakefile b/examples/nozzle_3grids/GNUmakefile index 7eb9f094c..ce3cd7055 100644 --- a/examples/nozzle_3grids/GNUmakefile +++ b/examples/nozzle_3grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_3grids/src/simulation.f90 b/examples/nozzle_3grids/src/simulation.f90 index 80fa99650..c3c3027fa 100644 --- a/examples/nozzle_3grids/src/simulation.f90 +++ b/examples/nozzle_3grids/src/simulation.f90 @@ -1627,7 +1627,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp3%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp3%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp3%p(np)%col =0.0_WP !< Give zero collision force + lp3%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp3%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp3%p(np)%d =(6.0_WP*Vl/pi)**(1.0_WP/3.0_WP) !< Assign diameter based on remaining liquid volume lp3%p(np)%pos =vf2%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp3%p(np)%vel =fs2%cfg%get_velocity(pos=lp3%p(np)%pos,i0=i,j0=j,k0=k,U=fs2%U,V=fs2%V,W=fs2%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_internal/GNUmakefile b/examples/nozzle_internal/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/nozzle_internal/GNUmakefile +++ b/examples/nozzle_internal/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/GNUmakefile b/examples/part_bed/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_bed/GNUmakefile +++ b/examples/part_bed/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index ab3c8a29a..60d4343ed 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -83,7 +83,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile index c66736380..08f94d1c9 100644 --- a/examples/part_inject/GNUmakefile +++ b/examples/part_inject/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_inject/input b/examples/part_inject/input index ce0325099..529ea015f 100644 --- a/examples/part_inject/input +++ b/examples/part_inject/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 2 2 +Partition : 2 2 2 # Mesh definition Lx : 0.007 diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index 09d75af36..be9287951 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -145,7 +145,7 @@ subroutine simulation_init ! Create a monitor file create_monitor: block ! Prepare some info about fields - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call lp%get_max() ! Create simulation monitor mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') @@ -188,12 +188,12 @@ subroutine simulation_run do while (.not.time%done()) ! Increment time - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call time%adjust_dt() call time%increment() ! Inject particles - call lp%inject(dt=time%dt) + call lp%inject(dt=time%dt,avoid_overlap=.true.) ! Collide particles call lp%collide(dt=time%dt) diff --git a/examples/part_tester/GNUmakefile b/examples/part_tester/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_tester/GNUmakefile +++ b/examples/part_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index b0fad014e..269a24285 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -76,7 +76,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/pvessel/GNUmakefile b/examples/pvessel/GNUmakefile index 53ecb4714..7d199c73f 100644 --- a/examples/pvessel/GNUmakefile +++ b/examples/pvessel/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -COOLPROP_DIR= /Users/desjardi/Builds/coolprop +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/rayleigh-taylor/GNUmakefile b/examples/rayleigh-taylor/GNUmakefile index bd18602c5..f928f86a6 100644 --- a/examples/rayleigh-taylor/GNUmakefile +++ b/examples/rayleigh-taylor/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile new file mode 100644 index 000000000..44ad3a454 --- /dev/null +++ b/examples/riser/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := variable_density particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/riser/README b/examples/riser/README new file mode 100644 index 000000000..772f09724 --- /dev/null +++ b/examples/riser/README @@ -0,0 +1 @@ +Periodic pipe with particles. diff --git a/examples/riser/input b/examples/riser/input new file mode 100644 index 000000000..1f1fe64e4 --- /dev/null +++ b/examples/riser/input @@ -0,0 +1,46 @@ +# Parallelization +Partition : 1 4 1 + +# Mesh definition +Pipe length : 0.08 +Pipe diameter : .01 +nx : 570 +ny : 70 +nz : 1 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 +Max time : 10 + +# Fluid properties +Bulk velocity : 0.272 +Dynamic viscosity : 1.8e-5 +Density : 1.2 +Gravity : -9.81 0 0 + +# Particle properties +Particle volume fraction : 0.012 +Particle mean diameter : 58e-6 +Particle standard deviation : 25-6 +Particle min diameter : 21e-6 +Particle max diameter : 140e-6 +Particle diameter shift : 8e-6 +Particle density : 2250 +Collision timescale : 15e-5 +Coefficient of restitution : 0.8 +Friction coefficient : 0.1 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 200e-5 + +# Postprocessing output +Postproc output period : 200e-5 + +# Restart files +Restart output period : 200e-5 +!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/Make.package b/examples/riser/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/riser/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 new file mode 100644 index 000000000..57e685a7d --- /dev/null +++ b/examples/riser/src/geometry.f90 @@ -0,0 +1,134 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init, get_VF + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 new file mode 100644 index 000000000..eff547c6e --- /dev/null +++ b/examples/riser/src/simulation.f90 @@ -0,0 +1,825 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg,D,get_VF + use lowmach_class, only: lowmach + use fourier3d_class, only: fourier3d + use hypre_str_class, only: hypre_str + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker + type(lowmach), public :: fs + type(fourier3d), public :: ps + type(hypre_str), public :: vs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Provide a datafile and an event tracker for saving restarts + type(event) :: save_evt + type(datafile) :: df + logical :: restarted + + !> Ensight postprocessing + type(ensight) :: ens_out + type(partmesh) :: pmesh + type(event) :: ens_evt + + !> Event for post-processing + type(event) :: ppevt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,lptfile,tfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: G + real(WP), dimension(:,:,:,:), allocatable :: Gnorm + real(WP) :: visc,rho,mfr,mfr_target,bforce + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + +contains + + + !> Specialized subroutine that outputs mean statistics + subroutine postproc() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp +!!$ ! Allocate radial line storage +!!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP +!!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP +!!$ allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP +!!$ allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP +!!$ ! Integrate all data over x and z +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) +!!$ Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) +!!$ end do +!!$ end do +!!$ end do +!!$ ! All-reduce the data +!!$ call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ if (vol(j).gt.0.0_WP) then +!!$ Uavg(j)=Uavg(j)/vol(j) +!!$ else +!!$ Uavg(j)=0.0_WP +!!$ end if +!!$ end do +!!$ ! If root, print it out +!!$ if (fs%cfg%amRoot) then +!!$ filename='Uavg_' +!!$ write(timestamp,'(es12.5)') time%t +!!$ open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) +!!$ write(iunit,'(a12,3x,a12)') 'Height','Uavg' +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) +!!$ end do +!!$ close(iunit) +!!$ end if +!!$ ! Deallocate work arrays +!!$ deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*(fs%rhoU(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*fs%rhoU(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Handle restart/saves here + restart_and_save: block + character(len=str_medium) :: timestamp + ! Create event for saving restart files + save_evt=event(time,'Restart output') + call param_read('Restart output period',save_evt%tper) + ! Check if we are restarting + call param_read(tag='Restart from',val=timestamp,short='r',default='') + restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. + if (restarted) then + ! If we are, read the name of the directory + call param_read('Restart from',timestamp,'r') + ! Read the datafile + df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) + else + ! If we are not restarting, we will still need a datafile for saving restart files + df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) + df%valname(1)='t' + df%valname(2)='dt' + df%valname(3)='mfr' + df%valname(4)='bforce' + df%varname(1)='U' + df%varname(2)='V' + df%varname(3)='W' + df%varname(4)='P' + end if + end block restart_and_save + + + ! Revisit timetracker to adjust time and time step values if this is a restart + update_timetracker: block + if (restarted) then + call df%pullval(name='t' ,val=time%t ) + call df%pullval(name='dt',val=time%dt) + time%told=time%t-time%dt + end if + end block update_timetracker + + + ! Initialize wallclock timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_lognormal,random_uniform + use mathtools, only: Pi,twoPi + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER + use parallel, only: MPI_REAL_WP + real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf + real(WP) :: dmean,dsd,dmin,dmax,dshift + real(WP), dimension(:), allocatable :: dp + integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + character(len=str_medium) :: timestamp + logical :: overlap + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get pipe diameter from input + ! Get mean volume fraction from input + call param_read('Particle volume fraction',VFavg) + ! Get drag model from input + call param_read('Drag model',lp%drag_model,default='Tenneti') + ! Get particle density from input + call param_read('Particle density',lp%rho) + ! Get particle diameter from input + call param_read('Particle mean diameter',dmean) + call param_read('Particle standard deviation',dsd,default=0.0_WP) + call param_read('Particle min diameter',dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',dshift,default=0.0_WP) + if (dsd.le.epsilon(1.0_WP)) then + dmin=dmean + dmax=dmean + end if + ! Get particle temperature from input + call param_read('Particle temperature',Tp,default=298.15_WP) + ! Set collision timescale + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Initialize particles + if (restarted) then + call param_read('Restart from',timestamp,'r') + ! Read the part file + call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) + else + ! Get volume of domain belonging to this proc + Vol_=0.0_WP + do k=lp%cfg%kmin_,lp%cfg%kmax_ + do j=lp%cfg%jmin_,lp%cfg%jmax_ + do i=lp%cfg%imin_,fs%cfg%imax_ + Vol_=Vol_+lp%cfg%dx(i)*lp%cfg%dy(j)*lp%cfg%dz(k) + end do + end do + end do + ! Get particle diameters + np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) + allocate(dp(np)) + sumVolp=0.0_WP; np=0 + do while(sumVolp.lt.VFavg*Vol_) + np=np+1 + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + do while (dp(np).gt.dmax+epsilon(1.0_WP).or.dp(np).lt.dmin-epsilon(1.0_WP)) + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + end do + sumVolp=sumVolp+Pi/6.0_WP*dp(np)**3 + end do + call lp%resize(np) + ! Allocate particle in cell arrays + allocate(npic( lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); npic=0 + allocate(ipic(1:40,lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); ipic=0 + ! Distribute particles + sumVolp=0.0_WP; meand=0.0_WP + do i=1,np + ! Set the diameter + lp%p(i)%d=dp(i) + ! Give position (avoid overlap) + overlap=.true. + do while (overlap) + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin_),lp%cfg%x(lp%cfg%imax_+1)-dmax),& + & random_uniform(lp%cfg%y(lp%cfg%jmin_),lp%cfg%y(lp%cfg%jmax_+1)-dmax),& + & random_uniform(lp%cfg%z(lp%cfg%kmin_),lp%cfg%z(lp%cfg%kmax_+1)-dmax)] + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + overlap=.false. + do kk=lp%p(i)%ind(3)-1,lp%p(i)%ind(3)+1 + do jj=lp%p(i)%ind(2)-1,lp%p(i)%ind(2)+1 + do ii=lp%p(i)%ind(1)-1,lp%p(i)%ind(1)+1 + do nn=1,npic(ii,jj,kk) + j=ipic(nn,ii,jj,kk) + if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) overlap=.true. + end do + end do + end do + end do + end do + ! Check if particle is within the pipe + r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) + if (r.le.0.5_WP*(D-lp%p(i)%d)) then + ! Activate the particle + lp%p(i)%flag=0 + ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + ! Set the temperature + lp%p(i)%T=Tp + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Sum up volume + sumVolp=sumVolp+Pi/6.0_WP*lp%p(i)%d**3 + meand=meand+lp%p(i)%d + else + lp%p(i)%flag=1 + end if + end do + deallocate(dp,npic,ipic) + call lp%sync() + ! Set ID + offset=0 + do i=1,lp%cfg%rank + offset=offset+lp%np_proc(i) + end do + do i=1,lp%np_ + lp%p(i)%id=int(i+offset,8) + end do + ! Get mean diameter and volume fraction + call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) + call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*D**2/4.0_WP*lp%cfg%xL) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', lp%np + print*,'Mean diameter', meand + print*,'Mean volume fraction',VFavg + end if + end if + ! Get initial particle volume fraction + call lp%update_VF() + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + real(WP) :: Ubulk + if (restarted) then + call df%pullvar(name='U',var=fs%U) + call df%pullvar(name='V',var=fs%V) + call df%pullvar(name='W',var=fs%W) + call df%pullvar(name='P',var=fs%P) + else + ! Initial velocity + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + end if + ! Set density from particle volume fraction and store initial density + fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho + ! Form momentum + call fs%rho_multiply + fs%rhoUold=fs%rhoU + ! Apply all other boundary conditions + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Set initial MFR and body force + if (restarted) then + call df%pullval(name='mfr',val=mfr) + call df%pullval(name='bforce',val=bforce) + else + mfr=get_bodyforce_mfr() + bforce=0.0_WP + end if + mfr_target=mfr + end block initialize_velocity + + + ! Initialize levelset and its normal + initialize_G: block + integer :: i,j,k + real(WP) :: buf + real(WP), dimension(3) :: n12 + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + n12(1)=0.0_WP + n12(2)=-fs%cfg%ym(j) + n12(3)=-fs%cfg%zm(k) + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + Gnorm(:,i,j,k)=n12/buf + end do + end do + end do + call fs%cfg%sync(G) + call fs%cfg%sync(Gnorm) + end block initialize_G + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='riser') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',fs%cfg%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create monitor filea + create_monitor: block + real(WP) :: cfl + ! Prepare some info about fields + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%ncol,'Collision number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc() + end block create_postproc + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use parallel, only: parallel_time + implicit none + real(WP) :: cfl + + ! Perform time integration + do while (.not.time%done()) + + ! Initial wallclock time + wt_total%time_in=parallel_time() + + ! Increment time + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Get fluid stress (include mean body force from mfr forcing) + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + resU=resU+bforce + + ! Collide and advance particles + call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + end block add_lpt_src + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) + RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) + RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + end do + end do + end do + end block ibm_correction + + ! Add body forcing + bodyforcing: block + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dtmid*bforce + end block bodyforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + +!!$ ! Apply direct forcing to enforce BC at the pipe walls +!!$ ibm_correction: block +!!$ integer :: i,j,k +!!$ real(WP) :: VFx,VFy,VFz +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ VFx=get_VF(i,j,k,'U') +!!$ VFy=get_VF(i,j,k,'V') +!!$ VFz=get_VF(i,j,k,'W') +!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx +!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy +!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz +!!$ end do +!!$ end do +!!$ end do +!!$ call fs%cfg%sync(fs%U) +!!$ call fs%cfg%sync(fs%V) +!!$ call fs%cfg%sync(fs%W) +!!$ end block ibm_correction + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Solve Poisson equation + wt_pres%time_in=parallel_time() + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Recompute massflow rate + mfr=get_bodyforce_mfr() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Specialized post-processing + if (ppevt%occurs()) call postproc() + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + ! Finally, see if it's time to save restart files + if (save_evt%occurs()) then + save_restart: block + character(len=str_medium) :: timestamp + ! Prefix for files + write(timestamp,'(es12.5)') time%t + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Populate df and write it + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt ) + call df%pushval(name='mfr',val=mfr_target) + call df%pushval(name='bforce',val=bforce ) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) + call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) + ! Write particle file + call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) + end block save_restart + end if + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) + + end subroutine simulation_final + +end module simulation diff --git a/examples/shock_particle/README b/examples/shock_particle/README deleted file mode 100644 index 098c2471d..000000000 --- a/examples/shock_particle/README +++ /dev/null @@ -1 +0,0 @@ -This is a test case for a shock wave interacting with Lagrangian particles. Uses multiphase solver and hard-codes VF to 0 or 1 based on chosen phase. diff --git a/examples/shock_particle/input b/examples/shock_particle/input deleted file mode 100644 index b359f094b..000000000 --- a/examples/shock_particle/input +++ /dev/null @@ -1,44 +0,0 @@ -# Parallelization -Partition : 3 1 1 - -# Mesh definition -Lx : 0.2048 -nx : 512 -Ly : 0.0256 -ny : 64 - -# Flow setup -Shock location : 0.08 -Mach number of shock : 1.47 -Pre-shock density : 1.204 -Pre-shock pressure : 1.01325e5 -Particle volume fraction : 0.2 -Particle curtain width : 0.0034 - -# Fluid properties -Phase : gas -Dynamic viscosity : 1.8e-5 -Thermal conductivity : 0 -Gamma : 1.4 - -# Particle parameters -Particle density : 1000 -Particle diameter : 200e-6 -Drag model : Tenneti - -# Time integration -Max timestep size : 8e-7 -Max cfl number : 0.9 -Max time : 100000 -Max steps : 100000 - -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 10e-6 diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 deleted file mode 100644 index 53a91f348..000000000 --- a/examples/shock_particle/src/simulation.f90 +++ /dev/null @@ -1,593 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use mast_class, only: mast - use vfs_class, only: vfs - use matm_class, only: matm - use lpt_class, only: lpt - use partmesh_class, only: partmesh - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - use string, only: str_medium - implicit none - private - - !> Single two-phase flow solver, volume fraction solver, material model, and LPT solver set - !> With corresponding time tracker - type(mast), public :: fs - type(vfs), public :: vf - type(matm), public :: matmod - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,cvgfile - type(monitor) :: lptfile - - public :: simulation_init,simulation_run,simulation_final - - !> Problem definition - character(len=str_medium) :: phase - integer :: relax_model - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resE - real(WP), dimension(:,:,:), allocatable :: dRHOdt - - contains - - !> Function that localizes the left (x-) of the domain - function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. - end function left_of_domain - - !> Function that localizes the right (x+) of the domain - function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. - end function right_of_domain - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - call param_read('Max steps',time%nmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resE (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT - initialize_lpt: block - use random, only: random_uniform - use mathtools, only: Pi - use parallel, only: amRoot - use lpt_class, only: drag_model - real(WP) :: dp,VFp,L,x0,vol,volp - integer :: i,np - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get drag model from the inpit - call param_read('Drag model',drag_model,default='Tenneti') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle diameter',dp) - ! Get particle volume fraction from the input - call param_read('Particle volume fraction',VFp) - ! Get curtain width from the input - call param_read('Particle curtain width',L) - ! Get starting position - x0=0.5_WP*(lp%cfg%x(lp%cfg%imax+1)-lp%cfg%x(lp%cfg%imin)-L) - ! Get number of particles - vol=L*lp%cfg%yL*lp%cfg%zL - volp=Pi*dp**3/6.0_WP - np=int(VFp * vol / volp) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(x0,x0+L),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin) - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero collision force - lp%p(i)%col=0.0_WP - ! Give it temperature - lp%p(i)%T=293.15_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do - end if - ! Distribute particles - call lp%sync() - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - if (amRoot) then - print*,"===== Particle Setup Description =====" - print*,'Number of particles', np - print*,'Mean volume fraction',vfp - end if - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') - call lp%update_partmesh(pmesh) - end block create_pmesh - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver with lvira reconstruction - vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') - call param_read('Phase',phase) - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - select case(trim(phase)) - case('gas') - vf%VF(i,j,k)=0.0_WP - case('liquid') - vf%VF(i,j,k)=1.0_WP - case default - end select - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end do - end do - end do - ! Boundary conditions on VF are built into the mast solver - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Set initial interface at the boundaries - call vf%set_full_bcond() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a compressible two-phase flow solver - create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz - use matm_class, only : air - use ils_class, only: pcg_bbox,gmres_smg - use mathtools, only: Pi - use parallel, only: amRoot - integer :: i,j,k,n - real(WP), dimension(3) :: xyz - real(WP) :: gamm,Pref,visc,hdff - real(WP) :: xshock,vshock,relshockvel - real(WP) :: rho0, P0, rho1, P1, Ma1, Ma, rho, P, U - type(bcond), pointer :: mybc - ! Create material model class - matmod=matm(cfg=cfg,name='Liquid-gas models') - ! Get EOS parameters from input - call param_read('Gamma',gamm) - ! Register equations of state - select case(trim(phase)) - case('gas') - call matmod%register_idealgas('gas',gamm) - case('liquid') - call param_read('Pref', Pref) - call matmod%register_stiffenedgas('liquid',gamm,Pref) - end select - ! Create flow solver - fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) - ! Register flow solver variables with material models - call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) - call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity, also heat diffusion - call param_read('Dynamic viscosity',visc) - call param_read('Thermal conductivity',hdff) - select case(trim(phase)) - case('gas') - call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscconst_gas=visc, & - viscconst_liquid=0.0_WP, hdffconst_gas=hdff, hdffconst_liquid=0.0_WP) - fs%Lrho = 0.0_WP - fs%LrhoE= 0.0_WP - case('liquid') - call matmod%register_diffusion_thermo_models(viscconst_gas=0.0_WP, viscconst_liquid=visc, & - hdffconst_gas=0.0_WP, hdffconst_liquid=hdff) - fs%Grho = 0.0_WP - end select - ! Read in surface tension coefficient - fs%sigma=0.0_WP - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit momentum solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) - ! Initially 0 velocity in y and z - fs%Vi = 0.0_WP; fs%Wi = 0.0_WP - ! Zero face velocities as well for the sake of dirichlet boundaries - fs%V = 0.0_WP; fs%W = 0.0_WP - ! Set up initial thermo properties (0) - ! Default is from Meng & Colonius (2015), - ! which is basically the same as Igra & Takayama and Terashima & Tryggvason - call param_read('Pre-shock density',rho0,default=1.204_WP) - call param_read('Pre-shock pressure',P0,default=1.01325e5_WP) - call param_read('Mach number of shock',Ma,default=1.47_WP) - call param_read('Shock location',xshock) - ! Use shock relations to get post-shock numbers (1) - P1 = P0 * (2.0_WP*gamm*Ma**2 - (gamm-1.0_WP)) / (gamm+1.0_WP) - rho1 = rho0 * (Ma**2 * (gamm+1.0_WP) / ((gamm-1.0_WP)*Ma**2 + 2.0_WP)) - ! Calculate post-shock Mach number - Ma1 = sqrt(((gamm-1.0_WP)*(Ma**2)+2.0_WP)/(2.0_WP*gamm*(Ma**2)-(gamm-1.0_WP))) - ! Calculate post-shock velocity - vshock = -Ma1 * sqrt(gamm*P1/rho1) + Ma*sqrt(gamm*P0/rho0) - ! Velocity at which shock moves - relshockvel = -rho1*vshock/(rho0-rho1) - - if (amRoot) then - print*,"===== Fluid Setup Description =====" - print*,'Mach number', Ma - print*,'Pre-shock: Density',rho0,'Pressure',P0 - print*,'Post-shock: Density',rho1,'Pressure',P1,'Velocity',vshock - print*,'Shock velocity', relshockvel - end if - - ! Initialize gas phase quantities - do i=fs%cfg%imino_,fs%cfg%imaxo_ - ! pressure, velocity, use matmod for energy - if (fs%cfg%x(i).lt.xshock) then - rho = rho1 - U = vshock - P = P1 - else - rho = rho0 - U = 0.0_WP - P = P0 - end if - select case(trim(phase)) - case('gas') - fs%Grho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%GrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'gas') - case('liquid') - fs%Lrho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%LrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'liquid') - end select - end do - - ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers - call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1) - - ! Calculate face velocities - call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) - ! Apply face BC - inflow - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%n_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=vshock - end do - ! Apply face BC - outflow - bc_scope = 'velocity' - call fs%apply_bcond(time%dt,bc_scope) - - ! Calculate mixture density and momenta - fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho - fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi - ! Perform initial pressure relax - relax_model = mech_egy_mech_hhz - call fs%pressure_relax(vf,matmod,relax_model) - ! Calculate initial phase and bulk moduli - call fs%init_phase_bulkmod(vf,matmod) - call fs%reinit_phase_pressure(vf,matmod) - call fs%harmonize_advpressure_bulkmod(vf,matmod) - ! Set initial pressure to harmonized field based on internal energy - fs%P = fs%PA - - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ShockTube') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) - call ens_out%add_scalar('T',fs%Tmptr) - call ens_out%add_scalar('P',fs%P) - call ens_out%add_scalar('PA',fs%PA) - call ens_out%add_scalar('Density',fs%RHO) - call ens_out%add_scalar('Bulkmod',fs%RHOSS2) - call ens_out%add_scalar('divU',fs%divU) - call ens_out%add_scalar('Viscosity',fs%visc) - call ens_out%add_scalar('Mach',fs%Mach) - call ens_out%add_particle('particles',pmesh) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%RHOmin,'RHOmin') - call mfile%add_column(fs%RHOmax,'RHOmax') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%Tmax,'Tmax') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLa_x,'Acoustic xCFL') - call cflfile%add_column(fs%CFLa_y,'Acoustic yCFL') - call cflfile%add_column(fs%CFLa_z,'Acoustic zCFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create convergence monitor - cvgfile=monitor(fs%cfg%amRoot,'cvg') - call cvgfile%add_column(time%n,'Timestep number') - call cvgfile%add_column(time%it,'Iteration') - call cvgfile%add_column(time%t,'Time') - call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') - call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') - call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') - call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') - call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') - call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') - call cvgfile%add_column(fs%psolv%it,'Pressure iteration') - call cvgfile%add_column(fs%psolv%rerr,'Pressure error') - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%VFmean,'VFp_mean') - call lptfile%add_column(lp%VFmax,'VFp_max') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - use messager, only: die - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Reinitialize phase pressure by syncing it with conserved phase energy - call fs%reinit_phase_pressure(vf,matmod) - fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi - fs%RHOold = fs%RHO - ! Remember old flow variables (phase) - fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho - fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE - fs%GPold = fs%GP; fs%LPold = fs%LP - - ! Remember old interface, including VF and barycenters - call vf%copy_interface_to_old() - - ! Create in-cell reconstruction - call fs%flow_reconstruct(vf) - - ! Zero variables that will change during subiterations - fs%P = 0.0_WP - fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP - fs%Hpjump = 0.0_WP - - ! Determine semi-Lagrangian advection flag - call fs%flag_sl(time%dt,vf) - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - resU=fs%rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) - - ! Update density based on particle volume fraction - fs%rho=resU*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Add momentum source term from lpt (cell-centered) - add_lpt_src: block - integer :: i,j,k - resU=0.0_WP; resV=0.0_WP; resW=0.0_WP; resE=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+lp%srcU(i,j,k) - resV(i,j,k)=resV(i,j,k)+lp%srcV(i,j,k) - resW(i,j,k)=resW(i,j,k)+lp%srcW(i,j,k) - resE(i,j,k)=resE(i,j,k)+lp%srcE(i,j,k) - end do - end do - end do - end block add_lpt_src - - ! Predictor step, involving advection and pressure terms - call fs%advection_step(time%dt,vf,matmod) - - ! Viscous step - call fs%diffusion_src_explicit_step(time%dt,vf,matmod,srcU=resU,srcV=resV,srcW=resW,srcE=resE) - - ! Prepare pressure projection - call fs%pressureproj_prepare(time%dt,vf,matmod) - ! Initialize and solve Helmholtz equation - call fs%psolv%setup() - fs%psolv%sol=fs%PA-fs%P - call fs%psolv%solve() - call fs%cfg%sync(fs%psolv%sol) - ! Perform corrector step using solution - fs%P=fs%P+fs%psolv%sol - call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) - - ! Record convergence monitor - call cvgfile%write() - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Pressure relaxation - call fs%pressure_relax(vf,matmod,relax_model) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block update_pmesh - call fs%get_viz() - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,resE,dRHOdt) - - end subroutine simulation_final - -end module simulation diff --git a/examples/shock_water_cylinder/GNUmakefile b/examples/shock_water_cylinder/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/shock_water_cylinder/GNUmakefile +++ b/examples/shock_water_cylinder/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/sod/GNUmakefile b/examples/sod/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/sod/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/sod/README b/examples/sod/README new file mode 100644 index 000000000..b5ce65a88 --- /dev/null +++ b/examples/sod/README @@ -0,0 +1,6 @@ +The classic Sod problem (Sod, JCP, 1978). + +An incident angle may be specified so that the 1d behavior (see +`input_aligned`) and the behavior at an angle to the mesh (see `input_skew`) +may be examined. + diff --git a/examples/sod/input_aligned b/examples/sod/input_aligned new file mode 100644 index 000000000..4ff2de33b --- /dev/null +++ b/examples/sod/input_aligned @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 0.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod/input_skew b/examples/sod/input_skew new file mode 100644 index 000000000..5974f5f37 --- /dev/null +++ b/examples/sod/input_skew @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 35.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod/src/Make.package b/examples/sod/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/sod/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/sod/src/geometry.f90 b/examples/sod/src/geometry.f90 new file mode 100644 index 000000000..dfe9a5b6e --- /dev/null +++ b/examples/sod/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + nz = 1 + Lz = 1.0_WP + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1-nx/2,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1-nz/2,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF = 1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 new file mode 100644 index 000000000..1778ef3fb --- /dev/null +++ b/examples/sod/src/simulation.f90 @@ -0,0 +1,335 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES, WALL_REFLECT + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Flow solver and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + character(len=str_medium) :: ens_out_name + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(1:5,i,j,k)) + phys_out(6,i,j,k) = sqrt(sum(phys_out(2:4,i,j,k)**2) / (DIATOMIC_GAMMA * phys_out(5,i,j,k) / phys_out(1,i,j,k))) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver + create_and_initialize_flow_solver: block + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP), dimension(5) :: lval, rval, val + real(WP) :: angle, x0, y0, x1, y1, w + integer :: i, j, k + + call param_read('Mesh angle', angle) + + write(ens_out_name,'(A,F0.1)') 'SodAngle', angle + + angle = angle * 2.0_WP * 4.0_WP * atan(1.0_WP) / 360 + + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_L, lval) + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_R, rval) + + do j = cfg%jmino_, cfg%jmaxo_ + y0 = cfg%y(j); y1 = cfg%y(j+1); + do i = cfg%imino_, cfg%imaxo_ + x0 = cfg%x(i); x1 = cfg%x(i+1); + if (cos(angle) * x1 + sin(angle) * y1 .le. 0.0_WP) then + val = lval + else if (cos(angle) * x0 + sin(angle) * y0 .ge. 0.0_WP) then + val = rval + else + w = 0.5_WP * (cotan(angle) * x0 + y0) * (tan(angle) * y0 + x0) + if (-cotan(angle) * x0 .gt. y1) then + w = w - 0.5_WP * (tan(angle) * y1 + x0) * (cotan(angle) * x0 + y1) + end if + if (-tan(angle) * y0 .gt. x1) then + w = w - 0.5_WP * (tan(angle) * y0 + x1) * (cotan(angle) * x1 + y0) + end if + w = w / (cfg%dx(i) * cfg%dy(j)) + val = lval * w + rval * (1.0_WP - w) + end if + do k = cfg%kmino_, cfg%kmaxo_ + fs%Uc(:,i,j,k) = val + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name=ens_out_name) + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:); + ptr2 => phys_out(3,:,:,:); + ptr3 => phys_out(4,:,:,:); + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + ptr1 => phys_out(6,:,:,:) + call ens_out%add_scalar('Ma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/sod_rusanov/GNUmakefile b/examples/sod_rusanov/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/sod_rusanov/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/sod_rusanov/input_aligned b/examples/sod_rusanov/input_aligned new file mode 100644 index 000000000..4ff2de33b --- /dev/null +++ b/examples/sod_rusanov/input_aligned @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 0.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod_rusanov/input_skew b/examples/sod_rusanov/input_skew new file mode 100644 index 000000000..5974f5f37 --- /dev/null +++ b/examples/sod_rusanov/input_skew @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 35.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod_rusanov/src/Make.package b/examples/sod_rusanov/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/sod_rusanov/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/sod_rusanov/src/geometry.f90 b/examples/sod_rusanov/src/geometry.f90 new file mode 100644 index 000000000..6a93a5c54 --- /dev/null +++ b/examples/sod_rusanov/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + nz = 1 + Lz = 1.0_WP + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1-nx/2,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1-nz/2,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=1, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF = 1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/sod_rusanov/src/simulation.f90 b/examples/sod_rusanov/src/simulation.f90 new file mode 100644 index 000000000..c0d58da33 --- /dev/null +++ b/examples/sod_rusanov/src/simulation.f90 @@ -0,0 +1,333 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use rusanov_class, only: rusanov, EXTRAPOLATE + use hyperbolic_euler, only: make_euler_rusanov, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Flow solver and a time tracker + type(rusanov), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + character(len=str_medium) :: ens_out_name + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(1:5,i,j,k)) + phys_out(6,i,j,k) = sqrt(sum(phys_out(2:4,i,j,k)**2) / (DIATOMIC_GAMMA * phys_out(5,i,j,k) / phys_out(1,i,j,k))) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver + create_and_initialize_flow_solver: block + + ! call constructor + fs = make_euler_rusanov(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=EXTRAPOLATE, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=EXTRAPOLATE, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=EXTRAPOLATE, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=EXTRAPOLATE, & + & locator=side_locator_y_r, dir='yr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP), dimension(5) :: lval, rval, val + real(WP) :: angle, x0, y0, x1, y1, w + integer :: i, j, k + + call param_read('Mesh angle', angle) + + write(ens_out_name,'(A,F0.1)') 'SodAngle', angle + + angle = angle * 2.0_WP * 4.0_WP * atan(1.0_WP) / 360 + + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_L, lval) + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_R, rval) + + do j = cfg%jmino_, cfg%jmaxo_ + y0 = cfg%y(j); y1 = cfg%y(j+1); + do i = cfg%imino_, cfg%imaxo_ + x0 = cfg%x(i); x1 = cfg%x(i+1); + if (cos(angle) * x1 + sin(angle) * y1 .le. 0.0_WP) then + val = lval + else if (cos(angle) * x0 + sin(angle) * y0 .ge. 0.0_WP) then + val = rval + else + w = 0.5_WP * (cotan(angle) * x0 + y0) * (tan(angle) * y0 + x0) + if (-cotan(angle) * x0 .gt. y1) then + w = w - 0.5_WP * (tan(angle) * y1 + x0) * (cotan(angle) * x0 + y1) + end if + if (-tan(angle) * y0 .gt. x1) then + w = w - 0.5_WP * (tan(angle) * y0 + x1) * (cotan(angle) * x1 + y0) + end if + w = w / (cfg%dx(i) * cfg%dy(j)) + val = lval * w + rval * (1.0_WP - w) + end if + do k = cfg%kmino_, cfg%kmaxo_ + fs%Uc(:,i,j,k) = val + end do + end do + end do + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name=ens_out_name) + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:) + ptr2 => phys_out(3,:,:,:) + ptr3 => phys_out(4,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + ptr1 => phys_out(6,:,:,:) + call ens_out%add_scalar('Ma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt, time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/spreading/GNUmakefile b/examples/spreading/GNUmakefile index d2be840a9..01b390664 100644 --- a/examples/spreading/GNUmakefile +++ b/examples/spreading/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/swirl_atomizer/GNUmakefile b/examples/swirl_atomizer/GNUmakefile new file mode 100644 index 000000000..d3c3c1851 --- /dev/null +++ b/examples/swirl_atomizer/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +USE_ODRPACK=FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/swirl_atomizer/README b/examples/swirl_atomizer/README new file mode 100644 index 000000000..e13540dfa --- /dev/null +++ b/examples/swirl_atomizer/README @@ -0,0 +1 @@ +This is an implementation of a two-phase pressure swirl atomizer. diff --git a/examples/swirl_atomizer/input b/examples/swirl_atomizer/input new file mode 100644 index 000000000..3d2151b27 --- /dev/null +++ b/examples/swirl_atomizer/input @@ -0,0 +1,39 @@ +# Parallelization +Partition : 8 1 1 + +# Domain definition +Lx : 5 +Ly : 5 +Lz : 5 +nx : 100 +ny : 100 +nz : 100 + +# Problem definition +Inner radius : 0.4 +Outer radius : 0.6 +Liquid velocity : 1 +Swirl ratio : 1 + +# Fluid properties - Dimensional case +Liquid dynamic viscosity : 1e-3 +Gas dynamic viscosity : 1e-5 +Liquid density : 1 +Gas density : 1e-3 +Surface tension coefficient : 1e-3 + +# Time integration +Max timestep size : 4e-3 +Max cfl number : 0.9 +Max time : 100 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-5 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 diff --git a/examples/swirl_atomizer/src/Make.package b/examples/swirl_atomizer/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/swirl_atomizer/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/shock_particle/src/geometry.f90 b/examples/swirl_atomizer/src/geometry.f90 similarity index 62% rename from examples/shock_particle/src/geometry.f90 rename to examples/swirl_atomizer/src/geometry.f90 index 736845194..b247f2af5 100644 --- a/examples/shock_particle/src/geometry.f90 +++ b/examples/swirl_atomizer/src/geometry.f90 @@ -4,78 +4,70 @@ module geometry use precision, only: WP implicit none private - + !> Single config type(config), public :: cfg - + public :: geometry_init contains - - + + !> Initialization of problem geometry subroutine geometry_init use sgrid_class, only: sgrid - use param, only: param_read, param_exists - use parallel, only: amRoot - use messager, only: die + use param, only: param_read implicit none type(sgrid) :: grid - - + + ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz,dx + real(WP) :: Lx,Ly,Lz real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition + + ! Read in grid and geometry definition call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - dx = Lx/nx call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nz',nz,default=1); allocate(z(nz+1)) - - if (nz.eq.1) then - Lz = dx - else - call param_read('Lz',Lz) - end if - - ! Uniform grid + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid do i=1,nx+1 - x(i) = real(i-1,WP)*dx + x(i)=real(i-1,WP)/real(nx,WP)*Lx end do do j=1,ny+1 - y(j) = real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly end do - - ! z is always uniform do k=1,nz+1 - z(k) = real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz end do - + ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='ShockTube') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='swirl_atomizer') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block use parallel, only: group integer, dimension(3) :: partition - ! Read in partition call param_read('Partition',partition,short='p') - ! Create partitioned grid cfg=config(grp=group,decomp=partition,grid=grid) - end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + end subroutine geometry_init - - + + end module geometry diff --git a/examples/swirl_atomizer/src/simulation.f90 b/examples/swirl_atomizer/src/simulation.f90 new file mode 100644 index 000000000..73e0ea519 --- /dev/null +++ b/examples/swirl_atomizer/src/simulation.f90 @@ -0,0 +1,515 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use surfmesh_class, only: surfmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + type(surfmesh), public :: smesh + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: SRmag + real(WP), dimension(:,:,:,:), allocatable :: SR + + !> Problem definition + real(WP) :: R1,R2 !< Inner and outer radii of annulus + real(WP) :: Ul,SW !< Liquid axial velocity and swirl ratio + +contains + + + !> Function that defines a level set function for an annular liquid region + function levelset_annulus(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G,r + r=sqrt(xyz(2)**2+xyz(3)**2) + G=min(r-R1,R2-r) + end function levelset_annulus + + + !> Function that localizes the top (x+) of the domain + function xp_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function xp_locator + + + !> Function that localizes the bottom (x-) of the domain boundary + function xm_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.le.pg%imin) isIn=.true. + end function xm_locator + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SRmag(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR (6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot,name='pressure_swirl') + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,r2p,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Set full domain to gas + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + vf%VF(i,j,k)=0.0_WP + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end do + end do + end do + ! Initialize an annular interface at the inlet only + call param_read('Inner radius',R1) + call param_read('Outer radius',R2) + if (vf%cfg%iproc.eq.1) then + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino,vf%cfg%imin-1 + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_annulus,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + end if + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use tpns_class, only: dirichlet,clipped_neumann + use ils_class, only: pcg_pfmg + integer :: i,j,k + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity' ,fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density' ,fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Inflow on the left of domain + call fs%add_bcond(name='inflow',type=dirichlet, face='x',dir=-1,canCorrect=.false.,locator=xm_locator) + ! Clipped Neumann outflow on the right of domain + call fs%add_bcond(name='bc_xp' ,type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=xp_locator) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + end block create_and_initialize_flow_solver + + + ! Initialize our velocity field + initialize_velocity: block + use tpns_class, only: bcond + type(bcond), pointer :: mybc + real(WP) :: r,theta + integer :: n,i,j,k + ! Zero initial field in the domain + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Read in inflow parameters + call param_read('Liquid velocity',Ul) + call param_read('Swirl ratio',SW) + ! Apply axial and swirl component Dirichlet at inlet + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + ! Set U velocity + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%U(i,j,k)=Ul + ! Set V velocity + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%y(j),cfg%zm(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%V(i,j,k)=+4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*cos(theta) + ! Set W velocity + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%ym(j),cfg%z(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%W(i,j,k)=-4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*sin(theta) + end do + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + + ! Create surfmesh object for interface polygon output + create_smesh: block + use irl_fortran_interface + integer :: i,j,k,nplane,np + ! Include an extra variable for number of planes + smesh=surfmesh(nvar=1,name='plic') + smesh%varname(1)='nplane' + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block create_smesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='swirl_atomizer') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('Pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_surface('vofplic',smesh) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(vf%SDint,'SD integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Calculate SR + ! call fs%get_strainrate(Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) + + ! ! Model shear thinning fluid + ! nonewt: block + ! integer :: i,j,k + ! real(WP), parameter :: C=1.137e-3_WP + ! real(WP), parameter :: n=0.3_WP + ! ! Update viscosity + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! ! Power law model + ! SRmag(i,j,k)=sqrt(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! SRmag(i,j,k)=max(SRmag(i,j,k),1000.0_WP**(1.0_WP/(n-1.0_WP))) + ! fs%visc_l(i,j,k)=C*SRmag(i,j,k)**(n-1.0_WP) + ! ! Carreau Model + ! ! SRmag(i,j,k)=sqrt(2.00_WP*SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! ! fs%visc_l(i,j,k)=visc_inf+(visc_0-visc_inf)*(1.00_WP+(lambda*SRmag(i,j,k))**2.00_WP)**((n-1.00_WP)/2.00_WP) + ! end do + ! end do + ! end do + ! ! call fs%cfg%sync(fs%visc_l) + ! end block nonewt + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + ! Update surfmesh object + update_smesh: block + use irl_fortran_interface + integer :: nplane,np,i,j,k + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block update_smesh + ! Perform ensight output + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + ! After we're done clip all VOF at the exit area and along the sides - hopefully nothing's left + clip_vof: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (i.ge.vf%cfg%imax-5) vf%VF(i,j,k)=0.0_WP + if (j.ge.vf%cfg%jmax-5) vf%VF(i,j,k)=0.0_WP + if (j.le.vf%cfg%jmin+5) vf%VF(i,j,k)=0.0_WP + if (k.ge.vf%cfg%kmax-5) vf%VF(i,j,k)=0.0_WP + if (k.le.vf%cfg%kmin+5) vf%VF(i,j,k)=0.0_WP + end do + end do + end do + end block clip_vof + + end do + + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,SR,SRmag) + + end subroutine simulation_final + + +end module simulation diff --git a/examples/vdjet/GNUmakefile b/examples/vdjet/GNUmakefile index f467f9676..7f4563ac0 100644 --- a/examples/vdjet/GNUmakefile +++ b/examples/vdjet/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/vortexTG/GNUmakefile b/examples/vortexTG/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/vortexTG/GNUmakefile +++ b/examples/vortexTG/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/water_air_rarefaction/GNUmakefile b/examples/water_air_rarefaction/GNUmakefile index bef49b8f7..466227c85 100644 --- a/examples/water_air_rarefaction/GNUmakefile +++ b/examples/water_air_rarefaction/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/zalesak/GNUmakefile b/examples/zalesak/GNUmakefile index 13301e748..26c33af3b 100644 --- a/examples/zalesak/GNUmakefile +++ b/examples/zalesak/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /opt/homebrew -IRL_DIR = /Users/desjardi/Repositories/Builds/irl +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/src/config/config_class.f90 b/src/config/config_class.f90 index c78562450..91917045b 100644 --- a/src/config/config_class.f90 +++ b/src/config/config_class.f90 @@ -19,11 +19,13 @@ module config_class ! Geometry real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction info (VF=1 is fluid, VF=0 is wall) + real(WP) :: fluid_vol !< Total fluid volume in the config contains procedure :: print=>config_print !< Output configuration information to the screen procedure :: write=>config_write !< Write out config files: grid and geometry procedure, private :: prep=>config_prep !< Finish preparing config after the partitioned grid is loaded + procedure :: calc_fluid_vol !< Compute fluid_vol after VF has been set procedure :: VF_extend !< Extend VF array into the non-periodic domain overlaps procedure :: integrate !< Integrate a variable on config while accounting for VF procedure :: set_scalar !< Subroutine that extrapolates a provided scalar value at a point to a pgrid field @@ -83,6 +85,8 @@ function construct_from_file(grp,decomp,no,fgrid,fgeom) result(self) call geomfile%pullvar('VF',self%VF) ! Perform an extension in the overlap call self%VF_extend() + ! Update fluid_vol + call self%calc_fluid_vol() end block read_VF end function construct_from_file @@ -122,6 +126,7 @@ subroutine config_prep(this) ! Allocate wall geometry - assume all fluid until told otherwise allocate(this%VF(this%imino_:this%imaxo_,this%jmino_:this%jmaxo_,this%kmino_:this%kmaxo_)); this%VF=1.0_WP + this%fluid_vol=this%vol_total end subroutine config_prep @@ -166,6 +171,26 @@ subroutine VF_extend(this) end if end subroutine VF_extend + + !> Calculate the total fluid volume by integrating VF + subroutine calc_fluid_vol(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(config), intent(inout) :: this + integer :: i,j,k,ierr + real(WP) :: buf + buf=0.0_WP + do k=this%kmin_,this%kmax_ + do j=this%jmin_,this%jmax_ + do i=this%imin_,this%imax_ + buf=buf+this%vol(i,j,k)*this%VF(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(buf,this%fluid_vol,1,MPI_REAL_WP,MPI_SUM,this%comm,ierr) + end subroutine calc_fluid_vol + !> Calculate the integral of a field on the config while accounting for VF subroutine integrate(this,A,integral) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index 3e86bf5c3..8831ca27a 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -259,7 +259,7 @@ subroutine init_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do @@ -1541,7 +1541,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl @@ -1724,28 +1724,14 @@ end subroutine correct_mfr !> Shift pressure to ensure zero average subroutine shift_p(this,pressure) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP implicit none class(incomp), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index 484f033e7..a7a877d17 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -5,7 +5,7 @@ module scalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -59,7 +59,7 @@ module scalar_class real(WP), dimension(:,:,:), allocatable :: SCold !< SCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -74,7 +74,7 @@ module scalar_class real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity ! Bquick requires additional storage - real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup + real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup real(WP), dimension(:,:,:,:), allocatable :: bitp_xm,bitp_ym,bitp_zm !< Minus interpolation for SC - backup ! Masking info for metric modification @@ -91,8 +91,8 @@ module scalar_class procedure :: apply_bcond !< Apply all boundary conditions procedure :: init_metrics !< Initialize metrics procedure :: adjust_metrics !< Adjust metrics - procedure :: metric_reset !< Reset adaptive metrics like bquick - procedure :: metric_adjust !< Adjust adaptive metrics like bquick + procedure :: metric_reset !< Reset adaptive metrics like bquick + procedure :: metric_adjust !< Adjust adaptive metrics like bquick procedure :: get_drhoSCdt !< Calculate drhoSC/dt procedure :: get_max !< Calculate maximum field values procedure :: get_int !< Calculate integral field values @@ -136,13 +136,13 @@ function constructor(cfg,scheme,name) result(self) ! Prepare advection scheme self%scheme=scheme select case (self%scheme) - case (upwind) - ! Check current overlap - if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=1 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (upwind) + ! Check current overlap + if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=1 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (quick) ! Check current overlap if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') @@ -150,20 +150,17 @@ function constructor(cfg,scheme,name) result(self) self%nst=3 self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 - case (bquick) - ! Check current overlap - if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=3 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (bquick) + ! Check current overlap + if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=3 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case default call die('[scalar constructor] Unknown scalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -224,10 +221,10 @@ subroutine init_metrics(this) allocate(this%itp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered ! Create scalar interpolation coefficients to cell faces select case (this%scheme) - case (upwind) - this%itp_xp=1.0_WP; this%itp_xm=1.0_WP - this%itp_yp=1.0_WP; this%itp_ym=1.0_WP - this%itp_zp=1.0_WP; this%itp_zm=1.0_WP + case (upwind) + this%itp_xp=1.0_WP; this%itp_xm=1.0_WP + this%itp_yp=1.0_WP; this%itp_ym=1.0_WP + this%itp_zp=1.0_WP; this%itp_zm=1.0_WP case (quick,bquick) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -382,42 +379,50 @@ end subroutine adjust_metrics !> Finish setting up the scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) + subroutine setup(this,implicit_solver) implicit none class(scalar), intent(inout) :: this - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st ! Adjust metrics based on mask array call this%adjust_metrics() ! Bquick needs to remember the quick coefficients - select case (this%scheme) + select case (this%scheme) case (bquick) - allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp - allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm - allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp - allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym - allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp - allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm + allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp + allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm + allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp + allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym + allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp + allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm end select - - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -705,53 +710,53 @@ subroutine metric_reset(this) this%itp_zm=this%bitp_zm end select end subroutine metric_reset - - + + !> Adjust adaptive metrics like bquick subroutine metric_adjust(this,SC,SCmin,SCmax) - implicit none - class(scalar), intent(inout) :: this + implicit none + class(scalar), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SC !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), optional :: SCmin - real(WP), optional :: SCmax - integer :: i,j,k - select case (this%scheme) - case (bquick) - if (present(SCmin)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).lt.SCmin) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + real(WP), optional :: SCmin + real(WP), optional :: SCmax + integer :: i,j,k + select case (this%scheme) + case (bquick) + if (present(SCmin)) then + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).lt.SCmin) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if + end if + end do + end do + end do + end if if (present(SCmax)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).gt.SCmax) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if - end select + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).gt.SCmax) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if + end do + end do + end do + end if + end select end subroutine metric_adjust - + !> Print out info for scalar solver subroutine scalar_print(this) diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index e033c87f0..9c3a3a305 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -9,10 +9,10 @@ module ensight_class use partmesh_class, only: partmesh implicit none private - + ! Expose type/constructor/methods public :: ensight - + ! List types type :: scl !< Scalar field type(scl), pointer :: next @@ -37,7 +37,7 @@ module ensight_class character(len=str_medium) :: name type(partmesh), pointer :: ptr end type prt - + !> Ensight object definition as list of pointers to arrays type :: ensight ! An ensight object has a name @@ -60,21 +60,19 @@ module ensight_class procedure :: write_part !< Write out particle mesh file generic :: add_scalar=>add_rscalar,add_iscalar !< Add a new scalar field procedure, private :: add_rscalar !< Add a new real(WP) scalar field - procedure, private :: add_iscalar !< Add a new integer scalar field + procedure, private :: add_iscalar !< Add a new integer scalar field procedure :: add_vector !< Add a new vector field procedure :: add_surface !< Add a new surface mesh procedure :: add_particle !< Add a new particle mesh end type ensight - - + !> Declare ensight constructor interface ensight procedure construct_ensight end interface ensight - - + contains - + !> Constructor for an empty ensight object function construct_ensight(cfg,name) result(self) use messager, only: die @@ -87,25 +85,25 @@ function construct_ensight(cfg,name) result(self) character(len=str_medium) :: line integer :: iunit,ierr,stat logical :: file_is_there,found - + ! Link to config self%cfg=>cfg - + ! Store casename self%name=trim(adjustl(name)) - + ! Start with no time stamps self%ntime=0 - + ! Create directory if (self%cfg%amRoot) then call execute_command_line('mkdir -p ensight') call execute_command_line('mkdir -p ensight/'//trim(self%name)) end if - + ! Write out the geometry call self%write_geom(cfg=self%cfg,name='geometry') - + ! Empty pointer to lists for now self%first_scl=>NULL() self%first_vct=>NULL() @@ -144,17 +142,17 @@ function construct_ensight(cfg,name) result(self) close(iunit) end if end if - + ! Communicate to all processors call MPI_BCAST(self%ntime,1,MPI_INTEGER,0,self%cfg%comm,ierr) if (self%ntime.gt.0) then if (.not.self%cfg%amRoot) allocate(self%time(self%ntime)) call MPI_BCAST(self%time,self%ntime,MPI_REAL_WP,0,self%cfg%comm,ierr) end if - + end function construct_ensight - - + + !> Add a real scalar field for output subroutine add_rscalar(this,name,scalar) implicit none @@ -174,8 +172,8 @@ subroutine add_rscalar(this,name,scalar) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_scl%name)) end subroutine add_rscalar - - + + !> Add an integer scalar field for output subroutine add_iscalar(this,name,scalar) implicit none @@ -195,8 +193,8 @@ subroutine add_iscalar(this,name,scalar) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_scl%name)) end subroutine add_iscalar - - + + !> Add a vector field for output subroutine add_vector(this,name,vectx,vecty,vectz) implicit none @@ -219,8 +217,8 @@ subroutine add_vector(this,name,vectx,vecty,vectz) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_vct%name)) end subroutine add_vector - - + + !> Add a surface mesh for output subroutine add_surface(this,name,surface) implicit none @@ -272,6 +270,7 @@ subroutine write_data(this,time) real(WP), intent(in) :: time character(len=str_medium) :: filename integer :: iunit,ierr,n,i + character(len=8) :: ierr_s integer :: ibuff character(len=80) :: cbuff type(MPI_File) :: ifile @@ -317,7 +316,10 @@ subroutine write_data(this,time) if (this%cfg%amRoot) then ! Open the file open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[ensight write data] Could not open file '//trim(filename)) + if (ierr.ne.0) then + write(ierr_s, "(I4)") ierr + call die('[ensight write data] Could not open file '//trim(filename)//'(error '//ierr_s//')') + end if ! Write the header cbuff=trim(my_scl%name); write(iunit) cbuff cbuff='part' ; write(iunit) cbuff diff --git a/src/grid/iterator_class.f90 b/src/grid/iterator_class.f90 index 988c2ddf8..90a319ddb 100644 --- a/src/grid/iterator_class.f90 +++ b/src/grid/iterator_class.f90 @@ -10,7 +10,7 @@ module iterator_class private ! Expose type/constructor/methods - public :: iterator + public :: iterator, locator_gen_ftype !> itr object definition type :: iterator @@ -32,7 +32,15 @@ module iterator_class contains procedure :: print=>iterator_print !< Output iterator to the screen end type iterator - + + !> iterator generating function type + interface + logical function locator_gen_ftype(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator_gen_ftype + end interface !> Declare single-grid iterator constructor interface iterator @@ -50,14 +58,7 @@ function construct_from_function(pg,name,locator,face) result(self) type(iterator) :: self class(pgrid), target, intent(in) :: pg character(len=*), intent(in) :: name - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_gen_ftype) :: locator character(len=1), optional :: face integer :: i,j,k,cnt integer :: color,key,ierr diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index f0ba13b90..37bb8008c 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -8,10 +8,6 @@ module pgrid_class implicit none private - !> Default parallelization strategy - character(len=str_medium), parameter :: defstrat='fewest_dir' - integer, parameter :: defmincell=4 - ! Expose type/constructor/methods public :: pgrid @@ -92,7 +88,7 @@ module pgrid_class procedure, private :: pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries for integer procedure, private :: pgrid_rsync,pgrid_rsync_no !< Commmunicate inner and periodic boundaries for real(WP) procedure, private :: pgrid_rsync_array !< Commmunicate inner and periodic boundaries for arrays of real(WP) of the form (:,i,j,k) - procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) + procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) generic :: syncsum=>pgrid_rsyncsum !< Summation across inner and periodic boundaries - generic procedure, private :: pgrid_rsyncsum !< Summation inner and periodic boundaries for real(WP) procedure :: get_rank !< Function that returns rank of processor that contains provided indices diff --git a/src/hyperbolic/Make.package b/src/hyperbolic/Make.package new file mode 100644 index 000000000..379b832aa --- /dev/null +++ b/src/hyperbolic/Make.package @@ -0,0 +1,5 @@ +f90EXE_sources += hyperbolic_general.f90 muscl_class.f90 advection.f90 euler.f90 rusanov_class.f90 +# houssem2d.f90 + +INCLUDE_LOCATIONS += $(NGA_HOME)/src/hyperbolic +VPATH_LOCATIONS += $(NGA_HOME)/src/hyperbolic diff --git a/src/hyperbolic/advection.f90 b/src/hyperbolic/advection.f90 new file mode 100644 index 000000000..59353540e --- /dev/null +++ b/src/hyperbolic/advection.f90 @@ -0,0 +1,211 @@ + +!> contains necessary functions for using the muscl class (or other general hyperbolic +!> solvers) to solve basic advection problems + +!> Originally written by John P Wakefield in December 2022. + +module hyperbolic_advection + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use hyperbolic, only: eigenvals_ftype, rsolver_ftype, limiter_ftype, flux_ftype + use muscl_class, only: muscl + use rusanov_class, only: rusanov + implicit none + + real(WP), parameter :: advec_muscl_cflsafety = 0.99_WP + real(WP), parameter :: advec_muscl_divzero_eps = 1e-12_WP + character(len=str_medium), parameter :: ADVEC_MUSCL_NAME = 'MUSCL_CONST_ADVEC' + character(len=str_medium), parameter :: ADVEC_RUS_NAME = 'RUSANOV_CONST_ADVEC' + +contains + + !> muscl factory + function make_advec_muscl(cfg, N, limiter, velocity) result(solver) + implicit none + type(muscl) :: solver + class(config), target, intent(in) :: cfg + integer, intent(in) :: N + integer(1), intent(in) :: limiter + real(WP), dimension(3), intent(in) :: velocity + character(len=str_medium) :: name_actual + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(rsolver_ftype), pointer :: rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr + integer :: i + + name_actual = ADVEC_MUSCL_NAME + + evals_x_ptr => advec_evals_x; rsolv_x_ptr => advec_rsolv_x; + evals_y_ptr => advec_evals_y; rsolv_y_ptr => advec_rsolv_y; + evals_z_ptr => advec_evals_z; rsolv_z_ptr => advec_rsolv_z; + + ! build solver + solver = muscl(cfg, name_actual, N, 3, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr, limiter, & + & advec_muscl_divzero_eps, advec_muscl_cflsafety) + + ! set velocity + do i = 1, 3 + solver%params(i,:,:,:) = velocity(i) + end do + + ! set velocity mask + solver%vel_mask_x(:) = .false. + solver%vel_mask_y(:) = .false. + solver%vel_mask_z(:) = .false. + + end function make_advec_muscl + + !> rusanov factory + function make_advec_rusanov(cfg, N, velocity) result(solver) + implicit none + type(rusanov) :: solver + class(config), target, intent(in) :: cfg + integer, intent(in) :: N + real(WP), dimension(3), intent(in) :: velocity + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(flux_ftype), pointer :: flux_x_ptr, flux_y_ptr, flux_z_ptr + integer :: i + + evals_x_ptr => advec_evals_x; flux_x_ptr => advec_flux_x; + evals_y_ptr => advec_evals_y; flux_y_ptr => advec_flux_y; + evals_z_ptr => advec_evals_z; flux_z_ptr => advec_flux_z; + + ! build solver + solver = rusanov(cfg, ADVEC_RUS_NAME, N, 3, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, flux_x_ptr, flux_y_ptr, flux_z_ptr) + + ! put velocity in param array + do i = 1, 3 + solver%params(i,:,:,:) = velocity(i) + end do + + ! set velocity mask + solver%vel_mask_x(:) = .false. + solver%vel_mask_y(:) = .false. + solver%vel_mask_z(:) = .false. + + end function make_advec_rusanov + + pure subroutine advec_evals_x(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(1) + + end subroutine advec_evals_x + + pure subroutine advec_evals_y(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(2) + + end subroutine advec_evals_y + + pure subroutine advec_evals_z(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(3) + + end subroutine advec_evals_z + + pure subroutine advec_flux_x(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + + flux(:) = params(1) * U(:) + + end subroutine advec_flux_x + + pure subroutine advec_flux_y(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + + flux(:) = params(2) * U(:) + + end subroutine advec_flux_y + + pure subroutine advec_flux_z(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + + flux(:) = params(3) * U(:) + + end subroutine advec_flux_z + + pure subroutine advec_rsolv_simple(v, Ul, Ur, rs) + real(WP), intent(in) :: v + real(WP), dimension(:), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + integer :: i + + rs(:,:) = 0.0_WP + rs(:,1) = min(v, 0.0_WP) + rs(:,2) = max(v, 0.0_WP) + rs(:,3) = Ur(:) - Ul(:) + + rs(1:size(Ul,1),5:(size(Ul,1)+4)) = 1.0_WP + + end subroutine + + pure subroutine advec_rsolv_x(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(1) + pr(1)), Ul, Ur, rs) + + end subroutine advec_rsolv_x + + pure subroutine advec_rsolv_y(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(2) + pr(2)), Ul, Ur, rs) + + end subroutine advec_rsolv_y + + pure subroutine advec_rsolv_z(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(3) + pr(3)), Ul, Ur, rs) + + end subroutine advec_rsolv_z + +end module hyperbolic_advection + diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 new file mode 100644 index 000000000..7b76caa54 --- /dev/null +++ b/src/hyperbolic/euler.f90 @@ -0,0 +1,416 @@ + +!> contains necessary functions for using the muscl class (or other general +!> hyperbolic solvers) to solve the Euler equations for an ideal (gamma) gas + +!> Originally written by John P Wakefield in December 2022. + +module hyperbolic_euler + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use hyperbolic, only: VANLEER, eigenvals_ftype, rsolver_ftype, limiter_ftype, flux_ftype + use muscl_class, only: muscl + use rusanov_class, only: rusanov + implicit none + + real(WP), parameter :: euler_muscl_cflsafety = 0.92_WP + real(WP), parameter :: euler_muscl_divzero_eps = 1e-9_WP + character(len=str_medium), parameter :: euler_muscl_name = 'MUSCL_EULER' + + real(WP), parameter :: DIATOMIC_GAMMA = 1.4_WP + real(WP), dimension(5), parameter :: SOD_PHYS_L = (/ 1.0_WP, 0.0_WP, & + & 0.0_WP, 0.0_WP, 1.0_WP /) + real(WP), dimension(5), parameter :: SOD_PHYS_R = (/ 0.125_WP, 0.0_WP, & + & 0.0_WP, 0.0_WP, 0.1_WP /) + +contains + + !> muscl factory + function make_euler_muscl(cfg, limiter, gma) result(solver) + implicit none + type(muscl) :: solver + class(config), target, intent(in) :: cfg + integer(1), optional, intent(in) :: limiter + real(WP), optional, intent(in) :: gma + integer(1) :: limiter_actual + real(WP) :: gma_actual + character(len=str_medium) :: name_actual + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(rsolver_ftype), pointer :: rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr + + if (present(limiter)) then + limiter_actual = limiter + else + limiter_actual = VANLEER + end if + + if (present(gma)) then + gma_actual = gma + else + gma_actual = DIATOMIC_GAMMA + end if + + name_actual = euler_muscl_name + + evals_x_ptr => euler_evals_x; rsolv_x_ptr => euler_rsolv_x; + evals_y_ptr => euler_evals_y; rsolv_y_ptr => euler_rsolv_y; + evals_z_ptr => euler_evals_z; rsolv_z_ptr => euler_rsolv_z; + + ! build solver + solver = muscl(cfg, name_actual, 5, 1, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr, limiter_actual, & + & euler_muscl_divzero_eps, euler_muscl_cflsafety) + + ! set param array to hold gamma + solver%params(1,:,:,:) = gma_actual + + ! set velocity mask + solver%vel_mask_x(:) = (/ .false., .true., .false., .false., .false. /) + solver%vel_mask_y(:) = (/ .false., .false., .true., .false., .false. /) + solver%vel_mask_z(:) = (/ .false., .false., .false., .true., .false. /) + + end function make_euler_muscl + + !> rusanov factory + function make_euler_rusanov(cfg, gma) result(solver) + implicit none + type(rusanov) :: solver + class(config), target, intent(in) :: cfg + real(WP), optional, intent(in) :: gma + real(WP) :: gma_actual + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(flux_ftype), pointer :: flux_x_ptr, flux_y_ptr, flux_z_ptr + + if (present(gma)) then + gma_actual = gma + else + gma_actual = DIATOMIC_GAMMA + end if + + evals_x_ptr => euler_evals_x; flux_x_ptr => euler_flux_x; + evals_y_ptr => euler_evals_y; flux_y_ptr => euler_flux_y; + evals_z_ptr => euler_evals_z; flux_z_ptr => euler_flux_z; + + ! build solver + solver = rusanov(cfg, 'EULER_RUSANOV', 5, 1, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, flux_x_ptr, flux_y_ptr, flux_z_ptr) + + ! set param array to hold gamma + solver%params(1,:,:,:) = gma_actual + + ! set velocity mask + solver%vel_mask_x(:) = (/ .false., .true., .false., .false., .false. /) + solver%vel_mask_y(:) = (/ .false., .false., .true., .false., .false. /) + solver%vel_mask_z(:) = (/ .false., .false., .false., .true., .false. /) + + end function make_euler_rusanov + + !> Convert to Physical Coordinates (velocity and pressure to momentum and energy) + pure subroutine euler_tophys(gma, cons, phys) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: cons + real(WP), dimension(5), intent(out) :: phys + real(WP) :: KE + + phys(1) = cons(1) + phys(2) = cons(2) / cons(1) + phys(3) = cons(3) / cons(1) + phys(4) = cons(4) / cons(1) + KE = 0.5_WP * sum(cons(2:4)**2) / cons(1) + phys(5) = (gma - 1.0_WP) * (cons(5) - KE) + + end subroutine + + !> Convert to Conserved Coordinates (velocity and pressure to momentum and energy) + pure subroutine euler_tocons(gma, phys, cons) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: phys + real(WP), dimension(5), intent(out) :: cons + real(WP) :: KE + + cons(1) = phys(1) + cons(2) = phys(1) * phys(2) + cons(3) = phys(1) * phys(3) + cons(4) = phys(1) * phys(4) + KE = 0.5_WP * phys(1) * sum(phys(2:4)**2) + cons(5) = phys(5) / (gma - 1.0_WP) + KE + + end subroutine + + pure subroutine euler_flux_x(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP) :: pressure + + pressure = (params(1) - 1.0_WP) * (U(5) - 0.5_WP * (U(2)**2 + U(3)**2 + & + U(4)**2)/ U(1)) + + flux(1) = U(2) + flux(2) = U(2)**2 / U(1) + pressure + flux(3) = U(2) * U(3) / U(1) + flux(4) = U(2) * U(4) / U(1) + flux(5) = U(2) / U(1) * (U(5) + pressure) + + end subroutine euler_flux_x + + pure subroutine euler_flux_y(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP), dimension(5) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(3); u_permute(3) = u(2); + + call euler_flux_x(P, N, params, u_permute, flux) + + end subroutine euler_flux_y + + pure subroutine euler_flux_z(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP), dimension(N) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(4); u_permute(4) = u(2); + + call euler_flux_x(P, N, params, u_permute, flux) + + end subroutine euler_flux_z + + pure subroutine euler_evals_x(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + + call euler_evals_1d(params(1), U, evals) + + end subroutine euler_evals_x + + pure subroutine euler_evals_y(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + real(WP), dimension(5) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(3); u_permute(3) = u(2); + + call euler_evals_1d(params(1), u_permute, evals) + + end subroutine euler_evals_y + + pure subroutine euler_evals_z(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + real(WP), dimension(N) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(4); u_permute(4) = u(2); + + call euler_evals_1d(params(1), u_permute, evals) + + end subroutine euler_evals_z + + !> eigenvalues + pure subroutine euler_evals_1d(gma, U, lambda) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: U + real(WP), dimension(5), intent(out) :: lambda + real(WP) :: v, p, c, KE + + KE = 0.5_WP * sum(U(2:4)**2) / U(1) + v = U(2) / U(1) + p = (gma - 1) * (U(5) - KE) + c = sqrt(gma * p / U(1)) + + lambda = (/ v - c, v, v, v, v + c /) + + end subroutine euler_evals_1d + + pure subroutine euler_rsolv_x(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Ul, Ur, rs) + + end subroutine euler_rsolv_x + + pure subroutine euler_rsolv_y(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + real(WP), dimension(N) :: Uln, Urn + real(WP), dimension(5) :: rs_row + + Uln(:) = Ul(:); Uln(2) = Ul(3); Uln(3) = Ul(2); + Urn(:) = Ur(:); Urn(2) = Ur(3); Urn(3) = Ur(2); + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Uln, Urn, rs) + + rs_row(:) = rs(2,5:9); rs(2,5:9) = rs(3,5:9); rs(3,5:9) = rs_row(:); + + end subroutine euler_rsolv_y + + pure subroutine euler_rsolv_z(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + real(WP), dimension(N) :: Uln, Urn + real(WP), dimension(5) :: rs_row + + Uln(:) = Ul(:); Uln(2) = Ul(4); Uln(4) = Ul(2); + Urn(:) = Ur(:); Urn(2) = Ur(4); Urn(4) = Ur(2); + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Uln, Urn, rs) + + rs_row(:) = rs(2,5:9); rs(2,5:9) = rs(4,5:9); rs(4,5:9) = rs_row(:); + + end subroutine euler_rsolv_z + + !> Roe Solver + ! see page 354-ish of Toro's book + ! here `Ul' and `Ur' are the whole state, (u, v, w) is the velocity vector + pure subroutine euler_rsolv_roe_1d(gma, Ul, Ur, rs) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: Ul, Ur + real(WP), dimension(5,9), intent(out) :: rs + real(WP) :: rrhol, rrhor, drho, rho, pl, pr, Hl, Hr, u, v, w, H, a, du5b + + ! Roe averages + rrhol = sqrt(Ul(1)); rrhor = sqrt(Ur(1)); + rho = rrhol * rrhor + pl = (gma - 1.0_WP) * (Ul(5) - 0.5_WP * sum(Ul(2:4)**2) / Ul(1)) + pr = (gma - 1.0_WP) * (Ur(5) - 0.5_WP * sum(Ur(2:4)**2) / Ur(1)) + Hl = (Ul(5) + pl) / Ul(1); Hr = (Ur(5) + pr) / Ur(1); + u = (rrhol * Ul(2) / Ul(1) + rrhor * Ur(2) / Ur(1)) / (rrhol + rrhor) + v = (rrhol * Ul(3) / Ul(1) + rrhor * Ur(3) / Ur(1)) / (rrhol + rrhor) + w = (rrhol * Ul(4) / Ul(1) + rrhor * Ur(4) / Ur(1)) / (rrhol + rrhor) + H = (rrhol * Hl + rrhor * Hr) / (rrhol + rrhor) + a = sqrt((gma - 1.0_WP) * (H - 0.5_WP * (u**2 + v**2 + w**2))) + + ! lambdal and lambdar + rs(1,2) = u - a; rs(2:4,2) = u; rs(5,2) = u + a; + rs(:,1) = min(rs(:,2), 0.0_WP) + rs(:,2) = rs(:,2) - rs(:,1) + + ! α2 + drho = Ur(1) - Ul(1) + du5b = Ur(5) - Ul(5) - (Ur(3) - Ul(3) - v * drho) * v - (Ur(4) - Ul(4) - & + & w * drho) * w + rs(2,3) = (gma - 1.0_WP) / a**2 * ( & + & (Ur(1) - Ul(1)) * (H - u**2) + u * (Ur(2) - Ul(2)) - du5b & + & ) + + ! α1 + rs(1,3) = (drho * (u + a) - (Ur(2) - Ul(2)) - a * rs(2,3)) / (2 * a) + + ! α5 + rs(5,3) = drho - rs(1,3) - rs(2,3) + + ! α3 and α4 + rs(3,3) = Ur(3) - Ul(3) - v * drho + rs(4,3) = Ur(4) - Ul(4) - w * drho + + ! βs + rs(:,4) = 0.0_WP + + ! eigenvectors + rs(1,5) = 1.0_WP; rs(2,5) = u - a; rs(3,5) = v; rs(4,5) = w; rs(5,5) = H - u * a; + rs(1,9) = 1.0_WP; rs(2,9) = u + a; rs(3,9) = v; rs(4,9) = w; rs(5,9) = H + u * a; + rs(1,6) = 1.0_WP; rs(2,6) = u; rs(3,6) = v; rs(4,6) = w; rs(5,6) = 0.5_WP * (u**2 + v**2 + w**2); + rs(1,7) = 0.0_WP; rs(2,7) = 0.0_WP; rs(3,7) = 1.0_WP; rs(4,7) = 0.0_WP; rs(5,7) = v; + rs(1,8) = 0.0_WP; rs(2,8) = 0.0_WP; rs(3,8) = 0.0_WP; rs(4,8) = 1.0_WP; rs(5,8) = w; + + end subroutine euler_rsolv_roe_1d + + !! subroutines for Solving Riemann Problems Exactly + + !> From Toro, returns fK and fKprime + pure subroutine euler_fK(gma, rhoK, pK, cK, p, fK, fKprime) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoK, pK, cK, p + real(WP), intent(out) :: fK, fKprime + real(WP) :: AK, BK + + AK = 2 * ((gma + 1) * rhoK)**(-1); BK = (gma - 1) / (gma + 1) * pK; + if (p > pK) then ! shock + fK = (p - pK) * sqrt(AK / (p + BK)) + fKprime = sqrt(AK / (BK + p)) * (1 - (p - pK) / (2 * (BK + p))) + else ! rarefaction + fK = 2 * cK / (gma - 1) * ((p / pK)**((gma - 1) / (2 * gma)) - 1) + fKprime = (rhoK * cK)**(-1) * (p / pK)**(- (gma + 1) / (2 * gma)) + end if + + end subroutine + + !> returns f and fprime + pure subroutine euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, p, f, fprime) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoL, vL, pL, cL, rhoR, vR, pR, cR, p + real(WP), intent(out) :: f, fprime + real(WP) :: fL, fLp, fR, fRp + + call euler_fK(gma, rhoL, pL, cL, p, fL, fLp) + call euler_fK(gma, rhoR, pR, cR, p, fR, fRp) + + f = fL + fR + vR - vL + fprime = fLp + fRp + + end subroutine + + !> returns pressure and velocity (in that order) of the mid state + pure subroutine euler_findmid(gma, rhoL, vL, pL, rhoR, vR, pR, delta, maxiters, pM, vM) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoL, vL, pL, rhoR, vR, pR, delta + integer, intent(in) :: maxiters + real(WP), intent(out) :: pM, vM + real(WP) :: z, f, fp, cL, cR, fL, fLp, fR, fRp + integer(WP) :: n + + cL = sqrt(gma * pL / rhoL); cR = sqrt(gma * pR / rhoR); + + ! start with two rarefaction solution + z = (gma - 1) / (2 * gma) + pM = ((cL + cR - 0.5_WP * (gma - 1) * (vR - vL)) / (cL / pL**z + cR / & + & pR**z))**(z**(-1)) + + ! do rootfinding + call euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, pM, f, fp) + n = 0 + do while (abs(f) < delta .and. n < maxiters) + pM = pM - f / fp + call euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, pM, f, fp) + n = n + 1 + end do + + call euler_fK(gma, rhoL, pL, cL, pM, fL, fLp) + call euler_fK(gma, rhoR, pR, cR, pM, fR, fRp) + vM = 0.5_WP * (vL + vR + fR - fL) + + end subroutine + +end module hyperbolic_euler + diff --git a/src/hyperbolic/hyperbolic_general.f90 b/src/hyperbolic/hyperbolic_general.f90 new file mode 100644 index 000000000..da784a3de --- /dev/null +++ b/src/hyperbolic/hyperbolic_general.f90 @@ -0,0 +1,147 @@ + +!> module containing definitions relevant to a wide range of hyperbolic +!> solvers, e.g. function type definitions and limiter definitions + +!> Originally written by John P Wakefield in Feb 2023. + +module hyperbolic + use precision, only: WP + implicit none + public + + !> limiter names + integer(1), parameter, public :: UPWIND = 0_1 + integer(1), parameter, public :: LAXWEND = 1_1 + integer(1), parameter, public :: BEAMWARM = 2_1 + integer(1), parameter, public :: FROMM = 3_1 + integer(1), parameter, public :: MINMOD = 4_1 + integer(1), parameter, public :: SUPERBEE = 5_1 + integer(1), parameter, public :: MC = 6_1 + integer(1), parameter, public :: VANLEER = 7_1 + + !> function types + interface + + pure subroutine eigenvals_ftype(P, N, params, u, evals) + use precision, only: WP + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + end subroutine + + pure subroutine rsolver_ftype(P, N, pl, ul, pr, ur, rs) + use precision, only: WP + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: ul, ur + real(WP), dimension(:,:), intent(out) :: rs + end subroutine + + pure subroutine flux_ftype(P, N, params, u, f) + use precision, only: WP + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: f + end subroutine + + pure function limiter_ftype(r) result(phi) + use precision, only: WP + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + end function + + end interface + +contains + + !! limiter lookup function + function get_limiter(i) result(lim) + use messager, only: die + implicit none + integer(1), intent(in) :: i + procedure(limiter_ftype), pointer :: lim + + lim => NULL() + + select case (i) + case (UPWIND) + lim => limiter_upwind + case (LAXWEND) + lim => limiter_laxwend + case (BEAMWARM) + lim => limiter_beamwarm + case (FROMM) + lim => limiter_fromm + case (MINMOD) + lim => limiter_minmod + case (SUPERBEE) + lim => limiter_superbee + case (MC) + lim => limiter_mc + case (VANLEER) + lim => limiter_vanleer + case default + call die("could not find limiter") + end select + + end function get_limiter + + !! limiter definitions + pure function limiter_upwind(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + phi = 0.0 + end function + pure function limiter_laxwend(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + phi = 1.0 + end function + pure function limiter_beamwarm(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + end function + pure function limiter_fromm(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = 0.5_WP * (r + 1.0_WP) + end function + pure function limiter_minmod(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min(1.0_WP, r)) + end function + pure function limiter_superbee(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min(1.0_WP, 2.0_WP * r), min(2.0_WP, r)) + end function + pure function limiter_mc(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min((1.0_WP + r) / 2.0_WP, 2.0_WP, 2.0_WP * r)) + end function + pure function limiter_vanleer(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = (r + abs(r)) / (1.0_WP + abs(r)) + end function + +end module hyperbolic + diff --git a/src/hyperbolic/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 new file mode 100644 index 000000000..7797c235a --- /dev/null +++ b/src/hyperbolic/muscl_class.f90 @@ -0,0 +1,932 @@ +!> MUSCL-type solver class +!> Provides support for various BC, generic hyperbolic structures +!> +!> Originally written by John P Wakefield in December 2022. +!> +!> When possible, helper functions immediately follow the class function that +!> calls them. +!> +module muscl_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use iterator_class, only: iterator + use hyperbolic, only: limiter_ftype, eigenvals_ftype, rsolver_ftype, get_limiter + implicit none + private + + ! expose type/constructor/methods + public :: muscl, muscl_bc + + ! List of known available bcond types for this solver + ! here 'right' means bcond direction +1 + ! bits 1 and 2 - 00 nothing, 10 interpolate, 11 reflect + ! bits 3 and 4 - 00 nothing, 01 zero normal velocity + ! bit 5 - right moving waves, 0 leave, 1 zero + ! bit 6 - left moving waves, 0 leave, 1 zero + integer(1), parameter, public :: WALL_REFLECT = 7_1 !< reflecting wall + integer(1), parameter, public :: WALL_ABSORB = 39_1 !< absorbing wall + integer(1), parameter, public :: NO_WAVES = 34_1 !< outflow/free condition condition + + ! riemann solutions for an N dimensional system are stored in N by N+4 + ! dimensional arrays, in which + ! rs(:, 1) left-going eigenvalues + ! rs(:, 2) right-going eigenvalues + ! rs(:, 3) wave strengths + ! rs(:, 4) (projected) source strengths (only a good idea in 1d; commented below) + ! rs(:, 5:(N+4)) (linearized) eigenvectors + + !> boundary conditions for the hyperbolic solver + type :: muscl_bc + type(muscl_bc), pointer :: next !< linked list of bconds + character(len=str_medium) :: name = 'UNNAMED_BC' !< bcond name (default UNNAMED_BCOND) + integer(1) :: type !< bcond type + type(iterator) :: itr !< this is the iterator for the bcond + integer(1) :: dir !< bcond direction 0-6 + end type muscl_bc + + !> solver object definition + type :: muscl + + ! config / pgrid object + class(config), pointer :: cfg !< config / pgrid information + + ! name + character(len=str_medium) :: name = 'MUSCL' !< solver name + + ! system information + integer :: N !< system dimension + integer :: P !< number of parameters + procedure(eigenvals_ftype), pointer, nopass :: evals_x, evals_y, evals_z + procedure(rsolver_ftype), pointer, nopass :: rsolv_x, rsolv_y, rsolv_z + logical, dimension(:), allocatable :: vel_mask_x, vel_mask_y, vel_mask_z + + ! limiting + procedure(limiter_ftype), pointer, nopass :: limiter!< limiter function + real(WP) :: upratio_divzero_eps !< softening epsilon for upwind ratio + + ! boundary condition list + integer :: nbc !< number of bcond for our solver + type(muscl_bc), pointer :: first_bc !< list of bcond for our solver + + ! flow variables, parameter arrays + real(WP), dimension(:,:,:,:), pointer :: Uc, dU !< state variables + real(WP), dimension(:,:,:,:), pointer :: params !< params for evals/rsolver + + !TODO get this working + ! transsonic flags + !integer(1), dimension(:,:,:), allocatable :: trans !< bitwise entropy violation check xyz + !integer :: trans_total + !logical :: have_trans_flags + + ! wave bcs + ! first 6 bits used, same convention as type, xxyyzz + integer(1), dimension(:,:,:), allocatable :: wavebcs + + ! CFL numbers + real(WP) :: CFL_x, CFL_y, CFL_z !< global CFL numbers (over dt) + real(WP) :: CFL_safety !< CFL modifier when using cached value + logical :: have_CFL_x_estim, have_CFL_y_estim, have_CFL_z_estim + logical :: have_CFL_x_exact, have_CFL_y_exact, have_CFL_z_exact + + ! monitoring quantities + real(WP), dimension(:), pointer :: Umin, Umax !< state variable range + real(WP), dimension(:), pointer :: Uint !< integral of state vars over domain + logical :: have_Urange + + contains + + ! standard interface + procedure :: print => muscl_print !< output solver to the screen + procedure :: add_bcond !< add a boundary condition + procedure :: get_bcond !< get a boundary condition + procedure :: apply_bcond !< apply all boundary conditions + procedure :: get_cfl !< get maximum CFL + procedure :: get_range !< calculate min/max field values + procedure :: get_min => get_range !< compatibility + procedure :: get_max => get_range !< compatibility + !procedure :: get_mfr !< mfr at ea bcond in last step + procedure :: calc_dU_x, calc_dU_y, calc_dU_z !< take step + + ! muscl specific + !TODO get this working + !procedure :: check_transonic !< check for transonic waves + procedure :: recalc_cfl !< calculate maximum CFL + + end type muscl + + !> declare constructors + interface muscl; procedure constructor; end interface + +contains + + !! standard interface class functions + + !> default constructor for MUSCL-type flow solver + function constructor(cfg, name, N, P, evals_x, evals_y, evals_z, rsolv_x, & + & rsolv_y, rsolv_z, lim, upratio_divzero_eps, CFL_safety) result(this) + use messager, only: die + implicit none + type(muscl) :: this + class(config), target, intent(in) :: cfg + character(len=*), intent(in), optional :: name + integer, intent(in) :: N, P + procedure(eigenvals_ftype), pointer, intent(in) :: evals_x, evals_y, evals_z + procedure(rsolver_ftype), pointer, intent(in) :: rsolv_x, rsolv_y, rsolv_z + integer(1), intent(in) :: lim + real(WP), intent(in) :: upratio_divzero_eps, CFL_safety + integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo, minmino, maxmaxo + + ! check number of ghost cells + if (cfg%no .lt. 2) call die("must have at least two ghost cells") + + ! point to pgrid object + this%cfg => cfg + + ! set the name for the solver + if (present(name)) this%name = trim(adjustl(name)) + + ! system information + this%N = N; this%P = P; + this%evals_x => evals_x; this%evals_y => evals_y; this%evals_z => evals_z; + this%rsolv_x => rsolv_x; this%rsolv_y => rsolv_y; this%rsolv_z => rsolv_z; + + ! limiting + this%limiter => get_limiter(lim) + this%upratio_divzero_eps = upratio_divzero_eps + + ! initialize boundary condition list + this%nbc = 0; this%first_bc => NULL(); + + ! get array sizes + imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; + jmino = this%cfg%jmino_; jmaxo = this%cfg%jmaxo_; + kmino = this%cfg%kmino_; kmaxo = this%cfg%kmaxo_; + minmino = min(imino, jmino, kmino); maxmaxo = max(imaxo, jmaxo, kmaxo) + + ! allocate flow variables and parameter arrays + allocate(this%params(P,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%Uc(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%dU(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + + ! allocate transsonic flags, initialize values + !allocate(this%trans(imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + !this%have_trans_flags = .false. + + ! allocate velocity masks + allocate(this%vel_mask_x(N), this%vel_mask_y(N), this%vel_mask_z(N)) + + ! wave bcs flags + allocate(this%wavebcs(imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + this%wavebcs(:,:,:) = 0_1 + + ! initialize CFL computations + this%CFL_safety = CFL_safety + this%have_CFL_x_estim = .false.; this%have_CFL_x_exact = .false.; + this%have_CFL_y_estim = .false.; this%have_CFL_y_exact = .false.; + this%have_CFL_z_estim = .false.; this%have_CFL_z_exact = .false.; + + ! initialize monitoring + allocate(this%Umin(N), this%Umax(N), this%Uint(N)) + this%have_Urange = .false. + + end function + + !> solver print function + subroutine muscl_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(muscl), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("MUSCL-type solver [",a,"] for config [",a,"]")') & + & trim(this%name), trim(this%cfg%name) + end if + + end subroutine + + !> Add a boundary condition + subroutine add_bcond(this, name, type, locator, dir) + use iterator_class, only: locator_gen_ftype + use string, only: lowercase + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + character(len=*), intent(in) :: name + integer(1), intent(in) :: type + procedure(locator_gen_ftype) :: locator + character(len=2), intent(in) :: dir + type(muscl_bc), pointer :: new_bc + integer :: i, j, k, n + integer(1) :: wbc + + ! prepare new bcond + allocate(new_bc) + new_bc%name = trim(adjustl(name)) + new_bc%type = type + new_bc%itr = iterator(pg=this%cfg, name=new_bc%name, locator=locator) + select case (lowercase(dir)) + case ('c'); new_bc%dir = 0_1 + case ('-x', 'x-', 'xl'); new_bc%dir = 2_1 + case ('+x', 'x+', 'xr'); new_bc%dir = 1_1 + case ('-y', 'y-', 'yl'); new_bc%dir = 4_1 + case ('+y', 'y+', 'yr'); new_bc%dir = 3_1 + case ('-z', 'z-', 'zl'); new_bc%dir = 6_1 + case ('+z', 'z+', 'zr'); new_bc%dir = 5_1 + case default; call die('[MUSCL add_bcond] unknown bcond direction') + end select + + ! insert it in front + new_bc%next => this%first_bc + this%first_bc => new_bc + this%nbc = this%nbc + 1 + + ! update wave zeroing array + wbc = ishft(iand(type, 96_1), -4_1) + if (mod(new_bc%dir, 2_1) .eq. 0_1 .and. new_bc%dir .ne. 0_1) then + select case (wbc) + case (0_1); wbc = 0_1 + case (1_1); wbc = 2_1 + case (2_1); wbc = 1_1 + case default; call die("assertion error") + end select + end if + wbc = ishft(wbc, 2 * ((new_bc%dir - 1_1) / 2_1)) + do n = 1, new_bc%itr%n_ + i = new_bc%itr%map(1,n) + j = new_bc%itr%map(2,n) + k = new_bc%itr%map(3,n) + this%wavebcs(i,j,k) = this%wavebcs(i,j,k) + wbc + end do + + end subroutine add_bcond + + !> get a boundary condition + subroutine get_bcond(this, name, my_bc) + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + character(len=*), intent(in) :: name + type(muscl_bc), pointer, intent(out) :: my_bc + + my_bc => this%first_bc + do while (associated(my_bc)) + if (trim(my_bc%name) .eq. trim(name)) return + my_bc => my_bc%next + end do + + call die('[muscl get_bcond] Boundary condition was not found') + + end subroutine get_bcond + + !> enforce boundary condition + !> note that this interpolates (ensuring ghost cells have the right value), + !> but all wave-related constraints are imposed during the step + subroutine apply_bcond(this, t, dt) + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: t, dt + integer(1) :: masked_type + logical, dimension(this%N) :: vel_mask + integer :: i, j, k, m, n, iref, jref, kref + type(muscl_bc), pointer :: my_bc + + ! Traverse bcond list + my_bc => this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + masked_type = iand(my_bc%type, 3_1) + select case (masked_type) + case (0_1) !< do nothing + case (2_1) !< interpolate + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + this%Uc(:,i,j,k) = this%Uc(:,iref,jref,kref) + end do + case (3_1) !< reflect + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + if (i .ne. iref) then + if (i .lt. iref) then + iref = i + 2 * (iref - i) - 1 + else + iref = i - 2 * (i - iref) + 1 + end if + vel_mask(:) = this%vel_mask_x(:) + end if + if (j .ne. jref) then + if (j .lt. jref) then + jref = j + 2 * (jref - j) - 1 + else + jref = j - 2 * (j - jref) + 1 + end if + vel_mask(:) = this%vel_mask_y(:) + end if + if (k .ne. kref) then + if (k .lt. kref) then + kref = k + 2 * (kref - k) - 1 + else + kref = k - 2 * (k - kref) + 1 + end if + vel_mask(:) = this%vel_mask_z(:) + end if + do n = 1, this%N + if (vel_mask(n)) then + this%Uc(n,i,j,k) = - this%Uc(n,iref,jref,kref) + else + this%Uc(n,i,j,k) = + this%Uc(n,iref,jref,kref) + end if + end do + end do + case (1_1) + call die('[muscl apply_bcond] Unknown bcond type') + case default + call die('[muscl apply_bcond] Unknown bcond type') + end select + + ! zero normal velocity? + masked_type = iand(my_bc%type, 4_1) + if (masked_type .eq. 4_1) then + select case (my_bc%dir) + case (0_1) + vel_mask(:) = this%vel_mask_x(:) .and. this%vel_mask_y(:) .and. & + & this%vel_mask_z(:) + case (1_1, 2_1) + vel_mask(:) = this%vel_mask_x(:) + case (3_1, 4_1) + vel_mask(:) = this%vel_mask_y(:) + case (5_1, 6_1) + vel_mask(:) = this%vel_mask_z(:) + end select + do m = 1, my_bc%itr%n_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + do n = 1, this%N + if (vel_mask(n)) this%Uc(n,i,j,k) = 0.0_WP + end do + end do + end if + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%Uc) + call this%cfg%sync(this%dU) + + ! Move on to the next bcond + my_bc => my_bc%next + + end do + + end subroutine apply_bcond + + !> get CFL number + subroutine get_cfl(this, dt, cfl) + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + logical :: have_CFL_estim, have_CFL_exact + + have_CFL_estim = this%have_CFL_x_estim .and. this%have_CFL_y_estim .and. & + & this%have_CFL_z_estim + + have_CFL_exact = this%have_CFL_x_exact .and. this%have_CFL_y_exact .and. & + this%have_CFL_z_exact + + if (.not. have_CFL_estim) call this%recalc_cfl() + + cfl = dt * max(this%CFL_x, this%CFL_y, this%CFL_z) + + if (.not. have_CFL_exact) cfl = this%CFL_safety * cfl + + end subroutine get_cfl + + !> get min/max field values + subroutine get_range(this) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MIN, MPI_MAX, MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), dimension(this%N) :: task_Umin, task_Umax, task_Uint + integer :: i, j, k, ierr + + if (.not. this%have_Urange) then + + task_Umin(:) = + huge(1.0_WP) + task_Umax(:) = - huge(1.0_WP) + task_Uint(:) = 0.0_WP + + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + task_Umin = min(task_Umin, this%Uc(:,i,j,k)) + task_Umax = max(task_Umax, this%Uc(:,i,j,k)) + task_Uint = task_Uint + this%Uc(:,i,j,k) * this%cfg%dx(i) * & + & this%cfg%dy(j) * this%cfg%dz(k) + end do + end do + end do + + call MPI_ALLREDUCE(task_Umin, this%Umin, this%N, MPI_REAL_WP, MPI_MIN, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umin") + call MPI_ALLREDUCE(task_Umax, this%Umax, this%N, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umax") + call MPI_ALLREDUCE(task_Uint, this%Uint, this%N, MPI_REAL_WP, MPI_SUM, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Uint") + + this%have_Urange = .true. + + end if + + end subroutine get_range + + !> compute dU in x direction + subroutine calc_dU_x(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, ierr + integer(1), dimension(:), allocatable :: bc1d + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; M = size(this%Uc, 2); cfl = 0.0_WP; + + allocate(bc1d(this%cfg%imino_:this%cfg%imaxo_)) + + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + bc1d(:) = this%wavebcs(:,j,k) + do i = this%cfg%imino_, this%cfg%imaxo_ + bc1d(i) = iand(this%wavebcs(i,j,k), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_x, this%cfg%dx, bc1d, dt, & + & this%params(:,:,j,k), this%Uc(:,:,j,k), this%dU(:,:,j,k), cfl) + end do + end do + + deallocate(bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_x, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_x_estim = .true.; this%have_CFL_x_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_x + + !> compute dU in y direction + subroutine calc_dU_y(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, jmino_, jmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + if (this%cfg%ny .lt. 2) return + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; cfl = 0.0_WP; + jmino_ = this%cfg%jmino_; jmaxo_ = this%cfg%jmaxo_; + + allocate(U1d(N,jmino_:jmaxo_), p1d(P,jmino_:jmaxo_)) + allocate(dU1d(N,jmino_:jmaxo_), bc1d(jmino_:jmaxo_)) + + M = size(U1d, 2); + do k = this%cfg%kmin_, this%cfg%kmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d = this%Uc(:,i,jmino_:jmaxo_,k) + dU1d = this%dU(:,i,jmino_:jmaxo_,k) + p1d = this%params(:,i,jmino_:jmaxo_,k) + do j = jmino_, jmaxo_ + bc1d(j) = iand(ishft(this%wavebcs(i,j,k), -2), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_y, this%cfg%dy, bc1d, dt, p1d, U1d, dU1d, cfl) + this%dU(:,i,jmino_:jmaxo_,k) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d, bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_y, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_y_estim = .true.; this%have_CFL_y_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_y + + !> compute dU in z direction + subroutine calc_dU_z(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, kmino_, kmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + if (this%cfg%nz .lt. 2) return + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; cfl = 0.0_WP; + kmino_ = this%cfg%kmino_; kmaxo_ = this%cfg%kmaxo_; + + allocate(U1d(N,kmino_:kmaxo_), p1d(P,kmino_:kmaxo_)) + allocate(dU1d(N,kmino_:kmaxo_), bc1d(kmino_:kmaxo_)) + + M = size(U1d, 2); + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d = this%Uc(:,i,j,kmino_:kmaxo_) + dU1d = this%dU(:,i,j,kmino_:kmaxo_) + p1d = this%params(:,i,j,kmino_:kmaxo_) + bc1d = this%wavebcs(i,j,kmino_:kmaxo_) + do k = kmino_, kmaxo_ + bc1d(k) = iand(ishft(this%wavebcs(i,j,k), -4), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_z, this%cfg%dz, bc1d, dt, p1d, U1d, dU1d, cfl) + this%dU(:,i,j,kmino_:kmaxo_) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d, bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_z, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_z_estim = .true.; this%have_CFL_z_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_z + + ! requires two ghost cells even if using the `upwind' limiter + ! left as an independent function, but called is by class + pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & + & params, U, dU, CFLmax) + implicit none + integer, intent(in) :: N, P, M + procedure(limiter_ftype), pointer, intent(in) :: limfun + real(WP), intent(in) :: eps + procedure(rsolver_ftype), pointer, intent(in) :: rsolver + real(WP), dimension(M), intent(in) :: dxs ! size M + integer(1), dimension(:), intent(in) :: wbcs ! size MI + real(WP), intent(in) :: dt + real(WP), dimension(P,M), intent(in) :: params ! size (P, M) + real(WP), dimension(N,M), intent(in) :: U ! size (N, M) + real(WP), dimension(N,M), intent(inout) :: dU ! size (N, M) + real(WP), intent(inout) :: CFLmax + real(WP), dimension(N,N+4) :: ll, lc, rc, rr ! size (N, N+4) + real(WP), dimension(N) :: phil, phir + integer :: j + + call rsolver(P, N, params(:,1), U(:,1), params(:,2), U(:,2), ll) + call rsolver(P, N, params(:,2), U(:,2), params(:,3), U(:,3), lc) + call rsolver(P, N, params(:,3), U(:,3), params(:,4), U(:,4), rc) + + call handle_wavebc(wbcs(1), ll) + call handle_wavebc(wbcs(2), lc) + call handle_wavebc(wbcs(3), rc) + + CFLmax = max(CFLmax, maxval(abs(ll(:,1:2))) / min(dxs(1), dxs(2))) + CFLmax = max(CFLmax, maxval(abs(lc(:,1:2))) / min(dxs(2), dxs(3))) + CFLmax = max(CFLmax, maxval(abs(rc(:,1:2))) / min(dxs(3), dxs(4))) + + call compute_limval(N, limfun, eps, ll, lc, rc, phil) + + do j = 3, M-2 + call rsolver(P, N, params(:,j+1), U(:,j+1), params(:,j+2), U(:,j+2), rr) + call handle_wavebc(wbcs(j+1), rr) + call compute_limval(N, limfun, eps, lc, rc, rr, phir) + CFLmax = max(CFLmax, maxval(abs(rr(:,1:2))) / min(dxs(j+1), dxs(j+2))) + call wavestep_firstorder_single(N, dxs(j), dt, lc, rc, dU(:,j)) + call wavestep_limitedcorrection_single(N, dxs(j), dt, lc, rc, & + & phil, phir, dU(:, j)) + ll(:, :) = lc(:, :) + lc(:, :) = rc(:, :) + rc(:, :) = rr(:, :) + phil = phir + end do + + end subroutine wavestep_1d + + pure subroutine handle_wavebc(bc, rs) + implicit none + integer(1), intent(in) :: bc + real(WP), dimension(:,:), intent(inout) :: rs + integer :: N + + N = size(rs, 1) + + ! zero negative waves? + if (iand(bc, 1_1) .eq. 1_1) rs(:, 3:4) = max(rs(:, 3:4), 0.0_WP) + + ! zero positive waves? + if (iand(bc, 2_1) .eq. 2_1) rs(:, 3:4) = min(rs(:, 3:4), 0.0_WP) + + end subroutine handle_wavebc + + ! this is called by the class, but is left as an independent function + pure subroutine compute_limval(N, limfun, eps, l_rs, c_rs, r_rs, limvals) + implicit none + procedure(limiter_ftype), pointer, intent(in) :: limfun + real(WP), intent(in) :: eps + integer, intent(in) :: N + real(WP), dimension(:,:), intent(in) :: l_rs, c_rs, r_rs + real(WP), dimension(:), intent(out) :: limvals + real(WP) :: r + integer :: p + + do p = 1,N + !TODO replace this with eigenvector projections + r = c_rs(p, 1) + c_rs(p, 2) + if (r .gt. 0.0_WP) then + r = l_rs(p, 3) * c_rs(p, 3) / (c_rs(p, 3) * c_rs(p, 3) + eps) + else + r = r_rs(p, 3) * c_rs(p, 3) / (c_rs(p, 3) * c_rs(p, 3) + eps) + end if + limvals(p) = limfun(r) + end do + + end subroutine compute_limval + + ! standard Roe/MUSCL/Leveque style wave step with limiters + ! the step has been split up to improve performance + ! this function has been made painful to look at in the interest of speed in + ! the julia implementation, then it stayed that way because I didn't want to + ! rewrite it + ! this is called by the class, but is left as an independent function + pure subroutine wavestep_firstorder_single(N, dx, k, lc_rs, rc_rs, dU) + implicit none + integer, intent(in) :: N + real(WP), intent(in) :: dx, k + real(WP), dimension(N,N+4), intent(in) :: lc_rs, rc_rs + real(WP), dimension(N), intent(inout) :: dU + real(WP), dimension(N) :: tmp1, tmp2 + + ! waves from left + tmp1 = lc_rs(:, 2) * lc_rs(:, 3) + !l_dxbeta : block + ! integer :: j + ! tmp2 = lc_rs(:, 1) + lc_rs(:, 2) + ! ! this probably isn't necessary for anything physical + ! do j = 1, N + ! if (tmp2(j) .eq. 0.0_WP) then + ! tmp2(j) = 0.5_WP + ! else if (tmp2(j) .gt. 0.0_WP) then + ! tmp2(j) = 1.0_WP + ! else + ! tmp2(j) = 0.0_WP + ! end if + ! end do + ! tmp2 = tmp2 * lc_rs(:, 4) + ! tmp2 = dx * tmp2 + !end block l_dxbeta + !tmp1 = tmp1 - tmp2 + tmp2 = matmul(lc_rs(:, 5:(N+4)), tmp1) + tmp2 = k / dx * tmp2 + dU = dU - tmp2 + + ! waves from right + tmp1 = rc_rs(:, 1) * rc_rs(:, 3) + !r_dxbeta : block + ! integer :: j + ! tmp2 = rc_rs(:, 1) + rc_rs(:, 2) + ! do j = 1, N + ! if (tmp2(j) .eq. 0.0_WP) then + ! tmp2(j) = 0.5_WP + ! else if (tmp2(j) .lt. 0.0_WP) then + ! tmp2(j) = 1.0_WP + ! else + ! tmp2(j) = 0.0_WP + ! end if + ! end do + ! tmp2 = tmp2 * rc_rs(:, 4) + ! tmp2 = dx * tmp2 + !end block r_dxbeta + !tmp1 = tmp1 - tmp2 + tmp2 = matmul(rc_rs(:, 5:(N+4)), tmp1) + tmp2 = k / dx * tmp2 + dU = dU - tmp2 + + end subroutine wavestep_firstorder_single + + ! this is called by the class, but is left as an independent function + pure subroutine wavestep_limitedcorrection_single(N, dx, k, lc_rs, & + & rc_rs, phil, phir, dU) + implicit none + integer, intent(in) :: N + real(WP), intent(in) :: dx, k + real(WP), dimension(:,:), intent(in) :: lc_rs, rc_rs + real(WP), dimension(:), intent(in) :: phil, phir + real(WP), dimension(:), intent(inout) :: dU + real(WP), dimension(N) :: tmp1, tmp2 + + tmp1 = (1.0_WP - k / dx * (rc_rs(:,2) - rc_rs(:,1))) + tmp1 = tmp1 * (rc_rs(:,2) - rc_rs(:,1)) * rc_rs(:, 3) * phir(:) + tmp2 = matmul(rc_rs(:, 5:(N+4)), tmp1) + tmp2 = - 0.5_WP * k / dx * tmp2 + dU = dU + tmp2 + + tmp1 = (1.0_WP - k / dx * (lc_rs(:,2) - lc_rs(:,1))) + tmp1 = tmp1 * (lc_rs(:,2) - lc_rs(:,1)) * lc_rs(:, 3) * phil(:) + tmp2 = matmul(lc_rs(:, 5:(N+4)), tmp1) + tmp2 = 0.5_WP * k / dx * tmp2 + dU = dU + tmp2 + + end subroutine + + !! muscl-specific class functions + + !> check for transsonic rarefaction waves + !TODO +! pure subroutine check_transonic(this) +! implicit none +! class(muscl), intent(inout) :: this +! real(WP) :: dim_CFL +! real(WP), dimension(N) :: evals_l, evals_r +! integer :: imin, imax, jmin, jmax, kmin, kmax +! integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo + +! this%trans_flags(:,:,:) = 0 +! this%trans_total = 0 + +! imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; +! jmino = this%cfg%jmino_; jmaxo = this%cfg%jmaxo_; +! kmino = this%cfg%kmino_; kmaxo = this%cfg%kmaxo_; +! imin = this%cfg%imin_; imax = this%cfg%imax_; +! jmin = this%cfg%jmin_; jmax = this%cfg%jmax_; +! kmin = this%cfg%kmin_; kmax = this%cfg%kmax_; + +! dim_CFL = 0.0_WP +! do k=this%cfg%kmin_,this%cfg%kmax_ +! do j=this%cfg%jmin_,this%cfg%jmax_ +! call check_transsonic_1d(this%evals_x, 1, this%params(:,imino:imaxo,j,k), & +! &this%Uc(:,imino:imaxo,j,k), flags(imino:imaxo-1,j,k), this%trans_total, & +! &dim_CFL) +! end do +! end do + +! this%loc_CFL_x = dim_CFL + +! dim_CFL = 0.0_WP +! do k = this%cfg%kmin_, this%cfg%kmax_ +! do i = this%cfg%imin_, this%cfg%imax_ +! this%Ucache1(:,jmino:jmaxo) = this%Uc(:,i,jmino:jmaxo,:) +! this%pcache(:,jmino:jmaxo) = this%params(:,i,jmino:jmaxo,:) +! this%tcache(:) = 0 +! call check_transsonic_1d(this%evals_y, 2, this%pcache(:,jmino:jmaxo), & +! &this%Ucache1(:,jmino:jmaxo), this%tcache(jmino:jmaxo-1), & +! &this%trans_total, dim_CFL) +! flags(i,jmin:jmax-1) = flags(i,jmin:jmax-1) + this%tcache(jmin:jmax-1) +! end do +! end do + +! this%loc_CFL_y = dim_CFL + +! dim_CFL = 0.0_WP +! do j = this%cfg%jmin_, this%cfg%jmax_ +! do i = this%cfg%imin_, this%cfg%imax_ +! this%Ucache1(:,kmino:kmaxo) = this%Uc(:,i,:,kmino:kmaxo) +! this%pcache(:,kmino:kmaxo) = this%params(:,i,:,kmino:kmaxo) +! this%tcache(:) = 0 +! call check_transsonic_1d(this%evals_z, 4, this%pcache(:,kmino:kmaxo), & +! &this%Ucache1(:,kmino:kmaxo), this%tcache(kmino:kmaxo-1), & +! &this%trans_total, dim_CFL) +! flags(i,kmin:kmax-1) = flags(i,kmin:kmax-1) + this%tcache(kmin:kmax-1) +! end do +! end do + +! this%loc_CFL_z = dim_CFL + +! this%have_trans_flags = .true. +! this%have_CFL_estim = .true. +! this%have_CFL_exact = .true. +! this%CFL_reduced = .false. + +! end subroutine check_transsonic + + ! called by class, but kept as independent function +! pure subroutine check_transsonic_1d(evalf, flaginc, dxs, params, U, flags, total, CFL) +! procedure(eigenvals_ftype), intent(in) :: evalf +! integer(1), intent(in) :: flaginc +! integer, intent(in) :: P, N, M, MI +! integer, intent(in) :: M2, M3 +! real(WP), dimension(M), intent(in) :: dxs +! real(WP), dimension(P,M2), intent(in) :: params +! real(WP), dimension(N,M3), intent(in) :: U +! integer(1), dimension(MI), intent(inout) :: flags +! integer, intent(inout) :: total +! real(WP), intent(inout) :: CFL +! real(WP), dimension(N) :: evals +! logical, dimension(N) :: gtzl, gtzr +! integer :: i + +! call evalf(U(:,1), params(:,1), evals) +! do i = 1, N; gtzr(i) = evals(i) .gt. 0.0_WP; end do + +! do i = 2, M +! CFL = max(CFL, maxval(abs(dxs(i) * evals))) +! gtzl(:) = gtzr(:) +! call evalf(U(:,1), params(:,1), evals) +! gtzr(:) = evals(:) .gt. 0.0_WP +! if (any((.not. gtzl) .and. gtzr)) then +! flags(i-1) = flags(i-1) + flaginc +! total = total + 1 +! end if +! end do + +! end subroutine check_transsonic_1d + + !> calculate CFL from cell values + subroutine recalc_cfl(this) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), dimension(this%N) :: evals + real(WP) :: task_CFL_x, task_CFL_y, task_CFL_z + integer :: i, j, k, ierrx, ierry, ierrz + + call this%cfg%sync(this%Uc) + + task_CFL_x = 0.0_WP; task_CFL_y = 0.0_WP; task_CFL_z = 0.0_WP; + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + call this%evals_x(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_x = max(task_CFL_x, this%cfg%dxi(i) * maxval(abs(evals))) + call this%evals_y(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_y = max(task_CFL_y, this%cfg%dyi(i) * maxval(abs(evals))) + call this%evals_z(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_z = max(task_CFL_z, this%cfg%dzi(i) * maxval(abs(evals))) + end do + end do + end do + + call MPI_ALLREDUCE(task_CFL_x, this%CFL_x, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrx) + call MPI_ALLREDUCE(task_CFL_y, this%CFL_y, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierry) + call MPI_ALLREDUCE(task_CFL_z, this%CFL_z, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrz) + + if (ierrx .ne. 0) call die("error reducing CFL") + if (ierry .ne. 0) call die("error reducing CFL") + if (ierrz .ne. 0) call die("error reducing CFL") + + this%have_CFL_x_estim = .true.; this%have_CFL_x_exact = .true.; + this%have_CFL_y_estim = .true.; this%have_CFL_y_exact = .true.; + this%have_CFL_z_estim = .true.; this%have_CFL_z_exact = .true.; + + end subroutine recalc_cfl + +end module + diff --git a/src/hyperbolic/rusanov_class.f90 b/src/hyperbolic/rusanov_class.f90 new file mode 100644 index 000000000..d10857d92 --- /dev/null +++ b/src/hyperbolic/rusanov_class.f90 @@ -0,0 +1,561 @@ +!> Rusanov solver class +!> +!> This first-order Rusanov scheme is extremely diffusive, but foolproof (as +!> long as a flux function is known. +!> +!> Originally written by John P Wakefield, Feb 2023. +!> +!> +module rusanov_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use iterator_class, only: iterator + use hyperbolic, only: eigenvals_ftype, flux_ftype + implicit none + private + + ! expose type/constructor/methods + public :: rusanov, rus_bc + + ! expose interfaces + public :: eigenvals_ftype, flux_ftype + + ! List of known available bcond types for this solver + integer(1), parameter, public :: EXTRAPOLATE = 1_1 !< 0th order extrapolation + integer(1), parameter, public :: REFLECT = 2_1 !< reflection by velmask + + !> boundary conditions for the hyperbolic solver + type :: rus_bc + type(rus_bc), pointer :: next !< linked list of bconds + character(len=str_medium) :: name = 'UNNAMED_BCOND' !< bcond name (default UNNAMED_BCOND) + integer(1) :: type !< bcond type + type(iterator) :: itr !< this is the iterator for the bcond + integer(1) :: dir !< bcond direction 0-6 + end type rus_bc + + !> solver object definition + type :: rusanov + + ! config / pgrid object + class(config), pointer :: cfg !< config / pgrid information + + ! name + character(len=str_medium) :: name = 'UNNAMED_RUSANOV' !< solver name + + ! system information + integer :: N !< system dimension + integer :: P !< number of parameters + procedure(eigenvals_ftype), pointer, nopass :: evals_x, evals_y, evals_z + procedure(flux_ftype), pointer, nopass :: flux_x, flux_y, flux_z + logical, dimension(:), allocatable :: vel_mask_x, vel_mask_y, vel_mask_z + + ! boundary condition list + integer :: nbc !< number of bcond for our solver + type(rus_bc), pointer :: first_bc !< list of bcond for our solver + + ! flow variables, parameter arrays + real(WP), dimension(:,:,:,:), pointer :: Uc, dU !< state variables + real(WP), dimension(:,:,:,:), pointer :: params !< params for evals/flux + + ! CFL numbers + real(WP) :: CFL_x, CFL_y, CFL_z !< global CFL numbers (over dt) + logical :: have_CFL_x, have_CFL_y, have_CFL_z + + ! monitoring quantities + real(WP), dimension(:), pointer :: Umin, Umax !< state variable range + real(WP), dimension(:), pointer :: Uint !< integral of state vars over domain + logical :: have_Urange + + contains + + ! standard interface + procedure :: print => rusanov_print !< output solver to the screen + procedure :: add_bcond !< add a boundary condition + procedure :: get_bcond !< get a boundary condition + procedure :: apply_bcond !< apply all boundary conditions + procedure :: get_cfl !< get maximum CFL + procedure :: get_range !< calculate min/max field values + procedure :: get_min => get_range !< compatibility + procedure :: get_max => get_range !< compatibility + procedure :: calc_dU_x, calc_dU_y, calc_dU_z !< take step + + end type rusanov + + !> declare constructors + interface rusanov; procedure rusanov_from_args; end interface + +contains + + !! standard interface class functions + + !> default constructor for rusanov-type flow solver + function rusanov_from_args(cfg, name, N, P, evals_x, evals_y, evals_z, & + flux_x, flux_y, flux_z) result(this) + use messager, only: die + implicit none + type(rusanov) :: this + class(config), target, intent(in) :: cfg + character(len=*), intent(in), optional :: name + integer, intent(in) :: N, P + procedure(eigenvals_ftype), pointer, intent(in) :: evals_x, evals_y, evals_z + procedure(flux_ftype), pointer, intent(in) :: flux_x, flux_y, flux_z + integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo, minmino, maxmaxo + + ! check number of ghost cells + if (cfg%no .lt. 1) call die("must have at least one ghost cell") + + ! point to pgrid object + this%cfg => cfg + + ! set the name for the solver + if (present(name)) this%name = trim(adjustl(name)) + + ! system information + this%N = N; this%P = P; + this%evals_x => evals_x; this%evals_y => evals_y; this%evals_z => evals_z; + this%flux_x => flux_x; this%flux_y => flux_y; this%flux_z => flux_z; + + ! boundary condition list + this%nbc = 0 + this%first_bc => NULL() + + ! get array sizes + imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; + jmino = this%cfg%jmino_; jmaxo = this%cfg%jmaxo_; + kmino = this%cfg%kmino_; kmaxo = this%cfg%kmaxo_; + minmino = min(imino, jmino, kmino); maxmaxo = max(imaxo, jmaxo, kmaxo) + + ! allocate flow variables and parameter arrays + allocate(this%params(P,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%Uc(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%dU(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + + ! allocate velocity masks + allocate(this%vel_mask_x(N), this%vel_mask_y(N), this%vel_mask_z(N)) + + ! initialize CFL computations + this%have_CFL_x = .false. + this%have_CFL_y = .false. + this%have_CFL_z = .false. + + ! initialize monitoring + allocate(this%Umin(N), this%Umax(N), this%Uint(N)) + this%have_Urange = .false. + + end function + + !> solver print function + subroutine rusanov_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(rusanov), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("rusanov-type solver [",a,"] for config [",a,"]")') & + & trim(this%name), trim(this%cfg%name) + end if + + end subroutine + + !> Add a boundary condition + subroutine add_bcond(this, name, type, locator, dir) + use iterator_class, only: locator_gen_ftype + use string, only: lowercase + use messager, only: die + implicit none + class(rusanov), intent(inout) :: this + character(len=*), intent(in) :: name + integer(1), intent(in) :: type + procedure(locator_gen_ftype) :: locator + character(len=2), intent(in) :: dir + type(rus_bc), pointer :: new_bc + + ! prepare new bcond + allocate(new_bc) + new_bc%name = trim(adjustl(name)) + new_bc%type = type + new_bc%itr = iterator(pg=this%cfg, name=new_bc%name, locator=locator) + select case (lowercase(dir)) + case ('c'); new_bc%dir = 0_1 + case ('-x', 'x-', 'xl'); new_bc%dir = 2_1 + case ('+x', 'x+', 'xr'); new_bc%dir = 1_1 + case ('-y', 'y-', 'yl'); new_bc%dir = 4_1 + case ('+y', 'y+', 'yr'); new_bc%dir = 3_1 + case ('-z', 'z-', 'zl'); new_bc%dir = 6_1 + case ('+z', 'z+', 'zr'); new_bc%dir = 5_1 + case default; call die('[rusanov add_bcond] unknown bcond direction') + end select + + ! insert it in front + new_bc%next => this%first_bc + this%first_bc => new_bc + this%nbc = this%nbc + 1 + + end subroutine add_bcond + + !> get a boundary condition + subroutine get_bcond(this, name, my_bc) + use messager, only: die + implicit none + class(rusanov), intent(inout) :: this + character(len=*), intent(in) :: name + type(rus_bc), pointer, intent(out) :: my_bc + + my_bc => this%first_bc + do while (associated(my_bc)) + if (trim(my_bc%name).eq.trim(name)) return + my_bc => my_bc%next + end do + + call die('[rusanov get_bcond] Boundary condition was not found') + + end subroutine get_bcond + + !> enforce boundary condition + !> note that this interpolates (ensuring ghost cells have the right value), + !> but all wave-related constraints are imposed during the step + subroutine apply_bcond(this, t, dt) + use messager, only: die + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: t, dt + logical, dimension(this%N) :: vel_mask + integer :: i, j, k, m, n, iref, jref, kref + type(rus_bc), pointer :: my_bc + + ! Traverse bcond list + my_bc => this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + select case (my_bc%type) + case (0_1) !< do nothing + case (1_1) !< extrapolate + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + this%Uc(:,i,j,k) = this%Uc(:,iref,jref,kref) + end do + case (2_1) !< reflect + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + if (i .ne. iref) then + if (i .lt. iref) then + iref = i + 2 * (iref - i) - 1 + else + iref = i - 2 * (i - iref) + 1 + end if + vel_mask(:) = this%vel_mask_x(:) + end if + if (j .ne. jref) then + if (j .lt. jref) then + jref = j + 2 * (jref - j) - 1 + else + jref = j - 2 * (j - jref) + 1 + end if + vel_mask(:) = this%vel_mask_y(:) + end if + if (k .ne. kref) then + if (k .lt. kref) then + kref = k + 2 * (kref - k) - 1 + else + kref = k - 2 * (k - kref) + 1 + end if + vel_mask(:) = this%vel_mask_z(:) + end if + do n = 1, this%N + if (vel_mask(n)) then + this%Uc(n,i,j,k) = - this%Uc(n,iref,jref,kref) + else + this%Uc(n,i,j,k) = + this%Uc(n,iref,jref,kref) + end if + end do + end do + case default + call die('[rusanov apply_bcond] Unknown bcond type') + end select + + ! zero normal velocity? + !masked_type = iand(my_bc%type, 4_1) + !if (masked_type .eq. 4_1) then + ! select case (my_bc%dir) + ! case (0_1) + ! vel_mask(:) = this%vel_mask_x(:) .and. this%vel_mask_y(:) .and. & + ! & this%vel_mask_z(:) + ! case (1_1, 2_1) + ! vel_mask(:) = this%vel_mask_x(:) + ! case (3_1, 4_1) + ! vel_mask(:) = this%vel_mask_y(:) + ! case (5_1, 6_1) + ! vel_mask(:) = this%vel_mask_z(:) + ! end select + ! do m = 1, my_bc%itr%n_ + ! i = my_bc%itr%map(1,m) + ! j = my_bc%itr%map(2,m) + ! k = my_bc%itr%map(3,m) + ! do n = 1, this%N + ! if (vel_mask(n)) this%Uc(n,i,j,k) = 0.0_WP + ! end do + ! end do + !end if + + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%Uc) + call this%cfg%sync(this%dU) + + ! Move on to the next bcond + my_bc => my_bc%next + + end do + + end subroutine apply_bcond + + !> get CFL number + subroutine get_cfl(this, dt, cfl) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + real(WP), dimension(this%N) :: evals + real(WP) :: task_CFL_x, task_CFL_y, task_CFL_z + logical :: have_CFL + integer :: i, j, k, ierrx, ierry, ierrz + + have_CFL = this%have_CFL_x .and. this%have_CFL_y .and. this%have_CFL_z + + if (.not. have_CFL) then + + call this%cfg%sync(this%Uc) + + task_CFL_x = 0.0_WP; task_CFL_y = 0.0_WP; task_CFL_z = 0.0_WP; + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + call this%evals_x(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_x = max(task_CFL_x, this%cfg%dxi(i) * maxval(abs(evals))) + call this%evals_y(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_y = max(task_CFL_y, this%cfg%dyi(i) * maxval(abs(evals))) + call this%evals_z(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_z = max(task_CFL_z, this%cfg%dzi(i) * maxval(abs(evals))) + end do + end do + end do + + call MPI_ALLREDUCE(task_CFL_x, this%CFL_x, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrx) + call MPI_ALLREDUCE(task_CFL_y, this%CFL_y, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierry) + call MPI_ALLREDUCE(task_CFL_z, this%CFL_z, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrz) + + if (ierrx .ne. 0) call die("error reducing CFL") + if (ierry .ne. 0) call die("error reducing CFL") + if (ierrz .ne. 0) call die("error reducing CFL") + + this%have_CFL_x = .true. + this%have_CFL_y = .true. + this%have_CFL_z = .true. + + end if + + cfl = dt * max(this%CFL_x, this%CFL_y, this%CFL_z) + + end subroutine get_cfl + + !> get min/max field values + subroutine get_range(this) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MIN, MPI_MAX, MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(rusanov), intent(inout) :: this + real(WP), dimension(this%N) :: task_Umin, task_Umax, task_Uint + integer :: i, j, k, ierr + + if (.not. this%have_Urange) then + + task_Umin(:) = + huge(1.0_WP) + task_Umax(:) = - huge(1.0_WP) + task_Uint(:) = 0.0_WP + + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + task_Umin = min(task_Umin, this%Uc(:,i,j,k)) + task_Umax = max(task_Umax, this%Uc(:,i,j,k)) + task_Uint = task_Uint + this%Uc(:,i,j,k) * this%cfg%dx(i) * & + & this%cfg%dy(j) * this%cfg%dz(k) + end do + end do + end do + + call MPI_ALLREDUCE(task_Umin, this%Umin, this%N, MPI_REAL_WP, MPI_MIN, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umin") + call MPI_ALLREDUCE(task_Umax, this%Umax, this%N, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umax") + call MPI_ALLREDUCE(task_Uint, this%Uint, this%N, MPI_REAL_WP, MPI_SUM, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Uint") + + this%have_Urange = .true. + + end if + + end subroutine get_range + + !> compute dU in x direction + subroutine calc_dU_x(this, dt) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: j, k + + call this%cfg%sync(this%Uc) + + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + call rusanov_1d(this%N, this%P, size(this%Uc, 2), this%flux_x, & + this%evals_x, this%cfg%dx, dt, this%params(:,:,j,k), & + this%Uc(:,:,j,k), this%dU(:,:,j,k)) + end do + end do + + call this%cfg%sync(this%dU) + + this%have_CFL_x = .false.; this%have_Urange = .false.; + + end subroutine calc_dU_x + + !> compute dU in y direction + subroutine calc_dU_y(this, dt) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: i, k, jmino_, jmaxo_ + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + + if (this%cfg%ny .lt. 2) return + + call this%cfg%sync(this%Uc) + + jmino_ = this%cfg%jmino_; jmaxo_ = this%cfg%jmaxo_; + + allocate(U1d(this%N,jmino_:jmaxo_), p1d(this%P,jmino_:jmaxo_), dU1d(this%N,jmino_:jmaxo_)) + + do k = this%cfg%kmin_, this%cfg%kmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d(:,:) = this%Uc(:,i,jmino_:jmaxo_,k) + dU1d(:,:) = this%dU(:,i,jmino_:jmaxo_,k) + p1d(:,:) = this%params(:,i,jmino_:jmaxo_,k) + call rusanov_1d(this%N, this%P, size(U1d, 2), this%flux_y, & + this%evals_y, this%cfg%dy, dt, p1d, U1d, dU1d) + this%dU(:,i,jmino_:jmaxo_,k) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d) + + call this%cfg%sync(this%dU) + + this%have_CFL_y = .false.; this%have_Urange = .false.; + + end subroutine calc_dU_y + + !> compute dU in z direction + subroutine calc_dU_z(this, dt) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: i, j, kmino_, kmaxo_ + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + + if (this%cfg%nz .lt. 2) return + + call this%cfg%sync(this%Uc) + + kmino_ = this%cfg%kmino_; kmaxo_ = this%cfg%kmaxo_; + + allocate(U1d(this%N,kmino_:kmaxo_), p1d(this%P,kmino_:kmaxo_), dU1d(this%N,kmino_:kmaxo_)) + + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d(:,:) = this%Uc(:,i,j,kmino_:kmaxo_) + dU1d(:,:) = this%dU(:,i,j,kmino_:kmaxo_) + p1d(:,:) = this%params(:,i,j,kmino_:kmaxo_) + call rusanov_1d(this%N, this%P, size(U1d, 2), this%flux_z, & + this%evals_z, this%cfg%dz, dt, p1d, U1d, dU1d) + this%dU(:,i,j,kmino_:kmaxo_) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d) + + call this%cfg%sync(this%dU) + + this%have_CFL_z = .false.; this%have_Urange = .false.; + + end subroutine calc_dU_z + + ! requires one ghost cell + ! left as an independent function, but called is by class + pure subroutine rusanov_1d(N, P, M, flux, evals, dxs, dt, params, U, dU) + implicit none + integer, intent(in) :: N, P, M + procedure(eigenvals_ftype), pointer, intent(in) :: evals + procedure(flux_ftype), pointer, intent(in) :: flux + real(WP), dimension(M), intent(in) :: dxs ! size M + real(WP), intent(in) :: dt + real(WP), dimension(P,M), intent(in) :: params ! size (P, M) + real(WP), dimension(N,M), intent(in) :: U ! size (N, M) + real(WP), dimension(N,M), intent(inout) :: dU ! size (N, M) + real(WP), dimension(N) :: F, Fl, Fr, nudiff, laml, lamr + integer :: j + + dU(:,:) = 0.0_WP + + call flux(P, N, params(:,1), U(:,1), Fl) + call evals(P, N, params(:,1), U(:,1), laml) + laml(:) = abs(laml(:)) + + do j = 2, M + + call flux(P, N, params(:,j), U(:,j), Fr) + call evals(P, N, params(:,j), U(:,j), lamr) + lamr(:) = abs(lamr(:)) + + nudiff = (U(:,j) - U(:,j-1)) * max(maxval(laml), maxval(lamr)) + + ! not the right division by dx, but whatever + F = dt * 0.5_WP / (0.5_WP * (dxs(j-1) + dxs(j))) * (Fr + Fl - nudiff) + + dU(:,j-1) = dU(:,j-1) - F + dU(:,j ) = dU(:,j ) + F + + Fl(:) = Fr(:); laml(:) = lamr(:); + + end do + + end subroutine rusanov_1d + +end module rusanov_class + diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 36d6b4ae1..8d8e492dc 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -1,849 +1,847 @@ !> Basic direct forcing IBM class: !> Provides support for Lagrangian marker particles module df_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION - implicit none - private - - - ! Expose type/constructor/methods - public :: dfibm - - - !> Memory adaptation parameter - real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor - real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor - - !> I/O chunk size to read at a time - integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - !> Basic marker particle definition - type :: part - !> MPI_DOUBLE_PRECISION data - real(WP) :: dA !< Element area - real(WP), dimension(3) :: norm !< Outward normal vector - real(WP), dimension(3) :: pos !< Particle center coordinates - real(WP), dimension(3) :: vel !< Velocity of particle - !> MPI_INTEGER data - integer :: id !< ID the object is associated with - integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) - end type part - !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=2 - integer , dimension(part_nblock) :: part_lblock=[10,5] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] - !> MPI_PART derived datatype and size - type(MPI_Datatype) :: MPI_PART - integer :: MPI_PART_SIZE - - !> Basic ibm object definition - type :: obj - !> MPI_DOUBLE_PRECISION data - real(WP) :: vol !< Object volume - real(WP), dimension(3) :: pos !< Center of mass - real(WP), dimension(3) :: vel !< Translational velocity of the object - real(WP), dimension(3) :: angVel !< Angular velocity of the object - real(WP), dimension(3) :: F !< Hydrodynamic force - end type obj - - !> Direct forcing IBM solver object definition - type :: dfibm - - ! This is our underlying config - class(config), pointer :: cfg !< This is the config the solver is build for - - ! This is the name of the solver - character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM - - ! Marker particle data - integer :: np !< Global number of particles - integer :: np_ !< Local number of particles - integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor - type(part), dimension(:), allocatable :: p !< Array of particles of type part - - ! Object data - integer :: nobj !< Global number of objects - type(obj), dimension(:), allocatable :: o !< Array of objects of type obj - - ! CFL numbers - real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers - - ! Solver parameters - real(WP) :: nstep=1 !< Number of substeps (default=1) - logical :: can_move !< Flag to allow moving IBM objects - - ! Monitoring info - real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info - real(WP) :: Umin,Umax,Umean !< U velocity info - real(WP) :: Vmin,Vmax,Vmean !< V velocity info - real(WP) :: Wmin,Wmax,Wmean !< W velocity info - real(WP) :: Fx,Fy,Fz !< Total force - - ! Volume fraction associated with IBM projection - real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered - - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - - ! Distance levelset for visualization and collision detection - real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered - + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: dfibm + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic marker particle definition + type :: part + !> MPI_DOUBLE_PRECISION data + real(WP) :: dA !< Element area + real(WP), dimension(3) :: norm !< Outward normal vector + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + !> MPI_INTEGER data + integer :: id !< ID the object is associated with + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=2 + integer , dimension(part_nblock) :: part_lblock=[10,5] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Basic ibm object definition + type :: obj + !> MPI_DOUBLE_PRECISION data + real(WP) :: vol !< Object volume + real(WP), dimension(3) :: pos !< Center of mass + real(WP), dimension(3) :: vel !< Translational velocity of the object + real(WP), dimension(3) :: angVel !< Angular velocity of the object + real(WP), dimension(3) :: F !< Hydrodynamic force + end type obj + + !> Direct forcing IBM solver object definition + type :: dfibm + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM + + ! Marker particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Object data + integer :: nobj !< Global number of objects + type(obj), dimension(:), allocatable :: o !< Array of objects of type obj + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + logical :: can_move !< Flag to allow moving IBM objects + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info + real(WP) :: Umin,Umax,Umean !< U velocity info + real(WP) :: Vmin,Vmax,Vmean !< V velocity info + real(WP) :: Wmin,Wmax,Wmean !< W velocity info + real(WP) :: Fx,Fy,Fz !< Total force + + ! Volume fraction associated with IBM projection + real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + + ! Distance levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered + contains - procedure :: update_partmesh !< Update a partmesh object using current particles - procedure :: setup_obj !< Setup IBM object - procedure :: get_source !< Compute direct forcing source - procedure :: resize !< Resize particle array to given size - procedure :: recycle !< Recycle particle array by removing flagged particles - procedure :: sync !< Synchronize particles across interprocessor boundaries - procedure :: read !< Parallel read particles from file - procedure :: write !< Parallel write particles to file - procedure :: get_max !< Extract various monitoring data - procedure :: get_cfl !< Calculate maximum CFL - procedure :: update_VF !< Compute volume fraction - procedure :: get_delta !< Compute regularized delta function - procedure :: interpolate !< Interpolation routine from mesh=>marker - procedure :: extrapolate !< Extrapolation routine from marker=>mesh - end type dfibm - - - !> Declare df solver constructor - interface dfibm - procedure constructor - end interface dfibm - + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: setup_obj !< Setup IBM object + procedure :: get_source !< Compute direct forcing source + procedure :: resize !< Resize particle array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute volume fraction + procedure :: get_delta !< Compute regularized delta function + procedure :: interpolate !< Interpolation routine from mesh=>marker + procedure :: extrapolate !< Extrapolation routine from marker=>mesh + end type dfibm + + + !> Declare df solver constructor + interface dfibm + procedure constructor + end interface dfibm + contains - !> Default constructor for direct forcing solver - function constructor(cfg,name) result(self) - implicit none - type(dfibm) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - integer :: i,j,k - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Allocate variables - allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 - self%np_=0; self%np=0 - call self%resize(0) - - ! Initialize MPI derived datatype for a particle - call prepare_mpi_part() - - ! Allocate levelset, VF and src arrays on cfg mesh - allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - - ! Initialize object - self%can_move=.false. - self%nobj=0 - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (self%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + !> Default constructor for direct forcing solver + function constructor(cfg,name) result(self) + implicit none + type(dfibm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate levelset, VF and src arrays on cfg mesh + allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + + ! Initialize object + self%can_move=.false. + self%nobj=0 + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Setup IBM objects, each processors own all objects + subroutine setup_obj(this) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i,j,n,ibuf,ierr + real(WP) :: myVol,dV,fac + real(WP), dimension(3) :: pos0,dist + ! Determine number of objects based on marker ID + n=1 + do i=1,this%np_ + n=max(n,this%p(i)%id) + end do + call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + ! Allocate and zero out the object array + allocate(this%o(1:this%nobj)) + if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then + fac=1.0_WP/3.0_WP + else + fac=1.0_WP/2.0_WP end if - end block logging - - end function constructor - - - !> Setup IBM objects, each processors own all objects - subroutine setup_obj(this) - use mpi_f08 - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i,j,n,ibuf,ierr - real(WP) :: myVol,dV,fac - real(WP), dimension(3) :: pos0,dist - ! Determine number of objects based on marker ID - n=1 - do i=1,this%np_ - n=max(n,this%p(i)%id) - end do - call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - ! Allocate and zero out the object array - allocate(this%o(1:this%nobj)) - if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then - fac=1.0_WP/3.0_WP - else - fac=1.0_WP/2.0_WP - end if - do i=1,this%nobj - ! Zero-out object properties - this%o(i)%pos=0.0_WP - this%o(i)%vel=0.0_WP - this%o(i)%angVel=0.0_WP - this%o(i)%F=0.0_WP - ! Compute center of mass - myVol=0.0_WP - do j=1,this%np_ - ! Determine particle associated with object - if (this%p(j)%id.eq.i) then - myVol=myVol+this%p(j)%dA - this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV - ! Determine object volume - myVol=0.0_WP - do j=1,this%np_ - if (this%p(j)%id.eq.i) then - dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) - if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) - if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) - if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) - myVol=myVol+fac*sum(dist)*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV - end do - end subroutine setup_obj - - - !> Compute direct forcing source by a specified time step dt - subroutine get_source(this,dt,U,V,W,rho) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: dti,rho_,dV - real(WP), dimension(3) :: vel,src - - ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - - ! Zero-out forces on objects - do i=1,this%nobj - this%o(i)%F=0.0_WP - end do - - ! Advance the equations - dti=1.0_WP/dt - do i=1,this%np_ - ! Interpolate the velocity to the particle location - vel=0.0_WP - if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') - if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') - if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') - rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') - ! Compute the source term - src=(this%p(i)%vel-vel) - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Send source term back to the mesh - if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') - if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') - if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') - ! Sum up force on object (Newton's 3rd law) - j=max(this%p(i)%id,1) - this%o(j)%F=this%o(j)%F-rho_*src*dV*dti - end do - - ! Sum at boundaries - call this%cfg%syncsum(this%srcU) - call this%cfg%syncsum(this%srcV) - call this%cfg%syncsum(this%srcW) - - ! Sum over each object - do j=1,this%nobj - call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src - end do - - ! Recompute volume fraction - call this%update_VF() - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + do i=1,this%nobj + ! Zero-out object properties + this%o(i)%pos=0.0_WP + this%o(i)%vel=0.0_WP + this%o(i)%angVel=0.0_WP + this%o(i)%F=0.0_WP + ! Compute center of mass + myVol=0.0_WP + do j=1,this%np_ + ! Determine particle associated with object + if (this%p(j)%id.eq.i) then + myVol=myVol+this%p(j)%dA + this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV + ! Determine object volume + myVol=0.0_WP + do j=1,this%np_ + if (this%p(j)%id.eq.i) then + dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) + if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) + if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) + if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) + myVol=myVol+fac*sum(dist)*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV + end do + end subroutine setup_obj + + + !> Compute direct forcing source by a specified time step dt + subroutine get_source(this,dt,U,V,W,rho) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: dti,rho_,dV + real(WP), dimension(3) :: vel,src + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + + ! Zero-out forces on objects + do i=1,this%nobj + this%o(i)%F=0.0_WP + end do + + ! Advance the equations + dti=1.0_WP/dt + do i=1,this%np_ + ! Interpolate the velocity to the particle location + vel=0.0_WP + if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') + if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') + if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') + rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') + ! Compute the source term + src=(this%p(i)%vel-vel) + ! Get element volume + dV=this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Send source term back to the mesh + if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') + ! Sum up force on object (Newton's 3rd law) + j=max(this%p(i)%id,1) + this%o(j)%F=this%o(j)%F-rho_*src*dV*dti + end do + + ! Sum at boundaries + call this%cfg%syncsum(this%srcU) + call this%cfg%syncsum(this%srcV) + call this%cfg%syncsum(this%srcW) + + ! Sum over each object + do j=1,this%nobj + call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src + end do + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end subroutine get_source + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i + real(WP) :: dV + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Get element volume + dV = this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Transfer volume to mesh + call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') + end do + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + end subroutine update_VF + + + !> Compute regularized delta function + subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(out) :: delta !< Return delta function + integer, intent(in) :: ic,jc,kc !< Cell index + real(WP), intent(in) :: xp,yp,zp !< Position of marker + character(len=*) :: dir + real(WP) :: deltax,deltay,deltaz,r + + ! Compute in X + if (trim(adjustl(dir)).eq.'U') then + r=(xp-this%cfg%x(ic))*this%cfg%dxmi(ic) + deltax=roma_kernel(r)*this%cfg%dxmi(ic) + else + r=(xp-this%cfg%xm(ic))*this%cfg%dxi(ic) + deltax=roma_kernel(r)*this%cfg%dxi(ic) end if - end block logging - - end subroutine get_source - - - !> Update particle volume fraction using our current particles - subroutine update_VF(this) - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i - real(WP) :: dV - ! Reset volume fraction - this%VF=0.0_WP - ! Transfer particle volume - do i=1,this%np_ - ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Transfer volume to mesh - call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') - end do - ! Sum at boundaries - call this%cfg%syncsum(this%VF) - end subroutine update_VF - - - !> Compute regularized delta function - subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(out) :: delta !< Return delta function - integer, intent(in) :: ic,jc,kc !< Cell index - real(WP), intent(in) :: xp,yp,zp !< Position of marker - character(len=*) :: dir - real(WP) :: deltax,deltay,deltaz,r - - ! Compute in X - if (trim(adjustl(dir)).eq.'U') then - r = (xp-this%cfg%x(ic))*this%cfg%dxmi(ic) - deltax = roma_kernel(r)*this%cfg%dxmi(ic) - else - r = (xp-this%cfg%xm(ic))*this%cfg%dxi(ic) - deltax = roma_kernel(r)*this%cfg%dxi(ic) - end if - - ! Compute in Y - if (trim(adjustl(dir)).eq.'V') then - r = (yp-this%cfg%y(jc))*this%cfg%dymi(jc) - deltay = roma_kernel(r)*this%cfg%dymi(jc) - else - r = (yp-this%cfg%ym(jc))*this%cfg%dyi(jc) - deltay = roma_kernel(r)*this%cfg%dyi(jc) - end if - - ! Compute in Z - if (trim(adjustl(dir)).eq.'W') then - r = (zp-this%cfg%z(kc))*this%cfg%dzmi(kc) - deltaz = roma_kernel(r)*this%cfg%dzmi(kc) - else - r = (zp-this%cfg%zm(kc))*this%cfg%dzi(kc) - deltaz = roma_kernel(r)*this%cfg%dzi(kc) - end if - - ! Put it all together - delta=deltax*deltay*deltaz - - contains - ! Mollification kernel - ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 - function roma_kernel(r) result(phi) + + ! Compute in Y + if (trim(adjustl(dir)).eq.'V') then + r=(yp-this%cfg%y(jc))*this%cfg%dymi(jc) + deltay=roma_kernel(r)*this%cfg%dymi(jc) + else + r=(yp-this%cfg%ym(jc))*this%cfg%dyi(jc) + deltay=roma_kernel(r)*this%cfg%dyi(jc) + end if + + ! Compute in Z + if (trim(adjustl(dir)).eq.'W') then + r=(zp-this%cfg%z(kc))*this%cfg%dzmi(kc) + deltaz=roma_kernel(r)*this%cfg%dzmi(kc) + else + r=(zp-this%cfg%zm(kc))*this%cfg%dzi(kc) + deltaz=roma_kernel(r)*this%cfg%dzi(kc) + end if + + ! Put it all together + delta=deltax*deltay*deltaz + + contains + ! Mollification kernel + ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 + function roma_kernel(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + if (abs(r).le.0.5_WP) then + phi=1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) + else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then + phi=1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + else + phi=0.0_WP + end if + end function roma_kernel + + end subroutine get_delta + + + !> Interpolation routine + function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) implicit none - real(WP), intent(in) :: r - real(WP) :: phi - if (abs(r).le.0.5_WP) then - phi = 1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) - else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then - phi = 1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + character(len=*) :: dir + real(WP) :: Ap + integer :: di,dj,dk + integer :: i1,i2,j1,j2,k1,k2 + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + ! Get the interpolation points + i1=ip-2; i2=ip+2 + j1=jp-2; j2=jp+2 + k1=kp-2; k2=kp+2 + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual interpolation on Ap + Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) + end function interpolate + + + !> Extrapolation routine + subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) + use messager, only: die + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(in) :: Ap + character(len=*) :: dir + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + integer :: di,dj,dk + ! If particle has left processor domain or reached last ghost cell, kill job + if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& + & jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& + & kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then + write(*,*) ip,jp,kp,xp,yp,zp + call die('[df extrapolate] Particle has left the domain') + end if + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual extrapolation on A + A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap + end subroutine extrapolate + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z + + ! Return if not used + if (.not.this%can_move) then + cfl=0.0_WP + return + end if + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Get mean, max, and min volume fraction and total force + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) + this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) + this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(dfibm), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(dfibm), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(dfibm), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 else - phi = 0.0_WP + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if end if - end function roma_kernel - - end subroutine get_delta - - - !> Interpolation routine - function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - character(len=*) :: dir - real(WP) :: Ap - integer :: di,dj,dk - integer :: i1,i2,j1,j2,k1,k2 - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - ! Get the interpolation points - i1=ip-2; i2=ip+2 - j1=jp-2; j2=jp+2 - k1=kp-2; k2=kp+2 - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual interpolation on Ap - Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) - end function interpolate - - - !> Extrapolation routine - subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) - use messager, only: die - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - real(WP), intent(in) :: Ap - character(len=*) :: dir - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - integer :: di,dj,dk - ! If particle has left processor domain or reached last ghost cell, kill job - if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& - jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& - kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then - write(*,*) ip,jp,kp,xp,yp,zp - call die('[df extrapolate] Particle has left the domain') - end if - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual extrapolation on A - A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap - end subroutine extrapolate - - - !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl - integer :: i,ierr - real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z - - ! Return if not used - if (.not.this%can_move) then - cfl=0.0_WP - return - end if - - ! Set the CFLs to zero - my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP - do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) - end do - my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt - - ! Get the parallel max - call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Return the maximum CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - - end subroutine get_cfl - - - !> Extract various monitoring data from particle field - subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP) :: buf,safe_np - integer :: i,j,k,ierr - - ! Create safe np - safe_np=real(max(this%np,1),WP) - - ! Diameter and velocity min/max/mean - this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP - this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP - this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP - do i=1,this%np_ - this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) - this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) - this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) - end do - call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf - call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf - call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np - call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf - call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf - call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np - call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf - call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf - call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - - ! Get mean, max, and min volume fraction and total force - this%VFmean=0.0_WP - this%VFmax =-huge(1.0_WP) - this%VFmin =+huge(1.0_WP) - this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) - this%VFmax =max(this%VFmax,this%VF(i,j,k)) - this%VFmin =min(this%VFmin,this%VF(i,j,k)) - this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) - this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) - this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf - call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf - call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total - - end subroutine get_max - - - !> Update particle mesh using our current particles - subroutine update_partmesh(this,pmesh) - use partmesh_class, only: partmesh - implicit none - class(dfibm), intent(inout) :: this - class(partmesh), intent(inout) :: pmesh - integer :: i - ! Reset particle mesh storage - call pmesh%reset() - ! Nothing else to do if no particle is present - if (this%np_.eq.0) return - ! Copy particle info - call pmesh%set_size(this%np_) - do i=1,this%np_ - pmesh%pos(:,i)=this%p(i)%pos - end do - end subroutine update_partmesh - - - !> Creation of the MPI datatype for particle - subroutine prepare_mpi_part() - use mpi_f08 - use messager, only: die - implicit none - integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp - integer(MPI_ADDRESS_KIND) :: lb,extent - type(MPI_Datatype) :: MPI_PART_TMP - integer :: i,mysize,ierr - ! Prepare the displacement array - disp(1)=0 - do i=2,part_nblock - call MPI_Type_size(part_tblock(i-1),mysize,ierr) - disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) - end do - ! Create and commit the new type - call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) - call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) - call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) - call MPI_Type_commit(MPI_PART,ierr) - ! If a problem was encountered, say it - if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') - ! Get the size of this type - call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) - end subroutine prepare_mpi_part - - - !> Synchronize particle arrays across processors - subroutine sync(this) - use mpi_f08 - implicit none - class(dfibm), intent(inout) :: this - integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc - integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp - integer :: n,prank,ierr - type(part), dimension(:), allocatable :: buf_send - ! Recycle first to minimize communication load - call this%recycle() - ! Prepare information about what to send - nsend_proc=0 - do n=1,this%np_ - prank=this%cfg%get_rank(this%p(n)%ind) - nsend_proc(prank)=nsend_proc(prank)+1 - end do - nsend_proc(this%cfg%rank)=0 - ! Inform processors of what they will receive - call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - ! Prepare displacements for all-to-all - nsend_disp(0)=0 - nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array - do n=1,this%cfg%nproc-1 - nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) - nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) - end do - ! Allocate buffer to send particles - allocate(buf_send(sum(nsend_proc))) - ! Pack the particles in the send buffer - nsend_proc=0 - do n=1,this%np_ - ! Get the rank - prank=this%cfg%get_rank(this%p(n)%ind) - ! Skip particles still inside - if (prank.eq.this%cfg%rank) cycle - ! Pack up for sending - nsend_proc(prank)=nsend_proc(prank)+1 - buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) - ! Flag particle for removal - this%p(n)%flag=1 - end do - ! Allocate buffer for receiving particles - call this%resize(this%np_+sum(nrecv_proc)) - ! Perform communication - call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) - ! Deallocate buffer - deallocate(buf_send) - ! Recycle to remove duplicate particles - call this%recycle() - end subroutine sync - - - !> Adaptation of particle array size - subroutine resize(this,n) - implicit none - class(dfibm), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize particle array to size n - if (.not.allocated(this%p)) then - ! Allocate directly to size n - allocate(this%p(n)) - this%p(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%p,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%p - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%p) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%p(1:n) - call move_alloc(tmp,this%p) - end if - end if - end subroutine resize - - - !> Clean-up of particle array by removing flag=1 particles - subroutine recycle(this) - implicit none - class(dfibm), intent(inout) :: this - integer :: new_size,i,ierr - ! Compact all active particles at the beginning of the array - new_size=0 - if (allocated(this%p)) then - do i=1,size(this%p,dim=1) - if (this%p(i)%flag.ne.1) then - new_size=new_size+1 - if (i.ne.new_size) then - this%p(new_size)=this%p(i) - this%p(i)%flag=1 - end if - end if - end do - end if - ! Resize to new size - call this%resize(new_size) - ! Update number of particles - this%np_=new_size - call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - this%np=sum(this%np_proc) - end subroutine recycle - - - !> Parallel write particles to file - subroutine write(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset - integer :: i,ierr,iunit - - ! Root serial-writes the file header - if (this%cfg%amRoot) then - ! Open the file - open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) - ! Number of particles and particle object size - write(iunit) this%np,MPI_PART_SIZE - ! Done with the header - close(iunit) - end if - - ! The rest is done in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) - - ! Get current position - call MPI_FILE_GET_POSITION(ifile,offset,ierr) - - ! Compute the offset and write - do i=1,this%cfg%rank - offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) - end do - if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + end subroutine resize + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(dfibm), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do end if - end block logging - - end subroutine write - - - !> Parallel read particles to file - subroutine read(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset,header_offset - integer :: i,j,ierr,npadd,psize,nchunk,cnt - integer, dimension(:,:), allocatable :: ppp - - ! First open the file in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) - - ! Read file header first - call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) - call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) - - ! Remember current position - call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) - - ! Check compatibility of particle type - if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') - - ! Naively share reading task among all processors - nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 - allocate(ppp(this%cfg%nproc,nchunk)) - ppp=int(npadd/(this%cfg%nproc*nchunk)) - cnt=0 - out:do j=1,nchunk - do i=1,this%cfg%nproc - cnt=cnt+1 - if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out - ppp(i,j)=ppp(i,j)+1 - end do - end do out - - ! Read by chunk - do j=1,nchunk - ! Find offset - offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) - ! Resize particle array - call this%resize(this%np_+ppp(this%cfg%rank+1,j)) - ! Read this file - call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) - ! Most general case: relocate every droplet - do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - ! Exchange all that - call this%sync() - end do - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header if (this%cfg%amRoot) then - write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) end if - end block logging - - end subroutine read - - + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + end module df_class diff --git a/src/libraries/precision.mod b/src/libraries/precision.mod new file mode 100644 index 000000000..575582711 Binary files /dev/null and b/src/libraries/precision.mod differ diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 4765b6fd3..e7782d88b 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -79,10 +79,8 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) character(len=str_medium), public :: drag_model !< Drag model - logical :: use_lift=.false. !< Compute lift force on particles - + ! Collisional parameters - logical :: use_col=.true. !< Flag for collisions real(WP) :: tau_col !< Characteristic collision time scale real(WP) :: e_n !< Normal restitution coefficient real(WP) :: e_w !< Wall restitution coefficient @@ -350,233 +348,279 @@ function constructor(cfg,name) result(self) end function constructor - !> Resolve collisional interaction between particles + !> Resolve collisional interaction between particles, walls, and an optional IB level set !> Requires tau_col, e_n, e_w and mu_f to be set beforehand - subroutine collide(this,dt) - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - - ! Start by zeroing out the collision force - zero_force: block - integer :: i - do i=1,this%np_ - this%p(i)%Acol=0.0_WP - this%p(i)%Tcol=0.0_WP - end do - end block zero_force - - ! Return if not used - if (.not.this%use_col) return - - ! Then share particles across overlap - call this%share() - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - - ! Finally, calculate collision force - collision_force: block - use mpi_f08 - use mathtools, only: Pi,normalize,cross_product - integer :: i1,i2,ii,jj,kk,nn,ierr - real(WP) :: d1,m1,d2,m2,d12,m12 - real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t - real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv - real(WP), parameter :: aclipnorm=1.0e-6_WP - real(WP), parameter :: acliptan=1.0e-9_WP - real(WP), parameter :: rcliptan=0.05_WP - - ! Reset collision counter - this%ncol=0 - - ! Precompute coefficients for k and eta - k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 - eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col - k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 - eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col - - ! Loop over all local particles - collision: do i1=1,this%np_ - - ! Cycle if id<=0 - if (this%p(i1)%id.le.0) cycle collision - - ! Store particle data - r1=this%p(i1)%pos - v1=this%p(i1)%vel - w1=this%p(i1)%angVel - d1=this%p(i1)%d - m1=this%rho*Pi/6.0_WP*d1**3 - - ! First collide with walls - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') - n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) - n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1*k_coeff_w - eta_n=m1*eta_coeff_w - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt/d1.gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - end if - - ! Loop over nearest cells - do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 - do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 - do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - v2=this%p(i2)%vel - w2=this%p(i2)%angVel - d2=this%p(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - v2=this%g(i2)%vel - w2=this%g(i2)%angVel - d2=this%g(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - end if - - ! Compute relative information - d12=norm2(r1-r2) - if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision - n12=(r2-r1)/d12 - v12=v1-v2 - rnv=dot_product(v12,n12) - r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) - delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - m12=m1*m2/(m1+m2) - k_n=m12*k_coeff - eta_n=m12*eta_coeff - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - ! Add up the collisions - this%ncol=this%ncol+1 - end if - - end do - - end do - end do - end do - - ! Deal with dimensionality - if (this%cfg%nx.eq.1) then - this%p(i1)%Acol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%ny.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Acol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%nz.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Acol(3)=0.0_WP - end if - - end do collision - - ! Determine total number of collisions - call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 - - end block collision_force - - end subroutine collide - + subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Gib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nxib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nyib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nzib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + + ! Check if all IB parameters are present + check_G: block + use messager, only: die + if (present(Gib).and.(.not.present(Nxib).or..not.present(Nyib).or..not.present(Nzib))) & + call die('[lpt collide] IB collisions need Gib, Nxib, Nyib, AND Nzib') + end block check_G + + ! Start by zeroing out the collision force + zero_force: block + integer :: i + do i=1,this%np_ + this%p(i)%Acol=0.0_WP + this%p(i)%Tcol=0.0_WP + end do + end block zero_force + + ! Then share particles across overlap + call this%share() + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i + end do + + end block pic_prep + + ! Finally, calculate collision force + collision_force: block + use mpi_f08 + use mathtools, only: Pi,normalize,cross_product + integer :: i1,i2,ii,jj,kk,nn,ierr + real(WP) :: d1,m1,d2,m2,d12,m12,buf + real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t + real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv + real(WP), parameter :: aclipnorm=1.0e-6_WP + real(WP), parameter :: acliptan=1.0e-9_WP + real(WP), parameter :: rcliptan=0.05_WP + + ! Reset collision counter + this%ncol=0 + + ! Precompute coefficients for k and eta + k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 + eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col + k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 + eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col + + ! Loop over all local particles + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision + + ! Store particle data + r1=this%p(i1)%pos + v1=this%p(i1)%vel + w1=this%p(i1)%angVel + d1=this%p(i1)%d + m1=this%rho*Pi/6.0_WP*d1**3 + + ! First collide with walls + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') + n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) + n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + + ! Collide with IB + if (present(Gib)) then + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Gib,bc='n') + n12(1)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nxib,bc='n') + n12(2)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nyib,bc='n') + n12(3)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nzib,bc='n') + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + n12 = -n12/buf + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + end if + + ! Loop over nearest cells + do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 + do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 + do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + v2=this%p(i2)%vel + w2=this%p(i2)%angVel + d2=this%p(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + v2=this%g(i2)%vel + w2=this%g(i2)%angVel + d2=this%g(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + end if + + ! Compute relative information + d12=norm2(r1-r2) + if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision + n12=(r2-r1)/d12 + v12=v1-v2 + rnv=dot_product(v12,n12) + r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) + delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + m12=m1*m2/(m1+m2) + k_n=m12*k_coeff + eta_n=m12*eta_coeff + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + ! Add up the collisions + this%ncol=this%ncol+1 + end if + + end do + + end do + end do + end do + + ! Deal with dimensionality + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if + + end do collision + + ! Determine total number of collisions + call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 + + end block collision_force + + end subroutine collide + !> Advance the particle equations by a specified time step dt !> p%id=0 => no coll, no solve @@ -592,9 +636,9 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) @@ -606,6 +650,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz type(part) :: myp,pold ! Zero out source term arrays @@ -613,6 +658,23 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty if (present(srcV)) srcV=0.0_WP if (present(srcW)) srcW=0.0_WP if (present(srcE)) srcE=0.0_WP + + ! Get fluid stress + if (present(stress_x)) then + sx=stress_x + else + sx=0.0_WP + end if + if (present(stress_y)) then + sy=stress_y + else + sy=0.0_WP + end if + if (present(stress_z)) then + sz=stress_z + else + sz=0.0_WP + end if ! Zero out number of particles removed this%np_out=0 @@ -633,13 +695,12 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Particle moment of inertia per unit mass Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) - !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) myp%pos=pold%pos+0.5_WP*mydt*myp%vel myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) myp%pos=pold%pos+mydt*myp%vel myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip @@ -746,8 +807,6 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque fVF=1.0_WP-pVF ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Interpolate the fluid vorticity to the particle location if needed - !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) end block interpolate ! Compute acceleration due to drag @@ -781,18 +840,18 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque end block compute_drag ! Compute acceleration due to Saffman lift - compute_lift: block - use mathtools, only: Pi,cross_product - real(WP) :: omegag,Cl,Reg - if (this%use_lift) then - omegag=sqrt(sum(fvort**2)) - if (omegag.gt.0.0_WP) then - Reg = p%d**2*omegag*frho/fvisc - Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) - acc=acc+Cl*cross_product(fvel-p%vel,fvort) - end if - end if - end block compute_lift + !compute_lift: block + ! use mathtools, only: Pi,cross_product + ! real(WP) :: omegag,Cl,Reg + ! if (this%use_lift) then + ! omegag=sqrt(sum(fvort**2)) + ! if (omegag.gt.0.0_WP) then + ! Reg = p%d**2*omegag*frho/fvisc + ! Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) + ! acc=acc+Cl*cross_product(fvel-p%vel,fvort) + ! end if + ! end if + !end block compute_lift ! Compute fluid torque (assumed Stokes drag) compute_torque: block @@ -819,7 +878,7 @@ subroutine update_VF(this) ! Transfer particle volume do i=1,this%np_ ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle + if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle ! Transfer particle volume Vp=Pi/6.0_WP*this%p(i)%d**3 call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') @@ -934,22 +993,23 @@ end subroutine filter !> Inject particles from a prescribed location with given mass flowrate !> Requires injection parameters to be set beforehand - subroutine inject(this,dt) + subroutine inject(this,dt,avoid_overlap) use mpi_f08 use parallel, only: MPI_REAL_WP use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection - real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters - real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep - integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id + real(WP), intent(inout) :: dt !< Timestep size over which to advance + logical, intent(in), optional :: avoid_overlap !< Option to avoid overlap during injection + real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection + real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters + real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep + integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id integer :: i,j,np0_,np2,np_tmp,count,ierr integer, dimension(:), allocatable :: nrecv type(part), dimension(:), allocatable :: p2 type(MPI_Status) :: status - logical :: overlap + logical :: avoid_overlap_,overlap ! Initial number of particles np0_=this%np_ @@ -967,7 +1027,9 @@ subroutine inject(this,dt) call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) ! Communicate nearby particles to check for overlap - if (this%use_col) then + avoid_overlap_=.false. + if (present(avoid_overlap)) avoid_overlap_=avoid_overlap + if (avoid_overlap_) then allocate(nrecv(this%cfg%nproc)) count=0 inj_min(1)=this%cfg%x(this%cfg%imino) @@ -1036,7 +1098,7 @@ subroutine inject(this,dt) this%p(count)%pos=get_position() overlap=.false. ! Check overlap with particles recently injected - if (this%use_col) then + if (avoid_overlap_) then do j=1,np_tmp-1 if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. end do @@ -1139,13 +1201,14 @@ end subroutine inject !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) + subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX use parallel, only: MPI_REAL_WP implicit none class(lpt), intent(inout) :: this real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl + real(WP), intent(out) :: cflc + real(WP), optional :: cfl integer :: i,ierr real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col @@ -1165,15 +1228,15 @@ subroutine get_cfl(this,dt,cfl) call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) ! Return the maximum convective CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - if (this%use_col) then - my_CFL_col=10.0_WP*my_CFL_col*dt - call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - cfl = max(cfl,this%CFL_col) - else - this%CFL_col=0.0_WP - end if + cflc=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + ! Compute collision CFL + my_CFL_col=10.0_WP*my_CFL_col*dt + call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! If asked for, also return the maximum overall CFL + if (present(CFL)) cfl=max(cflc,this%CFL_col) + end subroutine get_cfl @@ -1242,7 +1305,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -1255,7 +1318,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/src/solver/Make.package b/src/solver/Make.package index 6fc6cc525..0e5511f99 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -3,7 +3,7 @@ ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif ifeq ($(USE_FFTW),TRUE) - f90EXE_sources += pfft3d_class.f90 + f90EXE_sources += fourier3d_class.f90 endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index b671d7f84..7f3a8b58d 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -1,1189 +1,1190 @@ !> Direct diagonal solvers defined here module diag_class - use precision, only: WP - use config_class, only: config - use string, only: str_medium - implicit none - private - - ! Expose type/constructor/methods - public :: diag - - !> diag object definition - type :: diag - ! Diagonalr solver works for a config - type(config), pointer :: cfg !< Config for the diag solver - character(len=str_medium) :: name !< Name of solver - integer :: ndiags !< Number of diagonals - real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays - real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays - real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays - + use precision, only: WP + use config_class, only: config + use string, only: str_medium + implicit none + private + + ! Expose type/constructor/methods + public :: diag + + !> diag object definition + type :: diag + ! Diagonal solver works for a config + type(config), pointer :: cfg !< Config for the diag solver + character(len=str_medium) :: name !< Name of solver + integer :: ndiags !< Number of diagonals + real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays + real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays + real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays contains - procedure :: linsol_x !< Linear solver in x - procedure :: linsol_y !< Linear solver in y - procedure :: linsol_z !< Linear solver in z - procedure :: tridiagonal - procedure :: pentadiagonal - procedure :: polydiagonal - final :: destructor !< Destructor for diag - end type diag - - !> Declare diag constructor - interface diag - procedure diag_from_args - end interface diag - + procedure :: linsol_x !< Linear solver in x + procedure :: linsol_y !< Linear solver in y + procedure :: linsol_z !< Linear solver in z + procedure :: tridiagonal + procedure :: pentadiagonal + procedure :: polydiagonal + final :: destructor !< Destructor for diag + end type diag + + !> Declare diag constructor + interface diag + procedure diag_from_args + end interface diag + contains - - !> Destructor for diag object - subroutine destructor(this) - implicit none - type(diag) :: this - if (allocated(this%Ax)) deallocate(this%Ax) - if (allocated(this%Ay)) deallocate(this%Ay) - if (allocated(this%Az)) deallocate(this%Az) - if (allocated(this%Rx)) deallocate(this%Rx) - if (allocated(this%Ry)) deallocate(this%Ry) - if (allocated(this%Rz)) deallocate(this%Rz) - if (allocated(this%stackmem)) deallocate(this%stackmem) - end subroutine destructor - - - !> Constructor for a diag object - function diag_from_args(cfg,name,n) result(self) - use messager, only: die - implicit none - type(diag) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - integer, intent(in) :: n - integer :: nst - - ! Link the config and store the name - self%cfg=>cfg - self%name=trim(adjustl(name)) - - ! Number of diagonals and stencil size - self%ndiags=n - nst=(n-1)/2 - - ! Allocate arrays - allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) - allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) - allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) - allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) - allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) - allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) - - end function diag_from_args - - - ! Real solver in x - subroutine linsol_x(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,& - -(this%ndiags-1)/2),this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) - end select - - return - end subroutine linsol_x - - - ! Real solver in y - subroutine linsol_y(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,& - -(this%ndiags-1)/2),this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) - end select - - return - end subroutine linsol_y - - - ! Real solver in z - subroutine linsol_z(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,& - -(this%ndiags-1)/2),this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) - end select - - return - end subroutine linsol_z - - - subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER - real(WP), dimension(lot,n) :: B ! DIAGONAL - real(WP), dimension(lot,n) :: C ! UPPER - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot) :: r1 - real(WP), dimension(lot) :: r2 - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:), allocatable :: sendbuf - real(WP), dimension(:,:,:), allocatable :: recvbuf1 - real(WP), dimension(:,:), allocatable :: recvbuf2 - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 - ! Stuff - integer :: i,igroup - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call tridiagonal_serial(A,B,C,R,n,lot) - else - call tridiagonal_periodic_serial(A,B,C,R,n,lot) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot*12*proc)) - allocate(recvbuf1(nlot,6,2*proc)) - allocate(recvbuf2(nlot,2*proc)) - - ! Initialize boundary values - s1(:,1) = a(:,1) - s2(:,n) = c(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(i) - do i=2,n - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - s1(:,i) = -s1(:,i-1)*const(:) - end do - - ! Backward elimination - ! Lower boundary in s2(i) - do i=n-1,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) - s2(:,i) = -s2(:,i+1)*const(:) - end do - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced pentadiagonal system - ! Use of pentadiagonal system is more robust than the - ! reordered (removes zeros) tridiagonal system - - ! Send rows of pentadiagonal system - ! (0, s1, b, 0, s2; r) - ! (s1, 0, b, s2, 0; r) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = ngroup(igroup) - - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) - - ! Clear unused values - nk = ngroup(nrank+1) - recvbuf1(nk+1:nlot, :, :) = 0.0_WP - recvbuf1(nk+1:nlot, 3, :) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - ! Store in buf to avoid creating a temporary array (there must be a better way to do this) - allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) - buf1=recvbuf1(:,1,2:2*proc-1) - buf2=recvbuf1(:,2,2:2*proc-1) - buf3=recvbuf1(:,3,2:2*proc-1) - buf4=recvbuf1(:,4,2:2*proc-1) - buf5=recvbuf1(:,5,2:2*proc-1) - buf6=recvbuf1(:,6,2:2*proc-1) - call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) - recvbuf1(:,1,2:2*proc-1)=buf1 - recvbuf1(:,2,2:2*proc-1)=buf2 - recvbuf1(:,3,2:2*proc-1)=buf3 - recvbuf1(:,4,2:2*proc-1)=buf4 - recvbuf1(:,5,2:2*proc-1)=buf5 - recvbuf1(:,6,2:2*proc-1)=buf6 - deallocate(buf1,buf2,buf3,buf4,buf5,buf6) - else - call pentadiagonal_periodic_serial(& - recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& - recvbuf1(:,4,:),recvbuf1(:,5,:),recvbuf1(:,6,:),& - 2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) - end if - - ! Move solution to first slot - do i=1,2*proc - recvbuf2(:,i) = recvbuf1(:,6,i) - end do - - ! Permute the order - do i=1,proc-1 - const(1:nlot) = recvbuf2(:,2*i) - recvbuf2(:,2*i) = recvbuf2(:,2*i+1) - recvbuf2(:,2*i+1) = const(1:nlot) - end do - - ! If periodic, don't forget the end points - if (nper) then - const(1:nlot) = recvbuf2(:,1) - recvbuf2(:,1) = recvbuf2(:,2*proc) - recvbuf2(:,2*proc) = const(1:nlot) - end if - - ! Scatter back the solution - call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - do i=1,n - r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) - end do - - deallocate(sendbuf) - deallocate(recvbuf2) - deallocate(recvbuf1) - deallocate(ngroup) - - return - end subroutine tridiagonal - - - !> TriDiagonal Solver - Serial Case - Periodic - subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - r = r/(a + b + c) - return - else if (n .eq. 2) then - ! Solve 2x2 system - c(:,1) = c(:,1) + a(:,1) - a(:,2) = a(:,2) + c(:,2) - const(:) = a(:,2)/b(:,1) - b(:,2) = b(:,2) - c(:,1)*const(:) - r(:,2) = r(:,2) - r(:,1)*const(:) - r(:,2) = r(:,2)/b(:,2) - r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) - return - end if - - ! Forward elimination - do i=2,n-2 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - ! Boundary is stored in a(i) - a(:,i) = -a(:,i-1)*const(:) - end do - i=n-1 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = c(:,i) - a(:,i-1)*const(:) - i=n - const(:) = a(:,i)/b(:,i-1) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = b(:,i) - a(:,i-1)*const(:) - - ! Backward elimination - do i=n-2,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - a(:,i) = a(:,i) - a(:,i+1)*const(:) - end do - - ! Eliminate oddball - const(:) = c(:,n)/b(:,1) - r(:,n) = r(:,n) - r(:,1)*const(:) - a(:,n) = a(:,n) - a(:,1)*const(:) - - ! Backward substitution - r(:,n) = r(:,n)/a(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) - end do - - return - end subroutine tridiagonal_periodic_serial - - - !> TriDiagonal Solver - Serial Case - Not Periodic - subroutine tridiagonal_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - ! Forward elimination - do i=2,n - const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - end do - - ! Back-substitution - r(:,n) = r(:,n)/b(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine tridiagonal_serial - - subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot,2) :: r1 - real(WP), dimension(lot,2) :: r2 - real(WP), dimension(lot,n,2) :: s1 - real(WP), dimension(lot,n,2) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:,:), allocatable :: sendbuf - real(WP), dimension(:,:), allocatable :: recvbuf - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:,:), allocatable :: AA - real(WP), dimension(:,:), allocatable :: swap - - ! Stuff - integer :: i,igroup,j,k,m - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call pentadiagonal_serial(A,B,C,D,E,R,n,lot) - else - call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot,24*proc)) - allocate(recvbuf(nlot,24*proc)) - - if (n > 1) then ! do normal stuff - - ! Initialize boundary values - s1(:,1,1) = a(:,1) - s1(:,1,2) = b(:,1) - s1(:,2,1) = 0.0_WP - s1(:,2,2) = a(:,2) - s2(:,n-1,1) = e(:,n-1) - s2(:,n-1,2) = 0.0_WP - s2(:,n,1) = d(:,n) - s2(:,n,2) = e(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(:,i,1:2) - do i=1,n-2 - ! Eliminate a(i+2) - const(:) = a(:,i+2)/c(:,i) - b(:,i+2) = b(:,i+2) - d(:,i)*const(:) - c(:,i+2) = c(:,i+2) - e(:,i)*const(:) - r(:,i+2) = r(:,i+2) - r(:,i)*const(:) - s1(:,i+2,1) = -s1(:,i,1)*const(:) - s1(:,i+2,2) = -s1(:,i,2)*const(:) - - ! Eliminate b(i+1) - const(:) = b(:,i+1)/c(:,i) - c(:,i+1) = c(:,i+1) - d(:,i)*const(:) - d(:,i+1) = d(:,i+1) - e(:,i)*const(:) - r(:,i+1) = r(:,i+1) - r(:,i)*const(:) - s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) - s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) - end do - ! Eliminate b(n) - const(:) = b(:,n)/c(:,n-1) - c(:,n) = c(:,n) - d(:,n-1)*const(:) - r(:,n) = r(:,n) - r(:,n-1)*const(:) - s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) - s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) - s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) - - ! Backward elimination - ! Lower boundary in s2(:,i,1:2) - do i=n,3,-1 - ! Eliminate e(i-2) - const(:) = e(:,i-2)/c(:,i) - r(:,i-2) = r(:,i-2) - r(:,i)*const(:) - s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) - s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) - s2(:,i-2,1) = -s2(:,i,1)*const(:) - s2(:,i-2,2) = -s2(:,i,2)*const(:) - - ! Eliminate d(i-1) - const(:) = d(:,i-1)/c(:,i) - r(:,i-1) = r(:,i-1) - r(:,i)*const(:) - s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) - s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) - s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) - s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) - end do - ! Eliminate d(1) - const(:) = d(:,1)/c(:,2) - r(:,1) = r(:,1) - r(:,2)*const(:) - s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) - s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) - s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) - s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) - - end if ! n > 1 - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced 11-diagonal system - ! Use of 11-diagonal system is more robust than the - ! reordered (removes zeros) 7-diagonal system - - ! Send rows of 11-diagonal system - ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) - ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) - ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) - ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) - ! For efficiency, only send non-zero elements - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - if (n > 1) then ! do normal stuff - - do i=1,2 - sendbuf(1:nk, L+0) = c(k1:k2, i) - sendbuf(1:nk, L+1) = r(k1:k2, i) - sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) - sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - sendbuf(1:nk, L+0) = s1(k1:k2, i,j) - sendbuf(1:nk, L+1) = s2(k1:k2, i,j) - sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) - sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) - L = L + 4 - end do - end do - - else ! n == 1 special case - - sendbuf(1:nk, L+0) = c(k1:k2, 1) - sendbuf(1:nk, L+1) = r(k1:k2, 1) - sendbuf(1:nk, L+2) = 1.0_WP - sendbuf(1:nk, L+3) = 0.0_WP - sendbuf(1:nk, L+4) = 1.0_WP - sendbuf(1:nk, L+5) = 0.0_WP - sendbuf(1:nk, L+6) = c(k1:k2, 1) - sendbuf(1:nk, L+7) = r(k1:k2, 1) - sendbuf(1:nk, L+8) = a(k1:k2, 1) - sendbuf(1:nk, L+9) = d(k1:k2, 1) - sendbuf(1:nk, L+10) = 0.0_WP - sendbuf(1:nk, L+11) = 0.0_WP - sendbuf(1:nk, L+12) = b(k1:k2, 1) - sendbuf(1:nk, L+13) = e(k1:k2, 1) - sendbuf(1:nk, L+14) = -1.0_WP - sendbuf(1:nk, L+15) = 0.0_WP - sendbuf(1:nk, L+16) = 0.0_WP - sendbuf(1:nk, L+17) = -1.0_WP - sendbuf(1:nk, L+18) = a(k1:k2, 1) - sendbuf(1:nk, L+19) = d(k1:k2, 1) - sendbuf(1:nk, L+20) = 0.0_WP - sendbuf(1:nk, L+21) = 0.0_WP - sendbuf(1:nk, L+22) = b(k1:k2, 1) - sendbuf(1:nk, L+23) = e(k1:k2, 1) - L = L + 24 - - end if - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) - - ! Build reduced matrix - allocate(AA(nlot, 4*proc, -5:5 + 1)) - AA = 0.0_WP - L = 1 - do k=1,proc - m = 4*(k-1) - - do i=1,2 - AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) - AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) - AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) - AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) - AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) - AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) - AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) - L = L + 4 - end do - end do - - end do - - ! Clear unused values - nk = ngroup(nrank+1) - AA(nk+1:nlot, :, :) = 0.0_WP - AA(nk+1:nlot, :, 0) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) - else - if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' - call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) - end if - - ! Move solution to beginning of recvbuf - recvbuf(:, 1:4*proc) = AA(:, :, 6) - deallocate(AA) - - ! Permute the order - allocate (swap(nlot,2)) - do i=1,proc-1 - swap(:,:) = recvbuf(:, 4*i-1:4*i) - recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) - recvbuf(:, 4*i+1:4*i+2) = swap(:,:) - end do - ! If periodic, don't forget the end points - if (nper) then - swap(:,:) = recvbuf(:, 4*proc-1:4*proc) - recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) - recvbuf(:, 1:2) = swap(:,:) - end if - deallocate (swap) - - ! Scatter back the solution - deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) - call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) - r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) - L = L + 4 - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - if (n > 1) then ! do normal stuff - - do j=1,2 - do i=1,n - r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) - end do - end do - r = r / c - - else ! n == 1 special case - - r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & - -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) - - end if - - deallocate(sendbuf) - deallocate(recvbuf) - deallocate(ngroup) - - return - end subroutine pentadiagonal - - - ! ================================================= ! - ! PentaDiagonal Solver - Serial Case - Not periodic ! - ! ================================================= ! - subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,1) = R(:,1)/C(:,1) - return - else if (n .eq. 2) then - ! Solve 2x2 system - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - end if - - ! Forward elimination - do i=1,n-2 - ! Eliminate A(2,i+1) - const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - - ! Eliminate A(1,i+2) - const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - end do - ! Eliminate A(2,n) - const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) - C(:,n) = C(:,n) - D(:,n-1)*const(:) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - - ! Back-substitution - R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) - R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine pentadiagonal_serial - - - - ! ============================================= ! - ! PentaDiagonal Solver - Serial Case - Periodic ! - ! ============================================= ! - subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) - return - else if (n .eq. 2) then - ! Solve 2x2 system - C(:,:) = C(:,:) + A(:,:) + E(:,:) - D(:,1) = D(:,1) + B(:,1) - B(:,2) = B(:,2) + D(:,2) - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - else if (n .eq. 3) then - B(:,:) = B(:,:) + E(:,:) - D(:,:) = D(:,:) + A(:,:) - call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) - return - else if (n .eq. 4) then - A(:,:) = A(:,:) + E(:,:) - E(:,:) = 0.0_WP - end if - - ! Initialize boundary data - s1 = 0.0_WP - s1(:,1) = A(:,1) - s1(:,n-3) = s1(:,n-3) + E(:,n-3) - s1(:,n-2) = D(:,n-2) - s1(:,n-1) = C(:,n-1) - s1(:,n) = B(:,n) - s2 = 0.0_WP - s2(:,1) = B(:,1) - s2(:,2) = A(:,2) - s2(:,n-2) = s2(:,n-2) + E(:,n-2) - s2(:,n-1) = D(:,n-1) - s2(:,n) = C(:,n) - - ! Forward elimination - do i=1,n-2 - ! Eliminate b(i+1) - const(:) = B(:,i+1)/C(:,i) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) - s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) - - ! Eliminate a(i+2) - const(:) = A(:,i+2)/C(:,i) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) - s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) - end do - - ! Backward elimination - do i=n-2,3,-1 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate e(i-2) - const(:) = E(:,i-2)/C(:,i) - R(:,i-2) = R(:,i-2) - R(:,i)*const(:) - s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) - s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) - end do - i=2 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate oddball region - const(:) = E(:,n-1)/C(:,1) - R(:,n-1) = R(:,n-1) - R(:,1)*const(:) - s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) - s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) - - const(:) = D(:,n)/C(:,1) - R(:,n) = R(:,n) - R(:,1)*const(:) - s1(:,n) = s1(:,n) - s1(:,1)*const(:) - s2(:,n) = s2(:,n) - s2(:,1)*const(:) - - const(:) = E(:,n)/C(:,2) - R(:,n) = R(:,n) - R(:,2)*const(:) - s1(:,n) = s1(:,n) - s1(:,2)*const(:) - s2(:,n) = s2(:,n) - s2(:,2)*const(:) - - ! Eliminate corner region - const(:) = s1(:,n)/s1(:,n-1) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) - - R(:,n) = R(:,n)/s2(:,n) - R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) - end do - - return - end subroutine pentadiagonal_periodic_serial - - - subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) - implicit none - class(diag), intent(inout) :: this - character(len=*), intent(in) :: dir - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - integer :: proc - logical :: nper - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc.eq.1) then - if (.not.nper) then - call polydiagonal_serial(nd,A,R,n,lot) - else - call polydiagonal_periodic_serial(nd,A,R,n,lot,b) - end if - return - else - stop 'polydiagonal: Implemented only in serial.' - end if - - return - end subroutine polydiagonal - - - subroutine polydiagonal_serial(nd,A,R,n,lot) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k - - ! Forward elimination - do i=1,n-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,n-i) - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,min(nd,n-i) - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Back-substitution - do i=n,1,-1 - do j=1,min(nd,n-i) - R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_serial - - - subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k,i0 - - if (n.eq.1) then - const(:) = 0.0_WP - do j=-nd,nd - const(:) = const(:) + A(:,j,1) - end do - R(:,1) = R(:,1) / const(:) - return - end if - - ! Setup bridge array - do j=1,nd - do i=1,n - b(:,i,j) = 0.0_WP - end do - end do - do i=1,nd - do j=i,nd - b(:,i,j) = A(:,i,-nd+j-i) - b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) - end do - end do - do i=n-nd+1,n - do j=1,nd - b(:,i,j) = A(:,i,-nd+j-(i-n)) - end do - end do - - ! Forward elimination - do i=1,n-nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,nd - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,nd - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Backward elimination - do i=n-nd,1,-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,i-1) - const(:) = A(:,i-j,j)*pivot(:) - do k=1,nd - b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) - end do - R(:,i-j) = R(:,i-j) - R(:,i)*const(:) - end do - end do - - ! Eliminate oddball region - do i=1,nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=i,nd - const(:) = A(:,n-j+i,j)*pivot(:) - do k=1,nd - b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) - end do - R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) - end do - end do - - ! Elimination for corner matrix - i0 = n-nd - do i=1,nd-1 - pivot(:) = 1.0_WP/b(:,i+i0,i) - do j=i+1,nd - const(:) = b(:,j+i0,i)*pivot(:) - do k=i+1,nd - b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) - end do - R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) - end do - end do - - ! Back-substitution for corner matrix - i0 = n-nd - do i=nd,1,-1 - do j=i+1,nd - R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) - end do - R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) - end do - - ! Back-substitution for bridge - do i=n-nd,1,-1 - do j=1,nd - R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_periodic_serial - - + + !> Destructor for diag object + subroutine destructor(this) + implicit none + type(diag) :: this + if (allocated(this%Ax)) deallocate(this%Ax) + if (allocated(this%Ay)) deallocate(this%Ay) + if (allocated(this%Az)) deallocate(this%Az) + if (allocated(this%Rx)) deallocate(this%Rx) + if (allocated(this%Ry)) deallocate(this%Ry) + if (allocated(this%Rz)) deallocate(this%Rz) + if (allocated(this%stackmem)) deallocate(this%stackmem) + end subroutine destructor + + + !> Constructor for a diag object + function diag_from_args(cfg,name,n) result(self) + use messager, only: die + implicit none + type(diag) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: n + integer :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Number of diagonals and stencil size + self%ndiags=n + nst=(n-1)/2 + + ! Allocate arrays + allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) + allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) + allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) + allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) + allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) + allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) + + end function diag_from_args + + + ! Real solver in x + subroutine linsol_x(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-(this%ndiags-1)/2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) + end select + + end subroutine linsol_x + + + ! Real solver in y + subroutine linsol_y(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-(this%ndiags-1)/2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) + end select + + end subroutine linsol_y + + + ! Real solver in z + subroutine linsol_z(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-(this%ndiags-1)/2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) + end select + + end subroutine linsol_z + + + subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER + real(WP), dimension(lot,n) :: B ! DIAGONAL + real(WP), dimension(lot,n) :: C ! UPPER + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot) :: r1 + real(WP), dimension(lot) :: r2 + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:), allocatable :: sendbuf + real(WP), dimension(:,:,:), allocatable :: recvbuf1 + real(WP), dimension(:,:), allocatable :: recvbuf2 + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 + ! Stuff + integer :: i,igroup + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call tridiagonal_serial(A,B,C,R,n,lot) + else + call tridiagonal_periodic_serial(A,B,C,R,n,lot) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot*12*proc)) + allocate(recvbuf1(nlot,6,2*proc)) + allocate(recvbuf2(nlot,2*proc)) + + ! Initialize boundary values + s1(:,1) = a(:,1) + s2(:,n) = c(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(i) + do i=2,n + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + s1(:,i) = -s1(:,i-1)*const(:) + end do + + ! Backward elimination + ! Lower boundary in s2(i) + do i=n-1,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) + s2(:,i) = -s2(:,i+1)*const(:) + end do + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced pentadiagonal system + ! Use of pentadiagonal system is more robust than the + ! reordered (removes zeros) tridiagonal system + + ! Send rows of pentadiagonal system + ! (0, s1, b, 0, s2; r) + ! (s1, 0, b, s2, 0; r) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = ngroup(igroup) + + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) + + ! Clear unused values + nk = ngroup(nrank+1) + recvbuf1(nk+1:nlot, :, :) = 0.0_WP + recvbuf1(nk+1:nlot, 3, :) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + ! Store in buf to avoid creating a temporary array (there must be a better way to do this) + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,2:2*proc-1) + buf2=recvbuf1(:,2,2:2*proc-1) + buf3=recvbuf1(:,3,2:2*proc-1) + buf4=recvbuf1(:,4,2:2*proc-1) + buf5=recvbuf1(:,5,2:2*proc-1) + buf6=recvbuf1(:,6,2:2*proc-1) + call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) + recvbuf1(:,1,2:2*proc-1)=buf1 + recvbuf1(:,2,2:2*proc-1)=buf2 + recvbuf1(:,3,2:2*proc-1)=buf3 + recvbuf1(:,4,2:2*proc-1)=buf4 + recvbuf1(:,5,2:2*proc-1)=buf5 + recvbuf1(:,6,2:2*proc-1)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + else + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,:) + buf2=recvbuf1(:,2,:) + buf3=recvbuf1(:,3,:) + buf4=recvbuf1(:,4,:) + buf5=recvbuf1(:,5,:) + buf6=recvbuf1(:,6,:) + call pentadiagonal_periodic_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) + recvbuf1(:,1,:)=buf1 + recvbuf1(:,2,:)=buf2 + recvbuf1(:,3,:)=buf3 + recvbuf1(:,4,:)=buf4 + recvbuf1(:,5,:)=buf5 + recvbuf1(:,6,:)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + end if + + ! Move solution to first slot + do i=1,2*proc + recvbuf2(:,i) = recvbuf1(:,6,i) + end do + + ! Permute the order + do i=1,proc-1 + const(1:nlot) = recvbuf2(:,2*i) + recvbuf2(:,2*i) = recvbuf2(:,2*i+1) + recvbuf2(:,2*i+1) = const(1:nlot) + end do + + ! If periodic, don't forget the end points + if (nper) then + const(1:nlot) = recvbuf2(:,1) + recvbuf2(:,1) = recvbuf2(:,2*proc) + recvbuf2(:,2*proc) = const(1:nlot) + end if + + ! Scatter back the solution + call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + do i=1,n + r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) + end do + + deallocate(sendbuf) + deallocate(recvbuf2) + deallocate(recvbuf1) + deallocate(ngroup) + + end subroutine tridiagonal + + + !> TriDiagonal Solver - Serial Case - Periodic + subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + r = r/(a + b + c) + return + else if (n .eq. 2) then + ! Solve 2x2 system + c(:,1) = c(:,1) + a(:,1) + a(:,2) = a(:,2) + c(:,2) + const(:) = a(:,2)/b(:,1) + b(:,2) = b(:,2) - c(:,1)*const(:) + r(:,2) = r(:,2) - r(:,1)*const(:) + r(:,2) = r(:,2)/b(:,2) + r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) + return + end if + + ! Forward elimination + do i=2,n-2 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + ! Boundary is stored in a(i) + a(:,i) = -a(:,i-1)*const(:) + end do + i=n-1 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = c(:,i) - a(:,i-1)*const(:) + i=n + const(:) = a(:,i)/b(:,i-1) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = b(:,i) - a(:,i-1)*const(:) + + ! Backward elimination + do i=n-2,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + a(:,i) = a(:,i) - a(:,i+1)*const(:) + end do + + ! Eliminate oddball + const(:) = c(:,n)/b(:,1) + r(:,n) = r(:,n) - r(:,1)*const(:) + a(:,n) = a(:,n) - a(:,1)*const(:) + + ! Backward substitution + r(:,n) = r(:,n)/a(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) + end do + + end subroutine tridiagonal_periodic_serial + + + !> TriDiagonal Solver - Serial Case - Not Periodic + subroutine tridiagonal_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + ! Forward elimination + do i=2,n + const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + end do + + ! Back-substitution + r(:,n) = r(:,n)/b(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) + end do + + end subroutine tridiagonal_serial + + + subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot,2) :: r1 + real(WP), dimension(lot,2) :: r2 + real(WP), dimension(lot,n,2) :: s1 + real(WP), dimension(lot,n,2) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:,:), allocatable :: sendbuf + real(WP), dimension(:,:), allocatable :: recvbuf + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:,:), allocatable :: AA + real(WP), dimension(:,:), allocatable :: swap + + ! Stuff + integer :: i,igroup,j,k,m + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call pentadiagonal_serial(A,B,C,D,E,R,n,lot) + else + call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot,24*proc)) + allocate(recvbuf(nlot,24*proc)) + + if (n > 1) then ! do normal stuff + + ! Initialize boundary values + s1(:,1,1) = a(:,1) + s1(:,1,2) = b(:,1) + s1(:,2,1) = 0.0_WP + s1(:,2,2) = a(:,2) + s2(:,n-1,1) = e(:,n-1) + s2(:,n-1,2) = 0.0_WP + s2(:,n,1) = d(:,n) + s2(:,n,2) = e(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(:,i,1:2) + do i=1,n-2 + ! Eliminate a(i+2) + const(:) = a(:,i+2)/c(:,i) + b(:,i+2) = b(:,i+2) - d(:,i)*const(:) + c(:,i+2) = c(:,i+2) - e(:,i)*const(:) + r(:,i+2) = r(:,i+2) - r(:,i)*const(:) + s1(:,i+2,1) = -s1(:,i,1)*const(:) + s1(:,i+2,2) = -s1(:,i,2)*const(:) + + ! Eliminate b(i+1) + const(:) = b(:,i+1)/c(:,i) + c(:,i+1) = c(:,i+1) - d(:,i)*const(:) + d(:,i+1) = d(:,i+1) - e(:,i)*const(:) + r(:,i+1) = r(:,i+1) - r(:,i)*const(:) + s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) + s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) + end do + ! Eliminate b(n) + const(:) = b(:,n)/c(:,n-1) + c(:,n) = c(:,n) - d(:,n-1)*const(:) + r(:,n) = r(:,n) - r(:,n-1)*const(:) + s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) + s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) + s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) + + ! Backward elimination + ! Lower boundary in s2(:,i,1:2) + do i=n,3,-1 + ! Eliminate e(i-2) + const(:) = e(:,i-2)/c(:,i) + r(:,i-2) = r(:,i-2) - r(:,i)*const(:) + s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) + s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) + s2(:,i-2,1) = -s2(:,i,1)*const(:) + s2(:,i-2,2) = -s2(:,i,2)*const(:) + + ! Eliminate d(i-1) + const(:) = d(:,i-1)/c(:,i) + r(:,i-1) = r(:,i-1) - r(:,i)*const(:) + s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) + s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) + s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) + s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) + end do + ! Eliminate d(1) + const(:) = d(:,1)/c(:,2) + r(:,1) = r(:,1) - r(:,2)*const(:) + s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) + s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) + s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) + s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) + + end if ! n > 1 + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced 11-diagonal system + ! Use of 11-diagonal system is more robust than the + ! reordered (removes zeros) 7-diagonal system + + ! Send rows of 11-diagonal system + ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) + ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) + ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) + ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) + ! For efficiency, only send non-zero elements + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + if (n > 1) then ! do normal stuff + + do i=1,2 + sendbuf(1:nk, L+0) = c(k1:k2, i) + sendbuf(1:nk, L+1) = r(k1:k2, i) + sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) + sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + sendbuf(1:nk, L+0) = s1(k1:k2, i,j) + sendbuf(1:nk, L+1) = s2(k1:k2, i,j) + sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) + sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) + L = L + 4 + end do + end do + + else ! n == 1 special case + + sendbuf(1:nk, L+0) = c(k1:k2, 1) + sendbuf(1:nk, L+1) = r(k1:k2, 1) + sendbuf(1:nk, L+2) = 1.0_WP + sendbuf(1:nk, L+3) = 0.0_WP + sendbuf(1:nk, L+4) = 1.0_WP + sendbuf(1:nk, L+5) = 0.0_WP + sendbuf(1:nk, L+6) = c(k1:k2, 1) + sendbuf(1:nk, L+7) = r(k1:k2, 1) + sendbuf(1:nk, L+8) = a(k1:k2, 1) + sendbuf(1:nk, L+9) = d(k1:k2, 1) + sendbuf(1:nk, L+10) = 0.0_WP + sendbuf(1:nk, L+11) = 0.0_WP + sendbuf(1:nk, L+12) = b(k1:k2, 1) + sendbuf(1:nk, L+13) = e(k1:k2, 1) + sendbuf(1:nk, L+14) = -1.0_WP + sendbuf(1:nk, L+15) = 0.0_WP + sendbuf(1:nk, L+16) = 0.0_WP + sendbuf(1:nk, L+17) = -1.0_WP + sendbuf(1:nk, L+18) = a(k1:k2, 1) + sendbuf(1:nk, L+19) = d(k1:k2, 1) + sendbuf(1:nk, L+20) = 0.0_WP + sendbuf(1:nk, L+21) = 0.0_WP + sendbuf(1:nk, L+22) = b(k1:k2, 1) + sendbuf(1:nk, L+23) = e(k1:k2, 1) + L = L + 24 + + end if + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) + + ! Build reduced matrix + allocate(AA(nlot, 4*proc, -5:5 + 1)) + AA = 0.0_WP + L = 1 + do k=1,proc + m = 4*(k-1) + + do i=1,2 + AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) + AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) + AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) + AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) + AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) + AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) + AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) + L = L + 4 + end do + end do + + end do + + ! Clear unused values + nk = ngroup(nrank+1) + AA(nk+1:nlot, :, :) = 0.0_WP + AA(nk+1:nlot, :, 0) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) + else + if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' + call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) + end if + + ! Move solution to beginning of recvbuf + recvbuf(:, 1:4*proc) = AA(:, :, 6) + deallocate(AA) + + ! Permute the order + allocate (swap(nlot,2)) + do i=1,proc-1 + swap(:,:) = recvbuf(:, 4*i-1:4*i) + recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) + recvbuf(:, 4*i+1:4*i+2) = swap(:,:) + end do + ! If periodic, don't forget the end points + if (nper) then + swap(:,:) = recvbuf(:, 4*proc-1:4*proc) + recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) + recvbuf(:, 1:2) = swap(:,:) + end if + deallocate (swap) + + ! Scatter back the solution + deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) + call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) + r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) + L = L + 4 + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + if (n > 1) then ! do normal stuff + + do j=1,2 + do i=1,n + r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) + end do + end do + r = r / c + + else ! n == 1 special case + + r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & + & -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) + + end if + + deallocate(sendbuf) + deallocate(recvbuf) + deallocate(ngroup) + + end subroutine pentadiagonal + + + ! ================================================= ! + ! PentaDiagonal Solver - Serial Case - Not periodic ! + ! ================================================= ! + subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,1) = R(:,1)/C(:,1) + return + else if (n .eq. 2) then + ! Solve 2x2 system + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + end if + + ! Forward elimination + do i=1,n-2 + ! Eliminate A(2,i+1) + const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + + ! Eliminate A(1,i+2) + const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + end do + ! Eliminate A(2,n) + const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) + C(:,n) = C(:,n) - D(:,n-1)*const(:) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + + ! Back-substitution + R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) + R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) + end do + + end subroutine pentadiagonal_serial + + + ! ============================================= ! + ! PentaDiagonal Solver - Serial Case - Periodic ! + ! ============================================= ! + subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) + return + else if (n .eq. 2) then + ! Solve 2x2 system + C(:,:) = C(:,:) + A(:,:) + E(:,:) + D(:,1) = D(:,1) + B(:,1) + B(:,2) = B(:,2) + D(:,2) + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + else if (n .eq. 3) then + B(:,:) = B(:,:) + E(:,:) + D(:,:) = D(:,:) + A(:,:) + call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) + return + else if (n .eq. 4) then + A(:,:) = A(:,:) + E(:,:) + E(:,:) = 0.0_WP + end if + + ! Initialize boundary data + s1 = 0.0_WP + s1(:,1) = A(:,1) + s1(:,n-3) = s1(:,n-3) + E(:,n-3) + s1(:,n-2) = D(:,n-2) + s1(:,n-1) = C(:,n-1) + s1(:,n) = B(:,n) + s2 = 0.0_WP + s2(:,1) = B(:,1) + s2(:,2) = A(:,2) + s2(:,n-2) = s2(:,n-2) + E(:,n-2) + s2(:,n-1) = D(:,n-1) + s2(:,n) = C(:,n) + + ! Forward elimination + do i=1,n-2 + ! Eliminate b(i+1) + const(:) = B(:,i+1)/C(:,i) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) + s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) + + ! Eliminate a(i+2) + const(:) = A(:,i+2)/C(:,i) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) + s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) + end do + + ! Backward elimination + do i=n-2,3,-1 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate e(i-2) + const(:) = E(:,i-2)/C(:,i) + R(:,i-2) = R(:,i-2) - R(:,i)*const(:) + s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) + s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) + end do + i=2 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate oddball region + const(:) = E(:,n-1)/C(:,1) + R(:,n-1) = R(:,n-1) - R(:,1)*const(:) + s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) + s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) + + const(:) = D(:,n)/C(:,1) + R(:,n) = R(:,n) - R(:,1)*const(:) + s1(:,n) = s1(:,n) - s1(:,1)*const(:) + s2(:,n) = s2(:,n) - s2(:,1)*const(:) + + const(:) = E(:,n)/C(:,2) + R(:,n) = R(:,n) - R(:,2)*const(:) + s1(:,n) = s1(:,n) - s1(:,2)*const(:) + s2(:,n) = s2(:,n) - s2(:,2)*const(:) + + ! Eliminate corner region + const(:) = s1(:,n)/s1(:,n-1) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) + + R(:,n) = R(:,n)/s2(:,n) + R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) + end do + + end subroutine pentadiagonal_periodic_serial + + + subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) + implicit none + class(diag), intent(inout) :: this + character(len=*), intent(in) :: dir + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + integer :: proc + logical :: nper + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc.eq.1) then + if (.not.nper) then + call polydiagonal_serial(nd,A,R,n,lot) + else + call polydiagonal_periodic_serial(nd,A,R,n,lot,b) + end if + return + else + stop 'polydiagonal: Implemented only in serial.' + end if + + end subroutine polydiagonal + + + subroutine polydiagonal_serial(nd,A,R,n,lot) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k + + ! Forward elimination + do i=1,n-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,n-i) + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,min(nd,n-i) + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Back-substitution + do i=n,1,-1 + do j=1,min(nd,n-i) + R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_serial + + + subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k,i0 + + if (n.eq.1) then + const(:) = 0.0_WP + do j=-nd,nd + const(:) = const(:) + A(:,j,1) + end do + R(:,1) = R(:,1) / const(:) + return + end if + + ! Setup bridge array + do j=1,nd + do i=1,n + b(:,i,j) = 0.0_WP + end do + end do + do i=1,nd + do j=i,nd + b(:,i,j) = A(:,i,-nd+j-i) + b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) + end do + end do + do i=n-nd+1,n + do j=1,nd + b(:,i,j) = A(:,i,-nd+j-(i-n)) + end do + end do + + ! Forward elimination + do i=1,n-nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,nd + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,nd + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Backward elimination + do i=n-nd,1,-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,i-1) + const(:) = A(:,i-j,j)*pivot(:) + do k=1,nd + b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) + end do + R(:,i-j) = R(:,i-j) - R(:,i)*const(:) + end do + end do + + ! Eliminate oddball region + do i=1,nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=i,nd + const(:) = A(:,n-j+i,j)*pivot(:) + do k=1,nd + b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) + end do + R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) + end do + end do + + ! Elimination for corner matrix + i0 = n-nd + do i=1,nd-1 + pivot(:) = 1.0_WP/b(:,i+i0,i) + do j=i+1,nd + const(:) = b(:,j+i0,i)*pivot(:) + do k=i+1,nd + b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) + end do + R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) + end do + end do + + ! Back-substitution for corner matrix + i0 = n-nd + do i=nd,1,-1 + do j=i+1,nd + R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) + end do + R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) + end do + + ! Back-substitution for bridge + do i=n-nd,1,-1 + do j=1,nd + R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_periodic_serial + + end module diag_class diff --git a/src/solver/pfft3d_class.f90 b/src/solver/fourier3d_class.f90 similarity index 64% rename from src/solver/pfft3d_class.f90 rename to src/solver/fourier3d_class.f90 index 85605ba08..b8bc1d930 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/fourier3d_class.f90 @@ -1,8 +1,8 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -! Based on serial FFTW here, and manual transpose. It'd be nice to switch to a library -module pfft3d_class +!> Makes use of FFTW and in-house parallel transpose operations +module fourier3d_class use precision, only: WP use config_class, only: config use string, only: str_short @@ -13,98 +13,106 @@ module pfft3d_class ! Expose type/constructor/methods - public :: pfft3d + public :: fourier3d - !> pfft3d object definition - type, extends(linsol) :: pfft3d + !> fourier3d object definition + type, extends(linsol) :: fourier3d ! FFT's oddball logical :: oddball ! Data storage for FFTW plans - real(C_DOUBLE), dimension(:), allocatable :: in_x,out_x - real(C_DOUBLE), dimension(:), allocatable :: in_y,out_y - real(C_DOUBLE), dimension(:), allocatable :: in_z,out_z + complex(WP), dimension(:), allocatable :: in_x,out_x + complex(WP), dimension(:), allocatable :: in_y,out_y + complex(WP), dimension(:), allocatable :: in_z,out_z ! FFTW plans type(C_PTR) :: fplan_x,bplan_x type(C_PTR) :: fplan_y,bplan_y type(C_PTR) :: fplan_z,bplan_z + !> Unstrided arrays + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs + ! Storage for transposed data - real(WP), dimension(:,:,:), allocatable :: xtrans - real(WP), dimension(:,:,:), allocatable :: ytrans - real(WP), dimension(:,:,:), allocatable :: ztrans + complex(WP), dimension(:,:,:), allocatable :: xtrans + complex(WP), dimension(:,:,:), allocatable :: ytrans + complex(WP), dimension(:,:,:), allocatable :: ztrans ! Transpose partition - X integer, dimension(:), allocatable :: imin_x,imax_x integer, dimension(:), allocatable :: jmin_x,jmax_x integer, dimension(:), allocatable :: kmin_x,kmax_x integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x integer :: sendcount_x,recvcount_x character(len=str_short) :: xdir - + ! Transpose partition - Y integer, dimension(:), allocatable :: imin_y,imax_y integer, dimension(:), allocatable :: jmin_y,jmax_y integer, dimension(:), allocatable :: kmin_y,kmax_y integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y integer :: sendcount_y,recvcount_y character(len=str_short) :: ydir - + ! Transpose partition - Z integer, dimension(:), allocatable :: imin_z,imax_z integer, dimension(:), allocatable :: jmin_z,jmax_z integer, dimension(:), allocatable :: kmin_z,kmax_z integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z integer :: sendcount_z,recvcount_z character(len=str_short) :: zdir contains - procedure :: print_short=>pfft3d_print_short !< One-line printing of solver status - procedure :: print=>pfft3d_print !< Long-form printing of solver status - procedure :: log=>pfft3d_log !< Long-form logging of solver status - procedure :: init=>pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup=>pfft3d_setup !< Solver setup (every time the operator changes) - procedure :: solve=>pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy=>pfft3d_destroy !< Solver destruction (every time the operator changes) + procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status + procedure :: print=>fourier3d_print !< Long-form printing of solver status + procedure :: log=>fourier3d_log !< Long-form logging of solver status + procedure :: init=>fourier3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>fourier3d_setup !< Solver setup (every time the operator changes) + procedure :: solve=>fourier3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>fourier3d_destroy !< Solver destruction (every time the operator changes) - procedure, private :: pfft3d_xtranspose_init - procedure, private :: pfft3d_ytranspose_init - procedure, private :: pfft3d_ztranspose_init + procedure, private :: fourier3d_fourier_transform + procedure, private :: fourier3d_inverse_transform + + procedure, private :: fourier3d_xtranspose_init + procedure, private :: fourier3d_ytranspose_init + procedure, private :: fourier3d_ztranspose_init - procedure, private :: pfft3d_xtranspose_forward - procedure, private :: pfft3d_ytranspose_forward - procedure, private :: pfft3d_ztranspose_forward + procedure, private :: fourier3d_xtranspose_forward + procedure, private :: fourier3d_ytranspose_forward + procedure, private :: fourier3d_ztranspose_forward - procedure, private :: pfft3d_xtranspose_backward - procedure, private :: pfft3d_ytranspose_backward - procedure, private :: pfft3d_ztranspose_backward + procedure, private :: fourier3d_xtranspose_backward + procedure, private :: fourier3d_ytranspose_backward + procedure, private :: fourier3d_ztranspose_backward - end type pfft3d + end type fourier3d - !> Declare pfft3d constructor - interface pfft3d - procedure pfft3d_from_args - end interface pfft3d + !> Declare fourier3d constructor + interface fourier3d + procedure fourier3d_from_args + end interface fourier3d contains - !> Constructor for an pfft3d object - function pfft3d_from_args(cfg,name) result(self) + !> Constructor for a fourier3d object + function fourier3d_from_args(cfg,name,nst) result(self) use messager, only: die implicit none - type(pfft3d) :: self + type(fourier3d) :: self class(config), target, intent(in) :: cfg character(len=*), intent(in) :: name + integer, intent(in) :: nst ! Link the config and store the name self%cfg=>cfg @@ -114,7 +122,7 @@ function pfft3d_from_args(cfg,name) result(self) self%method=0 ! Set up stencil size and map - self%nst=7 + self%nst=nst allocate(self%stc(1:self%nst,1:3)) self%stc=0 @@ -124,10 +132,14 @@ function pfft3d_from_args(cfg,name) result(self) allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP ! Zero out some info - self%it=0 + self%it=1 self%aerr=0.0_WP self%rerr=0.0_WP + ! Allocate unstrided arrays + allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%transformed_rhs (self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + ! Setup is not done self%setup_done=.false. @@ -135,9 +147,9 @@ function pfft3d_from_args(cfg,name) result(self) check_solver_is_useable: block integer :: ndim,ndcp ! Periodicity and uniformity of mesh - if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') - if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') - if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') + if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[fourier3d constructor] Need x-direction needs to be periodic and uniform') + if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[fourier3d constructor] Need y-direction needs to be periodic and uniform') + if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[fourier3d constructor] Need z-direction needs to be periodic and uniform') ! Ensure that we have at least one non-decomposed direction ndim=0 if (self%cfg%nx.gt.1) ndim=ndim+1 @@ -147,19 +159,19 @@ function pfft3d_from_args(cfg,name) result(self) if (self%cfg%npx.gt.1) ndcp=ndcp+1 if (self%cfg%npy.gt.1) ndcp=ndcp+1 if (self%cfg%npz.gt.1) ndcp=ndcp+1 - if (ndcp.ge.ndim) call die('[pfft3d constructor] Need at least one NON-decomposed direction') + if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one NON-decomposed direction') end block check_solver_is_useable - end function pfft3d_from_args + end function fourier3d_from_args !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver !> Only the stencil needs to be defined at this point - subroutine pfft3d_init(this) + subroutine fourier3d_init(this) use messager, only: die implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 integer, dimension(3) :: periodicity,offset include 'fftw3.f03' @@ -175,40 +187,40 @@ subroutine pfft3d_init(this) ! Initialize transpose and FFTW plans in x if (this%cfg%nx.gt.1) then - call this%pfft3d_xtranspose_init() + call this%fourier3d_xtranspose_init() allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) - this%fplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_R2HC,FFTW_MEASURE) - this%bplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_HC2R,FFTW_MEASURE) + this%fplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) end if ! Initialize transpose and FFTW plans in y if (this%cfg%ny.gt.1) then - call this%pfft3d_ytranspose_init() + call this%fourier3d_ytranspose_init() allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) - this%fplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_R2HC,FFTW_MEASURE) - this%bplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_HC2R,FFTW_MEASURE) + this%fplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) end if ! Initialize transpose and FFTW plans in z if (this%cfg%nz.gt.1) then - call this%pfft3d_ztranspose_init() + call this%fourier3d_ztranspose_init() allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) - this%fplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_R2HC,FFTW_MEASURE) - this%bplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_HC2R,FFTW_MEASURE) + this%fplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) end if ! Find who owns the oddball this%oddball=.false. if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. - end subroutine pfft3d_init + end subroutine fourier3d_init !> Initialize transpose tool in x - subroutine pfft3d_xtranspose_init(this) + subroutine fourier3d_xtranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,ip,q,r ! Determine non-decomposed direction to use for transpose @@ -319,14 +331,14 @@ subroutine pfft3d_xtranspose_init(this) ! Allocate storage allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - end subroutine pfft3d_xtranspose_init + end subroutine fourier3d_xtranspose_init !> Initialize transpose tool in y - subroutine pfft3d_ytranspose_init(this) + subroutine fourier3d_ytranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,jp,q,r ! Determine non-decomposed direction to use for transpose @@ -437,14 +449,14 @@ subroutine pfft3d_ytranspose_init(this) ! Allocate storage allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - end subroutine pfft3d_ytranspose_init + end subroutine fourier3d_ytranspose_init !> Initialize transpose tool in z - subroutine pfft3d_ztranspose_init(this) + subroutine fourier3d_ztranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,kp,q,r ! Determine non-decomposed direction to use for transpose @@ -555,17 +567,17 @@ subroutine pfft3d_ztranspose_init(this) ! Allocate storage allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - end subroutine pfft3d_ztranspose_init + end subroutine fourier3d_ztranspose_init !> Perform forward transpose in x - subroutine pfft3d_xtranspose_forward(this,A,At) + subroutine fourier3d_xtranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -585,7 +597,7 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) @@ -610,7 +622,7 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -624,17 +636,17 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end select - end subroutine pfft3d_xtranspose_forward + end subroutine fourier3d_xtranspose_forward !> Perform forward transpose in y - subroutine pfft3d_ytranspose_forward(this,A,At) + subroutine fourier3d_ytranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -651,7 +663,7 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_y(jp),this%jmax_y(jp) @@ -679,7 +691,7 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) do j=this%jmin_y(jp),this%jmax_y(jp) @@ -693,17 +705,17 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end select - end subroutine pfft3d_ytranspose_forward + end subroutine fourier3d_ytranspose_forward !> Perform forward transpose in z - subroutine pfft3d_ztranspose_forward(this,A,At) + subroutine fourier3d_ztranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -720,7 +732,7 @@ subroutine pfft3d_ztranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(kp),this%kmax_z(kp) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -745,7 +757,7 @@ subroutine pfft3d_ztranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(kp),this%kmax_z(kp) do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) @@ -762,17 +774,17 @@ subroutine pfft3d_ztranspose_forward(this,A,At) At=A end select - end subroutine pfft3d_ztranspose_forward + end subroutine fourier3d_ztranspose_forward !> Perform backward transpose in x - subroutine pfft3d_xtranspose_backward(this,At,A) + subroutine fourier3d_xtranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -792,7 +804,7 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_x(ip),this%jmax_x(ip) @@ -817,7 +829,7 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%kmin_x(ip),this%kmax_x(ip) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -831,17 +843,17 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end select - end subroutine pfft3d_xtranspose_backward - + end subroutine fourier3d_xtranspose_backward + !> Perform backward transpose in y - subroutine pfft3d_ytranspose_backward(this,At,A) + subroutine fourier3d_ytranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -858,7 +870,7 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) @@ -886,7 +898,7 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%kmin_y(jp),this%kmax_y(jp) do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) @@ -900,17 +912,17 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end select - end subroutine pfft3d_ytranspose_backward + end subroutine fourier3d_ytranspose_backward !> Perform backward transpose in z - subroutine pfft3d_ztranspose_backward(this,At,A) + subroutine fourier3d_ztranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -927,7 +939,7 @@ subroutine pfft3d_ztranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -952,7 +964,7 @@ subroutine pfft3d_ztranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) do j=this%jmin_z(kp),this%jmax_z(kp) @@ -969,44 +981,216 @@ subroutine pfft3d_ztranspose_backward(this,At,A) A=At end select - end subroutine pfft3d_ztranspose_backward + end subroutine fourier3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine fourier3d_fourier_transform(this,A) + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Forward transform - X + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x + end do + end do + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Forward transform - Y + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y + end do + end do + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Forward transform - Z + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + + ! Oddball + if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP + + end subroutine fourier3d_fourier_transform - !> Setup solver - done everytime the operator changes - subroutine pfft3d_setup(this) + !> FFT -> real and transpose back + subroutine fourier3d_inverse_transform(this,A) + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Inverse transform + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x/this%cfg%nx + end do + end do + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Inverse transform + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y/this%cfg%ny + end do + end do + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Inverse transform + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z/this%cfg%nz + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + +end subroutine fourier3d_inverse_transform + + +!> Setup solver - done everytime the operator changes + subroutine fourier3d_setup(this) use messager, only: die + use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM + use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - integer :: i,j,k,st,ierr - integer, dimension(:), allocatable :: row - real(WP), dimension(:), allocatable :: val + class(fourier3d), intent(inout) :: this + real(WP), dimension(1:this%nst) :: ref_opr + logical :: circulant + integer :: i,j,k,n,ierr ! If the solver has already been setup, destroy it first if (this%setup_done) call this%destroy() + ! Check circulent operator + if (this%cfg%amRoot) ref_opr=this%opr(:,this%cfg%imin,this%cfg%jmin,this%cfg%kmin) + call MPI_BCAST(ref_opr,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) + circulant=.true. + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (any(abs(this%opr(:,i,j,k)-ref_opr).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulant=.false. + end do + end do + end do + if (.not.circulant) call die('[fourier3d setup] operator must be uniform in space') + + ! Build the operator + this%factored_operator=0.0_WP + do n=1,this%nst + i=modulo(this%stc(n,1)-this%cfg%imin+1,this%cfg%nx)+this%cfg%imin + j=modulo(this%stc(n,2)-this%cfg%jmin+1,this%cfg%ny)+this%cfg%jmin + k=modulo(this%stc(n,3)-this%cfg%kmin+1,this%cfg%nz)+this%cfg%kmin + if (this%cfg%imin_.le.i.and.i.le.this%cfg%imax_.and.& + & this%cfg%jmin_.le.j.and.j.le.this%cfg%jmax_.and.& + & this%cfg%kmin_.le.k.and.k.le.this%cfg%kmax_) this%factored_operator(i,j,k)=this%factored_operator(i,j,k)+real(ref_opr(n),WP) + end do + + ! Take transform of operator + call this%fourier3d_fourier_transform(this%factored_operator) + ! Make zero wavenumber not zero + ! Setting this to one has the nice side effect of returning a solution with the same integral + if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=1.0_C_DOUBLE + + ! Make sure other wavenumbers are not close to zero + i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_WP)) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) then + print*,j + call die('[fourier3d setup] elements of transformed operator near zero') + end if + + ! Divide now instead of later + this%factored_operator=1.0_WP/this%factored_operator + + ! Check for division issues + i=count(isnan(abs(this%factored_operator))) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) call die('[fourier3d setup] elements of transformed operator are NaN') ! Set setup-flag to true this%setup_done=.true. - end subroutine pfft3d_setup + end subroutine fourier3d_setup !> Solve the linear system iteratively - subroutine pfft3d_solve(this) + subroutine fourier3d_solve(this) use messager, only: die use param, only: verbose implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: i,j,k,ierr ! Check that setup was done - if (.not.this%setup_done) call die('[pfft3d solve] Solver has not been setup.') + if (.not.this%setup_done) call die('[fourier3d solve] Solver has not been setup.') - ! Set solver it and err to standard values - this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + ! Copy to unstrided array + this%transformed_rhs=this%rhs(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) + ! Forward transform + call this%fourier3d_fourier_transform(this%transformed_rhs) + ! Divide + this%transformed_rhs=this%transformed_rhs*this%factored_operator + + ! Backward transform + call this%fourier3d_inverse_transform(this%transformed_rhs) + + ! Copy to strided output + this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs ! Sync the solution vector call this%cfg%sync(this%sol) @@ -1015,56 +1199,59 @@ subroutine pfft3d_solve(this) if (verbose.gt.0) call this%log if (verbose.gt.1) call this%print_short - end subroutine pfft3d_solve + end subroutine fourier3d_solve !> Destroy solver - done everytime the operator changes - subroutine pfft3d_destroy(this) + subroutine fourier3d_destroy(this) use messager, only: die implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr + include 'fftw3.f03' - ! Destroy solver, operator, and rhs/sol vectors - + ! Destroy our plans + call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x) + call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y) + call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z) ! Set setup-flag to false this%setup_done=.false. - end subroutine pfft3d_destroy + end subroutine fourier3d_destroy - !> Log pfft3d info - subroutine pfft3d_log(this) + !> Log fourier3d info + subroutine fourier3d_log(this) use string, only: str_long use messager, only: log implicit none - class(pfft3d), intent(in) :: this + class(fourier3d), intent(in) :: this character(len=str_long) :: message if (this%cfg%amRoot) then - write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + write(message,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) end if - end subroutine pfft3d_log + end subroutine fourier3d_log - !> Print pfft3d info to the screen - subroutine pfft3d_print(this) + !> Print fourier3d info to the screen + subroutine fourier3d_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(pfft3d), intent(in) :: this + class(fourier3d), intent(in) :: this if (this%cfg%amRoot) then - write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) end if - end subroutine pfft3d_print + end subroutine fourier3d_print - !> Short print of pfft3d info to the screen - subroutine pfft3d_print_short(this) + !> Short print of fourier3d info to the screen + subroutine fourier3d_print_short(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - end subroutine pfft3d_print_short + class(fourier3d), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("fourier3d solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + end subroutine fourier3d_print_short -end module pfft3d_class +end module fourier3d_class diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index 86a74c310..4fdf728c6 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -26,7 +26,7 @@ module sgsmodel_class integer :: imax_in,jmax_in,kmax_in !< Safe max in each direction ! Some clipping parameters - real(WP) :: Cs_ref=0.1_WP + real(WP) :: Cs_ref=0.17_WP ! LM and MM tensor norms and eddy viscosity real(WP), dimension(:,:,:), allocatable :: LM,MM !< LM and MM tensor norms @@ -413,7 +413,6 @@ subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) else Cs=0.0_WP end if - Cs = this%Cs_ref this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*Cs*this%delta(i,j,k)**2 end do end do @@ -444,7 +443,7 @@ subroutine visc_cst(this,rho,SR) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref*this%delta(i,j,k)**2 + this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*(this%Cs_ref*this%delta(i,j,k))**2 end do end do end do @@ -463,33 +462,41 @@ subroutine visc_vreman(this,rho,gradu) implicit none class(sgsmodel), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient - real(WP), dimension(:,:,:), allocatable :: alph2 !< velocity gradient tensor squared - real(WP) :: C,B,beta11,beta22,beta33,beta12,beta13,beta23 - integer :: i,j,k - - allocate(alph2(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - alph2 = gradu(1,1,:,:,:)**2 + gradu(1,2,:,:,:)**2 + gradu(1,3,:,:,:)**2 + & - & gradu(2,1,:,:,:)**2 + gradu(2,2,:,:,:)**2 + gradu(2,3,:,:,:)**2 + & - & gradu(3,1,:,:,:)**2 + gradu(3,2,:,:,:)**2 + gradu(3,3,:,:,:)**2 - - ! Model constant - FOR HIT c \approx 0.07 - ! For complex flows c = 2.5*Cs**2 - C = 2.5_WP*this%Cs_ref**2 + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient + real(WP) :: A,B,C + real(WP), dimension(1:3,1:3) :: beta + integer :: i,j,k,ii,jj + + ! Model constant is c=2.5*Cs_ref**2 + ! Vreman uses c=0.07 which corresponds to Cs_ref=0.17 + C=2.5_WP*this%Cs_ref**2 ! Compute the eddy viscosity do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - beta11 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)**2 + gradu(2,1,i,j,k)**2 + gradu(3,1,i,j,k)**2) - beta22 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)**2 + gradu(2,2,i,j,k)**2 + gradu(3,2,i,j,k)**2) - beta33 = this%delta(i,j,k)**2*(gradu(1,3,i,j,k)**2 + gradu(2,3,i,j,k)**2 + gradu(3,3,i,j,k)**2) - beta12 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,2,i,j,k) + gradu(2,1,i,j,k)*gradu(2,2,i,j,k) + gradu(3,1,i,j,k)*gradu(3,2,i,j,k)) - beta13 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,3,i,j,k) + gradu(2,1,i,j,k)*gradu(2,3,i,j,k) + gradu(3,1,i,j,k)*gradu(3,3,i,j,k)) - beta23 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)*gradu(1,3,i,j,k) + gradu(2,2,i,j,k)*gradu(2,3,i,j,k) + gradu(3,2,i,j,k)*gradu(3,3,i,j,k)) - - B = beta11*beta22 - beta12**2 + beta11*beta33 - beta13**2 + beta22*beta33 - beta23**2 - this%visc(i,j,k) = C*sqrt(B/alph2(i,j,k)) + ! Compute A=gradu_ij*gradu_ij invariant + A=gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2+& + & gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2+& + & gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2 + ! Compute beta_ij=dx_m*dx_m*gradu_mi*gradu_mj + do jj=1,3 + do ii=1,3 + beta(ii,jj)=this%cfg%dx(i)**2*gradu(1,ii,i,j,k)*gradu(1,jj,i,j,k)& + & +this%cfg%dy(j)**2*gradu(2,ii,i,j,k)*gradu(2,jj,i,j,k)& + & +this%cfg%dz(k)**2*gradu(3,ii,i,j,k)*gradu(3,jj,i,j,k) + end do + end do + ! Compute B invariant + B=beta(1,1)*beta(2,2)-beta(1,2)**2& + &+beta(1,1)*beta(3,3)-beta(1,3)**2& + &+beta(2,2)*beta(3,3)-beta(2,3)**2 + ! Assemble algebraic eddy viscosity model + if (B.lt.1.0e-8_WP) then + this%visc(i,j,k)=0.0_WP + else + this%visc(i,j,k)=rho(i,j,k)*C*sqrt(B/A) + end if end do end do end do @@ -497,9 +504,6 @@ subroutine visc_vreman(this,rho,gradu) ! Synchronize visc call this%cfg%sync(this%visc) - ! Deallocate work arrays - deallocate(alph2) - end subroutine visc_vreman diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index dd4d1dce4..4d106e6f7 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -115,6 +115,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture + ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays @@ -2526,100 +2527,100 @@ end subroutine calculate_ustar end subroutine advection_step subroutine diffusion_src_explicit_step(this,dt,vf,matmod,sgs_visc,srcU,srcV,srcW,srcE) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - use vfs_class, only: vfs - use matm_class, only: matm - implicit none - class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver - class(vfs), intent(inout) :: vf !< The volume fraction solver - class(matm), intent(inout) :: matmod !< The material models for this solver - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT - real(WP), intent(in) :: dt !< Timestep size over which to advance - real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep - real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces - integer :: i,j,k,n,nCFL,ierr - real(WP) :: buf,myCFL,mydt,spec_heat - - ! Set up intermediate divergence - div =>this%tmp1 - ! Set up temporary face velocity - Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 - Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 - ! Set up face viscosities - visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 - - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Viscosity and thermal conductivity updated using new temperature and VOF - call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - - ! Estimate CFL from explicit diffusive and source terms - buf=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - ! Viscous CFL - buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) - spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & - +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) - buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) - ! Gravity CFL (check this) - buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & - dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & - dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) - end do - end do - end do - call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Calculate sub-step for viscous solver - nCFL=ceiling(myCFL) - mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon - - ! Sub-step for stability - do n=1,nCFL - ! Perform viscous step - call diffusion_src_explicit_substep() - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Calculate viscosity - if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - end do - - ! Nullify... - -contains - - subroutine diffusion_src_explicit_substep() + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + use vfs_class, only: vfs + use matm_class, only: matm implicit none + class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver + class(vfs), intent(inout) :: vf !< The volume fraction solver + class(matm), intent(inout) :: matmod !< The material models for this solver + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep + real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces + integer :: i,j,k,n,nCFL,ierr + real(WP) :: buf,myCFL,mydt,spec_heat - real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX - real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy - real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz - real(WP) :: dMUdx,dMUdy,dMUdz - real(WP) :: div2U,div2V,div2W - real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + ! Set up intermediate divergence + div =>this%tmp1 + ! Set up temporary face velocity + Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 + Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 + ! Set up face viscosities + visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 - integer :: i,j,k,n + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Viscosity and thermal conductivity updated using new temperature and VOF + call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - ! Viscous routine operates on face velocities, need to be updated each time - ! Update traditional face velocity (just interpolated) - call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) - ! Apply boundary condtions - bc_scope = 'velocity' - call this%apply_bcond(dt,bc_scope) - ! Calculate other interpolated face velocities (ignore masks) - call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) - call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) - ! BCs not needed, masks are already addressed, nothing used from within boundary + ! Estimate CFL from explicit diffusive and source terms + buf=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Viscous CFL + buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) + spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & + & +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) + buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) + ! Gravity CFL (check this) + buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & + & dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & + & dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) + end do + end do + end do + call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Calculate sub-step for viscous solver + nCFL=ceiling(myCFL) + mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon + + ! Sub-step for stability + do n=1,nCFL + ! Perform viscous step + call diffusion_src_explicit_substep() + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Calculate viscosity + if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + end do + + ! Nullify... + + contains + + subroutine diffusion_src_explicit_substep() + implicit none + + real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX + real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy + real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz + real(WP) :: dMUdx,dMUdy,dMUdz + real(WP) :: div2U,div2V,div2W + real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + + integer :: i,j,k,n + + ! Viscous routine operates on face velocities, need to be updated each time + ! Update traditional face velocity (just interpolated) + call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) + ! Apply boundary condtions + bc_scope = 'velocity' + call this%apply_bcond(dt,bc_scope) + ! Calculate other interpolated face velocities (ignore masks) + call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) + call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) + ! BCs not needed, masks are already addressed, nothing used from within boundary ! Compute divergence and SGS isotropic tensor in each cell do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 6dc3b63ba..9eaf88f1a 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -7,7 +7,7 @@ module tpns_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -107,10 +107,10 @@ module tpns_class real(WP), dimension(:,:,:), allocatable :: FWX,FWY,FWZ !< W-momentum fluxes ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP) :: RHOeps !< Parameter for when to switch between centered and modified interpolation scheme @@ -245,12 +245,6 @@ function constructor(cfg,name) result(self) allocate(self%FWY(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWY=0.0_WP allocate(self%FWZ(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWZ=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -354,7 +348,7 @@ subroutine init_metrics(this) do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ do i=this%cfg%imino_+1,this%cfg%imaxo_ - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] end do end do end do @@ -839,14 +833,17 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(tpns), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided ! Adjust metrics based on bcflag array call this%adjust_metrics() + + ! Point to pressure solver linsol object + this%psolv=>pressure_solver ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] @@ -861,22 +858,30 @@ subroutine setup(this,pressure_ils,implicit_ils) this%psolv%opr(1,:,:,:)=this%cfg%VF ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) - - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP + call this%psolv%init() - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -2087,7 +2092,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLst) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) end subroutine get_cfl @@ -2275,23 +2280,11 @@ subroutine shift_p(this,pressure) implicit none class(tpns), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index f25e3224c..d194ff686 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -6,7 +6,7 @@ module lowmach_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -78,10 +78,10 @@ module lowmach_class real(WP), dimension(:,:,:), allocatable :: div !< Divergence array ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity @@ -191,12 +191,6 @@ function constructor(cfg,name) result(self) ! Allocate fluid viscosity allocate(self%visc(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -289,7 +283,7 @@ subroutine init_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do @@ -760,16 +754,19 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(lowmach), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided integer :: i,j,k ! Adjust metrics based on bcflag array call this%adjust_metrics() + ! Point to pressure solver linsol object + this%psolv=>pressure_solver + ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] this%psolv%stc(2,:)=[+1, 0, 0] @@ -803,23 +800,31 @@ subroutine setup(this,pressure_ils,implicit_ils) end do ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) + call this%psolv%init() call this%psolv%setup() - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -1727,7 +1732,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl @@ -1917,23 +1922,11 @@ subroutine shift_p(this,pressure) implicit none class(lowmach), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 105e30b51..89747e49b 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -5,7 +5,7 @@ module vdscalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -60,7 +60,7 @@ module vdscalar_class real(WP), dimension(:,:,:), allocatable :: rhoSCold !< rhoSCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -151,9 +151,6 @@ function constructor(cfg,scheme,name) result(self) call die('[scalar constructor] Unknown vdscalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -368,31 +365,39 @@ end subroutine adjust_metrics !> Finish setting up the variable density scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) + subroutine setup(this,implicit_solver) implicit none class(vdscalar), intent(inout) :: this - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st ! Adjust metrics based on mask array call this%adjust_metrics() - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup diff --git a/tools/GNUMake/Make.local b/tools/GNUMake/Make.local index e0b436202..4feb6db08 100644 --- a/tools/GNUMake/Make.local +++ b/tools/GNUMake/Make.local @@ -41,7 +41,7 @@ endif # When I run on my local desktop, I like to add this gfortran flag. FFLAGS += -fcheck=array-temps -F90FLAGS += -fcheck=array-temps +F90FLAGS += -fcheck=array-temps # --std=f2008 # Instead of linking to static gfortran library, I like to use shared libraries. @@ -69,3 +69,4 @@ CFLAGS = MY_AWESOME_CFLAGS ifeq ($(lowercase_comp),pg?compiler) CXXFLAGS := $(filter-out --c++11,$(CXXFLAGS)) endif +