diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 000000000..4171cd2d5 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,4 @@ +{ + "fortran.fortls.disabled": true, + "makefile.configureOnOpen": false +} \ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..ffef59533 --- /dev/null +++ b/Makefile @@ -0,0 +1,139 @@ +#======================================================================= +# Makefile for Xcompact3D +#======================================================================= +# Choose pre-processing options +# -DDOUBLE_PREC - use double-precision +# -DSAVE_SINGLE - Save 3D data in single-precision +# -DDEBG - debuggin xcompact3d.f90 +# generate a Git version string +GIT_VERSION := $(shell git describe --tag --long --always) + +DEFS = -DDOUBLE_PREC -DVERSION=\"$(GIT_VERSION)\" + +LCL = local# local,lad,sdu,archer +IVER = 17# 15,16,17,18 +CMP = gcc# intel,gcc +FFT = generic# generic,fftw3,mkl + +BUILD ?= + +#######CMP settings########### +ifeq ($(CMP),intel) +FC = mpiifort +#FFLAGS = -fpp -O3 -xHost -heap-arrays -shared-intel -mcmodel=large -safe-cray-ptr -g -traceback +FFLAGS = -fpp -O3 -xSSE4.2 -axAVX,CORE-AVX-I,CORE-AVX2 -ipo -fp-model fast=2 -mcmodel=large -safe-cray-ptr -I$(MPI_ROOT)/lib +##debuggin test: -check all -check bounds -chintel eck uninit -gen-interfaces -warn interfaces +else ifeq ($(CMP),gcc) +FC = mpif90 +#FFLAGS = -O3 -funroll-loops -floop-optimize -g -Warray-bounds -fcray-pointer -x f95-cpp-input +ifeq ($(BUILD),debug) +FFLAGS = -cpp -g3 -Og -fexceptions -ftrapv +FFLAGS += -ffpe-trap=invalid,zero -fcheck=bounds -fimplicit-none +else +FFLAGS = -cpp -O3 -funroll-loops -floop-optimize -g +endif +FFLAGS += -Warray-bounds -fcray-pointer -fbacktrace -ffree-line-length-none +ifeq "$(shell expr `gfortran -dumpversion | cut -f1 -d.` \>= 10)" "1" +FFLAGS += -fallow-argument-mismatch +endif +else ifeq ($(CMP),nagfor) +FC = mpinagfor +FFLAGS = -fpp +else ifeq ($(CMP),cray) +FC = ftn +FFLAGS = -eF -g -O3 -N 1023 +endif + + +MODDIR = ./mod +DECOMPDIR = ./decomp2d +SRCDIR = ./src +TURBDIR = ./src + +### List of files for the main code +SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/fft_$(FFT).f90 $(DECOMPDIR)/io.f90 +OBJDECOMP = $(SRCDECOMP:%.f90=%.o) +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/poisson.f90 $(SRCDIR)/derive.f90 $(SRCDIR)/implicit.f90 $(SRCDIR)/schemes.f90 $(SRCDIR)/parameters.f90 $(SRCDIR)/*.f90 +OBJ = $(SRC:%.f90=%.o) +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/BC-dbg-schemes.f90 $(SRCDIR)/poisson.f90 $(TURBDIR)/constants.f90 $(SRCDIR)/ellip_utils.f90 $(SRCDIR)/ibm.f90 $(SRCDIR)/derive.f90 $(SRCDIR)/implicit.f90 $(SRCDIR)/schemes.f90 $(SRCDIR)/forces.f90 $(SRCDIR)/probes.f90 $(SRCDIR)/navier.f90 $(SRCDIR)/tools.f90 $(SRCDIR)/visu.f90 $(SRCDIR)/BC-TBL.f90 $(SRCDIR)/BC-ABL.f90 $(SRCDIR)/les_models.f90 $(SRCDIR)/BC-Lock-exchange.f90 $(SRCDIR)/time_integrators.f90 $(SRCDIR)/filters.f90 $(SRCDIR)/parameters.f90 $(SRCDIR)/BC-User.f90 $(SRCDIR)/BC-TGV.f90 $(SRCDIR)/BC-Channel-flow.f90 $(SRCDIR)/BC-Periodic-hill.f90 $(SRCDIR)/BC-Cylinder.f90 $(SRCDIR)/BC-Ellipsoid.f90 $(SRCDIR)/BC-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/acl_utils.f90 $(TURBDIR)/airfoils.f90 $(TURBDIR)/dynstall.f90 $(TURBDIR)/dynstall_legacy.f90 $(TURBDIR)/acl_elem.f90 $(TURBDIR)/acl_controller.f90 $(TURBDIR)/acl_turb.f90 $(TURBDIR)/acl_out.f90 $(TURBDIR)/acl_farm_controller.f90 $(TURBDIR)/acl_model.f90 $(TURBDIR)/acl_source.f90 $(TURBDIR)/adm.f90 $(TURBDIR)/turbine.f90 $(SRCDIR)/statistics.f90 $(SRCDIR)/case.f90 $(SRCDIR)/transeq.f90 $(SRCDIR)/genepsi3d.f90 $(SRCDIR)/xcompact3d.f90 + + +#######FFT settings########## +ifeq ($(FFT),fftw3) + #FFTW3_PATH=/usr + #FFTW3_PATH=/usr/lib64 + FFTW3_PATH=/usr/local/Cellar/fftw/3.3.7_1 + INC:=-I$(FFTW3_PATH)/include + LIBFFT=-L$(FFTW3_PATH) -lfftw3 -lfftw3f +else ifeq ($(FFT),fftw3_f03) + FFTW3_PATH=/usr #ubuntu # apt install libfftw3-dev + #FFTW3_PATH=/usr/lib64 #fedora # dnf install fftw fftw-devel + #FFTW3_PATH=/usr/local/Cellar/fftw/3.3.7_1 #macOS # brew install fftw + INC:=-I$(FFTW3_PATH)/include + LIBFFT=-L$(FFTW3_PATH)/lib -lfftw3 -lfftw3f +else ifeq ($(FFT),generic) + INC:= + LIBFFT= +else ifeq ($(FFT),mkl) + SRCDECOMP := $(DECOMPDIR)/mkl_dfti.f90 $(SRCDECOMP) + LIBFFT=-Wl,--start-group $(MKLROOT)/lib/intel64/libmkl_intel_lp64.a $(MKLROOT)/lib/intel64/libmkl_sequential.a $(MKLROOT)/lib/intel64/libmkl_core.a -Wl,--end-group -lpthread + INC=-I$(MKLROOT)/include +else ifeq ($(FFT),ffte) + INC:= + LIBFFT:=-L$(FFTE_DIR)/lib -lffte +endif + +#######OPTIONS settings########### +OPT := -I$(SRCDIR) -I$(DECOMPDIR) $(FFLAGS) +LINKOPT := $(FFLAGS) + +LIBIO := +ADIOS2DIR := +ifeq ($(IO),adios2) + ifeq ($(ADIOS2DIR),) + $(error Set ADIOS2DIR=/path/to/adios2/install/) + endif + OPT := -DADIOS2 $(OPT) + INC := $(INC) $(shell $(ADIOS2DIR)/bin/adios2-config --fortran-flags) #$(patsubst $(shell $(ADIOS2DIR)/bin/adios2-config --fortran-libs),,$(shell $(ADIOS2DIR)/bin/adios2-config -f)) + LIBIO := $(shell $(ADIOS2DIR)/bin/adios2-config --fortran-libs) +endif + +#----------------------------------------------------------------------- +# Normally no need to change anything below + +all: xcompact3d + +xcompact3d : $(OBJDECOMP) $(OBJ) + $(FC) -o $@ $(LINKOPT) $(OBJDECOMP) $(OBJ) $(LIBFFT) $(LIBIO) + +$(OBJDECOMP):$(DECOMPDIR)%.o : $(DECOMPDIR)%.f90 + $(FC) $(FFLAGS) $(OPT) $(DEFS) $(DEFS2) $(INC) -c $< + mv $(@F) ${DECOMPDIR} + #mv *.mod ${DECOMPDIR} + + +$(OBJ):$(SRCDIR)%.o : $(SRCDIR)%.f90 + $(FC) $(FFLAGS) $(OPT) $(DEFS) $(DEFS2) $(INC) -c $< + mv $(@F) ${SRCDIR} + #mv *.mod ${SRCDIR} + +## This %.o : %.f90 doesn't appear to be called... +%.o : %.f90 + $(FC) $(FFLAGS) $(DEFS) $(DEFS2) $(INC) -c $< + +.PHONY: post +post: + $(FC) $(FFLAGS) $(DEFS) $(DEFS2) post.f90 -c + $(FC) $(FFLAGS) -o $@ $(PSRC:.f90=.o) + +.PHONY: clean + + +clean: + rm -f $(DECOMPDIR)/*.o $(DECOMPDIR)/*.mod $(DECOMPDIR)/*.smod + rm -f $(SRCDIR)/*.o $(SRCDIR)/*.mod $(SRCDIR)/*.smod + rm -f *.o *.mod *.smod xcompact3d + +.PHONY: cleanall +cleanall: clean + rm -f *~ \#*\# out/* data/* stats/* planes/* *.xdmf *.log *.out nodefile core sauve* diff --git a/decomp2d/io.f90 b/decomp2d/io.f90 new file mode 100644 index 000000000..31c47f696 --- /dev/null +++ b/decomp2d/io.f90 @@ -0,0 +1,1870 @@ +!======================================================================= +! This is part of the 2DECOMP&FFT library +! +! 2DECOMP&FFT is a software framework for general-purpose 2D (pencil) +! decomposition. It also implements a highly scalable distributed +! three-dimensional Fast Fourier Transform (FFT). +! +! Copyright (C) 2009-2013 Ning Li, the Numerical Algorithms Group (NAG) +! Copyright (C) 2021 the University of Edinburgh (UoE) +! +!======================================================================= + +! This module provides parallel IO facilities for applications based on +! 2D decomposition. + +module decomp_2d_io + + use decomp_2d + use MPI +#ifdef T3PIO + use t3pio +#endif + +#ifdef ADIOS2 + use adios2 +#endif + + implicit none + + integer, parameter, public :: decomp_2d_write_mode = 1, decomp_2d_read_mode = 2, & + decomp_2d_append_mode = 3 + integer, parameter :: MAX_IOH = 10 ! How many live IO things should we handle? + character(len=*), parameter :: io_sep = "::" + integer, save :: nreg_io = 0 + integer, dimension(MAX_IOH), save :: io_step +#ifndef ADIOS2 + integer, dimension(MAX_IOH), save :: fh_registry + logical, dimension(MAX_IOH), target, save :: fh_live + character(len=1024), dimension(MAX_IOH), target, save :: fh_names + integer(kind=MPI_OFFSET_KIND), dimension(MAX_IOH), save :: fh_disp +#else + type(adios2_adios) :: adios + character(len=1024), dimension(MAX_IOH), target, save :: engine_names + logical, dimension(MAX_IOH), target, save :: engine_live + type(adios2_engine), dimension(MAX_IOH), save :: engine_registry +#endif + + private ! Make everything private unless declared public + + public :: decomp_2d_write_one, decomp_2d_read_one, & + decomp_2d_write_var, decomp_2d_read_var, & + decomp_2d_write_scalar, decomp_2d_read_scalar, & + decomp_2d_write_plane, decomp_2d_write_every, & + decomp_2d_write_subdomain, & + decomp_2d_write_outflow, decomp_2d_read_inflow, & + decomp_2d_io_init, decomp_2d_io_finalise, & ! XXX: initialise/finalise 2decomp&fft IO module + decomp_2d_init_io, & ! XXX: initialise an io process - awful naming + decomp_2d_register_variable, & + decomp_2d_open_io, decomp_2d_close_io, & + decomp_2d_start_io, decomp_2d_end_io, & + gen_iodir_name, & + decomp_2d_set_io_step + + ! Generic interface to handle multiple data types + + interface decomp_2d_write_one + module procedure write_one_real + module procedure write_one_complex + module procedure mpiio_write_real_coarse + module procedure mpiio_write_real_probe + end interface decomp_2d_write_one + + interface decomp_2d_read_one + module procedure read_one_real + module procedure read_one_complex + end interface decomp_2d_read_one + + interface decomp_2d_write_var + module procedure write_var_real + module procedure write_var_complex + end interface decomp_2d_write_var + + interface decomp_2d_read_var + module procedure read_var_real + module procedure read_var_complex + end interface decomp_2d_read_var + + interface decomp_2d_write_scalar + module procedure write_scalar_real + module procedure write_scalar_complex + module procedure write_scalar_integer + module procedure write_scalar_logical + end interface decomp_2d_write_scalar + + interface decomp_2d_read_scalar + module procedure read_scalar_real + module procedure read_scalar_complex + module procedure read_scalar_integer + module procedure read_scalar_logical + end interface decomp_2d_read_scalar + + interface decomp_2d_write_plane + module procedure write_plane_3d_real + module procedure write_plane_3d_complex + ! module procedure write_plane_2d + end interface decomp_2d_write_plane + + interface decomp_2d_write_every + module procedure write_every_real + module procedure write_every_complex + end interface decomp_2d_write_every + + interface decomp_2d_write_subdomain + module procedure write_subdomain + end interface decomp_2d_write_subdomain + + interface decomp_2d_write_outflow + module procedure write_outflow + end interface decomp_2d_write_outflow + + interface decomp_2d_read_inflow + module procedure read_inflow + end interface decomp_2d_read_inflow + +contains + + subroutine decomp_2d_io_init() + +#ifdef ADIOS2 + integer :: ierror + logical :: adios2_debug_mode + character(len=80) :: config_file="adios2_config.xml" +#endif + +#ifdef ADIOS2 + !! TODO: make this a runtime-option + adios2_debug_mode = .true. + + call adios2_init(adios, trim(config_file), MPI_COMM_WORLD, adios2_debug_mode, ierror) + if (ierror.ne.0) then + print *, "Error initialising ADIOS2 - is adios2_config.xml present and valid?" + call MPI_ABORT(MPI_COMM_WORLD, -1, ierror) + endif + + engine_live(:) = .false. +#endif + + end subroutine decomp_2d_io_init + subroutine decomp_2d_io_finalise() + +#ifdef ADIOS2 + use adios2 +#endif + + implicit none + +#ifdef ADIOS2 + integer :: ierror +#endif + +#ifdef ADIOS2 + call adios2_finalize(adios, ierror) +#endif + + end subroutine decomp_2d_io_finalise + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Using MPI-IO library to write a single 3D array to a file +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine write_one_real(ipencil,var,filename,opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil + real(mytype), dimension(:,:,:), intent(IN) :: var + character(len=*), intent(IN) :: filename + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer(kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, fh, data_type, info, gs + + data_type = real_type + +#include "io_write_one.inc" + + return + end subroutine write_one_real + + subroutine write_one_complex(ipencil,var,filename,opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil + complex(mytype), dimension(:,:,:), intent(IN) :: var + character(len=*), intent(IN) :: filename + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer(kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, fh, data_type, info, gs + + data_type = complex_type + +#include "io_write_one.inc" + + return + end subroutine write_one_complex + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Using MPI-IO library to read from a file a single 3D array +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine read_one_real(ipencil,var,dirname,varname,io_name,opt_decomp,reduce_prec) + + implicit none + + integer, intent(IN) :: ipencil + real(mytype), dimension(:,:,:), intent(INOUT) :: var + character(len=*), intent(IN) :: varname, dirname, io_name + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + logical, intent(in), optional :: reduce_prec + + logical :: read_reduce_prec + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + real(mytype_single), allocatable, dimension(:,:,:) :: varsingle + integer :: idx + integer :: disp_bytes + character(len=:), allocatable :: full_io_name + logical :: opened_new, dir_exists + + read_reduce_prec = .true. + + idx = get_io_idx(io_name, dirname) +#ifndef ADIOS2 + opened_new = .false. + if (idx .lt. 1) then + ! Check file exists + allocate(character(len(trim(dirname)) + 1 + len(trim(varname))) :: full_io_name) + full_io_name = dirname//"/"//varname + if (nrank==0) then + inquire(file=full_io_name, exist=dir_exists) + if (.not.dir_exists) then + print *, "ERROR: cannot read from", full_io_name, " directory doesn't exist!" + stop + end if + end if + + call decomp_2d_open_io(io_name, full_io_name, decomp_2d_read_mode) + idx = get_io_idx(io_name, full_io_name) + opened_new = .true. + end if + + if (present(reduce_prec)) then + if (.not. reduce_prec) then + read_reduce_prec = .false. + end if + end if + if (read_reduce_prec) then + data_type = real_type_single + else + data_type = real_type + end if + call MPI_TYPE_SIZE(data_type,disp_bytes,ierror) + + !! Use MPIIO + if (read_reduce_prec) then + allocate (varsingle(xstV(1):xenV(1),xstV(2):xenV(2),xstV(3):xenV(3))) + end if + + if (present(opt_decomp)) then + decomp = opt_decomp + else + call get_decomp_info(decomp) + end if + + ! determine subarray parameters + sizes(1) = decomp%xsz(1) + sizes(2) = decomp%ysz(2) + sizes(3) = decomp%zsz(3) + + if (ipencil == 1) then + subsizes(1) = decomp%xsz(1) + subsizes(2) = decomp%xsz(2) + subsizes(3) = decomp%xsz(3) + starts(1) = decomp%xst(1)-1 ! 0-based index + starts(2) = decomp%xst(2)-1 + starts(3) = decomp%xst(3)-1 + else if (ipencil == 2) then + subsizes(1) = decomp%ysz(1) + subsizes(2) = decomp%ysz(2) + subsizes(3) = decomp%ysz(3) + starts(1) = decomp%yst(1)-1 + starts(2) = decomp%yst(2)-1 + starts(3) = decomp%yst(3)-1 + else if (ipencil == 3) then + subsizes(1) = decomp%zsz(1) + subsizes(2) = decomp%zsz(2) + subsizes(3) = decomp%zsz(3) + starts(1) = decomp%zst(1)-1 + starts(2) = decomp%zst(2)-1 + starts(3) = decomp%zst(3)-1 + endif + + associate(fh => fh_registry(idx), & + disp => fh_disp(idx)) + call MPI_TYPE_CREATE_SUBARRAY(3, sizes, subsizes, starts, & + MPI_ORDER_FORTRAN, data_type, newtype, ierror) + call MPI_TYPE_COMMIT(newtype,ierror) + call MPI_FILE_SET_VIEW(fh,disp,data_type, & + newtype,'native',MPI_INFO_NULL,ierror) + if (read_reduce_prec) then + call MPI_FILE_READ_ALL(fh, varsingle, & + subsizes(1)*subsizes(2)*subsizes(3), & + data_type, MPI_STATUS_IGNORE, ierror) + var = real(varsingle,mytype) + deallocate(varsingle) + else + call MPI_FILE_READ_ALL(fh, var, & + subsizes(1)*subsizes(2)*subsizes(3), & + data_type, MPI_STATUS_IGNORE, ierror) + endif + call MPI_TYPE_FREE(newtype,ierror) + + disp = disp + sizes(1) * sizes(2) * sizes(3) * disp_bytes + end associate + + if (opened_new) then + call decomp_2d_close_io(io_name, full_io_name) + deallocate(full_io_name) + end if +#else + call adios2_read_one_real(ipencil, var, dirname, varname, io_name) +#endif + return + end subroutine read_one_real + + + subroutine read_one_complex(ipencil,var,filename,opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil + complex(mytype), dimension(:,:,:), intent(INOUT) :: var + character(len=*), intent(IN) :: filename + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer(kind=MPI_OFFSET_KIND) :: disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, fh, data_type + + data_type = complex_type + +#include "io_read_one.inc" + + return + + end subroutine read_one_complex + +#ifdef ADIOS2 + subroutine adios2_read_one_real(ipencil,var,engine_name,varname,io_name) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + character(len=*), intent(in) :: engine_name + character(len=*), intent(in) :: io_name + character*(*), intent(in) :: varname + real(mytype), dimension(:,:,:), intent(out) :: var + + integer (kind=MPI_OFFSET_KIND) :: filesize, disp + integer :: i,j,k, ierror, newtype, fh + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle + integer :: idx + + call adios2_at_io(io_handle, adios, io_name, ierror) + call adios2_inquire_variable(var_handle, io_handle, varname, ierror) + if (.not.var_handle % valid) then + print *, "ERROR: trying to read variable without registering first! ", varname + stop + endif + + idx = get_io_idx(io_name, engine_name) + call adios2_get(engine_registry(idx), var_handle, var, adios2_mode_deferred, ierror) + + return + + end subroutine adios2_read_one_real +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write a 3D array as part of a big MPI-IO file, starting from + ! displacement 'disp'; 'disp' will be updated after the writing + ! operation to prepare the writing of next chunk of data. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine write_var_real(fh,disp,ipencil,var,opt_decomp) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: ipencil + real(mytype), dimension(:,:,:), intent(IN) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + + data_type = real_type + +#include "io_write_var.inc" + + return + end subroutine write_var_real + + subroutine write_var_complex(fh,disp,ipencil,var,opt_decomp) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: ipencil + complex(mytype), dimension(:,:,:), intent(IN) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + + data_type = complex_type + +#include "io_write_var.inc" + + return + end subroutine write_var_complex + + + subroutine write_outflow(dirname,varname,ntimesteps,var,io_name,opt_decomp) + + implicit none + + character(len=*), intent(in) :: dirname, varname, io_name + integer, intent(IN) :: ntimesteps + real(mytype), dimension(:,:,:), intent(IN) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + integer :: idx +#ifdef ADIOS2 + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle +#endif + + data_type = real_type + +#include "io_write_outflow.f90" + + return + end subroutine write_outflow + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Read a 3D array as part of a big MPI-IO file, starting from + ! displacement 'disp'; 'disp' will be updated after the reading + ! operation to prepare the reading of next chunk of data. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine read_var_real(fh,disp,ipencil,var,opt_decomp) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: ipencil + real(mytype), dimension(:,:,:), intent(INOUT) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + + data_type = real_type + +#include "io_read_var.inc" + + return + end subroutine read_var_real + + + subroutine read_var_complex(fh,disp,ipencil,var,opt_decomp) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: ipencil + complex(mytype), dimension(:,:,:), intent(INOUT) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + + data_type = complex_type + +#include "io_read_var.inc" + + return + end subroutine read_var_complex + + + subroutine read_inflow(dirname,varname,ntimesteps,var,io_name,opt_decomp) + + implicit none + + character(len=*), intent(in) :: dirname, varname, io_name + integer, intent(IN) :: ntimesteps + real(mytype), dimension(:,:,:), intent(INOUT) :: var + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror, newtype, data_type + integer :: idx +#ifdef ADIOS2 + integer(kind=8) :: steps + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle +#endif + + data_type = real_type + +#include "io_read_inflow.f90" + + return + end subroutine read_inflow + + subroutine decomp_2d_set_io_step(io_name, io_dir, step) + + character(len=*), intent(in) :: io_name, io_dir + integer, intent(in) :: step + + integer :: idx + + idx = get_io_idx(io_name, io_dir) + if (idx < 1) then + print *, "ERROR!" + stop + end if + + io_step(idx) = step + + end subroutine decomp_2d_set_io_step + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write scalar variables as part of a big MPI-IO file, starting from + ! displacement 'disp'; 'disp' will be updated after the reading + ! operation to prepare the reading of next chunk of data. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine write_scalar_real(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh ! file handle + integer(KIND=MPI_OFFSET_KIND), & + intent(INOUT) :: disp ! displacement + integer, intent(IN) :: n ! number of scalars + real(mytype), dimension(n), & + intent(IN) :: var ! array of scalars + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,real_type, & + real_type,'native',MPI_INFO_NULL,ierror) + if (nrank==0) then + m = n ! only one rank needs to write + else + m = 0 + end if + call MPI_FILE_WRITE_ALL(fh, var, m, real_type, & + MPI_STATUS_IGNORE, ierror) + disp = disp + n*mytype_bytes + + return + end subroutine write_scalar_real + + + subroutine write_scalar_complex(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + complex(mytype), dimension(n), intent(IN) :: var + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,complex_type, & + complex_type,'native',MPI_INFO_NULL,ierror) + if (nrank==0) then + m = n + else + m = 0 + end if + call MPI_FILE_WRITE_ALL(fh, var, m, complex_type, & + MPI_STATUS_IGNORE, ierror) + disp = disp + n*mytype_bytes*2 + + return + end subroutine write_scalar_complex + + + subroutine write_scalar_integer(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + integer, dimension(n), intent(IN) :: var + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,MPI_INTEGER, & + MPI_INTEGER,'native',MPI_INFO_NULL,ierror) + if (nrank==0) then + m = n + else + m = 0 + end if + call MPI_FILE_WRITE_ALL(fh, var, m, MPI_INTEGER, & + MPI_STATUS_IGNORE, ierror) + call MPI_TYPE_SIZE(MPI_INTEGER,m,ierror) + disp = disp + n*m + + return + end subroutine write_scalar_integer + + + subroutine write_scalar_logical(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + logical, dimension(n), intent(IN) :: var + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,MPI_LOGICAL, & + MPI_LOGICAL,'native',MPI_INFO_NULL,ierror) + if (nrank==0) then + m = n + else + m = 0 + end if + call MPI_FILE_WRITE_ALL(fh, var, m, MPI_LOGICAL, & + MPI_STATUS_IGNORE, ierror) + call MPI_TYPE_SIZE(MPI_LOGICAL,m,ierror) + disp = disp + n*m + + return + end subroutine write_scalar_logical + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Read scalar variables as part of a big MPI-IO file, starting from + ! displacement 'disp'; 'disp' will be updated after the reading + ! operation to prepare the reading of next chunk of data. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine read_scalar_real(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh ! file handle + integer(KIND=MPI_OFFSET_KIND), & + intent(INOUT) :: disp ! displacement + integer, intent(IN) :: n ! number of scalars + real(mytype), dimension(n), & + intent(INOUT) :: var ! array of scalars + + integer :: ierror + + call MPI_FILE_SET_VIEW(fh,disp,real_type, & + real_type,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_READ_ALL(fh, var, n, real_type, & + MPI_STATUS_IGNORE, ierror) + disp = disp + n*mytype_bytes + + return + end subroutine read_scalar_real + + + subroutine read_scalar_complex(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + complex(mytype), dimension(n), intent(INOUT) :: var + + integer :: ierror + + call MPI_FILE_SET_VIEW(fh,disp,complex_type, & + complex_type,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_READ_ALL(fh, var, n, complex_type, & + MPI_STATUS_IGNORE, ierror) + disp = disp + n*mytype_bytes*2 + + return + end subroutine read_scalar_complex + + + subroutine read_scalar_integer(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + integer, dimension(n), intent(INOUT) :: var + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,MPI_INTEGER, & + MPI_INTEGER,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_READ_ALL(fh, var, n, MPI_INTEGER, & + MPI_STATUS_IGNORE, ierror) + call MPI_TYPE_SIZE(MPI_INTEGER,m,ierror) + disp = disp + n*m + + return + end subroutine read_scalar_integer + + + subroutine read_scalar_logical(fh,disp,n,var) + + implicit none + + integer, intent(IN) :: fh + integer(KIND=MPI_OFFSET_KIND), intent(INOUT) :: disp + integer, intent(IN) :: n + logical, dimension(n), intent(INOUT) :: var + + integer :: m, ierror + + call MPI_FILE_SET_VIEW(fh,disp,MPI_LOGICAL, & + MPI_LOGICAL,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_READ_ALL(fh, var, n, MPI_LOGICAL, & + MPI_STATUS_IGNORE, ierror) + call MPI_TYPE_SIZE(MPI_LOGICAL,m,ierror) + disp = disp + n*m + + return + end subroutine read_scalar_logical + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write a 2D slice of the 3D data to a file +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine plane_extents (sizes, subsizes, starts, iplane, opt_decomp, opt_nplanes) + + integer, intent(in) :: iplane + type(decomp_info), intent(in), optional :: opt_decomp + integer, intent(in), optional :: opt_nplanes + + integer, dimension(3), intent(out) :: sizes, subsizes, starts + + integer :: nplanes + type(decomp_info) :: decomp + + if (present(opt_decomp)) then + decomp = opt_decomp + else + call get_decomp_info(decomp) + end if + + if (present(opt_nplanes)) then + nplanes = opt_nplanes + else + nplanes = 1 + end if + + if (iplane == 1) then + sizes(1) = nplanes + sizes(2) = decomp%ysz(2) + sizes(3) = decomp%zsz(3) + subsizes(1) = nplanes + subsizes(2) = decomp%xsz(2) + subsizes(3) = decomp%xsz(3) + starts(1) = 0 + starts(2) = decomp%xst(2)-1 + starts(3) = decomp%xst(3)-1 + else if (iplane == 2) then + sizes(1) = decomp%xsz(1) + sizes(2) = nplanes + sizes(3) = decomp%zsz(3) + subsizes(1) = decomp%ysz(1) + subsizes(2) = nplanes + subsizes(3) = decomp%ysz(3) + starts(1) = decomp%yst(1)-1 + starts(2) = 0 + starts(3) = decomp%yst(3)-1 + else if (iplane == 3) then + sizes(1) = decomp%xsz(1) + sizes(2) = decomp%ysz(2) + sizes(3) = nplanes + subsizes(1) = decomp%zsz(1) + subsizes(2) = decomp%zsz(2) + subsizes(3) = nplanes + starts(1) = decomp%zst(1)-1 + starts(2) = decomp%zst(2)-1 + starts(3) = 0 + else + print *, "Can't work with plane ", iplane + stop + endif + + end subroutine plane_extents + + subroutine write_plane_3d_real(ipencil,var,iplane,n,dirname,varname,io_name, & + opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + real(mytype), dimension(:,:,:), intent(IN) :: var + integer, intent(IN) :: iplane !(x-plane=1; y-plane=2; z-plane=3) + integer, intent(IN) :: n ! which plane to write (global coordinate) + character(len=*), intent(IN) :: dirname,varname,io_name + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + real(mytype), allocatable, dimension(:,:,:) :: wk, wk2 + real(mytype), allocatable, dimension(:,:,:) :: wk2d + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype, data_type + + logical :: opened_new, dir_exists + character(len=:), allocatable :: full_io_name + integer :: idx +#ifdef ADIOS2 + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle +#endif + + data_type = real_type + +#include "io_write_plane.inc" + + return + end subroutine write_plane_3d_real + + + subroutine write_plane_3d_complex(ipencil,var,iplane,n, & + dirname,varname,io_name,opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + complex(mytype), dimension(:,:,:), intent(IN) :: var + integer, intent(IN) :: iplane !(x-plane=1; y-plane=2; z-plane=3) + integer, intent(IN) :: n ! which plane to write (global coordinate) + character(len=*), intent(IN) :: dirname,varname,io_name + TYPE(DECOMP_INFO), intent(IN), optional :: opt_decomp + + complex(mytype), allocatable, dimension(:,:,:) :: wk, wk2 + complex(mytype), allocatable, dimension(:,:,:) :: wk2d + TYPE(DECOMP_INFO) :: decomp + integer, dimension(3) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype, data_type + logical :: opened_new, dir_exists + character(len=:), allocatable :: full_io_name + integer :: idx +#ifdef ADIOS2 + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle +#endif + + data_type = complex_type + +#include "io_write_plane.inc" + + return + end subroutine write_plane_3d_complex + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write a 2D array to a file +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !************** TO DO *************** + !* Consider handling distributed 2D data set + ! subroutine write_plane_2d(ipencil,var,filename) + ! integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + ! real(mytype), dimension(:,:), intent(IN) :: var ! 2D array + ! character(len=*), intent(IN) :: filename + ! + ! if (ipencil==1) then + ! ! var should be defined as var(xsize(2) + ! + ! else if (ipencil==2) then + ! + ! else if (ipencil==3) then + ! + ! end if + ! + ! return + ! end subroutine write_plane_2d + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write 3D array data for every specified mesh point +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine write_every_real(ipencil,var,iskip,jskip,kskip, & + filename, from1) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + real(mytype), dimension(:,:,:), intent(IN) :: var + integer, intent(IN) :: iskip,jskip,kskip + character(len=*), intent(IN) :: filename + logical, intent(IN) :: from1 ! .true. - save 1,n+1,2n+1... + ! .false. - save n,2n,3n... + + real(mytype), allocatable, dimension(:,:,:) :: wk, wk2 + integer(kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype, fh, key,color,newcomm, data_type + integer, dimension(3) :: xsz,ysz,zsz,xst,yst,zst,xen,yen,zen,skip + + data_type = real_type + +#include "io_write_every.inc" + + return + end subroutine write_every_real + + + subroutine write_every_complex(ipencil,var,iskip,jskip,kskip, & + filename, from1) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + complex(mytype), dimension(:,:,:), intent(IN) :: var + integer, intent(IN) :: iskip,jskip,kskip + character(len=*), intent(IN) :: filename + logical, intent(IN) :: from1 ! .true. - save 1,n+1,2n+1... + ! .false. - save n,2n,3n... + + complex(mytype), allocatable, dimension(:,:,:) :: wk, wk2 + integer(kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype, fh, key,color,newcomm, data_type + integer, dimension(3) :: xsz,ysz,zsz,xst,yst,zst,xen,yen,zen,skip + + data_type = complex_type + +#include "io_write_every.inc" + + return + end subroutine write_every_complex + + subroutine coarse_extents(ipencil, icoarse, sizes, subsizes, starts, opt_decomp) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + integer, intent(IN) :: icoarse !(nstat=1; nvisu=2) + type(decomp_info), intent(in), optional :: opt_decomp + + integer, dimension(3) :: sizes, subsizes, starts + integer :: ierror + type(decomp_info) :: decomp + + if ((icoarse.lt.0).or.(icoarse.gt.2)) then + print *, "Error invalid value of icoarse: ", icoarse + call MPI_ABORT(MPI_COMM_WORLD, -1, ierror) + endif + if ((ipencil.lt.1).or.(ipencil.gt.3)) then + print *, "Error invalid value of ipencil: ", ipencil + call MPI_ABORT(MPI_COMM_WORLD, -1, ierror) + endif + + if (icoarse==0) then + !! Use full fields + + if (present(opt_decomp)) then + decomp = opt_decomp + else + call get_decomp_info(decomp) + endif + + sizes(1) = decomp%xsz(1) + sizes(2) = decomp%ysz(2) + sizes(3) = decomp%zsz(3) + + if (ipencil == 1) then + subsizes(1:3) = decomp%xsz(1:3) + starts(1:3) = decomp%xst(1:3) - 1 + elseif (ipencil == 2) then + subsizes(1:3) = decomp%ysz(1:3) + starts(1:3) = decomp%yst(1:3) - 1 + elseif (ipencil == 3) then + subsizes(1:3) = decomp%zsz(1:3) + starts(1:3) = decomp%zst(1:3) - 1 + endif + elseif (icoarse==1) then + sizes(1) = xszS(1) + sizes(2) = yszS(2) + sizes(3) = zszS(3) + + if (ipencil == 1) then + subsizes(1) = xszS(1) + subsizes(2) = xszS(2) + subsizes(3) = xszS(3) + starts(1) = xstS(1)-1 ! 0-based index + starts(2) = xstS(2)-1 + starts(3) = xstS(3)-1 + else if (ipencil == 2) then + subsizes(1) = yszS(1) + subsizes(2) = yszS(2) + subsizes(3) = yszS(3) + starts(1) = ystS(1)-1 + starts(2) = ystS(2)-1 + starts(3) = ystS(3)-1 + else if (ipencil == 3) then + subsizes(1) = zszS(1) + subsizes(2) = zszS(2) + subsizes(3) = zszS(3) + starts(1) = zstS(1)-1 + starts(2) = zstS(2)-1 + starts(3) = zstS(3)-1 + endif + elseif (icoarse==2) then + sizes(1) = xszV(1) + sizes(2) = yszV(2) + sizes(3) = zszV(3) + + if (ipencil == 1) then + subsizes(1) = xszV(1) + subsizes(2) = xszV(2) + subsizes(3) = xszV(3) + starts(1) = xstV(1)-1 ! 0-based index + starts(2) = xstV(2)-1 + starts(3) = xstV(3)-1 + else if (ipencil == 2) then + subsizes(1) = yszV(1) + subsizes(2) = yszV(2) + subsizes(3) = yszV(3) + starts(1) = ystV(1)-1 + starts(2) = ystV(2)-1 + starts(3) = ystV(3)-1 + else if (ipencil == 3) then + subsizes(1) = zszV(1) + subsizes(2) = zszV(2) + subsizes(3) = zszV(3) + starts(1) = zstV(1)-1 + starts(2) = zstV(2)-1 + starts(3) = zstV(3)-1 + endif + endif + + end subroutine coarse_extents + + subroutine mpiio_write_real_coarse(ipencil,var,dirname,varname,icoarse,io_name,opt_decomp,reduce_prec,opt_deferred_writes) + + ! USE param + ! USE variables + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + integer, intent(IN) :: icoarse !(nstat=1; nvisu=2) + real(mytype), dimension(:,:,:), intent(IN) :: var + character(len=*), intent(in) :: dirname, varname, io_name + type(decomp_info), intent(in), optional :: opt_decomp + logical, intent(in), optional :: reduce_prec + logical, intent(in), optional :: opt_deferred_writes + + real(mytype_single), allocatable, dimension(:,:,:) :: varsingle + real(mytype), allocatable, dimension(:,:,:) :: varfull + logical :: write_reduce_prec + logical :: deferred_writes + + integer (kind=MPI_OFFSET_KIND) :: filesize + integer, dimension(3) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype + integer :: idx + logical :: opened_new + integer :: disp_bytes + logical :: dir_exists + character(len=:), allocatable :: full_io_name +#ifdef ADIOS2 + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle + integer :: write_mode +#endif + + !! Set defaults + write_reduce_prec = .true. + deferred_writes = .true. + + opened_new = .false. + idx = get_io_idx(io_name, dirname) +#ifndef ADIOS2 + if (present(reduce_prec)) then + if (.not. reduce_prec) then + write_reduce_prec = .false. + end if + end if + if (write_reduce_prec) then + call MPI_TYPE_SIZE(real_type_single,disp_bytes,ierror) + else + call MPI_TYPE_SIZE(real_type,disp_bytes,ierror) + end if + + !! Use original MPIIO writers + if (present(opt_decomp)) then + call coarse_extents(ipencil, icoarse, sizes, subsizes, starts, opt_decomp) + else + call coarse_extents(ipencil, icoarse, sizes, subsizes, starts) + end if + if (write_reduce_prec) then + allocate (varsingle(xstV(1):xenV(1),xstV(2):xenV(2),xstV(3):xenV(3))) + varsingle=real(var, mytype_single) + end if + + if (write_reduce_prec) then + call MPI_TYPE_CREATE_SUBARRAY(3, sizes, subsizes, starts, & + MPI_ORDER_FORTRAN, real_type_single, newtype, ierror) + else + call MPI_TYPE_CREATE_SUBARRAY(3, sizes, subsizes, starts, & + MPI_ORDER_FORTRAN, real_type, newtype, ierror) + end if + call MPI_TYPE_COMMIT(newtype,ierror) + + if (idx .lt. 1) then + ! Create folder if needed + if (nrank==0) then + inquire(file=dirname, exist=dir_exists) + if (.not.dir_exists) then + call system("mkdir "//dirname//" 2> /dev/null") + end if + end if + allocate(character(len(trim(dirname)) + 1 + len(trim(varname))) :: full_io_name) + full_io_name = dirname//"/"//varname + call decomp_2d_open_io(io_name, full_io_name, decomp_2d_write_mode) + idx = get_io_idx(io_name, full_io_name) + opened_new = .true. + end if + + if (write_reduce_prec) then + call MPI_FILE_SET_VIEW(fh_registry(idx),fh_disp(idx),real_type_single, & + newtype,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_WRITE_ALL(fh_registry(idx), varsingle, & + subsizes(1)*subsizes(2)*subsizes(3), & + real_type_single, MPI_STATUS_IGNORE, ierror) + else + call MPI_FILE_SET_VIEW(fh_registry(idx),fh_disp(idx),real_type, & + newtype,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_WRITE_ALL(fh_registry(idx), var, & + subsizes(1)*subsizes(2)*subsizes(3), & + real_type, MPI_STATUS_IGNORE, ierror) + end if + +! write(*,*) 'Sizes(1) = ', sizes(1) +! write(*,*) 'Sizes(2) = ', sizes(2) +! write(*,*) 'Sizes(3) = ', sizes(3) +! write(*,*) 'MPI_OFFSET_KIND = ', MPI_OFFSET_KIND + + fh_disp(idx) = fh_disp(idx) + int(sizes(1),MPI_OFFSET_KIND) * int(sizes(2),MPI_OFFSET_KIND) * int(sizes(3),MPI_OFFSET_KIND) * int(disp_bytes,MPI_OFFSET_KIND) + + if (opened_new) then + call decomp_2d_close_io(io_name, full_io_name) + deallocate(full_io_name) + end if + + call MPI_TYPE_FREE(newtype,ierror) + if (write_reduce_prec) then + deallocate(varsingle) + end if +#else + if (idx < 1) then + print *, "ERROR: failed to find engine for ", io_name, " ", dirname + end if + if (.not. engine_live(idx)) then + print *, "ERROR: Engine is not live!" + stop + end if + + call adios2_at_io(io_handle, adios, io_name, ierror) + call adios2_inquire_variable(var_handle, io_handle, varname, ierror) + if (.not.var_handle % valid) then + print *, "ERROR: trying to write variable before registering!", varname + stop + endif + + if (idx .lt. 1) then + print *, "You haven't opened ", io_name, ":", dirname + stop + end if + + if (present(opt_deferred_writes)) then + deferred_writes = opt_deferred_writes + end if + + if (deferred_writes) then + write_mode = adios2_mode_deferred + else + write_mode = adios2_mode_sync + end if + + if (engine_registry(idx)%valid) then + call adios2_put(engine_registry(idx), var_handle, var, write_mode, ierror) + if (ierror /= 0) then + print *, "ERROR: something went wrong in adios2_put" + stop + end if + else + print *, "ERROR: decomp2d thinks engine is live, but adios2 engine object is not valid" + stop + end if +#endif + + return + end subroutine mpiio_write_real_coarse + + subroutine decomp_2d_register_variable(io_name, varname, ipencil, icoarse, iplane, type, opt_decomp, opt_nplanes) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + integer, intent(IN) :: icoarse !(nstat=1; nvisu=2) + character(len=*), intent(in) :: io_name + integer, intent(in) :: type + integer, intent(in) :: iplane + type(decomp_info), intent(in), optional :: opt_decomp + integer, intent(in), optional :: opt_nplanes + + integer :: nplanes + character*(*), intent(in) :: varname +#ifdef ADIOS2 + integer, dimension(3) :: sizes, subsizes, starts + type(adios2_io) :: io_handle + type(adios2_variable) :: var_handle + integer, parameter :: ndims = 3 + logical, parameter :: adios2_constant_dims = .true. + integer :: data_type + integer :: ierror + + if (iplane .eq. 0) then + if (present(opt_decomp)) then + call coarse_extents(ipencil, icoarse, sizes, subsizes, starts, opt_decomp) + else + call coarse_extents(ipencil, icoarse, sizes, subsizes, starts) + endif + else + if (present(opt_nplanes)) then + nplanes = opt_nplanes + else + nplanes = 1 + end if + if (present(opt_decomp)) then + call plane_extents(sizes, subsizes, starts, iplane, opt_decomp, opt_nplanes=nplanes) + else + call plane_extents(sizes, subsizes, starts, iplane, opt_nplanes=nplanes) + endif + end if + + ! Check if variable already exists, if not create it + call adios2_at_io(io_handle, adios, io_name, ierror) + if (io_handle%valid) then + call adios2_inquire_variable(var_handle, io_handle, varname, ierror) + if (.not.var_handle % valid) then + !! New variable + if (nrank .eq. 0) then + print *, "Registering variable for IO: ", varname + endif + + ! Need to set the ADIOS2 data type + if (type.eq.kind(0.0d0)) then + !! Double + data_type = adios2_type_dp + else if (type.eq.kind(0.0)) then + !! Single + data_type = adios2_type_real + else + print *, "Trying to write unknown data type!" + call MPI_ABORT(MPI_COMM_WORLD, -1, ierror) + endif + + call adios2_define_variable(var_handle, io_handle, varname, data_type, & + ndims, int(sizes, kind=8), int(starts, kind=8), int(subsizes, kind=8), & + adios2_constant_dims, ierror) + if (ierror /= 0) then + print *, "ERROR registering variable" + stop + end if + endif + else + print *, "ERROR trying to register variable with invalid IO!" + stop + end if +#endif + + end subroutine decomp_2d_register_variable + + subroutine mpiio_write_real_probe(ipencil,var,filename,nlength) + + ! USE param + ! USE variables + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + integer, intent(in) :: nlength + real(mytype), dimension(:,:,:,:), intent(IN) :: var + + character(len=*) :: filename + + integer (kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(4) :: sizes, subsizes, starts + integer :: i,j,k, ierror, newtype, fh + + sizes(1) = xszP(1) + sizes(2) = yszP(2) + sizes(3) = zszP(3) + sizes(4) = nlength + if (ipencil == 1) then + subsizes(1) = xszP(1) + subsizes(2) = xszP(2) + subsizes(3) = xszP(3) + subsizes(4) = nlength + starts(1) = xstP(1)-1 ! 0-based index + starts(2) = xstP(2)-1 + starts(3) = xstP(3)-1 + starts(4) = 0 + else if (ipencil == 2) then + subsizes(1) = yszP(1) + subsizes(2) = yszP(2) + subsizes(3) = yszP(3) + starts(1) = ystP(1)-1 + starts(2) = ystP(2)-1 + starts(3) = ystP(3)-1 + else if (ipencil == 3) then + subsizes(1) = zszP(1) + subsizes(2) = zszP(2) + subsizes(3) = zszP(3) + starts(1) = zstP(1)-1 + starts(2) = zstP(2)-1 + starts(3) = zstP(3)-1 + endif + ! print *,nrank,starts(1),starts(2),starts(3),starts(4) + call MPI_TYPE_CREATE_SUBARRAY(4, sizes, subsizes, starts, & + MPI_ORDER_FORTRAN, real_type, newtype, ierror) + call MPI_TYPE_COMMIT(newtype,ierror) + call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & + MPI_MODE_CREATE+MPI_MODE_WRONLY, MPI_INFO_NULL, & + fh, ierror) + filesize = 0_MPI_OFFSET_KIND + call MPI_FILE_SET_SIZE(fh,filesize,ierror) ! guarantee overwriting + disp = 0_MPI_OFFSET_KIND + call MPI_FILE_SET_VIEW(fh,disp,real_type, & + newtype,'native',MPI_INFO_NULL,ierror) + call MPI_FILE_WRITE_ALL(fh, var, & + subsizes(1)*subsizes(2)*subsizes(3)*subsizes(4), & + real_type, MPI_STATUS_IGNORE, ierror) + call MPI_FILE_CLOSE(fh,ierror) + call MPI_TYPE_FREE(newtype,ierror) + + + return + end subroutine mpiio_write_real_probe + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Write a 3D data set covering a smaller sub-domain only +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine write_subdomain(ipencil,var,is,ie,js,je,ks,ke,filename) + + implicit none + + integer, intent(IN) :: ipencil !(x-pencil=1; y-pencil=2; z-pencil=3) + real(mytype), dimension(:,:,:), intent(IN) :: var + integer, intent(IN) :: is, ie, js, je, ks, ke + character(len=*), intent(IN) :: filename + + real(mytype), allocatable, dimension(:,:,:) :: wk, wk2 + integer(kind=MPI_OFFSET_KIND) :: filesize, disp + integer, dimension(3) :: sizes, subsizes, starts + integer :: color, key, errorcode, newcomm, ierror + integer :: newtype, fh, data_type, i, j, k + integer :: i1, i2, j1, j2, k1, k2 + + data_type = real_type + + ! validate the input paramters + if (is<1 .OR. ie>nx_global .OR. js<1 .OR. je>ny_global .OR. & + ks<1 .OR. ke>nz_global) then + errorcode = 10 + call decomp_2d_abort(errorcode, & + 'Invalid subdomain specified in I/O') + end if + + ! create a communicator for all those MPI ranks containing the subdomain + color = 1 + key = 1 + if (ipencil==1) then + if (xstart(1)>ie .OR. xend(1)je .OR. xend(2)ke .OR. xend(3)ie .OR. yend(1)je .OR. yend(2)ke .OR. yend(3)ie .OR. zend(1)je .OR. zend(2)ke .OR. zend(3)ie .AND. xstart(1)ie) then + subsizes(1) = ie - xstart(1) + 1 + end if + subsizes(2) = xsize(2) + starts(2) = xstart(2) - js + if (xend(2)>je .AND. xstart(2)je) then + subsizes(2) = je - xstart(2) + 1 + end if + subsizes(3) = xsize(3) + starts(3) = xstart(3) - ks + if (xend(3)>ke .AND. xstart(3)ke) then + subsizes(3) = ke - xstart(3) + 1 + end if + + else if (ipencil==2) then + + ! TODO + + else if (ipencil==3) then + + ! TODO + + end if + + + ! copy data from orginal to a temp array + ! pay attention to blocks only partially cover the sub-domain + if (ipencil==1) then + + if (xend(1)>ie .AND. xstart(1)ie) then + i1 = xstart(1) + i2 = ie + else if (xstart(1)je .AND. xstart(2)je) then + j1 = xstart(2) + j2 = je + else if (xstart(2)ke .AND. xstart(3)ke) then + k1 = xstart(3) + k2 = ke + else if (xstart(3) fh_live + names_ptr => fh_names +#else + live_ptrh => engine_live + names_ptr => engine_names +#endif + + idx = get_io_idx(io_name, io_dir) + if (idx .lt. 1) then + !! New io destination + if (nreg_io .lt. MAX_IOH) then + nreg_io = nreg_io + 1 + do idx = 1, MAX_IOH + if (.not. live_ptrh(idx)) then + live_ptrh(idx) = .true. + exit + end if + end do + + full_name = io_name//io_sep//io_dir + names_ptr(idx) = full_name + + if (mode .eq. decomp_2d_write_mode) then + !! Setup writers +#ifndef ADIOS2 + filesize = 0_MPI_OFFSET_KIND + fh_disp(idx) = 0_MPI_OFFSET_KIND + access_mode = MPI_MODE_CREATE + MPI_MODE_WRONLY +#else + access_mode = adios2_mode_write +#endif + else if (mode .eq. decomp_2d_read_mode) then + !! Setup readers +#ifndef ADIOS2 + fh_disp(idx) = 0_MPI_OFFSET_KIND + access_mode = MPI_MODE_RDONLY +#else + access_mode = adios2_mode_read +#endif + else if (mode .eq. decomp_2d_append_mode) then +#ifndef ADIOS2 + filesize = 0_MPI_OFFSET_KIND + fh_disp(idx) = 0_MPI_OFFSET_KIND + access_mode = MPI_MODE_CREATE + MPI_MODE_WRONLY +#else + access_mode = adios2_mode_append +#endif + else + print *, "ERROR: Unknown mode!" + stop + endif + + !! Open IO +#ifndef ADIOS2 + call MPI_FILE_OPEN(MPI_COMM_WORLD, io_dir, & + access_mode, MPI_INFO_NULL, & + fh_registry(idx), ierror) + if (mode .eq. decomp_2d_write_mode) then + !! Guarantee overwriting + call MPI_FILE_SET_SIZE(fh_registry(idx), filesize, ierror) + end if +#else + call adios2_at_io(io, adios, io_name, ierror) + if (io%valid) then + call adios2_open(engine_registry(idx), io, trim(gen_iodir_name(io_dir, io_name)), access_mode, ierror) + if (ierror /= 0) then + print *, "ERROR opening engine!" + stop + end if + else + print *, "ERROR: Couldn't find IO handle" + stop + end if +#endif + end if + end if + + end subroutine decomp_2d_open_io + + subroutine decomp_2d_close_io(io_name, io_dir) + + implicit none + + character(len=*), intent(in) :: io_name, io_dir + + character(len=1024), dimension(:), pointer :: names_ptr + logical, dimension(:), pointer :: live_ptrh + integer :: idx, ierror + + idx = get_io_idx(io_name, io_dir) +#ifndef ADIOS2 + names_ptr => fh_names + live_ptrh => fh_live + call MPI_FILE_CLOSE(fh_registry(idx), ierror) +#else + names_ptr => engine_names + live_ptrh => engine_live + call adios2_close(engine_registry(idx), ierror) + if (ierror /= 0) then + print *, "ERROR closing IO" + end if +#endif + names_ptr(idx) = "" + live_ptrh(idx) = .false. + nreg_io = nreg_io - 1 + + end subroutine decomp_2d_close_io + + subroutine decomp_2d_start_io(io_name, io_dir) + + implicit none + + character(len=*), intent(in) :: io_name, io_dir +#ifdef ADIOS2 + integer :: idx, ierror + + idx = get_io_idx(io_name, io_dir) + associate(engine => engine_registry(idx)) + if (engine%valid) then + call adios2_begin_step(engine, ierror) + if (ierror /= 0) then + print *, "ERROR beginning step" + stop + end if + else + print *, "ERROR trying to begin step with invalid engine" + stop + end if + end associate + + io_step(idx) = -1 +#endif + + end subroutine decomp_2d_start_io + + subroutine decomp_2d_end_io(io_name, io_dir) + + implicit none + + character(len=*), intent(in) :: io_name, io_dir +#ifdef ADIOS2 + integer :: idx, ierror + + idx = get_io_idx(io_name, io_dir) + associate(engine => engine_registry(idx)) + if (engine%valid) then + call adios2_end_step(engine, ierror) + if (ierror /= 0) then + print *, "ERROR ending step" + stop + end if + else + print *, "ERROR trying to end step with invalid engine" + stop + end if + end associate + + io_step(idx) = -1 +#endif + + end subroutine decomp_2d_end_io + + integer function get_io_idx(io_name, engine_name) + + implicit none + + character(len=*), intent(in) :: io_name + character(len=*), intent(in) :: engine_name + + character(len=(len(io_name)+len(io_sep)+len(engine_name))) :: full_name + integer :: idx + logical :: found + + character(len=1024), dimension(:), pointer :: names_ptr + +#ifndef ADIOS2 + names_ptr => fh_names +#else + names_ptr => engine_names +#endif + + full_name = io_name//io_sep//engine_name + + found = .false. + do idx = 1, MAX_IOH + if (names_ptr(idx) .eq. full_name) then + found = .true. + exit + end if + end do + + if (.not. found) then + idx = -1 + end if + + get_io_idx = idx + + end function get_io_idx + + function gen_iodir_name(io_dir, io_name) + + character(len=*), intent(in) :: io_dir, io_name + character(len=(len(io_dir) + 5)) :: gen_iodir_name +#ifdef ADIOS2 + integer :: ierror + type(adios2_io) :: io + character(len=5) :: ext +#endif + +#ifndef ADIOS2 + write(gen_iodir_name, "(A)") io_dir +#else + call adios2_at_io(io, adios, io_name, ierror) + if (io%engine_type .eq. "BP4") then + ext = ".bp4" + else if (io%engine_type .eq. "HDF5") then + ext = ".hdf5" + else + print *, "ERROR: Unkown engine type! ", io%engine_type + print *, "- IO: ", io_name + print *, "- DIR:", io_dir + stop + endif + write(gen_iodir_name, "(A,A)") trim(io_dir), trim(ext) +#endif + + end function gen_iodir_name + +end module decomp_2d_io diff --git a/docs/pages/user_guide/parameters.rst b/docs/pages/user_guide/parameters.rst index 47cd158bf..aa3036cf1 100644 --- a/docs/pages/user_guide/parameters.rst +++ b/docs/pages/user_guide/parameters.rst @@ -245,7 +245,7 @@ cex,cey,ra,nobjmax,nraf,nvol,iforces ForceCVs -------- -xld, xrd, yld, yud +xld, xrd, yld, yud, zld, zrd LMN --- diff --git a/inputs/input.i3d b/inputs/input.i3d new file mode 100644 index 000000000..be9f13b9a --- /dev/null +++ b/inputs/input.i3d @@ -0,0 +1,157 @@ +! -*- mode: f90 -*- + +!=================== +&BasicParam +!=================== + +! Flow type (1=Lock-exchange, 2=TGV, 3=Channel, 4=Periodic hill, 5=Cylinder, 6=dbg-schemes, 14 = ellipsoid) +itype = 14 + +! Domain decomposition +p_row=0 ! Row partition +p_col=0 ! Column partition + +! Mesh +nx=257 ! X-direction nodes +ny=64 ! Y-direction nodes +nz=64 ! Z-direction nodes +istret = 0 ! y mesh refinement (0:no, 1:center, 2:both sides, 3:bottom) +beta = 0.259065151 ! Refinement parameter (beta) + +! Domain +xlx = 20. ! Lx (Size of the box in x-direction) +yly = 6. ! Ly (Size of the box in y-direction) +zlz = 6. ! Lz (Size of the box in z-direction) + +! Boundary conditions +nclx1 = 2 +nclxn = 2 +ncly1 = 0 +nclyn = 0 +nclz1 = 0 +nclzn = 0 + + +! Flow parameters +iin = 1 ! Inflow conditions (1: classic, 2: turbinit) +re = 300. ! nu=1/re (Kinematic Viscosity) +u1 = 0. ! u1 (max velocity) (for inflow condition) +u2 = 0. ! u2 (min velocity) (for inflow condition) +init_noise = 0.125 ! Turbulence intensity (1=100%) !! Initial condition +inflow_noise = 0.0 ! Turbulence intensity (1=100%) !! Inflow condition + +! Time stepping +dt = 0.0075 ! Time step +ifirst = 1 ! First iteration +ilast = 2000 ! Last iteration + +! Enable modelling tools +ilesmod=0 ! if 0 then DNS +iscalar=0 ! If iscalar=0 (no scalar), if iscalar=1 (scalar) +iibm=2 ! Flag for immersed boundary method + +/End + +!==================== +&NumOptions +!==================== + +! Spatial derivatives +ifirstder = 4 ! (1->2nd central, 2->4th central, 3->4th compact, 4-> 6th compact) +isecondder = 5 ! (1->2nd central, 2->4th central, 3->4th compact, 4-> 6th compact, 5->hyperviscous 6th) +ipinter = 3 ! interpolation scheme (1: classic, 2: optimized, 3: optimized agressive) + +! Time scheme +itimescheme = 3 ! Time integration scheme (1->Euler,2->AB2, 3->AB3, 4->AB4,5->RK3,6->RK4) + +/End + +!================= +&InOutParam +!================= + +! Basic I/O +irestart = 0 ! Read initial flow field ? +icheckpoint = 10000 ! Frequency for writing backup file +ioutput = 25 ! Frequency for visualization +ilist = 10 ! Frequency for the output to screen +nvisu = 1 ! Size for visualisation collection + +/End + +!================= +&Statistics +!================= + +nstat = 1 ! Size arrays for statistic collection +initstat = 10000 ! Time steps after which statistics are collected + +/End + +!######################## +! OPTIONAL PARAMETERS +!####################### + +!================ +&ScalarParam +!================ + +numscalar = 0 ! How many scalars? +Sc = 0.2 ! Schmidt number + +/End + +!================ +&LESModel +!================ + +jles = 0 ! LES Model (1: Phys Smag, 2: Phys WALE, 3: Phys dyn. Smag, 4: iSVV, 5: dyn SEV) +smagcst = 0.14 ! Smagorinsky constant +SmagWallDamp = 1 ! 1: Mason and Thomson Damping function, otherwise OFF +walecst = 0.5 ! WALES Model Coefficient +iconserv = 0 ! Formulation SGS divergence (0: non conservative, 1: conservative) + +/End + + +!================ +&ibmstuff +!================ + +imove=1 +cex=5. !when simulating a cylinder x coordinate of the center +cey=3. !when simulating a cylinder y coordinate of the center +cez=3. !when simulating a sphere z coordinate of the center +shx=1. !shape parameters of ellipsoid +shy=0.7 +shz=0.4 +oriw=1.0 !orientation of ellipsoid +orii=0.0 +orij=0.0 +orik=0.0 +lvx=1.0 +lvy=0. +lvz=0. +avx=1. +avy=1. +avz=0. +rho_s=1. +ra=0.5 !when simulating an ellipsoid, equivalent radius +nraf=10 !level of refinement for iibm==2 to find the surface of the immersed object +nobjmax=2 !number of immersed objects (DO NOT USE ZERO OBJECTS) +iforces=1 +nvol=1 !Number of volumes for computing force balance + +/End + +&ForceCVs + +xld(1) = 4.0 !X left for volume control +xrd(1) = 6.0 !X right for volume control +yld(1) = 5.0 !Y bottom for volume control +yud(1) = 7.0 !Y top for volume control + +/End + +&CASE +/End diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 new file mode 100644 index 000000000..f25fd8a83 --- /dev/null +++ b/src/BC-Ellipsoid.f90 @@ -0,0 +1,518 @@ +module ellip + +USE decomp_2d_constants +USE decomp_2d_mpi +USE decomp_2d +USE variables +USE param + +IMPLICIT NONE + +integer :: FS +character(len=100) :: fileformat +character(len=1),parameter :: NL=char(10) !new line character + +PRIVATE ! All functions/subroutines private by default +PUBLIC :: init_ellip, boundary_conditions_ellip, postprocess_ellip, & + geomcomplex_ellip, visu_ellip, visu_ellip_init + +contains + +subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) + + use param, only : one, two, ten + use ibm_param + use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius, EllipsoidalRadius_debug + use complex_geometry, only: nraf,nyraf + + implicit none + + integer :: nxi,nxf,ny,nyi,nyf,nzi,nzf + real(mytype),dimension(nxi:nxf,nyi:nyf,nzi:nzf) :: epsi + real(mytype),dimension(ny) :: yp + real(mytype) :: dx,dz + real(mytype) :: remp + integer :: i,j,k, i_body + real(mytype) :: xm,ym,zm,r,rads2,kcon + real(mytype) :: zeromach + real(mytype) :: cexx,ceyy,cezz,dist_axi + real(mytype) :: point(3) + logical :: is_inside + + zeromach=one + do while ((one + zeromach / two) .gt. one) + zeromach = zeromach/two + end do + zeromach = ten*zeromach + is_inside=.false. + ! orientation=[oriw, orii, orij, orik] + do i = 1,nbody + call NormalizeQuaternion(orientation(i,:)) + enddo + ! shape=[shx, shy, shz] + ! write(*,*) shape, 'SHAPE' + + + ! Intitialise epsi + epsi(:,:,:)=zero + + + + ! Update center of moving ellipsoid + ! if (t.ne.0.) then + ! cexx=cex+lvx*(t-ifirst*dt) + ! ceyy=cey+lvy*(t-ifirst*dt) + ! cezz=cez+lvz*(t-ifirst*dt) + ! else + ! cexx=cex + ! ceyy=cey + ! cezz=cez + ! endif + ! position=[cexx,ceyy,cezz] + ! write(*,*) position + ! ce=[cexx, ceyy, cezz] + ! + ! Define adjusted smoothing constant +! kcon = log((one-0.0001)/0.0001)/(smoopar*0.5*dx) ! 0.0001 is the y-value, smoopar: desired number of affected points +! write(*,*) nzi, nzf + do k=nzi,nzf + zm=(real(k-1,mytype))*dz + ! write(*,*) k, zm + do j=nyi,nyf + ! ym=(real(j-1,mytype))*dy + ym=yp(j) + do i=nxi,nxf + xm=real(i-1,mytype)*dx + point=[xm, ym, zm] + ! call EllipsoidalRadius(point, position, orientation, shape, r) + do i_body = 1,nbody + if (cube_flag.eq.0) then + call EllipsoidalRadius(point,position(i_body,:),orientation(i_body,:),shape(i_body,:),r) + is_inside = (r-ra(i_body)).lt.zeromach + ! if (is_inside) then + ! call EllipsoidalRadius_debug(point,position(i_body,:),orientation(i_body,:),shape(i_body,:),r) + ! endif + if (ra(i_body) /= ra(i_body)) then + write(*,*) "Nrank = ", nrank + write(*,*) "Point = ", point + endif + else if (cube_flag.eq.1) then + is_inside = (abs(xm-position(i_body,1)).lt.ra(i_body)).and.(abs(ym-position(i_body,2)).lt.ra(i_body)).and.(abs(zm-position(i_body,3)).lt.ra(i_body)) + endif + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) + if (is_inside) then + ! write(*,*) i, j, k + epsi(i,j,k)=remp + cycle + endif + enddo + ! write(*,*) is_inside + + ! write(*,*) i, j, k, zm + ! epsi(i,j,k)=remp + ! write(*,*) remp + enddo + enddo + enddo + + return +end subroutine geomcomplex_ellip + +!******************************************************************** +subroutine boundary_conditions_ellip (ux,uy,uz,phi) + + USE param + USE variables + USE decomp_2d + + implicit none + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi + + call inflow (phi) + call outflow (ux,uy,uz,phi) + + return +end subroutine boundary_conditions_ellip +!******************************************************************** +subroutine inflow (phi) + + USE param + USE variables + USE decomp_2d + USE ibm_param + + implicit none + + integer :: i,j,k,is + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi + + if ((shear_flow_ybc.eq.1).or.(shear_flow_zbc.eq.1)) then + u1 = 0.0_mytype + u2 = 0.0_mytype + endif + + + !call random_number(bxo) + !call random_number(byo) + !call random_number(bzo) + do k=1,xsize(3) + do j=1,xsize(2) + bxx1(j,k)=u1+bxo(j,k)*inflow_noise + bxy1(j,k)=zero+byo(j,k)*inflow_noise + bxz1(j,k)=zero+bzo(j,k)*inflow_noise + enddo + enddo + + if (shear_flow_ybc.eq.1) then + do k=1,xsize(3) + do i=1,xsize(1) + byxn(i,k)=+shear_velocity + enddo + enddo + do k=1,xsize(3) + do i=1,xsize(1) + byx1(i,k)=-shear_velocity + enddo + enddo + endif + + if (shear_flow_zbc.eq.1) then + do j=1,xsize(2) + do i=1,xsize(1) + bzxn(i,j)=+shear_velocity + enddo + enddo + do j=1,xsize(2) + do i=1,xsize(1) + bzx1(i,j)=-shear_velocity + enddo + enddo + endif + + + if (iscalar.eq.1) then + do is=1, numscalar + do k=1,xsize(3) + do j=1,xsize(2) + phi(1,j,k,is)=cp(is) + enddo + enddo + enddo + endif + + return +end subroutine inflow +!******************************************************************** +subroutine outflow (ux,uy,uz,phi) + + USE param + USE variables + USE decomp_2d + USE MPI + USE ibm_param + + implicit none + + integer :: j,k,code + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi + real(mytype) :: udx,udy,udz,uddx,uddy,uddz,cx,uxmin,uxmax,uxmin1,uxmax1 + + udx=one/dx; udy=one/dy; udz=one/dz; uddx=half/dx; uddy=half/dy; uddz=half/dz + + uxmax=-1609._mytype + uxmin=1609._mytype + do k=1,xsize(3) + do j=1,xsize(2) + if (ux(nx-1,j,k).gt.uxmax) uxmax=ux(nx-1,j,k) + if (ux(nx-1,j,k).lt.uxmin) uxmin=ux(nx-1,j,k) + enddo + enddo + + call MPI_ALLREDUCE(uxmax,uxmax1,1,real_type,MPI_MAX,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(uxmin,uxmin1,1,real_type,MPI_MIN,MPI_COMM_WORLD,code) + + if (u1 == zero) then + cx=(half*(uxmax1+uxmin1))*gdt(itr)*udx + elseif (u1 == one) then + cx=uxmax1*gdt(itr)*udx + elseif (u1 == two) then + cx=u2*gdt(itr)*udx !works better + else + cx=(half*(u1+u2))*gdt(itr)*udx + endif + + do k=1,xsize(3) + do j=1,xsize(2) + bxxn(j,k)=ux(nx,j,k)-cx*(ux(nx,j,k)-ux(nx-1,j,k)) + bxyn(j,k)=uy(nx,j,k)-cx*(uy(nx,j,k)-uy(nx-1,j,k)) + bxzn(j,k)=uz(nx,j,k)-cx*(uz(nx,j,k)-uz(nx-1,j,k)) + enddo + enddo + + if (iscalar==1) then + if (u2==zero) then + cx=(half*(uxmax1+uxmin1))*gdt(itr)*udx + elseif (u2==one) then + cx=uxmax1*gdt(itr)*udx + elseif (u2==two) then + cx=u2*gdt(itr)*udx !works better + else + stop + endif + + do k=1,xsize(3) + do j=1,xsize(2) + phi(nx,j,k,:)=phi(nx,j,k,:)-cx*(phi(nx,j,k,:)-phi(nx-1,j,k,:)) + enddo + enddo + endif + + if (nrank==0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime == ilast)) & + write(*,*) "Outflow velocity ux nx=n min max=",real(uxmin1,4),real(uxmax1,4) + + return +end subroutine outflow +!******************************************************************** +subroutine init_ellip (ux1,uy1,uz1,phi1) + + USE decomp_2d + USE decomp_2d_io + USE variables + USE param + USE MPI + USE ibm_param + use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate + + + implicit none + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux1,uy1,uz1 + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi1 + + real(mytype) :: y,um,eqr,ym + integer :: k,j,i,ii,is,code,jj + + ! write(*,*) 'INSIDE INIT ELLIP' + + ! eqr=(sh(1)*sh(2)*sh(3))**(1.0/3.0) + ! shape=sh(:)/eqr + + ! orientation=ori + ! call NormalizeQuaternion(orientation) + ! position=ce + ! linearVelocity=lv + ! angularVelocity=[zero, av(1), av(2), av(3)] + ! call ellipInertiaCalculate(shape,rho_s,inertia) + ! call ellipMassCalculate(shape,rho_s,ellip_m) + + ! if (nrank==0) then + ! write(*,*) 'set shape = ', shape + ! write(*,*) 'set orientation = ', orientation + ! write(*,*) 'set position = ', position + ! write(*,*) 'set linear velocity = ', linearVelocity + ! write(*,*) 'set angular velocity = ', angularVelocity + ! write(*,*) 'set moment of inertia = ', inertia + ! write(*,*) 'density of solid = ', rho_s + ! end if + + if (iscalar==1) then + + phi1(:,:,:,:) = zero !change as much as you want + + endif + ! if (shear_flow_ybc.eq.1) then + ! do i=1,xsize(1) + ! do j=1,xsize(2) + ! jj=j+xstart(2)-1 + ! ym=real(jj)*dy + ! do k=1,xsize(3) + ! ux1(i,j,k)=real((jj-(ny/2)))/(yly/2.0)*shear_velocity + ! enddo + ! enddo + ! enddo + ! else + ux1=zero; + ! endif + + + uy1=zero; uz1=zero + + if (iin.ne.0) then + call system_clock(count=code) + if (iin.eq.2) code=0 + call random_seed(size = ii) + call random_seed(put = code+63946*(nrank+1)*(/ (i - 1, i = 1, ii) /)) + + call random_number(ux1) + call random_number(uy1) + call random_number(uz1) + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + ux1(i,j,k)=init_noise*(ux1(i,j,k)-0.5) + uy1(i,j,k)=init_noise*(uy1(i,j,k)-0.5) + uz1(i,j,k)=init_noise*(uz1(i,j,k)-0.5) + enddo + enddo + enddo + + !modulation of the random noise + do k=1,xsize(3) + do j=1,xsize(2) + if (istret.eq.0) y=(j+xstart(2)-1-1)*dy-yly/2. + if (istret.ne.0) y=yp(j+xstart(2)-1)-yly/2. + um=exp(-zptwo*y*y) + do i=1,xsize(1) + ux1(i,j,k)=um*ux1(i,j,k) + uy1(i,j,k)=um*uy1(i,j,k) + uz1(i,j,k)=um*uz1(i,j,k) + enddo + enddo + enddo + endif + + !INIT FOR G AND U=MEAN FLOW + NOISE + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + ux1(i,j,k)=ux1(i,j,k)+u1 + uy1(i,j,k)=uy1(i,j,k) + if (shear_flow_ybc.eq.1) then + ux1(i,j,k)=ux1(i,j,k)+((j+xstart(2)-1-1)*dy-yly/2.)/(yly/2.0)*shear_velocity + endif + if (shear_flow_zbc.eq.1) then + ux1(i,j,k)=ux1(i,j,k)+((k+xstart(3)-1-1)*dz-zlz/2.)/(zlz/2.0)*shear_velocity + endif + uz1(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + +#ifdef DEBG + if (nrank .eq. 0) write(*,*) '# init end ok' +#endif + + return +end subroutine init_ellip +!******************************************************************** + +!############################################################################ +subroutine postprocess_ellip(ux1,uy1,uz1,ep1) + + USE MPI + USE decomp_2d + USE decomp_2d_io + USE var, only : uvisu + USE var, only : ta1,tb1,tc1,td1,te1,tf1,tg1,th1,ti1,di1 + USE var, only : ta2,tb2,tc2,td2,te2,tf2,di2,ta3,tb3,tc3,td3,te3,tf3,di3 + USE ibm_param + + real(mytype),intent(in),dimension(xsize(1),xsize(2),xsize(3)) :: ux1, uy1, uz1, ep1 + +end subroutine postprocess_ellip + +subroutine visu_ellip_init (visu_initialised) + + use decomp_2d + use decomp_2d_io, only : decomp_2d_register_variable + use visu, only : io_name, output2D + + implicit none + + logical, intent(out) :: visu_initialised + + call decomp_2d_register_variable(io_name, "vort", 1, 0, output2D, mytype) + call decomp_2d_register_variable(io_name, "critq", 1, 0, output2D, mytype) + + visu_initialised = .true. + +end subroutine visu_ellip_init +!############################################################################ +!! +!! SUBROUTINE: visu_ellip +!! AUTHOR: FS +!! DESCRIPTION: Performs ellipinder-specific visualization +!! +!############################################################################ +subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) + + use var, only : ux2, uy2, uz2, ux3, uy3, uz3 + USE var, only : ta1,tb1,tc1,td1,te1,tf1,tg1,th1,ti1,di1 + USE var, only : ta2,tb2,tc2,td2,te2,tf2,di2,ta3,tb3,tc3,td3,te3,tf3,di3 + use var, ONLY : nxmsize, nymsize, nzmsize + use visu, only : write_field + use ibm_param, only : ubcx,ubcy,ubcz,inviscid_output + + implicit none + + real(mytype), intent(in), dimension(xsize(1),xsize(2),xsize(3)) :: ux1, uy1, uz1 + real(mytype), intent(in), dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize,npress) :: pp3 + real(mytype), intent(in), dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi1 + real(mytype), intent(in), dimension(xsize(1),xsize(2),xsize(3)) :: ep1 + integer, intent(in) :: num + + ! Write vorticity as an example of post processing + + ! Perform communications if needed + if (sync_vel_needed) then + call transpose_x_to_y(ux1,ux2) + call transpose_x_to_y(uy1,uy2) + call transpose_x_to_y(uz1,uz2) + call transpose_y_to_z(ux2,ux3) + call transpose_y_to_z(uy2,uy3) + call transpose_y_to_z(uz2,uz3) + sync_vel_needed = .false. + endif + + !x-derivatives + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx is 1. etc + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) + !y-derivatives + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) + !!z-derivatives + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) + !!all back to x-pencils + call transpose_z_to_y(ta3,td2) + call transpose_z_to_y(tb3,te2) + call transpose_z_to_y(tc3,tf2) + call transpose_y_to_x(td2,tg1) + call transpose_y_to_x(te2,th1) + call transpose_y_to_x(tf2,ti1) + call transpose_y_to_x(ta2,td1) + call transpose_y_to_x(tb2,te1) + call transpose_y_to_x(tc2,tf1) + !du/dx=ta1 du/dy=td1 and du/dz=tg1 + !dv/dx=tb1 dv/dy=te1 and dv/dz=th1 + !dw/dx=tc1 dw/dy=tf1 and dw/dz=ti1 + !VORTICITY FIELD + di1 = zero + di1(:,:,:)=sqrt( (tf1(:,:,:)-th1(:,:,:))**2 & + + (tg1(:,:,:)-tc1(:,:,:))**2 & + + (tb1(:,:,:)-td1(:,:,:))**2) + + if (inviscid_output.eq.0) then + + call write_field(di1, ".", "vort", num, flush = .true.) ! Reusing temporary array, force flush + + !Q=-0.5*(ta1**2+te1**2+ti1**2)-td1*tb1-tg1*tc1-th1*tf1 + di1 = zero + di1(:,:,: ) = - half*(ta1(:,:,:)**2+te1(:,:,:)**2+ti1(:,:,:)**2) & + - td1(:,:,:)*tb1(:,:,:) & + - tg1(:,:,:)*tc1(:,:,:) & + - th1(:,:,:)*tf1(:,:,:) + call write_field(di1, ".", "critq", num, flush = .true.) ! Reusing temporary array, force flush + endif +end subroutine visu_ellip + +end module ellip + \ No newline at end of file diff --git a/src/BC-dbg-schemes.f90 b/src/BC-dbg-schemes.f90 new file mode 100644 index 000000000..c208f8435 --- /dev/null +++ b/src/BC-dbg-schemes.f90 @@ -0,0 +1,1477 @@ +!Copyright (c) 2012-2022, Xcompact3d +!This file is part of Xcompact3d (xcompact3d.com) +!SPDX-License-Identifier: BSD 3-Clause + +module dbg_schemes + + use decomp_2d + use variables + use param + + implicit none + + private ! All functions/subroutines private by default + public :: init_dbg, boundary_conditions_dbg, postprocess_dbg + public :: sin_prec, cos_prec, tan_prec, & + asin_prec, acos_prec, atan_prec, & + sinh_prec, cosh_prec, tanh_prec, & + exp_prec, log_prec,log10_prec, & + sqrt_prec, abs_prec + +contains + !******************************************************************** + subroutine init_dbg (ux1,uy1,uz1,ep1,phi1) + + use decomp_2d + use decomp_2d_io + use variables + use param + use MPI + + implicit none + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux1,uy1,uz1,ep1 + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi1 + + integer :: code, ierror + + call debug_schemes() + call MPI_ABORT(MPI_COMM_WORLD,code,ierror) + + return + end subroutine init_dbg + !******************************************************************** + subroutine boundary_conditions_dbg (ux,uy,uz,phi) + + use param + use variables + use decomp_2d + + implicit none + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi + + return + end subroutine boundary_conditions_dbg + + !################################################################## + !******************************************************************** + ! Math functions for Single/double precision + !------------------------------------------- + function sin_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dsin(x) +#else + y = sin(x) +#endif + end function sin_prec + !------------------------------------------- + function cos_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dcos(x) +#else + y = cos(x) +#endif + end function cos_prec + !------------------------------------------- + function tan_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dtan(x) +#else + y = tan(x) +#endif + end function tan_prec + !------------------------------------------- + function asin_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dasin(x) +#else + y = asin(x) +#endif + end function asin_prec + !------------------------------------------- + function acos_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dacos(x) +#else + y = acos(x) +#endif + end function acos_prec + !------------------------------------------- + function atan_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = datan(x) +#else + y = atan(x) +#endif + end function atan_prec + !------------------------------------------- + function sinh_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dsinh(x) +#else + y = sinh(x) +#endif + end function sinh_prec + !------------------------------------------- + function cosh_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dcosh(x) +#else + y = cosh(x) +#endif + end function cosh_prec + !------------------------------------------- + function tanh_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dtanh(x) +#else + y = tanh(x) +#endif + end function tanh_prec + !------------------------------------------- + function exp_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dexp(x) +#else + y = exp(x) +#endif + end function exp_prec + !------------------------------------------- + function log_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dlog(x) +#else + y = alog(x) +#endif + end function log_prec + !------------------------------------------- + function log10_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dlog10(x) +#else + y = alog10(x) +#endif + end function log10_prec + !------------------------------------------- + function sqrt_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dsqrt(x) +#else + y = sqrt(x) +#endif + end function sqrt_prec + !------------------------------------------- + function abs_prec(x) result(y) + USE decomp_2d, only : mytype + real(mytype), intent(in) :: x + real(mytype) :: y +#ifdef DOUBLE_PREC + y = dabs(x) +#else + y = abs(x) +#endif + end function abs_prec + + !******************************************************************** + subroutine xerrors(dfdx1, dfdxp1, dfdxx1, dfdxxp1) + + real(mytype), dimension(:,:,:), intent(in) :: dfdx1, dfdxp1, dfdxx1, dfdxxp1 + + real(mytype) :: x, err, avg, expt + integer :: i + + err = 0._mytype + do i = 1, size(dfdx1, 1) + x = real(i - 1, mytype) * dx + expt = four * pi * cos_prec(four * pi * x) + + avg = sum(dfdx1(i,:,:)) / size(dfdx1, 2) / size(dfdx1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdx1, 1)) + print *, "dfdx1 RMS error: ", err + + err = 0._mytype + do i = 1, size(dfdxp1, 1) + x = real(i - 1, mytype) * dx + expt = -four * pi * sin_prec(four * pi * x) + + avg = sum(dfdxp1(i,:,:)) / size(dfdxp1, 2) / size(dfdxp1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdxp1, 1)) + print *, "dfdxp1 RMS error: ", err + + err = 0._mytype + do i = 1, size(dfdxx1, 1) + x = real(i - 1, mytype) * dx + expt = -sixteen * (pi**2) * sin_prec(four * pi * x) + + avg = sum(dfdxx1(i,:,:)) / size(dfdxx1, 2) / size(dfdxx1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdxx1, 1)) + print *, "dfdxx1 RMS error: ", err + + err = 0._mytype + do i = 1, size(dfdxxp1, 1) + x = real(i - 1, mytype) * dx + expt = -sixteen * (pi**2) * cos_prec(four * pi * x) + + avg = sum(dfdxxp1(i,:,:)) / size(dfdxxp1, 2) / size(dfdxxp1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdxxp1, 1)) + print *, "dfdxxp1 RMS error: ", err + + end subroutine xerrors + subroutine yerrors(dfdy1, dfdyp1, dfdyy1, dfdyyp1) + + real(mytype), dimension(:,:,:), intent(in) :: dfdy1, dfdyp1, dfdyy1, dfdyyp1 + + real(mytype) :: y, err, avg, expt + integer :: j + + err = 0._mytype + do j = 1, size(dfdy1, 2) + y = real(j - 1, mytype) * dy + expt = four * pi * cos_prec(four * pi * y) + + avg = sum(dfdy1(:,j,:)) / size(dfdy1, 1) / size(dfdy1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdy1, 2)) + print *, "dfdy1 RMS error: ", err + + err = 0._mytype + do j = 1, size(dfdyp1, 2) + y = real(j - 1, mytype) * dy + expt = -four * pi * sin_prec(four * pi * y) + + avg = sum(dfdyp1(:,j,:)) / size(dfdyp1, 1) / size(dfdyp1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdyp1, 2)) + print *, "dfdyp1 RMS error: ", err + + err = 0._mytype + do j = 1, size(dfdyy1, 2) + y = real(j - 1, mytype) * dy + expt = -sixteen * (pi**2) * sin_prec(four * pi * y) + + avg = sum(dfdyy1(:,j,:)) / size(dfdyy1, 1) / size(dfdyy1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdyy1, 2)) + print *, "dfdyy1 RMS error: ", err + + err = 0._mytype + do j = 1, size(dfdyyp1, 1) + y = real(j - 1, mytype) * dy + expt = -sixteen * (pi**2) * cos_prec(four * pi * y) + + avg = sum(dfdyyp1(:,j,:)) / size(dfdyyp1, 1) / size(dfdyyp1, 3) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdyyp1, 2)) + print *, "dfdyyp1 RMS error: ", err + + end subroutine yerrors + subroutine zerrors(dfdz1, dfdzp1, dfdzz1, dfdzzp1) + + real(mytype), dimension(:,:,:), intent(in) :: dfdz1, dfdzp1, dfdzz1, dfdzzp1 + + real(mytype) :: z, err, avg, expt + integer :: k + + err = 0._mytype + do k = 1, size(dfdz1, 3) + z = real(k - 1, mytype) * dz + expt = four * pi * cos_prec(four * pi * z) + + avg = sum(dfdz1(:,:,k)) / size(dfdz1, 1) / size(dfdz1, 2) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdz1, 3)) + print *, "dfdz1 RMS error: ", err + + err = 0._mytype + do k = 1, size(dfdzp1, 3) + z = real(k - 1, mytype) * dz + expt = -four * pi * sin_prec(four * pi * z) + + avg = sum(dfdzp1(:,:,k)) / size(dfdzp1, 1) / size(dfdzp1, 2) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdzp1, 3)) + print *, "dfdzp1 RMS error: ", err + + err = 0._mytype + do k = 1, size(dfdzz1, 3) + z = real(k - 1, mytype) * dz + expt = -sixteen * (pi**2) * sin_prec(four * pi * z) + + avg = sum(dfdzz1(:,:,k)) / size(dfdzz1, 1) / size(dfdzz1, 2) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdzz1, 3)) + print *, "dfdzz1 RMS error: ", err + + err = 0._mytype + do k = 1, size(dfdzzp1, 1) + z = real(k - 1, mytype) * dz + expt = -sixteen * (pi**2) * cos_prec(four * pi * z) + + avg = sum(dfdzzp1(:,:,k)) / size(dfdzzp1, 1) / size(dfdzzp1, 2) + err = err + (expt - avg)**2 + end do + err = sqrt(err / size(dfdzzp1, 3)) + print *, "dfdzzp1 RMS error: ", err + + end subroutine zerrors + subroutine debug_schemes() + + USE param + USE variables + USE decomp_2d + USE var, only : nxmsize, nymsize, nzmsize + + implicit none + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: fx1, ffx1, ffxp1, fiffx1, fiffxp1, fxp1, dfdx1, dfdxp1, dfdxx1, dfdxxp1, di1, rand1 + real(mytype),dimension(ysize(1),ysize(2),ysize(3)) :: fy2, ffy2, ffyp2, fiffy2, fiffyp2, fyp2, dfdy2, dfdyp2, dfdyy2, dfdyyp2, di2, rand2 + real(mytype),dimension(zsize(1),zsize(2),zsize(3)) :: fz3, ffz3, ffzp3, fiffz3, fiffzp3, fzp3, dfdz3, dfdzp3, dfdzz3, dfdzzp3, di3, rand3 + real(mytype), save, allocatable, dimension(:,:,:) :: test1,test11,test2,test22,test3,test33 + real(mytype) :: x,x1,y,y1,z,z1 + integer :: i,j,k + character(len=30) :: filename + + allocate(test1(nxmsize,xsize(2),xsize(3))) + allocate(test11(nxmsize,xsize(2),xsize(3))) + allocate(test2(ysize(1),nymsize,ysize(3))) + allocate(test22(ysize(1),nymsize,ysize(3))) + allocate(test3(zsize(1),zsize(2),nzmsize)) + allocate(test33(zsize(1),zsize(2),nzmsize)) + + nclx1=1 + nclxn=1 + ncly1=1 + nclyn=1 + nclz1=1 + nclzn=1 + call schemes() + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + fx1(i,j,k) = sin_prec(x) !odd + fxp1(i,j,k) = cos_prec(x) !even + enddo + enddo + enddo + call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,0) + call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(67,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(1) + x = real(i-1,mytype)*dx + write(67,'(9E14.6)') x,& + four*pi*cos_prec(four*pi*x),dfdx1(i,1,1),& + -four*pi*sin_prec(four*pi*x),dfdxp1(i,1,1),& + -sixteen*pi*pi*sin_prec(four*pi*x),dfdxx1(i,1,1),& + -sixteen*pi*pi*cos_prec(four*pi*x),dfdxxp1(i,1,1) + enddo + close(67) + endif + call xerrors(dfdx1, dfdxp1, dfdxx1, dfdxxp1) + call derxvp(test1,fx1,di1,sx,cfx6,csx6,cwx6,xsize(1),nxmsize,xsize(2),xsize(3),0) + call interxvp(test11,fxp1,di1,sx,cifxp6,cisxp6,ciwxp6,xsize(1),nxmsize,xsize(2),xsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_xVP',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(68,file=trim(filename),status='unknown',form='formatted') + do i=1,nxmsize + x1 = real(i-half,mytype)*dx + write(68,'(5E14.6)') x1,& + four*pi*cos_prec(four*pi*x1),test1(i,1,1),& + cos_prec(four*pi*x1),test11(i,1,1) + enddo + close(68) + endif + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,nxmsize + x1 = real(i-0.5,mytype)*dx*four*pi + test1(i,j,k) = cos_prec(x1) + enddo + enddo + enddo + call derxpv(fx1,test1,di1,sx,cfip6,csip6,cwip6,cfx6,csx6,cwx6,& + nxmsize,xsize(1),xsize(2),xsize(3),1) + call interxpv(fxp1,test1,di1,sx,cifip6,cisip6,ciwip6,cifx6,cisx6,ciwx6,& + nxmsize,xsize(1),xsize(2),xsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_xPV',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(69,file=trim(filename),status='unknown',form='formatted') + do i=1,nxmsize + x = real(i-1.,mytype)*dx + write(69,'(5E14.6)') x,& + -four*pi*sin_prec(four*pi*x),fx1(i,1,1),& + cos_prec(four*pi*x),fxp1(i,1,1) + enddo + close(69) + endif + + ! FILTER + call random_number(rand1) + call filter(0.45_mytype) + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + ffx1(i,j,k) = sin_prec(x)+sin_prec(ten*x)+0.25*rand1(i,j,k) !odd + ffxp1(i,j,k) = cos_prec(x)+cos_prec(ten*x)+0.25*rand1(i,j,k) !even + enddo + enddo + enddo + + call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(70,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(2) + x = real(i-1,mytype)*dx + write(70,'(9E14.6)') x,& + ffx1(i,1,1),fiffx1(i,1,1),& + ffxp1(i,1,1),fiffxp1(i,1,1) + enddo + close(70) + endif + + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*4*pi + do i=1,ysize(1) + fy2(i,j,k) = sin_prec(y) + fyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,0) + call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + call deryy (dfdyy2 ,fy2 ,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,0) + call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + if (nrank.eq.0) then + write(filename,"('schemes_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(67,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(67,'(9E14.6)') y,& + four*pi*cos_prec(four*pi*y),dfdy2(1,j,1),& + -four*pi*sin_prec(four*pi*y),dfdyp2(1,j,1),& + -sixteen*pi*pi*sin_prec(four*pi*y),dfdyy2(1,j,1),& + -sixteen*pi*pi*cos_prec(four*pi*y),dfdyyp2(1,j,1) + enddo + close(67) + endif + call yerrors(dfdy2, dfdyp2, dfdyy2, dfdyyp2) + call deryvp(test2,fy2,di2,sy,cfy6,csy6,cwy6,ppyi,ysize(1),ysize(2),nymsize,ysize(3),0) + call interyvp(test22,fyp2,di2,sy,cifyp6,cisyp6,ciwyp6,ysize(1),ysize(2),nymsize,ysize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_yVP',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(68,file=trim(filename),status='unknown',form='formatted') + do j=1,nymsize + y1 = real(j-half,mytype)*dy + write(68,'(5E14.6)') y1,& + four*pi*cos_prec(four*pi*y1),test2(1,j,1),& + cos_prec(four*pi*y1),test22(1,j,1) + enddo + close(68) + endif + do k=1,ysize(3) + do j=1,nymsize + y1 = real(j-half,mytype)*dy*4*pi + do i=1,ysize(1) + test2(i,j,k) = cos_prec(y1) + enddo + enddo + enddo + call derypv(fy2,test2,di2,sy,cfip6y,csip6y,cwip6y,cfy6,csy6,cwy6,ppy,& + ysize(1),nymsize,ysize(2),ysize(3),1) + call interypv(fyp2,test2,di2,sy,cifip6y,cisip6y,ciwip6y,cify6,cisy6,ciwy6,& + ysize(1),nymsize,ysize(2),ysize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_yPV',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(69,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(69,'(5E14.6)') y,& + -four*pi*sin_prec(four*pi*y),fy2(1,j,1),& + cos_prec(four*pi*y),fyp2(1,j,1) + enddo + close(69) + endif + + ! FILTER + call filter(0.45_mytype) + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*four*pi + do i=1,ysize(1) + ffy2(i,j,k) = sin_prec(y) + ffyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + + call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(70,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(70,'(9E14.6)') y,& + ffy2(1,j,1),fiffy2(1,j,1),& + ffyp2(1,j,1),fiffyp2(1,j,1) + enddo + close(70) + endif + + do k=1,zsize(3) + z = real(k-1,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + fz3(i,j,k) = sin_prec(z) + fzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,0) + call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,0) + call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,0) + call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(67,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(67,'(9E14.6)') z,& + four*pi*cos_prec(four*pi*z),dfdz3(1,1,k),& + -four*pi*sin_prec(four*pi*z),dfdzp3(1,1,k),& + -sixteen*pi*pi*sin_prec(four*pi*z),dfdzz3(1,1,k),& + -sixteen*pi*pi*cos_prec(four*pi*z),dfdzzp3(1,1,k) + enddo + close(67) + endif + call zerrors(dfdz3, dfdzp3, dfdzz3, dfdzzp3) + call derzvp(test3,fz3,di3,sz,cfz6,csz6,cwz6,zsize(1),zsize(2),zsize(3),nzmsize,0) + call interzvp(test33,fzp3,di3,sz,cifzp6,ciszp6,ciwzp6,zsize(1),zsize(2),zsize(3),nzmsize,1) + if (nrank.eq.0) then + write(filename,"('schemes_zVP',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(68,file=trim(filename),status='unknown',form='formatted') + do k=1,nzmsize + z1 = real(k-half,mytype)*dz + write(68,'(5E14.6)') z1,& + four*pi*cos_prec(four*pi*z1),test3(1,1,k),& + cos_prec(four*pi*z1),test33(1,1,k) + enddo + close(68) + endif + + do k=1,nzmsize + z1 = real(k-half,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + test3(i,j,k) = cos_prec(z1) + enddo + enddo + enddo + call derzpv(fz3,test3,di3,sz,cfip6z,csip6z,cwip6z,cfz6,csz6,cwz6,zsize(1),zsize(2),nzmsize,zsize(3),1) + call interzpv(fzp3,test3,di3,sz,cifip6z,cisip6z,ciwip6z,cifz6,cisz6,ciwz6,zsize(1),zsize(2),nzmsize,zsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_zPV',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(69,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(69,'(5E14.6)') z,& + -four*pi*sin_prec(four*pi*z),fz3(1,1,k),& + cos_prec(four*pi*z),fzp3(1,1,k) + enddo + close(69) + endif + + ! FILTER + call filter(0.45_mytype) + do k=1,zsize(3) + z = real(k-1,mytype)*dz*four*pi + do j=1,zsize(2) + do i=1,zsize(1) + ffz3(i,j,k) = sin_prec(z) + ffzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(70,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(70,'(9E14.6)') z,& + ffz3 (1,1,k),fiffz3 (1,1,k),& + ffzp3(1,1,k),fiffzp3(1,1,k) + enddo + close(70) + endif + + !############################################################### + !############################################################### + + nclx1=2 + nclxn=2 + ncly1=2 + nclyn=2 + nclz1=2 + nclzn=2 + call schemes() + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + fx1(i,j,k) = sin_prec(x) !odd + enddo + enddo + enddo + call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + if (nrank.eq.0) then + write(filename,"('schemes_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(67,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(1) + x = real(i-1,mytype)*dx + write(67,'(5E14.6)') x,& + four*pi*cos_prec(four*pi*x),dfdx1(i,1,1),& + -sixteen*pi*pi*sin_prec(four*pi*x),dfdxx1(i,1,1) + enddo + close(67) + endif + + ! FILTER + call random_number(rand1) + call filter(-0.45_mytype) + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + ffx1(i,j,k) = sin_prec(x)+sin_prec(two*x)+rand1(i,j,k) !odd + ffxp1(i,j,k) = cos_prec(x)+cos_prec(two*x)+rand1(i,j,k) !even + enddo + enddo + enddo + + call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(70,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(2) + x = real(i-1,mytype)*dx + write(70,'(9E14.6)') x,& + ffx1(i,1,1),fiffx1(i,1,1),& + ffxp1(i,1,1),fiffxp1(i,1,1) + enddo + close(70) + endif + + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*4*pi + do i=1,ysize(1) + fy2(i,j,k) = sin_prec(y) + enddo + enddo + enddo + call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,0) + iimplicit = -iimplicit + call deryy (dfdyy2 ,fy2 ,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,0) + iimplicit = -iimplicit + if (nrank.eq.0) then + write(filename,"('schemes_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(67,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(67,'(5E14.6)') y,& + four*pi*cos_prec(four*pi*y),dfdy2(1,j,1),& + -sixteen*pi*pi*sin_prec(four*pi*y),dfdyy2(1,j,1) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*four*pi + do i=1,ysize(1) + ffy2(i,j,k) = sin_prec(y) + ffyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + + call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(70,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(70,'(9E14.6)') y,& + ffy2(1,j,1),fiffy2(1,j,1),& + ffyp2(1,j,1),fiffyp2(1,j,1) + enddo + close(70) + endif + do k=1,zsize(3) + z = real(k-1,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + fz3(i,j,k) = sin_prec(z) + enddo + enddo + enddo + call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,0) + call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,0) + if (nrank.eq.0) then + write(filename,"('schemes_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(67,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(67,'(5E14.6)') z,& + four*pi*cos_prec(four*pi*z),dfdz3(1,1,k),& + -sixteen*pi*pi*sin_prec(four*pi*z),dfdzz3(1,1,k) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,zsize(3) + z = real(k-1,mytype)*dz*four*pi + do j=1,zsize(2) + do i=1,zsize(1) + ffz3(i,j,k) = sin_prec(z) + ffzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(70,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(70,'(9E14.6)') z,& + ffz3 (1,1,k),fiffz3 (1,1,k),& + ffzp3(1,1,k),fiffzp3(1,1,k) + enddo + close(70) + endif + + !############################################################### + !############################################################### + + nclx1=2 + nclxn=1 + ncly1=2 + nclyn=1 + nclz1=2 + nclzn=1 + call schemes() + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + fx1(i,j,k) = sin_prec(x) !odd + fxp1(i,j,k) = cos_prec(x) !even + enddo + enddo + enddo + call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,0) + call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(67,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(1) + x = real(i-1,mytype)*dx + write(67,'(9E14.6)') x,& + four*pi*cos_prec(four*pi*x),dfdx1(i,1,1),& + -four*pi*sin_prec(four*pi*x),dfdxp1(i,1,1),& + -sixteen*pi*pi*sin_prec(four*pi*x),dfdxx1(i,1,1),& + -sixteen*pi*pi*cos_prec(four*pi*x),dfdxxp1(i,1,1) + enddo + close(67) + endif + ! FILTER + call random_number(rand1) + call filter(0.45_mytype) + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + ffx1(i,j,k) = sin_prec(x)+sin_prec(ten*x)+0.25*rand1(i,j,k) !odd + ffxp1(i,j,k) = cos_prec(x)+cos_prec(ten*x)+0.25*rand1(i,j,k) !even + enddo + enddo + enddo + + call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(70,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(2) + x = real(i-1,mytype)*dx + write(70,'(9E14.6)') x,& + ffx1(i,1,1),fiffx1(i,1,1),& + ffxp1(i,1,1),fiffxp1(i,1,1) + enddo + close(70) + endif + + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*4*pi + do i=1,ysize(1) + fy2(i,j,k) = sin_prec(y) + fyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,0) + call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + call deryy (dfdyy2 ,fy2 ,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,0) + call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + if (nrank.eq.0) then + write(filename,"('schemes_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(67,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(67,'(9E14.6)') y,& + four*pi*cos_prec(four*pi*y),dfdy2(1,j,1),& + -four*pi*sin_prec(four*pi*y),dfdyp2(1,j,1),& + -sixteen*pi*pi*sin_prec(four*pi*y),dfdyy2(1,j,1),& + -sixteen*pi*pi*cos_prec(four*pi*y),dfdyyp2(1,j,1) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*four*pi + do i=1,ysize(1) + ffy2(i,j,k) = sin_prec(y) + ffyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + + call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(70,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(70,'(9E14.6)') y,& + ffy2(1,j,1),fiffy2(1,j,1),& + ffyp2(1,j,1),fiffyp2(1,j,1) + enddo + close(70) + endif + + do k=1,zsize(3) + z = real(k-1,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + fz3(i,j,k) = sin_prec(z) + fzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,0) + call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,0) + call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,0) + call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(67,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(67,'(9E14.6)') z,& + four*pi*cos_prec(four*pi*z),dfdz3(1,1,k),& + -four*pi*sin_prec(four*pi*z),dfdzp3(1,1,k),& + -sixteen*pi*pi*sin_prec(four*pi*z),dfdzz3(1,1,k),& + -sixteen*pi*pi*cos_prec(four*pi*z),dfdzzp3(1,1,k) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,zsize(3) + z = real(k-1,mytype)*dz*four*pi + do j=1,zsize(2) + do i=1,zsize(1) + ffz3(i,j,k) = sin_prec(z) + ffzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(70,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(70,'(9E14.6)') z,& + ffz3 (1,1,k),fiffz3 (1,1,k),& + ffzp3(1,1,k),fiffzp3(1,1,k) + enddo + close(70) + endif + + !############################################################### + !############################################################### + + nclx1=1 + nclxn=2 + ncly1=1 + nclyn=2 + nclz1=1 + nclzn=2 + call schemes() + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + fx1(i,j,k) = sin_prec(x) !odd + fxp1(i,j,k) = cos_prec(x) !even + enddo + enddo + enddo + call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,0) + call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(67,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(1) + x = real(i-1,mytype)*dx + write(67,'(9E14.6)') x,& + four*pi*cos_prec(four*pi*x),dfdx1(i,1,1),& + -four*pi*sin_prec(four*pi*x),dfdxp1(i,1,1),& + -sixteen*pi*pi*sin_prec(four*pi*x),dfdxx1(i,1,1),& + -sixteen*pi*pi*cos_prec(four*pi*x),dfdxxp1(i,1,1) + enddo + close(67) + endif + ! FILTER + call random_number(rand1) + call filter(0.45_mytype) + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + ffx1(i,j,k) = sin_prec(x)!+sin_prec(ten*x)+0.25*rand1(i,j,k) !odd + ffxp1(i,j,k) = cos_prec(x)!+cos_prec(ten*x)+0.25*rand1(i,j,k) !even + enddo + enddo + enddo + + call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(70,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(2) + x = real(i-1,mytype)*dx + write(70,'(9E14.6)') x,& + ffx1(i,1,1),fiffx1(i,1,1),& + ffxp1(i,1,1),fiffxp1(i,1,1) + enddo + close(70) + endif + + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*4*pi + do i=1,ysize(1) + fy2(i,j,k) = sin_prec(y) + fyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,0) + call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + call deryy (dfdyy2 ,fy2 ,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,0) + call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,0) + iimplicit = -iimplicit + if (nrank.eq.0) then + write(filename,"('schemes_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(67,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(67,'(9E14.6)') y,& + four*pi*cos_prec(four*pi*y),dfdy2(1,j,1),& + -four*pi*sin_prec(four*pi*y),dfdyp2(1,j,1),& + -sixteen*pi*pi*sin_prec(four*pi*y),dfdyy2(1,j,1),& + -sixteen*pi*pi*cos_prec(four*pi*y),dfdyyp2(1,j,1) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*four*pi + do i=1,ysize(1) + ffy2(i,j,k) = sin_prec(y) + ffyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + + call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(70,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(70,'(9E14.6)') y,& + ffy2(1,j,1),fiffy2(1,j,1),& + ffyp2(1,j,1),fiffyp2(1,j,1) + enddo + close(70) + endif + + do k=1,zsize(3) + z = real(k-1,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + fz3(i,j,k) = sin_prec(z) + fzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,0) + call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,0) + call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,0) + call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('schemes_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(67,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(67,'(9E14.6)') z,& + four*pi*cos_prec(four*pi*z),dfdz3(1,1,k),& + -four*pi*sin_prec(four*pi*z),dfdzp3(1,1,k),& + -sixteen*pi*pi*sin_prec(four*pi*z),dfdzz3(1,1,k),& + -sixteen*pi*pi*cos_prec(four*pi*z),dfdzzp3(1,1,k) + enddo + close(67) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,zsize(3) + z = real(k-1,mytype)*dz*four*pi + do j=1,zsize(2) + do i=1,zsize(1) + ffz3(i,j,k) = sin_prec(z) + ffzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(70,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(70,'(9E14.6)') z,& + ffz3 (1,1,k),fiffz3 (1,1,k),& + ffzp3(1,1,k),fiffzp3(1,1,k) + enddo + close(70) + endif + + !############################################################### + !############################################################### + deallocate(test1) + deallocate(test11) + deallocate(test2) + deallocate(test22) + deallocate(test3) + deallocate(test33) + nclx1=0 + nclxn=0 + ncly1=0 + nclyn=0 + nclz1=0 + nclzn=0 + nclx=.true. + ncly=.true. + nclz=.true. + nxm=nx + nym=ny + nzm=nz + nxmsize=xsize(1) + nymsize=ysize(2) + nzmsize=zsize(3) + dx=xlx/real(nxm,mytype) + dy=yly/real(nym,mytype) + dz=zlz/real(nzm,mytype) + dx2=dx*dx + dy2=dy*dy + dz2=dz*dz + call schemes() + allocate(test1(nxmsize,xsize(2),xsize(3))) + allocate(test11(nxmsize,xsize(2),xsize(3))) + allocate(test2(ysize(1),nymsize,ysize(3))) + allocate(test22(ysize(1),nymsize,ysize(3))) + allocate(test3(zsize(1),zsize(2),nzmsize)) + allocate(test33(zsize(1),zsize(2),nzmsize)) + + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + fx1(i,j,k) = sin_prec(x) !odd + fxp1(i,j,k) = cos_prec(x) + enddo + enddo + enddo + call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + if (nrank.eq.0) then + write(filename,"('schemes_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(67,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(1) + x = real(i-1,mytype)*dx + write(67,'(5E14.6)') x,& + four*pi*cos_prec(four*pi*x),dfdx1(i,1,1),& + -sixteen*pi*pi*sin_prec(four*pi*x),dfdxx1(i,1,1) + enddo + close(67) + endif + call derxvp(test1,fx1,di1,sx,cfx6,csx6,cwx6,xsize(1),nxmsize,xsize(2),xsize(3),0) + call interxvp(test11,fxp1,di1,sx,cifxp6,cisxp6,ciwxp6,xsize(1),nxmsize,xsize(2),xsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_xVP',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(68,file=trim(filename),status='unknown',form='formatted') + do i=1,nxmsize + x1 = real(i-half,mytype)*dx + write(68,'(5E14.6)') x1,& + four*pi*cos_prec(four*pi*x1),test1(i,1,1),& + cos_prec(four*pi*x1),test11(i,1,1) + enddo + close(68) + endif + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,nxmsize + x1 = real(i-0.5,mytype)*dx*four*pi + test1(i,j,k) = cos_prec(x1) + enddo + enddo + enddo + call derxpv(fx1,test1,di1,sx,cfip6,csip6,cwip6,cfx6,csx6,cwx6,& + nxmsize,xsize(1),xsize(2),xsize(3),1) + call interxpv(fxp1,test11,di1,sx,cifip6,cisip6,ciwip6,cifx6,cisx6,ciwx6,& + nxmsize,xsize(1),xsize(2),xsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_xPV',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(69,file=trim(filename),status='unknown',form='formatted') + do i=1,nxmsize + x = real(i-1.,mytype)*dx + write(69,'(5E14.6)') x,& + -four*pi*sin_prec(four*pi*x),fx1(i,1,1),& + cos_prec(four*pi*x),fxp1(i,1,1) + enddo + close(69) + endif + + ! FILTER + call random_number(rand1) + call filter(-0.45_mytype) + do k=1,xsize(3) + do j=1,xsize(2) + do i=1,xsize(1) + x = real(i-1,mytype)*dx*four*pi + ffx1(i,j,k) = sin_prec(x)+sin_prec(ten*x)+rand1(i,j,k) !odd + ffxp1(i,j,k) = cos_prec(x)+cos_prec(ten*x)+rand1(i,j,k) !even + enddo + enddo + enddo + + call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_x',I1.1,I1.1,I1.1,I4.4)") jles,nclx1,nclxn,nx + open(70,file=trim(filename),status='unknown',form='formatted') + do i=1,xsize(2) + x = real(i-1,mytype)*dx + write(70,'(9E14.6)') x,& + ffx1(i,1,1),fiffx1(i,1,1),& + ffxp1(i,1,1),fiffxp1(i,1,1) + enddo + close(70) + endif + + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*4*pi + do i=1,ysize(1) + fy2(i,j,k) = sin_prec(y) + fyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,0) + iimplicit = -iimplicit + call deryy (dfdyy2 ,fy2 ,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,0) + iimplicit = -iimplicit + if (nrank.eq.0) then + write(filename,"('schemes_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(67,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(67,'(5E14.6)') y,& + four*pi*cos_prec(four*pi*y),dfdy2(1,j,1),& + -sixteen*pi*pi*sin_prec(four*pi*y),dfdyy2(1,j,1) + enddo + close(67) + endif + + call deryvp(test2,fy2,di2,sy,cfy6,csy6,cwy6,ppyi,ysize(1),ysize(2),nymsize,ysize(3),0) + call interyvp(test22,fyp2,di2,sy,cifyp6,cisyp6,ciwyp6,ysize(1),ysize(2),nymsize,ysize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_yVP',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(68,file=trim(filename),status='unknown',form='formatted') + do j=1,nymsize + y1 = real(j-half,mytype)*dy + write(68,'(5E14.6)') y1,& + four*pi*cos_prec(four*pi*y1),test2(1,j,1),& + cos_prec(four*pi*y1),test22(1,j,1) + enddo + close(68) + endif + do k=1,ysize(3) + do j=1,nymsize + y1 = real(j-0.5,mytype)*dy*4*pi + do i=1,ysize(1) + test2(i,j,k) = cos_prec(y1) + enddo + enddo + enddo + call derypv(fy2,test2,di2,sy,cfip6y,csip6y,cwip6y,cfy6,csy6,cwy6,ppy,& + ysize(1),nymsize,ysize(2),ysize(3),1) + call interypv(fyp2,test2,di2,sy,cifip6y,cisip6y,ciwip6y,cify6,cisy6,ciwy6,& + ysize(1),nymsize,ysize(2),ysize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_yPV',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(69,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(69,'(5E14.6)') y,& + -four*pi*sin_prec(four*pi*y),fy2(1,j,1),& + cos_prec(four*pi*y),fyp2(1,j,1) + enddo + close(69) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,ysize(3) + do j=1,ysize(2) + y = real(j-1,mytype)*dy*four*pi + do i=1,ysize(1) + ffy2(i,j,k) = sin_prec(y) + ffyp2(i,j,k) = cos_prec(y) + enddo + enddo + enddo + + call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_y',I1.1,I1.1,I1.1,I4.4)") jles,ncly1,nclyn,ny + open(70,file=trim(filename),status='unknown',form='formatted') + do j=1,ysize(2) + y = real(j-1,mytype)*dy + write(70,'(9E14.6)') y,& + ffy2(1,j,1),fiffy2(1,j,1),& + ffyp2(1,j,1),fiffyp2(1,j,1) + enddo + close(70) + endif + do k=1,zsize(3) + z = real(k-1,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + fz3(i,j,k) = sin_prec(z) + fzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,0) + call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,0) + if (nrank.eq.0) then + write(filename,"('schemes_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(67,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(67,'(5E14.6)') z,& + four*pi*cos_prec(four*pi*z),dfdz3(1,1,k),& + -sixteen*pi*pi*sin_prec(four*pi*z),dfdzz3(1,1,k) + enddo + close(67) + endif + call derzvp(test3,fz3,di3,sz,cfz6,csz6,cwz6,zsize(1),zsize(2),zsize(3),nzmsize,0) + call interzvp(test33,fzp3,di3,sz,cifzp6,ciszp6,ciwzp6,zsize(1),zsize(2),zsize(3),nzmsize,1) + if (nrank.eq.0) then + write(filename,"('schemes_zVP',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(68,file=trim(filename),status='unknown',form='formatted') + do k=1,nzmsize + z1 = real(k-half,mytype)*dz + write(68,'(5E14.6)') z1,& + four*pi*cos_prec(four*pi*z1),test3(1,1,k),& + cos_prec(four*pi*z1),test33(1,1,k) + enddo + close(68) + endif + + do k=1,nzmsize + z1 = real(k-half,mytype)*dz*4*pi + do j=1,zsize(2) + do i=1,zsize(1) + test3(i,j,k) = cos_prec(z1) + enddo + enddo + enddo + call derzpv(fz3,test3,di3,sz,cfip6z,csip6z,cwip6z,cfz6,csz6,cwz6,zsize(1),zsize(2),nzmsize,zsize(3),1) + call interzpv(fzp3,test3,di3,sz,cifip6z,cisip6z,ciwip6z,cifz6,cisz6,ciwz6,zsize(1),zsize(2),nzmsize,zsize(3),1) + if (nrank.eq.0) then + write(filename,"('schemes_zPV',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(69,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(69,'(5E14.6)') z,& + -four*pi*sin_prec(four*pi*z),fz3(1,1,k),& + cos_prec(four*pi*z),fzp3(1,1,k) + enddo + close(69) + endif + ! FILTER + call filter(0.45_mytype) + do k=1,zsize(3) + z = real(k-1,mytype)*dz*four*pi + do j=1,zsize(2) + do i=1,zsize(1) + ffz3(i,j,k) = sin_prec(z) + ffzp3(i,j,k) = cos_prec(z) + enddo + enddo + enddo + call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + if (nrank.eq.0) then + write(filename,"('filter_z',I1.1,I1.1,I1.1,I4.4)") jles,nclz1,nclzn,nz + open(70,file=trim(filename),status='unknown',form='formatted') + do k=1,zsize(3) + z = real(k-1,mytype)*dz + write(70,'(9E14.6)') z,& + ffz3 (1,1,k),fiffz3 (1,1,k),& + ffzp3(1,1,k),fiffzp3(1,1,k) + enddo + close(70) + endif + + stop 'stop debug_schemes' + end subroutine debug_schemes + + subroutine init_post(ep1) + + real(mytype),intent(in),dimension(xstart(1):xend(1),xstart(2):xend(2),xstart(3):xend(3)) :: ep1 + + end subroutine init_post + + subroutine postprocess_dbg(ux1,uy1,uz1,phi1,ep1) + + real(mytype),intent(in),dimension(xsize(1),xsize(2),xsize(3)) :: ux1, uy1, uz1 + real(mytype),intent(in),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi1 + + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1 + + end subroutine postprocess_dbg + +end module dbg_schemes diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9974b0a34..6aa953300 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -15,6 +15,7 @@ add_executable(xcompact3d acl_utils.f90 adm.f90 airfoils.f90 + BC-Ellipsoid.f90 Case-ABL.f90 Case-Cavity.f90 Case-Channel.f90 @@ -33,6 +34,7 @@ add_executable(xcompact3d derive.f90 dynstall.f90 dynstall_legacy.f90 + ellip_utils.f90 filters.f90 forces.f90 genepsi3d.f90 diff --git a/src/Case-ABL.f90 b/src/Case-ABL.f90 index 24ceef099..30c328aad 100644 --- a/src/Case-ABL.f90 +++ b/src/Case-ABL.f90 @@ -418,24 +418,24 @@ subroutine wall_sgs_slip(ux,uy,uz,phi,nut1,wallfluxx,wallfluxy,wallfluxz) endif call filter(zero) - call filx(uxf1,ux,di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call filx(uzf1,uz,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call filx(uxf1,ux,di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc + call filx(uzf1,uz,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,3) call transpose_x_to_y(uxf1,ta2) call transpose_x_to_y(uzf1,tb2) call transpose_y_to_z(ta2,ta3) call transpose_y_to_z(tb2,tb3) - call filz(uxf3,ta3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call filz(uzf3,tb3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call filz(uxf3,ta3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,1) + call filz(uzf3,tb3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,3) call transpose_z_to_y(uxf3,ta2) call transpose_z_to_y(uzf3,tb2) call transpose_y_to_x(ta2,uxf1) call transpose_y_to_x(tb2,uzf1) if (iscalar==1) then - call filx(phif1,phi(:,:,:,1),di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,zero) + call filx(phif1,phi(:,:,:,1),di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,0) call transpose_x_to_y(phif1,ta2) call transpose_y_to_z(ta2,ta3) - call filz(phif3,ta3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,zero) + call filz(phif3,ta3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,0) call transpose_z_to_y(phif3,ta2) call transpose_y_to_x(ta2,phif1) endif @@ -746,13 +746,13 @@ subroutine wall_sgs_noslip(ux1,uy1,uz1,nut1,wallsgsx1,wallsgsy1,wallsgsz1) if (iconserv==0) then ! Derivative of wallmodel-corrected SGS stress tensor - call dery_22(ta2,te2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),1,ubcy) - call dery_22(tb2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),1,ubcy) + call dery_22(ta2,te2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),1,2) !ubcy) + call dery_22(tb2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),10,2) !ubcy) call transpose_y_to_x(ta2,wallsgsx1) call transpose_y_to_x(tb2,wallsgsz1) - call derx(wallsgsy1,te1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) + call derx(wallsgsy1,te1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) call transpose_y_to_z(th2,th3) - call derz(ti1,th3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz(ti1,th3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) call transpose_z_to_y(ti3,tb2) call transpose_y_to_x(tb2,ti1) wallsgsy1 = wallsgsy1 + ti1 diff --git a/src/Case-Channel.f90 b/src/Case-Channel.f90 index 7726cc921..e62a67db6 100644 --- a/src/Case-Channel.f90 +++ b/src/Case-Channel.f90 @@ -342,17 +342,17 @@ subroutine visu_channel(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/Case-Cylinder-wake.f90 b/src/Case-Cylinder-wake.f90 index 506d51e33..65b1be28a 100644 --- a/src/Case-Cylinder-wake.f90 +++ b/src/Case-Cylinder-wake.f90 @@ -69,7 +69,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) do i=nxi,nxf xm=real(i-1,mytype)*dx r=sqrt((xm-cexx)**two+(ym-ceyy)**two) - if (r-ra.gt.zeromach) then + if ((r-ra(1)).gt.zeromach) then cycle endif epsi(i,j,k)=remp @@ -346,17 +346,17 @@ subroutine visu_cyl(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/Case-Gravity-current.f90 b/src/Case-Gravity-current.f90 index 4cd89ecaa..2521c6e46 100644 --- a/src/Case-Gravity-current.f90 +++ b/src/Case-Gravity-current.f90 @@ -462,23 +462,23 @@ subroutine budget(rho1,ux1,uy1,uz1,phi1,vol1) ek=zero;ek1=zero;dek=zero;dek1=zero;ep=zero;ep1=zero;dep=zero;dep1=zero;diss1=zero !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives call transpose_x_to_y(ux1,ux2) call transpose_x_to_y(uy1,uy2) call transpose_x_to_y(uz1,uz2) - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives call transpose_y_to_z(ux2,ux3) call transpose_y_to_z(uy2,uy3) call transpose_y_to_z(uz2,uz3) - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) @@ -537,21 +537,21 @@ subroutine budget(rho1,ux1,uy1,uz1,phi1,vol1) ! endif do is=1, numscalar if (ri(is) .eq. zero) cycle - call derxxS (dphixx1,phi1(:,:,:,is),di1,sx,sfxpS,ssxpS,swxpS,xsize(1),xsize(2),xsize(3),1,zero) + call derxxS (dphixx1,phi1(:,:,:,is),di1,sx,sfxpS,ssxpS,swxpS,xsize(1),xsize(2),xsize(3),1,0) call transpose_x_to_y(dphixx1,dphixx2) call transpose_x_to_y(phi1(:,:,:,is),phi2(:,:,:,is)) - call deryS (dphiy2,phi2(:,:,:,is),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),1,zero) + call deryS (dphiy2,phi2(:,:,:,is),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),1,0) iimplicit = -iimplicit - call deryyS (dphiyy2,phi2(:,:,:,is),di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1,zero) + call deryyS (dphiyy2,phi2(:,:,:,is),di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1,0) iimplicit = -iimplicit call transpose_y_to_z(phi2(:,:,:,is),phi3(:,:,:,is)) - call derzzS (dphizz3,phi3(:,:,:,is),di3,sz,sfzpS,sszpS,swzpS,zsize(1),zsize(2),zsize(3),1,zero) + call derzzS (dphizz3,phi3(:,:,:,is),di3,sz,sfzpS,sszpS,swzpS,zsize(1),zsize(2),zsize(3),1,0) call transpose_z_to_y(dphizz3,dphizz2) @@ -573,16 +573,16 @@ subroutine budget(rho1,ux1,uy1,uz1,phi1,vol1) enddo if (ilmn.and.((Fr**2).gt.zero)) then - call derxx(ta1, rho1(:,:,:,1), di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1,zero) + call derxx(ta1, rho1(:,:,:,1), di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1,0) call transpose_x_to_y(ta1, ta2) call transpose_x_to_y(rho1(:,:,:,1), rho2) iimplicit = -iimplicit - call deryy(tb2, rho2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,zero) + call deryy(tb2, rho2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,0) iimplicit = -iimplicit call transpose_y_to_z(rho2, rho3) - call derzz(ta3, rho3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1,zero) + call derzz(ta3, rho3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1,0) call transpose_z_to_y(ta3, tc2) do k = 1, ysize(3) diff --git a/src/Case-PTBL.f90 b/src/Case-PTBL.f90 index f4e78f263..f00d1d289 100644 --- a/src/Case-PTBL.f90 +++ b/src/Case-PTBL.f90 @@ -214,9 +214,9 @@ subroutine momentum_forcing_ptbl(dux1, duy1, duz1, ux1, uy1, uz1, phi1) call transpose_x_to_y(ux1, ux2) call transpose_x_to_y(uy1, uy2) call transpose_x_to_y(uz1, uz2) - call dery(ta2, ux2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call dery(tb2, uy2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call dery(tc2, uz2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call dery(ta2, ux2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call dery(tb2, uy2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call dery(tc2, uz2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) call transpose_y_to_x(ta2, ta1) call transpose_y_to_x(tb2, tb1) call transpose_y_to_x(tc2, tc1) @@ -330,7 +330,7 @@ subroutine scalar_forcing_ptbl(uy1, dphi1, phi1) omegad = sc(1) * thetad if (nrank == 0) write (*, "(' omegad = ',E15.7,' omega= ',F14.12)") omegad, omega if (omegad > 0) then - call deryS(ta2, phi2(:, :, :, 1), di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call deryS(ta2, phi2(:, :, :, 1), di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) call transpose_y_to_x(ta2, ta1) do k = 1, xsize(3) do j = 1, xsize(2) @@ -460,21 +460,21 @@ subroutine postprocess_ptbl(ux1, uy1, uz1, pp3, phi1, ep1) if (Pro_Spectra ==1) call Gathering_Probe (pre2, p_ins(:, b)) ! Wall-normal derivatives of mean velocity - call dery(dudysxz(:, b), usxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) - call dery(dvdysxz(:, b), vsxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) - call dery(dwdysxz(:, b), wsxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(dudysxz(:, b), usxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) + call dery(dvdysxz(:, b), vsxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) + call dery(dwdysxz(:, b), wsxz(:, b), di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) ! Cross derivatives of fluctuating velocity call transpose_y_to_x(uy2p, tb1) call transpose_y_to_x(uz2p, tc1) call transpose_y_to_z(ux2p, ta3) call transpose_y_to_z(uy2p, tb3) - call derx(te1, tb1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) - call derx(tf1, tc1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) - call dery(td2, ux2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call dery(tf2, uz2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call derz(td3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) - call derz(te3, tb3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derx(te1, tb1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) + call derx(tf1, tc1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) + call dery(td2, ux2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call dery(tf2, uz2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call derz(td3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) + call derz(te3, tb3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_x_to_y(te1, tb2) call transpose_x_to_y(tf1, tc2) call transpose_z_to_y(td3, tg2) @@ -674,17 +674,17 @@ subroutine visu_ptbl(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) @@ -764,13 +764,13 @@ function comp_thetad(thetad0, ux2, uy2, ux2m) result(thetad) ! Calculate averaged derivatives call extract_fluctuat(ux2, ux2m, ux2p) call horizontal_avrge(ux2p * uy2, uxuy2pm) - call dery(duxuy2pm, uxuy2pm, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) - call dery(dudy2m, ux2m, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(duxuy2pm, uxuy2pm, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) + call dery(dudy2m, ux2m, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) ydudy2m = dudy2m * yp ! Viscous term iimplicit = -iimplicit - call deryy(du2dy22m, ux2m, di2, sy, sfyp, ssyp, swyp, 1, ysize(2), 1, 1, zero) + call deryy(du2dy22m, ux2m, di2, sy, sfyp, ssyp, swyp, 1, ysize(2), 1, 1, 0) !zero) iimplicit = -iimplicit if (istret /= 0) then du2dy22m = du2dy22m * pp2y - pp4y * dudy2m @@ -1018,13 +1018,13 @@ subroutine mean_convection(u1pu2p, um, vm, wm, mean_conv) real(mytype), dimension(ysize(2)) :: tempa2, tempb2, tempc2 call transpose_y_to_x(u1pu2p, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, tempa2) call horizontal_avrge(u1pu2p, tempc2) - call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) call transpose_y_to_z(u1pu2p, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, tempc2) mean_conv = -(um * tempa2 + vm * tempb2 + wm * tempc2) @@ -1043,13 +1043,13 @@ subroutine turb_convection(u1pu2p, up, vp, wp, turb_conv) real(mytype), dimension(ysize(2)) :: tempa2, tempb2, tempc2 call transpose_y_to_x(u1pu2p * up, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, tempa2) call horizontal_avrge(u1pu2p * vp, tempc2) - call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) call transpose_y_to_z(u1pu2p * wp, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0)! zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, tempc2) turb_conv = -(tempa2 + tempb2 + tempc2) @@ -1068,19 +1068,19 @@ subroutine visc_diffusion(u1pu2p, visc_diff) real(mytype), dimension(ysize(2)) :: tempa2, tempb2, tempc2, tempd2 call transpose_y_to_x(u1pu2p, ta1) - call derxx(tb1, ta1, di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derxx(tb1, ta1, di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, tempa2) call horizontal_avrge(u1pu2p, tempc2) iimplicit = -iimplicit - call deryy(tempb2, tempc2, di2, sy, sfyp, ssyp, swyp, 1, ysize(2), 1, 1, zero) + call deryy(tempb2, tempc2, di2, sy, sfyp, ssyp, swyp, 1, ysize(2), 1, 1, 0) !zero) iimplicit = -iimplicit if (istret /= 0) then - call dery(tempd2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(tempd2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) tempb2 = tempb2 * pp2y - pp4y * tempd2 end if call transpose_y_to_z(u1pu2p, ta3) - call derzz(tb3, ta3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derzz(tb3, ta3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, tempc2) visc_diff = xnu * (tempa2 + tempb2 + tempc2) @@ -1099,13 +1099,13 @@ subroutine production(u1, u2, u1p, u2p, up, vp, wp, prod) real(mytype), dimension(ysize(2)) :: tempa2, tempb2, tempc2, dudx, dudy, dudz call transpose_y_to_x(u2, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, dudx) call horizontal_avrge(u2, tempc2) - call dery(dudy, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(dudy, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) call transpose_y_to_z(u2, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, dudz) call horizontal_avrge(u1p * up, tempa2) @@ -1113,13 +1113,13 @@ subroutine production(u1, u2, u1p, u2p, up, vp, wp, prod) call horizontal_avrge(u1p * wp, tempc2) prod = -(tempa2 * dudx + tempb2 * dudy + tempc2 * dudz) call transpose_y_to_x(u1, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, dudx) call horizontal_avrge(u1, tempc2) - call dery(dudy, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(dudy, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) call transpose_y_to_z(u1, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, dudz) call horizontal_avrge(u2p * up, tempa2) @@ -1145,15 +1145,15 @@ subroutine pres_transport(one, two, u1p, u2p, prep, pres_tran) ta2 = u1p * prep if (two == 1) then call transpose_y_to_x(ta2, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, tempa2) else if (two == 2) then call horizontal_avrge(ta2, tempc2) - call dery(tempa2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(tempa2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) else if (two == 3) then call transpose_y_to_z(ta2, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, tempa2) else @@ -1163,15 +1163,15 @@ subroutine pres_transport(one, two, u1p, u2p, prep, pres_tran) ta2 = u2p * prep if (one == 1) then call transpose_y_to_x(ta2, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call horizontal_avrge(ta2, tempb2) else if (one == 2) then call horizontal_avrge(ta2, tempc2) - call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(tempb2, tempc2, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) else if (one == 3) then call transpose_y_to_z(ta2, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tc2) call horizontal_avrge(tc2, tempb2) else @@ -1194,20 +1194,20 @@ subroutine dissipation(u1p, u2p, diss) real(mytype), dimension(ysize(2)) :: tempa2, tempb2, tempc2 call transpose_y_to_x(u1p, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, ta2) call transpose_y_to_x(u2p, ta1) - call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx(tb1, ta1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero) call transpose_x_to_y(tb1, tb2) call horizontal_avrge(ta2 * tb2, tempa2) - call dery(ta2, u1p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call dery(tb2, u2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call dery(ta2, u1p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call dery(tb2, u2p, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) call horizontal_avrge(ta2 * tb2, tempb2) call transpose_y_to_z(u1p, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, ta2) call transpose_y_to_z(u2p, ta3) - call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz(tb3, ta3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) !zero) call transpose_z_to_y(tb3, tb2) call horizontal_avrge(ta2 * tb2, tempc2) diss = -two * xnu * (tempa2 + tempb2 + tempc2) @@ -1240,7 +1240,7 @@ function comp_thetad_II(ux2, uy2, ux2m) result(thetad) ! Calculate averaged derivatives call extract_fluctuat(ux2, ux2m, ux2p) call horizontal_avrge(ux2p * uy2, uxuy2pm) - call dery(dudy2m, ux2m, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, zero) + call dery(dudy2m, ux2m, di2, sy, ffyp, fsyp, fwyp, ppy, 1, ysize(2), 1, 1, 0) !zero) ! G(t) Model based on (0: Momentum Thickness) diff --git a/src/Case-Periodic-hill.f90 b/src/Case-Periodic-hill.f90 index 95b4af583..b6a975c22 100644 --- a/src/Case-Periodic-hill.f90 +++ b/src/Case-Periodic-hill.f90 @@ -331,17 +331,17 @@ subroutine visu_hill(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/Case-Sandbox.f90 b/src/Case-Sandbox.f90 index 020fcc89e..70fb0a78c 100644 --- a/src/Case-Sandbox.f90 +++ b/src/Case-Sandbox.f90 @@ -174,7 +174,7 @@ subroutine deposit (phi1) do is=1, numscalar if (uset(is) .eq. zero) cycle call transpose_x_to_y(phi1(:,:,:,is),phi2(:,:,:,is)) - call deryS (ta2, phi2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call deryS (ta2, phi2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero is 0 do k=1, ysize(3) do i=1, ysize(1) if (ta2(i,1,k) .lt. zero) then diff --git a/src/Case-TBL.f90 b/src/Case-TBL.f90 index 465557679..dad226bd6 100644 --- a/src/Case-TBL.f90 +++ b/src/Case-TBL.f90 @@ -368,17 +368,17 @@ subroutine visu_tbl(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/Case-TGV.f90 b/src/Case-TGV.f90 index 165535288..67d0c88d3 100644 --- a/src/Case-TGV.f90 +++ b/src/Case-TGV.f90 @@ -258,17 +258,17 @@ subroutine postprocess_tgv(ux1,uy1,uz1,phi1,ep1) !! Write vorticity as an example of post processing !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) @@ -329,17 +329,17 @@ subroutine postprocess_tgv(ux1,uy1,uz1,phi1,ep1) !SECOND DERIVATIVES !x-derivatives - call derxx (ta1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,ubcx) - call derxx (tb1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derxx (tc1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derxx (ta1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,1) + call derxx (tb1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,2) + call derxx (tc1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call deryy (ta2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcx) - call deryy (tb2,uy2,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,ubcy) - call deryy (tc2,uz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcz) + call deryy (ta2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,1) + call deryy (tb2,uy2,di2,sy,sfy ,ssy ,swy ,ysize(1),ysize(2),ysize(3),0,2) + call deryy (tc2,uz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derzz (ta3,ux3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derzz (tb3,uy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derzz (tc3,uz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,ubcz) + call derzz (ta3,ux3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,1) + call derzz (tb3,uy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,2) + call derzz (tc3,uz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) @@ -421,17 +421,17 @@ subroutine postprocess_tgv(ux1,uy1,uz1,phi1,ep1) call transpose_y_to_z(bz2,bz3) !x-derivatives - call derx (ta1,Bm(:,:,:,1),di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,Bm(:,:,:,2),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,Bm(:,:,:,3),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,Bm(:,:,:,1),di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call derx (tb1,Bm(:,:,:,2),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call derx (tc1,Bm(:,:,:,3),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) !y-derivatives - call dery (ta2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,by2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx) + call dery (tb2,by2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) + call dery (tc2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz) !!z-derivatives - call derz (ta3,bx3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,by3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,bz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,bx3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call derz (tb3,by3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call derz (tc3,bz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) @@ -544,17 +544,17 @@ subroutine visu_tgv(ux1, uy1, uz1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/Case-Uniform.f90 b/src/Case-Uniform.f90 index f32aa50d0..796e2ac70 100644 --- a/src/Case-Uniform.f90 +++ b/src/Case-Uniform.f90 @@ -289,17 +289,17 @@ subroutine visu_uniform(ux1, uy1, uz1, pp3, phi1, ep1, num) endif !x-derivatives - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !y-derivatives - call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (ta2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (tb2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (tc2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !!z-derivatives - call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (ta3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz (tb3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz (tc3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !!all back to x-pencils call transpose_z_to_y(ta3,td2) call transpose_z_to_y(tb3,te2) diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index daf852955..07f64151e 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -13,7 +13,7 @@ module actuator_line_model_utils interface trilinear_interpolation module procedure trilinear_interpolation_scalar module procedure trilinear_interpolation_vec3 - end interface trilinear_interpolation + end interface trilinear_interpolation public QuatRot, cross, IsoKernel, AnIsoKernel, int2str, trilinear_interpolation @@ -29,7 +29,7 @@ real(mytype) function trilinear_interpolation_scalar(x0,y0,z0, & ! !******************************************************************************* use, intrinsic :: ieee_arithmetic - + implicit none real(mytype),intent(in) :: x0,y0,z0,x1,y1,z1,x,y,z,u000,u100,u001,u101,u010,u110,u011,u111 real(mytype) :: c00,c01,c10,c11,c0,c1,xd,yd,zd @@ -84,7 +84,7 @@ function trilinear_interpolation_vec3(x0,y0,z0,x1,y1,z1,x,y,z, & ! !******************************************************************************* use, intrinsic :: ieee_arithmetic - + implicit none real(mytype),intent(in) :: x0,y0,z0,x1,y1,z1,x,y,z real(mytype),intent(in) :: u000(3),u100(3),u001(3),u101(3),u010(3),u110(3),u011(3),u111(3) diff --git a/src/case.f90 b/src/case.f90 index 9fa8e760b..71f156359 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -22,6 +22,7 @@ module case use cavity use pipe use ptbl + use ellip use var, only : nzmsize @@ -32,8 +33,8 @@ module case private ! All functions/subroutines private by default public :: init, boundary_conditions, & momentum_forcing, scalar_forcing, set_fluid_properties, & - test_flow, preprocessing, postprocessing, visu_case, & - visu_case_init, visu_case_finalise + test_flow, preprocessing, postprocessing, visu_case, & + visu_case_init, visu_case_finalise contains !################################################################## @@ -119,6 +120,10 @@ subroutine init (rho1, ux1, uy1, uz1, ep1, phi1, drho1, dux1, duy1, duz1, dphi1, call init_ptbl(ux1, uy1, uz1, phi1) + elseif (itype.eq.itype_ellip) then + + call init_ellip (ux1, uy1, uz1, phi1) + else if (nrank.eq.0) then @@ -224,6 +229,10 @@ subroutine boundary_conditions (rho,ux,uy,uz,phi,ep) call boundary_conditions_ptbl(ux, uy, uz, phi) + elseif (itype.eq.itype_ellip) then + + call boundary_conditions_ellip(ux, uy, uz, phi) + endif end subroutine boundary_conditions @@ -252,7 +261,7 @@ subroutine preprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) end subroutine preprocessing !################################################################## !################################################################## - subroutine postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) + subroutine postprocessing(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1) use decomp_2d, only : xsize, ph1 use var, only : nzmsize, numscalar, nrhotime, npress, abl_T @@ -261,24 +270,24 @@ subroutine postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar), intent(in) :: phi1 real(mytype),dimension(xsize(1),xsize(2),xsize(3),nrhotime), intent(in) :: rho1 real(mytype),dimension(xsize(1),xsize(2),xsize(3)), intent(in) :: ep1 - real(mytype),dimension(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress), intent(in) :: pp3 + real(mytype),dimension(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress), intent(in) :: pp3, div_visu_var integer :: j ! Recover temperature when decomposed (pressure to be recovered externally) if (itype.eq.itype_abl.and.ibuoyancy.eq.1) then - do j=1,xsize(2) + do j=1,xsize(2) abl_T(:,j,:,1) = phi1(:,j,:,1) + Tstat(j,1) enddo - call run_postprocessing(rho1, ux1, uy1, uz1, pp3, abl_T, ep1) + call run_postprocessing(rho1, ux1, uy1, uz1, pp3, div_visu_var, abl_T, ep1) else - call run_postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) + call run_postprocessing(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1) endif end subroutine postprocessing !################################################################## !################################################################## - subroutine run_postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) + subroutine run_postprocessing(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1) use decomp_2d, only : xsize, ph1 use visu, only : write_snapshot, end_snapshot @@ -295,12 +304,12 @@ subroutine run_postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar), intent(in) :: phi1 real(mytype),dimension(xsize(1),xsize(2),xsize(3),nrhotime), intent(in) :: rho1 real(mytype),dimension(xsize(1),xsize(2),xsize(3)), intent(in) :: ep1 - real(mytype),dimension(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress), intent(in) :: pp3 + real(mytype),dimension(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress), intent(in) :: pp3, div_visu_var integer :: num if ((ivisu.ne.0).and.(mod(itime, ioutput).eq.0)) then - call write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) + call write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, itime, num) ! XXX: Ultimate goal for ADIOS2 is to pass do all postproc online - do we need this? ! Currently, needs some way to "register" variables for IO @@ -378,18 +387,22 @@ subroutine postprocess_case(rho,ux,uy,uz,pp,phi,ep) call postprocess_cavity(ux, uy, uz, phi) + elseif (itype.eq.itype_ellip) then + + call postprocess_ellip(ux, uy, uz, ep) + elseif (itype.eq.itype_pipe) then call postprocess_pipe(ux, uy, uz, pp, phi, ep) elseif (itype.eq.itype_ptbl) then - + call postprocess_ptbl (ux, uy, uz, pp, phi, ep) endif if (iforces.eq.1) then - call force(ux,uy,uz,ep) + ! call force(ux,uy,uz,ep) call restart_forces(1) endif @@ -431,7 +444,11 @@ subroutine visu_case_init else if (itype .eq. itype_uniform) then - call visu_uniform_init(case_visu_init) + call visu_uniform_init(case_visu_init) + + else if (itype.eq.itype_ellip) then + + call visu_ellip_init(case_visu_init) else if (itype .eq. itype_ptbl) then @@ -444,11 +461,11 @@ end subroutine visu_case_init subroutine visu_case_finalise implicit none - + if (itype .eq. itype_gravitycur) then call visu_gravitycur_finalise() - + end if end subroutine visu_case_finalise !################################################################## @@ -508,6 +525,11 @@ subroutine visu_case(rho1,ux1,uy1,uz1,pp3,phi1,ep1,num) call visu_uniform(ux1, uy1, uz1, pp3, phi1, ep1, num) called_visu = .true. + elseif (itype.eq.itype_ellip) then + + call visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) + called_visu = .true. + elseif (itype.eq.itype_ptbl) then call visu_ptbl(ux1, uy1, uz1, pp3, phi1, ep1, num) @@ -563,7 +585,7 @@ subroutine momentum_forcing(dux1, duy1, duz1, rho1, ux1, uy1, uz1, phi1) if(mhd_active) then call momentum_forcing_mhd(dux1(:,:,:,1),duy1(:,:,:,1),duz1(:,:,:,1),ux1,uy1,uz1) endif - + end subroutine momentum_forcing !################################################################## !################################################################## @@ -618,7 +640,7 @@ subroutine test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) use decomp_2d use param - use navier, only : divergence + use navier, only : divergence2 use var, only : numscalar, dv3 use tools, only : test_speed_min_max, compute_cfl, test_scalar_min_max @@ -631,7 +653,7 @@ subroutine test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) real(mytype), dimension(zsize(1), zsize(2), zsize(3)), intent(in) :: divu3 if ((mod(itime,ilist)==0 .or. itime == ifirst .or. itime == ilast)) then - call divergence(dv3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,2) + call divergence2(dv3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,2) call test_speed_min_max(ux1,uy1,uz1) call compute_cfl(ux1,uy1,uz1) if (iscalar==1) call test_scalar_min_max(phi1) diff --git a/src/derive.f90 b/src/derive.f90 index 5ba54cddc..a5a22deb5 100644 --- a/src/derive.f90 +++ b/src/derive.f90 @@ -18,7 +18,7 @@ subroutine derx_00(tx,ux,rx,sx,ffx,fsx,fwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz):: sx real(mytype), dimension(nx):: ffx,fsx,fwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -79,7 +79,7 @@ subroutine derx_11(tx,ux,rx,sx,ffx,fsx,fwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz):: sx real(mytype), dimension(nx):: ffx,fsx,fwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -152,7 +152,7 @@ subroutine derx_12(tx,ux,rx,sx,ffx,fsx,fwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz):: sx real(mytype), dimension(nx):: ffx,fsx,fwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -222,7 +222,7 @@ subroutine derx_21(tx,ux,rx,sx,ffx,fsx,fwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz):: sx real(mytype), dimension(nx):: ffx,fsx,fwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -292,7 +292,7 @@ subroutine derx_22(tx,ux,rx,sx,ffx,fsx,fwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz):: sx real(mytype), dimension(nx):: ffx,fsx,fwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -337,7 +337,7 @@ subroutine dery_00(ty,uy,ry,sy,ffy,fsy,fwy,ppy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: ffy,fsy,fwy,ppy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -435,7 +435,7 @@ subroutine dery_11(ty,uy,ry,sy,ffy,fsy,fwy,ppy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: ffy,fsy,fwy,ppy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -557,7 +557,7 @@ subroutine dery_12(ty,uy,ry,sy,ffy,fsy,fwy,ppy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: ffy,fsy,fwy,ppy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -676,7 +676,7 @@ subroutine dery_21(ty,uy,ry,sy,ffy,fsy,fwy,ppy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: ffy,fsy,fwy,ppy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -795,7 +795,7 @@ subroutine dery_22(ty,uy,ry,sy,ffy,fsy,fwy,ppy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: ffy,fsy,fwy,ppy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -869,7 +869,7 @@ subroutine derz_00(tz,uz,rz,sz,ffz,fsz,fwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: ffz,fsz,fwz - real(mytype) :: lind + integer :: lind if (nz==1) then tz = 0. @@ -962,7 +962,7 @@ subroutine derz_11(tz,uz,rz,sz,ffz,fsz,fwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: ffz,fsz,fwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1075,7 +1075,7 @@ subroutine derz_12(tz,uz,rz,sz,ffz,fsz,fwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: ffz,fsz,fwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1187,7 +1187,7 @@ subroutine derz_21(tz,uz,rz,sz,ffz,fsz,fwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: ffz,fsz,fwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1299,7 +1299,7 @@ subroutine derz_22(tz,uz,rz,sz,ffz,fsz,fwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: ffz,fsz,fwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1365,7 +1365,7 @@ subroutine derxx_00(tx,ux,rx,sx,sfx,ssx,swx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: sx real(mytype), dimension(nx):: sfx,ssx,swx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -1492,7 +1492,7 @@ subroutine derxx_11(tx,ux,rx,sx,sfx,ssx,swx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: sx real(mytype), dimension(nx):: sfx,ssx,swx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -1677,7 +1677,7 @@ subroutine derxx_12(tx,ux,rx,sx,sfx,ssx,swx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: sx real(mytype), dimension(nx):: sfx,ssx,swx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -1833,7 +1833,7 @@ subroutine derxx_21(tx,ux,rx,sx,sfx,ssx,swx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: sx real(mytype), dimension(nx):: sfx,ssx,swx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -1989,7 +1989,7 @@ subroutine derxx_22(tx,ux,rx,sx,sfx,ssx,swx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: sx real(mytype), dimension(nx):: sfx,ssx,swx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -2063,7 +2063,7 @@ subroutine deryy_00(ty,uy,ry,sy,sfy,ssy,swy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ty,uy,ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: sfy,ssy,swy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -2218,7 +2218,7 @@ subroutine deryy_11(ty,uy,ry,sy,sfy,ssy,swy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ty,uy,ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: sfy,ssy,swy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -2444,7 +2444,7 @@ subroutine deryy_12(ty,uy,ry,sy,sfy,ssy,swy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ty,uy,ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: sfy,ssy,swy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -2642,7 +2642,7 @@ subroutine deryy_21(ty,uy,ry,sy,sfy,ssy,swy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ty,uy,ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: sfy,ssy,swy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -2840,7 +2840,7 @@ subroutine deryy_22(ty,uy,ry,sy,sfy,ssy,swy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ty,uy,ry real(mytype), dimension(nx,nz) :: sy real(mytype), dimension(ny) :: sfy,ssy,swy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -2934,7 +2934,7 @@ subroutine derzz_00(tz,uz,rz,sz,sfz,ssz,swz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: sfz,ssz,swz - real(mytype) :: lind + integer :: lind if (nz==1) then tz = 0. @@ -3093,7 +3093,7 @@ subroutine derzz_11(tz,uz,rz,sz,sfz,ssz,swz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: sfz,ssz,swz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -3318,7 +3318,7 @@ subroutine derzz_12(tz,uz,rz,sz,sfz,ssz,swz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: sfz,ssz,swz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -3514,7 +3514,7 @@ subroutine derzz_21(tz,uz,rz,sz,sfz,ssz,swz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: sfz,ssz,swz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -3710,7 +3710,7 @@ subroutine derzz_22(tz,uz,rz,sz,sfz,ssz,swz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: sz real(mytype), dimension(nz) :: sfz,ssz,swz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 new file mode 100644 index 000000000..75c618d01 --- /dev/null +++ b/src/ellip_utils.f90 @@ -0,0 +1,760 @@ +!Copyright (c) 2012-2022, Xcompact3d +!This file is part of Xcompact3d (xcompact3d.com) +!SPDX-License-Identifier: BSD 3-Clause + +module ellipsoid_utils + + ! use decomp_2d, only: mytype + use param, only: zero, one, two + ! use dbg_schemes, only: sqrt_prec, cos_prec, exp_prec, sin_prec + use ibm_param + + implicit none + ! public QuatRot, cross, IsoKernel, AnIsoKernel, int2str + +contains + + ! !******************************************************************************* + ! ! + ! real(mytype) function trilinear_interpolation(x0,y0,z0, & + ! x1,y1,z1, & + ! x,y,z, & + ! u000,u100,u001,u101, & + ! u010,u110,u011,u111) + ! ! + ! !******************************************************************************* + + ! implicit none + ! real(mytype),intent(in) :: x0,y0,z0,x1,y1,z1,x,y,z,u000,u100,u001,u101,u010,u110,u011,u111 + ! real(mytype) :: c00,c01,c10,c11,c0,c1,xd,yd,zd + + ! if (x1/=x0) then + ! xd=(x-x0)/(x1-x0) + ! else + ! xd=zero + ! endif + + ! if (y1/=y0) then + ! yd=(y-y0)/(y1-y0) + ! else + ! yd=zero + ! endif + + ! if (z1/=z0) then + ! zd=(z-z0)/(z1-z0) + ! else + ! zd=zero + ! endif + + ! ! Interpolate along X + ! c00=u000*(one-xd)+u100*xd + ! c01=u001*(one-xd)+u101*xd + ! c10=u010*(one-xd)+u110*xd + ! c11=u011*(one-xd)+u111*xd + + ! ! Interpolate along Y + ! c0 = c00*(one-yd)+c10*yd + ! c1 = c01*(one-yd)+c11*yd + + ! ! Interpolate along Z + ! trilinear_interpolation=c0*(one-zd)+c1*zd + + ! return + + ! end function trilinear_interpolation + + ! !******************************************************************************* + ! ! + ! subroutine cross(ax,ay,az,bx,by,bz,cx,cy,cz) + ! ! + ! !******************************************************************************* + + ! real(mytype) :: ax,ay,az,bx,by,bz,cx,cy,cz + + ! cx = ay*bz - az*by + ! cy = az*bx - ax*bz + ! cz = ax*by - ay*bx + + ! end subroutine cross + + ! !******************************************************************************* + ! ! + ! subroutine QuatRot(vx,vy,vz,Theta,Rx,Ry,Rz,Ox,Oy,Oz,vRx,vRy,vRz) + ! ! + ! !******************************************************************************* + + ! implicit none + ! real(mytype), intent(in) :: vx,vy,vz,Theta,Rx,Ry,Rz,Ox,Oy,Oz + ! real(mytype),intent(inout) :: vRx,vRy,vRz + ! real(mytype) :: nRx,nRy,nRz + ! real(mytype) :: p(4,1), pR(4,1), q(4), qbar(4), RMag, vOx, vOy, vOz + ! real(mytype) :: QL(4,4), QbarR(4,4) + + ! ! Perform rotation of vector v around normal vector nR using the quaternion machinery. + ! ! v: input vector + ! ! Theta: rotation angle (rad) + ! ! nR: normal vector around which to rotate + ! ! Origin: origin point of rotation + ! ! vR: Rotated vector + + ! ! Force normalize nR + ! RMag=sqrt_prec(Rx**2.0+Ry**2.0+Rz**2.0) + ! nRx=Rx/RMag + ! nRy=Ry/RMag + ! nRz=Rz/RMag + + ! ! Quaternion form of v + ! vOx=vx-Ox + ! vOy=vy-Oy + ! vOz=vz-Oz + ! p=reshape([zero,vOx,vOy,vOz],[4,1]) + + ! ! Rotation quaternion and conjugate + ! q=(/cos_prec(Theta/2),nRx*sin_prec(Theta/2),nRy*sin_prec(Theta/2),nRz*sin_prec(Theta/2)/) + ! qbar=(/q(1),-q(2),-q(3),-q(4)/) + + ! QL=transpose(reshape((/q(1), -q(2), -q(3), -q(4), & + ! q(2), q(1), -q(4), q(3), & + ! q(3), q(4), q(1), -q(2), & + ! q(4), -q(3), q(2), q(1)/),(/4,4/))) + + ! QbarR=transpose(reshape((/qbar(1), -qbar(2), -qbar(3), -qbar(4), & + ! qbar(2), qbar(1), qbar(4), -qbar(3), & + ! qbar(3), -qbar(4), qbar(1), qbar(2), & + ! qbar(4), qbar(3), -qbar(2), qbar(1)/),(/4,4/))) + + ! ! Rotate p + ! pR=matmul(matmul(QbarR,QL),p) + ! vRx=pR(2,1)+Ox + ! vRy=pR(3,1)+Oy + ! vRz=pR(4,1)+Oz + + ! end subroutine QuatRot + + + + subroutine NormalizeQuaternion(quaternion) + real(mytype), intent(inout) :: quaternion(4) + real(mytype) :: normalizedQuaternion(4) + + ! Compute the magnitude of the quaternion + real(mytype) :: magnitude + magnitude = sqrt(quaternion(1)**2 + quaternion(2)**2 + quaternion(3)**2 + quaternion(4)**2) + if (magnitude < 0.0001) then + magnitude = one + write(*,*) "Tried to normalize a zero quaternion" + endif + ! Normalize the quaternion + quaternion = quaternion / magnitude + + end subroutine NormalizeQuaternion + + subroutine QuaternionNorm(q,norm) + real(mytype),intent(in) :: q(4) + real(mytype),intent(out):: norm + + norm = sqrt(q(1)**2+q(2)**2+q(3)**2+q(4)**2) + + end subroutine QuaternionNorm + + subroutine QuaternionConjugate(q, q_c) + real(mytype), intent(in) :: q(4) + real(mytype), intent(out) :: q_c(4) + + q_c = [q(1), -q(2), -q(3), -q(4)] + end subroutine + + + subroutine QuaternionMultiply(q1, q2, result) + real(mytype), intent(in) :: q1(4), q2(4) + real(mytype), intent(out) :: result(4) + + result(1) = q1(1) * q2(1) - q1(2) * q2(2) - q1(3) * q2(3) - q1(4) * q2(4) + result(2) = q1(1) * q2(2) + q1(2) * q2(1) + q1(3) * q2(4) - q1(4) * q2(3) + result(3) = q1(1) * q2(3) - q1(2) * q2(4) + q1(3) * q2(1) + q1(4) * q2(2) + result(4) = q1(1) * q2(4) + q1(2) * q2(3) - q1(3) * q2(2) + q1(4) * q2(1) + end subroutine QuaternionMultiply + + + subroutine RotatePoint(point, quaternion, rotatedPoint) + real(mytype), intent(in) :: point(3), quaternion(4) + real(mytype), intent(out) :: rotatedPoint(3) + real(mytype) :: conjugateQuaternion(4) + real(mytype) :: resultQuaternion(4) + real(mytype) :: rotatedPointQuaternion(4) + + ! Convert the point to a quaternion + real(mytype) :: pointQuaternion(4) + pointQuaternion(1) = 0.0D0 + pointQuaternion(2:4) = point(:) + + ! Perform the rotation + + conjugateQuaternion = [quaternion(1), -quaternion(2), -quaternion(3), -quaternion(4)] + + call QuaternionMultiply(quaternion, pointQuaternion, resultQuaternion) + call QuaternionMultiply(resultQuaternion, conjugateQuaternion, rotatedPointQuaternion) + + ! Convert the rotated quaternion back to a 3D point + rotatedPoint = rotatedPointQuaternion(2:4) + end subroutine RotatePoint + + subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) + real(mytype), intent(in) :: point(3), centre(3), orientation(4), shape(3) + real(mytype), intent(out) :: radius + real(mytype) :: trans_point(3),rotated_point(3),scaled_point(3), orientation_c(4) + integer :: i + + !translate point to body frame + trans_point = point-centre + + call QuaternionConjugate(orientation, orientation_c) + + !rotate point into body frame (using inverse(conjugate) of orientation) + call RotatePoint(trans_point, orientation, rotated_point) + + do i = 1,3 + scaled_point(i)=rotated_point(i)/shape(i) + end do + + radius=sqrt(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) + + ! if (radius /= radius) then + ! write(*,*) "Got an error in grid check!" + ! write(*,*) "Radius = ", radius + ! write(*,*) "point = ", point + ! write(*,*) "Body centre = ", centre + ! write(*,*) "Translated point = ", trans_point + ! write(*,*) "Orientation = ", orientation + ! write(*,*) "Rotated point = ", rotated_point + ! write(*,*) "Scaled Point = ", scaled_point + ! endif + + end subroutine + + subroutine EllipsoidalRadius_debug(point, centre, orientation, shape, radius) + real(mytype), intent(in) :: point(3), centre(3), orientation(4), shape(3) + real(mytype), intent(out) :: radius + real(mytype) :: trans_point(3),rotated_point(3),scaled_point(3), orientation_c(4) + integer :: i + + !translate point to body frame + trans_point = point-centre + + write(*,*) "Translated point = ", trans_point + + write(*,*) "Orientation = ", orientation + + call QuaternionConjugate(orientation, orientation_c) + + write(*,*) "Orientation inverse = ", orientation_c + + !rotate point into body frame (using inverse(conjugate) of orientation) + call RotatePoint(trans_point, orientation, rotated_point) + + write(*,*) "Rotated point = ", rotated_point + do i = 1,3 + scaled_point(i)=rotated_point(i)/shape(i) + end do + + write(*,*) "Scaled point = ", scaled_point + + radius=sqrt(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) + + write(*,*) "Radius = ", radius + + ! if (radius /= radius) then + ! write(*,*) "Got an error in grid check!" + ! write(*,*) "Radius = ", radius + ! write(*,*) "point = ", point + ! write(*,*) "Body centre = ", centre + ! write(*,*) "Translated point = ", trans_point + ! write(*,*) "Orientation = ", orientation + ! write(*,*) "Rotated point = ", rotated_point + ! write(*,*) "Scaled Point = ", scaled_point + ! endif + + end subroutine + + subroutine CrossProduct(a, b, result) + real(mytype), intent(in) :: a(3), b(3) + real(mytype), intent(inout) :: result(3) + + result(1) = a(2) * b(3) - a(3) * b(2) + result(2) = a(3) * b(1) - a(1) * b(3) + result(3) = a(1) * b(2) - a(2) * b(1) + end subroutine CrossProduct + + subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity, pointVelocity) + real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(4) + real(mytype), intent(out) :: pointVelocity(3) + real(mytype) :: crossed(3) + ! Compute the distance vector from the center to the point + real(mytype) :: distance(3) + distance = point - center + + ! Compute the cross product of angular velocity and distance vector + + call CrossProduct(distance, angularVelocity(2:4), crossed) + + + ! Calculate the velocity at the point + pointVelocity = crossed + linearVelocity + end subroutine CalculatePointVelocity + + subroutine CalculatePointVelocity_Multi(point, pointVelocity) + real(mytype), intent(in) :: point(3) + real(mytype), intent(out):: pointVelocity(3) + real(mytype) :: radii(10),r + integer :: i,i_closest + + radii(:) = 10000000. + do i = 1,nbody + call EllipsoidalRadius(point, position(i,:), orientation(i,:), shape(i,:), r) + radii(i) = r + enddo + i_closest=1 + if (nbody.gt.1) then + do i = 2,nbody + if (radii(i) < radii(i_closest)) then + i_closest=i + endif + enddo + endif + + call CalculatePointVelocity(point, position(i_closest,:), angularVelocity(i_closest,:), linearVelocity(i_closest, :), pointVelocity) + end subroutine + + subroutine is_inside_ellipsoid(point, centre, orientation, shape, ra, zeromach, is_inside) + real(mytype), intent(in) :: point(3), centre(3), orientation(4), shape(3), ra, zeromach + logical,intent(out) :: is_inside + real(mytype) :: r + + call EllipsoidalRadius(point,centre,orientation,shape,r) + + is_inside = ((r-ra).lt.zeromach) + + end subroutine is_inside_ellipsoid + + + subroutine navierFieldGen(ep1, ep1_x, ep1_y, ep1_z) + use param + use decomp_2d + real(mytype), dimension(xsize(1),xsize(2),xsize(3)), intent(in) :: ep1 + real(mytype),dimension(xsize(1),xsize(2),xsize(3)),intent(out) :: ep1_x, ep1_y, ep1_z + real(mytype) :: xm, ym, zm, point(3), x_pv, y_pv, z_pv, pointVelocity(3) + integer :: i,j,k + + do k = 1,xsize(3) + zm=real(k+xstart(3)-2, mytype)*dz + do j = 1,xsize(2) + ym=real(j+xstart(2)-2, mytype)*dy + do i = 1,xsize(1) + xm=real(i+xstart(1)-2, mytype)*dx + point=[xm,ym,zm] + if (ep1(i,j,k).eq.1) then + call CalculatePointVelocity_Multi(point, pointVelocity) + x_pv=pointVelocity(1) + y_pv=pointVelocity(2) + z_pv=pointVelocity(3) + else + x_pv=0 + y_pv=0 + z_pv=0 + endif + ep1_x(i,j,k)=x_pv + ep1_y(i,j,k)=y_pv + ep1_z(i,j,k)=z_pv + end do + end do + end do + + end subroutine navierFieldGen + + + subroutine body_to_lab(p_body, q, p_lab) + real(mytype),intent(in) :: p_body(4), q(4) + real(mytype),intent(out):: p_lab(4) + real(mytype) :: q_inv(4),q_m(4) + + call QuaternionConjugate(q, q_inv) + + call QuaternionMultiply(p_body,q_inv,q_m) + call QuaternionMultiply(q,q_m, p_lab) + + end subroutine body_to_lab + + subroutine lab_to_body(p_lab, q, p_body) + real(mytype),intent(in) :: p_lab(4), q(4) + real(mytype),intent(out):: p_body(4) + real(mytype) :: q_inv(4),q_m(4) + + call QuaternionConjugate(q, q_inv) + + call QuaternionMultiply(p_lab,q,q_m) + call QuaternionMultiply(q_inv,q_m, p_body) + + end subroutine lab_to_body + + subroutine omega_stepper(omega_n, ang_accel, time_step, omega_n1) + real(mytype),intent(in) :: omega_n(4), ang_accel(4), time_step + real(mytype),intent(out):: omega_n1(4) + + omega_n1 = omega_n + ang_accel * time_step + + end subroutine omega_stepper + + subroutine orientation_stepper(q1, omega_q, time_step, q_n1) + use param + real(mytype),intent(in) :: q1(4),omega_q(4),time_step + real(mytype),intent(out):: q_n1(4) + real(mytype) :: mag, re_part, im_sc, im_part(3), omega_n1(4) + + call QuaternionNorm(omega_q, mag) + re_part=cos(mag*time_step*half) + if (mag.gt.zero) then + im_sc = sin(mag*time_step*half)/mag + else + im_sc = zero + endif + im_part=im_sc * omega_q(2:4) + omega_n1=[re_part,im_part(1),im_part(2),im_part(3)] + + call QuaternionMultiply(omega_n1,q1,q_n1) + + end subroutine orientation_stepper + + SUBROUTINE ConvertToMovingRotatingFrame(vI, positionI, originO, vO, Omega, vR) + IMPLICIT NONE + + ! Arguments: + ! vI : Velocity in the inertial frame (3-element array) + ! positionI: Position in the inertial frame (3-element array) + ! originO : Position of the origin of the rotating frame in the inertial frame (3-element array) + ! vO : Linear velocity of the origin of the rotating frame + ! Omega : Angular velocity of the rotating frame (3-element array) + ! vR : Velocity in the moving and rotating frame (Output, 3-element array) + + real(mytype), INTENT(IN) :: vI(3), positionI(3), originO(3), vO(3), Omega(3) + real(mytype), INTENT(OUT) :: vR(3) + real(mytype) :: r(3), crossProduct_v(3) + + ! Compute r = positionI - originO + r(1) = positionI(1) - originO(1) + r(2) = positionI(2) - originO(2) + r(3) = positionI(3) - originO(3) + + ! Compute Omega x r (cross product) + crossProduct_v(1) = Omega(2)*r(3) - Omega(3)*r(2) + crossProduct_v(2) = Omega(3)*r(1) - Omega(1)*r(3) + crossProduct_v(3) = Omega(1)*r(2) - Omega(2)*r(1) + + ! Compute vR = vI - vO - Omega x r + vR(1) = vI(1) - vO(1) - crossProduct_v(1) + vR(2) = vI(2) - vO(2) - crossProduct_v(2) + vR(3) = vI(3) - vO(3) - crossProduct_v(3) + + END SUBROUTINE ConvertToMovingRotatingFrame + + subroutine coriolis_force(omega, vr, fcoriolis) + implicit none + + ! Arguments: + ! omega : Angular velocity of the rotating frame (3-element array) + ! vr : Velocity in the rotating frame (3-element array) + ! fcoriolis : Coriolis force (Output, 3-element array) + + real(mytype), intent(in) :: omega(3), vr(3) + real(mytype), intent(out) :: fcoriolis(3) + + ! Compute 2 * omega x vr (cross product) + fcoriolis(1) = 2.0_mytype * (omega(2)*vr(3) - omega(3)*vr(2)) + fcoriolis(2) = 2.0_mytype * (omega(3)*vr(1) - omega(1)*vr(3)) + fcoriolis(3) = 2.0_mytype * (omega(1)*vr(2) - omega(2)*vr(1)) + + end subroutine coriolis_force + + subroutine centrifugal_force(omega, r, fcentrifugal) + implicit none + + ! Parameters: + integer, parameter :: mytype = selected_real_kind(p=15) ! Assuming double precision + + ! Arguments: + ! omega : Angular velocity of the rotating frame (3-element array) + ! r : Position vector in the rotating frame (3-element array) + ! fcentrifugal : Centrifugal force (Output, 3-element array) + + real(mytype), intent(in) :: omega(3), r(3) + real(mytype), intent(out) :: fcentrifugal(3) + real(mytype) :: cross_product_omega_r(3) + + ! Compute omega x r (cross product) + cross_product_omega_r(1) = omega(2)*r(3) - omega(3)*r(2) + cross_product_omega_r(2) = omega(3)*r(1) - omega(1)*r(3) + cross_product_omega_r(3) = omega(1)*r(2) - omega(2)*r(1) + + ! Compute fcentrifugal = -omega x (omega x r) + fcentrifugal(1) = -(omega(2)*cross_product_omega_r(3) - omega(3)*cross_product_omega_r(2)) + fcentrifugal(2) = -(omega(3)*cross_product_omega_r(1) - omega(1)*cross_product_omega_r(3)) + fcentrifugal(3) = -(omega(1)*cross_product_omega_r(2) - omega(2)*cross_product_omega_r(1)) + + end subroutine centrifugal_force + + + + subroutine invert_3x3_matrix(matrix, inverse) + real(mytype), intent(in) :: matrix(3, 3) + real(mytype), intent(out) :: inverse(3, 3) + real(mytype) :: det + + ! Calculate the determinant of the 3x3 matrix + det = matrix(1, 1) * (matrix(2, 2) * matrix(3, 3) - matrix(3, 2) * matrix(2, 3)) & + - matrix(1, 2) * (matrix(2, 1) * matrix(3, 3) - matrix(3, 1) * matrix(2, 3)) & + + matrix(1, 3) * (matrix(2, 1) * matrix(3, 2) - matrix(3, 1) * matrix(2, 2)) + + ! Check if the determinant is zero (singular matrix) + if (abs(det) < 1e-10) then + write(*, *) "Matrix is singular. Inverse does not exist." + return + end if + + ! Calculate the elements of the inverse matrix using Cramer's rule + inverse(1, 1) = (matrix(2, 2) * matrix(3, 3) - matrix(3, 2) * matrix(2, 3)) / det + inverse(1, 2) = (matrix(1, 3) * matrix(3, 2) - matrix(3, 3) * matrix(1, 2)) / det + inverse(1, 3) = (matrix(1, 2) * matrix(2, 3) - matrix(2, 2) * matrix(1, 3)) / det + inverse(2, 1) = (matrix(2, 3) * matrix(3, 1) - matrix(3, 3) * matrix(2, 1)) / det + inverse(2, 2) = (matrix(1, 1) * matrix(3, 3) - matrix(3, 1) * matrix(1, 3)) / det + inverse(2, 3) = (matrix(1, 3) * matrix(2, 1) - matrix(2, 3) * matrix(1, 1)) / det + inverse(3, 1) = (matrix(2, 1) * matrix(3, 2) - matrix(3, 1) * matrix(2, 2)) / det + inverse(3, 2) = (matrix(1, 2) * matrix(3, 1) - matrix(3, 2) * matrix(1, 1)) / det + inverse(3, 3) = (matrix(1, 1) * matrix(2, 2) - matrix(2, 1) * matrix(1, 2)) / det + end subroutine invert_3x3_matrix + + subroutine matrix_vector_multiply(matrix, vector, result) + real(mytype), intent(in) :: matrix(3, 3) + real(mytype), intent(in) :: vector(3) + real(mytype), intent(out) :: result(3) + integer :: i, j + + do i = 1, 3 + result(i) = zero + do j = 1, 3 + result(i) = result(i) + matrix(i, j) * vector(j) + end do + end do + end subroutine matrix_vector_multiply + + + + subroutine accel_get(omega, inertia, torque_b, ang_accel) + real(mytype),intent(in) :: omega(4),inertia(3,3),torque_b(4) + real(mytype),intent(out) :: ang_accel(4) + real(mytype) :: inertia_inv(3,3),omega_v(3),torque_v(3),test(3),crossed(3),ang_accel_v(3) + + ! write(*,*) 'inverting ', inertia + call invert_3x3_matrix(inertia,inertia_inv) + omega_v=omega(2:4) + torque_v=torque_b(2:4) + call matrix_vector_multiply(inertia,omega_v,test) + call CrossProduct(omega_v,test,crossed) + call matrix_vector_multiply(inertia_inv,(torque_v-crossed),ang_accel_v) + ang_accel(:)=0_mytype + ang_accel(2:4)=ang_accel_v(1:3) + + end subroutine accel_get + + + + subroutine ang_half_step(q, omega_q, torque_vec, q_new, o_new) + use param + real(mytype),intent(in) :: q(4),omega_q(4),torque_vec(3) + real(mytype),intent(out) :: q_new(4),o_new(4) + real(mytype) :: inertia(3,3) + real(mytype) :: omega_b(4),torque_q(4),ang_accel_b(4),torque_b(4) + real(mytype) :: omega_n_quarter_b(4),omega_n_quarter(4),omega_n_half_b(4),omega_n_half(4) + real(mytype) :: q_half_predict(4) + + call lab_to_body(omega_q,q,omega_b) + torque_q(1)=zero + torque_q(2:4)=torque_vec(:) + + call lab_to_body(torque_q,q,torque_b) + + call accel_get(omega_b, inertia, torque_b, ang_accel_b) + + call omega_stepper(omega_b,ang_accel_b,dt*0.25,omega_n_quarter_b) + call omega_stepper(omega_b,ang_accel_b,dt*half,omega_n_half_b) + + call body_to_lab(omega_n_quarter_b,q,omega_n_quarter) + call orientation_stepper(q,omega_n_quarter,dt*half,q_half_predict) + + call body_to_lab(omega_n_half_b,q,omega_n_half) + + q_new=q_half_predict + o_new=omega_n_half + + end subroutine ang_half_step + + subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque_vec,q_full,omega_full) + use param + real(mytype),intent(in) :: q(4),omega_q(4),q_half(4),omega_n_half(4),torque_vec(3) + real(mytype),intent(out) :: q_full(4),omega_full(4) + real(mytype) :: inertia(3,3) + real(mytype) :: omega_b(4),omega_n_half_b(4),omega_full_b(4) + real(mytype) :: torque_q(4),torque_b(4) + real(mytype) :: ang_accel_half_b(4),omega_n_half2(4) + + call lab_to_body(omega_q, q, omega_b) + call lab_to_body(omega_n_half,q_half,omega_n_half_b) + + torque_q(1)=zero + torque_q(2:4)=torque_vec(:) + call lab_to_body(torque_q,q_half,torque_b) + + call accel_get(omega_n_half_b,inertia,torque_b,ang_accel_half_b) + call body_to_lab(omega_n_half_b,q_half,omega_n_half2) + + call orientation_stepper(q,omega_n_half2,dt,q_full) + + call omega_stepper(omega_b,ang_accel_half_b,dt,omega_full_b) + call body_to_lab(omega_full_b,q_full,omega_full) + + end subroutine ang_full_step + + subroutine ang_step(q,omega_q,torque_vec,inertia,time_step,q1,omega1) + use param + ! use ibm_param, only: inertia + real(mytype),intent(in) :: q(4),omega_q(4),torque_vec(3),inertia(3,3),time_step + real(mytype),intent(out):: q1(4),omega1(4) + real(mytype) :: torque_q(4),omega_b(4),torque_b(4),omega_half_b(4),omega1_b(4) + real(mytype) :: ang_accel_b(4), omega_half(4) + + ! write(*,*) 'ang_vel_lab = ', omega_q + call lab_to_body(omega_q, q, omega_b) !convert to body frame + ! write(*,*) 'ang_vel_b = ', omega_b + torque_q(1)=zero + torque_q(2:4)=torque_vec(:) + ! write(*,*) 'torque = ', torque_q + call lab_to_body(torque_q,q, torque_b) + ! write(*,*) 'torque_b = ', torque_b + + call accel_get(omega_b,inertia,torque_b,ang_accel_b) !calculate acceleration + ! write(*,*) 'acceleration =', ang_accel_b + + call omega_stepper(omega_b, ang_accel_b,time_step*half,omega_half_b) + ! write(*,*) 'omega_half_b =', omega_half_b + call omega_stepper(omega_b, ang_accel_b,time_step,omega1_b) !calculate omega at half and full timestep + ! write(*,*) 'omega_full_b =', omega1_b + call body_to_lab(omega_half_b,q,omega_half) !convert back to lab + ! write(*,*) 'omega_half_lab', omega_half + call orientation_stepper(q,omega_half,time_step,q1) !step forward orientation + ! write(*,*) 'time_step =', time_step + ! write(*,*) 'orientation1 =', q1 + call body_to_lab(omega1_b,q1,omega1) + ! write(*,*) 'omega_full =', omega1 + + end subroutine ang_step + + + subroutine lin_step(position,linearVelocity,linearForce,ellip_m,time_step,position_1,linearVelocity_1) + ! use ibm_param, only: ellip_m + real(mytype),intent(in) :: position(3),linearVelocity(3),linearForce(3),ellip_m,time_step + real(mytype),intent(out) :: position_1(3),linearVelocity_1(3) + real(mytype) :: linearAcceleration(3) + + linearAcceleration(:) = linearForce(:) / ellip_m + position_1(:) = position(:) + time_step*linearVelocity(:) + linearVelocity_1 = linearVelocity(:) + time_step*linearAcceleration(:) + + end subroutine lin_step + + subroutine ellipMassCalculate(shape,rho_s,mass) + use constants, only: pi + real(mytype),intent(in) :: shape(3),rho_s + real(mytype),intent(out) :: mass + real(mytype) :: a,b,c,vol + + a=shape(1) + b=shape(2) + c=shape(3) + vol=(4_mytype/3_mytype)*pi*a*b*c + mass=vol*rho_s + + end subroutine ellipMassCalculate + + subroutine ellipInertiaCalculate(shape,rho_s,inertia) + real(mytype),intent(in) :: shape(3),rho_s + real(mytype),intent(out) :: inertia(3,3) + real(mytype) :: a,b,c,i1,i2,i3,mass + + call ellipMassCalculate(shape,rho_s,mass) + + a=shape(1) + b=shape(2) + c=shape(3) + + i1=mass*(b**2+c**2)*0.2 + i2=mass*(a**2+c**2)*0.2 + i3=mass*(a**2+b**2)*0.2 + + inertia(:,:)=0_mytype + inertia(1,1)=i1 + inertia(2,2)=i2 + inertia(3,3)=i3 + + end subroutine ellipInertiaCalculate + + subroutine ibm_bcimp_calc(pointVelocity, lind, bcimp) + real(mytype), intent(in) :: pointVelocity(3) + integer, intent(in) :: lind + real(mytype), intent(out) :: bcimp + real(mytype) :: x_pv, y_pv, z_pv + + x_pv=pointVelocity(1) + y_pv=pointVelocity(2) + z_pv=pointVelocity(3) + if (lind.eq.0) then + bcimp=zero + elseif (lind.eq.1) then + bcimp=ubcx + ! write(*,*) bcimp + elseif (lind.eq.2) then + bcimp=ubcy + elseif (lind.eq.3) then + bcimp=ubcz + elseif (lind.eq.4) then + bcimp=ubcx*ubcx + elseif (lind.eq.5) then + bcimp=ubcy*ubcy + elseif (lind.eq.6) then + bcimp=ubcz*ubcz + elseif (lind.eq.7) then + bcimp=ubcx*ubcy + elseif (lind.eq.8) then + bcimp=ubcx*ubcz + elseif (lind.eq.9) then + bcimp=ubcy*ubcz + elseif (lind.eq.-1) then + bcimp=x_pv + ! write(*,*) bcimp + elseif (lind.eq.-2) then + bcimp=y_pv + elseif (lind.eq.-3) then + bcimp=z_pv + elseif (lind.eq.-4) then + bcimp=x_pv*x_pv + elseif (lind.eq.-5) then + bcimp=y_pv*y_pv + elseif (lind.eq.-6) then + bcimp=z_pv*z_pv + elseif (lind.eq.-7) then + bcimp=x_pv*y_pv + elseif (lind.eq.-8) then + bcimp=x_pv*z_pv + elseif (lind.eq.-9) then + bcimp=y_pv*z_pv + endif + end subroutine + +end module ellipsoid_utils diff --git a/src/filters.f90 b/src/filters.f90 index cf34259b0..fd2eed57e 100644 --- a/src/filters.f90 +++ b/src/filters.f90 @@ -230,7 +230,7 @@ subroutine filx_00(tx,ux,rx,fisx,fiffx,fifsx,fifwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: fisx real(mytype), dimension(nx) :: fiffx,fifsx,fifwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -301,7 +301,7 @@ subroutine filx_11(tx,ux,rx,fisx,fiffx,fifsx,fifwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: fisx real(mytype), dimension(nx) :: fiffx,fifsx,fifwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -393,7 +393,7 @@ subroutine filx_12(tx,ux,rx,fisx,fiffx,fifsx,fifwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: fisx real(mytype), dimension(nx) :: fiffx,fifsx,fifwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -479,7 +479,7 @@ subroutine filx_21(tx,ux,rx,fisx,fiffx,fifsx,fifwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: fisx real(mytype), dimension(nx) :: fiffx,fifsx,fifwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -567,7 +567,7 @@ subroutine filx_22(tx,ux,rx,fisx,fiffx,fifsx,fifwx,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tx,ux,rx real(mytype), dimension(ny,nz) :: fisx real(mytype), dimension(nx) :: fiffx,fifsx,fifwx - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolx(ux) if (iibm.eq.3) call cubsplx(ux,lind) @@ -615,7 +615,7 @@ subroutine fily_00(ty,uy,ry,fisy,fiffy,fifsy,fifwy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: fisy real(mytype), dimension(ny) :: fiffy,fifsy,fifwy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -691,7 +691,7 @@ subroutine fily_11(ty,uy,ry,fisy,fiffy,fifsy,fifwy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: fisy real(mytype), dimension(ny) :: fiffy,fifsy,fifwy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -784,7 +784,7 @@ subroutine fily_12(ty,uy,ry,fisy,fiffy,fifsy,fifwy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: fisy real(mytype), dimension(ny) :: fiffy,fifsy,fifwy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -869,7 +869,7 @@ subroutine fily_21(ty,uy,ry,fisy,fiffy,fifsy,fifwy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: fisy real(mytype), dimension(ny) :: fiffy,fifsy,fifwy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -955,7 +955,7 @@ subroutine fily_22(ty,uy,ry,fisy,fiffy,fifsy,fifwy,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: ry real(mytype), dimension(nx,nz) :: fisy real(mytype), dimension(ny) :: fiffy,fifsy,fifwy - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpoly(uy) if (iibm.eq.3) call cubsply(uy,lind) @@ -1003,7 +1003,7 @@ subroutine filz_00(tz,uz,rz,fisz,fiffz,fifsz,fifwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: fisz real(mytype), dimension(nz) :: fiffz,fifsz,fifwz - real(mytype) :: lind + integer :: lind if (nz==1) then tz = uz @@ -1079,7 +1079,7 @@ subroutine filz_11(tz,uz,rz,fisz,fiffz,fifsz,fifwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: fisz real(mytype), dimension(nz) :: fiffz,fifsz,fifwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1169,7 +1169,7 @@ subroutine filz_12(tz,uz,rz,fisz,fiffz,fifsz,fifwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: fisz real(mytype), dimension(nz) :: fiffz,fifsz,fifwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1254,7 +1254,7 @@ subroutine filz_21(tz,uz,rz,fisz,fiffz,fifsz,fifwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: fisz real(mytype), dimension(nz) :: fiffz,fifsz,fifwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) @@ -1340,7 +1340,7 @@ subroutine filz_22(tz,uz,rz,fisz,fiffz,fifsz,fifwz,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: tz,uz,rz real(mytype), dimension(nx,ny) :: fisz real(mytype), dimension(nz) :: fiffz,fifsz,fifwz - real(mytype) :: lind + integer :: lind if (iibm.eq.2) call lagpolz(uz) if (iibm.eq.3) call cubsplz(uz,lind) diff --git a/src/forces.f90 b/src/forces.f90 index 25f57637d..c1408e83d 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -20,13 +20,14 @@ module forces implicit none - integer,save :: nvol,iforces,i2dsim - real(mytype),save,allocatable,dimension(:,:,:) :: ux01, uy01, ux11, uy11, ppi1 - real(mytype),save,allocatable,dimension(:) :: xld,xrd,yld,yud,zfr,zbk - integer,save,allocatable,dimension(:) :: icvlf,icvrt,jcvlw,jcvup,kcvfr,kcvbk - integer,save,allocatable,dimension(:) :: icvlf_lx,icvrt_lx,icvlf_ly,icvrt_ly - integer,save,allocatable,dimension(:) :: jcvlw_lx,jcvup_lx,jcvlw_ly,jcvup_ly - integer,save,allocatable,dimension(:) :: kcvfr_lx,kcvbk_lx,kcvfr_ly,kcvbk_ly + integer :: nvol,iforces + real(mytype),save,allocatable,dimension(:,:,:) :: ux01, uy01, ux11, uy11, ppi1, uz01, uz11 + real(mytype),allocatable,dimension(:) :: xld, xrd, yld, yud, zld, zrd, xld2, xrd2, yld2, yud2, zld2, zrd2 + integer,allocatable,dimension(:) :: icvlf,icvrt,jcvlw,jcvup,zcvlf,zcvrt + integer,allocatable,dimension(:) :: icvlf_lx, icvrt_lx, icvlf_ly, icvrt_ly, icvlf_lz, icvrt_lz + integer,allocatable,dimension(:) :: jcvlw_lx, jcvup_lx, jcvlw_ly, jcvup_ly, jcvlw_lz, jcvup_lz + integer,allocatable,dimension(:) :: zcvlf_lx, zcvrt_lx, zcvlf_ly, zcvrt_ly, zcvlf_lz, zcvrt_lz + character(len=*), parameter :: io_restart_forces = "restart-forces-io", & resfile = "restart-forces" @@ -47,16 +48,39 @@ subroutine init_forces call alloc_x(ux11) call alloc_x(uy11) call alloc_x(ppi1) + call alloc_x(uz01) + call alloc_x(uz11) ux01 = zero uy01 = zero ux11 = zero uy11 = zero - - allocate(icvlf(nvol),icvrt(nvol),jcvlw(nvol),jcvup(nvol),kcvfr(nvol),kcvbk(nvol)) - allocate(icvlf_lx(nvol),icvrt_lx(nvol),icvlf_ly(nvol),icvrt_ly(nvol)) - allocate(jcvlw_lx(nvol),jcvup_lx(nvol),jcvlw_ly(nvol),jcvup_ly(nvol)) - allocate(kcvfr_lx(nvol),kcvbk_lx(nvol),kcvfr_ly(nvol),kcvbk_ly(nvol)) + uz01 = zero + uz11 = zero + + ! write(*,*) 'Alloc_x called' + + allocate(icvlf(nvol), icvrt(nvol), jcvlw(nvol), jcvup(nvol), zcvlf(nvol), zcvrt(nvol)) + allocate(icvlf_lx(nvol), icvrt_lx(nvol), icvlf_ly(nvol), icvrt_ly(nvol), icvlf_lz(nvol), icvrt_lz(nvol)) + allocate(jcvlw_lx(nvol), jcvup_lx(nvol), jcvlw_ly(nvol), jcvup_ly(nvol), jcvlw_lz(nvol), jcvup_lz(nvol)) + allocate(zcvlf_lx(nvol), zcvrt_lx(nvol), zcvlf_ly(nvol), zcvrt_ly(nvol), zcvlf_lz(nvol), zcvrt_lz(nvol)) + allocate(xld2(nvol), xrd2(nvol), yld2(nvol), yud2(nvol), zld2(nvol), zrd2(nvol)) + + ! write(*,*) 'allocate called' + + ! if ((iibm.ne.0).and.(t.ne.0.)) then + ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx + ! xrd2(:) = xrd(:) + (t-ifirst*dt)*ubcx + ! yld2(:) = yld(:) + (t-ifirst*dt)*ubcy + ! yud2(:) = yud(:) + (t-ifirst*dt)*ubcy + ! else + xld2(:) = xld(:) + xrd2(:) = xrd(:) + yld2(:) = yld(:) + yud2(:) = yud(:) + zld2(:) = zld(:) + zrd2(:) = zrd(:) + ! endif ! Definition of the Control Volume !***************************************************************** @@ -66,8 +90,6 @@ subroutine init_forces ! ok for istret=0 (!!to do for istret=1!!) icvlf(iv) = nint(xld(iv)/dx)+1 icvrt(iv) = nint(xrd(iv)/dx)+1 - kcvfr(iv) = nint(zfr(iv)/dz)+1 - kcvbk(iv) = nint(zbk(iv)/dz)+1 if (istret.eq.0) then jcvlw(iv) = nint(yld(iv)/dy)+1 jcvup(iv) = nint(yud(iv)/dy)+1 @@ -89,56 +111,46 @@ subroutine init_forces icvrt_lx(iv) = icvrt(iv) jcvlw_lx(iv) = max(jcvlw(iv)+1-xstart(2),1) jcvup_lx(iv) = min(jcvup(iv)+1-xstart(2),xsize(2)) - kcvfr_lx(iv) = max(kcvfr(iv)+1-xstart(3),1) - kcvbk_lx(iv) = min(kcvbk(iv)+1-xstart(3),xsize(3)) + jcvlw_lz(iv) = max(jcvlw(iv)+1-zstart(2),1) + jcvup_lz(iv) = min(jcvup(iv)+1-zstart(2),zsize(2)) + icvlf_ly(iv) = max(icvlf(iv)+1-ystart(1),1) icvrt_ly(iv) = min(icvrt(iv)+1-ystart(1),ysize(1)) + icvlf_lz(iv) = max(icvlf(iv)+1-zstart(1),1) + icvrt_lz(iv) = min(icvrt(iv)+1-zstart(1),zsize(1)) jcvlw_ly(iv) = jcvlw(iv) jcvup_ly(iv) = jcvup(iv) - kcvfr_ly(iv) = max(kcvfr(iv)+1-ystart(3),1) - kcvbk_ly(iv) = min(kcvbk(iv)+1-ystart(3),ysize(3)) + + zcvlf(iv) = nint(zld(iv)/dz)+1 + zcvrt(iv) = nint(zrd(iv)/dz)+1 + zcvlf_lx(iv) = max(zcvlf(iv)+1-xstart(3),1) + zcvrt_lx(iv) = min(zcvrt(iv)+1-xstart(3),xsize(3)) + zcvlf_ly(iv) = max(zcvlf(iv)+1-ystart(3),1) + zcvrt_ly(iv) = min(zcvrt(iv)+1-ystart(3),ysize(3)) + zcvlf_lz(iv) = zcvlf(iv) + zcvrt_lz(iv) = zcvrt(iv) enddo if (nrank==0) then - if (i2dsim==1) then - write(*,*) '========================Forces=============================' - write(*,*) ' (icvlf) (icvrt) ' - write(*,*) ' (jcvup) B____________C ' - write(*,*) ' \ \ ' - write(*,*) ' \ __ \ ' - write(*,*) ' \ \__\ \ ' - write(*,*) ' \ \ ' - write(*,*) ' \ CV \ ' - write(*,*) ' (jcvlw) A____________D ' - do iv=1,nvol - write(*,"(' Control Volume : #',I1)") iv - write(*,"(' xld, icvlf : (',F6.2,',',I6,')')") xld(iv), icvlf(iv) - write(*,"(' xrd, icvrt : (',F6.2,',',I6,')')") xrd(iv), icvrt(iv) - write(*,"(' yld, jcvlw : (',F6.2,',',I6,')')") yld(iv), jcvlw(iv) - write(*,"(' yud, jcvup : (',F6.2,',',I6,')')") yud(iv), jcvup(iv) - enddo - write(*,*) '===========================================================' - elseif (i2dsim==0) then - write(*,*) '========================Forces=============================' - write(*,*) ' (icvlf) (icvrt) (kcvbk) (kcvfr)' - write(*,*) ' (jcvup) B____________C B`_____________B ' - write(*,*) ' \ \ | \ \ ' - write(*,*) ' \ __ \ | \ ____ \ ' - write(*,*) ' \ \__\ \ | \ \___\ \ ' - write(*,*) ' \ \ | \ \ ' - write(*,*) ' \ CV \ | \ (Front) \ ' - write(*,*) ' (jcvlw) A____________D | A`_____________A ' - do iv=1,nvol - write(*,"(' Control Volume : #',I1)") iv - write(*,"(' xld, icvlf : (',F6.2,',',I6,')')") xld(iv), icvlf(iv) - write(*,"(' xrd, icvrt : (',F6.2,',',I6,')')") xrd(iv), icvrt(iv) - write(*,"(' yld, jcvlw : (',F6.2,',',I6,')')") yld(iv), jcvlw(iv) - write(*,"(' yud, jcvup : (',F6.2,',',I6,')')") yud(iv), jcvup(iv) - write(*,"(' zfr, kcvfr : (',F6.2,',',I6,')')") zfr(iv), kcvfr(iv) - write(*,"(' zbk, kcvbk : (',F6.2,',',I6,')')") zbk(iv), kcvbk(iv) - enddo - write(*,*) '===========================================================' - endif + write(*,*) '========================Forces=============================' + write(*,*) ' (icvlf) (icvrt) ' + write(*,*) ' (jcvup) B____________C ' + write(*,*) ' \ \ ' + write(*,*) ' \ __ \ ' + write(*,*) ' \ \__\ \ ' + write(*,*) ' \ \ ' + write(*,*) ' \ CV \ ' + write(*,*) ' (jcvlw) A____________D ' + do iv=1,nvol + write(*,"(' Control Volume : #',I1)") iv + write(*,"(' xld, icvlf : (',F6.2,',',I6,')')") xld(iv), icvlf(iv) + write(*,"(' xrd, icvrt : (',F6.2,',',I6,')')") xrd(iv), icvrt(iv) + write(*,"(' yld, jcvlw : (',F6.2,',',I6,')')") yld(iv), jcvlw(iv) + write(*,"(' yud, jcvup : (',F6.2,',',I6,')')") yud(iv), jcvup(iv) + write(*,"(' zld, zcvlf : (',F6.2,',',I6,')')") zld(iv), zcvlf(iv) + write(*,"(' zrd, zcvrt : (',F6.2,',',I6,')')") zrd(iv), zcvrt(iv) + enddo + write(*,*) '===========================================================' endif call decomp_2d_init_io(io_restart_forces) @@ -146,51 +158,193 @@ subroutine init_forces call decomp_2d_register_variable(io_restart_forces, "uy01", 1, 0, 0, mytype) call decomp_2d_register_variable(io_restart_forces, "ux11", 1, 0, 0, mytype) call decomp_2d_register_variable(io_restart_forces, "uy11", 1, 0, 0, mytype) - + call decomp_2d_register_variable(io_restart_forces, "uz01", 1, 0, 0, mytype) + call decomp_2d_register_variable(io_restart_forces, "uz11", 1, 0, 0, mytype) + end subroutine init_forces - ! - ! Allocate 1D arrays and initialize variables before reading the forces namelist - ! + subroutine update_forces + + USE decomp_2d + USE decomp_2d_io, only : decomp_2d_register_variable, decomp_2d_init_io + USE param + USE variables + implicit none + + integer :: iv,stp1,stp2,h + +! ! write(*,*) 'Inside INIT_FORCES' + +! call alloc_x(ux01) +! call alloc_x(uy01) +! call alloc_x(ux11) +! call alloc_x(uy11) +! call alloc_x(ppi1) +! call alloc_x(uz01) +! call alloc_x(uz11) + +! ux01 = zero +! uy01 = zero +! ux11 = zero +! uy11 = zero +! uz01 = zero +! uz11 = zero + +! ! write(*,*) 'Alloc_x called' + +! allocate(icvlf(nvol), icvrt(nvol), jcvlw(nvol), jcvup(nvol), zcvlf(nvol), zcvrt(nvol)) +! allocate(icvlf_lx(nvol), icvrt_lx(nvol), icvlf_ly(nvol), icvrt_ly(nvol), icvlf_lz(nvol), icvrt_lz(nvol)) +! allocate(jcvlw_lx(nvol), jcvup_lx(nvol), jcvlw_ly(nvol), jcvup_ly(nvol), jcvlw_lz(nvol), jcvup_lz(nvol)) +! allocate(zcvlf_lx(nvol), zcvrt_lx(nvol), zcvlf_ly(nvol), zcvrt_ly(nvol)) +! allocate(xld2(nvol), xrd2(nvol), yld2(nvol), yud2(nvol), zld2(nvol), zrd2(nvol)) + + ! write(*,*) 'allocate called' + + ! if ((iibm.ne.0).and.(t.ne.0.)) then + ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx + ! xrd2(:) = xrd(:) + (t-ifirst*dt)*ubcx + ! yld2(:) = yld(:) + (t-ifirst*dt)*ubcy + ! yud2(:) = yud(:) + (t-ifirst*dt)*ubcy + ! else + xld2(:) = xld(:) + xrd2(:) = xrd(:) + yld2(:) = yld(:) + yud2(:) = yud(:) + zld2(:) = zld(:) + zrd2(:) = zrd(:) + ! endif + + ! Definition of the Control Volume + !***************************************************************** + !! xld,xrd,yld,yud: limits of control volume (!!don't use cex and cey anymore!!) + + + do iv=1,nvol + ! ok for istret=0 (!!to do for istret=1!!) + icvlf(iv) = nint(xld(iv)/dx)+1 + icvrt(iv) = nint(xrd(iv)/dx)+1 + if (istret.eq.0) then + jcvlw(iv) = nint(yld(iv)/dy)+1 + jcvup(iv) = nint(yud(iv)/dy)+1 + else + stp1=0 + stp2=0 + do h = 1, ny-1 + if ((-yp(h+1)-yp(h)+two*yld(iv)).lt.(yld(iv)-yp(h)).and.(stp1.eq.0)) then + jcvlw(iv) = h+1 + stp1=1 + endif + if ((-yp(h+1)-yp(h)+two*yud(iv)).lt.(yud(iv)-yp(h)).and.(stp2.eq.0)) then + jcvup(iv) = h + stp2=1 + endif + enddo + endif + icvlf_lx(iv) = icvlf(iv) + icvrt_lx(iv) = icvrt(iv) + jcvlw_lx(iv) = max(jcvlw(iv)+1-xstart(2),1) + jcvup_lx(iv) = min(jcvup(iv)+1-xstart(2),xsize(2)) + jcvlw_lz(iv) = max(jcvlw(iv)+1-zstart(2),1) + jcvup_lz(iv) = min(jcvup(iv)+1-zstart(2),zsize(2)) + + icvlf_ly(iv) = max(icvlf(iv)+1-ystart(1),1) + icvrt_ly(iv) = min(icvrt(iv)+1-ystart(1),ysize(1)) + icvlf_lz(iv) = max(icvlf(iv)+1-zstart(1),1) + icvrt_lz(iv) = min(icvrt(iv)+1-zstart(1),zsize(1)) + jcvlw_ly(iv) = jcvlw(iv) + jcvup_ly(iv) = jcvup(iv) + + zcvlf(iv) = nint(zld(iv)/dz)+1 + zcvrt(iv) = nint(zrd(iv)/dz)+1 + zcvlf_lx(iv) = max(zcvlf(iv)+1-xstart(3),1) + zcvrt_lx(iv) = min(zcvrt(iv)+1-xstart(3),xsize(3)) + zcvlf_ly(iv) = max(zcvlf(iv)+1-ystart(3),1) + zcvrt_ly(iv) = min(zcvrt(iv)+1-ystart(3),ysize(3)) + enddo + + ! if (nrank==0) then + ! write(*,*) '========================Forces=============================' + ! write(*,*) ' (icvlf) (icvrt) ' + ! write(*,*) ' (jcvup) B____________C ' + ! write(*,*) ' \ \ ' + ! write(*,*) ' \ __ \ ' + ! write(*,*) ' \ \__\ \ ' + ! write(*,*) ' \ \ ' + ! write(*,*) ' \ CV \ ' + ! write(*,*) ' (jcvlw) A____________D ' + ! do iv=1,nvol + ! write(*,"(' Control Volume : #',I1)") iv + ! write(*,"(' xld, icvlf : (',F6.2,',',I6,')')") xld(iv), icvlf(iv) + ! write(*,"(' xrd, icvrt : (',F6.2,',',I6,')')") xrd(iv), icvrt(iv) + ! write(*,"(' yld, jcvlw : (',F6.2,',',I6,')')") yld(iv), jcvlw(iv) + ! write(*,"(' yud, jcvup : (',F6.2,',',I6,')')") yud(iv), jcvup(iv) + ! write(*,"(' zld, zcvlf : (',F6.2,',',I6,')')") zld(iv), zcvlf(iv) + ! write(*,"(' zrd, zcvrt : (',F6.2,',',I6,')')") zrd(iv), zcvrt(iv) + ! enddo + ! write(*,*) '===========================================================' + ! endif + + ! call decomp_2d_init_io(io_restart_forces) + ! call decomp_2d_register_variable(io_restart_forces, "ux01", 1, 0, 0, mytype) + ! call decomp_2d_register_variable(io_restart_forces, "uy01", 1, 0, 0, mytype) + ! call decomp_2d_register_variable(io_restart_forces, "ux11", 1, 0, 0, mytype) + ! call decomp_2d_register_variable(io_restart_forces, "uy11", 1, 0, 0, mytype) + ! call decomp_2d_register_variable(io_restart_forces, "uz01", 1, 0, 0, mytype) + ! call decomp_2d_register_variable(io_restart_forces, "uz11", 1, 0, 0, mytype) + + + end subroutine update_forces +! if ((iibm.ne.0).and.(t.ne.0.)) then + ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx + ! xrd2(:) = xrd(:) + (t-ifirst*dt)*ubcx + ! yld2(:) = yld(:) + (t-ifirst*dt)*ubcy + ! yud2(:) = yud(:) + (t-ifirst*dt)*ubcy + ! else + ! xld2(:) = xld(:) + ! xrd2(:) = xrd(:) + ! yld2(:) = yld(:) + ! yud2(:) = yud(:) + ! endif + subroutine setup_forces(iounit) - implicit none + implicit none - ! Argument - integer, intent(in) :: iounit + ! Argument + integer, intent(in) :: iounit - NAMELIST /ForceCVs/ xld, xrd, yld, yud, zfr, zbk, i2dsim + NAMELIST /ForceCVs/ xld, xrd, yld, yud, zld, zrd! , i2dsim - ! Safety check - if (allocated(xld)) then - call decomp_2d_abort(1, "Error in setup_forces") - end if - if (nvol < 1) then - call decomp_2d_abort(nvol, "Invalid nvol in setup_forces") - end if + ! Safety check + if (allocated(xld)) then + call decomp_2d_abort(1, "Error in setup_forces") + end if + if (nvol < 1) then + call decomp_2d_abort(nvol, "Invalid nvol in setup_forces") + end if - ! Allocate 1D arrays - allocate(xld(nvol), xrd(nvol), yld(nvol), yud(nvol), zfr(nvol), zbk(nvol)) - - ! Default values in the forces namelist - xld = 0._mytype - xrd = 0._mytype - yld = 0._mytype - yud = 0._mytype - zfr = 0._mytype - zbk = 0._mytype - i2dsim = 1 - - ! Read a part of the namelist and rewind - read(iounit, nml=ForceCVs) - rewind(iounit) - - ! Safety check - if (i2dsim < 0 .or. i2dsim > 1) then - call decomp_2d_abort(i2dsim, "Invalid value for the parameter i2dsim") - end if + ! Allocate 1D arrays + allocate(xld(nvol), xrd(nvol), yld(nvol), yud(nvol), zld(nvol), zrd(nvol)) + + ! Default values in the forces namelist + xld = 0._mytype + xrd = 0._mytype + yld = 0._mytype + yud = 0._mytype + zld = 0._mytype + zrd = 0._mytype + ! i2dsim = 1 + + ! Read a part of the namelist and rewind + read(iounit, nml=ForceCVs) + rewind(iounit) + + ! ! Safety check + ! if (i2dsim < 0 .or. i2dsim > 1) then + ! call decomp_2d_abort(i2dsim, "Invalid value for the parameter i2dsim") + ! end if - end subroutine setup_forces + end subroutine setup_forces subroutine restart_forces(itest1) @@ -201,8 +355,9 @@ subroutine restart_forces(itest1) implicit none - ! Argument - integer, intent(in) :: itest1 + integer :: ierror,code,itest1 + integer :: ierror_o=0 !error to open save file during restart + character(len=30) :: filename, filestart ! Exit if writing and invalid time step if (itest1 == 1 .and. mod(itime, icheckpoint).ne.0) then @@ -222,58 +377,99 @@ subroutine restart_forces(itest1) call decomp_2d_write_one(1,uy01,resfile,"uy01",0,io_restart_forces) call decomp_2d_write_one(1,ux11,resfile,"ux11",0,io_restart_forces) call decomp_2d_write_one(1,uy11,resfile,"uy11",0,io_restart_forces) + call decomp_2d_write_one(1,uz01,resfile,"uz01",0,io_restart_forces) + call decomp_2d_write_one(1,uz11,resfile,"uz11",0,io_restart_forces) + else !read call decomp_2d_read_one(1,ux01,resfile,"ux01",io_restart_forces) call decomp_2d_read_one(1,uy01,resfile,"uy01",io_restart_forces) call decomp_2d_read_one(1,ux11,resfile,"ux11",io_restart_forces) call decomp_2d_read_one(1,uy11,resfile,"uy11",io_restart_forces) + call decomp_2d_read_one(1,uz01,resfile,"uz01",io_restart_forces) + call decomp_2d_read_one(1,uz11,resfile,"uz11",io_restart_forces) + endif call decomp_2d_end_io(io_restart_forces, resfile) call decomp_2d_close_io(io_restart_forces, resfile) - + end subroutine restart_forces - subroutine force(ux1,uy1,uz1,ep1) + subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) USE param USE variables USE MPI USE ibm_param + USE ellipsoid_utils, only : CrossProduct,centrifugal_force,coriolis_force + + use var, only : ta1, tb1, tc1, td1, te1, tf1, tg1, th1, ti1, di1 + use var, only : ux2, uy2, uz2, ta2, tb2, tc2, td2, te2, tf2, tg2, th2, ti2, di2 + use var, only : ux3, uy3, uz3, ta3, tb3, tc3, td3, te3, tf3, tg3, th3, ti3, di3 - use var, only : ta1, tb1, tc1, td1, te1, di1, tg1, tg2, tg3, th1, th2, th3, tf2, tf1 - use var, only : ux2, ux3, uy2, uy3, uz2, ta2, tb2, td2, te2, di2, di3 - use var, only : tc2 implicit none character(len=30) :: filename, filename2 integer :: nzmsize - integer :: i, iv, j, k, kk, code, jj + integer :: i, iv, j, k, kk, code, jj, ii integer :: nvect1,nvect2,nvect3 integer :: ierror real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ux1, uy1, uz1 real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ep1 + integer, intent(in) ::record_var + real(mytype), intent(out) :: dra1(10),dra2(10),dra3(10) - !real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 ! we'll use tc2 + real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 + real(mytype), dimension(zsize(1),zsize(2),zsize(3)) :: ppi3 - real(mytype), dimension(nz) :: yLift,xDrag - real(mytype) :: yLift_mean,xDrag_mean + real(mytype), dimension(nz) :: yLift,xDrag, zLat + real(mytype) :: yLift_mean,xDrag_mean,zLat_mean + real(mytype) :: xm,ym,zm,rotationalComponent(3) real(mytype), dimension(ny-1) :: del_y - real(mytype), dimension(nz) :: tunstx,tunsty - real(mytype), dimension(nz) :: tconvx,tconvy + real(mytype), dimension(nz) :: tunstxl, tunstyl, tunstzl + real(mytype), dimension(nz) :: tconvxl,tconvyl,tconvzl + real(mytype), dimension(nz) :: tpresxl,tpresyl + real(mytype), dimension(nz) :: tdiffxl,tdiffyl,tdiffzl + + real(mytype), dimension(nz) :: tunstx, tunsty, tunstz + real(mytype), dimension(nz) :: tconvx,tconvy,tconvz real(mytype), dimension(nz) :: tpresx,tpresy - real(mytype), dimension(nz) :: tdiffx,tdiffy + real(mytype), dimension(nz) :: tdiffx,tdiffy,tdiffz + + + + real(mytype), dimension(ny) :: tconvxl2, tconvyl2, tconvzl2 + real(mytype), dimension(ny) :: tdiffxl2, tdiffyl2, tdiffzl2 + real(mytype), dimension(ny) :: tconvx2, tconvy2, tconvz2 + real(mytype), dimension(ny) :: tdiffx2, tdiffy2, tdiffz2 + real(mytype), dimension(ny) :: tpreszl, tpresz + real(mytype) :: uxmid,uymid,uzmid,prmid - real(mytype) :: dudxmid,dudymid,dvdxmid,dvdymid,dudzmid,dwdxmid,dwdymid,dvdzmid - real(mytype) :: fac,tsumx,tsumy - real(mytype) :: fcvx,fcvy,fprx,fpry,fdix,fdiy - real(mytype) :: xmom,ymom - real(mytype) :: convx,convy,pressx,pressy,stressx,stressy + real(mytype) :: dudxmid,dudymid,dudzmid,dvdxmid,dvdymid,dvdzmid + real(mytype) :: dwdxmid,dwdymid,dwdzmid + real(mytype) :: fac,fac1,fac2,fac3,tsumx,tsumy,tsumz,centrifugal(3),coriolis(3) + real(mytype) :: fcvx,fcvy,fcvz,fprx,fpry,fprz,fdix,fdiy,fdiz + real(mytype) :: xmom,ymom,zmom + real(mytype), dimension(ny) :: ztpresx, ztpresy + real(mytype), dimension(nz) :: zyLift, zxDrag, zzLat + real(mytype) :: zyLift_mean, zxDrag_mean, zzLat_mean + + + real(mytype), dimension(nz) :: drag1, drag2, drag11, drag22 + real(mytype), dimension(nz) :: drag3, drag4, drag33, drag44 + real(mytype) :: mom1, mom2, mom3, tp1, tp2, tp3 + + ! write(*,*) 'Inside FORCE' + + + dra1(:) = zero + dra2(:) = zero + dra3(:) = zero nvect1=xsize(1)*xsize(2)*xsize(3) nvect2=ysize(1)*ysize(2)*ysize(3) @@ -288,651 +484,1465 @@ subroutine force(ux1,uy1,uz1,ep1) enddo if (itime.eq.1) then + do iv=1,nvol + ! if (nrank.eq.0) then + ! open(12,file="Body1.dat",status='unknown',form='formatted') + ! endif + if ((nrank .eq. 0).and.(record_var.eq.1)) then + write(filename,"('forces.dat',I1.1)") iv + open(38+(iv-1),file=filename,status='unknown',form='formatted') + write(38+(iv-1),*) t, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero + call flush(38+(iv-1)) + ! write(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) + endif + enddo do k = 1, xsize(3) do j = 1, xsize(2) do i = 1, xsize(1) ux11(i,j,k)=ux1(i,j,k) uy11(i,j,k)=uy1(i,j,k) + uz11(i,j,k)=uz1(i,j,k) enddo enddo enddo return elseif (itime.eq.2) then + if ((nrank .eq. 0).and.(record_var.eq.1)) then + do i = 1,nvol + write(38+(iv-1),*) t, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero + call flush(38+(iv-1)) + enddo + endif do k = 1, xsize(3) do j = 1, xsize(2) do i = 1, xsize(1) ux01(i,j,k)=ux1(i,j,k) uy01(i,j,k)=uy1(i,j,k) + uz01(i,j,k)=uz1(i,j,k) enddo enddo enddo return endif - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) ! dudx - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) ! dvdx + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) ! dudx !x is 1 + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) ! dvdx !y is 2 + call derx (te1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) ! dw/dx!z is 3 + call transpose_x_to_y(ta1,ta2) ! dudx call transpose_x_to_y(tb1,tb2) ! dvdx + call transpose_x_to_y(te1,te2) ! dw/dx call transpose_x_to_y(ux1,ux2) call transpose_x_to_y(uy1,uy2) - call transpose_x_to_y(ppi1,tc2) + call transpose_x_to_y(uz1,uz2) + call transpose_x_to_y(ppi1,ppi2) - call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) ! dudy - call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) ! dvdy - call transpose_y_to_x(td2,td1) ! dudy - call transpose_y_to_x(te2,te1) ! dvdy + call dery (tc2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) ! dudy !x is 1 + call dery (td2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) ! dvdy !y is 2 + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) ! dw/dy!z is 3 - if (i2dsim==0) then - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) ! dwdx - call transpose_y_to_z(ux2, ux3) - call transpose_y_to_z(uy2, uy3) + call transpose_y_to_z(ux2,ux3) + call transpose_y_to_z(uy2,uy3) + call transpose_y_to_z(uz2,uz3) - call transpose_x_to_y(uz1, uz2) - call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) ! dwdy - call transpose_y_to_x(tf2,tf1) ! dwdy + call derz (tg3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) ! du/dz + call derz (th3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) ! dv/dz + call derz (ti3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) ! dw/dz - call derz (tg3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) !dudz - call derz (th3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) !dvdz - call transpose_z_to_y(tg3,tg2) - call transpose_y_to_x(tg2,tg1) - call transpose_z_to_y(th3,th2) - call transpose_y_to_x(th2,th1) - endif + call transpose_z_to_y(tg3,tg2) ! du/dz + call transpose_z_to_y(th3,th2) ! dv/dz + call transpose_z_to_y(ti3,ti2) ! + call transpose_y_to_x(tc2,tc1) ! dudy + call transpose_y_to_x(td2,td1) ! dvdy + call transpose_y_to_x(th2,th1) ! dv/dz + call transpose_y_to_x(tf2,tf1) ! dw/dy + call transpose_y_to_x(tg2,tg1) ! + call transpose_y_to_x(ti2,ti1) ! !***************************************************************** ! Drag and Lift coefficients !***************************************************************** - if(i2dsim==1) then - do iv=1,nvol - - !***************************************************************** - ! Calculation of the momentum terms - !***************************************************************** - ! - ! Calculation of the momentum terms. First we integrate the - ! time rate of momentum along the CV. - ! - ! Excluding the body internal cells. If the centroid - ! of the cell falls inside the body the cell is - ! excluded. - - tunstx=zero - tunsty=zero - do k=1,xsize(3) - tsumx=zero - tsumy=zero - do j=jcvlw_lx(iv),jcvup_lx(iv) - do i=icvlf_lx(iv),icvrt_lx(iv) - ! The velocity time rate has to be relative to the cell center, - ! and not to the nodes, because, here, we have an integral - ! relative to the volume, and, therefore, this has a sense - ! of a "source". - ! fac = (1.5*ux1(i,j,k)-2.0*ux01(i,j,k)+0.5*ux11(i,j,k))*epcv1(i,j,k) - fac = (onepfive*ux1(i,j,k)-two*ux01(i,j,k)+half*ux11(i,j,k))*(one-ep1(i,j,k)) - tsumx = tsumx+fac*dx*del_y(j+(xstart(2)-1))/dt !tsumx+fac*dx*dy/dt - !sumx(k) = sumx(k)+dudt1*dx*dy - - ! fac = (1.5*uy1(i,j,k)-2.0*uy01(i,j,k)+0.5*uy11(i,j,k))*epcv1(i,j,k) - fac = (onepfive*uy1(i,j,k)-two*uy01(i,j,k)+half*uy11(i,j,k))*(one-ep1(i,j,k)) - tsumy = tsumy+fac*dx*del_y(j+(xstart(2)-1))/dt !tsumy+fac*dx*dy/dt - !sumy(k) = sumy(k)+dudt1*dx*dy - enddo - enddo - tunstx(xstart(3)-1+k)=tsumx - tunsty(xstart(3)-1+k)=tsumy - enddo - call MPI_ALLREDUCE(MPI_IN_PLACE,tunstx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tunsty,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE") - end if - - !!$!********************************************************************************* - !!$! Secondly, the surface momentum fluxes - !!$!********************************************************************************* - !!$ - !!$! (icvlf) (icvrt) - !!$!(jcvup) B____________C - !!$! \ \ - !!$! \ __ \ - !!$! \ \__\ \ - !!$! \ \ - !!$! \ CV \ - !!$!(jcvlw) A____________D - - tconvx=zero - tconvy=zero - tdiffx=zero - tdiffy=zero - tpresx=zero - tpresy=zero - !BC and AD : x-pencils - !AD - if ((jcvlw(iv).ge.xstart(2)).and.(jcvlw(iv).le.xend(2))) then - j=jcvlw(iv)-xstart(2)+1 - do k=1,xsize(3) - kk=xstart(3)-1+k - fcvx=zero - fcvy=zero - fpry=zero - fdix=zero - fdiy=zero - do i=icvlf_lx(iv),icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx = fcvx -uxmid*uymid*dx - fcvy = fcvy -uymid*uymid*dx - - !pressure - prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry +prmid*dx - - !viscous term - dudymid = half*(td1(i,j,k)+td1(i+1,j,k)) - dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) - dvdymid = half*(te1(i,j,k)+te1(i+1,j,k)) - fdix = fdix -(xnu*(dudymid+dvdxmid)*dx) - fdiy = fdiy -two*xnu*dvdymid*dx - - enddo - - tconvx(kk)=tconvx(kk)+fcvx - tconvy(kk)=tconvy(kk)+fcvy - tpresy(kk)=tpresy(kk)+fpry - tdiffx(kk)=tdiffx(kk)+fdix - tdiffy(kk)=tdiffy(kk)+fdiy - enddo - endif - !BC - if ((jcvup(iv).ge.xstart(2)).and.(jcvup(iv).le.xend(2))) then - j=jcvup(iv)-xstart(2)+1 - do k=1,xsize(3) - kk=xstart(3)-1+k - fcvx=zero - fcvy=zero - fpry=zero - fdix=zero - fdiy=zero - do i=icvlf_lx(iv),icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx= fcvx +uxmid*uymid*dx - fcvy= fcvy +uymid*uymid*dx - - !pressure - prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry -prmid*dx - - !viscous term - dudymid = half*(td1(i,j,k)+td1(i+1,j,k)) - dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) - dvdymid = half*(te1(i,j,k)+te1(i+1,j,k)) - fdix = fdix +(xnu*(dudymid+dvdxmid)*dx) - fdiy = fdiy +two*xnu*dvdymid*dx - - enddo - tconvx(kk)=tconvx(kk)+fcvx - tconvy(kk)=tconvy(kk)+fcvy - tpresy(kk)=tpresy(kk)+fpry - tdiffx(kk)=tdiffx(kk)+fdix - tdiffy(kk)=tdiffy(kk)+fdiy - enddo - endif - !AB and DC : y-pencils - !AB - if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then - i=icvlf(iv)-ystart(1)+1 - do k=1,ysize(3) - kk=ystart(3)-1+k - fcvx=zero - fcvy=zero - fprx=zero - fdix=zero - fdiy=zero - do j=jcvlw_ly(iv),jcvup_ly(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - fcvx= fcvx -uxmid*uxmid*del_y(j) - fcvy= fcvy -uxmid*uymid*del_y(j) - - !pressure - prmid=half*(tc2(i,j,k)+tc2(i,j+1,k)) - fprx = fprx +prmid*del_y(j) - - !viscous term - dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) - dudymid = half*(td2(i,j,k)+td2(i,j+1,k)) - dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) - fdix = fdix -two*xnu*dudxmid*del_y(j) - fdiy = fdiy -xnu*(dvdxmid+dudymid)*del_y(j) - enddo - tconvx(kk)=tconvx(kk)+fcvx - tconvy(kk)=tconvy(kk)+fcvy - tpresx(kk)=tpresx(kk)+fprx - tdiffx(kk)=tdiffx(kk)+fdix - tdiffy(kk)=tdiffy(kk)+fdiy - enddo - endif - !DC - if ((icvrt(iv).ge.ystart(1)).and.(icvrt(iv).le.yend(1))) then - i=icvrt(iv)-ystart(1)+1 - do k=1,ysize(3) - kk=ystart(3)-1+k - fcvx=zero - fcvy=zero - fprx=zero - fdix=zero - fdiy=zero - do j=jcvlw_ly(iv),jcvup_ly(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - fcvx= fcvx +uxmid*uxmid*del_y(j) - fcvy= fcvy +uxmid*uymid*del_y(j) - - !pressure - prmid=half*(tc2(i,j,k)+tc2(i,j+1,k)) - fprx = fprx -prmid*del_y(j) - - !viscous term - dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) - dudymid = half*(td2(i,j,k)+td2(i,j+1,k)) - dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) - fdix = fdix +two*xnu*dudxmid*del_y(j) - fdiy = fdiy +xnu*(dvdxmid+dudymid)*del_y(j) - enddo - tconvx(kk)=tconvx(kk)+fcvx - tconvy(kk)=tconvy(kk)+fcvy - tpresx(kk)=tpresx(kk)+fprx - tdiffx(kk)=tdiffx(kk)+fdix - tdiffy(kk)=tdiffy(kk)+fdiy - enddo - endif - call MPI_ALLREDUCE(MPI_IN_PLACE,tconvx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tconvy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tpresx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tpresy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tdiffx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE,tdiffy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - - do k=1,zsize(3) - - tpresx(k)=tpresx(k)/dt - tpresy(k)=tpresy(k)/dt - - xmom = tunstx(k)+tconvx(k) - ymom = tunsty(k)+tconvy(k) - xDrag(k) = two*(tdiffx(k)+tpresx(k)-xmom) - yLift(k) = two*(tdiffy(k)+tpresy(k)-ymom) - - enddo + do iv=1,nvol - !Edited by F. Schuch - xDrag_mean = sum(xDrag(:))/real(nz,mytype) - yLift_mean = sum(yLift(:))/real(nz,mytype) - - ! if ((itime==ifirst).or.(itime==0)) then - ! if (nrank .eq. 0) then - ! write(filename,"('aerof',I1.1)") iv - ! open(38+(iv-1),file=filename,status='unknown',form='formatted') - ! endif - ! endif - if (nrank .eq. 0) then - write(38,*) t,xDrag_mean,yLift_mean - flush(38) - endif - enddo - elseif(i2dsim==0) then - do iv=1, nvol - - !***************************************************************** - ! 3D Control Volume Method (Added by Gaurav Gupta, IIST India) - !***************************************************************** - ! - !The following code outputs drag and lift force computed for a 3D - !object like sphere and coefficients of drag and lift can be - !calculated by dividing the forces by (0.5*rho*v*v*A). - - - tsumx=zero - tsumy=zero - do k=kcvfr_lx(iv), kcvbk_lx(iv) - do j=jcvlw_lx(iv),jcvup_lx(iv) - do i=icvlf_lx(iv),icvrt_lx(iv) - ! The velocity time rate has to be relative to the cell center, - ! and not to the nodes, because, here, we have an integral - ! relative to the volume, and, therefore, this has a sense - ! of a "source". - ! fac = (1.5*ux1(i,j,k)-2.0*ux01(i,j,k)+0.5*ux11(i,j,k))*epcv1(i,j,k) - fac = (onepfive*ux1(i,j,k)-two*ux01(i,j,k)+half*ux11(i,j,k))*(one-ep1(i,j,k)) - tsumx = tsumx+fac*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy*dz/dt - !sumx(k) = sumx(k)+dudt1*dx*dy - - ! fac = (1.5*uy1(i,j,k)-2.0*uy01(i,j,k)+0.5*uy11(i,j,k))*epcv1(i,j,k) - fac = (onepfive*uy1(i,j,k)-two*uy01(i,j,k)+half*uy11(i,j,k))*(one-ep1(i,j,k)) - tsumy = tsumy+fac*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy*dz/dt - !sumy(k) = sumy(k)+dudt1*dx*dy - enddo - enddo - enddo - - call MPI_ALLREDUCE(tsumx,xmom,1,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(tsumy,ymom,1,real_type,MPI_SUM,MPI_COMM_WORLD,code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - - convx=zero - convy=zero - pressx=zero - pressy=zero - stressx=zero - stressy=zero - - !y-pencil - !calculating the flux through inlet wall (x-direction) - if((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then - i=icvlf(iv)-ystart(1)+1 - fcvx=zero - fcvy=zero - fprx=zero - fdix=zero - fdiy=zero - do k=kcvfr_ly(iv),kcvbk_ly(iv) - do j=jcvlw_ly(iv),jcvup_ly(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux2(i,j,k) + ux2(i,j+1,k)) - uymid = half*(uy2(i,j,k) + uy2(i,j+1,k)) - fcvx = fcvx + uxmid*uxmid*del_y(j)*dz - fcvy = fcvy + uxmid*uymid*del_y(j)*dz - - !pressure - prmid=half*(tc2(i,j,k)+tc2(i,j+1,k)) - fprx = fprx -prmid*del_y(j)*dz - - !viscous term - dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) - dudymid = half*(td2(i,j,k)+td2(i,j+1,k)) - dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) - fdix = fdix + two*xnu*dudxmid*del_y(j)*dz - fdiy = fdiy + xnu*(dvdxmid+dudymid)*del_y(j)*dz - enddo - enddo - convx = convx + fcvx - pressx = pressx + fprx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - endif - - !calculating the flux through outlet wall (x-direction) - if((icvrt(iv).ge.ystart(1)).and.(icvrt(iv).le.yend(1))) then - i=icvrt(iv)-ystart(1)+1 - fcvx=zero - fcvy=zero - fprx=zero - fdix=zero - fdiy=zero - do k=kcvfr_ly(iv),kcvbk_ly(iv) - do j=jcvlw_ly(iv),jcvup_ly(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux2(i,j,k) + ux2(i,j+1,k)) - uymid = half*(uy2(i,j,k) + uy2(i,j+1,k)) - fcvx = fcvx - uxmid*uxmid*del_y(j)*dz - fcvy = fcvy - uxmid*uymid*del_y(j)*dz - - !pressure - prmid=half*(tc2(i,j,k)+tc2(i,j+1,k)) - fprx = fprx + prmid*del_y(j)*dz - - !viscous term - dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) - dudymid = half*(td2(i,j,k)+td2(i,j+1,k)) - dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) - fdix = fdix - two*xnu*dudxmid*del_y(j)*dz - fdiy = fdiy -xnu*(dvdxmid+dudymid)*del_y(j)*dz - enddo + !***************************************************************** + ! Calculation of the momentum terms + !***************************************************************** + ! + ! Calculation of the momentum terms. First we integrate the + ! time rate of momentum along the CV. + ! + ! Excluding the body internal cells. If the centroid + ! of the cell falls inside the body the cell is + ! excluded. + + tunstxl=zero + tunstyl=zero + tunstzl=zero + do k=zcvlf_lx(iv),zcvrt_lx(iv) + tsumx=zero + tsumy=zero + tsumz=zero + zm=real(xstart(3)+k-1,mytype)*dz + do j=jcvlw_lx(iv),jcvup_lx(iv) + ym=real(xstart(2)+j-1,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv) + xm=real(xstart(1)+i-1,mytype)*dx + + fac1 = (onepfive*ux1(i,j,k)-two*ux01(i,j,k)+half*ux11(i,j,k))*(one-ep1(i,j,k)) + fac2 = (onepfive*uy1(i,j,k)-two*uy01(i,j,k)+half*uy11(i,j,k))*(one-ep1(i,j,k)) + fac3 = (onepfive*uz1(i,j,k)-two*uz01(i,j,k)+half*uz11(i,j,k))*(one-ep1(i,j,k)) + + call coriolis_force(angularVelocity(iv,2:4),[fac1,fac2,fac3],coriolis) + call centrifugal_force(angularVelocity(iv,2:4), [xm,ym,zm]-position(iv,:),centrifugal) + ! The velocity time rate has to be relative to the cell center, + ! and not to the nodes, because, here, we have an integral + ! relative to the volume, and, therefore, this has a sense + ! of a "source". + ! fac = (1.5*ux1(i,j,k)-2.0*ux01(i,j,k)+0.5*ux11(i,j,k))*epcv1(i,j,k) + ! tsumx = tsumx+(fac1-coriolis(1)-centrifugal(1))*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy/dt + tsumx = tsumx+fac1*dx*del_y(min(ny-1,j+xstart(2)-1))*dz/dt + !sumx(k) = sumx(k)+dudt1*dx*dy + + ! fac = (1.5*uy1(i,j,k)-2.0*uy01(i,j,k)+0.5*uy11(i,j,k))*epcv1(i,j,k) + ! tsumy = tsumy+(fac2-coriolis(2)-centrifugal(2))*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt + tsumy = tsumy+fac2*dx*del_y(min(ny-1,j+xstart(2)-1))*dz/dt + !sumy(k) = sumy(k)+dudt1*dx*dy + + ! tsumz = tsumz+(fac3-coriolis(3)-centrifugal(3))*dx*del_y(j+(xstart(2)-1))*dz/dt + tsumz = tsumz+fac3*dx*del_y(min(ny-1,j+xstart(2)-1))*dz/dt enddo - convx = convx + fcvx - pressx = pressx + fprx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - endif - - !x-pencil - !calculating the flux through top wall (y-direction) - if ((jcvup(iv).ge.xstart(2)).and.(jcvup(iv).le.xend(2))) then - j=jcvup(iv)-xstart(2)+1 + enddo + tunstxl(xstart(3)-1+k)=tsumx + tunstyl(xstart(3)-1+k)=tsumy + tunstzl(xstart(3)-1+k)=tsumz + enddo + call MPI_ALLREDUCE(tunstxl,tunstx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstyl,tunsty,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstzl,tunstz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + +!!$!********************************************************************************* +!!$! Secondly, the surface momentum fluxes +!!$!********************************************************************************* +!!$ +!!$! (icvlf) (icvrt) +!!$!(jcvup) B____________C +!!$! \ \ +!!$! \ __ \ +!!$! \ \__\ \ +!!$! \ \ +!!$! \ CV \ +!!$!(jcvlw) A____________D + + drag1(:)=0. + drag2(:)=0. + drag3(:)=0. + drag4(:)=0. + + drag11(:)=0. + drag22(:)=0. + drag33(:)=0. + drag44(:)=0. + + tconvxl=zero + tconvyl=zero + tconvzl=zero + tdiffxl=zero + tdiffyl=zero + tdiffzl=zero + tpresxl=zero + tpresyl=zero + tpreszl=zero + + tconvxl2=zero + tconvyl2=zero + tconvzl2=zero + tdiffxl2=zero + tdiffyl2=zero + tdiffzl2=zero + !BC and AD : x-pencils + !AD + if ((jcvlw(iv).ge.xstart(2)).and.(jcvlw(iv).le.xend(2))) then + j=jcvlw(iv)-xstart(2)+1 + jj=jcvlw(iv) + ym=real(jj,mytype)*dy + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero + fcvz=zero fpry=zero fdix=zero fdiy=zero - do k=kcvfr_lx(iv),kcvbk_lx(iv) - do i=icvlf_lx(iv),icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx= fcvx -uxmid*uymid*dx*dz - fcvy= fcvy -uymid*uymid*dx*dz - - !pressure - prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry +prmid*dx*dz - - !viscous term - dudymid = half*(td1(i,j,k)+td1(i+1,j,k)) - dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) - dvdymid = half*(te1(i,j,k)+te1(i+1,j,k)) - fdix = fdix -(xnu*(dudymid+dvdxmid)*dx*dz) - fdiy = fdiy -two*xnu*dvdymid*dx*dz - - enddo + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'Calculating force at upper y boundary', [xm,ym,zm] + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx -uxmid*uymid*dx*dz + fcvy = fcvy -uymid*uymid*dx*dz + fcvz = fcvz -uymid*uzmid*dx*dz + + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fpry = fpry +prmid*dx*dz + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix -(xnu*(dudymid+dvdxmid)*dx*dz) + fdiy = fdiy -two*xnu*dvdymid*dx*dz + fdiz = fdiz -(xnu*(dwdymid+dvdzmid)*dx*dz) + + enddo - convx = convx + fcvx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - pressy = pressy + fpry - endif - - !calculating the flux through bottom wall (y-direction) - if ((jcvlw(iv).ge.xstart(2)).and.(jcvlw(iv).le.xend(2))) then - j=jcvlw(iv)-xstart(2)+1 + + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + tpresyl(kk)=tpresyl(kk)+fpry + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + enddo + endif + !BC + if ((jcvup(iv).ge.xstart(2)).and.(jcvup(iv).le.xend(2))) then + j=jcvup(iv)-xstart(2)+1 + jj=jcvup(iv) + ym=real(jj,mytype)*dy + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero + fcvz=zero fpry=zero fdix=zero fdiy=zero - do k=kcvfr_lx(iv),kcvbk_lx(iv) - do i=icvlf_lx(iv),icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx= fcvx +uxmid*uymid*dx*dz - fcvy= fcvy +uymid*uymid*dx*dz - - !pressure - prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry -prmid*dx*dz - - !viscous term - dudymid = half*(td1(i,j,k)+td1(i+1,j,k)) - dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) - dvdymid = half*(te1(i,j,k)+te1(i+1,j,k)) - fdix = fdix +(xnu*(dudymid+dvdxmid)*dx*dz) - fdiy = fdiy +two*xnu*dvdymid*dx*dz - enddo + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'xm = ', xm + ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx +uxmid*uymid*dx*dz + fcvy = fcvy +uymid*uymid*dx*dz + fcvz = fcvz +uymid*uzmid*dx*dz + + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fpry = fpry -prmid*dx*dz + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix + (xnu*(dudymid+dvdxmid)*dx*dz) + fdiy = fdiy + two*xnu*dvdymid*dx*dz + fdiz = fdiz + (xnu*(dwdymid+dvdzmid)*dx*dz) + enddo - convx = convx + fcvx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - pressy = pressy + fpry - endif - - !calculating the flux through the front wall (z-direction) - if((kcvfr(iv).ge.xstart(3).and.(kcvfr(iv).le.xend(3)))) then - k = kcvfr(iv)-xstart(3)+1 + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + + tpresyl(kk)=tpresyl(kk)+fpry + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + + enddo + endif + !AB and DC : y-pencils + !AB + if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then + i=icvlf(iv)-ystart(1)+1 + ii=icvlf(iv)-1 + xm=real(ii,mytype)*dx + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)+k-1 + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero - fpry=zero + fcvz=zero + fprx=zero fdix=zero fdiy=zero - do j=jcvlw_lx(iv), jcvup_lx(iv) - do i=icvlf_lx(iv), icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - uzmid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx= fcvx + uxmid*uzmid*dx*del_y(j) - fcvy= fcvy + uymid*uzmid*dx*del_y(j) - - !viscous flux - dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) - dwdxmid = half*(tc1(i,j,k)+tc1(i+1,j,k)) - dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) - dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) - fdix = fdix + (xnu*(dudzmid+dwdxmid)*dx*del_y(j)) - fdiy = fdiy + (xnu*(dvdzmid+dwdymid)*dx*del_y(j)) - enddo - enddo - convx = convx + fcvx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - endif - - !calculating the flux through the front wall (z-direction) - if((kcvbk(iv).ge.xstart(3).and.(kcvbk(iv).le.xend(3)))) then - k = kcvbk(iv)-xstart(3)+1 + fdiz=zero + do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dz + ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + + fcvx = fcvx -uxmid*uxmid*del_y(j)*dz + fcvy = fcvy -uxmid*uymid*del_y(j)*dz + fcvz = fcvz -uxmid*uzmid*del_y(j)*dz + + + !pressure + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + fprx = fprx +prmid*del_y(j)*dz + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix -two*xnu*dudxmid*del_y(j)*dz + fdiy = fdiy -xnu*(dvdxmid+dudymid)*del_y(j)*dz + fdiz = fdiz -xnu*(dwdxmid+dudzmid)*del_y(j)*dz + enddo + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + + tpresxl(kk)=tpresxl(kk)+fprx + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + + enddo + endif + !DC + if ((icvrt(iv).ge.ystart(1)).and.(icvrt(iv).le.yend(1))) then + i=icvrt(iv)-ystart(1)+1 + ii=icvrt(iv) + xm=real(ii,mytype)*dx + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero - fpry=zero + fcvz=zero + fprx=zero fdix=zero fdiy=zero - do j=jcvlw_lx(iv), jcvup_lx(iv) - do i=icvlf_lx(iv), icvrt_lx(iv)-1 - !momentum flux - !FIXME avoid interpolation for the non-linear term - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - uzmid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - fcvx= fcvx - uxmid*uzmid*dx*del_y(j) - fcvy= fcvy - uymid*uzmid*dx*del_y(j) - - !viscous flux - dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) - dwdxmid = half*(tc1(i,j,k)+tc1(i+1,j,k)) - dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) - dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) - fdix = fdix - (xnu*(dudzmid+dwdxmid)*dx*del_y(j)) - fdiy = fdiy - (xnu*(dvdzmid+dwdymid)*dx*del_y(j)) - enddo - enddo - convx = convx + fcvx - stressx = stressx + fdix - convy = convy + fcvy - stressy = stressy + fdiy - endif - - call MPI_ALLREDUCE(MPI_IN_PLACE, convx, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE, convy, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE, pressx, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE, pressy, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE, stressx, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - call MPI_ALLREDUCE(MPI_IN_PLACE, stressy, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) - if (code /= 0) then - call decomp_2d_abort(__FILE__, __LINE__, code, "MPI_ALLREDUCE!") - end if - - pressx = pressx/dt - pressy = pressy/dt - - xDrag_mean = xmom + convx - pressx -stressx - yLift_mean = ymom + convy - pressy -stressy - - if (nrank .eq. 0) then - write(38,*) t,xDrag_mean,yLift_mean - flush(38) - endif - enddo - endif - - if (mod(itime, icheckpoint).eq.0) then - if (nrank .eq. 0) then - write(filename, '(A,I7.7,A)') 'forces', itime, '.dat' - call execute_command_line("cp forces.dat " //filename) - endif - endif + fdiz=zero + do j=jcvlw_ly(iv),jcvup_ly(iv)-1 !!!What's going on here? + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dy + ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + + fcvx = fcvx + uxmid*uxmid*del_y(j)*dz + fcvy = fcvy + uxmid*uymid*del_y(j)*dz + fcvz = fcvz + uxmid*uzmid*del_y(j)*dz + + + !pressure + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + fprx = fprx -prmid*del_y(j)*dz + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix + two*xnu*dudxmid*del_y(j)*dz + fdiy = fdiy + xnu*(dvdxmid+dudymid)*del_y(j)*dz + fdiz = fdiz + xnu*(dwdxmid+dudzmid)*del_y(j)*dz + + enddo + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + + tpresxl(kk)=tpresxl(kk)+fprx + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz - do k = 1, xsize(3) - do j = 1, xsize(2) - do i = 1, xsize(1) - ux11(i,j,k)=ux01(i,j,k) - uy11(i,j,k)=uy01(i,j,k) - ux01(i,j,k)=ux1(i,j,k) - uy01(i,j,k)=uy1(i,j,k) enddo + endif + + !Left & Right : + !Left + if ((zcvlf(iv).ge.xstart(3)).and.(zcvlf(iv).le.xend(3))) then + k=zcvlf(iv)-xstart(3)+1 + kk=zcvlf(iv) + zm=real(kk,mytype)*dz + + fcvx=zero + fcvy=zero + fcvz=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=jcvlw_lx(iv),jcvup_lx(iv) + kk = xstart(2)-1+j + jj = xstart(2)-1+j + + ym=real(jj,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx= fcvx +uxmid*uzmid*dx*dy + fcvy= fcvy +uymid*uzmid*dx*dy + fcvz= fcvz +uzmid*uzmid*dx*dy + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fprz = fprz -prmid*dx*dy + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix +(xnu*(dudzmid+dwdxmid)*dx*dy) + fdiy = fdiy +(xnu*(dvdzmid+dwdymid)*dx*dy) + fdiz = fdiz +two*xnu*dwdzmid*dx*dy + enddo + enddo + !print*, kk + ! drag3(kk)=drag3(kk)+fcvx ! Should be size ny + ! print*, drag3(kk) + tconvxl2(kk)=tconvxl2(kk)+fcvx + tconvyl2(kk)=tconvyl2(kk)+fcvy + tconvzl2(kk)=tconvzl2(kk)+fcvz + tpreszl(kk) =tpreszl(kk) +fprz + tdiffxl2(kk)=tdiffxl2(kk)+fdix + tdiffyl2(kk)=tdiffyl2(kk)+fdiy + tdiffzl2(kk)=tdiffzl2(kk)+fdiz + endif + !Right + if ((zcvrt(iv).ge.xstart(3)).and.(zcvrt(iv).le.xend(3))) then + k=zcvrt(iv)-xstart(3)+1 + kk=zcvrt(iv) + zm=real(kk,mytype)*dz + ! kk=nrank+1 + + fcvx=zero + fcvy=zero + fcvz=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + ! do k=1,xsize(3) + do j=jcvlw_lx(iv),jcvup_lx(iv) + ! kk = xstart(2)-1+j + jj = xstart(2)-1+j + ym=real(jj,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] + + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx= fcvx -uxmid*uzmid*dx*dy + fcvy= fcvy -uymid*uzmid*dx*dy + fcvz= fcvz -uzmid*uzmid*dx*dy + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fprz = fprz +prmid*dx*dy + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix -(xnu*(dudzmid+dwdxmid)*dx*dy) + fdiy = fdiy -(xnu*(dvdzmid+dwdymid)*dx*dy) + fdiz = fdiz -two*xnu*dwdzmid*dx*dy + + enddo + enddo + ! drag4(kk)=drag4(kk)+fcvx ! Should be size ny + tconvxl2(kk)=tconvxl2(kk)+fcvx + tconvyl2(kk)=tconvyl2(kk)+fcvy + tconvzl2(kk)=tconvzl2(kk)+fcvz + tpreszl(kk) =tpreszl(kk) +fprz + tdiffxl2(kk)=tdiffxl2(kk)+fdix + tdiffyl2(kk)=tdiffyl2(kk)+fdiy + tdiffzl2(kk)=tdiffzl2(kk)+fdiz + endif + + call MPI_ALLREDUCE(tconvxl,tconvx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl,tconvy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl,tconvz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + call MPI_ALLREDUCE(tpresxl,tpresx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpresyl,tpresy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl,tdiffx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl,tdiffy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl,tdiffz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + call MPI_ALLREDUCE(tconvxl2,tconvx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl2,tconvy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl2,tconvz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpreszl, tpresz ,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl2,tdiffx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl2,tdiffy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl2,tdiffz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + + tp1 = sum(tpresx(:))/dt + tp2 = sum(tpresy(:))/dt + tp3 = sum(tpresz(:))/dt + + mom1 = sum(tunstx(:)) + sum(tconvx(:)) - sum(tconvx2(:)) + mom2 = sum(tunsty(:)) + sum(tconvy(:)) - sum(tconvy2(:)) + mom3 = sum(tunstz(:)) + sum(tconvz(:)) - sum(tconvz2(:)) + + dra1(iv) = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2(iv) = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3(iv) = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + + do k=1,zsize(3) + + tpresx(k)=tpresx(k)/dt + tpresy(k)=tpresy(k)/dt + tpresz(k)=tpresz(k)/dt + + + xmom = tunstx(k)+tconvx(k)+tconvx2(k) + ymom = tunsty(k)+tconvy(k)+tconvy2(k) + zmom = tunstz(k)+tconvz(k)+tconvz2(k) + xDrag(k) = (tdiffx(k)+tdiffx2(k)+tpresx(k)-xmom) + yLift(k) = (tdiffy(k)+tdiffy2(k)+tpresy(k)-ymom) + zLat(k) = (tdiffz(k)+tdiffz2(k)+tpresz(k)-zmom) + enddo + + !Edited by F. Schuch + xDrag_mean = sum(xDrag(:))/real(nz,mytype) + yLift_mean = sum(yLift(:))/real(nz,mytype) + + ! xDrag_tot = sum(xDrag(:)) + ! yLift_tot = sum(yLift(:)) + ! zLat_tot = sum(zLat(:)) + + if ((itime==ifirst).or.(itime==0)) then + + endif + if ((nrank .eq. 0).and.(record_var.eq.1).and.(mod(itime,ilist)==0)) then + ! write(*,*) 'TIME STEP = ', itime + write(38+(iv-1),*) t,dra1,dra2,dra3, sum(tdiffx), sum(tdiffx2), tp1, -mom1, -sum(tunstx(:)), -sum(tconvx(:)), -sum(tconvx2(:)) + ! write(*,*) 'written to file number', 38+(iv-1), t, dra1,dra2,dra3 + call flush(38+(iv-1)) + + ! write(12 ,*) t, position(1), position(2), position(3), orientation(1), orientation(2), orientation(3), orientation(4), linearVelocity(1), linearVelocity(2), linearVelocity(3), angularVelocity(1), angularVelocity(2), angularVelocity(3), linearAcceleration(1), linearAcceleration(2), linearAcceleration(3) + endif + ! if (mod(itime, ioutput).eq.0) then + ! if (nrank .eq. 0) then + ! write(filename,"('forces.dat',I7.7)") itime + ! call system("cp forces.dat " //filename) + ! endif + ! endif enddo + if (torques_flag.eq.0) then !only update velocity fields if torque calculation not called. + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux11(i,j,k)=ux01(i,j,k) + uy11(i,j,k)=uy01(i,j,k) + uz11(i,j,k)=uz01(i,j,k) + ux01(i,j,k)=ux1(i,j,k) + uy01(i,j,k)=uy1(i,j,k) + uz01(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + endif + return end subroutine force + + subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) + + USE param + USE variables + USE decomp_2d + USE MPI + USE ibm_param + USE ellipsoid_utils, only : CrossProduct,centrifugal_force,coriolis_force + + use var, only : ta1, tb1, tc1, td1, te1, tf1, tg1, th1, ti1, di1 + use var, only : ux2, uy2, uz2, ta2, tb2, tc2, td2, te2, tf2, tg2, th2, ti2, di2 + use var, only : ux3, uy3, uz3, ta3, tb3, tc3, td3, te3, tf3, tg3, th3, ti3, di3 + + + implicit none + character(len=30) :: filename, filename2 + integer :: nzmsize + integer :: i, iv, j, k, kk, code, jj, ii + integer :: nvect1,nvect2,nvect3 + + real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ux1, uy1, uz1 + real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ep1 + integer, intent(in) ::record_var + real(mytype), intent(out) :: dra1(10),dra2(10),dra3(10) + + real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 + real(mytype), dimension(zsize(1),zsize(2),zsize(3)) :: ppi3 + + real(mytype), dimension(nz) :: yLift,xDrag, zLat + real(mytype) :: yLift_mean,xDrag_mean,zLat_mean + real(mytype) :: xm,ym,zm,rotationalComponent(3) + + real(mytype), dimension(ny-1) :: del_y + + real(mytype), dimension(nz) :: tunstxl, tunstyl, tunstzl + real(mytype), dimension(nz) :: tconvxl,tconvyl,tconvzl + real(mytype), dimension(nz) :: tpresxl,tpresyl + real(mytype), dimension(nz) :: tdiffxl,tdiffyl,tdiffzl + + real(mytype), dimension(nz) :: tunstx, tunsty, tunstz + real(mytype), dimension(nz) :: tconvx,tconvy,tconvz + real(mytype), dimension(nz) :: tpresx,tpresy + real(mytype), dimension(nz) :: tdiffx,tdiffy,tdiffz + + + + real(mytype), dimension(ny) :: tconvxl2, tconvyl2, tconvzl2 + real(mytype), dimension(ny) :: tdiffxl2, tdiffyl2, tdiffzl2 + real(mytype), dimension(ny) :: tconvx2, tconvy2, tconvz2 + real(mytype), dimension(ny) :: tdiffx2, tdiffy2, tdiffz2 + real(mytype), dimension(ny) :: tpreszl, tpresz + + + real(mytype) :: uxmid,uymid,uzmid,prmid + real(mytype) :: dudxmid,dudymid,dudzmid,dvdxmid,dvdymid,dvdzmid + real(mytype) :: dwdxmid,dwdymid,dwdzmid + real(mytype) :: fac,fac1,fac2,fac3,tsumx,tsumy,tsumz,centrifugal(3),coriolis(3) + real(mytype) :: fcvx,fcvy,fcvz,fprx,fpry,fprz,fdix,fdiy,fdiz + real(mytype) :: xmom,ymom,zmom + real(mytype), dimension(ny) :: ztpresx, ztpresy + real(mytype), dimension(nz) :: zyLift, zxDrag, zzLat + real(mytype) :: zyLift_mean, zxDrag_mean, zzLat_mean + + + real(mytype), dimension(nz) :: drag1, drag2, drag11, drag22 + real(mytype), dimension(nz) :: drag3, drag4, drag33, drag44 + real(mytype) :: mom1, mom2, mom3, tp1, tp2, tp3 + real(mytype) :: radial(3),angular_velocity_result(3) + + ! write(*,*) 'Inside FORCE' + + dra1(:) = zero + dra2(:) = zero + dra3(:) = zero + + + nvect1=xsize(1)*xsize(2)*xsize(3) + nvect2=ysize(1)*ysize(2)*ysize(3) + nvect3=zsize(1)*zsize(2)*zsize(3) + + do jj = 1, ny-1 + if (istret.eq.0) then + del_y(jj)=dy + else + del_y(jj)=yp(jj+1)-yp(jj) + endif + enddo + + if (itime.eq.1) then + do iv=1,nvol + if ((nrank .eq. 0).and.(record_var.eq.1)) then + write(filename,"('torques.dat',I1.1)") iv + open(45+(iv-1),file=filename,status='unknown',form='formatted') + write(45+(iv-1),*) t, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero + call flush(45+(iv-1)) + ! write(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) + endif + if ((nrank.eq.0).and.(torq_debug.eq.1).and.(iv.eq.1)) then + open(100,file="backside.dat",status='unknown',form='formatted') + open(101,file="frontside.dat",status='unknown',form='formatted') + open(102,file="lowerside.dat",status='unknown',form='formatted') + open(103,file="upperside.dat",status='unknown',form='formatted') + open(104,file="leftside.dat",status='unknown',form='formatted') + open(105,file="rightside.dat",status='unknown',form='formatted') + open(106,file="ytorque_decomposition.dat",status='unknown',form='formatted') + open(107,file="ztorque_decomposition.dat",status='unknown',form='formatted') + endif + + enddo + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux11(i,j,k)=ux1(i,j,k) + uy11(i,j,k)=uy1(i,j,k) + uz11(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + return + elseif (itime.eq.2) then + ! if ((nrank .eq. 0).and.(record_var.eq.1)) then + ! do i = 1,nvol + ! ! write(*,*) "TRYING TO WRITE AT ITIME=2, t = ", t + ! write(45+(iv-1),*) t, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero + ! call flush(45+(iv-1)) + ! enddo + ! endif + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux01(i,j,k)=ux1(i,j,k) + uy01(i,j,k)=uy1(i,j,k) + uz01(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + return + endif + + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) ! dudx !x is 1 + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) ! dvdx !y is 2 + call derx (te1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) ! dw/dx!z is 3 + + call transpose_x_to_y(ta1,ta2) ! dudx + call transpose_x_to_y(tb1,tb2) ! dvdx + call transpose_x_to_y(te1,te2) ! dw/dx + + call transpose_x_to_y(ux1,ux2) + call transpose_x_to_y(uy1,uy2) + call transpose_x_to_y(uz1,uz2) + call transpose_x_to_y(ppi1,ppi2) + + call dery (tc2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) ! dudy !x is 1 + call dery (td2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) ! dvdy !y is 2 + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) ! dw/dy!z is 3 + + + call transpose_y_to_z(ux2,ux3) + call transpose_y_to_z(uy2,uy3) + call transpose_y_to_z(uz2,uz3) + + call derz (tg3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) ! du/dz + call derz (th3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) ! dv/dz + call derz (ti3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) ! dw/dz + + call transpose_z_to_y(tg3,tg2) ! du/dz + call transpose_z_to_y(th3,th2) ! dv/dz + call transpose_z_to_y(ti3,ti2) ! + + call transpose_y_to_x(tc2,tc1) ! dudy + call transpose_y_to_x(td2,td1) ! dvdy + call transpose_y_to_x(th2,th1) ! dv/dz + call transpose_y_to_x(tf2,tf1) ! dw/dy + call transpose_y_to_x(tg2,tg1) ! + call transpose_y_to_x(ti2,ti1) ! + !***************************************************************** + ! Drag and Lift coefficients + !***************************************************************** + do iv=1,nvol + + !***************************************************************** + ! Calculation of the momentum terms + !***************************************************************** + ! + ! Calculation of the momentum terms. First we integrate the + ! time rate of momentum along the CV. + ! + ! Excluding the body internal cells. If the centroid + ! of the cell falls inside the body the cell is + ! excluded. + + tunstxl=zero + tunstyl=zero + tunstzl=zero + do k=zcvlf_lx(iv),zcvrt_lx(iv) + tsumx=zero + tsumy=zero + tsumz=zero + zm=real(xstart(3)+k-1,mytype)*dz + do j=jcvlw_lx(iv),jcvup_lx(iv) + ym=real(xstart(2)+j-1,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv) + xm=real(xstart(1)+i-1,mytype)*dx + + fac1 = (onepfive*ux1(i,j,k)-two*ux01(i,j,k)+half*ux11(i,j,k))*(one-ep1(i,j,k)) + fac2 = (onepfive*uy1(i,j,k)-two*uy01(i,j,k)+half*uy11(i,j,k))*(one-ep1(i,j,k)) + fac3 = (onepfive*uz1(i,j,k)-two*uz01(i,j,k)+half*uz11(i,j,k))*(one-ep1(i,j,k)) + + ! call coriolis_force(angularVelocity,[fac1,fac2,fac3],coriolis) + ! call centrifugal_force(angularVelocity, [xm,ym,zm]-position,centrifugal) + ! The velocity time rate has to be relative to the cell center, + ! and not to the nodes, because, here, we have an integral + ! relative to the volume, and, therefore, this has a sense + ! of a "source". + ! fac = (1.5*ux1(i,j,k)-2.0*ux01(i,j,k)+0.5*ux11(i,j,k))*epcv1(i,j,k) + call crossProduct(([fac1,fac2,fac3]),[xm,ym,zm]-position(iv,:), angular_velocity_result) + tsumx = tsumx+angular_velocity_result(1)*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy/dt + ! tsumx = tsumx+fac1*dx*del_y(j+xstart(2)-1)*dz/dt + !sumx(k) = sumx(k)+dudt1*dx*dy + + ! fac = (1.5*uy1(i,j,k)-2.0*uy01(i,j,k)+0.5*uy11(i,j,k))*epcv1(i,j,k) + tsumy = tsumy+angular_velocity_result(2)*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt + ! tsumy = tsumy+fac2*dx*del_y(j+xstart(2)-1)*dz/dt + !sumy(k) = sumy(k)+dudt1*dx*dy + + tsumz = tsumz+angular_velocity_result(3)*dx*del_y(j+(xstart(2)-1))*dz/dt + ! tsumz = tsumz+fac3*dx*del_y(j+xstart(2)-1)*dz/dt + enddo + enddo + tunstxl(xstart(3)-1+k)=tsumx + tunstyl(xstart(3)-1+k)=tsumy + tunstzl(xstart(3)-1+k)=tsumz + enddo + call MPI_ALLREDUCE(tunstxl,tunstx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstyl,tunsty,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstzl,tunstz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + +!!$!********************************************************************************* +!!$! Secondly, the surface momentum fluxes +!!$!********************************************************************************* +!!$ +!!$! (icvlf) (icvrt) +!!$!(jcvup) B____________C +!!$! \ \ +!!$! \ __ \ +!!$! \ \__\ \ +!!$! \ \ +!!$! \ CV \ +!!$!(jcvlw) A____________D + + drag1(:)=0. + drag2(:)=0. + drag3(:)=0. + drag4(:)=0. + + drag11(:)=0. + drag22(:)=0. + drag33(:)=0. + drag44(:)=0. + + tconvxl=zero + tconvyl=zero + tconvzl=zero + tdiffxl=zero + tdiffyl=zero + tdiffzl=zero + tpresxl=zero + tpresyl=zero + tpreszl=zero + + tconvxl2=zero + tconvyl2=zero + tconvzl2=zero + tdiffxl2=zero + tdiffyl2=zero + tdiffzl2=zero + !BC and AD : x-pencils + !AD + if ((jcvlw(iv).ge.xstart(2)).and.(jcvlw(iv).le.xend(2))) then + j=jcvlw(iv)-xstart(2)+1 + jj=jcvlw(iv) + ym=real(jj,mytype)*dy + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + zm=real(kk,mytype)*dz + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'Calculating force at upper y boundary', [xm,ym,zm] + radial = [xm,ym,zm]-position(iv,:) + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx -(uymid*radial(3)-uzmid*radial(2))*uymid*dx*dz + fcvy = fcvy -(uzmid*radial(1)-uxmid*radial(3))*uymid*dx*dz + fcvz = fcvz -(uxmid*radial(2)-uymid*radial(1))*uymid*dx*dz + + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + ! fpry = fpry +prmid*dx*dz*(radial(1)-radial(3)) + fprz = fprz +prmid*dx*dz*(radial(1)) + fprx = fprx +prmid*dx*dz*(-radial(3)) + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix - (xnu*(two*dvdymid)*radial(3)-xnu*(dwdymid+dvdzmid)*radial(2))*dx*dz + fdiy = fdiy - (xnu*(dwdymid+dvdzmid)*radial(1)-xnu*(dudymid+dvdxmid)*radial(3))*dx*dz + fdiz = fdiz - (xnu*(dudymid+dvdxmid)*radial(2)-xnu*(two*dvdymid)*radial(1))*dx*dz + + ! fdix = fdix -(xnu*(dudymid+dvdxmid)*dx*dz) + ! fdiy = fdiy -two*xnu*dvdymid*dx*dz + ! fdiz = fdiz -(xnu*(dwdymid+dvdzmid)*dx*dz) + + + enddo + + tconvxl(1)=tconvxl(1)+fcvx + tconvyl(1)=tconvyl(1)+fcvy + tconvzl(1)=tconvzl(1)+fcvz + + tpresxl(1)=tpresxl(1)+fprx + ! tpresyl(1)=tpresyl(1)+fpry + tpreszl(1)=tpreszl(1)+fprz + + tdiffxl(1)=tdiffxl(1)+fdix + tdiffyl(1)=tdiffyl(1)+fdiy + tdiffzl(1)=tdiffzl(1)+fdiz + enddo + + endif + !BC + if ((jcvup(iv).ge.xstart(2)).and.(jcvup(iv).le.xend(2))) then + j=jcvup(iv)-xstart(2)+1 + jj=jcvup(iv) + ym=real(jj,mytype)*dy + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + zm=real(kk,mytype)*dz + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'xm = ', xm + ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + radial = [xm,ym,zm]-position(iv,:) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx +(uymid*radial(3)-uzmid*radial(2))*uymid*dx*dz + fcvy = fcvy +(uzmid*radial(1)-uxmid*radial(3))*uymid*dx*dz + fcvz = fcvz +(uxmid*radial(2)-uymid*radial(1))*uymid*dx*dz + + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + ! fpry = fpry -prmid*dx*dz*(radial(1)-radial(3)) + fprz = fprz -prmid*dx*dz*(radial(1)) + fprx = fprx -prmid*dx*dz*(-radial(3)) + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix + (xnu*(two*dvdymid)*radial(3)-xnu*(dwdymid+dvdzmid)*radial(2))*dx*dz + fdiy = fdiy + (xnu*(dwdymid+dvdzmid)*radial(1)-xnu*(dudymid+dvdxmid)*radial(3))*dx*dz + fdiz = fdiz + (xnu*(dudymid+dvdxmid)*radial(2)-xnu*(two*dvdymid)*radial(1))*dx*dz + + ! fdix = fdix + (xnu*(dudymid+dvdxmid)*dx*dz) + ! fdiy = fdiy + (xnu*(two*dvdymid)*dx*dz) + ! fdiz = fdiz + (xnu*(dwdymid+dvdzmid)*dx*dz) + + enddo + tconvxl(2)=tconvxl(2)+fcvx + tconvyl(2)=tconvyl(2)+fcvy + tconvzl(2)=tconvzl(2)+fcvz + + tpresxl(2)=tpresxl(2)+fprx + ! tpresyl(2)=tpresyl(2)+fpry + tpreszl(2)=tpreszl(2)+fprz + + tdiffxl(2)=tdiffxl(2)+fdix + tdiffyl(2)=tdiffyl(2)+fdiy + tdiffzl(2)=tdiffzl(2)+fdiz + + enddo + endif + !AB and DC : y-pencils + !AB + if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then + i=icvlf(iv)-ystart(1)+1 + ii=icvlf(iv)-1 + xm=real(ii,mytype)*dx + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)+k-1 + zm=real(kk,mytype)*dz + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dz + ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] + !momentum flux + radial = [xm,ym,zm]-position(iv,:) + + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx -(uymid*radial(3)-uzmid*radial(2))*uxmid*del_y(j)*dz + fcvy = fcvy -(uzmid*radial(1)-uxmid*radial(3))*uxmid*del_y(j)*dz + fcvz = fcvz -(uxmid*radial(2)-uymid*radial(1))*uxmid*del_y(j)*dz + + + !pressure + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + ! fprx = fprx +prmid*del_y(j)*dz*(radial(3)-radial(2)) + + fpry = fpry + prmid*del_y(j)*dz*(radial(3)) + fprz = fprz + prmid*del_y(j)*dz*(-radial(2)) + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix - (xnu*(dvdxmid+dudymid)*radial(3)-xnu*(dwdxmid+dudzmid)*radial(2))*del_y(j)*dz + fdiy = fdiy - (xnu*(dwdxmid+dudzmid)*radial(1)-xnu*(two*dudxmid)*radial(3))*del_y(j)*dz + fdiz = fdiz - (xnu*(two*dudxmid)*radial(2)-xnu*(dvdxmid+dudymid)*radial(1))*del_y(j)*dz + + + ! fdix = fdix -two*xnu*dudxmid*del_y(j)*dz + ! fdiy = fdiy -xnu*(dvdxmid+dudymid)*del_y(j)*dz + ! fdiz = fdiz -xnu*(dwdxmid+dudzmid)*del_y(j)*dz + enddo + tconvxl(3)=tconvxl(3)+fcvx + tconvyl(3)=tconvyl(3)+fcvy + tconvzl(3)=tconvzl(3)+fcvz + + ! tpresxl(3)=tpresxl(3)+fprx + tpresyl(3)=tpresyl(3)+fpry + tpreszl(3)=tpreszl(3)+fprz + + tdiffxl(3)=tdiffxl(3)+fdix + tdiffyl(3)=tdiffyl(3)+fdiy + tdiffzl(3)=tdiffzl(3)+fdiz + + enddo + endif + !DC + if ((icvrt(iv).ge.ystart(1)).and.(icvrt(iv).le.yend(1))) then + i=icvrt(iv)-ystart(1)+1 + ii=icvrt(iv) + xm=real(ii,mytype)*dx + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)-1+k + zm=real(kk,mytype)*dz + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dy + ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] + + radial = [xm,ym,zm]-position(iv,:) + + !momentum flux + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + + fcvx = fcvx +(uymid*radial(3)-uzmid*radial(2))*uxmid*del_y(j)*dz + fcvy = fcvy +(uzmid*radial(1)-uxmid*radial(3))*uxmid*del_y(j)*dz + fcvz = fcvz +(uxmid*radial(2)-uymid*radial(1))*uxmid*del_y(j)*dz + + + + !pressure + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + ! fprx = fprx -prmid*del_y(j)*dz*(radial(3)-radial(2)) + + fpry = fpry - prmid*del_y(j)*dz*(radial(3)) + fprz = fprz - prmid*del_y(j)*dz*(-radial(2)) + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix + (xnu*(dvdxmid+dudymid)*radial(3)-xnu*(dwdxmid+dudzmid)*radial(2))*del_y(j)*dz + fdiy = fdiy + (xnu*(dwdxmid+dudzmid)*radial(1)-xnu*(two*dudxmid)*radial(3))*del_y(j)*dz + fdiz = fdiz + (xnu*(two*dudxmid)*radial(2)-xnu*(dvdxmid+dudymid)*radial(1))*del_y(j)*dz + + + ! fdix = fdix + two*xnu*dudxmid*del_y(j)*dz + ! fdiy = fdiy + xnu*(dvdxmid+dudymid)*del_y(j)*dz + ! fdiz = fdiz + xnu*(dwdxmid+dudzmid)*del_y(j)*dz + + enddo + tconvxl(4)=tconvxl(4)+fcvx + tconvyl(4)=tconvyl(4)+fcvy + tconvzl(4)=tconvzl(4)+fcvz + + ! tpresxl(4)=tpresxl(4)+fprx + tpresyl(4)=tpresyl(4)+fpry + tpreszl(4)=tpreszl(4)+fprz + + tdiffxl(4)=tdiffxl(4)+fdix + tdiffyl(4)=tdiffyl(4)+fdiy + tdiffzl(4)=tdiffzl(4)+fdiz + + enddo + endif + + !Left & Right : + !Left + if ((zcvlf(iv).ge.xstart(3)).and.(zcvlf(iv).le.xend(3))) then + k=zcvlf(iv)-xstart(3)+1 + kk=zcvlf(iv) + zm=real(kk,mytype)*dz + + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdiy=zero + fdiz=zero + do j=jcvlw_lx(iv),jcvup_lx(iv) + kk = xstart(2)-1+j + jj = xstart(2)-1+j + + ym=real(jj,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] + + !momentum flux + radial = [xm,ym,zm]-position(iv,:) + + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx -(uymid*radial(3)-uzmid*radial(2))*uzmid*dx*del_y(j) !!!CHANGE + fcvy = fcvy -(uzmid*radial(1)-uxmid*radial(3))*uzmid*dx*del_y(j) + fcvz = fcvz -(uxmid*radial(2)-uymid*radial(1))*uzmid*dx*del_y(j) + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + ! fprz = fprz -prmid*dx*dy*(radial(2)-radial(1)) + fprx = fprx +prmid*dx*dy*(radial(2)) + fpry = fpry +prmid*dx*dy*(-radial(1)) + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix - (xnu*(dvdzmid+dwdymid)*radial(3)-xnu*(two*dwdzmid)*radial(2))*dx*dy + fdiy = fdiy - (xnu*(two*dwdzmid)*radial(1)-xnu*(dudzmid+dwdxmid)*radial(3))*dx*dy + fdiz = fdiz - (xnu*(dudzmid+dwdxmid)*radial(2)-xnu*(dvdzmid+dwdymid)*radial(1))*dx*dy + + + ! fdix = fdix +(xnu*(dudzmid+dwdxmid)*dx*dy) + ! fdiy = fdiy +(xnu*(dvdzmid+dwdymid)*dx*dy) + ! fdiz = fdiz +(xnu*(two*dwdzmid)*dx*dy) + enddo + enddo +!print*, kk +! drag3(kk)=drag3(kk)+fcvx ! Should be size ny +! print*, drag3(kk) + tconvxl2(5)=tconvxl2(5)+fcvx + tconvyl2(5)=tconvyl2(5)+fcvy + tconvzl2(5)=tconvzl2(5)+fcvz + tpresxl(5) =tpresxl(5) +fprx + tpresyl(5) =tpresyl(5) +fpry + ! tpreszl(5) =tpreszl(5) +fprz + tdiffxl2(5)=tdiffxl2(5)+fdix + tdiffyl2(5)=tdiffyl2(5)+fdiy + tdiffzl2(5)=tdiffzl2(5)+fdiz + endif + !Right + if ((zcvrt(iv).ge.xstart(3)).and.(zcvrt(iv).le.xend(3))) then + k=zcvrt(iv)-xstart(3)+1 + kk=zcvrt(iv) + zm=real(kk,mytype)*dz +! kk=nrank+1 + + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fpry=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + ! do k=1,xsize(3) + do j=jcvlw_lx(iv),jcvup_lx(iv) + ! kk = xstart(2)-1+j + jj = xstart(2)-1+j + ym=real(jj,mytype)*dy + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + !momentum flux + radial = [xm,ym,zm]-position(iv,:) + + call crossProduct(angularVelocity(iv,2:4),[xm,ym,zm]-position(iv,:),rotationalComponent) + ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] + + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(iv,1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(iv,2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(iv,3) + rotationalComponent(3) + + fcvx = fcvx +(uymid*radial(3)-uzmid*radial(2))*uzmid*dx*del_y(j) + fcvy = fcvy +(uzmid*radial(1)-uxmid*radial(3))*uzmid*dx*del_y(j) + fcvz = fcvz +(uxmid*radial(2)-uymid*radial(1))*uzmid*dx*del_y(j) + + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + ! fprz = fprz +prmid*dx*dy*(radial(2)-radial(1)) + + fprx = fprx -prmid*dx*dy*(radial(2)) + fpry = fpry -prmid*dx*dy*(-radial(1)) + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix + (xnu*(dvdzmid+dwdymid)*radial(3)-xnu*(two*dwdzmid)*radial(2))*dx*dy + fdiy = fdiy + (xnu*(two*dwdzmid)*radial(1)-xnu*(dudzmid+dwdxmid)*radial(3))*dx*dy + fdiz = fdiz + (xnu*(dudzmid+dwdxmid)*radial(2)-xnu*(dvdzmid+dwdymid)*radial(1))*dx*dy + + ! fdix = fdix -(xnu*(dudzmid+dwdxmid)*dx*dy) + ! fdiy = fdiy -(xnu*(dvdzmid+dwdymid)*dx*dy) + ! fdiz = fdiz -two*xnu*dwdzmid*dx*dy + + enddo + enddo +! drag4(kk)=drag4(kk)+fcvx ! Should be size ny + tconvxl2(6)=tconvxl2(6)+fcvx + tconvyl2(6)=tconvyl2(6)+fcvy + tconvzl2(6)=tconvzl2(6)+fcvz + + tpresxl(6) =tpresxl(6) +fprx !!!!!!!! + tpresyl(6) =tpresyl(6) +fpry + ! tpreszl(6) =tpreszl(6) +fprz + + tdiffxl2(6)=tdiffxl2(6)+fdix + tdiffyl2(6)=tdiffyl2(6)+fdiy + tdiffzl2(6)=tdiffzl2(6)+fdiz + endif + + call MPI_ALLREDUCE(tconvxl,tconvx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl,tconvy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl,tconvz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + call MPI_ALLREDUCE(tpresxl,tpresx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpresyl,tpresy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl,tdiffx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl,tdiffy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl,tdiffz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + call MPI_ALLREDUCE(tconvxl2,tconvx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl2,tconvy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl2,tconvz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpreszl, tpresz ,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl2,tdiffx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl2,tdiffy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl2,tdiffz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + + tp1 = sum(tpresx(:))/dt + tp2 = sum(tpresy(:))/dt + tp3 = sum(tpresz(:))/dt + + mom1 = sum(tunstx(:)) + sum(tconvx(:)) + (-2.0*tconv2_sign+1.0)*sum(tconvx2(:)) !if tconv2sign == 1.0, multiply by -1 + mom2 = sum(tunsty(:)) + sum(tconvy(:)) + (-2.0*tconv2_sign+1.0)*sum(tconvy2(:)) + mom3 = sum(tunstz(:)) + sum(tconvz(:)) + (-2.0*tconv2_sign+1.0)*sum(tconvz2(:)) + + dra1(iv) = -(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1)*(1.0-2.0*torq_flip) + dra2(iv) = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2)*(1.0-2.0*torq_flip) + dra3(iv) = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3)*(1.0-2.0*torq_flip) + + ! do k=1,zsize(3) + + ! tpresx(k)=tpresx(k)/dt + ! tpresy(k)=tpresy(k)/dt + ! tpresz(k)=tpresz(k)/dt + + + ! xmom = tunstx(k)+tconvx(k)+tconvx2(k) + ! ymom = tunsty(k)+tconvy(k)+tconvy2(k) + ! zmom = tunstz(k)+tconvz(k)+tconvz2(k) + ! xDrag(k) = (tdiffx(k)+tdiffx2(k)+tpresx(k)-xmom) + ! yLift(k) = (tdiffy(k)+tdiffy2(k)+tpresy(k)-ymom) + ! zLat(k) = (tdiffz(k)+tdiffz2(k)+tpresz(k)-zmom) + + ! enddo + + !Edited by F. Schuch + xDrag_mean = sum(xDrag(:))/real(nz,mytype) + yLift_mean = sum(yLift(:))/real(nz,mytype) + + ! xDrag_tot = sum(xDrag(:)) + ! yLift_tot = sum(yLift(:)) + ! zLat_tot = sum(zLat(:)) + + if ((itime==ifirst).or.(itime==0)) then + + endif + if ((nrank .eq. 0).and.(record_var.eq.1).and.(mod(itime,ilist)==0)) then + ! write(*,*) 'TIME STEP = ', itime + write(45+(iv-1),*) t,dra1,dra2,dra3, sum(tdiffx), sum(tdiffx2), tp1, -mom1, -sum(tunstx(:)), -sum(tconvx(:)), -sum(tconvx2(:)) + ! write(*,*) 'written to file number', 38+(iv-1), t, dra1,dra2,dra3 + call flush(45+(iv-1)) + + if (torq_debug.eq.1) then + write(100,*) t,dra1,dra2,dra3, tdiffx(1), tdiffx2(1), tpresx(1)/dt, -tunstx(1), -tconvx(1), -tconvx2(1) + write(101,*) t,dra1,dra2,dra3, tdiffx(2), tdiffx2(2), tpresx(2)/dt, -tunstx(2), -tconvx(2), -tconvx2(2) + write(102,*) t,dra1,dra2,dra3, tdiffx(3), tdiffx2(3), tpresx(3)/dt, -tunstx(3), -tconvx(3), -tconvx2(3) + write(103,*) t,dra1,dra2,dra3, tdiffx(4), tdiffx2(4), tpresx(4)/dt, -tunstx(4), -tconvx(4), -tconvx2(4) + write(104,*) t,dra1,dra2,dra3, tdiffx(5), tdiffx2(5), tpresx(5)/dt, -tunstx(5), -tconvx(5), -tconvx2(5) + write(105,*) t,dra1,dra2,dra3, tdiffx(6), tdiffx2(6), tpresx(6)/dt, -tunstx(6), -tconvx(6), -tconvx2(6) + + write(106,*) t,dra1,dra2,dra3, sum(tdiffy), sum(tdiffy2), tp2, -mom2, -sum(tunsty(:)), -sum(tconvy(:)), -sum(tconvy2(:)) + write(107,*) t,dra1,dra2,dra3, sum(tdiffz), sum(tdiffz2), tp3, -mom3, -sum(tunstz(:)), -sum(tconvz(:)), -sum(tconvz2(:)) + + call flush(100) + call flush(101) + call flush(102) + call flush(103) + call flush(104) + call flush(105) + + call flush(106) + call flush(107) + endif + endif + ! if (mod(itime, ioutput).eq.0) then + ! if (nrank .eq. 0) then + ! write(filename,"('forces.dat',I7.7)") itime + ! call system("cp forces.dat " //filename) + ! endif + ! endif + enddo + + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux11(i,j,k)=ux01(i,j,k) + uy11(i,j,k)=uy01(i,j,k) + uz11(i,j,k)=uz01(i,j,k) + ux01(i,j,k)=ux1(i,j,k) + uy01(i,j,k)=uy1(i,j,k) + uz01(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + + return + + end subroutine torque_calc end module forces diff --git a/src/forces_draft.f90 b/src/forces_draft.f90 new file mode 100644 index 000000000..46ed16826 --- /dev/null +++ b/src/forces_draft.f90 @@ -0,0 +1,918 @@ +!################################################################################ +!This file is part of Xcompact3d. +! +!Xcompact3d +!Copyright (c) 2012 Eric Lamballais and Sylvain Laizet +!eric.lamballais@univ-poitiers.fr / sylvain.laizet@gmail.com +! +! Xcompact3d is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation. +! +! Xcompact3d is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with the code. If not, see . +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- +! We kindly request that you cite Xcompact3d/Incompact3d in your +! publications and presentations. The following citations are suggested: +! +! 1-Laizet S. & Lamballais E., 2009, High-order compact schemes for +! incompressible flows: a simple and efficient method with the quasi-spectral +! accuracy, J. Comp. Phys., vol 228 (15), pp 5989-6015 +! +! 2-Laizet S. & Li N., 2011, Incompact3d: a powerful tool to tackle turbulence +! problems with up to 0(10^5) computational cores, Int. J. of Numerical +! Methods in Fluids, vol 67 (11), pp 1735-1757 +!################################################################################ + +!======================================================================= +! This program computes the drag and lift coefficients alongo a +! cylinder by the control ! volume (CV) technique for 2D (pencil) +! decomposition. +! +! Adpated from Leandro Pinto PhD Thesis (2012) by Gabriel Narvaez Campo +! 08-2018 Nucleo de Estudos em Transicao e Turbulencia (NETT/IPH/UFRGS) +! +!======================================================================= + +module forces + USE decomp_2d + USE ibm + implicit none + + integer :: nvol,iforces + real(mytype),save,allocatable,dimension(:,:,:) :: ux01, uy01, ux11, uy11, ppi1, uz01, uz11 + real(mytype),allocatable,dimension(:) :: xld, xrd, yld, yud, xld2, xrd2, yld2, yud2, zld, zrd + integer,allocatable,dimension(:) :: icvlf, icvrt, jcvlw, jcvup, zcvlf, zcvrt + integer,allocatable,dimension(:) :: icvlf_lx, icvrt_lx, icvlf_ly, icvrt_ly, icvlf_lz, icvrt_lz + integer,allocatable,dimension(:) :: jcvlw_lx, jcvup_lx, jcvlw_ly, jcvup_ly, jcvlw_lz, jcvup_lz + integer,allocatable,dimension(:) :: zcvlf_lx, zcvrt_lx, zcvlf_ly, zcvrt_ly + + + contains + + subroutine init_forces + + USE decomp_2d + USE param + USE variables + implicit none + + integer :: iv + + call alloc_x(ux01) + call alloc_x(uy01) + call alloc_x(ux11) + call alloc_x(uy11) + call alloc_x(ppi1) + call alloc_x(uz01) + call alloc_x(uz11) + + ux01 = zero + uy01 = zero + ux11 = zero + uy11 = zero + uz01 = zero + uz11 = zero + + allocate(icvlf(nvol), icvrt(nvol), jcvlw(nvol), jcvup(nvol), zcvlf(nvol), zcvrt(nvol)) + allocate(icvlf_lx(nvol), icvrt_lx(nvol), icvlf_ly(nvol), icvrt_ly(nvol), icvlf_lz(nvol), icvrt_lz(nvol)) + allocate(jcvlw_lx(nvol), jcvup_lx(nvol), jcvlw_ly(nvol), jcvup_ly(nvol), jcvlw_lz(nvol), jcvup_lz(nvol)) + allocate(zcvlf_lx(nvol), zcvrt_lx(nvol), zcvlf_ly(nvol), zcvrt_ly(nvol)) + allocate(xld2(nvol), xrd2(nvol), yld2(nvol), yud2(nvol)) + + ! Update Control Volume based on moving cylinder case + ! if ((iibm.ne.0).and.(t.ne.0.)) then + ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx + ! xrd2(:) = xrd(:) + (t-ifirst*dt)*ubcx + ! yld2(:) = yld(:) + (t-ifirst*dt)*ubcy + ! yud2(:) = yud(:) + (t-ifirst*dt)*ubcy + ! else + ! xld2(:) = xld(:) + ! xrd2(:) = xrd(:) + ! yld2(:) = yld(:) + ! yud2(:) = yud(:) + ! endif + + ! Definition of the Control Volume + !***************************************************************** + !! xld,xrd,yld,yud: limits of control volume (!!don't use cex and cey anymore!!) + do iv=1,nvol + ! ok for istret=0 (!!to do for istret=1!!) + icvlf(iv) = nint(xld2(iv)/dx)+1 + icvrt(iv) = nint(xrd2(iv)/dx)+1 + jcvlw(iv) = nint(yld2(iv)/dy)+1 + jcvup(iv) = nint(yud2(iv)/dy)+1 + + icvlf_lx(iv) = icvlf(iv) + icvrt_lx(iv) = icvrt(iv) + jcvlw_lx(iv) = max(jcvlw(iv)+1-xstart(2),1) + jcvup_lx(iv) = min(jcvup(iv)+1-xstart(2),xsize(2)) + jcvlw_lz(iv) = max(jcvlw(iv)+1-zstart(2),1) + jcvup_lz(iv) = min(jcvup(iv)+1-zstart(2),zsize(2)) + + icvlf_ly(iv) = max(icvlf(iv)+1-ystart(1),1) + icvrt_ly(iv) = min(icvrt(iv)+1-ystart(1),ysize(1)) + icvlf_lz(iv) = max(icvlf(iv)+1-zstart(1),1) + icvrt_lz(iv) = min(icvrt(iv)+1-zstart(1),zsize(1)) + jcvlw_ly(iv) = jcvlw(iv) + jcvup_ly(iv) = jcvup(iv) + + zcvlf(iv) = nint(zld(iv)/dz)+1 + zcvrt(iv) = nint(zrd(iv)/dz)+1 + zcvlf_lx(iv) = max(zcvlf(iv)+1-xstart(3),1) + zcvrt_lx(iv) = min(zcvrt(iv)+1-xstart(3),xsize(3)) + zcvlf_ly(iv) = max(zcvlf(iv)+1-ystart(3),1) + zcvrt_ly(iv) = min(zcvrt(iv)+1-ystart(3),ysize(3)) + enddo + + if (nrank==0) then + print *,'========================Forces=============================' + print *,' (icvlf) (icvrt) ' + print *,' (jcvup) B____________C ' + print *,' \ \ ' + print *,' \ __ \ ' + print *,' \ \__\ \ ' + print *,' \ \ ' + print *,' \ CV \ ' + print *,' (jcvlw) A____________D ' + do iv=1,nvol + write(*,"(' Control Volume : #',I1)") iv + write(*,"(' xld, icvlf : (',F6.2,',',I6,')')") xld(iv), icvlf(iv) + write(*,"(' xrd, icvrt : (',F6.2,',',I6,')')") xrd(iv), icvrt(iv) + write(*,"(' yld, jcvlw : (',F6.2,',',I6,')')") yld(iv), jcvlw(iv) + write(*,"(' yud, jcvup : (',F6.2,',',I6,')')") yud(iv), jcvup(iv) + enddo + print *,'===========================================================' + endif + end subroutine init_forces + + !*********************************************************************** + ! +! subroutine update_forces +! ! +! !*********************************************************************** + +! USE decomp_2d +! USE param +! USE variables +! implicit none + +! integer :: iv + +! ! Update Control Volume based on moving cylinder case +! if ((iibm.ne.0).and.(t.ne.0.)) then +! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx +! xrd2(:) = xrd(:) + (t-ifirst*dt)*ubcx +! yld2(:) = yld(:) + (t-ifirst*dt)*ubcy +! yud2(:) = yud(:) + (t-ifirst*dt)*ubcy +! else +! xld2(:) = xld(:) +! xrd2(:) = xrd(:) +! yld2(:) = yld(:) +! yud2(:) = yud(:) +! endif + +! ! Definition of the Control Volume +! !***************************************************************** +! !! xld,xrd,yld,yud: limits of control volume (!!don't use cex and cey anymore!!) +! do iv=1,nvol +! ! ok for istret=0 (!!to do for istret=1!!) +! icvlf(iv) = nint(xld2(iv)/dx)+1 +! icvrt(iv) = nint(xrd2(iv)/dx)+1 +! jcvlw(iv) = nint(yld2(iv)/dy)+1 +! jcvup(iv) = nint(yud2(iv)/dy)+1 + +! icvlf_lx(iv) = icvlf(iv) +! icvrt_lx(iv) = icvrt(iv) +! jcvlw_lx(iv) = max(jcvlw(iv)+1-xstart(2),1) +! jcvup_lx(iv) = min(jcvup(iv)+1-xstart(2),xsize(2)) +! jcvlw_lz(iv) = max(jcvlw(iv)+1-zstart(2),1) +! jcvup_lz(iv) = min(jcvup(iv)+1-zstart(2),zsize(2)) + +! icvlf_ly(iv) = max(icvlf(iv)+1-ystart(1),1) +! icvrt_ly(iv) = min(icvrt(iv)+1-ystart(1),ysize(1)) +! icvlf_lz(iv) = max(icvlf(iv)+1-zstart(1),1) +! icvrt_lz(iv) = min(icvrt(iv)+1-zstart(1),zsize(1)) +! jcvlw_ly(iv) = jcvlw(iv) +! jcvup_ly(iv) = jcvup(iv) + +! zcvlf(iv) = nint(zld(iv)/dz)+1 +! zcvrt(iv) = nint(zrd(iv)/dz)+1 +! zcvlf_lx(iv) = max(zcvlf(iv)+1-xstart(3),1) +! zcvrt_lx(iv) = min(zcvrt(iv)+1-xstart(3),xsize(3)) +! zcvlf_ly(iv) = max(zcvlf(iv)+1-ystart(3),1) +! zcvrt_ly(iv) = min(zcvrt(iv)+1-ystart(3),ysize(3)) +! enddo +! end subroutine update_forces + +! !*********************************************************************** + ! + subroutine restart_forces(itest1) + ! + !*********************************************************************** + + USE decomp_2d + USE decomp_2d_io + USE variables + USE param + USE MPI + + implicit none + + integer :: fh,ierror,code,itest1 + integer :: ierror_o=0 !error to open sauve file during restart + character(len=30) :: filename, filestart + integer (kind=MPI_OFFSET_KIND) :: filesize, disp + + write(filename, "('restart-forces',I7.7)") itime + write(filestart,"('restart-forces',I7.7)") ifirst-1 + + if (itest1==1) then !write + if (mod(itime, icheckpoint).ne.0) then + return + endif + + call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & + MPI_MODE_CREATE+MPI_MODE_WRONLY, MPI_INFO_NULL, & + fh, ierror) + filesize = 0_MPI_OFFSET_KIND + call MPI_FILE_SET_SIZE(fh,filesize,ierror) ! guarantee overwriting + disp = 0_MPI_OFFSET_KIND + call decomp_2d_write_var(fh,disp,1,ux01) + call decomp_2d_write_var(fh,disp,1,uy01) + call decomp_2d_write_var(fh,disp,1,ux11) + call decomp_2d_write_var(fh,disp,1,uy11) + call decomp_2d_write_var(fh,disp,1,uz01) + call decomp_2d_write_var(fh,disp,1,uz11) + call MPI_FILE_CLOSE(fh,ierror) + else !read + call MPI_FILE_OPEN(MPI_COMM_WORLD, filestart, & + MPI_MODE_RDONLY, MPI_INFO_NULL, & + fh, ierror_o) + disp = 0_MPI_OFFSET_KIND + call decomp_2d_read_var(fh,disp,1,ux01) + call decomp_2d_read_var(fh,disp,1,uy01) + call decomp_2d_read_var(fh,disp,1,ux11) + call decomp_2d_read_var(fh,disp,1,uy11) + call decomp_2d_read_var(fh,disp,1,uz01) + call decomp_2d_read_var(fh,disp,1,uz11) + call MPI_FILE_CLOSE(fh,ierror_o) + endif + + if (nrank.eq.0) then + if (ierror_o .ne. 0) then !Included by Felipe Schuch + print *,'===========================================================' + print *,'Error: Impossible to read '//trim(filestart) + print *,'===========================================================' + call MPI_ABORT(MPI_COMM_WORLD,code,ierror) + endif + endif + + end subroutine restart_forces + end module forces + + !*********************************************************************** + subroutine force(ux1,uy1,uz1,ep1) + !*********************************************************************** + + USE forces + USE param + USE variables + USE decomp_2d + USE MPI + USE ibm + use var, only : ta1, tb1, tc1, td1, te1, tf1, tg1, th1, ti1, di1 + use var, only : ux2, uy2, uz2, ta2, tb2, tc2, td2, te2, tf2, tg2, th2, ti2, di2 + use var, only : ux3, uy3, uz3, ta3, tb3, tc3, td3, te3, tf3, tg3, th3, ti3, di3 + + + implicit none + character(len=30) :: filename, filename2 + integer :: nzmsize + integer :: i, iv, j, k, kk, code, jj + integer :: nvect1,nvect2,nvect3 + + real(mytype), dimension(xsize(1),xsize(2),xsize(3)) :: ux1, uy1, uz1 + real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ep1 + + real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 + real(mytype), dimension(zsize(1),zsize(2),zsize(3)) :: ppi3 + + real(mytype), dimension(nz) :: yLift, xDrag, zLat + real(mytype) :: yLift_mean, xDrag_mean, zLat_mean + + real(mytype), dimension(nz) :: tunstxl, tunstyl, tunstzl + real(mytype), dimension(nz) :: tconvxl, tconvyl, tconvzl + real(mytype), dimension(nz) :: tpresxl, tpresyl + real(mytype), dimension(nz) :: tdiffxl, tdiffyl, tdiffzl + + real(mytype), dimension(nz) :: tunstx, tunsty, tunstz + real(mytype), dimension(nz) :: tconvx, tconvy, tconvz + real(mytype), dimension(nz) :: tpresx, tpresy + real(mytype), dimension(nz) :: tdiffx, tdiffy, tdiffz + + + real(mytype), dimension(ny) :: tconvxl2, tconvyl2, tconvzl2 + real(mytype), dimension(ny) :: tdiffxl2, tdiffyl2, tdiffzl2 + real(mytype), dimension(ny) :: tconvx2, tconvy2, tconvz2 + real(mytype), dimension(ny) :: tdiffx2, tdiffy2, tdiffz2 + real(mytype), dimension(ny) :: tpreszl, tpresz + + + + + real(mytype) :: uxmid, uymid, uzmid, prmid + real(mytype) :: dudxmid, dudymid, dudzmid, dvdxmid, dvdymid, dvdzmid + real(mytype) :: dwdxmid, dwdymid, dwdzmid + real(mytype) :: fac,tsumx, tsumy, tsumz + real(mytype) :: fcvx, fcvy, fcvz, fprx, fpry, fprz, fdix, fdiy, fdiz + real(mytype) :: xmom, ymom, zmom + real(mytype), dimension(ny) :: ztpresx, ztpresy + real(mytype), dimension(nz) :: zyLift, zxDrag, zzLat + real(mytype) :: zyLift_mean, zxDrag_mean, zzLat_mean + + + + real(mytype), dimension(nz) :: drag1, drag2, drag11, drag22 + real(mytype), dimension(nz) :: drag3, drag4, drag33, drag44 + real(mytype) :: mom1, mom2, mom3, tp1, tp2, tp3, dra1, dra2, dra3 + + ! if (imove.eq.1) then + ! ux1(:,:,:) = ux1(:,:,:) + 0.5 + ! endif + + nvect1=xsize(1)*xsize(2)*xsize(3) + nvect2=ysize(1)*ysize(2)*ysize(3) + nvect3=zsize(1)*zsize(2)*zsize(3) + + if (itime.eq.1) then + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux11(i,j,k)=ux1(i,j,k) + uy11(i,j,k)=uy1(i,j,k) + uz11(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + return + elseif (itime.eq.2) then + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux01(i,j,k)=ux1(i,j,k) + uy01(i,j,k)=uy1(i,j,k) + uz01(i,j,k)=uz1(i,j,k) + enddo + enddo + enddo + return + endif + !print*, t + !if (nrank.eq.0) print*, ppi1 + + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) ! du/dx + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) ! dv/dx + call derx (te1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) ! dw/dx + + call transpose_x_to_y(ta1,ta2) ! du/dx + call transpose_x_to_y(tb1,tb2) ! dv/dx + call transpose_x_to_y(te1,te2) ! dw/dx + + call transpose_x_to_y(ux1,ux2) + call transpose_x_to_y(uy1,uy2) + call transpose_x_to_y(uz1,uz2) + call transpose_x_to_y(ppi1,ppi2) + + + call dery (tc2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) ! du/dy + call dery (td2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) ! dv/dy + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) ! dw/dy + + call transpose_y_to_z(ux2,ux3) + call transpose_y_to_z(uy2,uy3) + call transpose_y_to_z(uz2,uz3) + !!!!!!! call transpose_y_to_z(ppi2,ppi3) + + !!!!!!! call transpose_y_to_z(te2,te3) ! dw/dx + !!!!!!! call transpose_y_to_z(tf2,tf3) ! dw/dy + + + call derz (tg3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) ! du/dz + call derz (th3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) ! dv/dz + call derz (ti3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) ! dw/dz + + + call transpose_z_to_y(tg3,tg2) ! du/dz + call transpose_z_to_y(th3,th2) ! dv/dz + call transpose_z_to_y(ti3,ti2) ! + + + call transpose_y_to_x(tc2,tc1) ! du/dy + call transpose_y_to_x(td2,td1) ! dv/dy + call transpose_y_to_x(th2,th1) ! dv/dz + call transpose_y_to_x(tf2,tf1) ! dw/dy + call transpose_y_to_x(tg2,tg1) ! + call transpose_y_to_x(ti2,ti1) ! + + + + + + !***************************************************************** + ! Drag and Lift coefficients + !***************************************************************** + do iv=1,nvol + + !***************************************************************** + ! Calculation of the momentum terms + !***************************************************************** + ! + ! Calculation of the momentum terms. First we integrate the + ! time rate of momentum along the CV. + ! + ! Excluding the body internal cells. If the centroid + ! of the cell falls inside the body the cell is + ! excluded. + + tunstxl=zero + tunstyl=zero + tunstzl=zero + ! do k=1,xsize(3) + do k=zcvlf_lx(iv),zcvrt_lx(iv) + tsumx=zero + tsumy=zero + tsumz=zero + do j=jcvlw_lx(iv),jcvup_lx(iv) + do i=icvlf_lx(iv),icvrt_lx(iv) + ! The velocity time rate has to be relative to the cell center, + ! and not to the nodes, because, here, we have an integral + ! relative to the volume, and, therefore, this has a sense + ! of a "source". + fac = (onepfive*ux1(i,j,k)-two*ux01(i,j,k)+half*ux11(i,j,k))*(one-ep1(i,j,k)) + tsumx = tsumx+fac*dx*dy*dz/dt + + fac = (onepfive*uy1(i,j,k)-two*uy01(i,j,k)+half*uy11(i,j,k))*(one-ep1(i,j,k)) + tsumy = tsumy+fac*dx*dy*dz/dt + + fac = (onepfive*uz1(i,j,k)-two*uz01(i,j,k)+half*uz11(i,j,k))*(one-ep1(i,j,k)) + tsumz = tsumz+fac*dx*dy*dz/dt + enddo + enddo + tunstxl(xstart(3)-1+k)=tsumx + tunstyl(xstart(3)-1+k)=tsumy + tunstzl(xstart(3)-1+k)=tsumz + enddo + call MPI_ALLREDUCE(tunstxl,tunstx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstyl,tunsty,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tunstzl,tunstz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + !!$!********************************************************************************* + !!$! Secondly, the surface momentum fluxes + !!$!********************************************************************************* + !!$ + !!$! (icvlf) (icvrt) + !!$!(jcvup) B____________C + !!$! \ \ + !!$! \ __ \ + !!$! \ \__\ \ + !!$! \ \ + !!$! \ CV \ + !!$!(jcvlw) A____________D + + drag1(:)=0. + drag2(:)=0. + drag3(:)=0. + drag4(:)=0. + + drag11(:)=0. + drag22(:)=0. + drag33(:)=0. + drag44(:)=0. + + tconvxl=zero + tconvyl=zero + tconvzl=zero + tdiffxl=zero + tdiffyl=zero + tdiffzl=zero + tpresxl=zero + tpresyl=zero + tpreszl=zero + + tconvxl2=zero + tconvyl2=zero + tconvzl2=zero + tdiffxl2=zero + tdiffyl2=zero + tdiffzl2=zero + !BC and AD : x-pencils + !AD + if ((jcvlw(iv).ge.xstart(2)).and.(jcvlw(iv).le.xend(2))) then + j=jcvlw(iv)-xstart(2)+1 + ! do k=1,xsize(3) + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + fcvx=zero + fcvy=zero + fcvz=zero + fpry=zero + fdix=zero + fdiy=zero + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + !momentum flux + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) + + fcvx= fcvx -uxmid*uymid*dx*dz + fcvy= fcvy -uymid*uymid*dx*dz + fcvz= fcvz -uymid*uzmid*dx*dz + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fpry = fpry +prmid*dx*dz + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix -(xnu*(dudymid+dvdxmid)*dx*dz) + fdiy = fdiy -two*xnu*dvdymid*dx*dz + fdiz = fdiz -(xnu*(dwdymid+dvdzmid)*dx*dz) + + enddo + ! drag1(kk)=drag1(kk)+fcvx + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + tpresyl(kk)=tpresyl(kk)+fpry + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + enddo + endif + !BC + if ((jcvup(iv).ge.xstart(2)).and.(jcvup(iv).le.xend(2))) then + j=jcvup(iv)-xstart(2)+1 + ! do k=1,xsize(3) + do k=zcvlf_lx(iv),zcvrt_lx(iv) + kk=xstart(3)-1+k + fcvx=zero + fcvy=zero + fcvz=zero + fpry=zero + fdix=zero + fdiy=zero + fdiz=zero + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + !momentum flux + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) + fcvx= fcvx +uxmid*uymid*dx*dz + fcvy= fcvy +uymid*uymid*dx*dz + fcvz= fcvz +uymid*uzmid*dx*dz + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fpry = fpry -prmid*dx*dz + + !viscous term + dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) + dvdxmid = half*(tb1(i,j,k)+tb1(i+1,j,k)) + dvdymid = half*(td1(i,j,k)+td1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + + fdix = fdix +(xnu*(dudymid+dvdxmid)*dx*dz) + fdiy = fdiy +two*xnu*dvdymid*dx*dz + fdiz = fdiz +(xnu*(dwdymid+dvdzmid)*dx*dz) + + enddo + ! drag2(kk)=drag2(kk)+fcvx + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + tpresyl(kk)=tpresyl(kk)+fpry + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + enddo + endif + !AB and DC : y-pencils + !AB + + ! print*,icvlf(iv) + if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then + i=icvlf(iv)-ystart(1)+1 + ! do k=1,ysize(3) + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)-1+k + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=1,ysize(2)-1 + ! do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + !momentum flux + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) + fcvx= fcvx -uxmid*uxmid*dy*dz + fcvy= fcvy -uxmid*uymid*dy*dz + fcvz= fcvz -uxmid*uzmid*dy*dz + + !pressure + prmid=half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + fprx = fprx +prmid*dy*dz + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix -two*xnu*dudxmid*dy*dz + fdiy = fdiy -xnu*(dvdxmid+dudymid)*dy*dz + fdiz = fdiz -xnu*(dwdxmid+dudzmid)*dy*dz + enddo + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + tpresxl(kk)=tpresxl(kk)+fprx + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + enddo + endif + !DC + if ((icvrt(iv).ge.ystart(1)).and.(icvrt(iv).le.yend(1))) then + i=icvrt(iv)-ystart(1)+1 + ! do k=1,ysize(3) + do k=zcvlf_ly(iv),zcvrt_ly(iv) + kk=ystart(3)-1+k + fcvx=zero + fcvy=zero + fcvz=zero + fprx=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=1,ysize(2)-1 + ! do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + !momentum flux + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) + fcvx= fcvx +uxmid*uxmid*dy*dz + fcvy= fcvy +uxmid*uymid*dy*dz + fcvz= fcvz +uxmid*uzmid*dy*dz + + !pressure + prmid=half*(ppi2(i,j,k)+ppi2(i,j+1,k)) + fprx = fprx -prmid*dy*dz + + !viscous term + dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) + dudymid = half*(tc2(i,j,k)+tc2(i,j+1,k)) + dvdxmid = half*(tb2(i,j,k)+tb2(i,j+1,k)) + dwdxmid = half*(te2(i,j,k)+te2(i,j+1,k)) + dudzmid = half*(tg2(i,j,k)+tg2(i,j+1,k)) + + fdix = fdix +two*xnu*dudxmid*dy*dz + fdiy = fdiy +xnu*(dvdxmid+dudymid)*dy*dz + fdiz = fdiz +xnu*(dwdxmid+dudzmid)*dy*dz + enddo + tconvxl(kk)=tconvxl(kk)+fcvx + tconvyl(kk)=tconvyl(kk)+fcvy + tconvzl(kk)=tconvzl(kk)+fcvz + tpresxl(kk)=tpresxl(kk)+fprx + tdiffxl(kk)=tdiffxl(kk)+fdix + tdiffyl(kk)=tdiffyl(kk)+fdiy + tdiffzl(kk)=tdiffzl(kk)+fdiz + enddo + endif + + + !Left & Right : + !Left + if ((zcvlf(iv).ge.xstart(3)).and.(zcvlf(iv).le.xend(3))) then + k=zcvlf(iv)-xstart(3)+1 + + + fcvx=zero + fcvy=zero + fcvz=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + do j=jcvlw_lx(iv),jcvup_lx(iv) + kk = xstart(2)-1+j + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + !momentum flux + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) + + fcvx= fcvx +uxmid*uzmid*dx*dy + fcvy= fcvy +uymid*uzmid*dx*dy + fcvz= fcvz +uzmid*uzmid*dx*dy + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fprz = fprz -prmid*dx*dy + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix +(xnu*(dudzmid+dwdxmid)*dx*dy) + fdiy = fdiy +(xnu*(dvdzmid+dwdymid)*dx*dy) + fdiz = fdiz +two*xnu*dwdzmid*dx*dy + enddo + enddo + !print*, kk + ! drag3(kk)=drag3(kk)+fcvx ! Should be size ny + ! print*, drag3(kk) + tconvxl2(kk)=tconvxl2(kk)+fcvx + tconvyl2(kk)=tconvyl2(kk)+fcvy + tconvzl2(kk)=tconvzl2(kk)+fcvz + tpreszl(kk) =tpreszl(kk) +fprz + tdiffxl2(kk)=tdiffxl2(kk)+fdix + tdiffyl2(kk)=tdiffyl2(kk)+fdiy + tdiffzl2(kk)=tdiffzl2(kk)+fdiz + endif + !Right + if ((zcvrt(iv).ge.xstart(3)).and.(zcvrt(iv).le.xend(3))) then + k=zcvrt(iv)-xstart(3)+1 + ! kk=nrank+1 + + fcvx=zero + fcvy=zero + fcvz=zero + fprz=zero + fdix=zero + fdiy=zero + fdiz=zero + ! do k=1,xsize(3) + do j=jcvlw_lx(iv),jcvup_lx(iv) + kk = xstart(2)-1+j + do i=icvlf_lx(iv),icvrt_lx(iv)-1 + !momentum flux + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) + + fcvx= fcvx -uxmid*uzmid*dx*dy + fcvy= fcvy -uymid*uzmid*dx*dy + fcvz= fcvz -uzmid*uzmid*dx*dy + + !pressure + prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) + fprz = fprz +prmid*dx*dy + + !viscous term + dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) + dwdxmid = half*(te1(i,j,k)+te1(i+1,j,k)) + dvdzmid = half*(th1(i,j,k)+th1(i+1,j,k)) + dwdymid = half*(tf1(i,j,k)+tf1(i+1,j,k)) + dwdzmid = half*(ti1(i,j,k)+ti1(i+1,j,k)) + + fdix = fdix -(xnu*(dudzmid+dwdxmid)*dx*dy) + fdiy = fdiy -(xnu*(dvdzmid+dwdymid)*dx*dy) + fdiz = fdiz -two*xnu*dwdzmid*dx*dy + + enddo + enddo + ! drag4(kk)=drag4(kk)+fcvx ! Should be size ny + tconvxl2(kk)=tconvxl2(kk)+fcvx + tconvyl2(kk)=tconvyl2(kk)+fcvy + tconvzl2(kk)=tconvzl2(kk)+fcvz + tpreszl(kk) =tpreszl(kk) +fprz + tdiffxl2(kk)=tdiffxl2(kk)+fdix + tdiffyl2(kk)=tdiffyl2(kk)+fdiy + tdiffzl2(kk)=tdiffzl2(kk)+fdiz + endif + + + call MPI_ALLREDUCE(tconvxl,tconvx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl,tconvy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl,tconvz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpresxl,tpresx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpresyl,tpresy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl,tdiffx,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl,tdiffy,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl,tdiffz,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + call MPI_ALLREDUCE(tconvxl2,tconvx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvyl2,tconvy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tconvzl2,tconvz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tpreszl, tpresz ,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffxl2,tdiffx2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffyl2,tdiffy2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + call MPI_ALLREDUCE(tdiffzl2,tdiffz2,ny,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + + ! call MPI_ALLREDUCE(drag1,drag11,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + ! call MPI_ALLREDUCE(drag2,drag22,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + ! call MPI_ALLREDUCE(drag3,drag33,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + ! call MPI_ALLREDUCE(drag4,drag44,nz,real_type,MPI_SUM,MPI_COMM_WORLD,code) + + + tp1 = sum(tpresx(:))/dt + tp2 = sum(tpresy(:))/dt + tp3 = sum(tpresz(:))/dt + + mom1 = sum(tunstx(:) + tconvx(:) + tconvx2(:)) + mom2 = sum(tunsty(:) + tconvy(:) + tconvy2(:)) + mom3 = sum(tunstz(:) + tconvz(:) + tconvz2(:)) + + dra1 = 2.0*(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2 = 2.0*(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3 = 2.0*(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + !print*, dra1, tp1, mom1 + !print*, dra1, mom1, tp1, sum(tpresx(:))/dt, sum(tunstx(:)), sum(tconvx(:)), sum(tdiffx) + + ! do k=zcvlf(iv),zcvrt(iv) + ! tpresx(k)=tpresx(k)/dt + ! tpresy(k)=tpresy(k)/dt + ! tpresz(k)=tpresz(k)/dt + + ! xmom = tunstx(k)+tconvx(k) + ! ymom = tunsty(k)+tconvy(k) + ! zmom = tunstz(k)+tconvz(k) + ! xDrag(k) = two*(tdiffx(k)+tpresx(k)-xmom) + ! yLift(k) = two*(tdiffy(k)+tpresy(k)-ymom) + ! zLat(k) = two*(tdiffz(k)+tpresz(k)-zmom) + ! enddo + ! xDrag_mean = sum(xDrag(zcvlf(iv):zcvrt(iv)))/real(zcvrt(iv)-zcvlf(iv)) + ! yLift_mean = sum(yLift(zcvlf(iv):zcvrt(iv)))/real(zcvrt(iv)-zcvlf(iv)) + ! zLat_mean = sum(zLat(zcvlf(iv):zcvrt(iv)))/real(zcvrt(iv)-zcvlf(iv)) + + + if ((itime==ifirst).or.(itime==0)) then + if (nrank .eq. 0) then + write(filename,"('aerof',I1.1)") iv + open(38+(iv-1),file=filename,status='unknown',form='formatted') + endif + endif + if (nrank .eq. 0) then + write(38+(iv-1),*) t, dra1, dra2, dra3!, sum(drag11), sum(drag22), sum(drag11)+sum(drag22), sum(drag33), sum(drag44), sum(drag33)+sum(drag44) + ! write(38+(iv-1),*) t, dra1, dra2, dra3 + endif + if (itime==ilast) then + if (nrank .eq. 0) then + close(38+(iv-1)) + write(filename,"('aerof',I1.1)") iv + write(filename2,"('aerof',I1.1,'-',I7.7)") iv, itime + call system("mv " //filename //filename2) + endif + endif + + + enddo + + do k = 1, xsize(3) + do j = 1, xsize(2) + do i = 1, xsize(1) + ux11(i,j,k)=ux01(i,j,k) + uy11(i,j,k)=uy01(i,j,k) + uz11(i,j,k)=uz01(i,j,k) + ux01(i,j,k)=ux1(i,j,k) + uy01(i,j,k)=uy1(i,j,k) + enddo + enddo + enddo + + ! if (imove.eq.1) then + ! ux1(:,:,:) = ux1(:,:,:) - 0.5 + ! endif + + return + + end subroutine force + + + + + + \ No newline at end of file diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 47a98d832..26bbd8398 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -49,21 +49,21 @@ end subroutine epsi_init !############################################################################ subroutine geomcomplex(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) - USE param, ONLY : itype, itype_cyl, itype_hill, itype_channel,& - itype_sandbox, itype_pipe + USE param, ONLY : itype, itype_cyl, itype_hill, itype_channel,itype_sandbox, itype_ellip,itype_pipe USE cyl, ONLY : geomcomplex_cyl USE hill, ONLY : geomcomplex_hill USE channel, ONLY : geomcomplex_channel USE sandbox, ONLY : geomcomplex_sandbox + USE ellip, ONLY : geomcomplex_ellip USE pipe, ONLY : geomcomplex_pipe IMPLICIT NONE - INTEGER :: nxi,nxf,ny,nyi,nyf,nzi,nzf - REAL(mytype),DIMENSION(nxi:nxf,nyi:nyf,nzi:nzf),intent(inout) :: epsi - REAL(mytype) :: dx,dz - REAL(mytype),DIMENSION(ny) :: yp - REAL(mytype) :: remp + INTEGER, intent(in) :: nxi,nxf,ny,nyi,nyf,nzi,nzf + REAL(mytype),DIMENSION(nxi:nxf,nyi:nyf,nzi:nzf) :: epsi + REAL(mytype), intent(in) :: dx,dz + REAL(mytype),DIMENSION(ny), intent(in) :: yp + REAL(mytype), intent(in) :: remp IF (itype.EQ.itype_cyl) THEN @@ -81,6 +81,10 @@ subroutine geomcomplex(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) CALL geomcomplex_sandbox(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, yp, remp) + ELSEIF (itype.EQ.itype_ellip) THEN + + CALL geomcomplex_ellip(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) + ELSEIF (itype.EQ.itype_pipe) THEN CALL geomcomplex_pipe(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) @@ -89,6 +93,104 @@ subroutine geomcomplex(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) end subroutine geomcomplex !############################################################################ + + subroutine param_assign() + + use ibm_param + use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate + use param + use var, only: nrank + real(mytype) :: eqr, ori_dummy(4), ellip_m_dummy, inertia_dummy(3,3) + integer :: i,ii,j + + do i =1,nbody + ii = (i-1)*3 + ! write(*,*) sh(ii+1), sh(ii+2), sh(ii+3) + eqr=(sh(ii+1)*sh(ii+2)*sh(ii+3))**(1.0/3.0) + if (eqr.lt.0.001) then + eqr=1.0 + endif + do j = 1,3 + shape(i,j) = sh(ii+j)/eqr + enddo + if (nrank==0) then + write(*,*) "Body ", i, ", eqr = ", eqr + + write(*,*) i, "'s shape = ", shape(i,:) + endif + enddo + + + do i = 1,nbody + ii = (i-1)*4 + do j = 1,4 + ori_dummy(j) = ori(ii+j) + enddo + + ! write(*,*) "Body, ", i, "orientation = ", ori_dummy + call NormalizeQuaternion(ori_dummy) + + if (nrank==0) then + write(*,*) "Body, ", i, "orientation = ", ori_dummy + endif + orientation(i,:) = ori_dummy + enddo + ! call NormalizeQuaternion(orientation) + do i = 1,nbody + ii = (i-1)*3 + do j = 1,3 + position(i,j) = ce(ii+j) + ! write(*,*) ce(i,j), position(j,i) + enddo + if (nrank==0) then + write(*,*) "Nbody", i, "position = ", position(i, :) + endif + enddo + ! write(*,*) "CE = ", ce + ! write(*,*) "Position = ", position + ! position=ce + do i = 1,nbody + ii = (i-1)*3 + do j = 1,3 + linearVelocity(i,j) = lv(ii+j) + enddo + enddo + + do i = 1,nbody + ii = (i-1)*3 + angularVelocity(i,1)=zero + do j = 1,3 + angularVelocity(i,j+1)=av(ii+j) + enddo + if (nrank==0) then + write(*,*) "Nbody", i, "angvel = ", angularVelocity(i, :) + endif + enddo + ! write(*,*) "Ra = ", ra + + do i = 1,nbody + if (nrank==0) then + write(*,*) "Nbody = ", i, "Radius = ", ra(i) + endif + enddo + do i = 1,nbody + call ellipInertiaCalculate(shape(i,:),rho_s(i),inertia_dummy) + inertia(i,:,:) = inertia_dummy + if (nrank==0) then + + write(*,*) "Nbody", i, "InertiaM = ", inertia(i,:,:) + endif + enddo + do i = 1,nbody + call ellipMassCalculate(shape(i,:), rho_s(i), ellip_m_dummy) + ellip_m(i) = ellip_m_dummy + if (nrank==0) then + + write(*,*) "Nbody", i, "ellip_m = ", ellip_m(i) + endif + enddo + + end subroutine param_assign !############################################################################ subroutine genepsi3d(ep1) @@ -179,7 +281,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& integer, dimension(ysize(1),ysize(3)) :: nobjy integer, dimension(zsize(1),zsize(2)) :: nobjz real(mytype),dimension(ny) :: yp - + ! Local variables integer, dimension(xsize(2),xsize(3)) :: nobjxraf integer, dimension(ysize(1),ysize(3)) :: nobjyraf @@ -224,16 +326,18 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& else dyraf =yly/real(nyraf-1, mytype) endif + do j=1,ny-1 + do jraf=1,nraf + ypraf(jraf+nraf*(j-1))=yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) + enddo + enddo + if (ncly) then + do jraf = 1,nraf + ypraf(jraf+nraf*(ny-1))=yp(ny)+real(jraf-1,mytype)*(yly-yp(ny))/real(nraf,mytype) + enddo + endif - ! Compute ypraf - if (istret.eq.0) then - do j = 1, nyraf - ypraf(j) = (j-1) * dyraf - end do - else - call stretching(nyraf, ypraf, opt_write = .false.) - end if - + if(.not.ncly)ypraf(nyraf)=yp(ny) yepsi=zero call geomcomplex(yepsi,ystart(1),yend(1),nyraf,1,nyraf,ystart(3),yend(3),dx,ypraf,dz,one) ! if (nrank==0) print*,' step 3' diff --git a/src/ibm.f90 b/src/ibm.f90 index ab6f9c11c..b95243733 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -15,6 +15,7 @@ subroutine corgp_IBM (ux,uy,uz,px,py,pz,nlock) USE param USE decomp_2d USE variables + implicit none integer :: i,j,k,nlock real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz,px,py,pz @@ -403,6 +404,8 @@ subroutine cubsplx(u,lind) USE decomp_2d USE variables USE ibm_param + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc + ! USE decomp_2d_mpi, only : decomp_2d_abort ! implicit none @@ -416,24 +419,35 @@ subroutine cubsplx(u,lind) real(mytype) :: xpol,ypol ! Position and Value of the Reconstructed Solution real(mytype),dimension(10) :: xa,ya ! Position and Value of the Input Data Function integer :: ia,na - real(mytype) :: lind ! Identifying which BC to Impose + integer :: lind,lind_2 ! Identifying which BC to Impose real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf ! Position of Boundary (Analytically) + real(mytype) :: point(3),pointVelocity(3) + real(mytype) :: xm,ym,zm ! ! Initialise Arrays xa(:)=0. ya(:)=0. ! ! Impose the Correct BC - bcimp=lind - ! + if (itype.eq.itype_ellip) then !variable surface values + lind_2=-lind + else + lind_2=lind + end if + do k=1,xsize(3) + zm=real(xstart(3)+k-1,mytype)*dz do j=1,xsize(2) + ym=real(xstart(2)+j-1,mytype)*dy if(nobjx(j,k).ne.0)then ia=0 do i=1,nobjx(j,k) - ! 1st Boundary + ! 1st Boundary - I DON'T UNDERSTAND THIS XM CONVERSION. + ! write(*,*) "Nobjx = ", nobjx(j,k) + ! xm=real(xstart(1)+i-2,mytype)*dx + xm = xi(i,j,k) nxpif=npif ia=ia+1 if (ianal.eq.0) then @@ -443,6 +457,18 @@ subroutine cubsplx(u,lind) call analitic_x(j,xi(i,j,k),ana_resi,k) ! Calculate the position of BC analytically xa(ia)=ana_resi endif + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + ! write(*,*) "Called CPV at ", point, "returned", pointVelocity + ! call EllipsoidalRadius(point, position, orientation, shape, dummy) + ! dummy = maxval(abs((point(2:3)-position(2:3)))) + ! if ((dummy.gt.(1.01)).or.(dummy.lt.0.99)) then + ! write(*,*) "At ", point, "r = ", dummy + ! endif + ! write(*,*) "Radius = ", dummy + ! write(*,*) "radius = ", dummy, "At point", point + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) + ya(ia)=bcimp if(xi(i,j,k).gt.0.)then ! Immersed Object inxi=0 @@ -487,7 +513,20 @@ subroutine cubsplx(u,lind) call analitic_x(j,xf(i,j,k),ana_resf,k) ! Calculate the position of BC analytically xa(ia)=ana_resf endif - ya(ia)=bcimp + xm = xf(i,j,k) + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + ! write(*,*) "Called CPV at ", point, "returned", pointVelocity + ! call EllipsoidalRadius(point, position, orientation, shape, dummy) + ! dummy = maxval(abs(point-position)) + ! write(*,*) "Radius = ", dummy + ! dummy = maxval(abs(point-position)) + ! if ((dummy.gt.(1.01)).or.(dummy.lt.0.99)) then + ! write(*,*) "At ", point, "r = ", dummy + ! endif + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) !take correct part of pointVelocity for equation type. + + ya(ia)=bcimp if(xf(i,j,k).lt.xlx)then ! Immersed Object inxf=0 ix=(xf(i,j,k)+dx)/dx+1 @@ -523,20 +562,20 @@ subroutine cubsplx(u,lind) ! Special Case if (xi(i,j,k).eq.xf(i,j,k)) then call decomp_2d_abort(1, "!! situation not supported by the IBM !!") - !u(ipol,j,k)=bcimp + !u(ipol,j,k)=bcimp else ! Cubic Spline Reconstruction na=ia do ipol=ipoli,ipolf if ((inxf.eq.1).and.(inxi.eq.1)) then ! If the Body Extends from the Inlet to the Outlet (Special Case) - u(ipol,j,k)=bcimp + u(ipol,j,k)=bcimp else xpol=dx*(ipol-1) if (xpol.eq.ana_resi) then u(ipol,j,k)=bcimp elseif (xpol.eq.ana_resf) then u(ipol,j,k)=bcimp - else + else call cubic_spline(xa,ya,na,xpol,ypol) u(ipol,j,k)=ypol endif @@ -564,6 +603,7 @@ subroutine cubsply(u,lind) USE variables USE ibm_param USE decomp_2d_mpi, only : decomp_2d_abort + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc ! implicit none ! @@ -576,23 +616,32 @@ subroutine cubsply(u,lind) real(mytype) :: xpol,ypol,dypol ! Position and Value of the Reconstructed Solution real(mytype),dimension(10) :: xa,ya ! Position and Value of the Input Data Function integer :: ia,na - real(mytype) :: lind ! Identifying which BC to Impose + integer :: lind, lind_2 ! Identifying which BC to Impose real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf + real(mytype) :: point(3),pointVelocity(3) + real(mytype) :: xm,ym,zm ! ! Initialise Arrays xa(:)=0. ya(:)=0. ! ! Impose the Correct BC - bcimp=lind + if (itype.eq.itype_ellip) then + lind_2 = -lind + else + lind_2 = lind + endif ! do k=1,ysize(3) + zm=real(ystart(3)+k-1,mytype)*dz do i=1,ysize(1) + xm=real(ystart(1)+i-1,mytype)*dx if(nobjy(i,k).ne.0)then ia=0 - do j=1,nobjy(i,k) + do j=1,nobjy(i,k) + ! ym=real(ystart(2)+j-2,mytype)*dy ! 1st Boundary nypif=npif ia=ia+1 @@ -603,6 +652,12 @@ subroutine cubsply(u,lind) call analitic_y(i,yi(j,i,k),ana_resi,k) ! Calculate the position of BC analytically xa(ia)=ana_resi endif + ym = yi(j,i,k) + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(yi(j,i,k).gt.0.)then ! Immersed Object jy=1 @@ -652,6 +707,12 @@ subroutine cubsply(u,lind) call analitic_y(i,yf(j,i,k),ana_resf,k) ! Calculate the position of BC analytically xa(ia)=ana_resf endif + ym = yf(j,i,k) + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(yf(j,i,k).lt.yly)then ! Immersed Object jy=1 @@ -692,7 +753,7 @@ subroutine cubsply(u,lind) ! Special Case if (yi(j,i,k).eq.yf(j,i,k)) then call decomp_2d_abort(1, "!! situation not supported by the IBM !!") - !u(i,jpol,k)=bcimp + !u(i,jpol,k)=bcimp else !calcul du polynôme na=ia @@ -702,7 +763,7 @@ subroutine cubsply(u,lind) u(i,jpol,k)=bcimp elseif (xpol.eq.ana_resf) then u(i,jpol,k)=bcimp - else + else call cubic_spline(xa,ya,na,xpol,ypol) u(i,jpol,k)=ypol endif @@ -729,6 +790,7 @@ subroutine cubsplz(u,lind) USE variables USE ibm_param USE decomp_2d_mpi, only : decomp_2d_abort + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc ! implicit none ! @@ -741,24 +803,34 @@ subroutine cubsplz(u,lind) real(mytype) :: xpol,ypol,dypol !|variables concernant les polynômes real(mytype),dimension(10) :: xa,ya !|de Lagrange. A mettre imérativement en integer :: ia,na !|double précision - real(mytype) :: lind ! Identifying which BC to Impose + integer :: lind, lind_2 ! Identifying which BC to Impose real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf + real(mytype) :: point(3),pointVelocity(3) + real(mytype) :: xm,ym,zm + ! ! Initialise Arrays xa(:)=zero ya(:)=zero ! ! Impose the Correct BC - bcimp=lind + if (itype.eq.itype_ellip) then + lind_2 = -lind + else + lind_2 = lind + end if ! do j=1,zsize(2) + ym=real(zstart(2)+j-1,mytype)*dy do i=1,zsize(1) + xm=real(zstart(1)+i-1,mytype)*dx if(nobjz(i,j).ne.0)then ia=0 do k=1,nobjz(i,j) ! 1st Boundary + ! zm=real(zstart(3)+k-2,mytype)*dz nzpif=npif ia=ia+1 if (ianal.eq.0) then @@ -768,6 +840,12 @@ subroutine cubsplz(u,lind) ! call analitic_z(i,zi(k,i,j),ana_resi,j) ! Calculate the position of BC analytically xa(ia)=ana_resi endif + zm = zi(k,i,j) + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(zi(k,i,j).gt.0.)then ! Immersed Object inxi=0 @@ -810,6 +888,12 @@ subroutine cubsplz(u,lind) !call analitic_z(i,zf(k,i,j),ana_resf,j) ! Calculate the position of BC analytically xa(ia)=ana_resf endif + zm = zi(k,i,j) + point=[xm,ym,zm] + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(zf(k,i,j).lt.zlz)then ! Immersed Object inxf=0 @@ -846,17 +930,17 @@ subroutine cubsplz(u,lind) if (zi(k,i,j).eq.zf(k,i,j)) then !u(i,j,kpol)=bcimp call decomp_2d_abort(1, "!! situation not supported by the IBM !!") - else + else ! Cubic Spline Reconstruction na=ia - do kpol=kpoli,kpolf + do kpol=kpoli,kpolf ! Special Case if (zi(k,i,j).eq.zf(k,i,j)) then u(i,j,kpol)=bcimp else if ((inxf.eq.1).and.(inxi.eq.1)) then ! If the Body Extends from the Front to the Back (Special Case) - u(i,j,kpol)=bcimp - else + u(i,j,kpol)=bcimp + else xpol=dz*(kpol-1) call cubic_spline(xa,ya,na,xpol,ypol) u(i,j,kpol)=ypol @@ -992,9 +1076,9 @@ subroutine ana_y_cyl(i,y_pos,ana_res) ceyy = cey endif if (y_pos.gt.ceyy) then ! Impose analytical BC - ana_res=ceyy + sqrt(ra**2.0-((i+ystart(1)-1-1)*dx-cexx)**2.0) + ana_res=ceyy + sqrt(ra(1)**2.0-((i+ystart(1)-1-1)*dx-cexx)**2.0) else - ana_res=ceyy - sqrt(ra**2.0-((i+ystart(1)-1-1)*dx-cexx)**2.0) + ana_res=ceyy - sqrt(ra(1)**2.0-((i+ystart(1)-1-1)*dx-cexx)**2.0) endif ! return @@ -1023,9 +1107,9 @@ subroutine ana_x_cyl(j,x_pos,ana_res) ceyy = cey endif if (x_pos.gt.cexx) then ! Impose analytical BC - ana_res = cexx + sqrt(ra**2.0-(yp(j+xstart(2)-1)-ceyy)**2.0) + ana_res = cexx + sqrt(ra(1)**2.0-(yp(j+xstart(2)-1)-ceyy)**2.0) else - ana_res = cexx - sqrt(ra**2.0-(yp(j+xstart(2)-1)-ceyy)**2.0) + ana_res = cexx - sqrt(ra(1)**2.0-(yp(j+xstart(2)-1)-ceyy)**2.0) endif ! return diff --git a/src/implicit.f90 b/src/implicit.f90 index ae7e69a40..3b50411d4 100644 --- a/src/implicit.f90 +++ b/src/implicit.f90 @@ -877,16 +877,16 @@ subroutine multmatrix7(td2,ta2,ux2,npaire,cly1,clyn,xcst) ! Check if we are solving momentum or scalars if (cly1.eq.ncly1 .and. clyn.eq.nclyn) then - call deryy(td2,ux2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0, ubcx) + call deryy(td2,ux2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0, 1) !x is 1 else - call deryyS(td2,ux2,di2,sy,sfyS,ssyS,swyS,ysize(1),ysize(2),ysize(3),0, ubcx) + call deryyS(td2,ux2,di2,sy,sfyS,ssyS,swyS,ysize(1),ysize(2),ysize(3),0, 1) endif else ! Check if we are solving momentum or scalars if (cly1.eq.ncly1 .and. clyn.eq.nclyn) then - call deryy(td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, ubcx) + call deryy(td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, 1) else - call deryyS(td2,ux2,di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1, ubcx) + call deryyS(td2,ux2,di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1, 1) endif endif @@ -1024,9 +1024,9 @@ subroutine multmatrix9(td2,ta2,ux2,npaire) elseif ((ncly1.eq.1.or.nclyn.eq.1) .and. npaire.eq.0) then - call deryy(td2,ux2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0, ubcx) + call deryy(td2,ux2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0, 1) !x is 1 else - call deryy(td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, ubcx) + call deryy(td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, 1) endif td2(:,:,:) = xcst * td2(:,:,:) diff --git a/src/les_models.f90 b/src/les_models.f90 index 965d37016..75c706cac 100644 --- a/src/les_models.f90 +++ b/src/les_models.f90 @@ -207,9 +207,9 @@ subroutine smag(nut1,ux1,uy1,uz1) ! gxy= dux/dy; gyy=duy/dy; gzy=duz/dy; ! gxz= dux/dz; gyz=duy/dz; gzz=duz/dz - call derx (gxx1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (gyx1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (gzx1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (gxx1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc + call derx (gyx1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call derx (gzx1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) sxx1(:,:,:) = gxx1(:,:,:) @@ -219,9 +219,9 @@ subroutine smag(nut1,ux1,uy1,uz1) call transpose_x_to_y(uz1,uz2) call transpose_x_to_y(gyx1,ta2) - call dery (gxy2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (gyy2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (gzy2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (gxy2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (gyy2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (gzy2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) sxy2(:,:,:)=half*(gxy2(:,:,:)+ta2(:,:,:)) syy2(:,:,:)=gyy2(:,:,:) @@ -232,9 +232,9 @@ subroutine smag(nut1,ux1,uy1,uz1) call transpose_y_to_z(uz2,uz3) call transpose_y_to_z(gzy2,ta3) - call derz(gxz3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz(gyz3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcz) - call derz(gzz3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz(gxz3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz(gyz3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz(gzz3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) szz3(:,:,:)=gzz3(:,:,:) syz3(:,:,:)=half*(gyz3(:,:,:)+ta3(:,:,:)) @@ -416,17 +416,17 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) ! Initialise the filter call filter(zero) - call filx(ux1f, ta1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,ubcx) !ux1 - call filx(uy1f, tb1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcy) !uy1 - call filx(uz1f, tc1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcz) !uz1 + call filx(ux1f, ta1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,1) !ux1 + call filx(uy1f, tb1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,2) !uy1 + call filx(uz1f, tc1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,3) !uz1 - call filx(uxx1f, uxx1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcx*ubcx) !ux1*ux1 - call filx(uyy1f, uyy1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcy*ubcy) !uy1*uy1 - call filx(uzz1f, uzz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcz*ubcz) !uz1*uz1 + call filx(uxx1f, uxx1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,4) !ux1*ux1 + call filx(uyy1f, uyy1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,5) !uy1*uy1 + call filx(uzz1f, uzz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,6) !uz1*uz1 - call filx(uxy1f, uxy1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,ubcx*ubcy) !ux1*uy1 - call filx(uxz1f, uxz1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,ubcx*ubcz) !ux1*uz1 - call filx(uyz1f, uyz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcy*ubcz) !uy1*uz1 + call filx(uxy1f, uxy1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,7) !ux1*uy1 + call filx(uxz1f, uxz1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,8) !ux1*uz1 + call filx(uyz1f, uyz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,9) !uy1*uz1 if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "filx ux= ", maxval(ta1), maxval(ux1f), maxval(ta1) - maxval(ux1f) @@ -455,17 +455,17 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_x_to_y(uxz1f, th2) call transpose_x_to_y(uyz1f, ti2) - call fily(ux2f, ta2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcx) !ux2 - call fily(uy2f, tb2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,ubcy) !uy2 - call fily(uz2f, tc2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcz) !uz2 + call fily(ux2f, ta2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,1) !ux2 + call fily(uy2f, tb2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,2) !uy2 + call fily(uz2f, tc2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,3) !uz2 - call fily(uxx2f, td2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcx*ubcx) !ux2*ux2 - call fily(uyy2f, te2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcy*ubcy) !uy2*uy2 - call fily(uzz2f, tf2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcz*ubcz) !uz2*uz2 + call fily(uxx2f, td2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,4) !ux2*ux2 + call fily(uyy2f, te2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,5) !uy2*uy2 + call fily(uzz2f, tf2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,6) !uz2*uz2 - call fily(uxy2f, tg2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,ubcx*ubcy) !ux2*uy2 - call fily(uxz2f, th2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcx*ubcz) !ux2*uz2 - call fily(uyz2f, ti2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,ubcy*ubcz) !uy2*uz2 + call fily(uxy2f, tg2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,7) !ux2*uy2 + call fily(uxz2f, th2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,8) !ux2*uz2 + call fily(uyz2f, ti2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,9) !uy2*uz2 if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "fily ux= ", maxval(ta2), maxval(ux2f), maxval(ta2) - maxval(ux2f) @@ -497,17 +497,17 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_y_to_z(uxz2f, th3) call transpose_y_to_z(uyz2f, ti3) - call filz(ux3f, ta3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcx) !ux3 - call filz(uy3f, tb3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcy) !uy3 - call filz(uz3f, tc3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,ubcz) !uz3 + call filz(ux3f, ta3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,1) !ux3 + call filz(uy3f, tb3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,2) !uy3 + call filz(uz3f, tc3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,3) !uz3 - call filz(uxx3f, td3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcx*ubcx) !ux3*ux3 - call filz(uyy3f, te3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcy*ubcy) !uy3*uy3 - call filz(uzz3f, tf3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcz*ubcz) !uz3*uz3 + call filz(uxx3f, td3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,4) !ux3*ux3 + call filz(uyy3f, te3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,5) !uy3*uy3 + call filz(uzz3f, tf3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,6) !uz3*uz3 - call filz(uxy3f, tg3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcx*ubcy) !ux3*uy3 - call filz(uxz3f, th3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,ubcx*ubcz) !ux3*uz3 - call filz(uyz3f, ti3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,ubcy*ubcz) !uy3*uz3 + call filz(uxy3f, tg3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,7) !ux3*uy3 + call filz(uxz3f, th3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,8) !ux3*uz3 + call filz(uyz3f, ti3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,9) !uy3*uz3 if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "filz ux= ", maxval(ta3), maxval(ux3f), maxval(ta3) - maxval(ux3f) @@ -561,9 +561,9 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) lxz1 = uxz1f - ux1f * uz1f lyz1 = uyz1f - uy1f * uz1f - call derx (gxx1f, ux1f, di1, sx, ffx, fsx, fwx, xsize(1), xsize(2), xsize(3), 0,ubcx) - call derx (gyx1f, uy1f, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1,ubcy) - call derx (gzx1f, uz1f, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1,ubcz) + call derx (gxx1f, ux1f, di1, sx, ffx, fsx, fwx, xsize(1), xsize(2), xsize(3), 0,1) + call derx (gyx1f, uy1f, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1,2) + call derx (gzx1f, uz1f, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1,3) sxx1f = gxx1f @@ -573,9 +573,9 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_x_to_y(uz1f, uz2f) call transpose_x_to_y(gyx1f, ta2) - call dery (gxy2f, ux2f, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,ubcx) - call dery (gyy2f, uy2f, di2, sy, ffy, fsy, fwy, ppy, ysize(1), ysize(2), ysize(3), 0,ubcy) - call dery (gzy2f, uz2f, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,ubcz) + call dery (gxy2f, ux2f, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,1) + call dery (gyy2f, uy2f, di2, sy, ffy, fsy, fwy, ppy, ysize(1), ysize(2), ysize(3), 0,2) + call dery (gzy2f, uz2f, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,3) sxy2f = half * (gxy2f + ta2) syy2f = gyy2f @@ -586,9 +586,9 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_y_to_z(uz2f, uz3f) call transpose_y_to_z(gzy2f, ta3) - call derz(gxz3f, ux3f, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1,ubcx) - call derz(gyz3f, uy3f, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1,ubcy) - call derz(gzz3f, uz3f, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0,ubcz) + call derz(gxz3f, ux3f, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1,1) + call derz(gyz3f, uy3f, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1,2) + call derz(gzz3f, uz3f, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0,3) szz3f = gzz3f syz3f = half * (gyz3f + ta3) @@ -690,13 +690,13 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) !Need to filter Aij components - call filx(axx1f, axx1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) - call filx(ayy1f, ayy1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) - call filx(azz1f, azz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + call filx(axx1f, axx1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + call filx(ayy1f, ayy1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) + call filx(azz1f, azz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) - call filx(axy1f, axy1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx(axz1f, axz1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx(ayz1f, ayz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + call filx(axy1f, axy1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx(axz1f, axz1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) + call filx(ayz1f, ayz1, di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,0) if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "filx axx1= ", maxval(axx1), maxval(axx1f), maxval(axx1) - maxval(axx1f) @@ -718,13 +718,13 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_x_to_y(axz1f, te2) call transpose_x_to_y(ayz1f, tf2) - call fily(axx2f, ta2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) - call fily(ayy2f, tb2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) - call fily(azz2f, tc2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + call fily(axx2f, ta2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + call fily(ayy2f, tb2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + call fily(azz2f, tc2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) - call fily(axy2f, td2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily(axz2f, te2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) - call fily(ayz2f, tf2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) + call fily(axy2f, td2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) + call fily(axz2f, te2, di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,0) + call fily(ayz2f, tf2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "fily axx2= ", maxval(ta2), maxval(axx2f), maxval(ta2) - maxval(axx2f) @@ -750,13 +750,13 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) call transpose_y_to_z(ayz2f, tf3) - call filz(axx3f, ta3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) - call filz(ayy3f, tb3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) - call filz(azz3f, tc3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + call filz(axx3f, ta3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + call filz(ayy3f, tb3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + call filz(azz3f, tc3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) - call filz(axy3f, td3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) - call filz(axz3f, te3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz(ayz3f, tf3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) + call filz(axy3f, td3, di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,0) + call filz(axz3f, te3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) + call filz(ayz3f, tf3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "filz axx3= ", maxval(ta3), maxval(axx3f), maxval(ta3) - maxval(axx3f) @@ -829,13 +829,13 @@ subroutine dynsmag(nut1,ux1,uy1,uz1,ep1) enddo !FILTERING THE NON-CONSTANT CONSTANT - call filx(smagC1f, smagC1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) + call filx(smagC1f, smagC1, di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,0) call transpose_x_to_y(smagC1f, ta2) - call fily(smagC2f, ta2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) + call fily(smagC2f, ta2, di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,0) call transpose_y_to_z(smagC2f, ta3) - call filz(smagC3f, ta3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) + call filz(smagC3f, ta3, di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,0) if (mod(itime, ilist) == 0) then if (nrank==0) write(*,*) "filx smagC1= ", maxval(smagC1), maxval(smagC1f), maxval(smagC1) - maxval(smagC1f) @@ -949,9 +949,9 @@ subroutine wale(nut1,ux1,uy1,uz1) ! gxy= dux/dy; gyy=duy/dy; gzy=duz/dy; ! gxz= dux/dz; gyz=duy/dz; gzz=duz/dz - call derx (gxx1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (gyx1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (gzx1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (gxx1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx + call derx (gyx1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy + call derx (gzx1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz sxx1(:,:,:) = gxx1(:,:,:) @@ -961,9 +961,9 @@ subroutine wale(nut1,ux1,uy1,uz1) call transpose_x_to_y(uz1,uz2) call transpose_x_to_y(gyx1,ta2) - call dery (gxy2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (gyy2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (gzy2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (gxy2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call dery (gyy2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call dery (gzy2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) syy2(:,:,:)=gyy2(:,:,:) sxy2(:,:,:)=half*(gxy2(:,:,:)+ta2(:,:,:)) @@ -975,9 +975,9 @@ subroutine wale(nut1,ux1,uy1,uz1) call transpose_y_to_z(uz2,uz3) call transpose_y_to_z(gzy2,ta3) - call derz(gxz3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz(gyz3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz(gzz3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz(gxz3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derz(gyz3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derz(gzz3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) szz3(:,:,:)=gzz3(:,:,:) syz3(:,:,:)=half*(gyz3(:,:,:)+ta3(:,:,:)) @@ -1122,11 +1122,11 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) sgsx2=zero; sgsy2=zero; sgsz2=zero sgsx3=zero; sgsy3=zero; sgsz3=zero !WORK X-PENCILS - call derx (ta1,nut1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,zero) + call derx (ta1,nut1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,0) - call derxx (td1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (te1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,zero) - call derxx (tf1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,zero) + call derxx (td1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,0) + call derxx (te1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,0) + call derxx (tf1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,0) sgsx1 = td1 * nut1 + two * sxx1 * ta1 sgsy1 = te1 * nut1 + two * sxy1 * ta1 @@ -1147,14 +1147,14 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) call transpose_x_to_y(uy1, uy2) call transpose_x_to_y(uz1, uz2) - call dery (ta2, nut2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,zero) + call dery (ta2, nut2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,0) !-->for ux td2 = zero iimplicit = -iimplicit if (istret.ne.0) then - call deryy (td2, ux2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,ubcx) - call dery (te2, ux2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,ubcx) + call deryy (td2, ux2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,1) + call dery (te2, ux2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,1) do k = 1, ysize(3) do j = 1, ysize(2) do i = 1, ysize(1) @@ -1163,14 +1163,14 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) enddo enddo else - call deryy (td2, ux2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,ubcx) + call deryy (td2, ux2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,1) endif !-->for uy te2 = zero if (istret.ne.0) then - call deryy (te2, uy2, di2, sy, sfy, ssy, swy, ysize(1), ysize(2), ysize(3), 0,ubcy) - call dery (tf2, uy2, di2, sy, ffy, fsy, fwy, ppy, ysize(1), ysize(2), ysize(3), 0,ubcy) + call deryy (te2, uy2, di2, sy, sfy, ssy, swy, ysize(1), ysize(2), ysize(3), 0,2) + call dery (tf2, uy2, di2, sy, ffy, fsy, fwy, ppy, ysize(1), ysize(2), ysize(3), 0,2) do k = 1, ysize(3) do j = 1, ysize(2) do i = 1, ysize(1) @@ -1179,14 +1179,14 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) enddo enddo else - call deryy (te2, uy2, di2, sy, sfy, ssy, swy, ysize(1), ysize(2), ysize(3), 0,ubcy) + call deryy (te2, uy2, di2, sy, sfy, ssy, swy, ysize(1), ysize(2), ysize(3), 0,2) endif !-->for uz tf2 = zero if (istret.ne.0) then - call deryy (tf2, uz2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,ubcz) - call dery (tj2, uz2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,ubcz) + call deryy (tf2, uz2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,3) + call dery (tj2, uz2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1,3) do k = 1, ysize(3) do j = 1, ysize(2) do i = 1, ysize(1) @@ -1195,7 +1195,7 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) enddo enddo else - call deryy (tf2, uz2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,ubcz) + call deryy (tf2, uz2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1,3) endif iimplicit = -iimplicit @@ -1215,11 +1215,11 @@ subroutine sgs_mom_nonconservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1,ep1) call transpose_y_to_z(uy2, uy3) call transpose_y_to_z(uz2, uz3) - call derz (ta3, nut3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz (ta3, nut3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) - call derzz (td3, ux3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, ubcx) - call derzz (te3, uy3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, ubcy) - call derzz (tf3, uz3, di3, sz, sfz, ssz, swz, zsize(1), zsize(2), zsize(3), 0, ubcz) + call derzz (td3, ux3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, 1) + call derzz (te3, uy3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, 2) + call derzz (tf3, uz3, di3, sz, sfz, ssz, swz, zsize(1), zsize(2), zsize(3), 0, 3) sgsx3 = sgsx3 + nut3 * td3 + two * sxz3 * ta3 sgsy3 = sgsy3 + nut3 * te3 + two * syz3 * ta3 @@ -1274,25 +1274,25 @@ subroutine sgs_scalar_nonconservative(sgsphi1,nut1,phi1,is) sgsphi1 = zero; sgsphi2 = zero; sgsphi3 = zero - call derxS (dnut1, nut1, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, zero) + call derxS (dnut1, nut1, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, 0) call transpose_x_to_y(nut1, nut2) - call deryS (dnut2, nut2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call deryS (dnut2, nut2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, 0) call transpose_y_to_z(nut2, nut3) - call derzS (dnut3, nut3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, zero) + call derzS (dnut3, nut3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, 0) ! kappat = nut/Pr Pr = Sc(is) - call derxS (tb1, phi1, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, zero) - call derxxS(tc1, phi1, di1, sx, sfxpS, ssxpS, swxpS, xsize(1), xsize(2), xsize(3), 1, zero) + call derxS (tb1, phi1, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, 0) + call derxxS(tc1, phi1, di1, sx, sfxpS, ssxpS, swxpS, xsize(1), xsize(2), xsize(3), 1, 0) sgsphi1 = tb1 * (dnut1/Pr) + tc1 * (nut1/Pr) call transpose_x_to_y(phi1, phi2) call transpose_x_to_y(sgsphi1, sgsphi2) - call deryS (tb2, phi2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call deryS (tb2, phi2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, 0) iimplicit = - iimplicit - call deryyS(tc2, phi2, di2, sy, sfypS, ssypS, swypS, ysize(1), ysize(2), ysize(3), 1, zero) + call deryyS(tc2, phi2, di2, sy, sfypS, ssypS, swypS, ysize(1), ysize(2), ysize(3), 1, 0) iimplicit = - iimplicit if (istret.ne.0) then do k = 1, ysize(3) @@ -1308,8 +1308,8 @@ subroutine sgs_scalar_nonconservative(sgsphi1,nut1,phi1,is) call transpose_y_to_z(phi2, phi3) call transpose_y_to_z(sgsphi2, sgsphi3) - call derzS (tb3, phi3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, zero) - call derzzS(tc3, phi3, di3, sz, sfzpS, sszpS, swzpS, zsize(1), zsize(2), zsize(3), 1, zero) + call derzS (tb3, phi3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, 0) + call derzzS(tc3, phi3, di3, sz, sfzpS, sszpS, swzpS, zsize(1), zsize(2), zsize(3), 1, 0) sgsphi3 = sgsphi3 + tb3 * (dnut3/Pr) + tc3 * (nut3/Pr) call transpose_z_to_y(sgsphi3, sgsphi2) @@ -1389,9 +1389,9 @@ subroutine sgs_mom_conservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1) sgsx3=zero; sgsy3=zero; sgsz3=zero ! WORK X-PENCILS - call derx (sgsx1,td1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,zero) - call derx (sgsy1,te1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,zero) - call derx (sgsz1,tf1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,zero) + call derx (sgsx1,td1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,0) !zero) + call derx (sgsy1,te1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,0) !zero) + call derx (sgsz1,tf1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,0) !zero) !call filter(0.48d0) !call filx(taf1,ta1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) @@ -1413,9 +1413,9 @@ subroutine sgs_mom_conservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1) call transpose_x_to_y(sgsy1, sgsy2) call transpose_x_to_y(sgsz1, sgsz2) - call dery (ta2,te2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call dery (tb2,tg2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) - call dery (tc2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,zero) + call dery (ta2,te2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,0) !zero) + call dery (tb2,tg2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) !zero) + call dery (tc2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,0) !zero) !call fily(taf2,ta2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) !call fily(tbf2,tb2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) @@ -1433,9 +1433,9 @@ subroutine sgs_mom_conservative(sgsx1,sgsy1,sgsz1,ux1,uy1,uz1,nut1) call transpose_y_to_z(th2, th3) call transpose_y_to_z(ti2, ti3) - call derz (ta3, tf3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, zero) - call derz (tb3, th3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, zero) - call derz (tc3, ti3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, zero) + call derz (ta3, tf3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, 0) !zero) + call derz (tb3, th3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, 0) !zero) + call derz (tc3, ti3, di3, sz, ffz, fsz, fwz, zsize(1), zsize(2), zsize(3), 0, 0) !zero) !call filz(taf3,ta3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) !call filz(tbf3,tb3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) diff --git a/src/mhd.f90 b/src/mhd.f90 index 0bdc47dc0..e4b165e7c 100644 --- a/src/mhd.f90 +++ b/src/mhd.f90 @@ -280,9 +280,9 @@ function grad_vmesh(phi) result(dphi) call transpose_x_to_y(phi,ta2) call transpose_y_to_z(ta2,ta3) ! - call derxS (ta1, phi, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, zero) - call deryS (tb2, ta2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, zero) - call derzS (tb3, ta3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, zero) + call derxS (ta1, phi, di1, sx, ffxpS, fsxpS, fwxpS, xsize(1), xsize(2), xsize(3), 1, 0) !zero) + call deryS (tb2, ta2, di2, sy, ffypS, fsypS, fwypS, ppy, ysize(1), ysize(2), ysize(3), 1, 0) !zero) + call derzS (tb3, ta3, di3, sz, ffzpS, fszpS, fwzpS, zsize(1), zsize(2), zsize(3), 1, 0) !zero) ! dphi(:,:,:,1)=ta1 ! @@ -508,16 +508,16 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) tc1(:,:,:) = ux1(:,:,:) * Bsum(:,:,:,3) - Bsum(:,:,:,1) * uz1(:,:,:) td1 = zero !call derx (td1,ta1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcx*ubcx) ! always zero - call derx (te1,tb1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx*ubcy) - call derx (tf1,tc1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx*ubcz) + call derx (te1,tb1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,7) !ubcx*ubcy + call derx (tf1,tc1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,8) !ubcx*ubcz - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz ! - call derx (tx1,Bsum(:,:,:,1),di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (ty1,Bsum(:,:,:,2),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tz1,Bsum(:,:,:,3),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (tx1,Bsum(:,:,:,1),di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx + call derx (ty1,Bsum(:,:,:,2),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy + call derx (tz1,Bsum(:,:,:,3),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz ! Convective terms of x-pencil are stored in tg1,th1,ti1 @@ -546,17 +546,17 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) te2(:,:,:) = zero !uy2(:,:,:)*by2(:,:,:) - by2(:,:,:)*uy2(:,:,:) ! always zero tf2(:,:,:) = uy2(:,:,:)*bz2(:,:,:) - by2(:,:,:)*uz2(:,:,:) - call dery (tg2,td2,di2,sy,ffy, fsy, fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcx*ubcy) + call dery (tg2,td2,di2,sy,ffy, fsy, fwy,ppy,ysize(1),ysize(2),ysize(3),0,7) !ubcx*ubcy th2 = zero !call dery (th2,te2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcy*ubcy) ! always zero - call dery (ti2,tf2,di2,sy,ffy, fsy, fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcz*ubcy) + call dery (ti2,tf2,di2,sy,ffy, fsy, fwy,ppy,ysize(1),ysize(2),ysize(3),0,9) !ubcz*ubcy - call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (te2,uy2,di2,sy,ffy, fsy ,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx + call dery (te2,uy2,di2,sy,ffy, fsy ,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz - call dery (tx2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (ty2,by2,di2,sy,ffy, fsy ,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tz2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (tx2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx + call dery (ty2,by2,di2,sy,ffy, fsy ,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy + call dery (tz2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz ! Convective terms of y-pencil in tg2,th2,ti2 @@ -584,17 +584,17 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) tf3(:,:,:) = zero !uz3(:,:,:)*bz3(:,:,:) - bz3(:,:,:)*uz3(:,:,:) ! always zero - call derz (tg3,td3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcx*ubcz) - call derz (th3,te3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcy*ubcz) + call derz (tg3,td3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,8) !ubcx*ubcz + call derz (th3,te3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,9) !ubcy*ubcz ti3 = zero !call derz (ti3,tf3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcz*ubcz) ! always zero - call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx + call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy + call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz - call derz (tx3,bx3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (ty3,by3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tz3,bz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (tx3,bx3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx + call derz (ty3,by3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy + call derz (tz3,bz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,2) !ubcz ! Convective terms of z-pencil in ta3,tb3,tc3 @@ -609,9 +609,9 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) tf3(:,:,:) = tc3(:,:,:) !DIFFUSIVE TERMS IN Z - call derzz (ta3,cx3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derzz (tb3,cy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derzz (tc3,cz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,ubcz) + call derzz (ta3,cx3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call derzz (tb3,cy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call derzz (tc3,cz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,3) !ubcz) ! Add convective and diffusive terms of z-pencil (half for skew-symmetric) @@ -634,9 +634,9 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) !DIFFUSIVE TERMS IN Y !-->for ux - call deryy (td2,cx2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcx) + call deryy (td2,cx2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,1) !ubcx) if (istret.ne.0) then - call dery (te2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) + call dery (te2,bx2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !ubcx) do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -647,9 +647,9 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) endif !-->for uy - call deryy (te2,cy2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0,ubcy) + call deryy (te2,cy2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) if (istret.ne.0) then - call dery (tf2,by2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) + call dery (tf2,by2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -660,9 +660,9 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) endif !-->for uz - call deryy (tf2,cz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcz) + call deryy (tf2,cz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,3) !ubcz) if (istret.ne.0) then - call dery (tj2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (tj2,bz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !ubcz) do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -683,9 +683,9 @@ subroutine mhd_rhs_eq(dB,B,B0,ux1,uy1,uz1) call transpose_y_to_x(tc2,tc1) !diff+conv. terms !DIFFUSIVE TERMS IN X - call derxx (td1,B(:,:,:,1),di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,ubcx) - call derxx (te1,B(:,:,:,2),di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derxx (tf1,B(:,:,:,3),di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derxx (td1,B(:,:,:,1),di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call derxx (te1,B(:,:,:,2),di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call derxx (tf1,B(:,:,:,3),di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) td1(:,:,:) = rrem * td1(:,:,:) te1(:,:,:) = rrem * te1(:,:,:) diff --git a/src/module_param.f90 b/src/module_param.f90 index db7eb8abd..7c63620b7 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -139,7 +139,7 @@ SUBROUTINE DERIVATIVE_X(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(ny,nz):: s real(mytype), dimension(nx):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE DERIVATIVE_X SUBROUTINE DERIVATIVE_Y(t,u,r,s,ff,fs,fw,pp,nx,ny,nz,npaire,lind) use decomp_2d_constants, only : mytype @@ -147,7 +147,7 @@ SUBROUTINE DERIVATIVE_Y(t,u,r,s,ff,fs,fw,pp,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(nx,nz):: s real(mytype), dimension(ny):: ff,fs,fw,pp - real(mytype) :: lind + integer :: lind END SUBROUTINE DERIVATIVE_Y SUBROUTINE DERIVATIVE_YY(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) use decomp_2d_constants, only : mytype @@ -155,7 +155,7 @@ SUBROUTINE DERIVATIVE_YY(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(nx,nz):: s real(mytype), dimension(ny):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE DERIVATIVE_YY SUBROUTINE DERIVATIVE_Z(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) use decomp_2d_constants, only : mytype @@ -163,7 +163,7 @@ SUBROUTINE DERIVATIVE_Z(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(nx,ny):: s real(mytype), dimension(nz):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE DERIVATIVE_Z END INTERFACE @@ -193,7 +193,7 @@ END SUBROUTINE DERIVATIVE_Z procedure (DERIVATIVE_Y), pointer :: deryBz procedure (DERIVATIVE_YY), pointer :: deryyBz procedure (DERIVATIVE_Z), pointer :: derzBz, derzzBz - + !O6SVV real(mytype),allocatable,dimension(:) :: newsm,newtm,newsmt,newtmt !real(mytype),allocatable,dimension(:) :: newrm,ttm,newrmt,ttmt @@ -206,7 +206,7 @@ SUBROUTINE FILTER_X(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(ny,nz):: s real(mytype), dimension(nx):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE FILTER_X SUBROUTINE FILTER_Y(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) use decomp_2d_constants, only : mytype @@ -214,7 +214,7 @@ SUBROUTINE FILTER_Y(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(nx,nz):: s real(mytype), dimension(ny):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE FILTER_Y SUBROUTINE FILTER_Z(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) use decomp_2d_constants, only : mytype @@ -222,7 +222,7 @@ SUBROUTINE FILTER_Z(t,u,r,s,ff,fs,fw,nx,ny,nz,npaire,lind) real(mytype), dimension(nx,ny,nz) :: t,u,r real(mytype), dimension(nx,ny):: s real(mytype), dimension(nz):: ff,fs,fw - real(mytype) :: lind + integer :: lind END SUBROUTINE FILTER_Z END INTERFACE @@ -303,14 +303,18 @@ module param itype_channel = 3, & itype_hill = 4, & itype_cyl = 5, & + itype_dbg = 6, & itype_mixlayer = 7, & + itype_jet = 8, & itype_tbl = 9, & itype_abl = 10, & itype_uniform = 11, & itype_sandbox = 12, & itype_cavity = 13, & itype_pipe = 14, & - itype_ptbl = 15 + itype_ptbl = 15, & + itype_ellip = 16 + integer :: cont_phi,itr,itime,itest,iprocessing integer :: ifft,istret,iforc_entree,iturb @@ -549,7 +553,7 @@ module complex_geometry integer ,allocatable,dimension(:,:) :: nobjx,nobjy,nobjz integer ,allocatable,dimension(:,:,:) :: nxipif,nxfpif,nyipif,nyfpif,nzipif,nzfpif real(mytype),allocatable,dimension(:,:,:) :: xi,xf,yi,yf,zi,zf - real(mytype),allocatable,dimension(:,:,:) :: xepsi, yepsi, zepsi + real(mytype),allocatable,dimension(:,:,:) :: xepsi, yepsi, zepsi integer :: nxraf,nyraf,nzraf,nraf,nobjmax end module complex_geometry !############################################################################ @@ -661,10 +665,13 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d_constants, only : mytype - real(mytype) :: cex,cey,cez,ra,rai,rao,ubcx,ubcy,ubcz,rads, c_air - real(mytype) :: chord,thickness,omega + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,rai,rao,ubcx,ubcy,ubcz,rads,c_air,cvl_scalar,grav_y,grav_x,grav_z + real(mytype) :: position(10,3),orientation(10,4),linearVelocity(10,3),angularVelocity(10,4),linearAcceleration(3),linearForce(10,3),torque(10,3),shape(10,3) + real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4),ra(10),rho_s(10),ellip_m(10),inertia(10,3,3) + real(mytype) :: chord,thickness,omega, tconv2_sign, shear_velocity + real(mytype) :: ce(30),sh(30),ori(40), lv(30), av(30) integer :: inana ! Analytical BC as Input - integer :: imove + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug, torq_flip, ztorq_only, nbody, inviscid_output, div_visu_flag end module ibm_param !############################################################################ !############################################################################ diff --git a/src/navier.f90 b/src/navier.f90 index 9d2120487..cec203839 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -12,7 +12,7 @@ module navier private - public :: solve_poisson, divergence, calc_divu_constraint + public :: solve_poisson, divergence,divergence2, calc_divu_constraint public :: pre_correc, cor_vel public :: lmn_t_to_rho_trans, momentum_to_velocity, velocity_to_momentum public :: gradp, tbl_flrt @@ -24,7 +24,7 @@ module navier !! DESCRIPTION: Takes the intermediate momentum field as input, !! computes div and solves pressure-Poisson equation. !############################################################################ - SUBROUTINE solve_poisson(pp3, px1, py1, pz1, rho1, ux1, uy1, uz1, ep1, drho1, divu3) + SUBROUTINE solve_poisson(div_visu_var, pp3, px1, py1, pz1, rho1, ux1, uy1, uz1, ep1, drho1, divu3) USE decomp_2d_poisson, ONLY : poisson USE var, ONLY : nzmsize @@ -43,7 +43,7 @@ SUBROUTINE solve_poisson(pp3, px1, py1, pz1, rho1, ux1, uy1, uz1, ep1, drho1, di REAL(mytype), DIMENSION(zsize(1), zsize(2), zsize(3)), INTENT(IN) :: divu3 !! Outputs - REAL(mytype), DIMENSION(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress) :: pp3 + REAL(mytype), DIMENSION(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress) :: pp3, div_visu_var REAL(mytype), DIMENSION(xsize(1), xsize(2), xsize(3)) :: px1, py1, pz1 !! Locals @@ -73,7 +73,7 @@ SUBROUTINE solve_poisson(pp3, px1, py1, pz1, rho1, ux1, uy1, uz1, ep1, drho1, di CALL momentum_to_velocity(rho1, ux1, uy1, uz1) ENDIF - call divergence(pp3(:,:,:,1),rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) + call divergence(div_visu_var(:,:,:,1),pp3(:,:,:,1),rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) IF (ilmn.AND.ivarcoeff) THEN dv3(:,:,:) = pp3(:,:,:,1) ENDIF @@ -254,7 +254,7 @@ end subroutine cor_vel ! output : pp3 (on pressure mesh) !written by SL 2018 !############################################################################ - subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) + subroutine divergence (div_visu_var,pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) USE param USE variables @@ -263,6 +263,7 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) duxydxyp3, uzp3, po3, dipp3, nxmsize, nymsize, nzmsize USE MPI USE ibm_param + USE ellipsoid_utils, ONLY: navierFieldGen implicit none @@ -274,7 +275,10 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) real(mytype),dimension(xsize(1),xsize(2),xsize(3),nrhotime),intent(in) :: rho1 !Z PENCILS NXM NYM NZ -->NXM NYM NZM real(mytype),dimension(zsize(1),zsize(2),zsize(3)),intent(in) :: divu3 - real(mytype),dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize),intent(out) :: pp3 + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1_ux,ep1_uy,ep1_uz + real(mytype),dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize),intent(out) :: pp3,div_visu_var + ! real(mytype),dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize) :: div_visu_var + integer :: nvect3,i,j,k,nlock integer :: code @@ -286,6 +290,11 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) ta1(:,:,:) = ux1(:,:,:) tb1(:,:,:) = uy1(:,:,:) tc1(:,:,:) = uz1(:,:,:) + else if (itype.eq.itype_ellip) then + call navierFieldGen(ep1, ep1_ux, ep1_uy, ep1_uz) + ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ep1_ux(:,:,:) + tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ep1_uy(:,:,:) + tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ep1_uz(:,:,:) else ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ubcx tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ubcy @@ -339,7 +348,7 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) pp3(:,:,:) = pp3(:,:,:) + po3(:,:,:) if (nlock==2) then - ! Line below sometimes generates issues with Intel + ! Line below sometimes generates issues with Intel !pp3(:,:,:)=pp3(:,:,:)-pp3(ph1%zst(1),ph1%zst(2),nzmsize) ! Using a tmp variable seems to sort the issue pres_ref = pp3(ph1%zst(1),ph1%zst(2),nzmsize) @@ -368,8 +377,138 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) endif endif + div_visu_var(:,:,:)=pp3(:,:,:) + return end subroutine divergence + + subroutine divergence2(pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) + + USE param + USE variables + USE var, ONLY: ta1, tb1, tc1, pp1, pgy1, pgz1, di1, & + duxdxp2, uyp2, uzp2, duydypi2, upi2, ta2, dipp2, & + duxydxyp3, uzp3, po3, dipp3, nxmsize, nymsize, nzmsize + USE MPI + USE ibm_param + USE ellipsoid_utils, ONLY: navierFieldGen + + implicit none + + ! TYPE(DECOMP_INFO) :: ph1,ph3,ph4 + + !X PENCILS NX NY NZ -->NXM NY NZ + real(mytype),dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ux1,uy1,uz1,ep1 + real(mytype),dimension(xsize(1),xsize(2),xsize(3),ntime),intent(in) :: drho1 + real(mytype),dimension(xsize(1),xsize(2),xsize(3),nrhotime),intent(in) :: rho1 + !Z PENCILS NXM NYM NZ -->NXM NYM NZM + real(mytype),dimension(zsize(1),zsize(2),zsize(3)),intent(in) :: divu3 + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1_ux,ep1_uy,ep1_uz + real(mytype),dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize),intent(out) :: pp3 + real(mytype),dimension(ph1%zst(1):ph1%zen(1),ph1%zst(2):ph1%zen(2),nzmsize) :: div_visu_var + + + integer :: nvect3,i,j,k,nlock + integer :: code + real(mytype) :: tmax,tmoy,pres_ref + + nvect3=(ph1%zen(1)-ph1%zst(1)+1)*(ph1%zen(2)-ph1%zst(2)+1)*nzmsize + + if (iibm.eq.0) then + ta1(:,:,:) = ux1(:,:,:) + tb1(:,:,:) = uy1(:,:,:) + tc1(:,:,:) = uz1(:,:,:) + else if (itype.eq.itype_ellip) then + call navierFieldGen(ep1, ep1_ux, ep1_uy, ep1_uz) + ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ep1_ux(:,:,:) + tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ep1_uy(:,:,:) + tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ep1_uz(:,:,:) + else + ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ubcx + tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ubcy + tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ubcz + endif + + !WORK X-PENCILS + + call derxvp(pp1,ta1,di1,sx,cfx6,csx6,cwx6,xsize(1),nxmsize,xsize(2),xsize(3),0) + + if (ilmn.and.(nlock.gt.0)) then + if ((nlock.eq.1).and.(.not.ivarcoeff)) then + !! Approximate -div(rho u) using ddt(rho) + call extrapol_drhodt(ta1, rho1, drho1) + elseif ((nlock.eq.2).or.ivarcoeff) then + !! Need to check our error against divu constraint + !! Or else we are solving the variable-coefficient Poisson equation + call transpose_z_to_y(-divu3, ta2) + call transpose_y_to_x(ta2, ta1) + endif + call interxvp(pgy1,ta1,di1,sx,cifxp6,cisxp6,ciwxp6,xsize(1),nxmsize,xsize(2),xsize(3),1) + pp1(:,:,:) = pp1(:,:,:) + pgy1(:,:,:) + endif + + call interxvp(pgy1,tb1,di1,sx,cifxp6,cisxp6,ciwxp6,xsize(1),nxmsize,xsize(2),xsize(3),1) + call interxvp(pgz1,tc1,di1,sx,cifxp6,cisxp6,ciwxp6,xsize(1),nxmsize,xsize(2),xsize(3),1) + + call transpose_x_to_y(pp1,duxdxp2,ph4)!->NXM NY NZ + call transpose_x_to_y(pgy1,uyp2,ph4) + call transpose_x_to_y(pgz1,uzp2,ph4) + + !WORK Y-PENCILS + call interyvp(upi2,duxdxp2,dipp2,sy,cifyp6,cisyp6,ciwyp6,(ph1%yen(1)-ph1%yst(1)+1),ysize(2),nymsize,ysize(3),1) + call deryvp(duydypi2,uyp2,dipp2,sy,cfy6,csy6,cwy6,ppyi,(ph1%yen(1)-ph1%yst(1)+1),ysize(2),nymsize,ysize(3),0) + + !! Compute sum dudx + dvdy + duydypi2(:,:,:) = duydypi2(:,:,:) + upi2(:,:,:) + + call interyvp(upi2,uzp2,dipp2,sy,cifyp6,cisyp6,ciwyp6,(ph1%yen(1)-ph1%yst(1)+1),ysize(2),nymsize,ysize(3),1) + + call transpose_y_to_z(duydypi2,duxydxyp3,ph3)!->NXM NYM NZ + call transpose_y_to_z(upi2,uzp3,ph3) + + !WORK Z-PENCILS + call interzvp(pp3,duxydxyp3,dipp3,sz,cifzp6,ciszp6,ciwzp6,(ph1%zen(1)-ph1%zst(1)+1),& + (ph1%zen(2)-ph1%zst(2)+1),zsize(3),nzmsize,1) + call derzvp(po3,uzp3,dipp3,sz,cfz6,csz6,cwz6,(ph1%zen(1)-ph1%zst(1)+1),& + (ph1%zen(2)-ph1%zst(2)+1),zsize(3),nzmsize,0) + + !! Compute sum dudx + dvdy + dwdz + pp3(:,:,:) = pp3(:,:,:) + po3(:,:,:) + + if (nlock==2) then + ! Line below sometimes generates issues with Intel + !pp3(:,:,:)=pp3(:,:,:)-pp3(ph1%zst(1),ph1%zst(2),nzmsize) + ! Using a tmp variable seems to sort the issue + pres_ref = pp3(ph1%zst(1),ph1%zst(2),nzmsize) + pp3(:,:,:)=pp3(:,:,:)-pres_ref + endif + + tmax=-1609._mytype + tmoy=zero + do k=1,nzmsize + do j=ph1%zst(2),ph1%zen(2) + do i=ph1%zst(1),ph1%zen(1) + if (pp3(i,j,k).gt.tmax) tmax=pp3(i,j,k) + tmoy=tmoy+abs(pp3(i,j,k)) + enddo + enddo + enddo + tmoy=tmoy/real(nvect3,mytype) + call MPI_ALLREDUCE(MPI_IN_PLACE, tmoy, 1, real_type, MPI_SUM, MPI_COMM_WORLD, code) + call MPI_ALLREDUCE(MPI_IN_PLACE, tmax, 1, real_type, MPI_MAX, MPI_COMM_WORLD, code) + + if ((nrank == 0) .and. (nlock > 0).and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then + if (nlock == 2) then + write(*,*) 'DIV U max mean=',real(tmax,mytype),real(tmoy/real(nproc),mytype) + else + write(*,*) 'DIV U* max mean=',real(tmax,mytype),real(tmoy/real(nproc),mytype) + endif + endif + + div_visu_var(:,:,:)=pp3(:,:,:) + + return + end subroutine divergence2 !############################################################################ !subroutine GRADP !Computation of the pressure gradient from the pressure mesh to the @@ -624,9 +763,9 @@ subroutine pre_correc(ux,uy,uz,ep) if (mhd_active) then do k=1,xsize(3) do i=1,xsize(1) - ux(i,1,k)=byx1(i,k) + ux(i,1,k)=byx1(i,k) uy(i,1,k)=byy1(i,k) - uz(i,1,k)=byz1(i,k) + uz(i,1,k)=byz1(i,k) enddo enddo else @@ -654,9 +793,9 @@ subroutine pre_correc(ux,uy,uz,ep) if (mhd_active) then do k=1,xsize(3) do i=1,xsize(1) - ux(i,xsize(2),k)=byxn(i,k) + ux(i,xsize(2),k)=byxn(i,k) uy(i,xsize(2),k)=byyn(i,k) - uz(i,xsize(2),k)=byzn(i,k) + uz(i,xsize(2),k)=byzn(i,k) enddo enddo else @@ -672,9 +811,9 @@ subroutine pre_correc(ux,uy,uz,ep) if (mhd_active) then do k=1,xsize(3) do i=1,xsize(1) - ux(i,xsize(2),k)=byxn(i,k) + ux(i,xsize(2),k)=byxn(i,k) uy(i,xsize(2),k)=byyn(i,k) - uz(i,xsize(2),k)=byzn(i,k) + uz(i,xsize(2),k)=byzn(i,k) enddo enddo else @@ -889,7 +1028,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) !! We need temperature CALL calc_temp_eos(ta1, rho1(:,:,:,1), phi1, tb1, xsize(1), xsize(2), xsize(3)) - CALL derxx (tb1, ta1, di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, zero) + CALL derxx (tb1, ta1, di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, 0) IF (imultispecies) THEN tb1(:,:,:) = (xnu / prandtl) * tb1(:,:,:) / ta1(:,:,:) @@ -904,7 +1043,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) DO is = 1, numscalar IF (massfrac(is)) THEN - CALL derxx (tc1, phi1(:,:,:,is), di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, zero) + CALL derxx (tc1, phi1(:,:,:,is), di1, sx, sfxp, ssxp, swxp, xsize(1), xsize(2), xsize(3), 1, 0) tb1(:,:,:) = tb1(:,:,:) + (xnu / sc(is)) * (td1(:,:,:) / mol_weight(is)) * tc1(:,:,:) ENDIF ENDDO @@ -924,7 +1063,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) !! Y-pencil tmp = iimplicit iimplicit = 0 - CALL deryy (tc2, ta2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1, zero) + CALL deryy (tc2, ta2, di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1, 0) iimplicit = tmp IF (imultispecies) THEN tc2(:,:,:) = (xnu / prandtl) * tc2(:,:,:) / ta2(:,:,:) @@ -942,7 +1081,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) IF (massfrac(is)) THEN tmp = iimplicit iimplicit = 0 - CALL deryy (td2, phi2(:,:,:,is), di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1, zero) + CALL deryy (td2, phi2(:,:,:,is), di2, sy, sfyp, ssyp, swyp, ysize(1), ysize(2), ysize(3), 1, 0) iimplicit = tmp tc2(:,:,:) = tc2(:,:,:) + (xnu / sc(is)) * (te2(:,:,:) / mol_weight(is)) * td2(:,:,:) ENDIF @@ -962,7 +1101,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) !!------------------------------------------------------------------------------ !! Z-pencil - CALL derzz (divu3, ta3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, zero) + CALL derzz (divu3, ta3, di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, 0) IF (imultispecies) THEN divu3(:,:,:) = (xnu / prandtl) * divu3(:,:,:) / ta3(:,:,:) @@ -977,7 +1116,7 @@ SUBROUTINE calc_divu_constraint(divu3, rho1, phi1) DO is = 1, numscalar IF (massfrac(is)) THEN - CALL derzz (tc3, phi3(:,:,:,is), di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, zero) + CALL derzz (tc3, phi3(:,:,:,is), di3, sz, sfzp, sszp, swzp, zsize(1), zsize(2), zsize(3), 1, 0) divu3(:,:,:) = divu3(:,:,:) + (xnu / sc(is)) * (td3(:,:,:) / mol_weight(is)) * tc3(:,:,:) ENDIF ENDDO @@ -1084,16 +1223,16 @@ SUBROUTINE birman_drhodt_corr(drhodt1_next, rho1) CALL transpose_y_to_z(rho2, rho3) !! Diffusion term - CALL derzz (ta3,rho3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1, zero) + CALL derzz (ta3,rho3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1, 0) CALL transpose_z_to_y(ta3, tb2) iimplicit = -iimplicit - CALL deryy (ta2,rho2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, zero) + CALL deryy (ta2,rho2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, 0) iimplicit = -iimplicit ta2(:,:,:) = ta2(:,:,:) + tb2(:,:,:) CALL transpose_y_to_x(ta2, te1) - CALL derxx (td1,rho1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1, zero) + CALL derxx (td1,rho1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1, 0) td1(:,:,:) = td1(:,:,:) + te1(:,:,:) drhodt1_next(:,:,:) = drhodt1_next(:,:,:) - invpe * td1(:,:,:) @@ -1195,7 +1334,7 @@ subroutine calc_rho0(rho1, rho0) ! Ensure a default value rho0 = 1.0_mytype end if - + end subroutine calc_rho0 !############################################################################ !############################################################################ @@ -1227,7 +1366,7 @@ SUBROUTINE calc_varcoeff_rhs(pp3, rho1, px1, py1, pz1, dv3, drho1, ep1, divu3, r real(mytype), intent(in) :: rho0 !! OUTPUTS - REAL(mytype), DIMENSION(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize) :: pp3 + REAL(mytype), DIMENSION(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize) :: pp3,div_visu_var !! LOCALS INTEGER :: nlock, ierr @@ -1237,7 +1376,7 @@ SUBROUTINE calc_varcoeff_rhs(pp3, rho1, px1, py1, pz1, dv3, drho1, ep1, divu3, r tc1(:,:,:) = (one - rho0 / rho1(:,:,:,1)) * pz1(:,:,:) nlock = -1 !! Don't do any funny business with LMN - call divergence(pp3,rho1,ta1,tb1,tc1,ep1,drho1,divu3,nlock) + call divergence(div_visu_var,pp3,rho1,ta1,tb1,tc1,ep1,drho1,divu3,nlock) !! lapl(p) = div((1 - rhomin/rho) grad(p)) + rhomin(div(u*) - div(u)) !! dv3 contains div(u*) - div(u) @@ -1270,7 +1409,7 @@ subroutine tbl_flrt (ux1,uy1,uz1) call transpose_x_to_y(uy1,uy2) ! Flow rate at the inlet ut1=zero - if (ystart(1)==1) then !! CPUs at the inlet + if (ystart(1)==1) then !! CPUs at the inletdiv_vi do k=1,ysize(3) do j=1,ysize(2)-1 ut1=ut1+(yp(j+1)-yp(j))*(ux2(1,j+1,k)-half*(ux2(1,j+1,k)-ux2(1,j,k))) @@ -1330,7 +1469,7 @@ end subroutine tbl_flrt !! !! subroutine: pipe_bulk / pipe_bulk_u / pipe_bulk_phi !! AUTHOR: Rodrigo Vicente Cruz - !! DESCRIPTION: Correction of pipe's bulk velocity (constant + !! DESCRIPTION: Correction of pipe's bulk velocity (constant !! flow rate) and bulk temperature. !! See Thesis Vicente Cruz 2021 for help. !! diff --git a/src/parameters.f90 b/src/parameters.f90 index 8b39a1ccf..00005898e 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -30,7 +30,7 @@ subroutine parameter(input_i3d) use mod_stret, only : beta use probes, only : nprobes, setup_probes, flag_all_digits, flag_extra_probes, xyzprobes use visu, only : output2D - use forces, only : iforces, nvol, setup_forces + use forces, only : iforces, nvol, xld, xrd, yld, yud, zld, zrd,setup_forces use mhd, only : mhd_equation,hartmann,stuart,rem use particle, only : initype_particle,n_particles,bc_particle,particle_inject_period @@ -65,17 +65,22 @@ subroutine parameter(input_i3d) alpha_sc, beta_sc, g_sc, Tref NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iconserv NAMELIST /ThetaDotModel/ jtheta_dot,jthickness,Method_FT,K_theta,H_12 - NAMELIST /BlowingModel/ Blowing,A_Blowing,Xst_Blowing,Xen_Blowing,Range_Smooth + NAMELIST /BlowingModel/ Blowing,A_Blowing,Xst_Blowing,Xen_Blowing,Range_Smooth NAMELIST /AdversePresGrad/ APG,APG_DpDX,APG_Beta NAMELIST /ProbeSpectra/ Pro_Spectra,X_Pro_Spectra,Z_Pro_Spectra NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,ra,rai,rao,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads, c_air + NAMELIST /ibmstuff/ ce,sh,ori,lv,av,ra,cex,cey,cez,rai,rao, & + nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega , & + ubcx,ubcy,ubcz,rads,rho_s, c_air, grav_x,grav_y,grav_z, nozdrift, force_csv, bodies_fixed, cube_flag, tconv2_sign, & + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug, torq_flip, ztorq_only, nbody, & + inviscid_output, div_visu_flag + NAMELIST /ForceCVs/ xld, xrd, yld, yud, zld, zrd NAMELIST /LMN/ dens1, dens2, prandtl, ilmn_bound, ivarcoeff, ilmn_solve_temp, & massfrac, mol_weight, imultispecies, primary_species, & Fr, ibirman_eos NAMELIST /ABL/ z_zero, iwallmodel, k_roughness, ustar, dBL, & imassconserve, ibuoyancy, iPressureGradient, iCoriolis, CoriolisFreq, & - istrat, idamping, iheight, TempRate, TempFlux, itherm, gravv, UG, T_wall, T_top, ishiftedper, iconcprec, pdl, dsampling + istrat, idamping, iheight, TempRate, TempFlux, itherm, gravv, UG, T_wall, T_top, ishiftedper, iconcprec, pdl, dsampling NAMELIST /CASE/ pfront NAMELIST/ALMParam/iturboutput,NTurbines,TurbinesPath,NActuatorlines,ActuatorlinesPath,eps_factor,rho_air NAMELIST/ADMParam/Ndiscs,ADMcoords,iturboutput,rho_air,T_relax @@ -130,7 +135,8 @@ subroutine parameter(input_i3d) read(10, nml=ProbesParam); rewind(10) endif if (iforces.eq.1) then - call setup_forces(10) + allocate(xld(nvol), xrd(nvol), yld(nvol), yud(nvol), zld(nvol), zrd(nvol)) + read(10, nml=ForceCVs); rewind(10) endif !! Set Scalar BCs same as fluid (may be overridden) [DEFAULT] @@ -210,7 +216,7 @@ subroutine parameter(input_i3d) endif endif - + if(mhd_active) then read(10, nml=MHDParam); rewind(10) !! read mhd nclxB1(1) = nclxBx1 @@ -234,14 +240,14 @@ subroutine parameter(input_i3d) endif if(particle_active) then - read(10, nml=ParTrack); rewind(10) + read(10, nml=ParTrack); rewind(10) endif ! !! These are the 'optional'/model parameters if(ilesmod.ne.0) then read(10, nml=LESModel); rewind(10) endif - + !!==> Pasha if(itype .eq. 15) then read(10, nml=ThetaDotModel); rewind(10) @@ -298,7 +304,11 @@ subroutine parameter(input_i3d) dy2 = dy * dy dz2 = dz * dz - xnu=one/re + if (re.gt.0.001) then + xnu=one/re + else + xnu=zero + endif !! Constant pressure gradient, re = Re_tau -> use to compute Re_centerline if (cpg) then re_cent = (re/0.116_mytype)**(1.0_mytype/0.88_mytype) @@ -393,7 +403,9 @@ subroutine parameter(input_i3d) elseif (itype.eq.itype_cavity) then print *,'Cavity' elseif (itype.eq.itype_ptbl) then - print *,'Temporal turbulent boundary layer' + print *,'Temporal turbulent boundary layer' + elseif (itype.eq.itype_ellip) then + print *,'Simulating Ellipsoid' else print *,'Unknown itype: ', itype stop @@ -468,32 +480,32 @@ subroutine parameter(input_i3d) endif endif write(*,*) '===========================================================' - if (FreeStream==0) then + if (FreeStream==0) then write(*,"(' FreeStream (BC) : ',A10)") "Off" else if (FreeStream==1) then write(*,"(' FreeStream (BC) : ',A10)") "On" - end if + end if write(*,*) '===========================================================' - if (jtheta_dot==0) then + if (jtheta_dot==0) then write(*,"(' Theta dot Model : ',A10)") "Biau" else if (jtheta_dot==1) then write(*,"(' Theta dot Model : ',A10)") "Andy" - if (jthickness ==0) then + if (jthickness ==0) then write(*,"(' Model works based on : ',A25)") "Momentum Thickness" else write(*,"(' Model works based on : ',A25)") "Displacement Thickness" - write(*,"(' H_12 for scaling : ',F12.6)") H_12 + write(*,"(' H_12 for scaling : ',F12.6)") H_12 end if - if (Method_FT ==0) then + if (Method_FT ==0) then write(*,"(' Theta Model version : ',A25)") " v1.0 " - elseif (Method_FT ==1) then + elseif (Method_FT ==1) then write(*,"(' Theta Model version : ',A25)") " v2.0 " end if - write(*,"(' K coefficient => e(Th) : ',F12.6)") K_theta + write(*,"(' K coefficient => e(Th) : ',F12.6)") K_theta endif write(*,*) '===========================================================' - if (Blowing==0) then + if (Blowing==0) then write(*,"(' Blowing : ',A10)") "Off" elseif (Blowing==1) then write(*,"(' Blowing : ',A10)") "On" @@ -505,18 +517,18 @@ subroutine parameter(input_i3d) endif write(*,*) '===========================================================' - if (APG==0) then + if (APG==0) then write(*,"(' Adverse Pressure Gradient : ',A10)") "Off" elseif (APG==1) then write(*,"(' Adverse Pressure Gradient : ',A10)") "On" write(*,"(' Pressure Gradient : ',F12.6)") APG_DpDX elseif (APG==2) then write(*,"(' Adverse Pressure Gradient : ',A10)") "On" - write(*,"(' Beta of Pressure Gradient : ',F12.6)") APG_Beta + write(*,"(' Beta of Pressure Gradient : ',F12.6)") APG_Beta endif write(*,*) '===========================================================' - if (Pro_Spectra==0) then + if (Pro_Spectra==0) then write(*,"(' Probe for Spectra : ',A10)") "Off" elseif (Pro_Spectra==1) then write(*,"(' Probe for Spectra : ',A10)") "On" @@ -685,7 +697,7 @@ subroutine parameter_defaults() use visu, only : output2D use forces, only : iforces, nvol - use mhd, only: mhd_equation, rem, stuart, hartmann + use mhd, only: mhd_equation, rem, stuart, hartmann use particle, only : initype_particle,n_particles,bc_particle,particle_inject_period implicit none @@ -732,11 +744,11 @@ subroutine parameter_defaults() smagcst=0.15 maxdsmagcst=0.3 - + !! SVV stuff nu0nu=four cnu=0.44_mytype - + !! IBM stuff nraf = 0 nobjmax = 0 @@ -750,6 +762,18 @@ subroutine parameter_defaults() wrotation = zero irotation = 0 itest=1 + oriw=one + rho_s=one + cvl_scalar=onepfive + grav_y=zero + grav_x=zero + grav_z=zero + nozdrift=0 + force_csv=0 + nbody=1 + inviscid_output=0 + div_visu_flag=0 + ra(:) = 1.0 !! Gravity field gravx = zero diff --git a/src/probes.f90 b/src/probes.f90 index e70e9e07f..661042a73 100644 --- a/src/probes.f90 +++ b/src/probes.f90 @@ -351,15 +351,15 @@ subroutine write_probes(ux1,uy1,uz1,pp3,phi1) sync_vel_needed = .false. endif ! Compute velocity gradient - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) - call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) - call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !x is 1 etc. + call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) + call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) + call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) + call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) + call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) ! Store velocity gradient call write_extra_probes_vel(ta1, td2, td3, tb1, te2, te3, tc1, tf2, tf3) @@ -380,13 +380,13 @@ subroutine write_probes(ux1,uy1,uz1,pp3,phi1) endif ! Compute derivative if (evensc) then - call derxS (tb1,phi1(:,:,:,is),di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,zero) - call deryS (tc2,phi2(:,:,:,is),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,zero) - call derzS (tb3,phi3(:,:,:,is),di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,zero) + call derxS (tb1,phi1(:,:,:,is),di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,0) !zero is 0. + call deryS (tc2,phi2(:,:,:,is),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,0) !zero is 0. + call derzS (tb3,phi3(:,:,:,is),di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,0) !zero is 0. else - call derxS (tb1,phi1(:,:,:,is),di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,zero) - call deryS (tc2,phi2(:,:,:,is),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call derzS (tb3,phi3(:,:,:,is),di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,zero) + call derxS (tb1,phi1(:,:,:,is),di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + call deryS (tc2,phi2(:,:,:,is),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,0) !zero is 0. + call derzS (tb3,phi3(:,:,:,is),di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,0) !zero is 0. endif ! Store scalars gradient call write_extra_probes_scal(is, tb1, tc2, tb3) diff --git a/src/tools.f90 b/src/tools.f90 index 68c83f5f1..515114b0c 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -131,6 +131,11 @@ subroutine test_speed_min_max(ux,uy,uz) call MPI_ABORT(MPI_COMM_WORLD,code,ierror) stop endif + if (uxmin1 /= uxmin1) then + write(*,*) 'NaN solutions for flow and body occurred!' + call MPI_ABORT(MPI_COMM_WORLD,code,ierror) + stop + endif endif @@ -143,6 +148,7 @@ subroutine simu_stats(iwhen) use simulation_stats use var use MPI + use ibm_param, only: position,orientation implicit none @@ -480,7 +486,7 @@ subroutine restart(ux1,uy1,uz1,dux1,duy1,duz1,ep1,pp3,phi1,dphi1,px1,py1,pz1,rho end if if(particle_active) call particle_checkpoint(mode='read') - + endif if (nrank==0) then @@ -520,7 +526,7 @@ subroutine init_restart_adios2() use param, only : ilmn, nrhotime, ntime, mhd_active use var, only : itimescheme, iibm use mhd, only : mhd_equation - + implicit none integer :: ierror @@ -578,7 +584,7 @@ subroutine init_restart_adios2() end do call decomp_2d_register_variable(io_restart, "mu", 1, 0, 0, mytype) end if - + if (mhd_active .and. mhd_equation == 'induction') then call decomp_2d_register_variable(io_restart, "bx", 1, 0, 0, mytype) call decomp_2d_register_variable(io_restart, "by", 1, 0, 0, mytype) @@ -616,9 +622,9 @@ subroutine apply_spatial_filter(ux1,uy1,uz1,phi1) !if (iscalar == 1) phi11=phi1(:,:,:,1) !currently only first scalar if (ifilter==1.or.ifilter==2) then - call filx(uxf1,ux1,di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call filx(uyf1,uy1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call filx(uzf1,uz1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call filx(uxf1,ux1,di1,fisx,fiffx,fifsx,fifwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx) + call filx(uyf1,uy1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy) + call filx(uzf1,uz1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz) else uxf1=ux1 uyf1=uy1 @@ -632,9 +638,9 @@ subroutine apply_spatial_filter(ux1,uy1,uz1,phi1) !if (iscalar == 1) call transpose_x_to_y(phif1,phi2) if (ifilter==1.or.ifilter==3) then ! all filter or y filter - call fily(uxf2,ux2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcx) - call fily(uyf2,uy2,di2,fisy,fiffy,fifsy,fifwy,ysize(1),ysize(2),ysize(3),0,ubcy) - call fily(uzf2,uz2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,ubcz) + call fily(uxf2,ux2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,1) !ubcx) + call fily(uyf2,uy2,di2,fisy,fiffy,fifsy,fifwy,ysize(1),ysize(2),ysize(3),0,2) !ubcy) + call fily(uzf2,uz2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,3) !ubcz) !if (iscalar.eq.1) call fily(phif2,phi2,di2,fisy,fiffy,fifsy,fifwy,ysize(1),ysize(2),ysize(3),0) else uxf2=ux2 @@ -649,9 +655,9 @@ subroutine apply_spatial_filter(ux1,uy1,uz1,phi1) !if (iscalar == 1) call transpose_y_to_z(phif2,phi3) if (ifilter==1.or.ifilter==2) then - call filz(uxf3,ux3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call filz(uyf3,uy3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call filz(uzf3,uz3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call filz(uxf3,ux3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,1) !ubcx) + call filz(uyf3,uy3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,2) !ubcy) + call filz(uzf3,uz3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,3) !ubcz) !if (iscalar.eq.1) call filz(phif3,phi3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0) else uxf3=ux3 @@ -735,7 +741,7 @@ end subroutine read_inflow !! SUBROUTINE: append_outflow !############################################################################ subroutine append_outflow(ux,uy,uz,timestep) - + use decomp_2d_io use var, only: ux_recoutflow, uy_recoutflow, uz_recoutflow, ilist use param @@ -746,7 +752,7 @@ subroutine append_outflow(ux,uy,uz,timestep) integer, intent(in) :: timestep integer :: j,k - if (nrank==0.and.mod(itime,ilist)==0) print *, 'Appending outflow', timestep + if (nrank==0.and.mod(itime,ilist)==0) print *, 'Appending outflow', timestep do k=1,xsize(3) do j=1,xsize(2) ux_recoutflow(timestep,j,k)=ux(xend(1),j,k) @@ -829,20 +835,20 @@ subroutine compute_cfldiff() write(*,"(' cfl_diff_sum : ',F13.8)") cfl_diff_sum write(*,*) '===========================================================' endif - + if( mhd_active .and. mhd_equation=='induction') then - + cfl_diff_x = dt/ (dx**2) / rem cfl_diff_z = dt/ (dz**2) / rem - + if (istret == 0) then cfl_diff_y = dt / (dy**2) / rem else cfl_diff_y = dt / (minval(dyp)**2) / rem end if - + cfl_diff_sum = cfl_diff_x + cfl_diff_y + cfl_diff_z - + if (nrank==0) then write(*,*) '===========================================================' write(*,*) 'Magnetic Diffusion number' @@ -852,7 +858,7 @@ subroutine compute_cfldiff() write(*,"(' B cfl_diff_sum : ',F13.8)") cfl_diff_sum write(*,*) '===========================================================' endif - endif + endif return end subroutine compute_cfldiff diff --git a/src/transeq.f90 b/src/transeq.f90 index ab767ad3c..1638df84a 100644 --- a/src/transeq.f90 +++ b/src/transeq.f90 @@ -122,12 +122,12 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (nrank == 0) write(*,*)'## SUB momentum_rhs_eq VAR ta1 (uu) MAX ', dep #endif - call derx (td1,ta1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcx*ubcx) - call derx (te1,tb1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx*ubcy) - call derx (tf1,tc1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx*ubcz) - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (td1,ta1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,4) !ubcx*ubcx is 4. + call derx (te1,tb1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,7) !ubcx*ubcy is 7. + call derx (tf1,tc1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,8) !ubcx*ubcz is 8. + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx is 1. + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy is 2. + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz is 3. #ifdef DEBG dep=maxval(abs(ta1)) @@ -154,7 +154,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (ilmn) then !! Quasi-skew symmetric terms - call derx (td1,rho1(:,:,:,1),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1, zero) + call derx (td1,rho1(:,:,:,1),di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1, 0) !zero is 0. tg1(:,:,:) = tg1(:,:,:) + ux1(:,:,:) * ux1(:,:,:) * td1(:,:,:) th1(:,:,:) = th1(:,:,:) + uy1(:,:,:) * ux1(:,:,:) * td1(:,:,:) ti1(:,:,:) = ti1(:,:,:) + uz1(:,:,:) * ux1(:,:,:) * td1(:,:,:) @@ -195,12 +195,12 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (nrank == 0) write(*,*)'## SUB momentum_rhs_eq VAR td2 (uu) MAX ', dep #endif - call dery (tg2,td2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcx*ubcy) - call dery (th2,te2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcy*ubcy) - call dery (ti2,tf2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcz*ubcy) - call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (tg2,td2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,7) !x*y is 7 + call dery (th2,te2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,5) !y*y is 5 + call dery (ti2,tf2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,9) !z*y is 9 + call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !x is 1 + call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !y is 2 + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !z is 3 #ifdef DEBG dep=maxval(abs(td2)) @@ -227,7 +227,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (ilmn) then !! Quasi-skew symmetric terms - call dery (te2,rho2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) + call dery (te2,rho2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) !zero is 0. tg2(:,:,:) = tg2(:,:,:) + ux2(:,:,:) * uy2(:,:,:) * te2(:,:,:) th2(:,:,:) = th2(:,:,:) + uy2(:,:,:) * uy2(:,:,:) * te2(:,:,:) ti2(:,:,:) = ti2(:,:,:) + uz2(:,:,:) * uy2(:,:,:) * te2(:,:,:) @@ -256,12 +256,12 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (nrank == 0) write(*,*)'## SUB momentum_rhs_eq VAR td3 (uu) MAX ', dep #endif - call derz (tg3,td3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcx*ubcz) - call derz (th3,te3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcy*ubcz) - call derz (ti3,tf3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcz*ubcz) - call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (tg3,td3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,8) !x*z is 8 + call derz (th3,te3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,9) !y*z is 9 + call derz (ti3,tf3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,6) !z*z is 6 + call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !x is 1 + call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !y is 2 + call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !z is 3 ! Convective terms of z-pencil in ta3,tb3,tc3 if (ilmn) then @@ -276,7 +276,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (ilmn) then !! Quasi-skew symmetric terms - call derz (tf3,rho3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,zero) + call derz (tf3,rho3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,0) ta3(:,:,:) = ta3(:,:,:) + ux3(:,:,:) * uz3(:,:,:) * tf3(:,:,:) tb3(:,:,:) = tb3(:,:,:) + uy3(:,:,:) * uz3(:,:,:) * tf3(:,:,:) tc3(:,:,:) = tc3(:,:,:) + uz3(:,:,:) * uz3(:,:,:) * tf3(:,:,:) @@ -298,9 +298,9 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) tf3(:,:,:) = tc3(:,:,:) !DIFFUSIVE TERMS IN Z - call derzz (ta3,ux3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derzz (tb3,uy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derzz (tc3,uz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,ubcz) + call derzz (ta3,ux3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,1) !x is 1 + call derzz (tb3,uy3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,2) !y is 2 + call derzz (tc3,uz3,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,3) !z is 3 ! Add convective and diffusive terms of z-pencil (half for skew-symmetric) @@ -333,9 +333,9 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) !DIFFUSIVE TERMS IN Y if (iimplicit.le.0) then !-->for ux - call deryy (td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcx) + call deryy (td2,ux2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,1) !x is 1 if (istret.ne.0) then - call dery (te2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) + call dery (te2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !x is 1 do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -346,9 +346,9 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) endif !-->for uy - call deryy (te2,uy2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0,ubcy) + call deryy (te2,uy2,di2,sy,sfy,ssy,swy,ysize(1),ysize(2),ysize(3),0,2) !y is 2 if (istret.ne.0) then - call dery (tf2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) + call dery (tf2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !y is 2 do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -359,9 +359,9 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) endif !-->for uz - call deryy (tf2,uz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,ubcz) + call deryy (tf2,uz2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,3) !z is 3 if (istret.ne.0) then - call dery (tj2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (tj2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !z is 3 do k = 1,ysize(3) do j = 1,ysize(2) do i = 1,ysize(1) @@ -374,7 +374,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) if (istret.ne.0) then !-->for ux - call dery (te2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) + call dery (te2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !x is 1 do k=1,ysize(3) do j=1,ysize(2) do i=1,ysize(1) @@ -383,7 +383,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) enddo enddo !-->for uy - call dery (tf2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) + call dery (tf2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !y is 2. do k=1,ysize(3) do j=1,ysize(2) do i=1,ysize(1) @@ -392,7 +392,7 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) enddo enddo !-->for uz - call dery (tj2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (tj2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !z is 3 do k=1,ysize(3) do j=1,ysize(2) do i=1,ysize(1) @@ -439,9 +439,9 @@ subroutine momentum_rhs_eq(dux1,duy1,duz1,rho1,ux1,uy1,uz1,ep1,phi1,divu3) call transpose_y_to_x(tc2,tc1) !diff+conv. terms !DIFFUSIVE TERMS IN X - call derxx (td1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,ubcx) - call derxx (te1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derxx (tf1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derxx (td1,ux1,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,1) !ubcx is 1. + call derxx (te1,uy1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy is 2. + call derxx (tf1,uz1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz is 3/ if (ilmn) then td1(:,:,:) = mu1(:,:,:) * xnu * td1(:,:,:) @@ -629,26 +629,26 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) one_third = one / three - call derz (tc3,divu3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,zero) + call derz (tc3,divu3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,0) call transpose_z_to_y(tc3, tc2) call transpose_z_to_y(divu3, th2) - call dery(tb2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,zero) + call dery(tb2,th2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,0) !zero is 0. call transpose_y_to_x(tb2, te1) call transpose_y_to_x(tc2, tf1) call transpose_y_to_x(th2, tg1) - call derx(td1,tg1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,zero) + call derx(td1,tg1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. dux1(:,:,:) = dux1(:,:,:) + mu1(:,:,:) * one_third * xnu * td1(:,:,:) duy1(:,:,:) = duy1(:,:,:) + mu1(:,:,:) * one_third * xnu * te1(:,:,:) duz1(:,:,:) = duz1(:,:,:) + mu1(:,:,:) * one_third * xnu * tf1(:,:,:) !! Variable viscosity part - call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,ubcx) - call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) - call derx (td1,mu1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,zero) + call derx (ta1,ux1,di1,sx,ffx,fsx,fwx,xsize(1),xsize(2),xsize(3),0,1) !ubcx is 1. + call derx (tb1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy is 2. + call derx (tc1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz is 3. + call derx (td1,mu1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,0) !zero is 0. ta1(:,:,:) = two * ta1(:,:,:) - (two * one_third) * tg1(:,:,:) ta1(:,:,:) = td1(:,:,:) * ta1(:,:,:) @@ -660,13 +660,13 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) call transpose_x_to_y(tc1, tc2) call transpose_x_to_y(td1, tg2) - call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcx) - call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) - call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,ubcz) + call dery (td2,ux2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,1) !x is 1 + call dery (te2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,2) !y is 2 + call dery (tf2,uz2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,3) !z is 3 te2(:,:,:) = two * te2(:,:,:) - (two * one_third) * th2(:,:,:) call transpose_x_to_y(mu1, ti2) - call dery (th2,ti2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) + call dery (th2,ti2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,0) !zero is 0. ta2(:,:,:) = ta2(:,:,:) + th2(:,:,:) * td2(:,:,:) tb2(:,:,:) = tb2(:,:,:) + th2(:,:,:) * te2(:,:,:) + tg2(:,:,:) * td2(:,:,:) @@ -679,14 +679,14 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) call transpose_y_to_z(th2, th3) !! dmudy call transpose_y_to_z(ti2, ti3) !! mu - call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcx) - call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,ubcy) - call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,ubcz) + call derz (td3,ux3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,1) !x is 1 + call derz (te3,uy3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,2) !y is 2 + call derz (tf3,uz3,di3,sz,ffz,fsz,fwz,zsize(1),zsize(2),zsize(3),0,3) !z is 3 tf3(:,:,:) = two * tf3(:,:,:) - (two * one_third) * divu3(:,:,:) tc3(:,:,:) = tc3(:,:,:) + tg3(:,:,:) * td3(:,:,:) + th3(:,:,:) * te3(:,:,:) - call derz (th3,ti3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,zero) + call derz (th3,ti3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,0) ta3(:,:,:) = ta3(:,:,:) + th3(:,:,:) * td3(:,:,:) tb3(:,:,:) = tb3(:,:,:) + th3(:,:,:) * te3(:,:,:) @@ -705,8 +705,8 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) call transpose_y_to_x(th2, te1) !! dmudy call transpose_y_to_x(ti2, tf1) !! dmudz - call derx (th1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcy) - call derx (ti1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,ubcz) + call derx (th1,uy1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,2) !ubcy is 2. + call derx (ti1,uz1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,3) !ubcz is 3. ta1(:,:,:) = ta1(:,:,:) + te1(:,:,:) * th1(:,:,:) + tf1(:,:,:) * ti1(:,:,:) dux1(:,:,:) = dux1(:,:,:) + xnu * ta1(:,:,:) @@ -910,11 +910,11 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) !X PENCILS if (skewsc) ta1(:,:,:) = ux1(:,:,:) * phi1(:,:,:) if (evensc) then - call derxS (tb1,phi1(:,:,:),di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,zero) - if (skewsc) call derxS (tc1,ta1,di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,zero) + call derxS (tb1,phi1(:,:,:),di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,0) !zero is 0. + if (skewsc) call derxS (tc1,ta1,di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. else - call derxS (tb1,phi1(:,:,:),di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,zero) - if (skewsc) call derxS (tc1,ta1,di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,zero) + call derxS (tb1,phi1(:,:,:),di1,sx,ffxS,fsxS,fwxS,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. + if (skewsc) call derxS (tc1,ta1,di1,sx,ffxpS,fsxpS,fwxpS,xsize(1),xsize(2),xsize(3),1,0) !zero is 0. endif if (ilmn) then tb1(:,:,:) = rho1(:,:,:,1) * ux1(:,:,:) * tb1(:,:,:) @@ -927,9 +927,9 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) endif if (evensc) then - call derxxS (ta1,phi1(:,:,:),di1,sx,sfxpS,ssxpS,swxpS,xsize(1),xsize(2),xsize(3),1,zero) + call derxxS (ta1,phi1(:,:,:),di1,sx,sfxpS,ssxpS,swxpS,xsize(1),xsize(2),xsize(3),1,0) !zero is 0. else - call derxxS (ta1,phi1(:,:,:),di1,sx,sfxS,ssxS,swxS,xsize(1),xsize(2),xsize(3),0,zero) + call derxxS (ta1,phi1(:,:,:),di1,sx,sfxS,ssxS,swxS,xsize(1),xsize(2),xsize(3),0,0) !zero is 0. endif ! Add convective and diffusive scalar terms of x-pencil @@ -942,13 +942,13 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) ! Explicit viscous diffusion if (iimplicit.le.0) then if (evensc) then - call deryS (tc2,td2(:,:,:),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,zero) - if (skewsc) call deryS (te2,tb2,di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call deryyS (ta2,td2(:,:,:),di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1,zero) + call deryS (tc2,td2(:,:,:),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,0) + if (skewsc) call deryS (te2,tb2,di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,0) + call deryyS (ta2,td2(:,:,:),di2,sy,sfypS,ssypS,swypS,ysize(1),ysize(2),ysize(3),1,0) else - call deryS (tc2,td2(:,:,:),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,zero) - if (skewsc) call deryS (te2,tb2,di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,zero) - call deryyS (ta2,td2(:,:,:),di2,sy,sfyS,ssyS,swyS,ysize(1),ysize(2),ysize(3),0,zero) + call deryS (tc2,td2(:,:,:),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,0) + if (skewsc) call deryS (te2,tb2,di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,0) + call deryyS (ta2,td2(:,:,:),di2,sy,sfyS,ssyS,swyS,ysize(1),ysize(2),ysize(3),0,0) endif if (istret.ne.0) then @@ -964,11 +964,11 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) ! (semi)implicit Y viscous diffusion else if (evensc) then - call deryS (tc2,td2(:,:,:),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,zero) - if (skewsc) call deryS (te2,tb2,di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,zero) + call deryS (tc2,td2(:,:,:),di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,0) + if (skewsc) call deryS (te2,tb2,di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,0) else - call deryS (tc2,td2(:,:,:),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,zero) - if (skewsc) call deryS (te2,tb2,di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,zero) + call deryS (tc2,td2(:,:,:),di2,sy,ffyS,fsyS,fwyS,ppy,ysize(1),ysize(2),ysize(3),0,0) + if (skewsc) call deryS (te2,tb2,di2,sy,ffypS,fsypS,fwypS,ppy,ysize(1),ysize(2),ysize(3),1,0) endif if (istret.ne.0) then @@ -1003,11 +1003,11 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) !Z PENCILS if (skewsc) ta3(:,:,:) = uz3(:,:,:) * td3(:,:,:) if (evensc) then - call derzS (tb3,td3(:,:,:),di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,zero) - if (skewsc) call derzS (tc3,ta3,di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,zero) + call derzS (tb3,td3(:,:,:),di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,0) + if (skewsc) call derzS (tc3,ta3,di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,0) else - call derzS (tb3,td3(:,:,:),di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,zero) - if (skewsc) call derzS (tc3,ta3,di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,zero) + call derzS (tb3,td3(:,:,:),di3,sz,ffzS,fszS,fwzS,zsize(1),zsize(2),zsize(3),0,0) + if (skewsc) call derzS (tc3,ta3,di3,sz,ffzpS,fszpS,fwzpS,zsize(1),zsize(2),zsize(3),1,0) endif ! convective terms @@ -1023,9 +1023,9 @@ subroutine scalar_transport_eq(dphi1, rho1, ux1, uy1, uz1, phi1, schmidt, is) ! diffusive terms if (evensc) then - call derzzS (ta3,td3(:,:,:),di3,sz,sfzpS,sszpS,swzpS,zsize(1),zsize(2),zsize(3),1,zero) + call derzzS (ta3,td3(:,:,:),di3,sz,sfzpS,sszpS,swzpS,zsize(1),zsize(2),zsize(3),1,0) else - call derzzS (ta3,td3(:,:,:),di3,sz,sfzS,sszS,swzS,zsize(1),zsize(2),zsize(3),0,zero) + call derzzS (ta3,td3(:,:,:),di3,sz,sfzS,sszS,swzS,zsize(1),zsize(2),zsize(3),0,0) endif ! Add convective and diffusive scalar terms of z-pencil @@ -1135,19 +1135,19 @@ subroutine scalar_settling(dphi1, phi1, is) call transpose_x_to_y(phi1, phi2) call transpose_y_to_z(phi2, phi3) - call derz (ta3, phi3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz (ta3, phi3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) ta3(:,:,:) = uset(is) * gravz * ta3(:,:,:) call transpose_z_to_y(ta3, tb2) - call dery (ta2, phi2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call dery (ta2, phi2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) ta2(:,:,:) = uset(is) * gravy * ta2(:,:,:) ta2(:,:,:) = ta2(:,:,:) + tb2(:,:,:) call transpose_y_to_x(ta2, ta1) dphi1(:,:,:,1,is) = dphi1(:,:,:,1,is) - ta1(:,:,:) - call derx (ta1, phi1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + call derx (ta1, phi1, di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero is 0. dphi1(:,:,:,1,is) = dphi1(:,:,:,1,is) - uset(is) * gravx * ta1(:,:,:) endsubroutine scalar_settling @@ -1209,29 +1209,29 @@ subroutine continuity_rhs_eq(drho1, rho1, ux1, divu3) !! XXX All variables up to date - no need to transpose - call derz (ta3, rho3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, zero) + call derz (ta3, rho3, di3, sz, ffzp, fszp, fwzp, zsize(1), zsize(2), zsize(3), 1, 0) ta3(:,:,:) = uz3(:,:,:) * ta3(:,:,:) + rho3(:,:,:) * divu3(:,:,:) call transpose_z_to_y(ta3, tb2) - call dery (ta2, rho2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, zero) + call dery (ta2, rho2, di2, sy, ffyp, fsyp, fwyp, ppy, ysize(1), ysize(2), ysize(3), 1, 0) ta2(:,:,:) = uy2(:,:,:) * ta2(:,:,:) + tb2(:,:,:) call transpose_y_to_x(ta2, ta1) call derx (drho1(:,:,:,1), rho1(:,:,:,1), & - di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, zero) + di1, sx, ffxp, fsxp, fwxp, xsize(1), xsize(2), xsize(3), 1, 0) !zero is 0. drho1(:,:,:,1) = -(ux1(:,:,:) * drho1(:,:,:,1) + ta1(:,:,:)) if (ibirman_eos) THEN !! Add a diffusion term - call derzz (ta3,rho3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1, zero) + call derzz (ta3,rho3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1, 0) call transpose_z_to_y(ta3, tb2) iimplicit = -iimplicit - call deryy (ta2,rho2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, zero) + call deryy (ta2,rho2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1, 0) iimplicit = -iimplicit ta2(:,:,:) = ta2(:,:,:) + tb2(:,:,:) call transpose_y_to_x(ta2, ta1) - call derxx (tb1,rho1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1, zero) + call derxx (tb1,rho1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1, 0) !zero is 0. ta1(:,:,:) = ta1(:,:,:) + tb1(:,:,:) drho1(:,:,:,1) = drho1(:,:,:,1) + invpe * ta1(:,:,:) diff --git a/src/variables.f90 b/src/variables.f90 index 92b4fdabc..7a7d571cb 100644 --- a/src/variables.f90 +++ b/src/variables.f90 @@ -16,7 +16,7 @@ module var ! define all major arrays here real(mytype), save, allocatable, dimension(:,:,:) :: ux1, ux2, ux3, po3, dv3 - real(mytype), save, allocatable, dimension(:,:,:,:) :: pp3 + real(mytype), save, allocatable, dimension(:,:,:,:) :: pp3, div_visu_var real(mytype), save, allocatable, dimension(:,:,:) :: uy1, uy2, uy3 real(mytype), save, allocatable, dimension(:,:,:) :: uz1, uz2, uz3 real(mytype), save, allocatable, dimension(:,:,:,:) :: rho1, drho1 @@ -452,6 +452,8 @@ subroutine init_variables allocate(pp3(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress)) pp3=zero + allocate(div_visu_var(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress)) + div_visu_var=zero call alloc_z(dv3,ph,.true.) dv3=zero call alloc_z(po3,ph,.true.) diff --git a/src/visu.f90 b/src/visu.f90 index 0b68e722e..1f46058e7 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -170,12 +170,12 @@ end subroutine visu_finalise ! ! Write a snapshot ! - subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) + subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, itime, num) use decomp_2d_io, only : decomp_2d_start_io use param, only : nrhotime, ilmn, iscalar, ioutput, irestart - + use ibm_param, only : inviscid_output,div_visu_flag use variables, only : sx, cifip6, cisip6, ciwip6, cifx6, cisx6, ciwx6 use variables, only : sy, cifip6y, cisip6y, ciwip6y, cify6, cisy6, ciwy6 use variables, only : sz, cifip6z, cisip6z, ciwip6z, cifz6, cisz6, ciwz6 @@ -185,6 +185,7 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) use var, only : pp2, ppi2, dip2, ph2, nymsize use var, only : ppi3, dip3, ph3, nzmsize use var, only : npress + ! use var, only : div_visu_var use tools, only : rescale_pressure @@ -194,7 +195,9 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) real(mytype), dimension(xsize(1), xsize(2), xsize(3)), intent(in) :: ux1, uy1, uz1 real(mytype), dimension(xsize(1), xsize(2), xsize(3)), intent(in) :: ep1 real(mytype), dimension(xsize(1), xsize(2), xsize(3), nrhotime), intent(in) :: rho1 - real(mytype), dimension(ph3%zst(1):ph3%zen(1),ph3%zst(2):ph3%zen(2),nzmsize,npress), intent(in) :: pp3 + real(mytype), dimension(ph3%zst(1):ph3%zen(1),ph3%zst(2):ph3%zen(2),nzmsize,npress), intent(in) :: pp3, div_visu_var + ! real(mytype), dimension(ph3%zst(1):ph3%zen(1),ph3%zst(2):ph3%zen(2),nzmsize,npress) :: div_visu_var + real(mytype), dimension(xsize(1), xsize(2), xsize(3), numscalar), intent(in) :: phi1 integer, intent(in) :: itime integer, intent(out) :: num @@ -235,9 +238,14 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) if (use_xdmf) call write_xdmf_header(".", "snapshot", num) ! Write velocity - call write_field(ux1, ".", "ux", num) - call write_field(uy1, ".", "uy", num) - call write_field(uz1, ".", "uz", num) + if (inviscid_output.eq.0) then + + call write_field(ux1, ".", "ux", num) + call write_field(uy1, ".", "uy", num) + call write_field(uz1, ".", "uz", num) + endif + call write_field(ep1, ".", "ep1", num, skip_ibm = .true.) + ! Interpolate pressure !WORK Z-PENCILS @@ -255,10 +263,32 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) ! Rescale pressure call rescale_pressure(ta1) - + if (inviscid_output.eq.0) then ! Write pressure - call write_field(ta1, ".", "pp", num, .true., flush=.true.) + call write_field(ta1, ".", "pp", num, .true., flush=.true.) + endif + if (div_visu_flag.eq.1) then + ! Interpolate div_visu_var + !WORK Z-PENCILS + call interzpv(ppi3,div_visu_var(:,:,:,1),dip3,sz,cifip6z,cisip6z,ciwip6z,cifz6,cisz6,ciwz6,& + (ph3%zen(1)-ph3%zst(1)+1),(ph3%zen(2)-ph3%zst(2)+1),nzmsize,zsize(3),1) + !WORK Y-PENCILS + call transpose_z_to_y(ppi3,pp2,ph3) !nxm nym nz + call interypv(ppi2,pp2,dip2,sy,cifip6y,cisip6y,ciwip6y,cify6,cisy6,ciwy6,& + (ph3%yen(1)-ph3%yst(1)+1),nymsize,ysize(2),ysize(3),1) + !WORK X-PENCILS + call transpose_y_to_x(ppi2,pp1,ph2) !nxm ny nz + call interxpv(ta1,pp1,di1,sx,cifip6,cisip6,ciwip6,cifx6,cisx6,ciwx6,& + nxmsize,xsize(1),xsize(2),xsize(3),1) + + + ! Rescale div_visu_var + call rescale_pressure(ta1) + + ! Write pressure + call write_field(ta1, ".", "div_visu", num, .true., flush=.true.) + endif ! LMN - write density if (ilmn) call write_field(rho1(:,:,:,1), ".", "rho", num) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index cac805e97..ba0846150 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -6,7 +6,7 @@ program xcompact3d use var use case - + use MPI, only: MPI_COMM_WORLD use transeq, only : calculate_transeq_rhs use time_integrators, only : int_time use navier, only : velocity_to_momentum, momentum_to_velocity, pre_correc, & @@ -21,15 +21,50 @@ program xcompact3d use param, only : mhd_active use particle, only : intt_particles + use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm + use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd,torque_calc,nvol implicit none + real(mytype) :: dummy,drag(10),lift(10),lat(10),grav_effy(10),grav_effx(10),grav_effz(10),xtorq(10),ytorq(10),ztorq(10),maxrad + integer :: iounit,ierr,i,code,ierror + real, dimension(100) :: x + character(len=30) :: filename!, filename2 + call init_xcompact3d() + iounit = 135 + !Print forces out on ellip + if ((nrank==0).and.(force_csv.eq.1)) then + open(unit=20, file='force_out.dat', status='unknown',form='formatted') + ! if (ierr /= 0) then + ! print *, 'Error opening file.' + ! stop + ! end if + write(*,*) 'Outputting forces' + end if + + if (nrank==0) then + do i = 1,nbody + write(filename,"('body.dat',I1.1)") i + open(unit=11+i, file=filename, status='unknown', form='formatted') + enddo + endif +! do i = 1,100 +! x(i) = i +! enddo +! open(unit=3, file='testcsv.dat', status='new',action='write',iostat=ierr) + +! do i = 1,100 +! write(3,*) x(i) +! enddo + + + do itime=ifirst,ilast !t=itime*dt t=t0 + (itime0 + itime + 1 - ifirst)*dt - + call simu_stats(2) if (iturbine.ne.0) call compute_turbines(ux1, uy1, uz1) @@ -51,6 +86,27 @@ program xcompact3d if (imove.eq.1) then ! update epsi for moving objects if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) + do i = 1,nobjmax + maxrad = max(shape(i,1),shape(i,2),shape(i,3)) + if (iforces.eq.1) then + xld(i) = position(i,1) - maxrad * ra(i) * cvl_scalar + xrd(i) = position(i,1) + maxrad * ra(i) * cvl_scalar + yld(i) = position(i,2) - maxrad * ra(i) * cvl_scalar + yud(i) = position(i,2) + maxrad * ra(i) * cvl_scalar + zld(i) = position(i,3) - maxrad * ra(i) * cvl_scalar + zrd(i) = position(i,3) + maxrad * ra(i) * cvl_scalar + ! write(*,*) "CV bounds = ", xld(i), xrd(i), yld(i), yud(i), zld(i), zrd(i) + if ((xld(i).lt.0).or.(xrd(i).gt.xlx).or.(yld(i).lt.0).or.(yud(i).gt.yly).or.(zld(i).lt.0).or.(zrd(i).gt.zlz)) then + write(*,*) "Body is too close to boundary!" + call MPI_ABORT(MPI_COMM_WORLD,code,ierror) + endif + endif + enddo + if (itime.eq.ifirst) then + call init_forces() + else + call update_forces() + endif else if (iibm.eq.1) then call body(ux1,uy1,uz1,ep1) endif @@ -70,7 +126,7 @@ program xcompact3d call pre_correc(ux1,uy1,uz1,ep1) call calc_divu_constraint(divu3,rho1,phi1) - call solve_poisson(pp3,px1,py1,pz1,rho1,ux1,uy1,uz1,ep1,drho1,divu3) + call solve_poisson(div_visu_var,pp3,px1,py1,pz1,rho1,ux1,uy1,uz1,ep1,drho1,divu3) call cor_vel(ux1,uy1,uz1,px1,py1,pz1) if(mhd_active .and. mhd_equation == 'induction') then @@ -85,6 +141,80 @@ program xcompact3d call test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) + !Add force calculation here + ! if (nrank.eq.0) then + ! write(*,*) 'Going to call force from xcompact3d, itr = ', itr + ! endif + if (itype.eq.itype_ellip) then + call force(ux1,uy1,uz1,ep1,drag,lift,lat,1) + grav_effx = grav_x*(rho_s-1.0) + grav_effy = grav_y*(rho_s-1.0) + grav_effz = grav_z*(rho_s-1.0) + do i = 1,nbody + linearForce(i,:) = [drag(i)-grav_effx(i), lift(i)-grav_effy(i), lat(i)-grav_effz(i)] + enddo + + + if (torques_flag.eq.1) then + call torque_calc(ux1,uy1,uz1,ep1,xtorq,ytorq,ztorq,1) + endif + if (orientations_free.eq.1) then + do i = 1,nvol + torque(i,:) = [xtorq(i), ytorq(i), ztorq(i)] + enddo + if (ztorq_only.eq.1) then + torque(:,1) = zero + torque(:,2) = zero + endif + else + torque(:,:) = zero + endif + ! if (nrank==0) then + + ! if (bodies_fixed==0) then + do i = 1,nvol + + call lin_step(position(i,:),linearVelocity(i,:),linearForce(i,:),ellip_m(i),dt,position_1,linearVelocity_1) + call ang_step(orientation(i,:),angularVelocity(i,:),torque(i,:),inertia(i,:,:),dt,orientation_1,angularVelocity_1) + + position(i,:) = position_1 + linearVelocity(i,:) = linearVelocity_1 + + orientation(i,:) = orientation_1 + angularVelocity(i,:) = angularVelocity_1 + enddo + + + if ((nrank==0).and.(mod(itime,ilist)==0)) then + do i = 1,nbody + write(11+i ,*) t, position(i,1), position(i,2), position(i,3), orientation(i,1), orientation(i,2), orientation(i,3), orientation(i,4), linearVelocity(i,1), linearVelocity(i,2), linearVelocity(i,3), angularVelocity(i,2), angularVelocity(i,3), angularVelocity(i,4), linearForce(i,1), linearForce(i,2), linearForce(i,3), torque(i,1), torque(i,2), torque(i,3) + flush(11+i) + enddo + endif + + if ((nrank==0).and.(mod(itime,ilist)==0)) then + do i = 1,nbody + write(*,*) "Body", i + write(*,*) "Position = ", position(i,:) + write(*,*) "Orientation = ", orientation(i,:) + write(*,*) "Linear velocity = ", linearVelocity(i,:) + write(*,*) "Angular velocity = ", angularVelocity(i,:) + write(*,*) "Linear Force = ", linearForce(i,:) + write(*,*) "Torque = ", torque(i,:) + enddo + ! call QuaternionNorm(angularVelocity,dummy) + + ! write(*,*) 'Norm of angvel = ', dummy + endif + endif + + ! endif + + ! if (nrank==0) then + ! write(*,*) 'Centroid position is ', position + ! write(*,*) 'Orientation is ', orientation + ! end if + if(mhd_active) call test_magnetic enddo !! End sub timesteps @@ -97,10 +227,12 @@ program xcompact3d call simu_stats(3) - call postprocessing(rho1,ux1,uy1,uz1,pp3,phi1,ep1) + call postprocessing(rho1,ux1,uy1,uz1,pp3, div_visu_var, phi1,ep1) enddo !! End time loop + close(iounit) + call finalise_xcompact3d() end program xcompact3d @@ -136,7 +268,7 @@ subroutine init_xcompact3d() use visu, only : visu_init, visu_ready - use genepsi, only : genepsi3d, epsi_init + use genepsi, only : genepsi3d, epsi_init, param_assign use ibm, only : body use probes, only : init_probes @@ -199,6 +331,9 @@ subroutine init_xcompact3d() call decomp_info_init(nxm, nym, nz, ph3) call init_variables() + if (itype.eq.itype_ellip) then + call param_assign() + endif call schemes() @@ -210,6 +345,7 @@ subroutine init_xcompact3d() endif if ((iibm.eq.2).or.(iibm.eq.3)) then + ! call boundary_conditions() call genepsi3d(ep1) else if (iibm.eq.1) then call epsi_init(ep1) @@ -217,7 +353,7 @@ subroutine init_xcompact3d() endif if (iforces.eq.1) then - call init_forces() + ! call init_forces() if (irestart==1) then call restart_forces(0) endif @@ -299,7 +435,7 @@ subroutine init_xcompact3d() open(38,file='forces.dat',form='formatted') endif endif - + if (itype==10) then if(nrank.eq.0)then open(42,file='shear.dat',form='formatted') @@ -349,7 +485,7 @@ subroutine finalise_xcompact3d() close(42) endif endif - + call simu_stats(4) call finalize_probes() call visu_case_finalise() diff --git a/tests/TGV-Taylor-Green-vortex/input.i3d b/tests/TGV-Taylor-Green-vortex/input.i3d new file mode 100644 index 000000000..e69de29bb